This commit is contained in:
龙腾猫跃
2023-03-08 23:34:10 +08:00
parent 36c10ade8c
commit d886acdeac
50 changed files with 781 additions and 659 deletions
+5 -5
View File
@@ -47,9 +47,9 @@ Public Class Application
Directory.CreateDirectory(Path & "PCL\Musics")
Try
Directory.CreateDirectory(PathTemp)
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL2 没有对 " & PathTemp & " 的访问权限")
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限")
Catch ex As Exception
MyMsgBox("手动设置的缓存文件夹不可用,PCL2 将使用默认缓存文件夹。" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
Setup.Set("SystemSystemCache", "")
PathTemp = IO.Path.GetTempPath() & "PCL\"
End Try
@@ -59,7 +59,7 @@ Public Class Application
#If Not DEBUG Then
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher 2 ")
If WindowHwnd <> IntPtr.Zero Then
'将已有的 PCL2 窗口拖出来
'将已有的 PCL 窗口拖出来
ShowWindowToTop(WindowHwnd)
'播放提示音并退出
Beep()
@@ -82,7 +82,7 @@ Public Class Application
Log("[Start] 程序路径:" & PathWithName)
'检测压缩包运行
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("PCL2 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL2 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True)
MyMsgBox("PCL 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True)
End If
'设置初始化
Setup.Load("SystemDebugMode")
@@ -104,7 +104,7 @@ Public Class Application
#End If
AniControlEnabled += 1
Catch ex As Exception
MsgBox(GetExceptionDetail(ex, True), MsgBoxStyle.Critical, "PCL2 初始化错误")
MsgBox(GetExceptionDetail(ex, True), MsgBoxStyle.Critical, "PCL 初始化错误")
FormMain.EndProgramForce(Result.Exception)
End Try
End Sub
+16 -2
View File
@@ -134,9 +134,23 @@
FrmDownloadInstall.MinecraftSelected(sender, e)
End Sub, False))
Case 8
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click))
If Distinct(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count Then
'存在重复的名称(#1344)
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
Else
'不存在重复的名称,正常加载
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click))
End If
Case 9
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click))
If Distinct(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count Then
'存在重复的名称(#1344)
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
Else
'不存在重复的名称,正常加载
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click))
End If
Case 10
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
Case 11
@@ -70,21 +70,33 @@
Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = 1
Close()
If MyConverter.Button1Action IsNot Nothing Then
MyConverter.Button1Action()
Else
MyConverter.IsExited = True
MyConverter.Result = 1
Close()
End If
End Sub
Public Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = 2
Close()
If MyConverter.Button2Action IsNot Nothing Then
MyConverter.Button2Action()
Else
MyConverter.IsExited = True
MyConverter.Result = 2
Close()
End If
End Sub
Public Sub Btn3_Click() Handles Btn3.Click
If MyConverter.IsExited Then Exit Sub
MyConverter.IsExited = True
MyConverter.Result = 3
Close()
If MyConverter.Button3Action IsNot Nothing Then
MyConverter.Button3Action()
Else
MyConverter.IsExited = True
MyConverter.Result = 3
Close()
End If
End Sub
Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown
@@ -65,7 +65,7 @@
Sub()
Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ContentExit
Thread.Sleep(10) '不在退出动画时执行 UI 线程操作,避免退出动画被重置
Loop
Loop
RunInUiWait(Sub() FinishedInvoke(RealLoader))
Thread.Sleep(20) '由于大量初始化控件会导致掉帧,延迟触发 State 改变事件
End Sub
+12 -22
View File
@@ -86,11 +86,11 @@
ValidateResult = ValidateRule.Validate(Text)
If IsNothing(ValidateResult) OrElse Not ValidateResult = "" Then Exit For
Next
Dim NewResult As Integer = If(ValidateResult = "", 0, 1)
Dim NewResult As Boolean = ValidateResult = ""
'根据结果改变样式
If ShownValidateResult <> NewResult Then
If ShownValidateResult <> If(NewResult, 0, 1) Then
If IsLoaded AndAlso labWrong IsNot Nothing Then
ChangeValidateResult(ValidateResult = "", True)
ChangeValidateResult(NewResult, True)
Else
RunInNewThread(Sub()
Thread.Sleep(30)
@@ -119,10 +119,17 @@
End If
End If
End Sub
''' <summary>
''' 强制显示结果为正常,类似尚未输入过文本的状态。不影响实际的检查结果。
''' </summary>
Public Sub ForceShowAsSuccess()
IsTextChanged = False
ChangeValidateResult(ValidateResult = "", True)
End Sub
Private ShownValidateResult As Integer = -1
Private Sub ChangeValidateResult(NewResult As Boolean, IsLoaded As Boolean)
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso IsTextChanged AndAlso labWrong IsNot Nothing Then
If NewResult Then
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso labWrong IsNot Nothing Then
If NewResult OrElse Not IsTextChanged Then
'变为正确
ShownValidateResult = 0
AniStart({
@@ -144,23 +151,6 @@
End If
Else
ShownValidateResult = 3
'AniStop("MyTextBox Validate " & Uuid)
'If NewResult Then
' '变为正确
' labWrong.Opacity = 0
' labWrong.Height = 0
' labWrong.Visibility = Visibility.Collapsed
'Else
' '变为错误
' labWrong.Visibility = Visibility.Visible
' labWrong.Text = ValidateResult
' labWrong.Opacity = 1
' labWrong.Height = 20.5
'End If
'Dim OriginalEnabled As Integer = AniControlEnabled
'AniControlEnabled += 1
'RefreshColor()
'AniControlEnabled = OriginalEnabled
End If
RefreshColor()
RaiseEvent ValidateChanged(Me, New EventArgs)
+34 -20
View File
@@ -108,7 +108,7 @@ Public Class FormMain
End If
If LastVersion < 233 Then 'Release 2.2.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "微软账号支持更换皮肤与披风"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持拖拽整合包文件到 PCL2 进行快捷安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持拖拽整合包文件到 PCL 进行快捷安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 下载支持显示对应的 MC 版本与 Mod 加载器,且可以跳转到 MCBBS 介绍页"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装 1.17 OptiFine + Forge"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "使用 Mojang 账号登录将会显示迁移提醒"))
@@ -126,6 +126,12 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 284 Then 'Snapshot 2.5.1
If LastVersion >= 275 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API"))
FeatureCount += 22
BugCount += 21
End If
If LastVersion < 283 Then 'Snapshot 2.5.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、下载 Modrinth 中的 Mod 与整合包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页"))
@@ -146,10 +152,6 @@ Public Class FormMain
If LastVersion = 277 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复设置背景音乐可能导致无法启动 PCL 的 Bug"))
BugCount += 2
End If
If LastVersion < 278 Then 'Snapshot 2.4.7
If LastVersion = 277 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复设置背景音乐可能导致无法启动 PCL 的 Bug"))
BugCount += 2
End If
If LastVersion < 277 Then 'Snapshot 2.4.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮"))
FeatureCount += 8
@@ -284,7 +286,7 @@ Public Class FormMain
BugCount += 19
End If
If LastVersion < 234 Then 'Snapshot 2.2.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持拖拽整合包文件到 PCL2 进行快捷安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持拖拽整合包文件到 PCL 进行快捷安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持安装 1.17 OptiFine + Forge"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod 详情页面支持跳转 MCBBS 介绍页"))
FeatureCount += 10
@@ -329,7 +331,7 @@ Public Class FormMain
Dim Content As String = "· " & Join(ContentList, vbCrLf & "· ")
'输出更新日志
RunInNewThread(Sub()
If MyMsgBox(Content, "PCL2 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
OpenWebsite("https://afdian.net/a/LTCat?tab=feed")
End If
End Sub, "UpdateLog Output")
@@ -443,15 +445,12 @@ Public Class FormMain
'加载池
RunInNewThread(Sub()
If Not Setup.Get("SystemEula") Then
Reopen:
Select Case MyMsgBox("在使用 PCL2 前,请同意 PCL2 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明")
Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW"))
Case 1
Setup.Set("SystemEula", True)
Case 2
EndProgram(False)
Case 3
OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW")
GoTo Reopen
End Select
End If
Try
@@ -478,13 +477,13 @@ Reopen:
#If Not BETA Then
Select Case Setup.Get("SystemCount")
Case 1
MyMsgBox("欢迎使用 PCL2 快照版!" & vbCrLf &
MyMsgBox("欢迎使用 PCL 快照版!" & vbCrLf &
"快照版包含尚未在正式版发布的测试性功能,仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦!" & vbCrLf &
"如果你并非通过赞助或赞助者本人邀请进群获得的本程序,那么可能是有人在违规传播,记得提醒他一下啦。", "快照版使用说明")
End Select
If Setup.Get("SystemCount") >= 99 Then
If ThemeUnlock(6, False) Then
MyMsgBox("你已经使用了 99 次 PCL2 啦,感谢你长期以来的支持!" & vbCrLf &
MyMsgBox("你已经使用了 99 次 PCL 啦,感谢你长期以来的支持!" & vbCrLf &
"隐藏主题 铁杆粉 已解锁!", "提示")
End If
End If
@@ -521,7 +520,7 @@ Reopen:
Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|"))
UnlockedTheme.Remove("13")
Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|"))
MyMsgBox("由于新版 PCL2 修改了欧皇彩的解锁方式,你需要重新解锁欧皇彩。" & vbCrLf &
MyMsgBox("由于新版 PCL 修改了欧皇彩的解锁方式,你需要重新解锁欧皇彩。" & vbCrLf &
"多谢各位的理解啦!", "重新解锁提醒")
End If
'重置滑稽彩
@@ -529,7 +528,7 @@ Reopen:
Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|"))
UnlockedTheme.Remove("12")
Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|"))
MyMsgBox("由于新版 PCL2 修改了滑稽彩的解锁方式,你需要重新解锁滑稽彩。" & vbCrLf &
MyMsgBox("由于新版 PCL 修改了滑稽彩的解锁方式,你需要重新解锁滑稽彩。" & vbCrLf &
"多谢各位的理解啦!", "重新解锁提醒")
End If
'移动自定义皮肤
@@ -838,8 +837,23 @@ Reopen:
Log("[System] 接受文件拖拽:" & FilePath, LogLevel.Developer)
RunInNewThread(Sub()
Dim Extension As String = FilePath.Split(".").Last.ToLower
'自定义主页
If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML,作为自定义主页加载")
If File.Exists(Path & "PCL\Custom.xaml") Then
If MyMsgBox("已存在一个自定义主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then
Exit Sub
End If
End If
CopyFile(FilePath, Path & "PCL\Custom.xaml")
RunInUi(Sub()
Setup.Set("UiCustomType", 1)
FrmLaunchRight.ForceRefresh()
End Sub)
Exit Sub
End If
'Mod 安装
If {"jar", "litemod", "disabled"}.Contains(Extension) Then
If {"jar", "litemod", "disabled"}.Any(Function(t) t = Extension) Then
Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
'获取并检查目标版本
Dim TargetVersion As McVersion = McVersionCurrent
@@ -873,13 +887,13 @@ Install:
Exit Sub
End If
'安装整合包
If {"zip", "rar", "mrpack"}.Contains(Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装")
If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub
End If
'RAR 处理
If Extension = "rar" Then
Hint("PCL2 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试!")
Hint("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试!")
Exit Sub
End If
'错误报告分析
@@ -895,7 +909,7 @@ Install:
Log(ex, "自主错误报告分析失败", LogLevel.Feedback)
End Try
'未知操作
Hint("PCL2 无法确定应当执行的文件拖拽操作……")
Hint("PCL 无法确定应当执行的文件拖拽操作……")
End Sub, "文件拖拽")
End If
Catch ex As Exception
+29 -31
View File
@@ -10,12 +10,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.5.0" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.5.0." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.5.1" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.5.1." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 281 'Release
#Else
Public Const VersionCode As Integer = 283 'Snapshot
Public Const VersionCode As Integer = 284 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -778,14 +778,10 @@ Public Module ModBase
If Not ToPath.Contains(":\") Then ToPath = Path & ToPath
'如果复制同一个文件则跳过
If FromPath = ToPath Then Exit Sub
'读取文件内容
Dim FileBytes As Byte()
Using ReadStream As New FileStream(FromPath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) '支持读取使用中的文件
ReDim FileBytes(ReadStream.Length - 1)
ReadStream.Read(FileBytes, 0, ReadStream.Length)
End Using
'写入文件内容
WriteFile(ToPath, FileBytes)
'确保目录存在
Directory.CreateDirectory(GetPathFromFullPath(ToPath))
'复制文件
File.Copy(FromPath, ToPath, True)
Catch ex As Exception
Throw New Exception("复制文件出错:" & FromPath & " -> " & ToPath, ex)
End Try
@@ -1222,7 +1218,7 @@ Re:
Try
GetJson(Content)
Catch ex As Exception
Throw New Exception("不是有效的 Json 文件", ex)
Throw New Exception("不是有效的 json 文件", ex)
End Try
End If
Return Nothing
@@ -1355,14 +1351,14 @@ Re:
Dim Desc As String = Join(DescList, vbCrLf & "→ ")
Dim Stack As String = If(StackList.Count > 0, vbCrLf & Join(StackList, vbCrLf), "")
'常见错误
'常见错误(记得同时修改下面的)
Dim CommonReason As String = Nothing
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL2 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
CommonReason = "PCL2 的权限不足。请尝试右键 PCL2,选择以管理员身份运行。"
CommonReason = "PCL 的权限不足。请尝试右键 PCL,选择以管理员身份运行。"
ElseIf TypeOf InnerEx Is OutOfMemoryException Then
CommonReason = "你的电脑运行内存不足,导致 PCL2 无法继续运行。请在关闭一部分不需要的程序后再试。"
CommonReason = "你的电脑运行内存不足,导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。"
ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
CommonReason = "你的网络环境不佳,导致难以连接到服务器。请检查网络,多重试几次,或尝试使用 VPN。"
@@ -1399,18 +1395,19 @@ Re:
Ex = Ex.InnerException
Loop
DescList = DescList.Distinct.ToList
'常见错误
Dim Desc As String = Join(DescList, vbCrLf & "→ ")
'常见错误(记得同时修改上面的)
Dim CommonReason As String = Nothing
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL2 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
CommonReason = "PCL2 的权限不足。请尝试右键 PCL2,选择以管理员身份运行。"
CommonReason = "PCL 的权限不足。请尝试右键 PCL,选择以管理员身份运行。"
ElseIf TypeOf InnerEx Is OutOfMemoryException Then
CommonReason = "你的电脑运行内存不足,导致 PCL2 无法继续运行。请在关闭一部分不需要的程序后再试。"
ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
CommonReason = "你的网络环境不佳,导致难以连接到服务器。请重试,或尝试使用 VPN。"
CommonReason = "你的电脑运行内存不足,导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。"
ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
CommonReason = "你的网络环境不佳,导致难以连接到服务器。请检查网络,多重试几次,或尝试使用 VPN。"
End If
'构造输出信息
@@ -1459,7 +1456,7 @@ Re:
Try
Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
Catch ex As Exception
Throw New Exception("格式化 Json 对象失败:" & If(If(Data, "").Length > 10000, Data.Substring(0, 100) & "...", Data))
Throw New Exception("格式化 json 对象失败:" & If(If(Data, "").Length > 10000, Data.Substring(0, 100) & "...", Data))
End Try
End Function
@@ -2042,7 +2039,8 @@ NextElement:
Catch ex As Exception
Log(ex, "无法打开网页(" & Url & ")")
ClipboardSet(Url, False)
MyMsgBox("可能由于浏览器未正确配置,PCL2 无法为你打开网页。" & vbCrLf & "网址已经复制到剪贴板,若有需要可以手动粘贴访问。", "无法打开网页")
MyMsgBox("可能由于浏览器未正确配置,PCL 无法为你打开网页。" & vbCrLf & "网址已经复制到剪贴板,若有需要可以手动粘贴访问。" & vbCrLf &
$"网址:{Url}", "无法打开网页")
End Try
End Sub
''' <summary>
@@ -2299,7 +2297,7 @@ Retry:
File.Create(Path & "PCL\Log1.txt").Dispose()
Catch ex As IOException
IsInitSuccess = False
Hint("可能同时开启了多个 PCL2,程序可能会出现未知问题!", HintType.Critical)
Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical)
Log(ex, "日志初始化失败(疑似文件占用问题)")
Catch ex As Exception
IsInitSuccess = False
@@ -2386,14 +2384,14 @@ Retry:
If CanFeedback(False) Then
If MyMsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
Else
MyMsgBox(Text & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
MyMsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
End If
Case LogLevel.Assert
Dim Time As Long = GetTimeTick()
If CanFeedback(False) Then
If MsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
Else
MsgBox(Text & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
MsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
End If
If GetTimeTick() - Time < 1500 Then
'弹窗无法保留
@@ -2455,14 +2453,14 @@ Retry:
If CanFeedback(False) Then
If MyMsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
Else
MyMsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
MyMsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
End If
Case LogLevel.Assert
Dim Time As Long = GetTimeTick()
If CanFeedback(False) Then
If MsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
Else
MsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL2 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
MsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
End If
If GetTimeTick() - Time < 1500 Then
'弹窗无法保留
@@ -2486,7 +2484,7 @@ Retry:
End Sub
Public Function CanFeedback(ShowHint As Boolean) As Boolean
If False.Equals(PageSetupSystem.IsLauncherNewest) Then
If ShowHint Then MyMsgBox("你的 PCL2 不是最新版,因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈")
If ShowHint Then MyMsgBox("你的 PCL 不是最新版,因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈")
Return False
Else
Return True
@@ -961,7 +961,7 @@ Capture:
Next
'是否禁用多线程,以及规定碎片大小
Dim TargetUrl As String = GetSource().Url
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("mcer.cn") Then Return False
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") Then Return False
Dim RealFilePieceLimit = If(TargetUrl.Contains("download.mcbbs.net"), FilePieceLimit * 5, FilePieceLimit)
'寻找最大碎片
Dim FilePieceMax As NetThread = Threads
+16 -20
View File
@@ -107,32 +107,28 @@ Public Class MyBitmap
''' </summary>
''' <param name="angle">旋转角度(单位为角度)。</param>
Public Function Rotation(angle As Double) As System.Drawing.Bitmap
With Me
Dim img As System.Drawing.Image = Me.Pic
Dim bitSize As Single = img.Width
Dim bmp As New System.Drawing.Bitmap(CInt(bitSize), CInt(bitSize))
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp)
g.TranslateTransform(bitSize / 2, bitSize / 2)
g.RotateTransform(angle)
g.TranslateTransform(-bitSize / 2, -bitSize / 2)
g.DrawImage(img, New System.Drawing.Rectangle(0, 0, img.Width, img.Width))
End Using
Return bmp
End With
Dim img As System.Drawing.Image = Me.Pic
Dim bitSize As Single = img.Width
Dim bmp As New System.Drawing.Bitmap(CInt(bitSize), CInt(bitSize))
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp)
g.TranslateTransform(bitSize / 2, bitSize / 2)
g.RotateTransform(angle)
g.TranslateTransform(-bitSize / 2, -bitSize / 2)
g.DrawImage(img, New System.Drawing.Rectangle(0, 0, img.Width, img.Width))
End Using
Return bmp
End Function
''' <summary>
''' 获取裁切的图片,这个方法不会导致原对象改变且会返回一个新的对象。
''' </summary>
Public Function Clip(rect As System.Drawing.Rectangle) As System.Drawing.Bitmap
With Me
Dim img As System.Drawing.Image = Pic
Dim bmp As New System.Drawing.Bitmap(rect.Width, rect.Height)
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp)
g.DrawImageUnscaled(img, rect)
End Using
Return bmp
End With
Dim img As System.Drawing.Image = Pic
Dim bmp As New System.Drawing.Bitmap(rect.Width, rect.Height)
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp)
g.DrawImageUnscaled(img, rect)
End Using
Return bmp
End Function
''' <summary>
@@ -225,7 +225,7 @@
RawName = Data("name")
Description = Data("summary")
Website = Data("links")("websiteUrl").ToString.TrimEnd("/")
LastUpdate = Data("dateModified")
LastUpdate = Data("dateReleased") '#1194
DownloadCount = Data("downloadCount")
'Logo
If Data("logo").Count > 0 Then
@@ -302,6 +302,7 @@
ModLoaders = New List(Of CompModLoaderType)
For Each File In If(Data("latestFiles"), {})
Dim NewFile As New CompFile(File, Type)
If Not NewFile.Available Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders)
Next
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
@@ -414,9 +415,9 @@
Dim NewItem As New MyCompItem With {.Tag = Me}
NewItem.LabTitle.Text = TranslatedName
NewItem.LabInfo.Text = Description.Replace(vbCr, "").Replace(vbLf, "")
NewItem.LabLeft.Text = If(ModeDebug, If(FromCurseForge, "[CurseForge] ", "[Modrinth] "), "") &
(If(ModLoaders.Count > 0 AndAlso ShowLoaderDesc, "[" & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & "] ", "") &
NewItem.LabLeft.Text = (If(ModLoaders.Count > 0 AndAlso ShowLoaderDesc, "[" & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & "] ", "") &
If(ShowMcVersionDesc, GameVersionDescription, "")).Replace("] [", " ") &
If(FromCurseForge, "[CurseForge] ", "[Modrinth] ") &
Join(Tags, ",") &
If(LastUpdate IsNot Nothing, " (" & GetTimeSpanString(LastUpdate - Date.Now) & "更新)", "")
If LogoUrl Is Nothing Then
@@ -439,6 +440,7 @@
''' 检查是否与某个 Project 是相同的工程,只是在不同的网站。
''' </summary>
Public Function IsLike(Project As CompProject) As Boolean
If Id = Project.Id Then Return True '相同实例
'提取字符串中的字母和数字
Dim GetRaw =
Function(Data As String) As String
@@ -448,12 +450,17 @@
Next
Return Result.ToString.ToLower
End Function
'具体的检查
'精准匹配:相同实例 或 MCMOD 指定的相同内容
'模糊匹配:支持的 Mod 加载器一致,且 (原名、描述文本或 Slug 的英文部分相同)
If Id = Project.Id OrElse TranslatedName = Project.TranslatedName OrElse '精准匹配
((RawName = Project.RawName OrElse Description = Project.Description OrElse GetRaw(Slug) = GetRaw(Project.Slug)) AndAlso
ModLoaders.Count = Project.ModLoaders.Count AndAlso ModLoaders.Except(Project.ModLoaders).Count = 0) Then '模糊匹配
'来自不同的网站
If FromCurseForge = Project.FromCurseForge Then Return False
'Mod 加载器一致
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False
'MC 版本一致
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse
GetRaw(Slug) = GetRaw(Project.Slug) Then
Log($"[Comp] 将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程")
'如果只有一个有 DatabaseEntry,设置给另外一个
If DatabaseEntry Is Nothing AndAlso Project.DatabaseEntry IsNot Nothing Then DatabaseEntry = Project.DatabaseEntry
If DatabaseEntry IsNot Nothing AndAlso Project.DatabaseEntry Is Nothing Then Project.DatabaseEntry = DatabaseEntry
@@ -809,8 +816,9 @@ Retry:
#Region "提取非重复项,存储于 RealResults"
'将 CurseForge 排在 Modrinth 的前面,避免加载结束顺序不同导致排名不同
RawResults = RawResults.Where(Function(x) x.FromCurseForge).Concat(RawResults.Where(Function(x) Not x.FromCurseForge)).ToList
'将 Modrinth 排在 CurseForge 的前面,避免加载结束顺序不同导致排名不同
'这样做的话,去重后将优先保留 CurseForge 内容(考虑到 CurseForge 热度更高)
RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList
'RawResults 去重
RawResults = Distinct(RawResults, Function(a, b) a.IsLike(b))
'已有内容去重
@@ -939,11 +947,18 @@ Retry:
End Property
'下载信息
''' <summary>
''' 下载信息是否可用。
''' </summary>
Public ReadOnly Property Available As Boolean
Get
Return FileName IsNot Nothing
End Get
End Property
''' <summary>
''' 下载的文件名。
''' </summary>
Public ReadOnly FileName As String
Public ReadOnly FileName As String = Nothing
''' <summary>
''' 文件所有可能的下载源。
''' </summary>
@@ -1022,8 +1037,11 @@ 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")
FileName = Data("files")(0)("filename")
DownloadAddress = {Data("files")(0)("url").ToString.Replace(FileName, Net.WebUtility.UrlEncode(FileName))}
'可能为空
If CType(Data("files"), JArray).Count > 0 Then
FileName = Data("files")(0)("filename")
DownloadAddress = {Data("files")(0)("url").ToString.Replace(FileName, Net.WebUtility.UrlEncode(FileName))}
End If
'Dependencies
If Type = CompType.Mod Then
RawDependencies = Data("dependencies").
@@ -1058,15 +1076,15 @@ Retry:
''' <summary>
''' 将当前文件信息实例化为控件。
''' </summary>
Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing) As MyListItem
Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing,
Optional BadDisplayName As Boolean = False) As MyListItem
'获取描述信息
Dim Info As String = ""
Select Case Type
Case CompType.Mod
Info += If(ModLoaders.Count > 0, Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/"), "") &
If(GameVersions.Count > 1 AndAlso GameVersions.Count < 10, If(ModLoaders.Count > 0, " ", "") & Join(GameVersions, "、").Replace("-snapshot", " 快照"), "")
If Info <> "" Then Info = "适用于 " & Info & ","
Info += If(ModLoaders.Count > 0,
"适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & ",", "")
Info += If(ModeDebug AndAlso Dependencies.Count > 0, Dependencies.Count & " 个前置 Mod,", "")
Case CompType.ModPack
If GameVersions.All(Function(v) v.Contains("w")) Then
@@ -1081,7 +1099,8 @@ Retry:
'建立控件
Dim NewItem As New MyListItem With {
.Title = DisplayName, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
.Title = If(BadDisplayName, FileName, DisplayName),
.SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
.Info = Info
}
Select Case Status
@@ -1153,7 +1172,8 @@ Retry:
'Modrinth
ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True)
End If
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).ToList
CompFilesCache(ProjectId) = Distinct(ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
Where(Function(a) a.Available).ToList, Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
'获取前置 Mod 列表
If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId)
Dim Deps As List(Of String) = CompFilesCache(ProjectId).
@@ -29,7 +29,7 @@
''' <summary>
''' 将可用于分析的日志存储到 AnalyzeRawFiles。
''' </summary>
''' <param name="LatestLog">从 PCL2 捕获到的最后 200 行程序输出。</param>
''' <param name="LatestLog">从 PCL 捕获到的最后 200 行程序输出。</param>
Public Sub Collect(VersionPathIndie As String, Optional LatestLog As IList(Of String) = Nothing)
Log("[Crash] 步骤 1:收集日志文件")
@@ -178,7 +178,7 @@
FileName = "游戏崩溃前的输出.txt" OrElse FileName = "rawoutput.log" Then
TargetType = AnalyzeFileType.MinecraftLog
If DirectFile Is Nothing Then DirectFile = LogFile
ElseIf FileName = "启动器日志.txt" OrElse FileName = "PCL2 启动器日志.txt" OrElse FileName = "log1.txt" Then
ElseIf FileName = "启动器日志.txt" OrElse FileName = "PCL2 启动器日志.txt" OrElse FileName = "PCL 启动器日志.txt" OrElse FileName = "log1.txt" Then
If LogFile.Value.Any(Function(s) s.Contains("以下为游戏输出的最后一段内容")) Then
TargetType = AnalyzeFileType.MinecraftLog
If DirectFile Is Nothing Then DirectFile = LogFile
@@ -243,7 +243,7 @@
Log("[Crash] 输出报告:" & SelectedFile.Key & ",作为 Minecraft 或启动器日志")
Next
'选择一份最佳的来自启动器的游戏日志
For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt"}
For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt", "PCL 启动器日志.txt"}
If FileNameDict.ContainsKey(FileName) Then
Dim CurrentLog = FileNameDict(FileName)
'截取 “以下为游戏输出的最后一段内容” 后的内容
@@ -253,12 +253,12 @@
LogMc += Line & vbLf
ElseIf Line.Contains("以下为游戏输出的最后一段内容") Then
HasLauncherMark = True
Log("[Crash] 找到 PCL2 输出的游戏实时日志头")
Log("[Crash] 找到 PCL 输出的游戏实时日志头")
End If
Next
'导入后 500 行
If Not HasLauncherMark Then LogMc += GetHeadTailLines(CurrentLog.Value, 0, 500)
LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray) & vbLf & "[" '路径包含中文且存在编码问题导致找不到或无法加载主类的末端检测
LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为启动器日志")
Exit For
End If
@@ -267,7 +267,7 @@
For Each FileName As String In {"latest.log", "latest log.txt", "debug.log", "debug log.txt"}
If FileNameDict.ContainsKey(FileName) Then
Dim CurrentLog = FileNameDict(FileName)
LogMc += GetHeadTailLines(CurrentLog.Value, 250, 500) & vbLf & "["
LogMc += GetHeadTailLines(CurrentLog.Value, 250, 500)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为 Minecraft 日志")
Exit For
End If
@@ -331,7 +331,7 @@
Java版本过高
Java版本不兼容
显卡驱动不支持导致无法设置像素格式
路径包含中文且存在编码问题导致找不到或无法加载主类
极短的程序输出
Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION 'https://bugs.mojang.com/browse/MC-32606
AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION 'https://bugs.mojang.com/browse/MC-31618
Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION
@@ -464,6 +464,7 @@ Done:
If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("java.lang.ClassCastException: class jdk.") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("TRANSFORMER/net.optifine/net.optifine.reflect.Reflector.<clinit>(Reflector.java") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.texture.SpriteContents.<init>(net.minecraft.resources.ResourceLocation, ") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.block.model.BakedQuad.<init>(int[], int, net.minecraft.core.Direction, net.minecraft.client.renderer.texture.TextureAtlasSprite, boolean, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.server.level.DistanceManager.addRegionTicket(net.minecraft.server.level.TicketType, net.minecraft.world.level.ChunkPos, int, java.lang.Object, boolean)'") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("Open J9 is not supported") OrElse LogMc.Contains("OpenJ9 is incompatible") OrElse LogMc.Contains(".J9VMInternals.") Then AppendReason(CrashReason.使用OpenJ9)
@@ -478,8 +479,6 @@ Done:
If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容)
If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误)
If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf))
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, If(RegexSeek(LogMc, "(?<=the game will display an error screen and halt[\s\S]+?Exception: )[\s\S]+?(?=\n\tat)"), "").TrimEnd(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足)
If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界)
If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容)
@@ -495,21 +494,24 @@ Done:
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
'找不到或无法加载主类
If (RegexCheck(LogMc, "^[^\n.]+.\w+.[^\n]+\n\[$") OrElse RegexCheck(LogMc, "^\[[^\]]+\] [^\n.]+.\w+.[^\n]+\n\[")) AndAlso
Not (LogMc.Contains("at net.") OrElse LogMc.Contains("/INFO]")) AndAlso
LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 500 Then
AppendReason(CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类)
End If
'Mod 导致的崩溃
If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in mixins.)[^./ ]+(?=.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[mixins.)[^./ ]+(?=.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in callback )[^./ ]+(?=.mixins.json:)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in callback mixins.)[^./ ]+(?=.json:)")
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "[^\n]+?(?)"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'仅当没有其他分析结果时显示
If CrashReasons.Count = 0 Then
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
End If
End If
'虚拟机日志分析
@@ -552,9 +554,13 @@ Done:
'游戏日志分析
If LogMc IsNot Nothing Then
If LogMc.Contains("]: Warnings were found!") Then AppendReason(CrashReason.Fabric报错, If(RegexSeek(LogMc, "(?<=\]: Warnings were found! ?[\n]+)[\w\W]+?(?=[\n]+\[)"), "").Trim(vbCrLf.ToCharArray))
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso
LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
AppendReason(CrashReason.极短的程序输出, LogMc)
End If
'Mixin 失败可以导致大量 Mod 实例创建失败
If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf)))
'注意:Fabric 的 Warnings were found! 不一定是崩溃原因,它可能是单纯的警报
End If
'崩溃报告分析
@@ -600,12 +606,12 @@ NextStack:
For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
Dim Word As String = Splited(i)
If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi",
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base",
"forge", "setup", "block", "model", "mixin", "event", "unimi",
"common", "server", "config", "loader", "launch", "entity", "assist", "client", "modapi", "mojang", "shader", "events", "github", "recipe",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty",
"common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content",
"fastutil", "optifine", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override", "blockentity"
"fastutil", "optifine", "scheduler", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override", "blockentity"
}.Contains(Word.ToLower) Then Continue For
PossibleWords.Add(Word.Trim)
Next
@@ -663,7 +669,7 @@ NextStack:
For Each ModString As String In ModNameLines
Dim RealModString As String = ModString.ToLower.Replace("_", "")
If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For
If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") Then Continue For
If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For
HintLines.Add(ModString.Trim(vbCrLf.ToCharArray))
Exit For
Next
@@ -696,7 +702,7 @@ NextStack:
''' 尝试获取 Mod 名称,若失败则返回原关键字。
''' </summary>
Private Function TryAnalyzeModName(Keywords As String) As List(Of String)
Dim RawList As New List(Of String) From {Keywords}
Dim RawList As New List(Of String) From {If(Keywords, "")}
If String.IsNullOrEmpty(Keywords) Then Return RawList
Return If(AnalyzeModName(RawList), RawList)
End Function
@@ -709,10 +715,8 @@ NextStack:
Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
'弹窗提示
FrmMain.ShowWindowToTop()
Redo:
Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"))
Case 2
Dim ShowLog As Action =
Sub()
If File.Exists(DirectFile.Value.Key) Then
ShellOnly(DirectFile.Value.Key)
Else
@@ -720,7 +724,10 @@ Redo:
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
ShellOnly(FilePath)
End If
GoTo Redo
End Sub
Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, ShowLog))
Case 3
Dim FileAddress As String = Nothing
Try
@@ -740,7 +747,7 @@ Redo:
Case "LatestLaunch.bat"
FileName = "启动脚本.bat"
Case "Log1.txt"
FileName = "PCL2 启动器日志.txt"
FileName = "PCL 启动器日志.txt"
Case "RawOutput.log"
FileName = "游戏崩溃前的输出.txt"
End Select
@@ -764,157 +771,161 @@ Redo:
''' </summary>
Private Function GetAnalyzeResult(IsHandAnalyze As Boolean) As String
'非一个结果的处理
Dim ResultString As String
'没有结果的处理
If CrashReasons.Count = 0 Then
If IsHandAnalyze Then
Return "很抱歉,PCL2 无法确定错误原因。"
Return "很抱歉,PCL 无法确定错误原因。"
Else
Return "很抱歉,你的游戏出现了一些问题……" & vbCrLf &
"如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" & vbCrLf &
"你也可以查看错误报告,其中可能会有出错的原因。"
End If
ElseIf CrashReasons.Count >= 2 Then
Hint("错误分析时发现数个可能的原因,窗口中仅显示了第一条,你可以在启动器日志中检查更多可能的原因!", HintType.Finish)
End If
'根据不同原因判断
Dim Additional As List(Of String) = CrashReasons.First.Value
Select Case CrashReasons.First.Key
Case CrashReason.Mod文件被解压
ResultString = "由于 Mod 文件被解压了,导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可,若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod,然后再启动游戏。"
Case CrashReason.内存不足
ResultString = "Minecraft 内存不足,导致其无法继续运行。\n这很可能是由于你为游戏分配的内存不足,或是游戏的配置要求过高。\n\n你可以在启动设置中增加为游戏分配的内存,删除配置要求较高的材质、Mod、光影。\n如果这依然不奏效,请在开始游戏前尽量关闭其他软件,或者……换台电脑?\h"
Case CrashReason.使用OpenJ9
ResultString = "游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java,然后再启动游戏。"
Case CrashReason.使用JDK
ResultString = "游戏似乎因为使用 JDK,或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8(Java 8),然后再启动游戏。\n如果你没有安装 JRE 8,你可以从网络中下载、安装一个。"
Case CrashReason.Java版本过高
ResultString = "游戏似乎因为你所使用的 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用较低版本的 Java,然后再启动游戏。\n如果没有,可以从网络中下载、安装一个。"
Case CrashReason.Java版本不兼容
ResultString = "游戏不兼容你当前使用的 Java。\n如果没有合适的 Java,可以从网络中下载、安装一个。"
Case CrashReason.使用32位Java导致JVM无法分配足够多的内存
If Environment.Is64BitOperatingSystem Then
ResultString = "你似乎正在使用 32 位 Java,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n请在启动设置的 Java 选择一项中改用 64 位的 Java 再启动游戏,然后再启动游戏。\n如果你没有安装 64 位的 Java,你可以从网络中下载、安装一个。"
Else
ResultString = "你正在使用 32 位的操作系统,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内,那或许只能换台电脑了……\h"
End If
Case CrashReason.崩溃日志堆栈分析发现关键字, CrashReason.MC日志堆栈分析发现关键字
If Additional.Count = 1 Then
ResultString = "你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL2 找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道它对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h"
Else
ResultString = "你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL2 找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道这些关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h"
End If
Case CrashReason.崩溃日志堆栈分析发现Mod名称
If Additional.Count = 1 Then
ResultString = "名为 " & Additional.First & " 的 Mod 可能导致了游戏出错。\n\e\h"
Else
ResultString = "可能是以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h"
End If
Case CrashReason.确定Mod导致游戏崩溃
If Additional.Count = 1 Then
ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h"
Else
ResultString = "以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h"
End If
Case CrashReason.ModMixin失败
If Additional.Count = 1 Then
ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着该 Mod 存在 Bug,或与当前环境不兼容。\n\e\h"
Else
ResultString = "以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着这些 Mod 存在 Bug,或与当前环境不兼容。\n\e\h"
End If
Case CrashReason.Mod配置文件导致游戏崩溃
If Additional(1) Is Nothing Then
ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h"
Else
ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。"
End If
Case CrashReason.Mod初始化失败
If Additional.Count = 1 Then
ResultString = "名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n\e\h"
Else
ResultString = "以下 Mod 初始化失败,导致游戏无法继续加载:\n - " & Join(Additional, "\n - ") & "\n\e\h"
End If
Case CrashReason.特定方块导致崩溃
If Additional.Count = 1 Then
ResultString = "游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是该方块导致出错,你或许需要使用一些方式删除此方块。\n - 若仍然出错,问题就可能来自其他原因……\h"
Else
ResultString = "游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是某些方块导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h"
End If
Case CrashReason.Mod重复安装
If Additional.Count >= 2 Then
ResultString = "你重复安装了多个相同的 Mod:\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。"
Else
ResultString = "你可能重复安装了多个相同的 Mod,导致游戏无法继续加载。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h"
End If
Case CrashReason.特定实体导致崩溃
If Additional.Count = 1 Then
ResultString = "游戏似乎因为实体 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并生成一个该实体,然后观察游戏的运行情况:\n - 若正常运行,则是该实体导致出错,你或许需要使用一些方式删除此实体。\n - 若仍然出错,问题就可能来自其他原因……\h"
Else
ResultString = "游戏似乎因为世界中的某些实体出现了问题。\n\n你可以创建一个新世界,并生成各种实体,观察游戏的运行情况:\n - 若正常运行,则是某些实体导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h"
End If
Case CrashReason.OptiFine与Forge不兼容
ResultString = "由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。\n经测试,Forge 版本过高或过低都可能导致崩溃。"
Case CrashReason.低版本Forge与高版本Java不兼容
ResultString = "由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 8.0.320 的 Java"
Case CrashReason.版本Json中存在多个Forge
ResultString = "可能由于使用其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。"
Case CrashReason.玩家手动触发调试崩溃
ResultString = "* 事实上,你的游戏没有任何问题,这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗?"
Case CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类
ResultString = "由于游戏路径含有中文字符,且 Java 或系统编码存在错误,导致游戏无法运行。\n\n解决这一问题的最简单方法是检查游戏的完整路径,并删除各个文件夹名中的中文字符。\n这包括了游戏的版本名、它所处的 .minecraft 文件夹及其之前的文件夹名。\h"
Case CrashReason.OptiFine导致无法加载世界 'https://www.minecraftforum.net/forums/support/java-edition-support/3051132-exception-ticking-world
ResultString = "你所使用的 OptiFine 可能导致了你的游戏出现问题。\n\n该问题只在特定 OptiFine 版本中出现,你可以尝试更换 OptiFine 的版本。\h"
Case CrashReason.显卡驱动不支持导致无法设置像素格式, CrashReason.Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.显卡不支持OpenGL
If LogAll.Contains("hd graphics ") Then
ResultString = "你的显卡驱动存在问题,或未使用独立显卡,导致游戏无法正常运行。\n\n如果你的电脑存在独立显卡,请使用独立显卡而非 Intel 核显启动 PCL2 与 Minecraft。\n如果问题依然存在,请尝试升级你的显卡驱动到最新版本,或回退到出厂版本。\n如果还是不行,还可以尝试使用 8.0.51 或更低版本的 Java。\h"
Else
ResultString = "你的显卡驱动存在问题,导致游戏无法正常运行。\n\n请尝试升级你的显卡驱动到最新版本,或回退到出厂版本,然后再启动游戏。\n如果还是不行,可以尝试使用 8.0.51 或更低版本的 Java。\n如果问题依然存在,那么你可能需要换个更好的显卡……\h"
End If
Case CrashReason.材质过大或显卡配置不足
ResultString = "你所使用的材质分辨率过高,或显卡配置不足,导致游戏无法继续运行。\n\n如果你正在使用高清材质,请将它移除。\n如果你没有使用材质,那么你可能需要更新显卡驱动,或者换个更好的显卡……\h"
Case CrashReason.光影或资源包导致OpenGL1282错误
ResultString = "你所使用的光影或材质导致游戏出现了一些问题……\n\n请尝试删除你所添加的这些额外资源。\h"
Case CrashReason.Mod过多导致超出ID限制
ResultString = "你所安装的 Mod 过多,超出了游戏的 ID 限制,导致了游戏崩溃。\n请尝试安装 JEID 等修复 Mod,或删除部分大型 Mod。"
Case CrashReason.文件或内容校验失败
ResultString = "部分文件或内容校验失败,导致游戏出现了问题。\n\n请尝试删除游戏(包括 Mod)并重新下载,或尝试在重新下载时使用 VPN。\h"
Case CrashReason.Fabric报错
If Additional.Count = 1 Then
ResultString = "Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。"
Else
ResultString = "Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h"
End If
Case CrashReason.Mod加载器报错
If Additional.Count = 1 Then
ResultString = "Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。"
Else
ResultString = "Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h"
End If
Case CrashReason.Fabric报错并给出解决方案
If Additional.Count = 1 Then
ResultString = "Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。"
Else
ResultString = "Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h"
End If
Case CrashReason.Forge报错
If Additional.Count = 1 Then
ResultString = "Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。"
Else
ResultString = "Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h"
End If
Case CrashReason.没有可用的分析文件
ResultString = "你的游戏出现了一些问题,但 PCL2 未能找到相关记录文件,因此无法进行分析。\h"
Case Else
ResultString = "PCL2 获取到了没有详细信息的错误原因(" & CrashReasons.First.Key & "),请向 PCL2 作者提交反馈以获取详情。\h"
End Select
Dim Results As New List(Of String)
For Each Reason In CrashReasons
Dim Additional As List(Of String) = Reason.Value
Select Case Reason.Key
Case CrashReason.Mod文件被解压
Results.Add("由于 Mod 文件被解压了,导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可,若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod,然后再启动游戏。")
Case CrashReason.内存不足
Results.Add("Minecraft 内存不足,导致其无法继续运行。\n这很可能是由于你为游戏分配的内存不足,或是游戏的配置要求过高。\n\n你可以在启动设置中增加为游戏分配的内存,删除配置要求较高的材质、Mod、光影。\n如果这依然不奏效,请在开始游戏前尽量关闭其他软件,或者……换台电脑?\h")
Case CrashReason.使用OpenJ9
Results.Add("游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java,然后再启动游戏。")
Case CrashReason.使用JDK
Results.Add("游戏似乎因为使用 JDK,或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8(Java 8),然后再启动游戏。\n如果你没有安装 JRE 8,你可以从网络中下载、安装一个。")
Case CrashReason.Java版本过高
Results.Add("游戏似乎因为你所使用的 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用较低版本的 Java,然后再启动游戏。\n如果没有,可以从网络中下载、安装一个。")
Case CrashReason.Java版本不兼容
Results.Add("游戏不兼容你当前使用的 Java。\n如果没有合适的 Java,可以从网络中下载、安装一个。")
Case CrashReason.使用32位Java导致JVM无法分配足够多的内存
If Environment.Is64BitOperatingSystem Then
Results.Add("你似乎正在使用 32 位 Java,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n请在启动设置的 Java 选择一项中改用 64 位的 Java 再启动游戏,然后再启动游戏。\n如果你没有安装 64 位的 Java,你可以从网络中下载、安装一个。")
Else
Results.Add("你正在使用 32 位的操作系统,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内,那或许只能换台电脑了……\h")
End If
Case CrashReason.崩溃日志堆栈分析发现关键字, CrashReason.MC日志堆栈分析发现关键字
If Additional.Count = 1 Then
Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道它对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
Else
Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道这些关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
End If
Case CrashReason.崩溃日志堆栈分析发现Mod名称
If Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 可能导致了游戏出错。\n\e\h")
Else
Results.Add("可能是以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h")
End If
Case CrashReason.确定Mod导致游戏崩溃
If Additional.Count = 1 Then
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h")
Else
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h")
End If
Case CrashReason.ModMixin失败
If Additional.Count = 1 Then
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着该 Mod 存在 Bug,或与当前环境不兼容。\n\e\h")
Else
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着这些 Mod 存在 Bug,或与当前环境不兼容。\n\e\h")
End If
Case CrashReason.Mod配置文件导致游戏崩溃
If Additional(1) Is Nothing Then
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h")
Else
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。")
End If
Case CrashReason.Mod初始化失败
If Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n\e\h")
Else
Results.Add("以下 Mod 初始化失败,导致游戏无法继续加载:\n - " & Join(Additional, "\n - ") & "\n\e\h")
End If
Case CrashReason.特定方块导致崩溃
If Additional.Count = 1 Then
Results.Add("游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是该方块导致出错,你或许需要使用一些方式删除此方块。\n - 若仍然出错,问题就可能来自其他原因……\h")
Else
Results.Add("游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是某些方块导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h")
End If
Case CrashReason.Mod重复安装
If Additional.Count >= 2 Then
Results.Add("你重复安装了多个相同的 Mod:\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。")
Else
Results.Add("你可能重复安装了多个相同的 Mod,导致游戏无法继续加载。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
End If
Case CrashReason.特定实体导致崩溃
If Additional.Count = 1 Then
Results.Add("游戏似乎因为实体 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并生成一个该实体,然后观察游戏的运行情况:\n - 若正常运行,则是该实体导致出错,你或许需要使用一些方式删除此实体。\n - 若仍然出错,问题就可能来自其他原因……\h")
Else
Results.Add("游戏似乎因为世界中的某些实体出现了问题。\n\n你可以创建一个新世界,并生成各种实体,观察游戏的运行情况:\n - 若正常运行,则是某些实体导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h")
End If
Case CrashReason.OptiFine与Forge不兼容
Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。")
Case CrashReason.低版本Forge与高版本Java不兼容
Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 8.0.320 的 Java")
Case CrashReason.版本Json中存在多个Forge
Results.Add("可能由于使用其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
Case CrashReason.玩家手动触发调试崩溃
Results.Add("* 事实上,你的游戏没有任何问题,这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗?")
Case CrashReason.极短的程序输出
Results.Add($"程序返回了以下信息:\n{Additional.First}\n\h")
Case CrashReason.OptiFine导致无法加载世界 'https://www.minecraftforum.net/forums/support/java-edition-support/3051132-exception-ticking-world
Results.Add("你所使用的 OptiFine 可能导致了你的游戏出现问题。\n\n该问题只在特定 OptiFine 版本中出现,你可以尝试更换 OptiFine 的版本。\h")
Case CrashReason.显卡驱动不支持导致无法设置像素格式, CrashReason.Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.显卡不支持OpenGL
If LogAll.Contains("hd graphics ") Then
Results.Add("你的显卡驱动存在问题,或未使用独立显卡,导致游戏无法正常运行。\n\n如果你的电脑存在独立显卡,请使用独立显卡而非 Intel 核显启动 PCL 与 Minecraft。\n如果问题依然存在,请尝试升级你的显卡驱动到最新版本,或回退到出厂版本。\n如果还是不行,还可以尝试使用 8.0.51 或更低版本的 Java。\h")
Else
Results.Add("你的显卡驱动存在问题,导致游戏无法正常运行。\n\n请尝试升级你的显卡驱动到最新版本,或回退到出厂版本,然后再启动游戏。\n如果还是不行,可以尝试使用 8.0.51 或更低版本的 Java。\n如果问题依然存在,那么你可能需要换个更好的显卡……\h")
End If
Case CrashReason.材质过大或显卡配置不足
Results.Add("你所使用的材质分辨率过高,或显卡配置不足,导致游戏无法继续运行。\n\n如果你正在使用高清材质,请将它移除。\n如果你没有使用材质,那么你可能需要更新显卡驱动,或者换个更好的显卡……\h")
Case CrashReason.光影或资源包导致OpenGL1282错误
Results.Add("你所使用的光影或材质导致游戏出现了一些问题……\n\n请尝试删除你所添加的这些额外资源。\h")
Case CrashReason.Mod过多导致超出ID限制
Results.Add("你所安装的 Mod 过多,超出了游戏的 ID 限制,导致了游戏崩溃。\n请尝试安装 JEID 等修复 Mod,或删除部分大型 Mod。")
Case CrashReason.文件或内容校验失败
Results.Add("部分文件或内容校验失败,导致游戏出现了问题。\n\n请尝试删除游戏(包括 Mod)并重新下载,或尝试在重新下载时使用 VPN。\h")
Case CrashReason.Fabric报错
If Additional.Count = 1 Then
Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
End If
Case CrashReason.Mod加载器报错
If Additional.Count = 1 Then
Results.Add("Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
End If
Case CrashReason.Fabric报错并给出解决方案
If Additional.Count = 1 Then
Results.Add("Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
End If
Case CrashReason.Forge报错
If Additional.Count = 1 Then
Results.Add("Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
End If
Case CrashReason.没有可用的分析文件
Results.Add("你的游戏出现了一些问题,但 PCL 未能找到相关记录文件,因此无法进行分析。\h")
Case Else
Results.Add("PCL 获取到了没有详细信息的错误原因(" & CrashReasons.First.Key & "),请向 PCL 作者提交反馈以获取详情。\h")
End Select
Next
ResultString = ResultString.
Replace("\n", vbCrLf).
Replace("\h", If(IsHandAnalyze, "", vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。")).
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf)
Return ResultString.Trim(vbCrLf.ToCharArray)
'整理多个原因
IsHandAnalyze = False
Return Join(Results, "\n\n此外,").
Replace("\n", vbCrLf).
Replace("\h", "").
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
Trim(vbCrLf.ToCharArray) &
If(Results.Any(Function(r) r.EndsWith("\h")),
If(IsHandAnalyze, "", vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。"), "")
End Function
End Class
@@ -13,7 +13,7 @@
Loop
'检查 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 文件下载信息")
Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息")
End If
'检查文件
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1"))
@@ -211,7 +211,7 @@
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
'添加 PCL2 特供项
'添加 PCL 特供项
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
@@ -244,7 +244,7 @@
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
'添加 PCL2 特供项
'添加 PCL 特供项
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json}
@@ -274,10 +274,10 @@
Return Version("url").ToString
End If
Next
Log("未发现版本 " & Id & " 的 Json 下载地址,版本列表返回为:" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug)
Log("未发现版本 " & Id & " 的 json 下载地址,版本列表返回为:" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug)
Return Nothing
Catch ex As Exception
Log(ex, "获取版本 " & Id & " 的 Json 下载地址失败")
Log(ex, "获取版本 " & Id & " 的 json 下载地址失败")
Return Nothing
End Try
End Function
@@ -977,7 +977,7 @@
End Function
Public Function DlSourceLauncherOrMetaGet(MojangBase As String, Optional IsStatic As Boolean = True) As String()
If MojangBase Is Nothing Then Throw New Exception("无对应的 Json 下载地址")
If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址")
If IsStatic Then
Return {MojangBase.Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"),
MojangBase,
@@ -181,12 +181,6 @@ NextInner:
RunInUiWait(Sub()
Dim LoginInput As McLoginData = McLoginInput()
CheckResult = McLoginAble(LoginInput)
If CheckResult = "" AndAlso
LoginInput.Type = McLoginType.Legacy AndAlso '离线登录
Not RegexCheck(CType(LoginInput, McLoginLegacy).UserName, "^[0-9A-Za-z_]+$") AndAlso
McVersionCurrent.Version.McCodeMain >= 18 Then 'MC 1.18 以上
CheckResult = "玩家名只能由数字、英文和下划线组成,不能包含中文或特殊字符!"
End If
End Sub)
If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
'求赞助
@@ -194,8 +188,8 @@ NextInner:
RunInNewThread(Sub()
Select Case Setup.Get("SystemLaunchCount")
Case 20, 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800, 1900, 2000
If MyMsgBox("PCL2 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
"如果觉得 PCL2 还算好用的话,也可以考虑小小地赞助一下作者呢 qwq……" & vbCrLf &
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
"如果觉得 PCL 还算好用的话,也可以考虑小小地赞助一下作者呢 qwq……" & vbCrLf &
"毕竟一个人开发也不容易(小声)……",
"求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then
OpenWebsite("https://afdian.net/a/LTCat/plan")
@@ -928,7 +922,7 @@ SystemBrowser:
Try
Result = NetRequestMuity("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 1)
Catch ex As Exception
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then 'Fix Hex-Dragon/PCL2#269
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
Return {"Relogin", ""}
Else
Throw
@@ -988,11 +982,11 @@ SystemBrowser:
"该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
OpenWebsite("https://account.live.com/editprof.aspx")
MyMsgBox("请在打开的网页中修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf &
"在修改成功后等待一分钟,然后再回到 PCL2,就可以正常登录了!", "登录提示")
"在修改成功后等待一分钟,然后再回到 PCL,就可以正常登录了!", "登录提示")
Else
OpenWebsite("https://support.microsoft.com/zh-cn/account-billing/如何更改-microsoft-帐户上的出生日期-837badbc-999e-54d2-2617-d19206b9540a")
MyMsgBox("请根据打开的网页的说明,修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf &
"在修改成功后等待一分钟,然后再回到 PCL2,就可以正常登录了!", "登录提示")
"在修改成功后等待一分钟,然后再回到 PCL,就可以正常登录了!", "登录提示")
End If
Throw New Exception("$$")
Else
@@ -1373,7 +1367,7 @@ SystemBrowser:
'添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then
Throw New Exception("版本 Json 中没有 mainClass 项!")
Throw New Exception("版本 json 中没有 mainClass 项!")
Else
DataList.Add(Version.JsonObject("mainClass"))
End If
@@ -1461,7 +1455,7 @@ NextVersion:
'添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then
Throw New Exception("版本 Json 中没有 mainClass 项!")
Throw New Exception("版本 json 中没有 mainClass 项!")
Else
Result += " " & Version.JsonObject("mainClass").ToString
End If
@@ -1579,7 +1573,7 @@ NextVersion:
GameArguments.Add("${natives_directory}", Version.Path & Version.Name & "-natives")
GameArguments.Add("${library_directory}", PathMcFolder & "libraries")
GameArguments.Add("${libraries_directory}", PathMcFolder & "libraries")
GameArguments.Add("${launcher_name}", "PCL2")
GameArguments.Add("${launcher_name}", "PCL")
GameArguments.Add("${launcher_version}", VersionCode)
GameArguments.Add("${version_name}", Version.Name)
Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Version:=McVersionCurrent)
@@ -1837,19 +1831,20 @@ NextVersion:
PackFormat = 9
End If
Case 19, 99 '99 是快照版
If McVersionCurrent.Version.McCodeSub <= 2 Then
PackFormat = 9
If McVersionCurrent.Version.McCodeSub <= 3 Then
PackFormat = 10
Else
PackFormat = 12
End If
Case Else
PackFormat = 13
'https://minecraft.fandom.com/zh/wiki/数据包#数据包版本
End Select
McLaunchLog("正在构建自定义皮肤资源包,格式为:" & PackFormat)
'准备文件
Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png")
Bit.Save(PackPicAddress)
WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL2 自定义离线皮肤资源包""}}")
WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png")
If (McVersionCurrent.Version.McCodeMain = 6 OrElse McVersionCurrent.Version.McCodeMain = 7) AndAlso Skin.Pic.Height = 64 Then
McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪")
@@ -1861,7 +1856,24 @@ NextVersion:
Using ZipAr As New ZipArchive(ZipFile, ZipArchiveMode.Create)
ZipAr.CreateEntryFromFile(MetaFileAddress, "pack.mcmeta")
ZipAr.CreateEntryFromFile(PackPicAddress, "pack.png")
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Setup.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
'1.19.3+ 使用复杂版本的替换
Dim IsOldType As Boolean
Select Case McVersionCurrent.Version.McCodeMain
Case Is < 19
IsOldType = True
Case 19
IsOldType = McVersionCurrent.Version.McCodeSub <= 2
Case Else
IsOldType = False
End Select
If IsOldType Then
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Setup.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
Else
For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png",
$"assets/minecraft/textures/entity/player/{If(Setup.Get("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png")
Next
End If
End Using
End Using
File.Delete(Path & "PCL\CustomSkin_Cliped.png")
@@ -1917,8 +1929,10 @@ IgnoreCustomSkin:
Private Sub McLaunchCustom(Loader As LoaderTask(Of Integer, Integer))
'获取自定义命令
Dim CustomCommand As String = Setup.Get("VersionAdvanceRun", Version:=McVersionCurrent)
If CustomCommand <> "" Then CustomCommand = ArgumentReplace(CustomCommand)
Dim CustomCommandGlobal As String = Setup.Get("LaunchAdvanceRun")
If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal)
Dim CustomCommandVersion As String = Setup.Get("VersionAdvanceRun", Version:=McVersionCurrent)
If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion)
'输出 bat
Try
@@ -1928,7 +1942,8 @@ IgnoreCustomSkin:
"echo 游戏正在启动,请稍候。" & vbCrLf &
"set APPDATA=""" & PathMcFolder & """" & vbCrLf &
"cd /D """ & PathMcFolder & """" & vbCrLf &
CustomCommand & vbCrLf &
CustomCommandGlobal & vbCrLf &
CustomCommandVersion & vbCrLf &
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
@@ -1947,23 +1962,52 @@ IgnoreCustomSkin:
End Try
'执行自定义命令
If CustomCommand <> "" Then
McLaunchLog("正在执行自定义命令:" & CustomCommand)
If CustomCommandGlobal <> "" Then
McLaunchLog("正在执行全局自定义命令:" & CustomCommandGlobal)
Dim CustomProcess As New Process
Try
Dim Cmd As New Process
Cmd.StartInfo.FileName = "cmd.exe"
Cmd.StartInfo.Arguments = "/c """ & CustomCommand & """"
Cmd.StartInfo.WorkingDirectory = Path
Cmd.StartInfo.UseShellExecute = False
Cmd.StartInfo.CreateNoWindow = True
Cmd.Start()
If Setup.Get("VersionAdvanceRunWait", Version:=McVersionCurrent) Then
Do Until Cmd.HasExited OrElse Loader.IsAborted
CustomProcess.StartInfo.FileName = "cmd.exe"
CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandGlobal & """"
CustomProcess.StartInfo.WorkingDirectory = Path
CustomProcess.StartInfo.UseShellExecute = False
CustomProcess.StartInfo.CreateNoWindow = True
CustomProcess.Start()
If Setup.Get("LaunchAdvanceRunWait") Then
Do Until CustomProcess.HasExited OrElse Loader.IsAborted
Thread.Sleep(10)
Loop
End If
Catch ex As Exception
Log(ex, "执行自定义命令失败", LogLevel.Hint)
Log(ex, "执行全局自定义命令失败", LogLevel.Hint)
Finally
If Not CustomProcess.HasExited AndAlso Loader.IsAborted Then
McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183
CustomProcess.Kill()
End If
End Try
End If
If CustomCommandVersion <> "" Then
McLaunchLog("正在执行版本自定义命令:" & CustomCommandVersion)
Dim CustomProcess As New Process
Try
CustomProcess.StartInfo.FileName = "cmd.exe"
CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandVersion & """"
CustomProcess.StartInfo.WorkingDirectory = Path
CustomProcess.StartInfo.UseShellExecute = False
CustomProcess.StartInfo.CreateNoWindow = True
CustomProcess.Start()
If Setup.Get("VersionAdvanceRunWait", Version:=McVersionCurrent) Then
Do Until CustomProcess.HasExited OrElse Loader.IsAborted
Thread.Sleep(10)
Loop
End If
Catch ex As Exception
Log(ex, "执行版本自定义命令失败", LogLevel.Hint)
Finally
If Not CustomProcess.HasExited AndAlso Loader.IsAborted Then
McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183
CustomProcess.Kill()
End If
End Try
End If
@@ -2020,7 +2064,7 @@ IgnoreCustomSkin:
'输出信息
McLaunchLog("")
McLaunchLog("~ 基础参数 ~")
McLaunchLog("PCL2 版本:" & VersionDisplayName & " (" & VersionCode & ")")
McLaunchLog("PCL 版本:" & VersionDisplayName & " (" & VersionCode & ")")
McLaunchLog("游戏版本:" & McVersionCurrent.Version.ToString & "(" & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & ")")
McLaunchLog("资源版本:" & McAssetsGetIndexName(McVersionCurrent))
McLaunchLog("版本继承:" & If(McVersionCurrent.InheritVersion = "", "无", McVersionCurrent.InheritVersion))
@@ -6,7 +6,7 @@ Public Module ModMinecraft
'列表初始化
Public JavaListCacheVersion As Integer = 2
Public JavaListCacheVersion As Integer = 3
''' <summary>
''' 目前所有可用的 Java。
''' </summary>
@@ -46,12 +46,23 @@ Public Module ModMinecraft
''' </summary>
Private ReadOnly Property PathEnv As String
Get
If _PathEnv Is Nothing Then _PathEnv = Environment.GetEnvironmentVariable("Path")
If _PathEnv Is Nothing Then _PathEnv = If(Environment.GetEnvironmentVariable("Path"), "")
Return _PathEnv
End Get
End Property
Private _PathEnv As String = Nothing
''' <summary>
''' JAVA_HOME 环境变量。
''' </summary>
Private ReadOnly Property PathJavaHome As String
Get
If _PathJavaHome Is Nothing Then _PathJavaHome = If(Environment.GetEnvironmentVariable("JAVA_HOME"), "")
Return _PathJavaHome
End Get
End Property
Private _PathJavaHome As String = Nothing
Public Class JavaEntry
'路径
@@ -216,8 +227,9 @@ Public Module ModMinecraft
#Region "模糊查找可能可用的 Java"
'查找环境变量中的 Java
For Each PathInEnv As String In Split(PathEnv.Replace("\\", "\").Replace("/", "\"), ";")
For Each PathInEnv As String In Split((PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\"), ";")
PathInEnv = PathInEnv.Trim(" """.ToCharArray())
If PathInEnv = "" Then Continue For
If Not PathInEnv.EndsWith("\") Then PathInEnv += "\"
'粗略检查有效性
If File.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False
@@ -235,7 +247,7 @@ Public Module ModMinecraft
JavaSearchFolder(PathMcFolder, JavaPreList, False, IsFullSearch:=True)
End If
'若[不全]为符号链接,则清除符号链接的地址
'若不全为符号链接,则清除符号链接的地址
Dim JavaWithoutReparse As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList
Dim Folder As String = Pair.Key.Replace("\\", "\").Replace("/", "\")
@@ -252,14 +264,14 @@ Public Module ModMinecraft
Next
If JavaWithoutReparse.Count > 0 Then JavaPreList = JavaWithoutReparse
'若不全为 javapath_target,则清除二重引用的地址
'若不全为特殊引用,则清除特殊引用的地址
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList
If Pair.Key.Contains("javapath_target_") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含二重引用")
If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
Continue For
End If
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含二重引用")
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
Next
If JavaWithoutInherit.Count > 0 Then JavaPreList = JavaWithoutInherit
@@ -508,6 +520,9 @@ RetryGet:
'指定的 Java 不可用,弹窗要求选择
Log("[Java] 发现用户指定的不兼容 Java:" & UserJava.ToString)
For Each Java In AllowedJavaList
Log($"[Java] 实际可用的 Java:{Java.ToString}")
Next
Dim Requirement As String = ""
Dim ShowRevision As Boolean = False
If (MinVersion Is Nothing OrElse MinVersion.Minor = 0) AndAlso (MaxVersion IsNot Nothing AndAlso MaxVersion.Minor < 999) Then
@@ -529,12 +544,12 @@ RetryGet:
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
Else
Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & ",但当前" & Requirement & "。" & vbCrLf &
"如果强制使用该 Java,可能会导致出现异常。" & vbCrLf &
"你可以将 游戏 Java 设置修改为 自动选择合适的 Java 来避免这一提示。" & vbCrLf &
"如果强制使用该 Java,可能导致游戏崩溃。" & vbCrLf &
"你也可以将 游戏 Java 设置修改为 自动选择合适的 Java。" & vbCrLf &
vbCrLf &
" - 指定的 Java:" & UserJava.ToString,
"Java 兼容性警告", "让 PCL2 自动选择", "强制使用该 Java", "取消")
Case 1 '让 PCL2 自动选择
"Java 兼容性警告", "让 PCL 自动选择", "强制使用该 Java", "取消")
Case 1 '让 PCL 自动选择
Case 2 '强制使用指定的 Java
Log("[Java] 已强制使用用户指定的不兼容 Java")
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
@@ -662,8 +677,8 @@ NoUserJava:
Public Sub JavaMissing(VersionCode As Integer)
Select Case VersionCode
Case 7
MyMsgBox("PCL2 未找到 Java 7。" & vbCrLf &
"请自行百度安装 Java 7,安装后在 PCL2 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。",
MyMsgBox("PCL 未找到 Java 7。" & vbCrLf &
"请自行百度安装 Java 7,安装后在 PCL 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。",
"未找到 Java")
Case 8 '291
If Is32BitSystem Then
@@ -671,17 +686,17 @@ NoUserJava:
Else
OpenWebsite("https://wwa.lanzoui.com/i2UyMq0jaqb")
End If
MyMsgBox("PCL2 未找到版本适宜的 Java 8。" & vbCrLf &
"请在打开的网页中下载安装包并安装,安装后在 PCL2 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。",
MyMsgBox("PCL 未找到版本适宜的 Java 8。" & vbCrLf &
"请在打开的网页中下载安装包并安装,安装后在 PCL 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。",
"未找到 Java")
Case 16, 17
If Is32BitSystem Then
MyMsgBox("该版本的 MC 已不支持 32 位操作系统。你必须增加内存并重装为 64 位系统才能继续。", "系统兼容性提示")
Else
OpenWebsite("https://www.oracle.com/java/technologies/downloads/#java17")
MyMsgBox("PCL2 未找到 Java 17。" & vbCrLf &
MyMsgBox("PCL 未找到 Java 17。" & vbCrLf &
"请在打开的网页中选择 x64 Installer,下载并安装。" & vbCrLf &
"安装后在 PCL2 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。",
"安装后在 PCL 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入,确保安装的 Java 已列入 Java 列表。",
"未找到 Java")
End If
End Select
@@ -812,15 +827,15 @@ NoUserJava:
Dim ResultJson As String =
"{
""profiles"": {
""PCL2"": {
""PCL"": {
""icon"": ""Grass"",
""name"": ""PCL2"",
""name"": ""PCL"",
""lastVersionId"": ""latest-release"",
""type"": ""latest-release"",
""lastUsed"": """ & Date.Now.ToString("yyyy-MM-dd") & "T" & Date.Now.ToString("HH:mm:ss") & ".0000Z""
}
},
""selectedProfile"": ""PCL2"",
""selectedProfile"": ""PCL"",
""clientToken"": ""23323323323323323323323323323333""
}"
WriteFile(Folder & "launcher_profiles.json", ResultJson, Encoding:=Encoding.GetEncoding("GB18030"))
@@ -1136,21 +1151,21 @@ VersionSearchFinish:
Public Property JsonText As String
Get
If _JsonText Is Nothing Then
If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 Json 文件:" & Path & Name & ".json")
If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 json 文件:" & Path & Name & ".json")
_JsonText = ReadFile(Path & Name & ".json")
'如果 ReadFile 失败会返回空字符串;这可能是由于文件被临时占用,故延时后重试
If _JsonText.Length = 0 Then
If RunInUi() Then
Log("[Minecraft] 版本 Json 文件为空或读取失败,由于代码在主线程运行,将不再进行重试", LogLevel.Debug)
Log("[Minecraft] 版本 json 文件为空或读取失败,由于代码在主线程运行,将不再进行重试", LogLevel.Debug)
Throw New Exception("版本 Json 文件为空或读取失败")
Else
Log("[Minecraft] 版本 Json 文件为空或读取失败,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug)
Log("[Minecraft] 版本 json 文件为空或读取失败,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug)
Thread.Sleep(2000)
_JsonText = ReadFile(Path & Name & ".json")
If _JsonText.Length = 0 Then Throw New Exception("版本 Json 文件为空或读取失败")
If _JsonText.Length = 0 Then Throw New Exception("版本 json 文件为空或读取失败")
End If
End If
If _JsonText.Length < 100 Then Throw New Exception("版本 Json 文件有误,内容为:" & _JsonText)
If _JsonText.Length < 100 Then Throw New Exception("版本 json 文件有误,内容为:" & _JsonText)
End If
Return _JsonText
End Get
@@ -1222,10 +1237,10 @@ Recheck:
GoTo Recheck
End If
Catch ex As Exception
Log(ex, "合并版本依赖项 Json 失败(" & If(InheritVersion, "null").ToString & ")")
Log(ex, "合并版本依赖项 json 失败(" & If(InheritVersion, "null").ToString & ")")
End Try
Catch ex As Exception
Throw New Exception("版本 Json 不规范(" & If(Name, "null") & ")", ex)
Throw New Exception("版本 json 不规范(" & If(Name, "null") & ")", ex)
End Try
Try
'处理 JumpLoader
@@ -1317,7 +1332,7 @@ Recheck:
CheckPermissionWithException(Path & "PCL\")
Catch ex As Exception
State = McVersionState.Error
Info = "PCL2 没有对该文件夹的访问权限,请右键以管理员身份运行 PCL2"
Info = "PCL 没有对该文件夹的访问权限,请右键以管理员身份运行 PCL"
Log(ex, "没有访问版本文件夹的权限")
Return False
End Try
@@ -1325,7 +1340,7 @@ Recheck:
Try
Dim JsonObjCheck = JsonObject
Catch ex As Exception
Log(ex, "版本 Json 可用性检查失败(" & Path & ")")
Log(ex, "版本 json 可用性检查失败(" & Path & ")")
JsonText = ""
JsonObject = Nothing
Info = ex.Message
@@ -1747,11 +1762,7 @@ Reload:
'改变当前选择的版本
OnLoaded:
If McVersionList.Count = 0 Then
McVersionCurrent = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Minecraft] 未找到可用 Minecraft 版本")
Else
If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then '不能判断 Count = 0,这在只有错误版本时导致了误判
'尝试读取已储存的选择
Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version")
If Not SavedSelection = "" Then
@@ -1773,6 +1784,10 @@ OnLoaded:
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
Log("[Launch] 自动选择 Minecraft 版本:" & McVersionCurrent.Path)
End If
Else
McVersionCurrent = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Minecraft] 未找到可用 Minecraft 版本")
End If
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000))
Catch ex As ThreadInterruptedException
@@ -2131,27 +2146,16 @@ NextVersion:
''' <summary>
''' 要求玩家选择一个皮肤文件,并进行相关校验。
''' </summary>
Public Function McSkinSelect(MustHaveTwoLayers As Boolean) As McSkinInfo
Public Function McSkinSelect() As McSkinInfo
Dim FileName As String = SelectFile("皮肤文件(*.png)|*.png", "选择皮肤文件")
'验证有效性
If FileName = "" Then Return New McSkinInfo With {.IsVaild = False}
Try
Dim Image As New MyBitmap(FileName)
If MustHaveTwoLayers Then
If Image.Pic.Width = 64 AndAlso Image.Pic.Height = 32 Then
Hint("自定义离线皮肤只支持 64x64 像素的双层皮肤!", HintType.Critical)
Return New McSkinInfo With {.IsVaild = False}
End If
If Image.Pic.Width <> 64 OrElse Image.Pic.Height <> 64 Then
Hint("自定义离线皮肤图片大小应为 64x64 像素!", HintType.Critical)
Return New McSkinInfo With {.IsVaild = False}
End If
Else
If Image.Pic.Width <> 64 OrElse Not (Image.Pic.Height = 32 OrElse Image.Pic.Height = 64) Then
Hint("皮肤图片大小应为 64x32 像素或 64x64 像素!", HintType.Critical)
Return New McSkinInfo With {.IsVaild = False}
End If
If Image.Pic.Width <> 64 OrElse Not (Image.Pic.Height = 32 OrElse Image.Pic.Height = 64) Then
Hint("皮肤图片大小应为 64x32 像素或 64x64 像素!", HintType.Critical)
Return New McSkinInfo With {.IsVaild = False}
End If
Dim FileInfo As New FileInfo(FileName)
If FileInfo.Length > 24 * 1024 Then
@@ -2403,7 +2407,7 @@ NextVersion:
'不能调用 RealVersion.Check(),可能会莫名其妙地触发 CheckPermission 正被另一进程使用,导致误判前置不存在
If Not File.Exists(RealVersion.Path & RealVersion.Name & ".json") Then
RealVersion = Version
Log("[Minecraft] 可能缺少前置版本 " & RealVersion.Name & ",找不到对应的 Json 文件", LogLevel.Debug)
Log("[Minecraft] 可能缺少前置版本 " & RealVersion.Name & ",找不到对应的 json 文件", LogLevel.Debug)
End If
'获取详细下载信息
If RealVersion.JsonObject("downloads") IsNot Nothing AndAlso RealVersion.JsonObject("downloads")("client") IsNot Nothing Then
@@ -2545,7 +2549,7 @@ NextVersion:
Dim MainJar As NetFile = DlClientJarGet(Version, True)
If MainJar IsNot Nothing Then Result.Add(MainJar)
Catch ex As Exception
Log(ex, "版本缺失主 Jar 文件所必须的信息", LogLevel.Developer)
Log(ex, "版本缺失主 jar 文件所必须的信息", LogLevel.Developer)
End Try
If CoreJarOnly Then Return Result
@@ -3116,7 +3120,7 @@ NextVersion:
If Jar.Entries.Count = 0 Then Throw New FileFormatException("文件内容为空")
Catch ex As UnauthorizedAccessException
Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer)
_FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL2", ex)
_FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL", ex)
Jar = Nothing
Catch ex As Exception
Log(ex, "Mod 文件无法打开(" & Path & ")", LogLevel.Developer)
@@ -3751,27 +3755,15 @@ VersionFindFail:
'进行提示
If Version Is Nothing Then Exit Sub
Dim Time As Date = Version("releaseTime")
Dim MsgResult As Integer
If (Date.Now - Time).TotalDays > 1 Then
'1 天以上
MsgResult = MyMsgBox("新版本:" & VersionName & vbCrLf & "更新时间:" & Time.ToString, "Minecraft 更新提示", "下载", "更新日志", "取消")
ElseIf (Date.Now - Time).TotalHours > 3 Then
'1 天 ~ 3 小时
MsgResult = MyMsgBox("新版本:" & VersionName & vbCrLf & "更新于:" & GetTimeSpanString(Time - Date.Now), "Minecraft 更新提示", "下载", "更新日志", "取消")
Else
'不到 3 小时
MsgResult = MyMsgBox("新版本:" & VersionName & vbCrLf & "更新于:" & GetTimeSpanString(Time - Date.Now), "Minecraft 更新提示", "下载", "取消")
If MsgResult = 2 Then MsgResult = 3 '把 “取消” 移位
End If
Dim MsgBoxText As String = $"新版本:{VersionName}{vbCrLf}" &
If((Date.Now - Time).TotalDays > 1, "更新时间:" & Time.ToString, "更新于:" & GetTimeSpanString(Time - Date.Now))
Dim MsgResult = MyMsgBox(MsgBoxText, "Minecraft 更新提示", "确定", "下载", If((Date.Now - Time).TotalHours > 3, "更新日志", ""),
Button3Action:=Sub() McUpdateLogShow(Version))
'弹窗结果
Select Case MsgResult
Case 1
'下载
McDownloadClient(NetPreDownloadBehaviour.HintWhileExists, VersionName, Version("url").ToString)
Case 2
'更新日志
McUpdateLogShow(Version)
End Select
If MsgResult = 2 Then
'下载
McDownloadClient(NetPreDownloadBehaviour.HintWhileExists, VersionName, Version("url").ToString)
End If
Catch ex As Exception
Log(ex, "Minecraft 更新提示发送失败(" & If(VersionName, "Nothing") & ")", LogLevel.Feedback)
@@ -60,7 +60,7 @@
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
ElseIf File.ToLower.EndsWith(".rar") Then
Log(ex, "PCL2 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
Else
Log(ex, "打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
@@ -263,8 +263,10 @@ Retry:
IsResourcePack = False
End If
'实际的添加
FileList.Add(ModJson("id"), New CompFile(ModJson, CompType.Mod).ToNetFile(
PathMcFolder & "versions\" & VersionName & "\" & If(IsResourcePack, "resourcepacks", "mods") & "\"))
Dim File As New CompFile(ModJson, CompType.Mod)
If Not File.Available Then Continue For
FileList.Add(ModJson("id"),
File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{If(IsResourcePack, "resourcepacks", "mods")}\"))
Task.Progress += 1 / (1 + ModFileList.Count)
Next
Task.Output = FileList.Values.ToList
@@ -358,7 +360,7 @@ Retry:
Select Case Entry.Name.ToLower
Case "minecraft"
MinecraftVersion = Entry.Value.ToString
Case "forge" 'eg. 14.23.5.2859
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
ForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Forge 版本:" & ForgeVersion)
Case "fabric-loader" 'eg. 0.14.14
@@ -206,7 +206,7 @@
'Log(Text)
'关闭与崩溃检测
If Not Text.Contains("[CHAT]") Then
If Text.Contains("Someone is closing me!") Then
If Text.Contains("Someone is closing me!") OrElse Text.Contains("Restarting Minecraft with command") Then '#1258
WatcherLog("识别为关闭的 Log:" & Text)
State = MinecraftState.Ended
ElseIf Text.Contains("Crash report saved to") OrElse Text.Contains("This crash report has been saved to:") Then
+3 -2
View File
@@ -64,13 +64,13 @@
Case "下载文件"
Data(0) = Data(0).Replace("\", "/")
If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL2 不支持其他乱七八糟的协议。", "事件执行失败")
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的协议。", "事件执行失败")
Exit Sub
End If
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
Case Else
MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL2 是否为最新版本。", "事件执行失败")
MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
End Select
Catch ex As Exception
Log(ex, "事件执行失败", LogLevel.Msgbox)
@@ -121,6 +121,7 @@
'确认实际路径
Dim Location As String, WorkingDir As String = Path & "PCL"
HelpTryExtract()
If RelativeUrl.Contains(":\") Then
'绝对路径
Location = RelativeUrl
+2 -2
View File
@@ -265,9 +265,9 @@
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception
If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL2 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
ElseIf Not (MusicCurrent.ToLower.EndsWith(".wav") OrElse MusicCurrent.ToLower.EndsWith(".mp3") OrElse MusicCurrent.ToLower.EndsWith(".flac")) Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL2 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
End If
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.5.0.0")>
<Assembly: AssemblyFileVersion("2.5.0.0")>
<Assembly: AssemblyVersion("2.5.1.0")>
<Assembly: AssemblyFileVersion("2.5.1.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -37,7 +37,7 @@ Public Module ModDownloadLib
'已有版本检查
If Behaviour <> NetPreDownloadBehaviour.IgnoreCheck AndAlso File.Exists(VersionFolder & Id & ".json") AndAlso File.Exists(VersionFolder & Id & ".jar") Then
If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return Nothing
If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 Json 与 Jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 与 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
File.Delete(VersionFolder & Id & ".jar")
File.Delete(VersionFolder & Id & ".json")
Else
@@ -82,14 +82,14 @@ Public Module ModDownloadLib
Dim Loaders As New List(Of LoaderBase)
'下载版本 Json 文件
Loaders.Add(New LoaderDownload("下载版本 Json 文件", New List(Of NetFile) From {
Loaders.Add(New LoaderDownload("下载版本 json 文件", New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 2})
'获取支持库文件地址
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 Jar 文件下载地址",
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 jar 文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder), True)) With {.ProgressWeight = 0.5, .Show = False})
'下载支持库文件
Loaders.Add(New LoaderDownload("下载核心 Jar 文件", New List(Of NetFile)) With {.ProgressWeight = 5})
Loaders.Add(New LoaderDownload("下载核心 jar 文件", New List(Of NetFile)) With {.ProgressWeight = 5})
'启动
Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
@@ -115,7 +115,7 @@ Public Module ModDownloadLib
'下载版本 Json 文件
If JsonUrl Is Nothing Then
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取原版 Json 文件下载地址",
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取原版 json 文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim JsonAddress As String = DlClientListGet(Id)
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JsonAddress), VersionFolder & VersionName & ".json")}
@@ -166,7 +166,7 @@ Public Module ModDownloadLib
End Function
Private Const McDownloadClientLibName As String = "下载原版支持库文件"
Private Const McDownloadClientJsonName As String = "下载原版 Json 文件"
Private Const McDownloadClientJsonName As String = "下载原版 json 文件"
#End Region
@@ -192,7 +192,7 @@ Public Module ModDownloadLib
Else
NewItem.Info = Entry("lore").ToString
End If
If Entry("url").ToString.Contains("pcl") Then NewItem.Info = "[PCL2 特别提供] " & NewItem.Info
If Entry("url").ToString.Contains("pcl") Then NewItem.Info = "[PCL 特别提供] " & NewItem.Info
AddHandler NewItem.Click, OnClick
'建立菜单
If IsSaveOnly Then
@@ -333,7 +333,7 @@ Public Module ModDownloadLib
'已有版本检查
If File.Exists(VersionFolder & Id & ".json") Then
If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 Json 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 和 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
File.Delete(VersionFolder & Id & ".jar")
File.Delete(VersionFolder & Id & ".json")
Else
@@ -770,7 +770,7 @@ Public Module ModDownloadLib
'已有版本检查
If File.Exists(VersionFolder & VersionName & ".json") Then
If MyMsgBox("版本 " & VersionName & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 Json 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
If MyMsgBox("版本 " & VersionName & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 和 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
File.Delete(VersionFolder & VersionName & ".jar")
File.Delete(VersionFolder & VersionName & ".json")
Else
@@ -992,16 +992,16 @@ Public Module ModDownloadLib
Public Sub McDownloadForge(DownloadInfo As DlForgeVersionEntry)
'老版本提示
If DownloadInfo.Category = "client" Then
If MyMsgBox("该 Forge 版本过于古老,PCL2 暂不支持该版本的自动安装。" & vbCrLf &
"若你仍然希望继续,PCL2 将把安装程序下载到你指定的位置,但不会进行安装。",
If MyMsgBox("该 Forge 版本过于古老,PCL 暂不支持该版本的自动安装。" & vbCrLf &
"若你仍然希望继续,PCL 将把安装程序下载到你指定的位置,但不会进行安装。",
"版本过老", "继续", "取消") = 1 Then
McDownloadForgeSave(DownloadInfo)
End If
Exit Sub
End If
If DownloadInfo.Category = "universal" OrElse DownloadInfo.Inherit.StartsWith("1.5") Then '对该版本自动安装的支持将在之后加入
If MyMsgBox("该 Forge 版本过于古老,PCL2 暂不支持该版本的自动安装。" & vbCrLf &
"若你仍然希望继续,PCL2 将把安装程序下载到你指定的位置,但不会进行安装。",
If MyMsgBox("该 Forge 版本过于古老,PCL 暂不支持该版本的自动安装。" & vbCrLf &
"若你仍然希望继续,PCL 将把安装程序下载到你指定的位置,但不会进行安装。",
"版本过老", "继续", "取消") = 1 Then
McDownloadForgeSave(DownloadInfo)
End If
@@ -1026,7 +1026,7 @@ Public Module ModDownloadLib
'已有版本检查
If File.Exists(VersionFolder & Id & ".json") Then
If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 Json 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
If MyMsgBox("版本 " & Id & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 和 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
File.Delete(VersionFolder & Id & ".jar")
File.Delete(VersionFolder & Id & ".json")
Else
@@ -1239,6 +1239,11 @@ Public Module ModDownloadLib
'参数初始化
McFolder = If(McFolder, PathMcFolder)
If Version.StartsWith("1.") AndAlso Version.Contains("-") Then
'类似 1.19.3-41.2.8 格式,优先使用 Version 中要求的版本而非 Inherit(例如 1.19.3 却使用了 1.19 的 Forge)
Inherit = Version.Split("-").First
Version = Version.Split("-").Last
End If
Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder
Dim Id As String = Inherit & "-forge-" & Version
Dim InstallerAddress As String = PathTemp & "Cache\Code\ForgeInstall-" & Version & "_" & RandomInteger(0, 100000)
@@ -1267,20 +1272,20 @@ Public Module ModDownloadLib
End If
'下载 Forge 主文件
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("准备 Mod 加载器下载",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'启动依赖版本的下载
If ClientDownloadLoader Is Nothing Then
If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器,则不能指定 MC 安装文件夹")
ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, Inherit)
End If
'添加主文件
Dim Files As New List(Of NetFile) From {New NetFile({
"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName,
"http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName,
"https://download.mcbbs.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName
}, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=DownloadInfo.Hash))}
Task.Output = Files
End Sub) With {.ProgressWeight = 0.5, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'启动依赖版本的下载
If ClientDownloadLoader Is Nothing Then
If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器,则不能指定 MC 安装文件夹")
ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, Inherit)
End If
'添加主文件
Dim Files As New List(Of NetFile) From {New NetFile({
"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName,
"http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName,
"https://download.mcbbs.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName
}, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=DownloadInfo.Hash))}
Task.Output = Files
End Sub) With {.ProgressWeight = 0.5, .Show = False})
Loaders.Add(New LoaderDownload("下载 Mod 加载器主文件", New List(Of NetFile)) With {.ProgressWeight = 9})
'安装(仅在新版安装时需要原版 Jar)
@@ -1788,7 +1793,7 @@ Public Module ModDownloadLib
'若要下载 Forge,则需要在下面两项中完成至少一项
''' <summary>
''' 欲下载的 Forge 版本名。例如 36.1.4。
''' 欲下载的 Forge 版本名。接受例如 36.1.4 / 14.23.5.2859 / 1.19-41.1.0 的输入。
''' </summary>
Public ForgeVersion As String = Nothing
''' <summary>
@@ -2065,30 +2070,30 @@ Public Module ModDownloadLib
Dim OutputJson As JObject, MinecraftJson As JObject, OptiFineJson As JObject = Nothing, ForgeJson As JObject = Nothing, LiteLoaderJson As JObject = Nothing, FabricJson As JObject = Nothing
#Region "读取文件并检查文件是否合规"
Dim MinecraftJsonText As String = ReadFile(MinecraftJsonPath)
If Not MinecraftJsonText.StartsWith("{") Then Throw New Exception("Minecraft Json 有误,地址:" & MinecraftJsonPath & ",前段内容:" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000)))
If Not MinecraftJsonText.StartsWith("{") Then Throw New Exception("Minecraft json 有误,地址:" & MinecraftJsonPath & ",前段内容:" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000)))
MinecraftJson = GetJson(MinecraftJsonText)
If HasOptiFine Then
Dim OptiFineJsonText As String = ReadFile(OptiFineJsonPath)
If Not OptiFineJsonText.StartsWith("{") Then Throw New Exception("OptiFine Json 有误,地址:" & OptiFineJsonPath & ",前段内容:" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000)))
If Not OptiFineJsonText.StartsWith("{") Then Throw New Exception("OptiFine json 有误,地址:" & OptiFineJsonPath & ",前段内容:" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000)))
OptiFineJson = GetJson(OptiFineJsonText)
End If
If HasForge Then
Dim ForgeJsonText As String = ReadFile(ForgeJsonPath)
If Not ForgeJsonText.StartsWith("{") Then Throw New Exception("Forge Json 有误,地址:" & ForgeJsonPath & ",前段内容:" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000)))
If Not ForgeJsonText.StartsWith("{") Then Throw New Exception("Forge json 有误,地址:" & ForgeJsonPath & ",前段内容:" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000)))
ForgeJson = GetJson(ForgeJsonText)
End If
If HasLiteLoader Then
Dim LiteLoaderJsonText As String = ReadFile(LiteLoaderJsonPath)
If Not LiteLoaderJsonText.StartsWith("{") Then Throw New Exception("LiteLoader Json 有误,地址:" & LiteLoaderJsonPath & ",前段内容:" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000)))
If Not LiteLoaderJsonText.StartsWith("{") Then Throw New Exception("LiteLoader json 有误,地址:" & LiteLoaderJsonPath & ",前段内容:" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000)))
LiteLoaderJson = GetJson(LiteLoaderJsonText)
End If
If HasFabric Then
Dim FabricJsonText As String = ReadFile(FabricJsonPath)
If Not FabricJsonText.StartsWith("{") Then Throw New Exception("Fabric Json 有误,地址:" & FabricJsonPath & ",前段内容:" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000)))
If Not FabricJsonText.StartsWith("{") Then Throw New Exception("Fabric json 有误,地址:" & FabricJsonPath & ",前段内容:" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000)))
FabricJson = GetJson(FabricJsonText)
End If
#End Region
@@ -9,7 +9,7 @@
<StackPanel Orientation="Vertical" Margin="5">
<!--<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="自动安装提示" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Margin="0,0,0,2" Text="本页只提供需要在下载后手动进行安装的游戏 Jar 与 Json 下载。" TextWrapping="Wrap" />
<TextBlock Margin="0,0,0,2" Text="本页只提供需要在下载后手动进行安装的游戏 jar 与 json 下载。" TextWrapping="Wrap" />
<TextBlock Margin="0,0,0,11" Text="如果你想要进行自动安装,在游戏安装页选择游戏版本,然后直接安装即可。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
@@ -18,8 +18,8 @@
Case LoadState.Failed
Dim ErrorMessage As String = ""
If CompFileLoader.Error IsNot Nothing Then ErrorMessage = CompFileLoader.Error.Message
If ErrorMessage.Contains("不是有效的 Json 文件") Then
Log("[Comp] 下载的文件 Json 列表损坏,已自动重试", LogLevel.Debug)
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Comp] 下载的文件 json 列表损坏,已自动重试", LogLevel.Debug)
PageLoaderRestart()
End If
End Select
@@ -39,8 +39,7 @@
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Title="Minecraft" Height="40" Margin="0,15,0,0" x:Name="CardMinecraft" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<FrameworkElement Tag="用于折叠" />
<local:MyCard Title="Minecraft" Height="40" Margin="0,15,0,0" x:Name="CardMinecraft">
<Grid x:Name="PanMinecraftInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top">
<Grid.RenderTransform>
<TranslateTransform />
@@ -48,9 +47,18 @@
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<Image x:Name="ImgMinecraft" Margin="0,0,7,0" SnapsToDevicePixels="True" Height="18" RenderOptions.BitmapScalingMode="Linear" />
<TextBlock x:Name="LabMinecraft" VerticalAlignment="Center" TextTrimming="CharacterEllipsis" Grid.Column="1" />
<Path Data="M2,4 l-2,2 10,10 10,-10 -2,-2 -8,8 -8,-8 z" Height="6" Width="10" Stretch="Uniform" VerticalAlignment="Center"
Grid.Column="2" Fill="{StaticResource ColorBrushGray4}" Margin="0,1,6,0" RenderTransformOrigin="0.5,0.5">
<Path.RenderTransform>
<RotateTransform Angle="90" />
</Path.RenderTransform>
</Path>
<TextBlock VerticalAlignment="Center" Text="返回" Grid.Column="3" Foreground="{StaticResource ColorBrushGray4}" />
</Grid>
</local:MyCard>
<local:MyCard Title="OptiFine" Height="40" Margin="0,15,0,0" x:Name="CardOptiFine" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
@@ -38,6 +38,7 @@
If IsInSelectPage Then Exit Sub
IsInSelectPage = True
AutoSelectedFabricApi = False
IsSelectNameEdited = False
PanSelect.Visibility = Visibility.Visible
PanSelect.IsHitTestVisible = True
@@ -873,10 +874,6 @@
OptiFabric_Loaded()
CardFabric.IsSwaped = True
SelectReload()
If Not Setup.Get("HintInstallFabricApi") Then
Setup.Set("HintInstallFabricApi", True)
Hint("安装 Fabric 时通常还需要安装 Fabric API,在选择 Fabric 后就会显示其安装选项!")
End If
End Sub
Private Sub Fabric_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnFabricClear.MouseLeftButtonUp
SelectedFabric = Nothing
@@ -948,6 +945,7 @@
If LoadFabricApiGetError() IsNot Nothing Then e.Handled = True
End Sub
Private AutoSelectedFabricApi As Boolean = False
''' <summary>
''' 尝试重新可视化 FabricApi 版本列表。
''' </summary>
@@ -967,16 +965,19 @@
End If
Next
If Versions.Count = 0 Then Exit Sub
'排序
Versions = Sort(Versions, Function(Left As CompFile, Right As CompFile) As Boolean
Return Left.ReleaseDate > Right.ReleaseDate
End Function)
Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate)
'可视化
PanFabricApi.Children.Clear()
For Each Version In Versions
If Not IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Continue For
PanFabricApi.Children.Add(FabricApiDownloadListItem(Version, AddressOf FabricApi_Selected))
Next
'自动选择 Fabric API
If Not AutoSelectedFabricApi Then
AutoSelectedFabricApi = True
Log($"[Download] 已自动选择 Fabric API:{CType(PanFabricApi.Children(0), MyListItem).Title}")
FabricApi_Selected(PanFabricApi.Children(0), Nothing)
End If
Catch ex As Exception
Log(ex, "可视化 Fabric API 安装版本列表出错", LogLevel.Feedback)
End Try
@@ -1087,7 +1088,7 @@
(Setup.Get("LaunchArgumentIndie") = 0 OrElse Setup.Get("LaunchArgumentIndie") = 2) Then
If MyMsgBox("你尚未开启版本隔离,这会导致多个 MC 共用同一个 Mod 文件夹。" & vbCrLf &
"因此在切换 MC 版本时,MC 会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
"PCL2 推荐你在开始下载前,在 设置 → 版本隔离 中开启版本隔离选项!", "版本隔离提示", "取消下载", "继续") = 1 Then
"PCL 推荐你在开始下载前,在 设置 → 版本隔离 中开启版本隔离选项!", "版本隔离提示", "取消下载", "继续") = 1 Then
Exit Sub
End If
End If
@@ -137,7 +137,7 @@
If Not Setup.Get("HintHandInstall") Then
Setup.Set("HintHandInstall", True)
If MyMsgBox("手动安装包功能提供了 OptiFine、Forge 等组件的 .jar 安装文件下载,但无法自动安装。" & vbCrLf &
"在自动安装页面先选择 MC 版本,然后就可以选择 OptiFine、Forge 等组件,让 PCL2 自动进行安装了。", "自动安装提示", "返回自动安装", "继续下载手动安装包") = 1 Then
"在自动安装页面先选择 MC 版本,然后就可以选择 OptiFine、Forge 等组件,让 PCL 自动进行安装了。", "自动安装提示", "返回自动安装", "继续下载手动安装包") = 1 Then
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.Download}, FormMain.PageSubType.DownloadInstall)
AniControlEnabled -= 1
Exit Sub
@@ -14,8 +14,8 @@
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="70" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="0.9*" />
<ColumnDefinition Width="1.6*" />
<ColumnDefinition Width="1.3*" />
<ColumnDefinition Width="1.2*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
@@ -54,8 +54,9 @@
<local:MyComboBoxItem Content="支持库" Tag="421/library" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="版本" Margin="0,0,25,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320" HintText="全部 (也可自行输入)">
<local:MyComboBoxItem Content="" IsSelected="True" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.3" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.19.1" />
@@ -99,12 +100,14 @@
</local:MyCard>
<local:MyCard Margin="0,15,0,0" x:Name="CardPages" HorizontalAlignment="Center">
<StackPanel Orientation="Horizontal" Height="23" Margin="10,7">
<local:MyIconButton x:Name="BtnPageLeft" IsEnabled="False" Opacity="0.5"
Logo="M671.968176 911.99957c-12.287381 0-24.576482-4.67206-33.951566-14.047144L286.048434 545.984249c-18.751888-18.719204-18.751888-49.12028 0-67.872168L638.016611 126.111222c18.751888-18.751888 49.12028-18.751888 67.872168 0 18.751888 18.719204 18.751888 49.12028 0 67.872168l-318.016611 318.047574L705.888778 830.047574c18.751888 18.751888 18.751888 49.12028 0 67.872168C696.544658 907.32751 684.255557 911.99957 671.968176 911.99957z" />
<local:MyIconButton x:Name="BtnPageFirst" IsEnabled="False" Opacity="0.2" Margin="0,0.5,5,0.5"
Logo="M496.213333 329.856L315.306667 510.848l180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z m298.666667 0l-180.949333 180.992 180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z" />
<local:MyIconButton x:Name="BtnPageLeft" IsEnabled="False" Opacity="0.2" Margin="0,0,5,0"
Logo="M650.752 278.357333l-241.322667 241.365334 241.322667 241.365333a42.666667 42.666667 0 1 1-60.330667 60.330667l-271.530666-271.530667a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.416-27.648l271.530666-271.530666a42.666667 42.666667 0 0 1 60.330667 60.330666z" />
<TextBlock x:Name="LabPage" Text="1"
Margin="7,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight"
Logo="M761.055557 532.128047c0.512619-0.992555 1.343475-1.823411 1.792447-2.848649 8.800538-18.304636 5.919204-40.703346-9.664077-55.424808L399.935923 139.743798c-19.264507-18.208305-49.631179-17.344765-67.872168 1.888778-18.208305 19.264507-17.375729 49.631179 1.888778 67.872168l316.960409 299.839269L335.199677 813.631716c-19.071845 18.399247-19.648112 48.767639-1.247144 67.872168 9.407768 9.791372 21.984142 14.688778 34.560516 14.688778 12.000108 0 24.000215-4.479398 33.311652-13.439914l350.048434-337.375729c0.672598-0.672598 0.927187-1.599785 1.599785-2.303346 0.512619-0.479935 1.056202-0.832576 1.567101-1.343475C757.759656 538.879828 759.199462 535.391265 761.055557 532.128047z" />
Margin="8,0,13,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight" Margin="0,0,30,0"
Logo="M404.309333 278.357333l241.322667 241.365334-241.322667 241.365333a42.666667 42.666667 0 1 0 60.330667 60.330667l271.530667-271.530667a42.453333 42.453333 0 0 0 11.818666-22.613333l0.597334-5.034667v-5.034667a42.496 42.496 0 0 0-12.416-27.648L464.64 218.026667a42.666667 42.666667 0 0 0-60.330667 60.330666z" />
</StackPanel>
</local:MyCard>
</StackPanel>
@@ -15,7 +15,8 @@
If FrmDownloadMod IsNot Nothing AndAlso FrmDownloadMod.IsLoaded Then
With Request
.SearchText = FrmDownloadMod.TextSearchName.Text
.GameVersion = If(FrmDownloadMod.TextSearchVersion.Text.Contains("."), FrmDownloadMod.TextSearchVersion.Text, Nothing)
.GameVersion = If(FrmDownloadMod.TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(FrmDownloadMod.TextSearchVersion.Text.Contains(".") OrElse FrmDownloadMod.TextSearchVersion.Text.Contains("w"), FrmDownloadMod.TextSearchVersion.Text, Nothing))
.Tag = FrmDownloadMod.ComboSearchTag.SelectedItem.Tag
.ModLoader = Val(FrmDownloadMod.ComboSearchLoader.SelectedItem.Tag)
End With
@@ -26,6 +27,7 @@
'结果 UI 化
Private Sub Load_OnFinish()
Try
Log($"[Comp] 开始可视化 Mod 列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
'列表项
PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
@@ -38,11 +40,13 @@
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal,
Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1
BtnPageFirst.IsEnabled = Page > 1
BtnPageFirst.Opacity = If(BtnPageFirst.IsEnabled, 1, 0.2)
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.5)
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.5)
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2)
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
@@ -56,8 +60,8 @@
Case LoadState.Failed
Dim ErrorMessage As String = ""
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 Json 文件") Then
Log("[Download] 下载的 Mod 列表 Json 文件损坏,已自动重试", LogLevel.Debug)
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Download] 下载的 Mod 列表 json 文件损坏,已自动重试", LogLevel.Debug)
PageLoaderRestart()
End If
End Select
@@ -71,6 +75,9 @@
'切换页码
Private Sub BtnPageFirst_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageFirst.Click
ChangePage(0)
End Sub
Private Sub BtnPageLeft_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageLeft.Click
ChangePage(Page - 1)
End Sub
@@ -94,7 +101,7 @@
'搜索按钮
Private Sub StartNewSearch() Handles BtnSearchRun.Click
Page = 0
Storage = New CompProjectStorage
If Loader.ShouldStart(LoaderInput()) Then Storage = New CompProjectStorage '避免连续搜索两次使得 CompProjectStorage 引用丢失(#1311)
Loader.Start()
End Sub
Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp
@@ -104,8 +111,8 @@
'重置按钮
Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click
TextSearchName.Text = ""
TextSearchVersion.Text = "全部 (也可自行输入)"
TextSearchVersion.SelectedIndex = 0
TextSearchVersion.Text = ""
ComboSearchTag.SelectedIndex = 0
ComboSearchLoader.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
@@ -113,13 +120,13 @@
'版本选择
Private Sub TextSearchVersion_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextSearchVersion.TextChanged
If TextSearchVersion.Text = "" Then
If TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w") Then
ComboSearchLoader.Visibility = Visibility.Visible
Grid.SetColumnSpan(TextSearchVersion, 1)
Else
ComboSearchLoader.Visibility = Visibility.Collapsed
Grid.SetColumnSpan(TextSearchVersion, 2)
ComboSearchLoader.SelectedIndex = 0
Else
ComboSearchLoader.Visibility = Visibility.Visible
Grid.SetColumnSpan(TextSearchVersion, 1)
End If
End Sub
@@ -46,8 +46,9 @@
<local:MyComboBoxItem Tag="4482/" Content="大型整合" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="版本" Margin="0,0,25,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" IsEditable="True" MaxDropDownHeight="320" HintText="全部 (也可自行输入)">
<local:MyComboBoxItem Content="" IsSelected="True" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="4" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.3" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.19.1" />
@@ -88,12 +89,14 @@
</local:MyCard>
<local:MyCard Margin="0,15,0,0" x:Name="CardPages" HorizontalAlignment="Center">
<StackPanel Orientation="Horizontal" Height="23" Margin="10,7">
<local:MyIconButton x:Name="BtnPageLeft" IsEnabled="False" Opacity="0.5"
Logo="M671.968176 911.99957c-12.287381 0-24.576482-4.67206-33.951566-14.047144L286.048434 545.984249c-18.751888-18.719204-18.751888-49.12028 0-67.872168L638.016611 126.111222c18.751888-18.751888 49.12028-18.751888 67.872168 0 18.751888 18.719204 18.751888 49.12028 0 67.872168l-318.016611 318.047574L705.888778 830.047574c18.751888 18.751888 18.751888 49.12028 0 67.872168C696.544658 907.32751 684.255557 911.99957 671.968176 911.99957z" />
<local:MyIconButton x:Name="BtnPageFirst" IsEnabled="False" Opacity="0.2" Margin="0,0.5,5,0.5"
Logo="M496.213333 329.856L315.306667 510.848l180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z m298.666667 0l-180.949333 180.992 180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z" />
<local:MyIconButton x:Name="BtnPageLeft" IsEnabled="False" Opacity="0.2" Margin="0,0,5,0"
Logo="M650.752 278.357333l-241.322667 241.365334 241.322667 241.365333a42.666667 42.666667 0 1 1-60.330667 60.330667l-271.530666-271.530667a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.416-27.648l271.530666-271.530666a42.666667 42.666667 0 0 1 60.330667 60.330666z" />
<TextBlock x:Name="LabPage" Text="1"
Margin="7,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight"
Logo="M761.055557 532.128047c0.512619-0.992555 1.343475-1.823411 1.792447-2.848649 8.800538-18.304636 5.919204-40.703346-9.664077-55.424808L399.935923 139.743798c-19.264507-18.208305-49.631179-17.344765-67.872168 1.888778-18.208305 19.264507-17.375729 49.631179 1.888778 67.872168l316.960409 299.839269L335.199677 813.631716c-19.071845 18.399247-19.648112 48.767639-1.247144 67.872168 9.407768 9.791372 21.984142 14.688778 34.560516 14.688778 12.000108 0 24.000215-4.479398 33.311652-13.439914l350.048434-337.375729c0.672598-0.672598 0.927187-1.599785 1.599785-2.303346 0.512619-0.479935 1.056202-0.832576 1.567101-1.343475C757.759656 538.879828 759.199462 535.391265 761.055557 532.128047z" />
Margin="8,0,13,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight" Margin="0,0,30,0"
Logo="M404.309333 278.357333l241.322667 241.365334-241.322667 241.365333a42.666667 42.666667 0 1 0 60.330667 60.330667l271.530667-271.530667a42.453333 42.453333 0 0 0 11.818666-22.613333l0.597334-5.034667v-5.034667a42.496 42.496 0 0 0-12.416-27.648L464.64 218.026667a42.666667 42.666667 0 0 0-60.330667 60.330666z" />
</StackPanel>
</local:MyCard>
</StackPanel>
@@ -15,7 +15,8 @@
If FrmDownloadPack IsNot Nothing AndAlso FrmDownloadPack.IsLoaded Then
With Request
.SearchText = FrmDownloadPack.TextSearchName.Text
.GameVersion = If(FrmDownloadPack.TextSearchVersion.Text.Contains("."), FrmDownloadPack.TextSearchVersion.Text, Nothing)
.GameVersion = If(FrmDownloadPack.TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(FrmDownloadPack.TextSearchVersion.Text.Contains(".") OrElse FrmDownloadPack.TextSearchVersion.Text.Contains("w"), FrmDownloadPack.TextSearchVersion.Text, Nothing))
.Tag = FrmDownloadPack.ComboSearchTag.SelectedItem.Tag
End With
End If
@@ -25,6 +26,7 @@
'结果 UI 化
Private Sub Load_OnFinish()
Try
Log($"[Comp] 开始可视化整合包列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
'列表项
PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
@@ -36,11 +38,13 @@
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal,
Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1
BtnPageFirst.IsEnabled = Page > 1
BtnPageFirst.Opacity = If(BtnPageFirst.IsEnabled, 1, 0.2)
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(BtnPageLeft.IsEnabled, 1, 0.5)
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.5)
BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2)
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
@@ -54,8 +58,8 @@
Case LoadState.Failed
Dim ErrorMessage As String = ""
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 Json 文件") Then
Log("[Download] 下载的整合包列表 Json 文件损坏,已自动重试", LogLevel.Debug)
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Download] 下载的整合包列表 json 文件损坏,已自动重试", LogLevel.Debug)
PageLoaderRestart()
End If
End Select
@@ -69,6 +73,9 @@
'切换页码
Private Sub BtnPageFirst_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageFirst.Click
ChangePage(0)
End Sub
Private Sub BtnPageLeft_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageLeft.Click
ChangePage(Page - 1)
End Sub
@@ -96,7 +103,7 @@
'搜索按钮
Private Sub StartNewSearch() Handles BtnSearchRun.Click
Page = 0
Storage = New CompProjectStorage
If Loader.ShouldStart(LoaderInput()) Then Storage = New CompProjectStorage '避免连续搜索两次使得 CompProjectStorage 引用丢失(#1311)
Loader.Start()
End Sub
Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp
@@ -106,8 +113,8 @@
'重置按钮
Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click
TextSearchName.Text = ""
TextSearchVersion.Text = "全部 (也可自行输入)"
TextSearchVersion.SelectedIndex = 0
TextSearchVersion.Text = ""
ComboSearchTag.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
@@ -17,7 +17,7 @@ Public Class FormLoginOAuth
IsLoginSuccessed = True
RaiseEvent OnLoginSuccess(Code)
ElseIf Url.Contains("github.") Then
Hint("PCL2 不支持使用 GitHub 登录微软账号!", HintType.Critical)
Hint("PCL 不支持使用 GitHub 登录微软账号!", HintType.Critical)
Close()
End If
End Sub
@@ -480,7 +480,7 @@ UseDefault:
End Try
Case 4 '自定义
If Not File.Exists(PathAppdata & "CustomSkin.png") Then
Hint("未找到离线皮肤自定义文件,可能它已被删除。PCL2 将使用默认的 Steve 皮肤!")
Hint("未找到离线皮肤自定义文件,可能它已被删除。PCL 将使用默认的 Steve 皮肤!")
Setup.Set("LaunchSkinType", 1)
GoTo UseDefault
End If
@@ -602,7 +602,7 @@ Finish:
End Sub
'启动按钮
Public Sub LaunchButtonClick() Handles BtnLaunch.Click
If Not BtnLaunch.IsEnabled Then Exit Sub
If McLaunchLoader.State = LoadState.Loading OrElse Not BtnLaunch.IsEnabled Then Exit Sub
'愚人节处理
If IsAprilEnabled AndAlso Not IsAprilGiveup Then
ThemeUnlock(12, False, "隐藏主题 滑稽彩 已解锁!")
@@ -58,7 +58,7 @@
LatestFileLink = Link
LatestFileContent = FileContent
Catch ex As Exception
Log(ex, "获取 PCL2 主页自定义信息失败", LogLevel.Msgbox)
Log(ex, "获取 PCL 主页自定义信息失败", LogLevel.Msgbox)
LatestFileLink = ""
End Try
End Select
@@ -85,7 +85,7 @@
End Sub)
End Sub, "主页自定义刷新")
Catch ex As Exception
Log(ex, "加载 PCL2 主页自定义信息失败", LogLevel.Msgbox)
Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox)
IsRefreshing = False
End Try
End Sub
@@ -4,7 +4,10 @@
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"
mc:Ignorable="d" d:DesignWidth="297.6" Margin="0,0,0,5">
<local:MyComboBox Margin="0,84,0,0" IsEditable="True" x:Name="ComboName" Height="28" IsTextSearchEnabled="False" HintText="游戏用户名" />
<local:MySkin HorizontalAlignment="Center" VerticalAlignment="Top" x:Name="Skin" HasCape="False" />
mc:Ignorable="d" d:DesignWidth="297.6">
<StackPanel Margin="0,0,0,5">
<local:MyHint x:Name="HintChinese" Text="玩家名如果包含英文、数字、下划线以外的内容,可能会无法进入 Minecraft 1.18 以后的世界!" Margin="0,0,0,15" Visibility="Collapsed" />
<local:MySkin HorizontalAlignment="Center" x:Name="Skin" HasCape="False" Margin="0,0,0,15" />
<local:MyComboBox IsEditable="True" x:Name="ComboName" Height="28" IsTextSearchEnabled="False" HintText="游戏用户名" />
</StackPanel>
</Grid>
@@ -1,4 +1,6 @@
Public Class PageLoginLegacy
Imports System.Windows.Forms
Public Class PageLoginLegacy
Public Sub New()
InitializeComponent()
@@ -49,9 +51,17 @@
End Function
Private Sub ComboLegacy_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged
If ComboName.Text.EndsWith(" ") Then
ComboName.Text = ComboName.Text.Trim()
SendKeys.SendWait("{END}")
ElseIf ComboName.Text.StartsWith(" ") Then
ComboName.Text = ComboName.Text.Trim()
SendKeys.SendWait("{HOME}")
End If
If Setup.Get("LaunchSkinType") = 0 Then
PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
End If
HintChinese.Visibility = If(RegexCheck(ComboName.Text, "^[0-9A-Za-z_]*$"), Visibility.Collapsed, Visibility.Visible)
End Sub
Private Sub Skin_Click() Handles Skin.Click
If (Setup.Get("UiHiddenPageSetup") OrElse Setup.Get("UiHiddenSetupLaunch")) AndAlso Not PageSetupUI.HiddenForceShow Then
@@ -65,7 +65,7 @@
Hint("登录失败,无法更改皮肤!", HintType.Critical)
Exit Sub
End If
Dim SkinInfo As McSkinInfo = McSkinSelect(False)
Dim SkinInfo As McSkinInfo = McSkinSelect()
If Not SkinInfo.IsVaild Then Exit Sub
Hint("正在更改皮肤……")
RunInNewThread(Async Sub()
@@ -69,7 +69,7 @@
Hint("登录失败,无法更改皮肤!", HintType.Critical)
Exit Sub
End If
Dim SkinInfo As McSkinInfo = McSkinSelect(False)
Dim SkinInfo As McSkinInfo = McSkinSelect()
If Not SkinInfo.IsVaild Then Exit Sub
Hint("正在更改皮肤……")
IsChanging = True
@@ -8,14 +8,14 @@
<StackPanel Name="PanMain" Margin="25,25,25,10" Grid.IsSharedSizeScope="True">
<local:MyCard Title="关于" Margin="0,0,0,15">
<StackPanel Margin="20,40,18,18">
<TextBlock TextWrapping="Wrap" Text="多人联机服务由速聚授权提供,PCL2 仅为速聚提供多人联机服务入口,使用中遇到的任何问题由速聚负责处理。你在使用多人联机服务过程中所遇到的任何问题与纠纷(包括其付费业务)均与 PCL2 无关,应与速聚协商解决。"
<TextBlock TextWrapping="Wrap" Text="多人联机服务由速聚授权提供,PCL 仅为速聚提供多人联机服务入口,使用中遇到的任何问题由速聚负责处理。你在使用多人联机服务过程中所遇到的任何问题与纠纷(包括其付费业务)均与 PCL 无关,应与速聚协商解决。"
Margin="0,0,0,3" />
<TextBlock TextWrapping="Wrap" Text="PCL2 作者并不会从速聚的付费业务中获得任何分成、奖金等报酬,请不要瞎说。"
<TextBlock TextWrapping="Wrap" Text="PCL 作者并不会从速聚的付费业务中获得任何分成、奖金等报酬,请不要瞎说。"
Margin="0,0,0,6" />
<local:MyListItem Title="速聚官网" Info="打开速聚的官方网站"
Type="Clickable" EventType="打开网页" EventData="https://www.the.bb/zh-CN.html"
PaddingRight="20" Logo="pack://application:,,,/images/Blocks/Grass.png" />
<local:MyListItem Title="授权协议书" Info="查看速聚与 PCL2 间的授权协议书"
<local:MyListItem Title="授权协议书" Info="查看速聚与 PCL 间的授权协议书"
Type="Clickable" EventType="打开网页" EventData="https://shimo.im/docs/0l3NVXYzeXhb903R"
PaddingRight="20" Logo="pack://application:,,,/images/Blocks/Grass.png" />
<local:MyListItem Title="用户协议与隐私政策" Info="查看速聚的用户协议与隐私政策文档"
@@ -98,7 +98,7 @@
'检查协议
If Not Setup.Get("LinkEula") Then
Reopen:
Select Case MyMsgBox("PCL2 的联机服务由速聚授权提供。" & vbCrLf & "在使用前,你需要同意速聚的用户服务协议和隐私政策。", "协议授权", "同意", "拒绝", "查看用户服务协议和隐私政策")
Select Case MyMsgBox("PCL 的联机服务由速聚授权提供。" & vbCrLf & "在使用前,你需要同意速聚的用户服务协议和隐私政策。", "协议授权", "同意", "拒绝", "查看用户服务协议和隐私政策")
Case 1
Setup.Set("LinkEula", True)
Case 2
@@ -124,7 +124,7 @@ Reopen:
End If
'没有联网
If IpCheckStatus = LoadState.Failed AndAlso PingTime = -1 Then
Throw New Exception("$PCL2 没法连上网……" & vbCrLf & "如果你改变了网络环境,请重启 PCL2。")
Throw New Exception("$PCL 没法连上网……" & vbCrLf & "如果你改变了网络环境,请重启 PCL。")
End If
End Sub
@@ -387,6 +387,7 @@ FinishMcbFileCheck:
''' 若程序正在运行,则结束程序进程,同时初始化状态数据。返回是否关闭了相关进程。
''' </summary>
Public Shared Function HiperStop(SleepWhenKilled As Boolean) As Boolean
Return False
HiperStop = False
'修改凭证
Dim ConfigContent As String = ReadFile(PathHiper & "config.yml")
@@ -484,7 +485,7 @@ FinishMcbFileCheck:
.FileName = PathHiper & "MCB 联机模块.exe", .WorkingDirectory = PathHiper,
.UseShellExecute = False, .CreateNoWindow = True,
.RedirectStandardError = True, .RedirectStandardOutput = True,
.Arguments = "-addr " & HostIp & ":" & HostPort & " -motd ""PCL2 联机房间"""
.Arguments = "-addr " & HostIp & ":" & HostPort & " -motd ""PCL 联机房间"""
}
Dim McbProcess As New Process() With {.StartInfo = McbInfo}
McbProcess.Start()
@@ -754,7 +755,7 @@ FinishMcbFileCheck:
' Exit Sub
'WrongCode:
' If Not Code.StartsWith("P") AndAlso Code.Length >= 49 Then Hint("你输入的可能是 IOI 的联机码,请在左侧的联机方式中选择 IOI!", HintType.Critical) : Exit Sub
' If Code.StartsWith("P") AndAlso Not Code.EndsWith(RequestVersion) Then Hint("你的 PCL2 版本与房主的 PCL2 版本不一致!", HintType.Critical) : Exit Sub
' If Code.StartsWith("P") AndAlso Not Code.EndsWith(RequestVersion) Then Hint("你的 PCL 版本与房主的 PCL 版本不一致!", HintType.Critical) : Exit Sub
' Hint("你输入的联机码无效!", HintType.Critical)
End Sub
Private Sub RoomJoin(Ip As String, Port As Integer)
@@ -51,7 +51,7 @@ Public Class PageLinkIoi
'检查协议
If Not Setup.Get("LinkEula") Then
Reopen:
Select Case MyMsgBox("PCL2 的联机服务由速聚授权提供。" & vbCrLf & "在使用前,你需要同意速聚的用户服务协议和隐私政策。", "协议授权", "同意", "拒绝", "查看用户服务协议和隐私政策")
Select Case MyMsgBox("PCL 的联机服务由速聚授权提供。" & vbCrLf & "在使用前,你需要同意速聚的用户服务协议和隐私政策。", "协议授权", "同意", "拒绝", "查看用户服务协议和隐私政策")
Case 1
Setup.Set("LinkEula", True)
Case 2
@@ -164,9 +164,9 @@ StartDownload:
If Not PageLinkLeft.FirewallIsBlock(PathIoi) Then Exit Try
If PageLinkLeft.FirewallPolicy.CurrentProfile.ExceptionsNotAllowed Then
'禁止白名单
MyMsgBox("由于 Windows 防火墙阻止了所有传入连接,PCL2 无法获取防火墙通行权限。" & vbCrLf &
MyMsgBox("由于 Windows 防火墙阻止了所有传入连接,PCL 无法获取防火墙通行权限。" & vbCrLf &
"联机会有很大概率失败,就算连上了,延迟也会变高……" & vbCrLf & vbCrLf &
"请先关闭 Windows 防火墙中的 " & vbLQ & "阻止所有传入连接" & vbRQ & " 选项,然后重启 PCL2。", "遭到防火墙拦截")
"请先关闭 Windows 防火墙中的 " & vbLQ & "阻止所有传入连接" & vbRQ & " 选项,然后重启 PCL。", "遭到防火墙拦截")
ElseIf IsAdmin() Then
'有管理员权限
Log("[IOI] Windows 防火墙:尝试添加防火墙通行权限")
@@ -177,14 +177,14 @@ StartDownload:
End Try
Else
'无管理员权限
If MyMsgBox("由于你开启了 Windows 防火墙,PCL2 需要获取防火墙通行权限。" & vbCrLf & vbCrLf &
"若继续,PCL2 将尝试以管理员权限重新启动。" & vbCrLf &
If MyMsgBox("由于你开启了 Windows 防火墙,PCL 需要获取防火墙通行权限。" & vbCrLf & vbCrLf &
"若继续,PCL 将尝试以管理员权限重新启动。" & vbCrLf &
"若拒绝,联机模块可能会被防火墙拦截,联机会有很大概率失败。", "需要管理员权限", "继续", "拒绝") = 1 Then
Log("[IOI] Windows 防火墙:尝试提升权限")
If RerunAsAdmin("--link ioi") Then
FrmMain.EndProgram(False) '已重新运行
Else
Hint("获取管理员权限失败,请尝试右键 PCL2,选择 " & vbLQ & "以管理员身份运行" & vbRQ & ",然后再进入联机页面!", HintType.Critical)
Hint("获取管理员权限失败,请尝试右键 PCL,选择 " & vbLQ & "以管理员身份运行" & vbRQ & ",然后再进入联机页面!", HintType.Critical)
End If
Else
Hint("在没有防火墙权限的情况下尝试联机,很可能会导致联机失败!", HintType.Critical)
@@ -1049,11 +1049,11 @@ Done:
SendPortsubRequest(User)
User.Progress = 0.9
If TargetVersion > RequestVersion Then
SendDisconnectRequest(User, "无法连接到 " & GetPlayerName() & ":对方的 PCL2 版本过低!", True)
Throw New InvalidOperationException("你的 PCL2 版本过低!")
SendDisconnectRequest(User, "无法连接到 " & GetPlayerName() & ":对方的 PCL 版本过低!", True)
Throw New InvalidOperationException("你的 PCL 版本过低!")
ElseIf TargetVersion < RequestVersion Then
SendDisconnectRequest(User, "无法连接到 " & GetPlayerName() & ":你的 PCL2 版本过低!", True)
Throw New InvalidOperationException("对方的 PCL2 版本过低!")
SendDisconnectRequest(User, "无法连接到 " & GetPlayerName() & ":你的 PCL 版本过低!", True)
Throw New InvalidOperationException("对方的 PCL 版本过低!")
Else
SendUpdateRequest(User, 1)
User.Progress = 1
@@ -213,17 +213,20 @@
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
Select Case MyMsgBox("你确定要删除版本 " & Version.Name & " 吗?" &
Select Case MyMsgBox($"你确定要{If(IsShiftPressed, "永久", "")}删除版本 {Version.Name} 吗?" &
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""),
"版本删除确认", , "取消",, True)
Case 1
FileIO.FileSystem.DeleteDirectory(Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & Version.Name & " 已删除到回收站!", HintType.Finish)
If IsShiftPressed Then
DeleteDirectory(Version.Path)
Hint("版本 " & Version.Name & " 已永久删除!", HintType.Finish)
Else
FileIO.FileSystem.DeleteDirectory(Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & Version.Name & " 已删除到回收站!", HintType.Finish)
End If
Case 2
' DeleteDirectory(Version.Path)
' Hint("版本 " & Version.Name & " 已永久删除!", HintType.Finish)
'Case 3
Exit Sub
End Select
'从 UI 中移除
@@ -9,6 +9,7 @@
<StackPanel x:Name="PanMain" Margin="25,10">
<local:MyCard x:Name="CardSkin" Margin="0,15" Title="离线皮肤">
<StackPanel Margin="25,40,25,15">
<local:MyHint Text="由于技术问题,皮肤预览与 Steve/Alex/自定义 选项暂时仅保证对 1.19.2 以前的版本有效!" IsWarn="False" Margin="0,0,0,10" />
<Grid Margin="-1,0,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition />
@@ -144,7 +145,7 @@
</local:MyTextBox>
</Grid>
<TextBlock VerticalAlignment="Center" Grid.Row="12" HorizontalAlignment="Left" Text="游戏 Java" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboArgumentJava" Grid.ColumnSpan="2" Grid.Row="12" Grid.Column="1" ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹,在进行自动选择时 PCL2 会尽量优先选择它">
<local:MyComboBox x:Name="ComboArgumentJava" Grid.ColumnSpan="2" Grid.Row="12" Grid.Column="1" ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹,在进行自动选择时 PCL 会尽量优先选择它">
<ComboBoxItem Content="加载中……" IsSelected="True" />
<!--<local:MyComboBoxItem Content="Java 8 (1.8.0_171),64 位:C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" IsSelected="True" ToolTip="C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" />-->
</local:MyComboBox>
@@ -220,13 +221,21 @@
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数" Margin="0,0,25,0" />
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数头" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" Text="-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="额外参数" Margin="0,0,25,0" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数尾" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如输入 --demo 则会以试玩模式启动游戏。" />
<StackPanel Margin="0,12,0,4" Orientation="Horizontal" Grid.Row="3" Grid.ColumnSpan="2">
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="4" Grid.ColumnSpan="2" Tag="LaunchAdvanceRun" Grid.Column="1" HintText=""
ToolTip="在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;可以使用以下替换标记实现相对路径(路径均以 \ 结尾):&#xa; · {path}:PCL 的 exe 文件所在的文件夹&#xa; · {minecraft}:.minecraft 文件夹&#xa; · {verpath}:版本文件夹(.minecraft\versions\版本名\)&#xa; · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹&#xa; · {java}:游戏运行时的 Java 文件夹&#xa;&#xa;除此之外,也支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {uuid}:玩家的 UUID&#xa; · {name}:游戏版本名&#xa; · {time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号&#xa;&#xa;例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}option.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。" />
<local:MyCheckBox Grid.Row="5" Grid.Column="1" x:Name="CheckAdvanceRunWait" Tag="LaunchAdvanceRunWait" Visibility="Collapsed"
Text="等待命令执行完成后再继续启动" Margin="0,8,0,7" />
<StackPanel Margin="0,12,0,4" Orientation="Horizontal" Grid.Row="6" Grid.ColumnSpan="2">
<local:MyCheckBox Text="忽略 Java 兼容性警告" x:Name="CheckAdvanceJava" Tag="LaunchAdvanceJava" Margin="0,0,60,0"
ToolTip="如果在设置中手动选择了与当前版本不兼容的 Java,则自动跳过兼容性警告弹窗,强制使用手动选择的 Java。" />
<local:MyCheckBox Text="关闭文件校验" x:Name="CheckAdvanceAssets" Tag="LaunchAdvanceAssets"
@@ -47,6 +47,8 @@
'高级设置
TextAdvanceJvm.Text = Setup.Get("LaunchAdvanceJvm")
TextAdvanceGame.Text = Setup.Get("LaunchAdvanceGame")
TextAdvanceRun.Text = Setup.Get("LaunchAdvanceRun")
CheckAdvanceRunWait.Checked = Setup.Get("LaunchAdvanceRunWait")
CheckAdvanceAssets.Checked = Setup.Get("LaunchAdvanceAssets")
CheckAdvanceJava.Checked = Setup.Get("LaunchAdvanceJava")
@@ -77,6 +79,8 @@
Setup.Reset("LaunchAdvanceGame")
Setup.Reset("LaunchAdvanceJava")
Setup.Reset("LaunchAdvanceAssets")
Setup.Reset("LaunchAdvanceRun")
Setup.Reset("LaunchAdvanceRunWait")
Setup.Reset("LaunchArgumentJavaAll")
Setup.Reset("LaunchArgumentJavaSelect")
@@ -95,7 +99,7 @@
Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioSkinType0.Check, RadioSkinType1.Check, RadioSkinType2.Check, RadioSkinType3.Check, RadioSkinType4.Check, RadioRamType0.Check, RadioRamType1.Check
If AniControlEnabled = 0 Then Setup.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1)))
End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSkinID.ValidatedTextChanged, TextArgumentWindowHeight.ValidatedTextChanged, TextArgumentWindowWidth.ValidatedTextChanged, TextArgumentInfo.ValidatedTextChanged, TextAdvanceGame.ValidatedTextChanged, TextAdvanceJvm.ValidatedTextChanged, TextArgumentTitle.ValidatedTextChanged
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSkinID.ValidatedTextChanged, TextArgumentWindowHeight.ValidatedTextChanged, TextArgumentWindowWidth.ValidatedTextChanged, TextArgumentInfo.ValidatedTextChanged, TextAdvanceGame.ValidatedTextChanged, TextAdvanceJvm.ValidatedTextChanged, TextArgumentTitle.ValidatedTextChanged, TextAdvanceRun.ValidatedTextChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text)
End Sub
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change
@@ -104,53 +108,58 @@
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged, ComboArgumentVisibie.SelectionChanged, ComboArgumentWindowType.SelectionChanged, ComboArgumentPriority.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change, CheckAdvanceJava.Change
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change, CheckAdvanceJava.Change, CheckAdvanceRunWait.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub
#Region "离线皮肤"
Private Sub BtnSkinChange_Click(sender As Object, e As EventArgs) Handles BtnSkinChange.Click
Dim SkinInfo As McSkinInfo = McSkinSelect(True)
Dim SkinInfo As McSkinInfo = McSkinSelect()
If Not SkinInfo.IsVaild Then Exit Sub
'设置文件
Try
'拷贝文件
File.Delete(PathAppdata & "CustomSkin.png")
CopyFile(SkinInfo.LocalFile, PathAppdata & "CustomSkin.png")
'更新设置
Setup.Set("LaunchSkinSlim", SkinInfo.IsSlim)
Catch ex As Exception
Log(ex, "设置离线皮肤失败", LogLevel.Msgbox)
Finally
'设置当前显示
PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
End Try
ChangeSkin(SkinInfo)
End Sub
Private Sub RadioSkinType3_Check(sender As Object, e As RouteEventArgs) Handles RadioSkinType4.PreviewCheck
If Not (AniControlEnabled = 0 AndAlso e.RaiseByMouse) Then Exit Sub
'已有图片则不再选择
If File.Exists(PathAppdata & "CustomSkin.png") Then Exit Sub
'没有图片则要求选择
Dim SkinInfo As McSkinInfo = McSkinSelect()
If Not SkinInfo.IsVaild Then
e.Handled = True
Exit Sub
End If
'正式改变
If Not ChangeSkin(SkinInfo) Then e.Handled = True
End Sub
'返回是否成功改变
Private Function ChangeSkin(SkinInfo As McSkinInfo) As Boolean
Try
'已有图片则不再选择
If File.Exists(PathAppdata & "CustomSkin.png") Then Exit Sub
'没有图片则要求选择
Dim SkinInfo As McSkinInfo = McSkinSelect(True)
If Not SkinInfo.IsVaild Then
e.Handled = True
Exit Sub
End If
'拷贝文件
File.Delete(PathAppdata & "CustomSkin.png")
CopyFile(SkinInfo.LocalFile, PathAppdata & "CustomSkin.png")
'将单层皮肤扩展到双层
Dim Bitmap As New MyBitmap(PathAppdata & "CustomSkin.png")
If Bitmap.Pic.Width = 64 AndAlso Bitmap.Pic.Height = 32 Then
Dim Img As System.Drawing.Image = Bitmap
Dim NewBitmap As New System.Drawing.Bitmap(64, 64)
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(NewBitmap)
g.DrawImageUnscaled(Img, New System.Drawing.Point(0, 0))
End Using
File.Delete(PathAppdata & "CustomSkin.png")
NewBitmap.Save(PathAppdata & "CustomSkin.png")
End If
'更新设置
Setup.Set("LaunchSkinSlim", SkinInfo.IsSlim)
ChangeSkin = True
Catch ex As Exception
Log(ex, "设置离线皮肤失败", LogLevel.Msgbox)
e.Handled = True
Log(ex, "改变离线皮肤失败", LogLevel.Msgbox)
ChangeSkin = False
Finally
'设置当前显示
PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
End Try
End Sub
End Function
Private Sub BtnSkinDelete_Click(sender As Object, e As EventArgs) Handles BtnSkinDelete.Click
Try
File.Delete(PathAppdata & "CustomSkin.png")
@@ -552,4 +561,12 @@ PreFin:
#End Region
#Region "高级设置"
Private Sub TextAdvanceRun_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextAdvanceRun.TextChanged
CheckAdvanceRunWait.Visibility = If(TextAdvanceRun.Text = "", Visibility.Collapsed, Visibility.Visible)
End Sub
#End Region
End Class
@@ -102,7 +102,7 @@
<local:MyComboBoxItem Content="关闭所有公告" />
</local:MyComboBox>
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="缓存文件夹" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextSystemCache" Grid.Row="4" Grid.ColumnSpan="2" Tag="SystemSystemCache" Grid.Column="1" ToolTip="PCL2 的下载、皮肤等缓存文件的存储位置。&#xa;不推荐路径中带有空格。&#xa;留空即为默认值,重启 PCL2 后生效。" HintText="默认">
<local:MyTextBox x:Name="TextSystemCache" Grid.Row="4" Grid.ColumnSpan="2" Tag="SystemSystemCache" Grid.Column="1" ToolTip="PCL 的下载、皮肤等缓存文件的存储位置。&#xa;不推荐路径中带有空格。&#xa;留空即为默认值,重启 PCL 后生效。" HintText="默认">
<local:MyTextBox.ValidateRules>
<local:ValidateNullable />
<local:ValidateFolderPath UseMinecraftCharCheck="False" />
@@ -111,10 +111,8 @@
<Grid Height="35" Grid.Row="6" Grid.ColumnSpan="5" Margin="0,5,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnSystemUpdate" MinWidth="140" Text="检查更新" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton x:Name="BtnSystemCacheClear" MinWidth="140" Text="清理缓存" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" />
</Grid>
</Grid>
</local:MyCard>
@@ -154,65 +154,6 @@
If AniControlEnabled = 0 Then Hint("部分调试信息将在刷新或启动器重启后切换显示!",, False)
End Sub
'清理缓存
Private IsClearingCache As Boolean = False
Private Sub BtnSystemCacheClear_Click(sender As Object, e As EventArgs) Handles BtnSystemCacheClear.Click
If HasDownloadingTask() Then
Hint("请在所有下载任务完成后再清理缓存!", HintType.Critical)
Exit Sub
End If
If PathTemp = IO.Path.GetTempPath() & "PCL\" Then
If MyMsgBox("你确定要清理缓存吗?" & vbCrLf & "在清理缓存后,PCL2 会被强制关闭,以避免缓存缺失带来的异常。", "清理确认", "确定", "取消") = 2 Then
Exit Sub
End If
Else
If MyMsgBox("你已将缓存文件夹手动修改为:" & PathTemp & vbCrLf &
"清理缓存将删除你所设置的这一文件夹中的所有内容,且无法恢复!" & vbCrLf &
"请在继续前,确认其中没有除了 PCL2 缓存以外的重要文件!" & vbCrLf & vbCrLf &
"在清理缓存后,PCL2 会被强制关闭,以避免缓存缺失带来的异常。", "清理确认", "永久删除该文件夹", "取消", IsWarn:=True) = 2 Then
Exit Sub
End If
End If
If IsClearingCache Then Exit Sub
IsClearingCache = True
Try
Dim TotalSize As ULong = DeleteCacheDirectory(PathTemp)
DeleteDirectory(PathTemp, True)
TotalSize += DeleteCacheDirectory(OsDrive & "ProgramData\PCL\")
DeleteDirectory(OsDrive & "ProgramData\PCL\", True)
If TotalSize <= 0 Then
Hint("没有可清理的缓存!")
Else
MyMsgBox("已清理 " & GetString(TotalSize) & " 缓存!" & vbCrLf & "PCL2 即将自动关闭。", "缓存已清理", ForceWait:=True)
FrmMain.EndProgram(False)
End If
Catch ex As Exception
Log(ex, "清理缓存失败", LogLevel.Hint)
Finally
IsClearingCache = False
End Try
End Sub
Private Function DeleteCacheDirectory(Path As String, Optional TotalSize As ULong = 0) As ULong
If Not Directory.Exists(Path) Then Return TotalSize
Dim Temp As String()
Temp = Directory.GetFiles(Path)
For Each str As String In Temp
Try
Dim Info As New FileInfo(str)
Dim FileActualSize = Math.Ceiling(Info.Length / 4096) * 4096
Info.Delete()
TotalSize += FileActualSize
Catch ex As Exception
Log(ex, "删除失败的缓存文件(" & str & ")")
End Try
Next
Temp = Directory.GetDirectories(Path)
For Each str As String In Temp
TotalSize += DeleteCacheDirectory(str)
Next
Return TotalSize
End Function
'自动更新
Private Sub ComboSystemActivity_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemActivity.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
@@ -39,7 +39,7 @@
<StackPanel Margin="20,17">
<TextBlock Margin="0,0,0,9" HorizontalAlignment="Center" Text="未找到 Mod" FontSize="19" UseLayoutRounding="True" SnapsToDevicePixels="True" Foreground="{DynamicResource ColorBrush3}" />
<Rectangle HorizontalAlignment="Stretch" Height="2" Fill="{DynamicResource ColorBrush3}" />
<TextBlock Margin="10,15,10,0" Text="要安装 Mod,请直接将 Mod 文件拖入 PCL2 窗口。&#xa;如果你确定你已经安装了 Mod,但仍然看到了这条提示,那么你的版本隔离设置可能有误。请尝试在启动设置中调整版本隔离选项。" TextWrapping="Wrap" />
<TextBlock Margin="10,15,10,0" Text="要安装 Mod,请直接将 Mod 文件拖入 PCL 窗口。&#xa;如果你确定你已经安装了 Mod,但仍然看到了这条提示,那么你的版本隔离设置可能有误。请尝试在启动设置中调整版本隔离选项。" TextWrapping="Wrap" />
<local:MyButton Height="35" HorizontalAlignment="Center" x:Name="BtnHintOpen" MinWidth="140" Text="打开 Mod 文件夹" Margin="0,15,0,0" Padding="13,0" ColorType="Highlight" />
</StackPanel>
</local:MyCard>
@@ -308,6 +308,7 @@
Public Sub Delete_Click(sender As MyIconButton, e As EventArgs)
Try
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim ListItem As MyListItem = sender.Tag
Dim ModEntity As McMod = ListItem.Tag
'前置检测警告
@@ -316,7 +317,11 @@
End If
'删除
If File.Exists(ModEntity.Path) Then
My.Computer.FileSystem.DeleteFile(ModEntity.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
If IsShiftPressed Then
File.Delete(ModEntity.Path)
Else
My.Computer.FileSystem.DeleteFile(ModEntity.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
Else
'在不明原因下删除的文件可能还在列表里,如果玩家又点了一次就会出错,总之加个判断也不碍事
Log("[System] 需要删除的 Mod 文件不存在(" & ModEntity.Path & ")", LogLevel.Hint)
@@ -333,7 +338,11 @@
CType(Parent.Parent, MyCard).Title = McModGetTitle(McModLoader.Output)
End If
'显示提示
Hint("已将 " & ModEntity.FileName & " 删除到回收站!", HintType.Finish)
If IsShiftPressed Then
Hint("已删除 " & ModEntity.FileName & "!", HintType.Finish)
Else
Hint("已将 " & ModEntity.FileName & " 删除到回收站!", HintType.Finish)
End If
LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.UpdateOnly)
Catch ex As Exception
@@ -92,7 +92,7 @@
Private Sub BtnDisplayDesc_Click(sender As Object, e As EventArgs) Handles BtnDisplayDesc.Click
Try
Dim OldInfo As String = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "CustomInfo")
Dim NewInfo As String = MyMsgBoxInput("更改描述", "修改版本的描述文本,留空则使用 PCL2 的默认描述。", OldInfo, New ObjectModel.Collection(Of Validate), "默认描述")
Dim NewInfo As String = MyMsgBoxInput("更改描述", "修改版本的描述文本,留空则使用 PCL 的默认描述。", OldInfo, New ObjectModel.Collection(Of Validate), "默认描述")
If NewInfo IsNot Nothing AndAlso OldInfo <> NewInfo Then WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "CustomInfo", NewInfo)
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load()
Reload()
@@ -121,7 +121,7 @@
Try
JsonObject = GetJson(ReadFile(PageVersionLeft.Version.Path & PageVersionLeft.Version.Name & ".json"))
Catch ex As Exception
Log(ex, "重命名读取 Json 时失败")
Log(ex, "重命名读取 json 时失败")
JsonObject = PageVersionLeft.Version.JsonObject
End Try
'重命名主文件夹
@@ -162,7 +162,7 @@
JsonObject("id") = NewName
WriteFile(NewPath & NewName & ".json", JsonObject.ToString)
Catch ex As Exception
Log(ex, "重命名 Json 时失败")
Log(ex, "重命名版本 json 失败")
End Try
End If
'刷新与提示
@@ -315,17 +315,20 @@
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
Select Case MyMsgBox("你确定要删除版本 " & PageVersionLeft.Version.Name & " 吗?" &
Select Case MyMsgBox($"你确定要{If(IsShiftPressed, "永久", "")}删除版本 {PageVersionLeft.Version.Name} 吗?" &
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""),
"版本删除确认", , "取消",, True)
"版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed)
Case 1
FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站!", HintType.Finish)
If IsShiftPressed Then
DeleteDirectory(PageVersionLeft.Version.Path)
Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除!", HintType.Finish)
Else
FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站!", HintType.Finish)
End If
Case 2
' DeleteDirectory(PageVersionLeft.Version.Path)
' Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除!", HintType.Finish)
'Case 3
Exit Sub
End Select
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
@@ -47,7 +47,7 @@
<local:MyComboBoxItem Content="关闭" ToolTip="与其余未开启隔离的版本均使用同一档案,存档、Mod 等均为公用。&#xa;若存在不同版本的 Forge 或 Fabric,可能会由于 Mod 与版本冲突导致未知问题。" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="6" HorizontalAlignment="Left" Text="游戏 Java" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboArgumentJava" Grid.ColumnSpan="2" Grid.Row="6" Grid.Column="1" ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹,在进行自动选择时 PCL2 会尽量优先选择它">
<local:MyComboBox x:Name="ComboArgumentJava" Grid.ColumnSpan="2" Grid.Row="6" Grid.Column="1" ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹,在进行自动选择时 PCL 会尽量优先选择它">
<ComboBoxItem Content="加载中……" IsSelected="True" />
<!--<local:MyComboBoxItem Content="Java 8 (1.8.0_171),64 位:C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" IsSelected="True" ToolTip="C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" />-->
</local:MyComboBox>
@@ -190,9 +190,9 @@
<RowDefinition Height="31" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数" Margin="0,0,25,0" />
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数头" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;若留空,则使用全局设置的值。" HintText="使用全局设置" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="额外参数" Margin="0,0,25,0" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数尾" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="VersionAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如输入 --demo 则会以试玩模式启动游戏。&#xa;若留空,则使用全局设置的值。" HintText="使用全局设置" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="文件校验" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboAdvanceAssets" Grid.Row="4" Grid.ColumnSpan="2" Tag="VersionAdvanceAssets" Grid.Column="1">
@@ -202,7 +202,7 @@
</local:MyComboBox>
<TextBlock Grid.Row="6" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,3" />
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="6" Grid.ColumnSpan="2" Tag="VersionAdvanceRun" Grid.Column="1" HintText="" Margin="0,0,0,3"
ToolTip="在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;可以使用以下替换标记实现相对路径(路径均以 \ 结尾):&#xa; · {path}:PCL 的 exe 文件所在的文件夹&#xa; · {minecraft}:.minecraft 文件夹&#xa; · {verpath}:版本文件夹(.minecraft\versions\版本名\)&#xa; · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹&#xa; · {java}:游戏运行时的 Java 文件夹&#xa;&#xa;除此之外,也支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {uuid}:玩家的 UUID&#xa; · {name}:游戏版本名&#xa; · {time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号&#xa;&#xa;例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}option.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。" />
ToolTip="该项不会覆盖全局设置:启动时会先执行全局设置的命令,再执行版本设置的命令。&#xa;在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;可以使用以下替换标记实现相对路径(路径均以 \ 结尾):&#xa; · {path}:PCL 的 exe 文件所在的文件夹&#xa; · {minecraft}:.minecraft 文件夹&#xa; · {verpath}:版本文件夹(.minecraft\versions\版本名\)&#xa; · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹&#xa; · {java}:游戏运行时的 Java 文件夹&#xa;&#xa;除此之外,也支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {uuid}:玩家的 UUID&#xa; · {name}:游戏版本名&#xa; · {time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号&#xa;&#xa;例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}option.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。" />
<local:MyCheckBox Grid.Row="7" Grid.Column="1" x:Name="CheckAdvanceRunWait" Tag="VersionAdvanceRunWait" Visibility="Collapsed"
Text="等待命令执行完成后再继续启动" Margin="0,5,0,0" />
</Grid>
+7 -7
View File
@@ -1,6 +1,6 @@

<!-- 这是 PCL2 的主页自定义文件。你可以通过修改这个文件来自定义 PCL2 主页:添加文本、打开网页、启动游戏,等等。
如果你倒腾这个文件把 PCL2 玩炸了,把这个文件直接删除就行了。
<!-- 这是 PCL 的主页自定义文件。你可以通过修改这个文件来自定义 PCL 主页:添加文本、打开网页、启动游戏,等等。
如果你倒腾这个文件把 PCL 玩炸了,把这个文件直接删除就行了。
如果你懂得 WPF 的布局文件编写,你甚至可以做出不少的新玩意儿…… -->
<local:MyCard Title="基础教学 1:纯文本">
@@ -84,13 +84,13 @@
<TextBlock Margin="0,4,0,0"
Text="如果能在 PCL 文件夹中找到该文件,则会优先打开 PCL 文件夹中的文件。当然,你可以使用例如 C:\ 开头的绝对路径。" />
<TextBlock TextWrapping="Wrap"
Text="此外,PCL2 会将文件中的花括号 path 替换为 PCL 可执行文件所在文件夹({path}),可以用于执行特定程序或加载图片。" />
Text="此外,PCL 会将文件中的花括号 path 替换为 PCL 可执行文件所在文件夹({path}),可以用于执行特定程序或加载图片。" />
<local:MyButton Margin="0,8,0,8" Width="200" Height="35"
Text="打开 PCL 日志" EventType="打开文件" EventData="Log1.txt" ToolTip="PCL2 的日志文件就在 PCL 文件夹内,且名为 Log1.txt" />
Text="打开 PCL 日志" EventType="打开文件" EventData="Log1.txt" ToolTip="PCL 的日志文件就在 PCL 文件夹内,且名为 Log1.txt" />
<TextBlock Margin="0,4,0,0"
Text="就像为游戏指定服务器 IP 一样,你也可以在 EventData 的竖线后为程序添加启动参数。" />
<local:MyButton Margin="0,8,0,0" Width="200" Height="35"
Text="定位游戏启动脚本" EventType="打开文件" EventData="explorer.exe|/select,LatestLaunch.bat" ToolTip="PCL2 会将上一次启动 MC 的脚本保存在 PCL 文件夹内,且名为 LatestLaunch.bat。&#xa;点击按钮会打开文件管理器,并且借助参数要求它选中这个文件。" />
Text="定位游戏启动脚本" EventType="打开文件" EventData="explorer.exe|/select,LatestLaunch.bat" ToolTip="PCL 会将上一次启动 MC 的脚本保存在 PCL 文件夹内,且名为 LatestLaunch.bat。&#xa;点击按钮会打开文件管理器,并且借助参数要求它选中这个文件。" />
</StackPanel>
</local:MyCard>
@@ -162,7 +162,7 @@
<local:MyCard Title="高级:预置图片和列表项" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,23,15">
<TextBlock TextWrapping="Wrap" LineHeight="17"
Text="PCL2 中包含一些预置的方块与物品图片,可以直接使用。"/>
Text="PCL 中包含一些预置的方块与物品图片,可以直接使用。"/>
<StackPanel Orientation="Horizontal">
<Image Width="30" Height="30" Margin="15,15,0,15" Source="pack://application:,,,/images/Blocks/CommandBlock.png"/>
<!-- 命令方块 -->
@@ -203,7 +203,7 @@
- Width、Height:设置宽度与高度
- ToolTip:设置鼠标指向时的提示文本
- Foreground:调整前景颜色(十六进制字符串,例如 #FF010203 代表 ARGB 中的 255,1,2,3。前两位代表不透明度,FF 为全不透明,00 为全透明)
- Background:调整背景颜色(使用类似 Background="{DynamicResource ColorBrush5}" 的格式以调用 PCL2 当前的主题颜色,修改末尾的数字编号以改变颜色浓度)
- Background:调整背景颜色(使用类似 Background="{DynamicResource ColorBrush5}" 的格式以调用 PCL 当前的主题颜色,修改末尾的数字编号以改变颜色浓度)
- Margin:调整外边距(格式为 左,上,右,下。例如 Margin="0,0,0,2" 即为 2 单位的下边距)
- HorizontalAlignment:设置对齐方式(Left、Center、Right)
Binary file not shown.