InfStarMC/PCL-ISE
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

2.4.6

Browse Source
This commit is contained in:
龙腾猫跃
2023-01-26 01:50:52 +08:00
parent 45a9bf1096
commit 06b50fa74c
29 changed files with 317 additions and 169 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Controls/MyListItem.xaml.vb
+1 -2
View File
@@ -461,8 +461,8 @@
AniStart(Anim, "MyListItem Checked " & Uuid)
Else
'不使用动画
AniStop("MyListItem Checked " & Uuid)
If Checked Then
'If Not IsNothing(RectCheck) Then RectCheck.Width = 4
If Not IsNothing(RectCheck) Then
RectCheck.Height = Double.NaN
RectCheck.Margin = New Thickness(-1, 6, 0, 6)
@@ -471,7 +471,6 @@
End If
SetResourceReference(ForegroundProperty, "ColorBrush3")
Else
'If Not IsNothing(RectCheck) Then RectCheck.Width = 0
If Not IsNothing(RectCheck) Then
RectCheck.Height = 0
RectCheck.Margin = New Thickness(-1, 0, 0, 0)
Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb
+2
View File
@@ -223,6 +223,8 @@
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
Else
AniStop("MyRadioBox BorderColor " & Uuid)
AniStop("MyRadioBox TextColor " & Uuid)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"))
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
Plain Craft Launcher 2/FormMain.xaml
+1 -1
View File
@@ -4,7 +4,7 @@
xmlns:local="clr-namespace:PCL"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d"
x:Name="WindMain" x:Class="FormMain" Style="{StaticResource MyWindow}"
AllowDrop="True" Topmost="True" Title="Plain Craft Launcher 2　" AllowsTransparency="True" MinHeight="470" MinWidth="780" ScrollViewer.VerticalScrollBarVisibility="Disabled" Icon="/Plain Craft Launcher 2;component/Images/icon.ico" Left="-10000" WindowStyle="None" ResizeMode="CanMinimize" Background="{x:Null}" d:DesignWidth="870" d:DesignHeight="520" Width="850" Height="500" RenderTransformOrigin="0.5,0.5">
AllowDrop="True" Topmost="True" Title="Plain Craft Launcher 2　" AllowsTransparency="True" MinHeight="470" MinWidth="780" ScrollViewer.VerticalScrollBarVisibility="Disabled" Icon="/Plain Craft Launcher 2;component/Images/icon.ico" WindowStyle="None" ResizeMode="CanMinimize" Background="{x:Null}" d:DesignWidth="870" d:DesignHeight="520" Width="850" Height="500" RenderTransformOrigin="0.5,0.5">
<Window.TaskbarItemInfo>
<TaskbarItemInfo ThumbnailClipMargin="{Binding Margin, ElementName=PanForm}" />
</Window.TaskbarItemInfo>
Plain Craft Launcher 2/FormMain.xaml.vb
+34 -22
View File
@@ -10,12 +10,13 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 274 Then 'Release 2.4.5
If LastVersion < 276 Then 'Release 2.4.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "增加 在游戏启动前执行命令 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化界面动画，修改部分配色"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文搜索"))
FeatureCount += 17
BugCount += 35
FeatureCount += 25
BugCount += 56
End If
If LastVersion < 272 Then 'Release 2.4.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
@@ -116,6 +117,11 @@ Public Class FormMain
'3：BUG+ IMP* FEAT-
'2：BUG* IMP-
'1：BUG-
If LastVersion < 277 Then 'Snapshot 2.4.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮"))
FeatureCount += 8
BugCount += 21
End If
If LastVersion < 275 Then 'Snapshot 2.4.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "增加 在游戏启动前执行命令 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化界面动画，修改部分配色"))
@@ -395,7 +401,7 @@ Public Class FormMain
AaCode(Sub()
PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True
Log("[System] DPI：" & DPI & "，工作区尺寸：" & My.Computer.Screen.WorkingArea.Width & " x " & My.Computer.Screen.WorkingArea.Height & "，系统版本：" & OsVersion.ToString)
Log($"[System] DPI：{DPI}，系统版本：{OsVersion}，PCL 位置：{PathWithName}")
End Sub, , True)
}, "Form Show")
'Timer 启动
@@ -552,17 +558,22 @@ Reopen:
If PanBack.RenderTransform Is Nothing Then
Dim TransformPos As New TranslateTransform(0, 0)
Dim TransformRotate As New RotateTransform(0)
PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos})}
Dim TransformScale As New ScaleTransform(1, 1)
PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})}
AniStart({
AaOpacity(Me, -Opacity, 150, 50),
AaDouble(Sub(i) TransformPos.Y += i, 30 - TransformPos.Y, 200, 0, New AniEaseOutFluent(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, 1 - TransformRotate.Angle, 200, 0, New AniEaseOutFluent(AniEasePower.Weak)),
AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)),
AaDouble(Sub(i)
TransformScale.ScaleX += i
TransformScale.ScaleY += i
End Sub, 0.88 - TransformScale.ScaleX, 180),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)),
AaCode(Sub()
IsHitTestVisible = False
Top = -10000
ShowInTaskbar = False
End Sub, 225),
AaCode(AddressOf EndProgramForce, 250)
End Sub, 210),
AaCode(AddressOf EndProgramForce, 230)
}, "Form Close")
Else
EndProgramForce()
@@ -581,7 +592,7 @@ Reopen:
If ReturnCode = Result.Exception Then
If Not IsLogShown Then
FeedbackInfo()
Log("请在 https://jinshuju.net/f/rP4b6E?x_field_1=crash 提交错误报告，以便于作者解决此问题！")
Log("请在 https://github.com/Hex-Dragon/PCL2/issues 提交错误报告，以便于作者解决此问题！")
IsLogShown = True
ShellOnly(Path & "PCL\Log1.txt")
End If
@@ -729,7 +740,7 @@ Reopen:
Dim AuthlibServer As String = Net.WebUtility.UrlDecode(Str.Substring("authlib-injector:yggdrasil-server:".Length))
Log("[System] Authlib 拖拽：" & AuthlibServer)
If Not String.IsNullOrEmpty(New ValidateHttp().Validate(AuthlibServer)) Then
Hint("输入的 Authlib 验证服务器不符合网址格式（" & AuthlibServer & "）！", HintType.Critical)
Hint($"输入的 Authlib 验证服务器不符合网址格式（{AuthlibServer}）！", HintType.Critical)
Exit Sub
End If
If McVersionCurrent Is Nothing Then
@@ -738,7 +749,7 @@ Reopen:
End If
If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then
'LittleSkin
If MyMsgBox("是否要在版本 " & McVersionCurrent.Name & " 中开启 LittleSkin 登录？" & vbCrLf &
If MyMsgBox($"是否要在版本 {McVersionCurrent.Name} 中开启 LittleSkin 登录？" & vbCrLf &
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Exit Sub
End If
@@ -748,8 +759,8 @@ Reopen:
Setup.Set("VersionServerAuthName", "LittleSkin 登录", Version:=McVersionCurrent)
Else
'第三方 Authlib 服务器
If MyMsgBox("是否要在版本 " & McVersionCurrent.Name & " 中开启第三方登录？" & vbCrLf &
"登录服务器：" & AuthlibServer & vbCrLf & vbCrLf &
If MyMsgBox($"是否要在版本 {McVersionCurrent.Name} 中开启第三方登录？" & vbCrLf &
$"登录服务器：{AuthlibServer}" & vbCrLf & vbCrLf &
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Exit Sub
End If
@@ -792,9 +803,10 @@ Reopen:
Dim FilePath As String = FilePathList.First
Log("[System] 接受文件拖拽：" & FilePath, LogLevel.Developer)
RunInNewThread(Sub()
Dim Extension As String = FilePath.Split(".").Last.ToLower
'Mod 安装
If FilePath.Split(".").Last.ToLower = "jar" Then
Log("[System] 文件为 jar 格式，尝试作为 Mod 安装")
If {"jar", "litemod"}.Contains(Extension) Then
Log("[System] 文件为 jar/litemod 格式，尝试作为 Mod 安装")
'获取并检查目标版本
Dim TargetVersion As McVersion = McVersionCurrent
If PageCurrent = PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version
@@ -803,7 +815,7 @@ Reopen:
Hint("若要安装 Mod，请先选择一个可以安装 Mod 的版本！")
ElseIf Not (PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod) Then
'未处于 Mod 管理页面
If MyMsgBox("是否要将这些文件作为 Mod 安装到 " & TargetVersion.Name & "？", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
If MyMsgBox($"是否要将这些文件作为 Mod 安装到 {TargetVersion.Name}？", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
Else
'处于 Mod 管理页面
Install:
@@ -812,9 +824,9 @@ Install:
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile))
Next
If FilePathList.Count = 1 Then
Hint("已安装 " & GetFileNameFromPath(FilePathList.First) & "！", HintType.Finish)
Hint($"已安装 {GetFileNameFromPath(FilePathList.First)}！", HintType.Finish)
Else
Hint("已安装 " & FilePathList.Count & " 个 Mod！", HintType.Finish)
Hint($"已安装 {FilePathList.Count} 个 Mod！", HintType.Finish)
End If
'刷新列表
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
@@ -827,12 +839,12 @@ Install:
Exit Sub
End If
'安装整合包
If {"zip", "rar"}.Contains(FilePath.Split(".").Last.ToLower) Then '部分压缩包是 zip 格式但后缀为 rar，总之试一试
If {"zip", "rar"}.Contains(Extension) Then '部分压缩包是 zip 格式但后缀为 rar，总之试一试
Log("[System] 文件为压缩包，尝试作为整合包安装")
If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub
End If
'RAR 处理
If FilePath.Split(".").Last.ToLower = "rar" Then
If Extension = "rar" Then
Hint("PCL2 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试！")
Exit Sub
End If
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+21 -15
View File
@@ -10,12 +10,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.4.5" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.4.5." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.4.6" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.4.6." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 274 'Release
Public Const VersionCode As Integer = 276 'Release
#Else
Public Const VersionCode As Integer = 275 'Snapshot
Public Const VersionCode As Integer = 277 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -743,11 +743,12 @@ Public Module ModBase
''' 从文件路径或者 Url 获取不包含路径的文件名。不包含文件名将会抛出异常。
''' </summary>
Public Function GetFileNameFromPath(FilePath As String) As String
If FilePath.EndsWith("\") OrElse FilePath.EndsWith("/") Then Throw New Exception("不包含文件名：" & FilePath)
If Not (FilePath.Contains("\") OrElse FilePath.Contains("/")) Then Return FilePath
If FilePath.Contains("?") Then FilePath = Left(FilePath, FilePath.LastIndexOf("?")) '去掉网络参数后的 ?
GetFileNameFromPath = Mid(FilePath, FilePath.LastIndexOfAny({"\", "/"}) + 2)
If GetFileNameFromPath = "" Then Throw New Exception("不包含文件名：" & FilePath)
FilePath = FilePath.Replace("/", "\")
If FilePath.EndsWith("\") Then Throw New Exception("不包含文件名：" & FilePath)
Dim FileName As String = FilePath.Split("\").Last.Split("?").First '去掉网络参数后的 ?
If FileName.Length = 0 Then Throw New Exception("不包含文件名：" & FilePath)
If FileName.Length > 250 Then Throw New PathTooLongException("文件名过长：" & FilePath)
Return FileName
End Function
''' <summary>
''' 从文件路径或者 Url 获取不包含路径与扩展名的文件名。不包含文件名将会抛出异常。
@@ -1266,15 +1267,17 @@ Re:
End Function
''' <summary>
''' 删除文件夹。失败会抛出异常。
''' 删除文件夹，返回删除的文件个数。通过参数选择是否抛出异常。
''' </summary>
Public Sub DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False)
If Not Directory.Exists(Path) Then Exit Sub
Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
If Not Directory.Exists(Path) Then Return 0
Dim DeletedCount As Integer = 0
Dim Temp As String()
Temp = Directory.GetFiles(Path)
For Each str As String In Temp
Try
File.Delete(str)
DeletedCount += 1
Catch ex As Exception
If IgnoreIssue Then
Log(ex, "删除单个文件可忽略地失败")
@@ -1296,13 +1299,16 @@ Re:
Throw
End If
End Try
'这个也不靠谱，目录不是空的警告
'My.Computer.FileSystem.DeleteDirectory(Path, FileIO.DeleteDirectoryOption.DeleteAllContents)
End Sub
Return DeletedCount
End Function
''' <summary>
''' 复制文件夹，失败会抛出异常。
''' </summary>
Public Sub CopyDirectory(FromPath As String, ToPath As String)
FromPath = FromPath.Replace("/", "\")
If Not FromPath.EndsWith("\") Then FromPath &= "\"
ToPath = ToPath.Replace("/", "\")
If Not ToPath.EndsWith("\") Then ToPath &= "\"
For Each File In EnumerateFiles(FromPath)
CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
Next
Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+3 -1
View File
@@ -236,7 +236,9 @@
''' </summary>
Public ReadOnly Property IsAborted As Boolean
Get
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread.CurrentThread, LastRunningThread)
Return LastRunningThread Is Nothing OrElse
Not ReferenceEquals(Thread.CurrentThread, LastRunningThread) OrElse
State = LoadState.Aborted
End Get
End Property
''' <summary>
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+1 -1
View File
@@ -1653,7 +1653,7 @@ NextElement:
Retry:
Try
Log("[Download] 复制已存在的文件（" & LocalPath & "）")
FileIO.FileSystem.CopyFile(LocalPath, File.LocalPath, True)
CopyFile(LocalPath, File.LocalPath)
File.Finish(False)
Catch ex As Exception
RetryCount += 1
Plain Craft Launcher 2/Modules/Base/ModValidate.vb
+66 -1
View File
@@ -15,6 +15,8 @@ End Class
''' </summary>
Public Class ValidateNullable
Inherits Validate
Public Sub New()
End Sub
Public Overrides Function Validate(Str As String) As String
If IsNothing(Str) OrElse String.IsNullOrEmpty(Str) Then Return Nothing
Return ""
@@ -26,6 +28,8 @@ End Class
''' </summary>
Public Class ValidateNullOrEmpty
Inherits Validate
Public Sub New()
End Sub
Public Overrides Function Validate(Str As String) As String
If IsNothing(Str) OrElse String.IsNullOrEmpty(Str) Then Return "输入内容不能为空！"
Return ""
@@ -37,6 +41,8 @@ End Class
''' </summary>
Public Class ValidateNullOrWhiteSpace
Inherits Validate
Public Sub New()
End Sub
Public Overrides Function Validate(Str As String) As String
If IsNothing(Str) OrElse String.IsNullOrWhiteSpace(Str) Then Return "输入内容不能为空！"
Return ""
@@ -161,6 +167,8 @@ Public Class ValidateExceptSame
Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
Public Property ErrorMessage As String
Public Property IgnoreCase As Boolean = False
Public Sub New()
End Sub
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能为 %！", Optional IgnoreCase As Boolean = False)
Me.Excepts = Excepts
Me.ErrorMessage = ErrorMessage
@@ -197,6 +205,8 @@ Public Class ValidateFolderName
Public Property UseMinecraftCharCheck As Boolean = True
Public Property IgnoreCase As Boolean = True
Private ReadOnly PathIgnore As IEnumerable(Of DirectoryInfo)
Public Sub New()
End Sub
Public Sub New(Path As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
Me.Path = Path
Me.IgnoreCase = IgnoreCase
@@ -221,7 +231,7 @@ Public Class ValidateFolderName
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符！").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！").Validate(Str)
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！", True).Validate(Str)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查文件夹重名
Dim Arr As New List(Of String)
@@ -240,6 +250,61 @@ Public Class ValidateFolderName
End Function
End Class
''' <summary>
''' 对文件名的粗略的特化检测。
''' </summary>
Public Class ValidateFileName
Inherits Validate
Public Property Name As String
Public Property UseMinecraftCharCheck As Boolean = True
Public Property IgnoreCase As Boolean = True
Public Property ParentFolder As String = Nothing
Public Property RequireParentFolderExists = True
Public Sub New()
End Sub
Public Sub New(Name As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
Me.Name = Name
Me.IgnoreCase = IgnoreCase
Me.UseMinecraftCharCheck = UseMinecraftCharCheck
End Sub
Public Overrides Function Validate(Str As String) As String
Try
'检查是否为空
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查空格
If Str.StartsWith(" ") Then Return "文件名不能以空格开头！"
If Str.EndsWith(" ") Then Return "文件名不能以空格结尾！"
'检查长度
LengthCheck = New ValidateLength(1, 253).Validate(Str & If(ParentFolder, ""))
If Not LengthCheck = "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWith(".") Then Return "文件名不能以小数点结尾！"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符！").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件名不可为 %！", True).Validate(Str)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查文件重名
If ParentFolder IsNot Nothing Then
Dim DirInfo As New DirectoryInfo(ParentFolder)
If DirInfo.Exists Then
Dim SameNameCheck = New ValidateExceptSame(DirInfo.EnumerateFiles("*").Select(Function(f) f.Name),
"不可与现有文件重名！", IgnoreCase).Validate(Str)
If Not SameNameCheck = "" Then Return SameNameCheck
Else
If RequireParentFolderExists Then Return $"父文件夹不存在：{ParentFolder}"
End If
End If
Return ""
Catch ex As Exception
Log(ex, "检查文件名出错")
Return "错误：" & ex.Message
End Try
End Function
End Class
''' <summary>
''' 要求输入一个可用的文件夹路径。
''' </summary>
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+5 -1
View File
@@ -329,6 +329,7 @@
显卡不支持OpenGL
使用OpenJ9
Java版本过高
Java版本不兼容
显卡驱动不支持导致无法设置像素格式
路径包含中文且存在编码问题导致找不到或无法加载主类
Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION 'https://bugs.mojang.com/browse/MC-32606
@@ -465,7 +466,6 @@ Done:
If LogMc.Contains("TRANSFORMER/net.optifine/net.optifine.reflect.Reflector.<clinit>(Reflector.java") 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)
If LogMc.Contains("java.lang.NoSuchFieldException: ucp") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("because module java.base does not export") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("java.lang.ClassNotFoundException: jdk.nashorn.api.scripting.NashornScriptEngineFactory") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("java.lang.ClassNotFoundException: java.lang.invoke.LambdaMetafactory") Then AppendReason(CrashReason.Java版本过高)
@@ -480,6 +480,8 @@ Done:
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版本不兼容)
If LogMc.Contains("java.lang.UnsupportedClassVersionError: net/fabricmc/loader/impl/launch/knot/KnotClient : Unsupported major.minor version") Then AppendReason(CrashReason.Java版本不兼容)
If LogMc.Contains("Could not reserve enough space") Then
If LogMc.Contains("for 1048576KB object heap") Then
AppendReason(CrashReason.使用32位Java导致JVM无法分配足够多的内存)
@@ -785,6 +787,8 @@ Redo:
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，你可以从网络中下载、安装一个。"
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+6 -5
View File
@@ -1272,7 +1272,7 @@
'构造搜索请求
Dim SearchEntries As New List(Of SearchEntry(Of DlCfDbEntry))
For Each Entry In DlCfProjectDb.Values
If If(Entry.ChineseName, "").Contains("动态的树") Then Continue For '傻逼 Mod 的附属太多了
If Entry.ChineseName.Contains("动态的树") Then Continue For '傻逼 Mod 的附属太多了
SearchEntries.Add(New SearchEntry(Of DlCfDbEntry) With {
.Item = Entry,
.SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
@@ -1416,9 +1416,9 @@
''' </summary>
Public WikiId As Integer
''' <summary>
''' 中文译名。若为 Nothing 或空字符串则使用英文名。
''' 中文译名。若为空字符串则使用英文名。
''' </summary>
Public ChineseName As String
Public ChineseName As String = ""
''' <summary>
''' MCBBS 发布帖编号（例如 195107）。若为 Nothing 则没有发布帖。
''' </summary>
@@ -1663,9 +1663,10 @@ ExitSub:
#Region "DlSource | 镜像下载源"
Public Function DlSourceResourceGet(MojangBase As String) As String()
Return {MojangBase.Replace("http://resources.download.minecraft.net", "https://download.mcbbs.net/assets"),
MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return {MojangBase.Replace("https://resources.download.minecraft.net", "https://download.mcbbs.net/assets"),
MojangBase,
MojangBase.Replace("http://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets")
MojangBase.Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets")
}
End Function
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+9 -7
View File
@@ -167,6 +167,7 @@ NextInner:
#Region "预检测"
Private Sub McLaunchPrecheck()
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
'检查路径
If McVersionCurrent.PathIndie.Contains("!") OrElse McVersionCurrent.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.PathIndie & "）")
If McVersionCurrent.Path.Contains("!") OrElse McVersionCurrent.Path.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.Path & "）")
@@ -1047,7 +1048,7 @@ SystemBrowser:
Case 1
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
Case 2
OpenWebsite("https://www.minecraft.net/zh-hans/store/minecraft-java-bedrock-edition-pc")
OpenWebsite("https://www.minecraft.net/store/checkout/minecraft-java-bedrock-edition-pc")
End Select
End Sub, "Login Failed: Create Profile")
Throw New Exception("$$")
@@ -1191,11 +1192,11 @@ SystemBrowser:
'Fabric 检测
If McVersionCurrent.Version.HasFabric Then
If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then
'1.15 - 1.16：Java 8 - 18
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 18, 999, 999)
'1.15 - 1.16：Java 8 - 19
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 19, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 Then
'1.18+：Java 17 - 18
MinVer = New Version(1, 17, 0, 0) : MaxVer = New Version(1, 18, 999, 999)
'1.18+：Java 17 - 19
MinVer = New Version(1, 17, 0, 0) : MaxVer = New Version(1, 19, 999, 999)
End If
End If
@@ -1207,14 +1208,15 @@ SystemBrowser:
'选择 Java
McLaunchLog("Java 版本需求：最低 " & MinVer.ToString & "，最高 " & MaxVer.ToString)
McLaunchJavaSelected = JavaSelect(MinVer, MaxVer, McVersionCurrent)
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
If Task.IsAborted Then Exit Sub
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
Exit Sub
End If
'无合适的 Java
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java
McLaunchLog("无合适的 Java，取消启动")
If MinVer >= New Version(1, 17, 0, 0) Then
'缺少 Java 17
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+81 -55
View File
@@ -125,7 +125,7 @@ Public Module ModMinecraft
Public Overrides Function ToString() As String
Dim VersionString = Version.ToString
If VersionString.StartsWith("1.") Then VersionString = Mid(VersionString, 3)
Return If(IsJre, "Java ", "JDK ") & VersionCode & " (" & VersionString & ")，" & If(Is64Bit, "64", "32") & " 位" & If(IsUserImport, "，手动导入", "") & "：" & PathFolder
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")，" & If(Is64Bit, "64", "32") & " 位" & If(IsUserImport, "，手动导入", "") & "：" & PathFolder
End Function
'构造
@@ -226,7 +226,7 @@ Public Module ModMinecraft
JavaSearchFolder(Disk.Name, JavaPreList, False)
Next
'查找 APPDATA 文件夹中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData), JavaPreList, False)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\", JavaPreList, False)
'查找启动器目录中的 Java
JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
'查找所选 Minecraft 文件夹中的 Java
@@ -416,7 +416,8 @@ Wait:
''' 最小与最大版本在与输入相同时也会通过。
''' 必须在工作线程调用。
''' </summary>
Public Function JavaSelect(Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing, Optional RelatedVersion As McVersion = Nothing) As JavaEntry
Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing,
Optional RelatedVersion As McVersion = Nothing) As JavaEntry
Try
Dim AllowedJavaList As New List(Of JavaEntry)
@@ -429,6 +430,8 @@ Wait:
For Each Entry In JavaPreList
TargetJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next
'检查特定的 Java
If TargetJavaList.Count > 0 Then
TargetJavaList = JavaCheckList(TargetJavaList)
Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定目录下的 Java")
@@ -443,6 +446,8 @@ RetryGet:
Case LoadState.Aborted
Throw New ThreadInterruptedException("Java 搜索加载器已中断")
End Select
'生成完整的 Java 列表
Dim AllJavaList As New List(Of JavaEntry)
AllJavaList.AddRange(TargetJavaList)
AllJavaList.AddRange(JavaList)
@@ -452,6 +457,7 @@ RetryGet:
If MinVersion IsNot Nothing AndAlso Java.Version < MinVersion Then Continue For
If MaxVersion IsNot Nothing AndAlso Java.Version > MaxVersion Then Continue For
If Java.Is64Bit AndAlso Is32BitSystem Then Continue For
If Java.IsJre AndAlso Java.VersionCode >= 12 Then Continue For '无论如何不允许使用 JRE 12+，它们完全是炸的，安 OptiFine、Forge 和启动 MC 都会炸
AllowedJavaList.Add(Java)
Next
@@ -462,30 +468,49 @@ RetryGet:
GoTo RetryGet
End If
'检查用户指定的 Java
Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect")
If RelatedVersion IsNot Nothing Then
Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion
End If
If UserSetup <> "" Then
Dim UserJava As JavaEntry
#Region "检查用户指定的 Java"
Dim UserJava As JavaEntry = Nothing
'获取版本独立设置中指定的 Java
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion) <> "使用全局设置" Then
Try
UserJava = JavaEntry.FromJson(GetJson(UserSetup))
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)))
'确保版本独立设置中指定的 Java 在 Java 列表中（#978）
If Not JavaList.Any(Function(j) j.PathFolder = UserJava.PathFolder) Then
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Log("版本独立设置中指定的 Java 不在主 Java 列表中，此设置已重置", LogLevel.Debug)
Exit Try
End If
Catch ex As Exception
Setup.Set("LaunchArgumentJavaSelect", "使用全局设置")
Log(ex, "版本指定的 Java 信息已损坏，已重置版本设置中指定的 Java")
GoTo UserPass
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Log(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", LogLevel.Hint)
End Try
For Each Java In AllowedJavaList
If Java.PathFolder = UserJava.PathFolder Then
'直接使用指定的 Java
End If
'获取全局设置中指定的 Java
If UserJava Is Nothing AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("LaunchArgumentJavaSelect")))
Catch ex As Exception
UserJava = Nothing
Setup.Reset("LaunchArgumentJavaSelect")
Log(ex, "设置中指定的 Java 已无法使用，此设置已重置", LogLevel.Hint)
End Try
End If
'确保指定的 Java 可用
If UserJava Is Nothing Then GoTo ExitUserJavaCheck
If AllowedJavaList.Any(Function(j) j.PathFolder = UserJava.PathFolder) Then
Log("[Java] 使用用户指定的 Java：" & UserJava.PathFolder)
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
GoTo UserPass
End If
Next
'指定的 Java 不可用，弹窗要求选择
Log("[Java] 发现用户指定的不兼容 Java：" & UserJava.ToString)
'弹窗要求选择
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
@@ -505,26 +530,33 @@ RetryGet:
'直接跳过弹窗
Hint("设置中指定了使用 Java " & JavaCurrent & "，但当前版本" & Requirement & "，这可能会导致游戏崩溃！", HintType.Critical)
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
ElseIf MyMsgBox("你在启动设置中指定了使用 Java " & JavaCurrent & "，但当前版本" & Requirement & "。" & vbCrLf &
"如果强制使用该 Java，可能会导致游戏崩溃。" & vbCrLf &
Else
Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & "，但当前" & Requirement & "。" & vbCrLf &
"如果强制使用该 Java，可能会导致出现异常。" & vbCrLf &
vbCrLf &
" - 指定的 Java：" & UserJava.ToString,
"Java 兼容性警告", "让 PCL2 自动选择", "强制使用该 Java") = 2 Then
'强制使用指定的 Java
"Java 兼容性警告", "让 PCL2 自动选择", "强制使用该 Java", "取消")
Case 1 '让 PCL2 自动选择
Case 2 '强制使用指定的 Java
Log("[Java] 已强制使用用户指定的不兼容 Java")
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
Case 3 '取消启动
Throw New Exception(CancelException)
End Select
End If
End If
ExitUserJavaCheck:
#End Region
'若依然未找到适合的 Java，直接返回
If AllowedJavaList.Count = 0 Then Return Nothing
'检查特定的 Java
'优先使用特定目录下的 Java
For Each Java In AllowedJavaList
If TargetJavaList.Contains(Java) Then
'直接使用指定的 Java
AllowedJavaList = New List(Of JavaEntry) From {Java}
Log("[Java] 使用特定目录下的 Java：" & Java.ToString)
Log("[Java] 优先使用特定目录下的 Java：" & Java.ToString)
GoTo UserPass
End If
Next
@@ -537,6 +569,8 @@ UserPass:
Dim SelectedJava = AllowedJavaList.First
Try
SelectedJava.Check()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
Log(ex, "找到的 Java 已无法使用，尝试进行搜索")
AllowedJavaList = New List(Of JavaEntry)
@@ -552,6 +586,7 @@ UserPass:
Log(ex, "查找符合条件的 Java 时出现加载器中断")
Return Nothing
Catch ex As Exception
If ex.Message = "$$" Then Throw ex
Log(ex, "查找符合条件的 Java 失败", LogLevel.Feedback)
Return Nothing
End Try
@@ -615,7 +650,7 @@ NoUserJava:
'4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20...
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 29, 10, 11, 12, 13, 9, 8, 7, 15, 30, 29, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28}
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 29, 10, 11, 12, 13, 9, 8, 7, 15, 31, 30, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28}
Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
End If
'5. 最次级版本号更接近 51
@@ -671,17 +706,10 @@ NoUserJava:
Public Name As String
Public Path As String
Public Type As McFolderType
Public VersionCount As Integer
Public Overrides Function Equals(obj As Object) As Boolean
If Not (TypeOf obj Is McFolder) Then
Return False
End If
If Not (TypeOf obj Is McFolder) Then Return False
Dim folder = DirectCast(obj, McFolder)
Return Name = folder.Name AndAlso
Path = folder.Path AndAlso
Type = folder.Type AndAlso
VersionCount = folder.VersionCount
Return Name = folder.Name AndAlso Path = folder.Path AndAlso Type = folder.Type
End Function
Public Overrides Function ToString() As String
Return Path
@@ -763,15 +791,6 @@ NoUserJava:
End If
For Each Folder As McFolder In CacheMcFolderList
#Region "获取可用版本数"
If Directory.Exists(Folder.Path & "versions\") Then
Folder.VersionCount = New DirectoryInfo(Folder.Path & "versions\").GetDirectories.Count
'减去隐藏版本的个数
For Each Dir As DirectoryInfo In New DirectoryInfo(Folder.Path & "versions\").GetDirectories
If ReadIni(Dir.FullName & "\PCL\Setup.ini", "Hide", "False") Then Folder.VersionCount -= 1
Next
End If
#End Region
#Region "更新 launcher_profiles.json"
McFolderLauncherProfilesJsonCreate(Folder.Path)
#End Region
@@ -817,7 +836,7 @@ NoUserJava:
#Region "版本处理"
Public Const McVersionCacheVersion As Integer = 24
Public Const McVersionCacheVersion As Integer = 25
Private _McVersionCurrent As McVersion
Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同，使得 UI 显示可以正常初始化
@@ -1650,7 +1669,7 @@ ExitDataLoad:
If Name.StartsWith("2.0") Then
Return "这个秘密计划了两年的更新将游戏推向了一个新高度！"
ElseIf Name.StartsWith("20w14inf") OrElse Name = "20w14∞" Then
Return "我们加入了 20 亿个新的世界，让无限的想象变成了现实！"
Return "我们加入了 20 亿个新的维度，让无限的想象变成了现实！"
ElseIf Name = "15w14a" Then
Return "作为一款全年龄向的游戏，我们需要和平，需要爱与拥抱。"
ElseIf Name = "1.rv-pre1" Then
@@ -1919,16 +1938,23 @@ OnLoaded:
'将每个大版本下的最常规版本加入
For Each Code As Integer In ExistVersion
If NewerVersion.ContainsKey(Code & "-" & McVersionState.OptiFine) Then
If NewerVersion.ContainsKey(Code & "-" & McVersionState.OptiFine) AndAlso NewerVersion.ContainsKey(Code & "-" & McVersionState.Original) Then
'同时存在 OptiFine 与原版
Dim OriginalVersion As McVersion = NewerVersion(Code & "-" & McVersionState.Original)
Dim OptiFineVersion As McVersion = NewerVersion(Code & "-" & McVersionState.OptiFine)
If NewerVersion.ContainsKey(Code & "-" & McVersionState.Original) AndAlso Not NewerVersion(Code & "-" & McVersionState.Original).Version.McName = OptiFineVersion.InheritVersion Then
'同时存在 OptiFine 与原版，但 OptiFine 不是该版的依赖版本，则一定为两个不同版本，且原版较新
VersionUseful.Add(NewerVersion(Code & "-" & McVersionState.Original))
VersionList.Remove(NewerVersion(Code & "-" & McVersionState.Original))
If OriginalVersion.Version.McCodeSub > OptiFineVersion.Version.McCodeSub Then
'仅在原版比 OptiFine 更新时才加入原版
VersionUseful.Add(OriginalVersion)
VersionList.Remove(OriginalVersion)
End If
VersionUseful.Add(OptiFineVersion)
VersionList.Remove(OptiFineVersion)
Else
ElseIf NewerVersion.ContainsKey(Code & "-" & McVersionState.OptiFine) Then
'没有原版，直接加入 OptiFine
VersionUseful.Add(NewerVersion(Code & "-" & McVersionState.OptiFine))
VersionList.Remove(NewerVersion(Code & "-" & McVersionState.OptiFine))
ElseIf NewerVersion.ContainsKey(Code & "-" & McVersionState.Original) Then
'没有 OptiFine，直接加入原版
VersionUseful.Add(NewerVersion(Code & "-" & McVersionState.Original))
VersionList.Remove(NewerVersion(Code & "-" & McVersionState.Original))
End If
@@ -2807,7 +2833,7 @@ NextVersion:
If File.Exists AndAlso (Token.Size = 0 OrElse Token.Size = File.Length) AndAlso
(Not CheckHash OrElse Token.Hash Is Nothing OrElse Token.Hash = GetAuthSHA1(Token.LocalPath)) Then Continue For
'文件不存在，添加下载
Result.Add(New NetFile(DlSourceResourceGet("http://resources.download.minecraft.net/" & Left(Token.Hash, 2) & "/" & Token.Hash), Token.LocalPath, New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.Hash)))
Result.Add(New NetFile(DlSourceResourceGet("https://resources.download.minecraft.net/" & Left(Token.Hash, 2) & "/" & Token.Hash), Token.LocalPath, New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.Hash)))
Next
Catch ex As Exception
Log(ex, "获取版本缺失的资源文件下载列表失败")
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+10 -5
View File
@@ -206,7 +206,7 @@ Retry:
Task.Progress = 0.5
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & OverrideHome) Then
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & OverrideHome, PathMcFolder & "versions\" & VersionName)
CopyDirectory(InstallTemp & ArchiveBaseFolder & OverrideHome, PathMcFolder & "versions\" & VersionName)
Else
Log("[ModPack] 整合包中未找到 override 目录，已跳过")
End If
@@ -242,8 +242,13 @@ Retry:
'跳过重复的 Mod（疑似 CurseForge Bug）
If FileList.ContainsKey(ModJson("id").ToObject(Of Integer)) Then Continue For
'根据 modules 判断是资源包还是 Mod
Dim IsResourcePack As Boolean
If ModJson("modules").Any Then 'modules 可能返回 null（#1006）
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
Dim IsResourcePack As Boolean = Not ModuleNames.Contains("META-INF") AndAlso ModuleNames.Contains("pack.mcmeta")
IsResourcePack = Not ModuleNames.Contains("META-INF") AndAlso ModuleNames.Contains("pack.mcmeta")
Else
IsResourcePack = False
End If
'实际的添加
FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(
PathMcFolder & "versions\" & VersionName & "\" & If(IsResourcePack, "resourcepacks", "mods") & "\", False))
@@ -368,7 +373,7 @@ Retry:
Task.Progress = 0.5
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName)
CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName)
Else
Log("[ModPack] 整合包中未找到 minecraft override 目录，已跳过")
End If
@@ -463,7 +468,7 @@ Retry:
Task.Progress = 0.5
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName)
CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName)
Else
Log("[ModPack] 整合包中未找到 override .minecraft 目录，已跳过")
End If
@@ -550,7 +555,7 @@ Retry:
Task.Progress = 0.5
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
Else
Log("[ModPack] 整合包中未找到 overrides 目录，已跳过")
End If
Plain Craft Launcher 2/Modules/ModEvent.vb
+1 -1
View File
@@ -67,7 +67,7 @@
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL2 不支持其他乱七八糟的协议。", "事件执行失败")
Exit Sub
End If
PageOtherTest.StartCustomDownload(Data(0))
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
Case Else
MyMsgBox("未知的事件类型：" & Type & vbCrLf & "请检查事件类型填写是否正确，或者 PCL2 是否为最新版本。", "事件执行失败")
Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+2 -2
View File
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.4.5.0")>
<Assembly: AssemblyFileVersion("2.4.5.0")>
<Assembly: AssemblyVersion("2.4.6.0")>
<Assembly: AssemblyFileVersion("2.4.6.0")>
<Assembly: NeutralResourcesLanguage("")>
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+10 -10
View File
@@ -380,7 +380,7 @@ Public Module ModDownloadLib
End Sub
Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean))
'选择 Java
Dim Java = JavaSelect(New Version(1, 8, 0, 0))
Dim Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
If Java Is Nothing Then
JavaMissing(17)
Throw New Exception("未找到用于安装 OptiFine 的 Java")
@@ -563,7 +563,7 @@ Public Module ModDownloadLib
If Directory.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then
DeleteDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit)
End If
My.Computer.FileSystem.CreateDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\")
Directory.CreateDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\")
McFolderLauncherProfilesJsonCreate(BaseMcFolder)
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
@@ -575,10 +575,10 @@ Public Module ModDownloadLib
Task.Progress = 0.96
'复制文件
File.Delete(BaseMcFolder & "launcher_profiles.json")
My.Computer.FileSystem.CopyDirectory(BaseMcFolder, McFolder, True)
CopyDirectory(BaseMcFolder, McFolder)
Task.Progress = 0.98
'清理文件
My.Computer.FileSystem.DeleteFile(Target)
File.Delete(Target)
DeleteDirectory(BaseMcFolderHome)
Catch ex As Exception
Throw New Exception("安装新版 OptiFine 版本失败", ex)
@@ -1097,7 +1097,7 @@ Public Module ModDownloadLib
Private Sub ForgeInjector(Target As String, Task As LoaderTask(Of Boolean, Boolean), McFolder As String)
'选择 Java
Dim Java = JavaSelect(New Version(1, 8, 0, 60))
Dim Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
If Java Is Nothing Then
JavaMissing(17)
Throw New Exception("未找到用于安装 Forge 的 Java")
@@ -1409,7 +1409,7 @@ Public Module ModDownloadLib
'清理文件
Try
If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then My.Computer.FileSystem.DeleteFile(InstallerAddress)
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
Catch ex As Exception
Log(ex, "安装 Forge 清理文件时出错")
End Try
@@ -1440,7 +1440,7 @@ Public Module ModDownloadLib
'解压支持库文件
Installer.Dispose()
ZipFile.ExtractToDirectory(InstallerAddress, InstallerAddress & "_unrar\")
My.Computer.FileSystem.CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\", True)
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DeleteDirectory(InstallerAddress & "_unrar\")
Else
'旧版格式
@@ -1463,7 +1463,7 @@ Public Module ModDownloadLib
Try
'清理文件
If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then My.Computer.FileSystem.DeleteFile(InstallerAddress)
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
Catch ex As Exception
Log(ex, "非新版方式安装 Forge 清理文件时出错")
@@ -1995,8 +1995,8 @@ Public Module ModDownloadLib
LoaderList.Add(New LoaderTask(Of String, String)("安装游戏", Sub(Task As LoaderTask(Of String, String))
InstallMerge(OutputFolder, OutputFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.3
If Directory.Exists(TempMcFolder & "libraries") Then My.Computer.FileSystem.CopyDirectory(TempMcFolder & "libraries", PathMcFolder & "libraries", True)
If Directory.Exists(TempMcFolder & "mods") Then My.Computer.FileSystem.CopyDirectory(TempMcFolder & "mods", PathMcFolder & "mods", True)
If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", PathMcFolder & "libraries")
If Directory.Exists(TempMcFolder & "mods") Then CopyDirectory(TempMcFolder & "mods", PathMcFolder & "mods")
End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件
If Not DontFixLibraries AndAlso
Plain Craft Launcher 2/Pages/PageDownload/MyCfItem.xaml
+1 -1
View File
@@ -21,7 +21,7 @@
<!--<Rectangle Height="45" Width="45" RadiusX="4" RadiusY="4" Fill="White" Grid.Column="1" Grid.Row="1" IsHitTestVisible="False" SnapsToDevicePixels="True" UseLayoutRounding="False" Grid.RowSpan="3" />-->
<Border Height="45" Width="45" Grid.Column="1" Grid.Row="1" IsHitTestVisible="False" SnapsToDevicePixels="True" UseLayoutRounding="True" Grid.RowSpan="3">
<Border.Clip>
<RectangleGeometry Rect="0,0,45,45" RadiusX="4" RadiusY="4" />
<RectangleGeometry Rect="0,0,45,45" RadiusX="6" RadiusY="6" />
</Border.Clip>
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
</Border>
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
+2
View File
@@ -638,6 +638,8 @@
If Versions.Count = 0 Then Exit Sub
'排序
Versions = Sort(Versions, Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
If Left.IsPreview AndAlso Not Right.IsPreview Then Return False
Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay)
End Function)
'可视化
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb
+9
View File
@@ -95,21 +95,30 @@
DlFabricListLoader.Start(IsForceRestart:=True)
DlFabricApiLoader.Start(IsForceRestart:=True)
DlOptiFabricLoader.Start(IsForceRestart:=True)
ItemInstall.Checked = True
Case FormMain.PageSubType.DownloadMod
If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart()
ItemMod.Checked = True
Case FormMain.PageSubType.DownloadPack
If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart()
ItemPack.Checked = True
Case FormMain.PageSubType.DownloadClient
DlClientListLoader.Start(IsForceRestart:=True)
ItemClient.Checked = True
Case FormMain.PageSubType.DownloadOptiFine
DlOptiFineListLoader.Start(IsForceRestart:=True)
ItemOptiFine.Checked = True
Case FormMain.PageSubType.DownloadForge
DlForgeListLoader.Start(IsForceRestart:=True)
ItemForge.Checked = True
Case FormMain.PageSubType.DownloadLiteLoader
DlLiteLoaderListLoader.Start(IsForceRestart:=True)
ItemLiteLoader.Checked = True
Case FormMain.PageSubType.DownloadFabric
DlFabricListLoader.Start(IsForceRestart:=True)
ItemFabric.Checked = True
End Select
Hint("正在刷新……", Log:=False)
End Sub
'点击返回
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml
+1 -1
View File
@@ -14,7 +14,7 @@
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="70" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="2.5*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
Plain Craft Launcher 2/Pages/PageLink/PageLinkLeft.xaml.vb
+1
View File
@@ -173,6 +173,7 @@ Public Class PageLinkLeft
If MyMsgBox("是否要初始化联机页的所有设置？该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then
If IsNothing(FrmSetupLink) Then FrmSetupLink = New PageSetupLink
FrmSetupLink.Reset()
ItemSetup.Checked = True
End If
End Sub
Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb
+2
View File
@@ -114,7 +114,9 @@
Select Case Val(sender.Tag)
Case FormMain.PageSubType.OtherHelp
RefreshHelp()
ItemHelp.Checked = True
End Select
Hint("正在刷新……", Log:=False)
End Sub
Public Shared Sub RefreshHelp()
Setup.Set("SystemHelpVersion", 0) '强制重新解压文件
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb
+2
View File
@@ -304,6 +304,7 @@
}, "SetupLaunch Ram TextRight")
Else
'不需要动画
AniStop("SetupLaunch Ram TextRight")
LabRamGame.Margin = New Thickness(TotalWidth - LabGameWidth, 3, 0, 0)
LabRamGameTitle.Margin = New Thickness(TotalWidth - LabGameTitleWidth, 0, 0, 5)
End If
@@ -316,6 +317,7 @@
}, "SetupLaunch Ram TextRight")
Else
'不需要动画
AniStop("SetupLaunch Ram TextRight")
LabRamGame.Margin = New Thickness(2 + RectUsedWidth, 3, 0, 0)
LabRamGameTitle.Margin = New Thickness(2 + RectUsedWidth, 0, 0, 5)
End If
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml.vb
+4
View File
@@ -147,21 +147,25 @@
If MyMsgBox("是否要初始化启动页的所有设置？该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then
If IsNothing(FrmSetupLaunch) Then FrmSetupLaunch = New PageSetupLaunch
FrmSetupLaunch.Reset()
ItemLaunch.Checked = True
End If
Case FormMain.PageSubType.SetupUI
If MyMsgBox("是否要初始化个性化页的所有设置？该操作不可撤销。" & vbCrLf & "（背景图片与音乐、自定义主页等外部文件不会被删除）", "初始化确认",, "取消", IsWarn:=True) = 1 Then
If IsNothing(FrmSetupUI) Then FrmSetupUI = New PageSetupUI
FrmSetupUI.Reset()
ItemUI.Checked = True
End If
Case FormMain.PageSubType.SetupSystem
If MyMsgBox("是否要初始化启动器页的所有设置？该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then
If IsNothing(FrmSetupSystem) Then FrmSetupSystem = New PageSetupSystem
FrmSetupSystem.Reset()
ItemSystem.Checked = True
End If
Case FormMain.PageSubType.SetupLink
If MyMsgBox("是否要初始化联机页的所有设置？该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then
If IsNothing(FrmSetupLink) Then FrmSetupLink = New PageSetupLink
FrmSetupLink.Reset()
ItemLink.Checked = True
End If
End Select
End Sub
Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb
+1 -1
View File
@@ -92,7 +92,7 @@
Card.Children.Add(GetObjectFromXML("<Path xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" Stretch=""Uniform"" Tag=""Failed"" Data=""F1 M2.5,0 L0,2.5 7.5,10 0,17.5 2.5,20 10,12.5 17.5,20 20,17.5 12.5,10 20,2.5 17.5,0 10,7.5 2.5,0Z"" Height=""15"" Width=""15"" HorizontalAlignment=""Center"" Grid.Column=""0"" Grid.Row=""0"" Fill=""{DynamicResource ColorBrush3}"" Margin=""0,1,0,0"" VerticalAlignment=""Top""/>"))
Dim Tb As TextBlock = GetObjectFromXML("<TextBlock xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" TextWrapping=""Wrap"" HorizontalAlignment=""Left"" ToolTipService.ShowDuration=""2333333"" ToolTip=""单击复制错误详情"" Grid.Column=""1"" Grid.Row=""0"" Margin=""0,0,0,5"" />")
Tb.Text = GetExceptionDetail(Loader.Error)
AddHandler Tb.MouseDown, Sub(sender As TextBlock, e As EventArgs)
AddHandler Tb.MouseLeftButtonDown, Sub(sender As TextBlock, e As EventArgs)
ClipboardSet(sender.Text, False)
Hint("已复制错误详情！", HintType.Finish)
End Sub
Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb
+3
View File
@@ -90,12 +90,15 @@
Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用
'强制刷新
If FrmVersionMod IsNot Nothing Then FrmVersionMod.RefreshList(True) '没有 Else，还没加载刷个鬼的新
ItemMod.Checked = True
Hint("正在刷新……", Log:=False)
End Sub
Public Sub Reset(sender As Object, e As EventArgs)
If MyMsgBox("是否要初始化该版本的版本独立设置？该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then
If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup
FrmVersionSetup.Reset()
ItemSetup.Checked = True
End If
End Sub
Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
+5 -4
View File
@@ -60,6 +60,7 @@
PanEmpty.Visibility = Visibility.Collapsed
End If
SearchBox.Text = ""
'建立 StackPanel
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, If(List.Count > 0, 20, 0)), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0)}
For Each ModEntity As McMod In List
@@ -383,15 +384,15 @@
ModSearchName = ModSearchName.Replace("++", "+").Replace("pti+Fine", "ptiFine")
'显示
If ModEntity.Url Is Nothing Then
If MyMsgBox(Join(ContentLines, vbCrLf), ModEntity.Name, "确定", "百科搜索") = 2 Then
If MyMsgBox(Join(ContentLines, vbCrLf), ModEntity.Name, "百科搜索", "返回") = 1 Then
OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0")
End If
Else
Select Case MyMsgBox(Join(ContentLines, vbCrLf), ModEntity.Name, "确定", "百科搜索", "打开官网")
Select Case MyMsgBox(Join(ContentLines, vbCrLf), ModEntity.Name, "打开官网", "百科搜索", "返回")
Case 1
OpenWebsite(ModEntity.Url)
Case 2
OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0")
Case 3
OpenWebsite(ModEntity.Url)
End Select
End If
Plain Craft Launcher 2/Pages/PageVersion/PageVersionModDisabled.xaml
+1 -1
View File
@@ -22,7 +22,7 @@
</Grid.ColumnDefinitions>
<TextBlock Grid.Row="0" Grid.ColumnSpan="4" Margin="0,0,0,9" HorizontalAlignment="Center" Text="该版本不可使用 Mod" FontSize="19" UseLayoutRounding="True" SnapsToDevicePixels="True" Foreground="{DynamicResource ColorBrush3}" />
<Rectangle Grid.Row="1" Grid.ColumnSpan="4" HorizontalAlignment="Stretch" Height="2" Fill="{DynamicResource ColorBrush3}" />
<TextBlock Grid.Row="2" Grid.ColumnSpan="4" Margin="10,15,10,5" Text="你需要先安装 Forge 或 Fabric 才能使用 Mod，请在下载页面重新安装这些版本。&#xa;如果你已经安装过了 Forge 或 Fabric，那么你很可能选择了错误的版本，请点击版本选择按钮切换版本，并注意 Forge 在版本选择列表中的图标为铁砧，Fabric 的图标为丝绸。" TextWrapping="Wrap" />
<TextBlock Grid.Row="2" Grid.ColumnSpan="4" Margin="10,15,10,5" Text="你需要先安装 Forge 或 Fabric 等 Mod 加载器才能使用 Mod，请在下载页面重新安装这些版本。&#xa;如果你已经安装过了 Mod 加载器，那么你很可能选择了错误的版本，请点击版本选择按钮切换版本，并注意 Forge 在版本选择列表中的图标为铁砧，Fabric 的图标为丝绸。" TextWrapping="Wrap" />
<local:MyButton Grid.Row="3" Grid.Column="1" Height="35" HorizontalAlignment="Center" x:Name="BtnDownload" MinWidth="140" Text="转到下载页面" Margin="10,10,10,0" Padding="13,0" ColorType="Highlight" />
<local:MyButton Grid.Row="3" Grid.Column="2" Height="35" HorizontalAlignment="Center" x:Name="BtnVersion" MinWidth="140" Text="版本选择" Margin="10,10,10,0" Padding="13,0" />
</Grid>
Plain Craft Launcher 2/Resources/Help.zip
BIN
View File
Binary file not shown.