From 2a46c9f5cef710e7e5790b2ac9b41e70b98ea343 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E9=BE=99=E8=85=BE=E7=8C=AB=E8=B7=83?= <1043137532@qq.com>
Date: Fri, 8 Nov 2024 00:43:29 +0800
Subject: [PATCH] 2.8.10
---
Plain Craft Launcher 2/Application.xaml.vb | 10 +-
Plain Craft Launcher 2/Controls/MyCard.vb | 30 +-
Plain Craft Launcher 2/Controls/MyImage.vb | 10 +-
.../Controls/MyMsg/MyMsgInput.xaml | 2 +-
.../Controls/MyMsg/MyMsgSelect.xaml | 2 +-
.../Controls/MyMsg/MyMsgText.xaml | 2 +-
Plain Craft Launcher 2/Controls/MyPageLeft.vb | 4 +
.../Controls/MyScrollViewer.vb | 12 +-
Plain Craft Launcher 2/FormMain.xaml.vb | 40 ++-
.../Modules/Base/ModBase.vb | 105 ++++--
.../Modules/Base/ModLoader.vb | 2 +-
Plain Craft Launcher 2/Modules/Base/ModNet.vb | 157 ++++-----
.../Modules/Base/MyBitmap.vb | 8 +
.../Modules/Minecraft/ModComp.vb | 38 +-
.../Modules/Minecraft/ModCrash.vb | 94 +++--
.../Modules/Minecraft/ModDownload.vb | 6 +-
.../Modules/Minecraft/ModJava.vb | 4 +-
.../Modules/Minecraft/ModLaunch.vb | 6 +-
.../Modules/Minecraft/ModMinecraft.vb | 7 +-
.../Modules/Minecraft/ModMod.vb | 4 +-
.../Modules/Minecraft/ModModpack.vb | 330 ++++++++++--------
Plain Craft Launcher 2/Modules/ModEvent.vb | 1 -
Plain Craft Launcher 2/Modules/ModMain.vb | 7 +-
.../My Project/AssemblyInfo.vb | 4 +-
.../Pages/PageDownload/ModDownloadLib.vb | 57 +--
.../PageDownloadCompDetail.xaml.vb | 68 ++--
.../PageDownload/PageDownloadInstall.xaml.vb | 6 +-
.../Pages/PageDownload/PageDownloadLeft.xaml | 146 ++++----
.../PageDownload/PageDownloadLeft.xaml.vb | 9 +-
.../Pages/PageDownload/PageDownloadMod.xaml | 3 -
.../PageDownload/PageDownloadOptiFine.xaml | 6 +-
.../PageDownload/PageDownloadOptiFine.xaml.vb | 3 -
.../Pages/PageDownload/PageDownloadPack.xaml | 3 -
.../Pages/PageLaunch/MyMsgLogin.xaml | 2 +-
.../Pages/PageLaunch/PageLaunchLeft.xaml.vb | 39 +--
.../Pages/PageLaunch/PageLaunchRight.xaml | 2 +-
.../Pages/PageLaunch/PageLaunchRight.xaml.vb | 17 +-
.../Pages/PageLaunch/PageLoginAuth.xaml.vb | 4 +-
.../Pages/PageLaunch/PageLoginLegacy.xaml.vb | 2 +-
.../Pages/PageLaunch/PageLoginNide.xaml.vb | 4 +-
.../Pages/PageOther/PageOtherAbout.xaml | 218 ++++++------
.../Pages/PageOther/PageOtherHelp.xaml.vb | 88 ++---
.../PageOther/PageOtherHelpDetail.xaml.vb | 5 +
.../Pages/PageSelectLeft.xaml | 2 +-
.../Pages/PageSelectLeft.xaml.vb | 13 +-
.../Pages/PageSelectRight.xaml.vb | 26 +-
.../Pages/PageSetup/ModSetup.vb | 4 +
.../Pages/PageSetup/PageSetupLaunch.xaml | 96 ++---
.../Pages/PageSetup/PageSetupLaunch.xaml.vb | 10 +-
.../Pages/PageSetup/PageSetupUI.xaml | 5 +-
.../Pages/PageSetup/PageSetupUI.xaml.vb | 4 +-
.../Pages/PageVersion/PageVersionLeft.xaml.vb | 12 +-
.../Pages/PageVersion/PageVersionMod.xaml.vb | 46 ++-
.../PageVersion/PageVersionSetup.xaml.vb | 5 +-
54 files changed, 1012 insertions(+), 778 deletions(-)
diff --git a/Plain Craft Launcher 2/Application.xaml.vb b/Plain Craft Launcher 2/Application.xaml.vb
index 14f28ea7..4c66c770 100644
--- a/Plain Craft Launcher 2/Application.xaml.vb
+++ b/Plain Craft Launcher 2/Application.xaml.vb
@@ -72,9 +72,17 @@ Public Class Application
Directory.CreateDirectory(PathAppdata)
'检测单例
#If Not DEBUG Then
+ Dim ShouldWaitForExit As Boolean = e.Args.Length > 0 AndAlso e.Args(0) = "--wait" '要求等待已有的 PCL 退出
+ Dim WaitRetryCount As Integer = 0
+WaitRetry:
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ")
If WindowHwnd = IntPtr.Zero Then FindWindow(Nothing, "Plain Craft Launcher 2 ")
If WindowHwnd <> IntPtr.Zero Then
+ If ShouldWaitForExit AndAlso WaitRetryCount < 20 Then '至多等待 10 秒
+ WaitRetryCount += 1
+ Thread.Sleep(500)
+ GoTo WaitRetry
+ End If
'将已有的 PCL 窗口拖出来
ShowWindowToTop(WindowHwnd)
'播放提示音并退出
@@ -162,7 +170,7 @@ Public Class Application
ExceptionString.Contains(".NET Framework") OrElse ' “自动错误判断” 的结果分析
ExceptionString.Contains("未能加载文件或程序集") Then
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
- MsgBox("你的 .NET Framework 版本过低或损坏，请在打开的网页中重新下载并安装 .NET Framework 4.6.2 后重试！", MsgBoxStyle.Information, "运行环境错误")
+ MsgBox("你的 .NET Framework 版本过低或损坏，请下载并重新安装 .NET Framework 4.6.2！", MsgBoxStyle.Information, "运行环境错误")
FormMain.EndProgramForce(Result.Cancel)
Else
FeedbackInfo()
diff --git a/Plain Craft Launcher 2/Controls/MyCard.vb b/Plain Craft Launcher 2/Controls/MyCard.vb
index 8ae95efe..30c65882 100644
--- a/Plain Craft Launcher 2/Controls/MyCard.vb
+++ b/Plain Craft Launcher 2/Controls/MyCard.vb
@@ -293,26 +293,28 @@
Public Const SwapedHeight As Integer = 40
Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
Dim Pos As Double = Mouse.GetPosition(Me).Y
- If Not IsSwaped AndAlso (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判
+ If Not IsSwaped AndAlso
+ (SwapControl Is Nothing OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判
IsMouseDown = True
End Sub
Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
- If IsMouseDown Then
- IsMouseDown = False
- Dim Pos As Double = Mouse.GetPosition(Me).Y
- If Not IsSwaped AndAlso (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判
+ If Not IsMouseDown Then Return
+ IsMouseDown = False
- Dim ee = New RouteEventArgs(True)
- RaiseEvent PreviewSwap(Me, ee)
- If ee.Handled Then
- IsMouseDown = False
- Exit Sub
- End If
+ Dim Pos As Double = Mouse.GetPosition(Me).Y
+ If Not IsSwaped AndAlso
+ (SwapControl Is Nothing OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判
- IsSwaped = Not IsSwaped
- Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", "：" & Title))
- RaiseEvent Swap(Me, ee)
+ Dim ee = New RouteEventArgs(True)
+ RaiseEvent PreviewSwap(Me, ee)
+ If ee.Handled Then
+ IsMouseDown = False
+ Return
End If
+
+ IsSwaped = Not IsSwaped
+ Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", "：" & Title))
+ RaiseEvent Swap(Me, ee)
End Sub
Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
IsMouseDown = False
diff --git a/Plain Craft Launcher 2/Controls/MyImage.vb b/Plain Craft Launcher 2/Controls/MyImage.vb
index 29cc9162..122edd31 100644
--- a/Plain Craft Launcher 2/Controls/MyImage.vb
+++ b/Plain Craft Launcher 2/Controls/MyImage.vb
@@ -14,13 +14,14 @@
'''
Public Property EnableCache As Boolean
Get
- Return _EnableCache
+ Return GetValue(EnableCacheProperty)
End Get
Set(value As Boolean)
- _EnableCache = value
+ SetValue(EnableCacheProperty, value)
End Set
End Property
- Private _EnableCache As Boolean = True
+ Public Shared Shadows ReadOnly EnableCacheProperty As DependencyProperty = DependencyProperty.Register(
+ "EnableCache", GetType(Boolean), GetType(MyImage), New PropertyMetadata(True))
'''
''' 与 Image 的 Source 类似。
@@ -114,9 +115,10 @@
Dim Retried As Boolean = False
Dim TempPath As String = GetTempPath(Url)
Dim TempFile As New FileInfo(TempPath)
+ Dim EnableCache As Boolean = Me.EnableCache
If EnableCache AndAlso TempFile.Exists Then
ActualSource = TempPath
- If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
+ If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
End If
RunInNewThread(
Sub()
diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml
index bf232812..282ecb27 100644
--- a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml
+++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml
@@ -25,7 +25,7 @@
+ VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml
index 5c21822d..b4f75ba3 100644
--- a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml
+++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml
@@ -24,7 +24,7 @@
+ VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml
index 10f2a924..0bbf1578 100644
--- a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml
+++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml
@@ -24,7 +24,7 @@
+ VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
diff --git a/Plain Craft Launcher 2/Controls/MyPageLeft.vb b/Plain Craft Launcher 2/Controls/MyPageLeft.vb
index b09897b7..9c368a60 100644
--- a/Plain Craft Launcher 2/Controls/MyPageLeft.vb
+++ b/Plain Craft Launcher 2/Controls/MyPageLeft.vb
@@ -104,3 +104,7 @@
End Sub
End Class
+
+Public Interface IRefreshable
+ Sub Refresh()
+End Interface
\ No newline at end of file
diff --git a/Plain Craft Launcher 2/Controls/MyScrollViewer.vb b/Plain Craft Launcher 2/Controls/MyScrollViewer.vb
index beaeb1c3..ad18da92 100644
--- a/Plain Craft Launcher 2/Controls/MyScrollViewer.vb
+++ b/Plain Craft Launcher 2/Controls/MyScrollViewer.vb
@@ -1,7 +1,7 @@
Public Class MyScrollViewer
Inherits ScrollViewer
- Public Property DeltaMuity As Double = 1
+ Public Property DeltaMult As Double = 1
Private RealOffset As Double
@@ -25,10 +25,12 @@
Next
End Sub
Public Sub PerformVerticalOffsetDelta(Delta As Double)
- AniStart(AaDouble(Sub(AnimDelta As Double)
- RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
- ScrollToVerticalOffset(RealOffset)
- End Sub, Delta * DeltaMuity, 300,, New AniEaseOutFluent(6)))
+ AniStart(
+ AaDouble(
+ Sub(AnimDelta As Double)
+ RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
+ ScrollToVerticalOffset(RealOffset)
+ End Sub, Delta * DeltaMult, 300,, New AniEaseOutFluent(6)))
End Sub
Private Sub MyScrollViewer_ScrollChanged(sender As Object, e As ScrollChangedEventArgs) Handles Me.ScrollChanged
RealOffset = VerticalOffset
diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb
index c520c422..35d01e23 100644
--- a/Plain Craft Launcher 2/FormMain.xaml.vb
+++ b/Plain Craft Launcher 2/FormMain.xaml.vb
@@ -10,6 +10,13 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
+ If LastVersion < 342 Then 'Release 2.8.9
+ FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持下载原版服务端"))
+ FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "本地 Mod 的标题支持选择显示 Mod 原始文件名"))
+ FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复搜索后启用/禁用 Mod 时出错的 Bug"))
+ FeatureCount += 17
+ BugCount += 13
+ End If
If LastVersion < 340 Then 'Release 2.8.8
If LastVersion = 338 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复数个与新正版登录相关的严重 Bug"))
FeatureCount += 3
@@ -75,6 +82,13 @@ Public Class FormMain
'3：BUG+ IMP* FEAT-
'2：BUG* IMP-
'1：BUG-
+ If LastVersion < 343 Then 'Snapshot 2.8.10
+ FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 详情页面会按 Mod 加载器分类卡片"))
+ FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装同时包含 modpack 文件和启动器的懒人包"))
+ FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化整合包导入流程"))
+ FeatureCount += 20
+ BugCount += 16
+ End If
If LastVersion < 341 Then 'Snapshot 2.8.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持下载原版服务端"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "本地 Mod 的标题支持选择显示 Mod 原始文件名"))
@@ -227,7 +241,9 @@ Public Class FormMain
If Not IsNothing(FrmLaunchLeft.Parent) Then FrmLaunchLeft.SetValue(ContentPresenter.ContentProperty, Nothing)
If Not IsNothing(FrmLaunchRight.Parent) Then FrmLaunchRight.SetValue(ContentPresenter.ContentProperty, Nothing)
PanMainLeft.Child = FrmLaunchLeft
+ PageLeft = FrmLaunchLeft
PanMainRight.Child = FrmLaunchRight
+ PageRight = FrmLaunchRight
FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay
'模式提醒
#If DEBUG Then
@@ -599,6 +615,12 @@ Public Class FormMain
PageSetupUI.HiddenRefresh()
Exit Sub
End If
+ '按 F5 刷新页面
+ If e.Key = Key.F5 Then
+ If TypeOf PageLeft Is IRefreshable Then CType(PageLeft, IRefreshable).Refresh()
+ If TypeOf PageRight Is IRefreshable Then CType(PageRight, IRefreshable).Refresh()
+ Exit Sub
+ End If
'调用启动游戏
If e.Key = Key.Enter AndAlso PageCurrent = FormMain.PageType.Launch Then
If IsAprilEnabled AndAlso Not IsAprilGiveup Then
@@ -736,14 +758,14 @@ Public Class FormMain
If FilePathList.Count > 1 Then
'必须要求全部为 jar 文件
For Each File In FilePathList
- If Not {"jar", "litemod", "disabled", "old"}.Contains(File.After(".").ToLower) Then
+ If Not {"jar", "litemod", "disabled", "old"}.Contains(File.AfterLast(".").ToLower) Then
Hint("一次请只拖入一个文件！", HintType.Critical)
Exit Sub
End If
Next
End If
'自定义主页
- Dim Extension As String = FilePath.After(".").ToLower
+ Dim Extension As String = FilePath.AfterLast(".").ToLower
If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML，作为自定义主页加载")
If File.Exists(Path & "PCL\Custom.xaml") Then
@@ -763,6 +785,11 @@ Public Class FormMain
'Mod 安装
If {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then
Log("[System] 文件为 jar/litemod 格式，尝试作为 Mod 安装")
+ '检查回收站：回收站中的文件有错误的文件名
+ If FilePathList.First.Contains(":\$RECYCLE.BIN\") Then
+ Hint("请先将文件从回收站还原，再拖入 PCL！", HintType.Critical)
+ Exit Sub
+ End If
'获取并检查目标版本
Dim TargetVersion As McVersion = McVersionCurrent
If PageCurrent = PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version
@@ -799,7 +826,14 @@ Install:
'安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar，总之试一试
Log("[System] 文件为压缩包，尝试作为整合包安装")
- If ModpackInstall(FilePath, ShowHint:=False) IsNot Nothing Then Exit Sub
+ Try
+ ModpackInstall(FilePath)
+ Exit Sub
+ Catch ex As CancelledException
+ Exit Sub '用户主动取消
+ Catch ex As Exception
+ '安装失败，继续往后尝试
+ End Try
End If
'RAR 处理
If Extension = "rar" Then
diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb
index 2f13ab03..83f8d6c3 100644
--- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb
+++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb
@@ -12,13 +12,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
- Public Const VersionBaseName As String = "2.8.9" '不含分支前缀的显示用版本名
- Public Const VersionStandardCode As String = "2.8.9." & VersionBranchCode '标准格式的四段式版本号
+ Public Const VersionBaseName As String = "2.8.10" '不含分支前缀的显示用版本名
+ Public Const VersionStandardCode As String = "2.8.10." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
#If BETA Then
- Public Const VersionCode As Integer = 340 'Release
+ Public Const VersionCode As Integer = 342 'Release
#Else
- Public Const VersionCode As Integer = 341 'Snapshot
+ Public Const VersionCode As Integer = 343 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -990,7 +990,7 @@ Public Module ModBase
End Using
End Function
'''
- ''' 弹出选取文件夹对话框并且要求选取文件夹。如果没有选择就返回空字符串。
+ ''' 弹出选取文件夹对话框并且要求选取文件夹，以 \ 结尾。如果没有选择就返回空字符串。
'''
Public Function SelectFolder(Optional Title As String = "选择文件夹") As String
Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True}
@@ -1207,7 +1207,8 @@ Re:
''' 尝试根据后缀名判断文件种类并解压文件，支持 gz 与 zip，会尝试将 jar 以 zip 方式解压。
''' 会尝试创建，但不会清空目标文件夹。
'''
- Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing)
+ Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing,
+ Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWithF(".gz", True) Then
'以 gz 方式解压
@@ -1223,7 +1224,9 @@ Re:
Else
'以 zip 方式解压
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
+ Dim TotalCount As Integer = Archive.Entries.Count
For Each Entry As ZipArchiveEntry In Archive.Entries
+ If ProgressIncrementHandler IsNot Nothing Then ProgressIncrementHandler(1 / TotalCount)
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
Continue For '不创建空文件夹
@@ -1293,13 +1296,16 @@ RetryDir:
'''
''' 复制文件夹，失败会抛出异常。
'''
- Public Sub CopyDirectory(FromPath As String, ToPath As String)
+ Public Sub CopyDirectory(FromPath As String, ToPath As String, Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
FromPath = FromPath.Replace("/", "\")
If Not FromPath.EndsWithF("\") Then FromPath &= "\"
ToPath = ToPath.Replace("/", "\")
If Not ToPath.EndsWithF("\") Then ToPath &= "\"
- For Each File In EnumerateFiles(FromPath)
+ Dim AllFiles = EnumerateFiles(FromPath).ToList
+ Dim FileCount As Integer = AllFiles.Count
+ For Each File In AllFiles
CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
+ If ProgressIncrementHandler IsNot Nothing Then ProgressIncrementHandler(1 / FileCount)
Next
End Sub
'''
@@ -1552,10 +1558,10 @@ RetryDir:
End Function
'''
- ''' 获取在子字符串之前的部分。
- ''' 会裁切尽可能多的内容，但如果未找到子字符串则不裁切。
+ ''' 获取在子字符串第一次出现之前的部分，例如对 2024/11/08 拆切 / 会得到 2024。
+ ''' 如果未找到子字符串则不裁切。
'''
- Public Function Before(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
+ Public Function BeforeFirst(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase))
If Pos >= 0 Then
Return Str.Substring(0, Pos)
@@ -1564,10 +1570,34 @@ RetryDir:
End If
End Function
'''
- ''' 获取在子字符串之后的部分。
- ''' 会裁切尽可能多的内容，但如果未找到子字符串则不裁切。
+ ''' 获取在子字符串最后一次出现之前的部分，例如对 2024/11/08 拆切 / 会得到 2024/11。
+ ''' 如果未找到子字符串则不裁切。
'''
- Public Function After(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
+ Public Function BeforeLast(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
+ Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase))
+ If Pos >= 0 Then
+ Return Str.Substring(0, Pos)
+ Else
+ Return Str
+ End If
+ End Function
+ '''
+ ''' 获取在子字符串第一次出现之后的部分，例如对 2024/11/08 拆切 / 会得到 11/08。
+ ''' 如果未找到子字符串则不裁切。
+ '''
+ Public Function AfterFirst(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
+ Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase))
+ If Pos >= 0 Then
+ Return Str.Substring(Pos + Text.Length)
+ Else
+ Return Str
+ End If
+ End Function
+ '''
+ ''' 获取在子字符串最后一次出现之后的部分，例如对 2024/11/08 拆切 / 会得到 08。
+ ''' 如果未找到子字符串则不裁切。
+ '''
+ Public Function AfterLast(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase))
If Pos >= 0 Then
Return Str.Substring(Pos + Text.Length)
@@ -1576,8 +1606,8 @@ RetryDir:
End If
End Function
'''
- ''' 获取处于两个子字符串之间的部分。
- ''' 会裁切尽可能多的内容：匹配开始使用 LastIndexOf，匹配结束使用 IndexOf，但如果未找到子字符串则不裁切。
+ ''' 获取处于两个子字符串之间的部分，裁切尽可能多的内容。
+ ''' 如果未找到子字符串则不裁切。
'''
Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.LastIndexOfF(After, IgnoreCase))
@@ -1844,6 +1874,31 @@ RetryDir:
#Region "系统"
+ '''
+ ''' 线程安全的，可以直接使用 For Each 的 List。
+ ''' 在使用 For Each 循环时，列表的结果可能并非最新，但不会抛出异常。
+ '''
+ Public Class SafeList(Of T)
+ Inherits SynchronizedCollection(Of T)
+ Public Sub New()
+ MyBase.New()
+ End Sub
+ Public Sub New(Data As IEnumerable(Of T))
+ MyBase.New(New Object, Data)
+ End Sub
+ Public Shared Widening Operator CType(Data As List(Of T)) As SafeList(Of T)
+ Return New SafeList(Of T)(Data)
+ End Operator
+ Public Shared Widening Operator CType(Data As SafeList(Of T)) As List(Of T)
+ Return New List(Of T)(Data)
+ End Operator
+ Public Overloads Function GetEnumerator() As IEnumerator(Of T)
+ SyncLock SyncRoot
+ Return Items.ToList.GetEnumerator()
+ End SyncLock
+ End Function
+ End Class
+
'''
''' 可用于临时存放文件的，不含任何特殊字符的文件夹路径，以“\”结尾。
'''
@@ -1866,6 +1921,12 @@ RetryDir:
Public Class RestartException
Inherits Exception
End Class
+ '''
+ ''' 指示用户手动取消了操作，或用户已知晓操作被取消的原因。
+ '''
+ Public Class CancelledException
+ Inherits Exception
+ End Class
'''
''' 当前程序是否拥有管理员权限。
@@ -1983,11 +2044,11 @@ NextElement:
'12~60 月，“1 年 2 个月”
GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年" & If((TotalMonthes Mod 12) > 0, " " & (TotalMonthes Mod 12) & " 个月", "")
ElseIf TotalMonthes >= 4 Then
- '4~11 月，“5 月”
- GetTimeSpanString = TotalMonthes & " 月"
+ '4~11 月，“5 个月”
+ GetTimeSpanString = TotalMonthes & " 个月"
ElseIf TotalMonthes >= 1 Then
- '1~4 月，“2 月 13 天”
- GetTimeSpanString = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
+ '1~4 月，“2 个月 13 天”
+ GetTimeSpanString = TotalMonthes & " 个月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
ElseIf Span.TotalDays >= 4 Then
'4~30 天，“23 天”
GetTimeSpanString = Span.Days & " 天"
@@ -2108,7 +2169,7 @@ NextElement:
'''
''' 在新的工作线程中执行代码。
'''
- Public Function RunInNewThread(Action As Action, Name As String, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
+ Public Function RunInNewThread(Action As Action, Optional Name As String = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
Dim th As New Thread(
Sub()
Try
@@ -2118,7 +2179,7 @@ NextElement:
Catch ex As Exception
Log(ex, Name & "：线程执行失败", LogLevel.Feedback)
End Try
- End Sub) With {.Name = Name, .Priority = Priority}
+ End Sub) With {.Name = If(Name, "Runtime New Invoke " & GetUuid() & "#"), .Priority = Priority}
th.Start()
Return th
End Function
diff --git a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb
index e824443d..f0698828 100644
--- a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+++ b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb
@@ -568,7 +568,7 @@ Restart:
End Class
'任务栏进度条
- Public LoaderTaskbar As New SynchronizedCollection(Of LoaderBase)
+ Public LoaderTaskbar As New SafeList(Of LoaderBase)
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb
index db4b3081..9dc67057 100644
--- a/Plain Craft Launcher 2/Modules/Base/ModNet.vb
+++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb
@@ -701,7 +701,7 @@ RequestFinished:
'''
''' 所属的文件列表任务。
'''
- Public Tasks As New SynchronizedCollection(Of LoaderDownload)
+ Public Tasks As New SafeList(Of LoaderDownload)
'''
''' 所有下载源。
'''
@@ -974,7 +974,8 @@ Capture:
Next
'是否禁用多线程，以及规定碎片大小
Dim TargetUrl As String = GetSource().Url
- If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth") Then Return Nothing
+ If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("mcimirror") OrElse TargetUrl.Contains("github.com") OrElse
+ TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("modrinth") Then Return Nothing
'寻找最大碎片
'FUTURE: 下载引擎重做，计算下载源平均链接时间和线程下载速度，按最高时间节省来开启多线程
Dim FilePieceMax As NetThread = Threads
@@ -1303,7 +1304,7 @@ Wrong:
If String.IsNullOrEmpty(header) Then Return Nothing
'attachment; filename="filename.ext"
If Not header.Contains("filename=") Then Return Nothing
- Return header.After("filename=").Trim(""""c, " "c).Before(";")
+ Return header.AfterLast("filename=").Trim(""""c, " "c).BeforeFirst(";")
End Function
'下载文件的最终收束事件
@@ -1469,8 +1470,7 @@ Retry:
'''
''' 需要下载的文件。
'''
- Public Files As List(Of NetFile)
- Private ReadOnly FilesLock As New Object
+ Public Files As SafeList(Of NetFile)
'''
''' 剩余未完成的文件数。（用于减轻 FilesLock 的占用）
'''
@@ -1483,9 +1483,7 @@ Retry:
Public Overrides Property Progress As Double
Get
If State >= LoadState.Finished Then Return 1
- SyncLock FilesLock
- If Not Files.Any() Then Return 0 '必须返回 0，否则在获取列表的时候会错觉已经下载完了
- End SyncLock
+ If Not Files.Any() Then Return 0 '必须返回 0，否则在获取列表的时候会错觉已经下载完了
Return _Progress
End Get
Set(value As Double)
@@ -1507,16 +1505,14 @@ Retry:
Log("[Download] 由于同加载器中失败次数过多引发强制失败：连续失败了 " & value & " 次", LogLevel.Debug)
On Error Resume Next
Dim ExList As New List(Of Exception)
- SyncLock FilesLock
- For Each File In Files
- For Each Source In File.Sources
- If Source.Ex IsNot Nothing Then
- ExList.Add(Source.Ex)
- If ExList.Count > 10 Then GoTo FinishExCatch
- End If
- Next
+ For Each File In Files
+ For Each Source In File.Sources
+ If Source.Ex IsNot Nothing Then
+ ExList.Add(Source.Ex)
+ If ExList.Count > 10 Then GoTo FinishExCatch
+ End If
Next
- End SyncLock
+ Next
FinishExCatch:
OnFail(ExList)
End If
@@ -1533,17 +1529,15 @@ FinishExCatch:
'计算进度
Dim NewProgress As Double = 0
Dim TotalProgress As Double = 0
- SyncLock FilesLock
- For Each File In Files
- If File.IsCopy Then
- NewProgress += File.Progress * 0.2
- TotalProgress += 0.2
- Else
- NewProgress += File.Progress
- TotalProgress += 1
- End If
- Next
- End SyncLock
+ For Each File In Files
+ If File.IsCopy Then
+ NewProgress += File.Progress * 0.2
+ TotalProgress += 0.2
+ Else
+ NewProgress += File.Progress
+ TotalProgress += 1
+ End If
+ Next
If TotalProgress > 0 Then NewProgress /= TotalProgress
'刷新进度
If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 2 * (NewProgress ^ 3) - 3 * (NewProgress ^ 2) + 2 * NewProgress '2x^3-3x^2+2x，模拟开头和结尾更慢的情况
@@ -1552,27 +1546,25 @@ FinishExCatch:
Public Sub New(Name As String, FileTasks As List(Of NetFile))
Me.Name = Name
- Files = FileTasks
+ Files = New SafeList(Of NetFile)(FileTasks)
End Sub
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
- SyncLock FilesLock
- If Input IsNot Nothing Then Files = Input
- '去重
- Dim ResultArray As New List(Of NetFile)
- For i = 0 To Files.Count - 1
- For ii = i + 1 To Files.Count - 1
- If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement
- Next
- ResultArray.Add(Files(i))
+ If Input IsNot Nothing Then Files = New SafeList(Of NetFile)(Input)
+ '去重
+ Dim ResultArray As New SafeList(Of NetFile)
+ For i = 0 To Files.Count - 1
+ For ii = i + 1 To Files.Count - 1
+ If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement
+ Next
+ ResultArray.Add(Files(i))
NextElement:
- Next i
- Files = ResultArray
- '设置剩余文件数
- SyncLock FileRemainLock
- For Each File In Files
- If File.State <> NetState.Finish Then FileRemain += 1
- Next
- End SyncLock
+ Next
+ Files = ResultArray
+ '设置剩余文件数
+ SyncLock FileRemainLock
+ For Each File In Files
+ If File.State <> NetState.Finish Then FileRemain += 1
+ Next
End SyncLock
State = LoadState.Loading
'开始执行
@@ -1615,25 +1607,23 @@ NextElement:
Next
End If
'最多 5 个线程，最少每个线程分配 10 个文件
- SyncLock FilesLock
- Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1)
- Dim FilesInThread As New List(Of NetFile)
- For Each File In Files
- FilesInThread.Add(File)
- If FilesInThread.Count = FilesPerThread Then
- Dim FilesToRun As New List(Of NetFile)
- FilesToRun.AddRange(FilesInThread)
- RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
- FilesInThread.Clear()
- End If
- Next
- If FilesInThread.Any Then
+ Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1)
+ Dim FilesInThread As New List(Of NetFile)
+ For Each File In Files
+ FilesInThread.Add(File)
+ If FilesInThread.Count = FilesPerThread Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
- End SyncLock
+ Next
+ If FilesInThread.Any Then
+ Dim FilesToRun As New List(Of NetFile)
+ FilesToRun.AddRange(FilesInThread)
+ RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
+ FilesInThread.Clear()
+ End If
Catch ex As Exception
OnFail(New List(Of Exception) From {ex})
End Try
@@ -1728,24 +1718,20 @@ Retry:
Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList
[Error] = If(UsefulExs.Any, UsefulExs(0), ExList(0))
'获取实际失败的文件
- SyncLock FilesLock
- For Each File In Files
- If File.State = NetState.Error Then
- [Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf & Join(
- File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "（" & s.Url & "）")), vbCrLf), [Error])
- Exit For
- End If
- Next
- End SyncLock
+ For Each File In Files
+ If File.State = NetState.Error Then
+ [Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf & Join(
+ File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "（" & s.Url & "）")), vbCrLf), [Error])
+ Exit For
+ End If
+ Next
'在设置 Error 对象后再更改为失败，避免 WaitForExit 无法捕获错误
State = LoadState.Failed
End SyncLock
'中断所有文件
- SyncLock FilesLock
- For Each TaskFile In Files
- If TaskFile.State < NetState.Merge Then TaskFile.State = NetState.Error
- Next
- End SyncLock
+ For Each TaskFile In Files
+ If TaskFile.State < NetState.Merge Then TaskFile.State = NetState.Error
+ Next
'在退出同步锁后再进行日志输出
Dim ErrOutput As New List(Of String)
For Each Ex As Exception In ExList
@@ -1760,11 +1746,9 @@ Retry:
End SyncLock
Log("[Download] " & Name & " 已取消！")
'中断所有文件
- SyncLock FilesLock
- For Each TaskFile In Files
- TaskFile.Abort(Me)
- Next
- End SyncLock
+ For Each TaskFile In Files
+ TaskFile.Abort(Me)
+ Next
End Sub
End Class
@@ -1786,8 +1770,7 @@ Retry:
'''
''' 当前的所有下载任务。
'''
- Public Tasks As New List(Of LoaderDownload)
- Private ReadOnly LockTasks As New Object
+ Public Tasks As New SafeList(Of LoaderDownload)
'''
''' 已下载完成的大小。
@@ -1860,11 +1843,9 @@ Retry:
End If
#End Region
#Region "刷新下载任务属性"
- SyncLock LockTasks
- For Each Task In Tasks
- Task.RefreshStat()
- Next
- End SyncLock
+ For Each Task In Tasks
+ Task.RefreshStat()
+ Next
#End Region
Catch ex As Exception
Log(ex, "刷新下载公开属性失败")
@@ -2010,9 +1991,7 @@ Retry:
Task.Files(i) = File '回设
Next
End SyncLock
- SyncLock LockTasks
- Tasks.Add(Task)
- End SyncLock
+ Tasks.Add(Task)
End Sub
End Class
diff --git a/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb b/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
index e126d616..c5303d60 100644
--- a/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
+++ b/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
@@ -17,15 +17,19 @@ Public Class MyBitmap
'自动类型转换
'支持的类：Image，ImageSource，Bitmap，ImageBrush，BitmapSource
Public Shared Widening Operator CType(Image As System.Drawing.Image) As MyBitmap
+ If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image)
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Image
+ If Image Is Nothing Then Return Nothing
Return Image.Pic
End Operator
Public Shared Widening Operator CType(Image As ImageSource) As MyBitmap
+ If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image)
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource
+ If Image Is Nothing Then Return Nothing
Dim Bitmap = Image.Pic
Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height)
Dim bitmapData = Bitmap.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
@@ -37,15 +41,19 @@ Public Class MyBitmap
End Try
End Operator
Public Shared Widening Operator CType(Image As System.Drawing.Bitmap) As MyBitmap
+ If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image)
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Bitmap
+ If Image Is Nothing Then Return Nothing
Return Image.Pic
End Operator
Public Shared Widening Operator CType(Image As ImageBrush) As MyBitmap
+ If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image)
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As ImageBrush
+ If Image Is Nothing Then Return Nothing
Return New ImageBrush(New MyBitmap(Image.Pic))
End Operator
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
index 73614ed2..97e7bde8 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
@@ -271,7 +271,7 @@
Next
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")).
- Select(Function(v) CInt(Val(v.Split(".")(1).Before("-")))).Where(Function(v) v > 0).
+ Select(Function(v) CInt(Val(v.Split(".")(1).BeforeFirst("-")))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Type
@@ -349,7 +349,7 @@
'搜索结果的键为 versions，获取特定工程的键为 game_versions
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")).
- Select(Of Integer)(Function(v) Val(v.Split(".")(1).Before("-"))).Where(Function(v) v > 0).
+ Select(Of Integer)(Function(v) Val(v.Split(".")(1).BeforeFirst("-"))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
'Type
Select Case Data("project_type").ToString
@@ -583,9 +583,9 @@
'有中文翻译
'尝试将文本分为三段：Title (EnglishName) - Suffix
'检查时注意 Carpet：它没有中文译名，但有 Suffix
- Title = TranslatedName.Before(" (").Before(" - ")
+ Title = TranslatedName.BeforeFirst(" (").BeforeFirst(" - ")
Dim Suffix As String = ""
- If TranslatedName.After(")").Contains(" - ") Then Suffix = TranslatedName.After(")").After(" - ")
+ If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ")
Dim EnglishName As String = TranslatedName
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
@@ -758,7 +758,7 @@ NoSubtitle:
Case CompType.ResourcePack
'FUTURE: Res
End Select
- Address += "&categoryId=" & If(Tag = "", "0", Tag.Before("/"))
+ Address += "&categoryId=" & If(Tag = "", "0", Tag.BeforeFirst("/"))
If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
@@ -779,7 +779,7 @@ NoSubtitle:
'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
Dim Facets As New List(Of String)
Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]")
- If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.After("/")}'""]")
+ If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]")
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
Address += "&facets=[" & String.Join(",", Facets) & "]"
@@ -887,7 +887,7 @@ NoSubtitle:
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " "
If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " "
- SearchResult += SearchResults(i).Item.ChineseName.After(" (").TrimEnd(") ").Before(" - ").
+ SearchResult += SearchResults(i).Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " "
Next
Log("[Comp] 中文搜索原始关键词：" & SearchResult, LogLevel.Developer)
@@ -1313,7 +1313,7 @@ Retry:
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
- Select(Function(v) If(v.Contains("-"), v.Before("-") & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
+ Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
@@ -1362,28 +1362,26 @@ Retry:
Optional BadDisplayName As Boolean = False) As MyListItem
'获取描述信息
- Dim Info As String = ""
+ Dim Title As String = If(BadDisplayName, FileName, DisplayName)
+ Dim Info As New List(Of String)
+ If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast("."))
Select Case Type
Case CompType.Mod
- Info += If(ModLoaders.Any,
- "适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & "，", "")
- Info += If(ModeDebug AndAlso Dependencies.Any, Dependencies.Count & " 个前置 Mod，", "")
+ If Dependencies.Any Then Info.Add(Dependencies.Count & " 个前置 Mod")
Case CompType.ModPack
- If GameVersions.All(Function(v) v.Contains("w")) Then
- Info += $"游戏版本 {Join(GameVersions, "、")}，"
- End If
+ If GameVersions.All(Function(v) v.Contains("w")) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
End Select
If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
- Info += If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载，", DownloadCount & " 次下载，")
+ Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
End If
- Info += GetTimeSpanString(ReleaseDate - Date.Now, False) & "更新"
- Info += If(Status = CompFileStatus.Release, "", "，" & StatusDescription)
+ Info.Add("更新于 " & GetTimeSpanString(ReleaseDate - Date.Now, False))
+ If Status <> CompFileStatus.Release Then Info.Add(StatusDescription)
'建立控件
Dim NewItem As New MyListItem With {
- .Title = If(BadDisplayName, FileName, DisplayName),
+ .Title = Title,
.SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
- .Info = Info
+ .Info = Info.Join("，")
}
Select Case Status
Case CompFileStatus.Release
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
index c88ce9ff..a3b3c614 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
@@ -381,6 +381,7 @@ Extracted:
没有可用的分析文件
使用32位Java导致JVM无法分配足够多的内存
Mod重复安装
+ Mod互不兼容
OptiFine与Forge不兼容
Fabric报错
Fabric报错并给出解决方案
@@ -413,7 +414,7 @@ Extracted:
'崩溃日志
If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析")
- Keywords.AddRange(AnalyzeStackKeyword(LogCrash.Before("System Details")))
+ Keywords.AddRange(AnalyzeStackKeyword(LogCrash.BeforeFirst("System Details")))
End If
'Minecraft 日志
If LogMc IsNot Nothing Then
@@ -541,12 +542,14 @@ Done:
End If
'确定的 Mod 导致崩溃
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
- 'Mod 重复安装
+ 'Mod 重复 / 前置问题
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("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
- 'Mod 缺少前置
+ If LogMc.Contains("Incompatible mods found!") Then '#5006
+ AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), ""))
+ End If
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
AppendReason(CrashReason.Mod缺少前置或MC版本错误,
RegexSearch(LogMc, "(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase).
@@ -592,37 +595,51 @@ Done:
'''
Private Sub AnalyzeCrit2()
+ 'Mixin 分析
+ Dim MixinAnalyze =
+ Function(LogText As String) As Boolean
+ Dim IsMixin As Boolean =
+ LogText.Contains("Mixin prepare failed ") OrElse LogText.Contains("Mixin apply failed ") OrElse
+ LogText.Contains("MixinApplyError") OrElse LogText.Contains("MixinTransformerError") OrElse
+ LogText.Contains("mixin.injection.throwables.") OrElse LogText.Contains(".json] FAILED during )")
+ If Not IsMixin Then Return False
+ 'Mod 名称匹配
+ Dim ModName As String = RegexSeek(LogText, "(?<=from mod )[^.\/ ]+(?=\] from)")
+ If ModName Is Nothing Then ModName = RegexSeek(LogText, "(?<=for mod )[^.\/ ]+(?= failed)")
+ If ModName IsNot Nothing Then
+ AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(ModName.TrimEnd((vbCrLf & " ").ToCharArray)))
+ Return True
+ End If
+ 'JSON 名称匹配
+ For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(]{1})[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
+ AppendReason(CrashReason.ModMixin失败,
+ TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
+ Return True
+ Next
+ '没有明确匹配
+ AppendReason(CrashReason.ModMixin失败)
+ Return True
+ End Function
+
'游戏日志分析
If LogMc IsNot Nothing Then
+ 'Mixin 崩溃
+ Dim IsMixin As Boolean = MixinAnalyze(LogMc)
'常规信息
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))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("确定了一种可能的解决方法，这样做可能会解决你的问题：") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法，这样做可能会解决你的问题：\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
- 'Mixin 崩溃
- If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("MixinApplyError") OrElse
- LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".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, "(?<= failed 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, "(?<=from mod )[^./ ]+(?=\] from)")
- If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=for mod )[^./ ]+(?= failed)")
- '兜底名称判断
- If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json)")
- If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json)")
- AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
- Else
- '在 #3104 的情况下，这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
- If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
+ If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下，这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
+ AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
End If
'崩溃报告分析
If LogCrash IsNot Nothing Then
+ 'Mixin 崩溃
+ MixinAnalyze(LogCrash)
+ '常规信息
If LogCrash.Contains("Suspected Mod") Then
Dim SuspectsRaw As String = LogCrash.Between("Suspected Mod", "Stacktrace")
If Not SuspectsRaw.StartsWithF("s: None") Then 'Suspected Mods: None
@@ -644,6 +661,8 @@ Done:
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
+ 'Mod 解析错误（常见于 Fabric 前置校验失败）
+ If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错)
'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! 不一定是崩溃原因，它可能是单纯的警报
@@ -699,7 +718,7 @@ NextStack:
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", "impl", "data", "pool", "task",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world",
- "gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
+ "gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge",
"injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "neoforged", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill"
@@ -742,7 +761,7 @@ NextStack:
Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式")
End If
- Details = Details.After("¨")
+ Details = Details.AfterLast("¨")
'[Forge] 获取所有包含 .jar 的行
'[Fabric] 获取所有包含 Mod 信息的行
@@ -877,16 +896,19 @@ NextStack:
If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles)
For Each OutputFile In OutputFiles
Dim FileName As String = GetFileNameFromPath(OutputFile)
+ Dim FileEncoding As Encoding = Nothing
Select Case FileName
Case "LatestLaunch.bat"
FileName = "启动脚本.bat"
Case "Log1.txt"
FileName = "PCL 启动器日志.txt"
+ FileEncoding = Encoding.UTF8
Case "RawOutput.log"
FileName = "游戏崩溃前的输出.txt"
+ FileEncoding = Encoding.UTF8
End Select
If File.Exists(OutputFile) Then
- Dim FileEncoding As Encoding = GetEncoding(ReadFileBytes(OutputFile))
+ If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
WriteFile(TempFolder & "Report\" & FileName,
SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
Encoding:=FileEncoding)
@@ -914,7 +936,7 @@ NextStack:
If IsHandAnalyze Then
Return "很抱歉，PCL 无法确定错误原因。"
Else
- Return $"很抱歉，你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助，请导出错误报告并发给他人，而不是发送这个窗口的截图。"
+ Return $"很抱歉，你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助，请把错误报告文件发给对方，而不是发送这个窗口的照片或者截图。"
End If
End If
@@ -970,7 +992,9 @@ NextStack:
Results.Add("以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.ModMixin失败
- If Additional.Count = 1 Then
+ If Additional.Count = 0 Then
+ Results.Add("部分 Mod 注入失败，导致游戏出错。\n这一般代表着部分 Mod 与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试逐步禁用 Mod，然后观察游戏是否还会崩溃，以此定位导致崩溃的 Mod。\n\e\h")
+ ElseIf Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 注入失败，导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试禁用此 Mod，然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h")
@@ -1043,25 +1067,31 @@ NextStack:
If Additional.Count = 1 Then
Results.Add("Fabric 提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。")
Else
- Results.Add("Fabric 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h")
+ Results.Add("Fabric 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h")
+ End If
+ Case CrashReason.Mod互不兼容
+ If Additional.Count = 1 Then
+ Results.Add("你所安装的 Mod 不兼容：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。")
+ Else
+ Results.Add("你所安装的 Mod 不兼容，Mod 加载器可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\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")
+ Results.Add("Mod 加载器可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\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")
+ Results.Add("Fabric 可能已经提供了解决方案，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\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")
+ Results.Add("Forge 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.没有可用的分析文件
Results.Add("你的游戏出现了一些问题，但 PCL 未能找到相关记录文件，因此无法进行分析。\h")
@@ -1077,7 +1107,7 @@ NextStack:
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
Trim(vbCrLf.ToCharArray) &
If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
- vbCrLf & "如果要寻求帮助，请向他人发送错误报告文件，而不是发送这个窗口的截图。" &
+ vbCrLf & "如果要寻求帮助，请把错误报告文件发给对方，而不是发送这个窗口的照片或者截图。" &
If(If(PageSetupSystem.IsLauncherNewest(), True), "",
vbCrLf & vbCrLf & "此外，你正在使用老版本 PCL，更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
End Function
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
index 5cbf8e25..832b372c 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
@@ -780,7 +780,7 @@
Inherit = "1.20.1"
Else '20.4.30-beta
VersionName = ApiName
- Version = New Version(ApiName.Before("-"))
+ Version = New Version(ApiName.BeforeFirst("-"))
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor)
End If
End Sub
@@ -1089,7 +1089,7 @@
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
- 'UNDONE: 在 MCIM 源稳定后回调
+ 'TODO: 在 MCIM 源稳定后回调
Case 0
If ModeDebug Then
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
@@ -1138,7 +1138,7 @@
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
- 'UNDONE: 在 MCIM 源稳定后回调
+ 'TODO: 在 MCIM 源稳定后回调
Case 0
If ModeDebug Then
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
index af527eff..1eee00a3 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
@@ -681,8 +681,8 @@ Wait:
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
- If IsFullSearch OrElse FolderInfo.Parent.Name.ToLower = "users" OrElse
- Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
+ If IsFullSearch OrElse
+ FolderInfo.Parent.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
JavaSearchFolder(FolderInfo, Results, Source)
End If
Next
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
index 1be022c1..ecf4dcc6 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
@@ -380,7 +380,7 @@ NextInner:
Case McLoginType.Ms
If Setup.Get("CacheMsV2Name") <> "" Then Return Setup.Get("CacheMsV2Name")
Case McLoginType.Legacy
- If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
+ If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨")
Case McLoginType.Nide
If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
Case McLoginType.Auth
@@ -390,7 +390,7 @@ NextInner:
If Setup.Get("CacheMsV2Name") <> "" Then Return Setup.Get("CacheMsV2Name")
If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
- If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
+ If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨")
Return Nothing
End Function
'''
@@ -501,7 +501,7 @@ NextInner:
#Region "分方式登录模块"
'各个登录方式的主对象与输入构造
- Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart)
+ Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 1}
Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
index 213a82c5..ca8315bd 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
@@ -1291,8 +1291,11 @@ OnLoaded:
'单独列出收藏的版本
Dim StaredVersions As New List(Of McVersion)
- For Each Version As McVersion In VersionList
- If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then StaredVersions.Add(Version)
+ For Each Version As McVersion In VersionList.ToList
+ If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then
+ StaredVersions.Add(Version)
+ VersionList.Remove(Version)
+ End If
Next
If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions)
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
index a6662adf..f1cb1699 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
@@ -688,7 +688,7 @@ Finished:
'''
Public ReadOnly Property CanUpdate As Boolean
Get
- Return ChangelogUrls.Any()
+ Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso ChangelogUrls.Any()
End Get
End Property
@@ -702,7 +702,7 @@ Finished:
Dim Info As New FileInfo(Path)
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
- If Cached <> "" Then
+ If Cached <> "" AndAlso RegexCheck(Cached, "^\d+$") Then '#5062
_CurseForgeHash = Cached
Return _CurseForgeHash
End If
diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
index d7285bd1..487e0e6f 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
@@ -1,4 +1,5 @@
Imports System.IO.Compression
+Imports System.Linq.Expressions
Public Module ModModpack
@@ -9,13 +10,22 @@ Public Module ModModpack
Public Sub ModpackInstall()
Dim File As String = SelectFile("整合包文件(*.rar;*.zip;*.mrpack)|*.rar;*.zip;*.mrpack", "选择整合包压缩文件") '选择整合包文件
If String.IsNullOrEmpty(File) Then Exit Sub
- RunInThread(Sub() ModpackInstall(File))
+ RunInThread(
+ Sub()
+ Try
+ ModpackInstall(File)
+ Catch ex As CancelledException
+ Catch ex As Exception
+ Log(ex, "手动安装整合包失败", LogLevel.Msgbox)
+ End Try
+ End Sub)
End Sub
'''
- ''' 安装一个给定的整合包文件，返回启动的安装加载器，如果未成功启动则返回 Nothing。
+ ''' 构建并启动安装给定的整合包文件的加载器，并返回该加载器。若失败则抛出异常。
''' 必须在工作线程执行。
'''
- Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As LoaderCombo(Of String)
+ '''
+ Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Log("[ModPack] 整合包安装请求：" & If(File, "null"))
Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = ""
@@ -23,7 +33,7 @@ Public Module ModModpack
'获取整合包种类与关键 Json
Dim PackType As Integer = -1
Try
- Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
+ Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.Read))
'从根目录判断整合包类型
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
@@ -37,11 +47,11 @@ Public Module ModModpack
End If
End If
If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
+ If Archive.GetEntry("modpack.zip") IsNot Nothing OrElse Archive.GetEntry("modpack.mrpack") IsNot Nothing Then PackType = 9 : Exit Try '带启动器的压缩包
'从一级目录判断整合包类型
For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/")
ArchiveBaseFolder = FullNames(0) & "/"
- If Entry.FullName.EndsWithF("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包
'确定为一级目录下
If FullNames.Count <> 2 Then Continue For
'判断是否为关键文件
@@ -57,17 +67,15 @@ Public Module ModModpack
End If
End If
If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
+ If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
Next
Catch ex As Exception
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
- Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
- Return Nothing
+ Throw New Exception("打开整合包文件失败", ex)
ElseIf File.EndsWithF(".rar", True) Then
- Log(ex, "PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
- Return Nothing
+ Throw New Exception("PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", ex)
Else
- Log(ex, "打开整合包文件失败，文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
- Return Nothing
+ Throw New Exception("打开整合包文件失败，文件可能损坏或为不支持的压缩包格式", ex)
End If
End Try
'执行对应的安装方法
@@ -88,21 +96,12 @@ Public Module ModModpack
Log("[ModPack] 整合包种类：Modrinth")
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 9
- Log("[ModPack] 整合包种类：压缩包")
- Archive.Dispose()
- Archive = Nothing
- Return InstallPackCompress(File, ArchiveBaseFolder)
+ Log("[ModPack] 整合包种类：带启动器的压缩包")
+ Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
Case Else
- If ShowHint Then
- Hint("未能识别该整合包的种类，无法安装！", HintType.Critical)
- Else
- Log("[ModPack] 未能识别该整合包的种类，无法安装！")
- End If
- Return Nothing
+ Log("[ModPack] 整合包种类：未能识别，假定为压缩包")
+ Return InstallPackCompress(File, Archive)
End Select
- Catch ex As Exception
- Log(ex, "准备安装整合包失败", LogLevel.Feedback)
- Return Nothing
Finally
If Archive IsNot Nothing Then Archive.Dispose()
End Try
@@ -111,7 +110,7 @@ Public Module ModModpack
'整合包缓存清理
Private IsInstallCacheCleared As Boolean = False
Private IsInstallCacheClearing As Boolean = False
- Private Sub UnpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase)
+ Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, LoaderProgressDelta As Double)
'清理缓存文件夹
If Not IsInstallCacheCleared Then
IsInstallCacheCleared = True
@@ -138,7 +137,7 @@ Public Module ModModpack
Retry:
'完全不知道为啥会出现文件正在被另一进程使用的问题，总之多试试
DeleteDirectory(InstallTemp)
- ExtractFile(FileAddress, InstallTemp, Encode)
+ ExtractFile(FileAddress, InstallTemp, Encode, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * LoaderProgressDelta)
Catch ex As Exception
Log(ex, "第 " & RetryCount & " 次解压尝试失败")
If TypeOf ex Is ArgumentException Then
@@ -151,7 +150,7 @@ Retry:
RetryCount += 1
GoTo Retry
Else
- Throw
+ Throw New Exception("解压整合包文件失败", ex)
End If
End Try
End Sub
@@ -166,20 +165,18 @@ Retry:
Dim Json As JObject
Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
- If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception
- Log(ex, "CurseForge 整合包安装信息存在问题", LogLevel.Hint)
- Return Nothing
+ Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
End Try
+ If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息")
'获取版本名
- Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
- If String.IsNullOrEmpty(VersionName) Then Return Nothing
+ If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
End If
'获取 Mod API 版本信息
@@ -190,35 +187,19 @@ Retry:
Dim Id As String = If(Entry("id"), "").ToString.ToLower
If Id.StartsWithF("forge-") Then
'Forge 指定
- If Id.Contains("recommended") Then
- Log("[ModPack] 该整合包版本过老，已不支持进行安装！", LogLevel.Hint)
- Return Nothing
- End If
- Try
- Log("[ModPack] 整合包 Forge 版本：" & Id)
- ForgeVersion = Id.Replace("forge-", "")
- Exit For
- Catch ex As Exception
- Log(ex, "读取整合包 Forge 版本失败：" & Id)
- End Try
+ If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老，已不支持进行安装！")
+ Log("[ModPack] 整合包 Forge 版本：" & Id)
+ ForgeVersion = Id.Replace("forge-", "")
ElseIf Id.StartsWithF("neoforge-") Then
'NeoForge 指定
- Try
- Log("[ModPack] 整合包 NeoForge 版本：" & Id)
- NeoForgeVersion = Id.Replace("neoforge-", "")
- Exit For
- Catch ex As Exception
- Log(ex, "读取整合包 NeoForge 版本失败：" & Id)
- End Try
+ Log("[ModPack] 整合包 NeoForge 版本：" & Id)
+ NeoForgeVersion = Id.Replace("neoforge-", "")
ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定
- Try
- Log("[ModPack] 整合包 Fabric 版本：" & Id)
- FabricVersion = Id.Replace("fabric-", "")
- Exit For
- Catch ex As Exception
- Log(ex, "读取整合包 Fabric 版本失败：" & Id)
- End Try
+ Log("[ModPack] 整合包 Fabric 版本：" & Id)
+ FabricVersion = Id.Replace("fabric-", "")
+ Else
+ Log("[ModPack] 未知 Mod 加载器：" & Id)
End If
Next
'解压与配置文件
@@ -228,17 +209,17 @@ Retry:
If OverrideHome <> "" Then
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
- UnpackFiles(InstallTemp, FileAddress, Task)
- Task.Progress = 0.5
+ ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
+ Task.Progress = 0.6
Dim OverridePath As String = InstallTemp & ArchiveBaseFolder & OverrideHome
'复制结果
If Directory.Exists(OverridePath) Then
- CopyDirectory(OverridePath, PathMcFolder & "versions\" & VersionName)
+ CopyDirectory(OverridePath, PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
Log($"[ModPack] 整合包 override 复制：{OverridePath} -> {PathMcFolder & "versions\" & VersionName}")
Else
Log($"[ModPack] 整合包中未找到 override 文件夹：{OverridePath}")
End If
- Task.Progress = 0.9
+ Task.Progress = 0.95
'开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {
@@ -260,9 +241,11 @@ Retry:
'获取 Mod 下载信息
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray))
- Task.Output = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
+ '由于 MCIM 缺少下载信息，只使用官方源获取列表
+ 'TODO: 在 MCIM 源稳定后回调回 DlModRequest
+ Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
'如果文件已被删除，则 API 会跳过那一项
- If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除，因此无法完成整合包安装，请联系整合包作者更新整合包中的 Mod 版本")
+ If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除，所以没法继续安装了，请向整合包作者反馈该问题")
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
'构造 NetFile
ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
@@ -320,7 +303,6 @@ Retry:
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
- If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -353,7 +335,7 @@ Retry:
Dim LoaderName As String = "CurseForge 整合包安装：" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Critical)
- Return Nothing
+ Throw New CancelledException
End If
'启动
@@ -361,7 +343,7 @@ Retry:
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
- If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
+ RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
Return Loader
End Function
@@ -372,11 +354,10 @@ Retry:
Dim Json As JObject
Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open))
- If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception
- Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
- Return Nothing
+ Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
End Try
+ If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息")
'获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing
Dim ForgeVersion As String = Nothing
@@ -397,39 +378,40 @@ Retry:
Log("[ModPack] 整合包 Fabric 版本：" & FabricVersion)
Case "quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
- Return Nothing
+ Throw New CancelledException
Case Else
Hint($"无法安装整合包，其中出现了未知的 Mod 加载器 {Entry.Value}！", HintType.Critical)
- Return Nothing
+ Throw New CancelledException
End Select
Next
'获取版本名
- Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
- If String.IsNullOrEmpty(VersionName) Then Return Nothing
+ If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
End If
'解压和配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
- UnpackFiles(InstallTemp, FileAddress, Task)
- Task.Progress = 0.5
+ ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
+ Task.Progress = 0.6
'复制 overrides 文件夹和 client-overrides 文件夹
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
- CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
+ CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
+ Sub(Delta) Task.Progress += Delta * 0.25)
Else
Log("[ModPack] 整合包中未找到 override 目录，已跳过")
End If
- Task.Progress = 0.8
+ Task.Progress = 0.85
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
- CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName)
+ CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName,
+ Sub(Delta) Task.Progress += Delta * 0.1)
End If
- Task.Progress = 0.9
+ Task.Progress = 0.95
'开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
@@ -469,7 +451,6 @@ Retry:
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
- If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -502,7 +483,7 @@ Retry:
Dim LoaderName As String = "Modrinth 整合包安装：" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Critical)
- Return Nothing
+ Throw New CancelledException
End If
'启动
@@ -510,9 +491,8 @@ Retry:
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
- If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
+ RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
Return Loader
-
End Function
'HMCL
@@ -522,44 +502,39 @@ Retry:
Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
Catch ex As Exception
- Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
- Return Nothing
+ Throw New Exception("HMCL 整合包安装信息存在问题", ex)
End Try
'获取版本名
Dim VersionName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
- If String.IsNullOrEmpty(VersionName) Then Return Nothing
+ If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
'解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
- UnpackFiles(InstallTemp, FileAddress, Task)
- Task.Progress = 0.5
+ ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
+ Task.Progress = 0.6
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
- CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName)
+ CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
Else
Log("[ModPack] 整合包中未找到 minecraft override 目录，已跳过")
End If
- Task.Progress = 0.9
+ Task.Progress = 0.95
'开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造加载器
- If Json("gameVersion") Is Nothing Then
- Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical)
- Return Nothing
- End If
+ If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Json("gameVersion").ToString
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
- If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json（副加载器）",
@@ -589,7 +564,7 @@ Retry:
Dim LoaderName As String = "HMCL 整合包安装：" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Critical)
- Return Nothing
+ Throw New CancelledException
End If
'启动
@@ -598,7 +573,7 @@ Retry:
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
- FrmMain.BtnExtraDownload.Ribble()
+ RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
Return Loader
End Function
@@ -610,30 +585,29 @@ Retry:
PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8))
PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
Catch ex As Exception
- Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
- Return Nothing
+ Throw New Exception("MMC 整合包安装信息存在问题", ex)
End Try
'获取版本名
Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
- If String.IsNullOrEmpty(VersionName) Then Return Nothing
+ If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
'解压、配置设置文件
Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\"
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
- UnpackFiles(InstallTemp, FileAddress, Task)
- Task.Progress = 0.5
+ ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
+ Task.Progress = 0.6
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
- CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName)
+ CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
Else
Log("[ModPack] 整合包中未找到 override .minecraft 目录，已跳过")
End If
- Task.Progress = 0.9
+ Task.Progress = 0.95
'开启版本隔离
WriteIni(SetupFile, "VersionArgumentIndie", 1)
'读取 MMC 设置文件（#2655）
@@ -676,10 +650,7 @@ Retry:
End Try
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造版本安装请求
- If PackJson("components") Is Nothing Then
- Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical)
- Return Nothing
- End If
+ If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
For Each Component In PackJson("components")
Select Case If(Component("uid"), "").ToString
@@ -695,12 +666,11 @@ Retry:
Request.FabricVersion = Component("version")
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
- Return Nothing
+ Throw New CancelledException
End Select
Next
'构造加载器
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
- If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -715,7 +685,7 @@ Retry:
Dim LoaderName As String = "MMC 整合包安装：" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Critical)
- Return Nothing
+ Throw New CancelledException
End If
'启动
@@ -723,7 +693,7 @@ Retry:
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
- FrmMain.BtnExtraDownload.Ribble()
+ RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
Return Loader
End Function
@@ -736,51 +706,44 @@ Retry:
Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
Catch ex As Exception
- Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
- Return Nothing
+ Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
End Try
'获取版本名
- Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
- If String.IsNullOrEmpty(VersionName) Then Return Nothing
+ If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
End If
'解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
- UnpackFiles(InstallTemp, FileAddress, Task)
- Task.Progress = 0.5
+ ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
+ Task.Progress = 0.6
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
- CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
+ CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
+ Sub(Delta) Task.Progress += 0.35 * Delta)
Else
Log("[ModPack] 整合包中未找到 overrides 目录，已跳过")
End If
- Task.Progress = 0.9
+ Task.Progress = 0.95
'开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造加载器
- If Json("addons") Is Nothing Then
- Hint("该整合包未提供游戏版本附加信息，无法安装！", HintType.Critical)
- Return Nothing
- End If
+ If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息，无法安装！")
Dim Addons As New Dictionary(Of String, String)
For Each Entry In Json("addons")
Addons.Add(Entry("id"), Entry("version"))
Next
- If Not Addons.ContainsKey("game") Then
- Hint("该整合包未提供游戏版本信息，无法安装！", HintType.Critical)
- Return Nothing
- End If
+ If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息，无法安装！")
If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Critical)
- Return Nothing
+ Throw New CancelledException
End If
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
@@ -792,7 +755,6 @@ Retry:
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
- If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -807,7 +769,7 @@ Retry:
Dim LoaderName As String = "MCBBS 整合包安装：" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Critical)
- Return Nothing
+ Throw New CancelledException
End If
'启动
@@ -816,31 +778,101 @@ Retry:
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
- If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
+ RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
Return Loader
End Function
- '普通压缩包
- Private Function InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) As LoaderCombo(Of String)
- MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹，它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True)
+ '带启动器的压缩包
+ Private Function InstallPackLauncherPack(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'获取解压路径
+ MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
- If String.IsNullOrEmpty(TargetFolder) Then Return Nothing
- If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Return Nothing
- If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Return Nothing
- '要求显示名称
- Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", GetFolderNameFromPath(TargetFolder),
- New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
- If String.IsNullOrWhiteSpace(NewName) Then Return Nothing
+ If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
+ If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Throw New CancelledException
+ If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Throw New CancelledException
'解压
- Dim Loader As New LoaderCombo(Of String)("安装压缩包", {
- New LoaderTask(Of String, Integer)("安装压缩包",
- Sub()
- UnpackFiles(TargetFolder, FileAddress, Nothing)
- PageSelectLeft.AddFolder(TargetFolder, NewName, False) '加入文件夹列表
- End Sub)
+ Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
+ New LoaderTask(Of String, Integer)("解压压缩包",
+ Sub(Task As LoaderTask(Of String, Integer))
+ ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.9)
+ Thread.Sleep(400) '避免文件争用
+ '查找解压后的 exe 文件
+ Dim Launcher As String = Nothing
+ For Each ExeFile In Directory.GetFiles(TargetFolder, "*.exe", SearchOption.AllDirectories)
+ Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
+ Log($"[Modpack] 文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
+ If Info.ProductName = "Plain Craft Launcher" Then
+ Launcher = ExeFile
+ ElseIf (Info.ProductName.ContainsF("Launcher", True) OrElse Info.ProductName.ContainsF("启动器", True)) AndAlso
+ Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then
+ If Launcher Is Nothing Then Launcher = ExeFile
+ End If
+ Next
+ Task.Progress = 0.95
+ '尝试使用附带的启动器打开
+ If Launcher IsNot Nothing Then
+ Log("[Modpack] 找到压缩包中附带的启动器：" & Launcher)
+ If MyMsgBox($"整合包中似乎自带了启动器，是否换用它继续安装？{vbCrLf}通常推荐这样做，以获得最佳体验。{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "继续", "取消") = 1 Then
+ ShellOnly(Launcher, "--wait")
+ Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序")
+ FrmMain.EndProgram(False)
+ Return
+ End If
+ Else
+ Log("[Modpack] 未找到压缩包中附带的启动器")
+ End If
+ '加入文件夹列表
+ Dim VersionName As String = GetFolderNameFromPath(TargetFolder)
+ PageSelectLeft.AddFolder(
+ TargetFolder & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
+ VersionName, False)
+ '调用 modpack 文件进行安装
+ Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
+ Log("[Modpack] 调用 modpack 文件继续安装：" & ModpackFile)
+ ModpackInstall(ModpackFile, VersionName)
+ End Sub)
})
- Loader.Start()
+ Loader.Start(TargetFolder)
+ LoaderTaskbarAdd(Loader)
+ FrmMain.BtnExtraDownload.ShowRefresh()
+ FrmMain.BtnExtraDownload.Ribble()
+ Return Loader
+ End Function
+
+ '普通压缩包
+ Private Function InstallPackCompress(FileAddress As String, Archive As Compression.ZipArchive) As LoaderCombo(Of String)
+ '尝试定位 .minecraft 文件夹：寻找形如 “/versions/XXX/XXX.json” 的路径
+ Dim Match As RegularExpressions.Match = Nothing
+ Dim Regex As New RegularExpressions.Regex("^.*\/(?=versions\/(?[^\/]+)\/(\k)\.json$)", RegularExpressions.RegexOptions.IgnoreCase)
+ For Each Entry In Archive.Entries
+ Dim EntryMatch = Regex.Match("/" & Entry.FullName)
+ If EntryMatch.Success Then
+ Match = EntryMatch
+ Exit For
+ End If
+ Next
+ If Match Is Nothing Then Throw New Exception("未能找到适合的文件结构，这可能不是一个 MC 压缩包") '没有匹配
+ Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
+ Dim VersionName As String = Match.Groups(1).Value
+ Log("[ModPack] 检测到压缩包的 .minecraft 根目录：" & ArchiveBaseFolder & "，命中的版本名：" & VersionName)
+ '获取解压路径
+ MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
+ Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
+ If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
+ If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Throw New CancelledException
+ If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Throw New CancelledException
+ '解压
+ Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
+ New LoaderTask(Of String, Integer)("解压压缩包",
+ Sub(Task As LoaderTask(Of String, Integer))
+ ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.95)
+ '加入文件夹列表
+ PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
+ Thread.Sleep(400) '避免文件争用
+ RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.VersionSelect))
+ End Sub)
+ }) With {.OnStateChanged = AddressOf McInstallState}
+ Loader.Start(TargetFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
diff --git a/Plain Craft Launcher 2/Modules/ModEvent.vb b/Plain Craft Launcher 2/Modules/ModEvent.vb
index 9c29699f..be69955b 100644
--- a/Plain Craft Launcher 2/Modules/ModEvent.vb
+++ b/Plain Craft Launcher 2/Modules/ModEvent.vb
@@ -139,7 +139,6 @@
Dim LocalTemp1 As String = PathTemp & "CustomEvent\" & RawFileName
Dim LocalTemp2 As String = PathTemp & "CustomEvent\" & RawFileName.Replace(".json", ".xaml")
Log("[Event] 转换网络资源：" & RelativeUrl & " -> " & LocalTemp1)
- Hint("正在获取资源，请稍候……")
Try
NetDownload(RelativeUrl, LocalTemp1)
NetDownload(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml"))
diff --git a/Plain Craft Launcher 2/Modules/ModMain.vb b/Plain Craft Launcher 2/Modules/ModMain.vb
index e629d767..e93cb749 100644
--- a/Plain Craft Launcher 2/Modules/ModMain.vb
+++ b/Plain Craft Launcher 2/Modules/ModMain.vb
@@ -443,6 +443,10 @@ EndHint:
#Region "帮助"
Public Class HelpEntry
+ '''
+ ''' 原始信息路径。用于刷新。
+ '''
+ Public RawPath As String
'基础
@@ -501,6 +505,7 @@ EndHint:
''' 从文件初始化 HelpEntry 对象，失败会抛出异常。
'''
Public Sub New(FilePath As String)
+ RawPath = FilePath
Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath)))
If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件：" & FilePath, FilePath)
'加载常规信息
@@ -598,7 +603,7 @@ EndHint:
'加载忽略列表
Log("[Help] 发现 .helpignore 文件：" & File.FullName)
For Each Line In ReadFile(File.FullName).Split(vbCrLf.ToCharArray)
- Dim RealString As String = Line.Before("#").Trim
+ Dim RealString As String = Line.BeforeFirst("#").Trim
If String.IsNullOrWhiteSpace(RealString) Then Continue For
IgnoreList.Add(RealString)
If ModeDebug Then Log("[Help] > " & RealString)
diff --git a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb
index 400835c8..a3e1e307 100644
--- a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+++ b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
-
-
+
+
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
index 8a62135c..ff7ec51f 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+++ b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
@@ -236,7 +236,15 @@ Public Module ModDownloadLib
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'分析服务端 JAR 文件下载地址
Dim McVersion As New McVersion(VersionFolder)
- If McVersion.JsonObject("downloads") Is Nothing OrElse McVersion.JsonObject("downloads")("server") Is Nothing OrElse McVersion.JsonObject("downloads")("server")("url") Is Nothing Then Throw New Exception($"{Id} 版本没有提供服务端文件")
+ If McVersion.JsonObject("downloads") Is Nothing OrElse McVersion.JsonObject("downloads")("server") Is Nothing OrElse McVersion.JsonObject("downloads")("server")("url") Is Nothing Then
+ File.Delete(VersionFolder & Id & ".json")
+ If Not New DirectoryInfo(VersionFolder).GetFileSystemInfos.Any() Then Directory.Delete(VersionFolder)
+ Task.Output = New List(Of NetFile)
+ Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载，没法下，撤退！", HintType.Critical)
+ Thread.Sleep(2000) '等玩家把上一个提示看完
+ Task.Abort()
+ Exit Sub
+ End If
Dim JarUrl As String = McVersion.JsonObject("downloads")("server")("url")
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(McVersion.JsonObject("downloads")("server")("size"), -1), Hash:=McVersion.JsonObject("downloads")("server")("sha1"))
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JarUrl), VersionFolder & Id & "-server.jar", Checker)}
@@ -551,10 +559,12 @@ pause"
Task.Progress = 0.1
Dim Sources As New List(Of String)
'BMCLAPI 源
+ Dim BmclapiInherit As String = DownloadInfo.Inherit
+ If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281
If DownloadInfo.IsPreview Then
- Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
+ Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
Else
- Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", ""))
+ Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", ""))
End If
'官方源
Dim PageData As String
@@ -562,12 +572,10 @@ pause"
PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True)
Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
- Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0))
+ Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources.Last)
Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败")
End Try
- 'OptiFine 中文镜像源
- Sources.Add("https://optifine.cn/download/" & DownloadInfo.NameFile)
'构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))}
End Sub) With {.ProgressWeight = 8})
@@ -714,10 +722,12 @@ Retry:
Sub(Task As LoaderTask(Of DlOptiFineListEntry, List(Of NetFile)))
Dim Sources As New List(Of String)
'BMCLAPI 源
+ Dim BmclapiInherit As String = DownloadInfo.Inherit
+ If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281
If DownloadInfo.IsPreview Then
- Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
+ Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
Else
- Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", ""))
+ Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", ""))
End If
'官方源
Dim PageData As String
@@ -725,7 +735,7 @@ Retry:
PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True)
Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
- Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0))
+ Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources.Last)
Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败")
End Try
@@ -1248,8 +1258,8 @@ Retry:
End If
If Not IsNeoForge AndAlso LoaderVersion.StartsWithF("1.") AndAlso LoaderVersion.Contains("-") Then
'类似 1.19.3-41.2.8 格式，优先使用 Version 中要求的版本而非 Inherit（例如 1.19.3 却使用了 1.19 的 Forge）
- Inherit = LoaderVersion.Before("-")
- LoaderVersion = LoaderVersion.After("-")
+ Inherit = LoaderVersion.BeforeFirst("-")
+ LoaderVersion = LoaderVersion.AfterLast("-")
End If
Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge")
Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder
@@ -1309,7 +1319,7 @@ Retry:
Loaders.Add(New LoaderDownload($"下载 {LoaderName} 主文件", New List(Of NetFile)) With {.ProgressWeight = 9})
'安装（仅在新版安装时需要原版 Jar）
- If IsNeoForge OrElse LoaderVersion.Before(".") >= 20 Then
+ If IsNeoForge OrElse LoaderVersion.BeforeFirst(".") >= 20 Then
Log($"[Download] 检测为{If(IsNeoForge, " Neo", "新版 ")}Forge：" & LoaderVersion)
Dim Libs As List(Of McLibToken) = Nothing
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件",
@@ -1331,7 +1341,7 @@ Retry:
Task.Progress = 0.4
Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
- Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Before("@")
+ Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).BeforeFirst("@")
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Dim ClientMappings As JToken = RawJson("downloads")("client_mappings")
Libs.Add(New McLibToken With {
@@ -1865,7 +1875,7 @@ Retry:
Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
'建立控件
Dim NewItem As New MyListItem With {
- .Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Before("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
+ .Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").BeforeFirst("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.StatusDescription & "，发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Logo = PathImage & "Blocks/Fabric.png"
}
@@ -2030,6 +2040,8 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Return True
+ Catch ex As CancelledException
+ Return False
Catch ex As Exception
Log(ex, "开始合并安装失败", LogLevel.Feedback)
Return False
@@ -2037,8 +2049,8 @@ Retry:
End Function
'''
''' 获取合并安装加载器列表，并进行前期的缓存清理与 Java 检查工作。
- ''' 如果出现已知问题且已提示用户，则返回 Nothing。出现异常则直接抛出。
'''
+ '''
Public Function McInstallLoader(Request As McInstallRequest, Optional DontFixLibraries As Boolean = False) As List(Of LoaderBase)
'获取缓存目录
Dim PathInstallTemp As String
@@ -2050,11 +2062,10 @@ Retry:
'清理缓存
Try
- If Not IsInstallTempCleared Then
- IsInstallTempCleared = True
- DeleteDirectory(PathInstallTemp, True)
- Log("[Download] 已清理合并安装缓存")
- End If
+ If IsInstallTempCleared Then Exit Try
+ IsInstallTempCleared = True
+ DeleteDirectory(PathInstallTemp, True)
+ Log("[Download] 已清理合并安装缓存")
Catch ex As Exception
Log(ex, "清理合并安装缓存失败")
End Try
@@ -2065,7 +2076,7 @@ Retry:
If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder)
Dim OptiFineFolder As String = Nothing
If Request.OptiFineVersion IsNot Nothing Then
- If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.After("_HD_U_") '#735
+ If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.AfterLast("_HD_U_") '#735
Request.OptiFineEntry = New DlOptiFineListEntry With {
.NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"),
.Inherit = Request.MinecraftName,
@@ -2110,7 +2121,7 @@ Retry:
'重复版本检查
If File.Exists(OutputFolder & Request.TargetVersionName & ".json") Then
Hint("版本 " & Request.TargetVersionName & " 已经存在！", HintType.Critical)
- Return Nothing
+ Throw New CancelledException
End If
Dim LoaderList As New List(Of LoaderBase)
@@ -2166,7 +2177,7 @@ Retry:
End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件
If Not DontFixLibraries AndAlso
- (Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.Before(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then
+ (Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(OutputFolder))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb
index 892375de..055b2f14 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb
@@ -34,41 +34,65 @@
End Select
End Sub
'结果 UI 化
- Private Class VersionSorterWithSelect
+ Private Class CardSorter
Implements IComparer(Of String)
- Public Top As String = ""
+ Public Topmost As String = ""
Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare
+ '相同
If x = y Then Return 0
- If x = Top Then Return -1
- If y = Top Then Return 1
+ '置顶
+ If x = Topmost Then Return -1
+ If y = Topmost Then Return 1
+ '特殊版本
+ Dim IsXSpecial As Boolean = x.EndsWithF("版本")
+ Dim IsYSpecial As Boolean = y.EndsWithF("版本")
+ If IsXSpecial AndAlso IsYSpecial Then Return x.CompareTo(y)
+ If IsXSpecial Then Return 1
+ If IsYSpecial Then Return -1
+ '比较版本号
+ Dim VersionCodeSort = -VersionSortInteger(x.Replace(x.BeforeFirst(" ") & " ", ""), y.Replace(y.BeforeFirst(" ") & " ", ""))
+ If VersionCodeSort <> 0 Then Return VersionCodeSort
+ '比较全部
Return -VersionSortInteger(x, y)
End Function
- Public Sub New(Optional Top As String = "")
- Me.Top = If(Top, "")
+ Public Sub New(Optional Topmost As String = "")
+ Me.Topmost = If(Topmost, "")
End Sub
End Class
Private Sub Load_OnFinish()
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any,
- $"所选版本：{TargetVersion} {If(TargetLoader <> CompModLoaderType.Any, TargetLoader, "")}", "")
+ $"所选版本：{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "")
'初始化字典
- Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New VersionSorterWithSelect(TargetCardName))
+ Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName))
Dict.Add("未知版本", New List(Of CompFile))
+ Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType)))
For Each Version As CompFile In CompFileLoader.Output
For Each GameVersion In Version.GameVersions
- '决定添加到哪个版本
- Dim TargetCard As String
+ '决定添加到哪个卡片
+ Dim Ver As String
If GameVersion Is Nothing Then
- TargetCard = "未知版本"
+ Ver = "未知版本"
ElseIf GameVersion.Contains("w") OrElse GameVersion.Contains("pre") OrElse GameVersion.Contains("rc") Then
- TargetCard = "快照版本"
- ElseIf GameVersion.StartsWith("1.0") Then
- TargetCard = "远古版本"
+ Ver = "快照版本"
+ ElseIf GameVersion.StartsWithF("1.0") Then
+ Ver = "远古版本"
Else
- TargetCard = GameVersion
+ Ver = GameVersion
End If
- '实际进行添加
- If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile))
- If Not Dict(TargetCard).Contains(Version) Then Dict(TargetCard).Add(Version)
+ '遍历加入的加载器列表
+ Dim Loaders As New List(Of String)
+ If Project.Type = CompType.Mod Then
+ For Each Loader In Version.ModLoaders
+ If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
+ Next
+ End If
+ If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的，确保它在一张卡片里
+ '实际添加
+ For Each Loader In Loaders
+ Dim TargetCard As String = Loader & Ver
+ If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile))
+ If Not Dict(TargetCard).Contains(Version) Then Dict(TargetCard).Add(Version)
+ Next
Next
Next
'添加筛选的版本的卡片
@@ -170,11 +194,7 @@
Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo)
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
- Sub()
- If ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Is Nothing Then
- Throw New Exception("整合包安装出现异常！")
- End If
- End Sub) With {.ProgressWeight = 0.1})
+ Sub() ModpackInstall(Target, VersionName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
@@ -277,7 +297,7 @@
If Project.TranslatedName = Project.RawName Then
FileName = File.FileName
Else
- Dim ChineseName As String = Project.TranslatedName.Before(" (").Before(" - ").
+ Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - ").
Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：")
Select Case Setup.Get("ToolDownloadTranslate")
Case 0
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
index 2230ba63..9b5a245c 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
@@ -1076,12 +1076,12 @@
If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True
If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False
'直接的判断（例如 1.18.1/22w03a）
- For Each Part As String In DisplayName.Before("]").TrimStart("[").Split("/")
+ For Each Part As String In DisplayName.BeforeFirst("]").TrimStart("[").Split("/")
If Part = MinecraftVersion Then Return True
Next
'将版本名分割语素（例如 1.16.4/5）
- Dim Lefts = RegexSearch(DisplayName.Before("]"), "[a-z/]+|[0-9/]+")
- Dim Rights = RegexSearch(MinecraftVersion.Before("]"), "[a-z/]+|[0-9/]+")
+ Dim Lefts = RegexSearch(DisplayName.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
+ Dim Rights = RegexSearch(MinecraftVersion.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
'对每段进行判断
Dim i As Integer = 0
While True
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml
index 8a646677..bb644b1e 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml
+++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml
@@ -2,88 +2,90 @@
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}">
-
+
+
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
-
- -->
+
+
+
+
+
+
+
-
-
-
-
-
-
-
- -->
+
+
+
+
+
+
+
-
-
-
-
-
-
-
- -->
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
+
+
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb
index de8faf88..e085dd77 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb
@@ -1,4 +1,5 @@
Public Class PageDownloadLeft
+ Implements IRefreshable
#Region "页面切换"
@@ -91,7 +92,13 @@
'强制刷新
Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用
- Select Case Val(sender.Tag)
+ Refresh(Val(sender.Tag))
+ End Sub
+ Public Sub Refresh() Implements IRefreshable.Refresh
+ Refresh(FrmMain.PageCurrentSub)
+ End Sub
+ Public Sub Refresh(SubType As FormMain.PageSubType)
+ Select Case SubType
Case FormMain.PageSubType.DownloadInstall
DlClientListLoader.Start(IsForceRestart:=True)
DlOptiFineListLoader.Start(IsForceRestart:=True)
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml
index ba9f3d3e..b6c512ab 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml
+++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml
@@ -36,17 +36,14 @@
-
-
-
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml
index 1ca5eb02..79b34ab5 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml
+++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml
@@ -8,14 +8,12 @@
-
+
-
-
-
+
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb
index 27c2fd4a..f843529b 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb
@@ -49,8 +49,5 @@
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://www.optifine.net/")
End Sub
- Private Sub BtnChina_Click(sender As Object, e As EventArgs) Handles BtnChina.Click
- OpenWebsite("https://optifine.cn/home")
- End Sub
End Class
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml
index c10ff3cb..2025c130 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml
+++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml
@@ -35,17 +35,14 @@
-
-
-
diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml
index 0da64cec..1144f092 100644
--- a/Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml
+++ b/Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml
@@ -24,7 +24,7 @@
+ VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb
index f3033b25..416bdcf1 100644
--- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb
@@ -26,21 +26,15 @@
If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip"
If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack"
If PackInstallPath IsNot Nothing Then
- If MyMsgBox($"PCL 即将在当前文件夹下自动安装整合包。", "自动安装", "继续", "取消") = 1 Then
- '确认自动安装
- Log("[Launch] 需自动安装整合包：" & PackInstallPath, LogLevel.Debug)
- Setup.Set("LaunchFolderSelect", "$.minecraft\")
- If Not Directory.Exists(Path & ".minecraft\") Then
- Directory.CreateDirectory(Path & ".minecraft\")
- Directory.CreateDirectory(Path & ".minecraft\versions\")
- McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
- End If
- McFolderListLoader.WaitForExit(IsForceRestart:=True)
- Else
- '取消自动安装
- Log("[Launch] 取消自动安装整合包：" & PackInstallPath, LogLevel.Debug)
- PackInstallPath = Nothing
+ Log("[Launch] 需自动安装整合包：" & PackInstallPath, LogLevel.Debug)
+ Setup.Set("LaunchFolderSelect", "$.minecraft\")
+ If Not Directory.Exists(Path & ".minecraft\") Then
+ Directory.CreateDirectory(Path & ".minecraft\")
+ Directory.CreateDirectory(Path & ".minecraft\versions\")
+ McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
End If
+ PageSelectLeft.AddFolder(Path & ".minecraft\", GetFolderNameFromPath(Path), False)
+ McFolderListLoader.WaitForExit()
End If
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
@@ -58,18 +52,19 @@
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'自动整合包安装
If PackInstallPath IsNot Nothing Then
- Dim InstallLoader = ModpackInstall(PackInstallPath)
- If InstallLoader Is Nothing Then
- Log("[Launch] 自动安装整合包失败：" & PackInstallPath)
- Else
- Log("[Launch] 自动安装整合包开始：" & PackInstallPath)
- RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
+ Try
+ Dim InstallLoader = ModpackInstall(PackInstallPath, GetFolderNameFromPath(Path))
+ Log("[Launch] 自动安装整合包已开始：" & PackInstallPath)
InstallLoader.WaitForExit()
If InstallLoader.State = LoadState.Finished Then
Log("[Launch] 自动安装整合包成功，删除安装包：" & PackInstallPath)
File.Delete(PackInstallPath)
End If
- End If
+ Catch ex As CancelledException
+ Log(ex, "自动安装整合包被用户取消：" & PackInstallPath)
+ Catch ex As Exception
+ Log(ex, "自动安装整合包失败：" & PackInstallPath, LogLevel.Msgbox)
+ End Try
End If
'确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect")
@@ -431,7 +426,7 @@ Finish:
ElseIf Setup.Get("LoginLegacyName") = "" Then
Return New EqualableList(Of String) From {0, ""}
Else
- Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.Before("¨"), "")}
+ Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨"), "")}
End If
Case 3
Return New EqualableList(Of String) From {3, Setup.Get("LaunchSkinID")}
diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml
index 99046f67..1cc6a708 100644
--- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml
+++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml
@@ -22,4 +22,4 @@
-
+
\ No newline at end of file
diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb
index ff0a41cf..0d3032b5 100644
--- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb
@@ -1,4 +1,5 @@
Public Class PageLaunchRight
+ Implements IRefreshable
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
@@ -26,12 +27,6 @@
'''
''' 刷新自定义主页。
'''
- Private Sub PressF5(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
- If e.Key = Key.F5 Then
- ForceRefresh()
- End If
- End Sub
-
Private Sub Refresh() Handles Me.Loaded
RunInNewThread(
Sub()
@@ -98,7 +93,7 @@ Download:
GoTo Download
Case 3
Log("[Page] 主页预设：简单主页")
- Url = "https://gitee.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml"
+ Url = "https://raw.gitcode.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml"
GoTo Download
Case 4
Log("[Page] 主页预设：每日整合包推荐")
@@ -122,7 +117,7 @@ Download:
GoTo Download
Case 9
Log("[Page] 主页预设：PCL 新功能说明书")
- Url = "https://gitee.com/wforstbreeze/whats-new-pcl/raw/main/Custom.xaml"
+ Url = "https://raw.gitcode.com/WForst-Breeze/WhatsNewPCL/raw/main/Custom.xaml"
GoTo Download
Case 10
Log("[Page] 主页预设：OpenMCIM Dashboard")
@@ -144,10 +139,10 @@ Download:
If Address.Contains(".xaml") Then
VersionAddress = Address.Replace(".xaml", ".xaml.ini")
Else
- VersionAddress = Address.Before("?")
+ VersionAddress = Address.BeforeFirst("?")
If Not VersionAddress.EndsWith("/") Then VersionAddress += "/"
VersionAddress += "version"
- If Address.Contains("?") Then VersionAddress += Address.After("?")
+ If Address.Contains("?") Then VersionAddress += Address.AfterLast("?")
End If
'校验版本
Dim Version As String = ""
@@ -189,7 +184,7 @@ Download:
''' 立即强制刷新自定义主页。
''' 必须在 UI 线程调用。
'''
- Public Sub ForceRefresh()
+ Public Sub ForceRefresh() Implements IRefreshable.Refresh
Log("[Page] 要求强制刷新自定义主页")
ClearCache()
'实际的刷新
diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb
index 3476e70f..e9ae125f 100644
--- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb
@@ -17,8 +17,8 @@
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Setup.Get("LoginAuthEmail").ToString.Split("¨")
- ComboName.Text = Setup.Get("LoginAuthEmail").ToString.Before("¨")
- If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.Before("¨").Trim
+ ComboName.Text = Setup.Get("LoginAuthEmail").ToString.BeforeFirst("¨")
+ If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.BeforeFirst("¨").Trim
End If
End If
IsFirstLoad = False
diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb
index 0c478822..ed916841 100644
--- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb
@@ -26,7 +26,7 @@ Public Class PageLoginLegacy
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Setup.Get("LoginLegacyName").ToString.Split("¨")
- ComboName.Text = Setup.Get("LoginLegacyName").ToString.Before("¨").Trim
+ ComboName.Text = Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨").Trim
End If
End If
IsReloaded = True
diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb
index 0e327d0c..3b478333 100644
--- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb
@@ -17,8 +17,8 @@
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Setup.Get("LoginNideEmail").ToString.Split("¨")
- ComboName.Text = Setup.Get("LoginNideEmail").ToString.Before("¨")
- If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.Before("¨").Trim
+ ComboName.Text = Setup.Get("LoginNideEmail").ToString.BeforeFirst("¨")
+ If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.BeforeFirst("¨").Trim
End If
End If
IsFirstLoad = False
diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml
index 951a5dc3..45677238 100644
--- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml
+++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml
@@ -104,108 +104,126 @@
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb
index d8c0a68c..46a8bf4c 100644
--- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb
@@ -1,4 +1,5 @@
Public Class PageOtherHelp
+ Implements IRefreshable
#Region "初始化"
@@ -79,31 +80,35 @@
End Try
End Sub
Public Shared Sub EnterHelpPage(Location As String)
- RunInThread(Sub()
- If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid)
- Dim Entry As New HelpEntry(Location)
- RunInUi(Sub()
- Dim FrmHelpDetail As New PageOtherHelpDetail
- If FrmHelpDetail.Init(Entry) Then
- FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}})
- Else
- Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", LogLevel.Debug)
- End If
- End Sub)
- End Sub)
+ RunInThread(
+ Sub()
+ If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid)
+ Dim Entry As New HelpEntry(Location)
+ RunInUi(
+ Sub()
+ Dim FrmHelpDetail As New PageOtherHelpDetail
+ If FrmHelpDetail.Init(Entry) Then
+ FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}})
+ Else
+ Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", LogLevel.Debug)
+ End If
+ End Sub)
+ End Sub)
End Sub
Public Shared Sub EnterHelpPage(Entry As HelpEntry)
- RunInThread(Sub()
- If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid)
- RunInUi(Sub()
- Dim FrmHelpDetail As New PageOtherHelpDetail
- If FrmHelpDetail.Init(Entry) Then
- FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}})
- Else
- Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", LogLevel.Debug)
- End If
- End Sub)
- End Sub)
+ RunInThread(
+ Sub()
+ If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid)
+ RunInUi(
+ Sub()
+ Dim FrmHelpDetail As New PageOtherHelpDetail
+ If FrmHelpDetail.Init(Entry) Then
+ FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}})
+ Else
+ Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", LogLevel.Debug)
+ End If
+ End Sub)
+ End Sub)
End Sub
Public Shared Function GetHelpPage(Location As String) As PageOtherHelpDetail
If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid)
@@ -122,14 +127,15 @@
If String.IsNullOrWhiteSpace(SearchBox.Text) Then
'隐藏
AniStart({
- AaOpacity(PanSearch, -PanSearch.Opacity, 100),
- AaCode(Sub()
- PanSearch.Height = 0
- PanSearch.Visibility = Visibility.Collapsed
- PanList.Visibility = Visibility.Visible
- End Sub,, True),
- AaOpacity(PanList, 1 - PanList.Opacity, 150, 30)
- }, "FrmOtherHelp Search Switch")
+ AaOpacity(PanSearch, -PanSearch.Opacity, 100),
+ AaCode(
+ Sub()
+ PanSearch.Height = 0
+ PanSearch.Visibility = Visibility.Collapsed
+ PanList.Visibility = Visibility.Visible
+ End Sub,, True),
+ AaOpacity(PanList, 1 - PanList.Opacity, 150, 30)
+ }, "FrmOtherHelp Search Switch")
Else
'构造请求
Dim QueryList As New List(Of SearchEntry(Of HelpEntry))
@@ -163,15 +169,19 @@
End If
'显示
AniStart({
- AaOpacity(PanList, -PanList.Opacity, 100),
- AaCode(Sub()
- PanList.Visibility = Visibility.Collapsed
- PanSearch.Visibility = Visibility.Visible
- PanSearch.TriggerForceResize()
- End Sub,, True),
- AaOpacity(PanSearch, 1 - PanSearch.Opacity, 150, 30)
- }, "FrmOtherHelp Search Switch")
+ AaOpacity(PanList, -PanList.Opacity, 100),
+ AaCode(
+ Sub()
+ PanList.Visibility = Visibility.Collapsed
+ PanSearch.Visibility = Visibility.Visible
+ PanSearch.TriggerForceResize()
+ End Sub,, True),
+ AaOpacity(PanSearch, 1 - PanSearch.Opacity, 150, 30)
+ }, "FrmOtherHelp Search Switch")
End If
End Sub
+ Public Sub Refresh() Implements IRefreshable.Refresh
+ PageOtherLeft.RefreshHelp()
+ End Sub
End Class
diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb
index 79aecfd3..fda05ce1 100644
--- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb
@@ -1,6 +1,11 @@
Public Class PageOtherHelpDetail
+ Implements IRefreshable
Public Entry As HelpEntry
+ Public Sub Refresh() Implements IRefreshable.Refresh
+ Init(New HelpEntry(Entry.RawPath))
+ End Sub
+
Private Sub PageOtherHelpDetail_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
PanBack.ScrollToTop()
End Sub
diff --git a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml
index 97e9c546..2dfe9032 100644
--- a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml
+++ b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml
@@ -9,7 +9,7 @@
-
+
diff --git a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb
index 1ef40df5..2b5177ad 100644
--- a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb
@@ -1,4 +1,5 @@
Public Class PageSelectLeft
+ Implements IRefreshable
Private Sub PageSelectLeft_Initialized(sender As Object, e As EventArgs) Handles Me.Initialized
AddHandler McFolderListLoader.PreviewFinish, Sub() If FrmSelectLeft IsNot Nothing Then RunInUiWait(AddressOf McFolderListUI)
@@ -295,7 +296,7 @@
For i = 0 To Folders.Count - 1
If Folders(i) = "" Then Exit For
If Folders(i).ToString.EndsWith(Folder.Path) Then
- Name = Folders(i).ToString.Before(">")
+ Name = Folders(i).ToString.BeforeFirst(">")
Folders.RemoveAt(i)
Exit For
End If
@@ -347,8 +348,14 @@
End Sub
Public Sub Refresh_Click(sender As Object, e As RoutedEventArgs)
Dim Data As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
- WriteIni(Data.Path & "PCL.ini", "VersionCache", "") '删除缓存以强制要求下一次加载时更新列表
- If Data.Path = PathMcFolder Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
+ RefreshCurrent(Data.Path)
+ End Sub
+ Public Sub RefreshCurrent() Implements IRefreshable.Refresh
+ RefreshCurrent(PathMcFolder)
+ End Sub
+ Public Shared Sub RefreshCurrent(Folder As String)
+ WriteIni(Folder & "PCL.ini", "VersionCache", "") '删除缓存以强制要求下一次加载时更新列表
+ If Folder = PathMcFolder Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub
Public Sub Rename_Click(sender As Object, e As RoutedEventArgs)
Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
diff --git a/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb
index 5b88927c..f3648692 100644
--- a/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb
@@ -167,14 +167,16 @@
ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnCont, 30)
ToolTipService.SetHorizontalOffset(BtnCont, 2)
- AddHandler BtnCont.Click, Sub()
- PageVersionLeft.Version = Version
- FrmMain.PageChange(FormMain.PageType.VersionSetup, 0)
- End Sub
- AddHandler sender.MouseRightButtonUp, Sub()
- PageVersionLeft.Version = Version
- FrmMain.PageChange(FormMain.PageType.VersionSetup, 0)
- End Sub
+ AddHandler BtnCont.Click,
+ Sub()
+ PageVersionLeft.Version = Version
+ FrmMain.PageChange(FormMain.PageType.VersionSetup, 0)
+ End Sub
+ AddHandler sender.MouseRightButtonUp,
+ Sub()
+ PageVersionLeft.Version = Version
+ FrmMain.PageChange(FormMain.PageType.VersionSetup, 0)
+ End Sub
sender.Buttons = {BtnStar, BtnDel, BtnCont}
Else
Dim BtnCont As New MyIconButton With {.LogoScale = 1.15, .Logo = Logo.IconButtonOpen}
@@ -182,12 +184,8 @@
ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnCont, 30)
ToolTipService.SetHorizontalOffset(BtnCont, 2)
- AddHandler BtnCont.Click, Sub()
- PageVersionOverall.OpenVersionFolder(Version)
- End Sub
- AddHandler sender.MouseRightButtonUp, Sub()
- PageVersionOverall.OpenVersionFolder(Version)
- End Sub
+ AddHandler BtnCont.Click, Sub() PageVersionOverall.OpenVersionFolder(Version)
+ AddHandler sender.MouseRightButtonUp, Sub() PageVersionOverall.OpenVersionFolder(Version)
sender.Buttons = {BtnStar, BtnDel, BtnCont}
End If
End Sub
diff --git a/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb b/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb
index 8ef2a755..444fc8ac 100644
--- a/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb
+++ b/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb
@@ -153,6 +153,7 @@
{"UiHiddenPageSetup", New SetupEntry(False)},
{"UiHiddenPageOther", New SetupEntry(False)},
{"UiHiddenFunctionSelect", New SetupEntry(False)},
+ {"UiHiddenFunctionModUpdate", New SetupEntry(False)},
{"UiHiddenFunctionHidden", New SetupEntry(False)},
{"UiHiddenSetupLaunch", New SetupEntry(False)},
{"UiHiddenSetupUi", New SetupEntry(False)},
@@ -632,6 +633,9 @@
Public Sub UiHiddenFunctionSelect(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
+ Public Sub UiHiddenFunctionModUpdate(Value As Boolean)
+ PageSetupUI.HiddenRefresh()
+ End Sub
Public Sub UiHiddenFunctionHidden(Value As Boolean)
PageSetupUI.HiddenRefresh()
End Sub
diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml
index d34419c9..e72ee0b6 100644
--- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml
+++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml
@@ -7,54 +7,7 @@
PanScroll="{Binding ElementName=PanBack}">
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
@@ -217,6 +170,53 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb
index 0d762868..17901872 100644
--- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb
@@ -107,7 +107,7 @@
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value)
End Sub
- Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentVisibie.SelectionChanged, ComboArgumentWindowType.SelectionChanged, ComboArgumentPriority.SelectionChanged
+ 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, CheckAdvanceRunWait.Change, CheckArgumentRam.Change
@@ -551,17 +551,17 @@ PreFin:
End Sub
'版本隔离警告
+ Private IsReverting As Boolean = False
Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
+ If IsReverting Then Exit Sub
If MyMsgBox("调整版本隔离后，你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf &
"如果修改后发现存档消失，把这项设置改回来就能恢复。" & vbCrLf &
"如果你不会迁移存档，不建议修改这项设置！",
"警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
- AniControlEnabled += 1
+ IsReverting = True
ComboArgumentIndie.SelectedItem = e.RemovedItems(0)
- AniControlEnabled -= 1
- Else
- Setup.Set(sender.Tag, sender.SelectedIndex)
+ IsReverting = False
End If
End Sub
diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml
index e9b7edc8..e619cc75 100644
--- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml
+++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml
@@ -290,8 +290,9 @@
-
-
+
+
+
diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb
index f058d565..7773249b 100644
--- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb
@@ -98,6 +98,7 @@
CheckHiddenPageSetup.Checked = Setup.Get("UiHiddenPageSetup")
CheckHiddenPageOther.Checked = Setup.Get("UiHiddenPageOther")
CheckHiddenFunctionSelect.Checked = Setup.Get("UiHiddenFunctionSelect")
+ CheckHiddenFunctionModUpdate.Checked = Setup.Get("UiHiddenFunctionModUpdate")
CheckHiddenFunctionHidden.Checked = Setup.Get("UiHiddenFunctionHidden")
CheckHiddenSetupLaunch.Checked = Setup.Get("UiHiddenSetupLaunch")
CheckHiddenSetupUI.Checked = Setup.Get("UiHiddenSetupUi")
@@ -148,6 +149,7 @@
Setup.Reset("UiHiddenPageSetup")
Setup.Reset("UiHiddenPageOther")
Setup.Reset("UiHiddenFunctionSelect")
+ Setup.Reset("UiHiddenFunctionModUpdate")
Setup.Reset("UiHiddenFunctionHidden")
Setup.Reset("UiHiddenSetupLaunch")
Setup.Reset("UiHiddenSetupUi")
@@ -175,7 +177,7 @@
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboBackgroundSuit.SelectionChanged, ComboCustomPreset.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub
- Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckMusicStop.Change, CheckMusicRandom.Change, CheckMusicAuto.Change, CheckBackgroundColorful.Change, CheckLogoLeft.Change, CheckLauncherLogo.Change, CheckHiddenFunctionHidden.Change, CheckHiddenFunctionSelect.Change, CheckHiddenPageDownload.Change, CheckHiddenPageLink.Change, CheckHiddenPageOther.Change, CheckHiddenPageSetup.Change, CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change, CheckHiddenOtherHelp.Change, CheckHiddenOtherTest.Change, CheckMusicStart.Change, CheckLauncherEmail.Change
+ Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckMusicStop.Change, CheckMusicRandom.Change, CheckMusicAuto.Change, CheckBackgroundColorful.Change, CheckLogoLeft.Change, CheckLauncherLogo.Change, CheckHiddenFunctionHidden.Change, CheckHiddenFunctionSelect.Change, CheckHiddenFunctionModUpdate.Change, CheckHiddenPageDownload.Change, CheckHiddenPageLink.Change, CheckHiddenPageOther.Change, CheckHiddenPageSetup.Change, CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change, CheckHiddenOtherHelp.Change, CheckHiddenOtherTest.Change, CheckMusicStart.Change, CheckLauncherEmail.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextLogoText.ValidatedTextChanged, TextCustomNet.ValidatedTextChanged
diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb
index a12b5f7a..e44d3e3a 100644
--- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb
@@ -88,17 +88,7 @@
#End Region
Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用
- '强制刷新
- Try
- CompProjectCache.Clear()
- File.Delete(PathTemp & "Cache\LocalMod.json")
- Log("[Mod] 由于点击刷新按钮，清理本地 Mod 信息缓存")
- Catch ex As Exception
- Log(ex, "强制刷新时清理本地 Mod 信息缓存失败")
- End Try
- If FrmVersionMod IsNot Nothing Then FrmVersionMod.ReloadModList(True) '无需 Else，还没加载刷个鬼的新
- ItemMod.Checked = True
- Hint("正在刷新……", Log:=False)
+ PageVersionMod.Refresh()
End Sub
Public Sub Reset(sender As Object, e As EventArgs)
diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
index f0643461..fb7e3aea 100644
--- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
@@ -1,4 +1,5 @@
Public Class PageVersionMod
+ Implements IRefreshable
#Region "初始化"
@@ -37,6 +38,23 @@
SearchBox.Text = ""
End If
End Sub
+ '强制刷新
+ Private Sub RefreshSelf() Implements IRefreshable.Refresh
+ Refresh()
+ End Sub
+ Public Shared Sub Refresh()
+ '强制刷新
+ Try
+ CompProjectCache.Clear()
+ File.Delete(PathTemp & "Cache\LocalMod.json")
+ Log("[Mod] 由于点击刷新按钮，清理本地 Mod 信息缓存")
+ Catch ex As Exception
+ Log(ex, "强制刷新时清理本地 Mod 信息缓存失败")
+ End Try
+ If FrmVersionMod IsNot Nothing Then FrmVersionMod.ReloadModList(True) '无需 Else，还没加载刷个鬼的新
+ FrmVersionLeft.ItemMod.Checked = True
+ Hint("正在刷新……", Log:=False)
+ End Sub
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanAllBack, Nothing, McModLoader, AddressOf LoadUIFromLoaderOutput, AutoRun:=False)
@@ -136,13 +154,13 @@
'''
Public Sub RefreshUI()
If PanList Is Nothing Then Exit Sub
- Dim ShowMods = GetShowingMods(True).ToList()
+ Dim ShowingMods = If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of McMod))).Where(Function(m) CanPassFilter(m)).ToList
'重新列出列表
AniControlEnabled += 1
- If ShowMods.Any() Then
+ If ShowingMods.Any() Then
PanList.Visibility = Visibility.Visible
PanList.Children.Clear()
- For Each TargetMod In ShowMods
+ For Each TargetMod In ShowingMods
Dim Item As MyLocalModItem = ModItems(TargetMod.RawFileName)
Item.Checked = SelectedMods.Contains(TargetMod.RawFileName) '更新选中状态
PanList.Children.Add(Item)
@@ -151,7 +169,7 @@
PanList.Visibility = Visibility.Collapsed
End If
AniControlEnabled -= 1
- SelectedMods = SelectedMods.Where(Function(m) ShowMods.Any(Function(s) s.RawFileName = m)).ToList '取消选中已经不显示的 Mod
+ SelectedMods = SelectedMods.Where(Function(m) ShowingMods.Any(Function(s) s.RawFileName = m)).ToList '取消选中已经不显示的 Mod
RefreshBars()
End Sub
@@ -169,7 +187,7 @@
Dim DisabledCount As Integer = 0
Dim UpdateCount As Integer = 0
Dim UnavalialeCount As Integer = 0
- For Each ModItem In GetShowingMods(False)
+ For Each ModItem In If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of McMod)))
AnyCount += 1
If ModItem.CanUpdate Then UpdateCount += 1
If ModItem.State.Equals(McMod.McModState.Fine) Then EnabledCount += 1
@@ -298,7 +316,7 @@
''' 全选。
'''
Private Sub BtnManageSelectAll_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageSelectAll.Click
- ChangeAllSelected(SelectedMods.Count < GetShowingMods(True).Count)
+ ChangeAllSelected(SelectedMods.Count < PanList.Children.Count)
End Sub
'''
@@ -332,9 +350,11 @@
Private Sub ChangeAllSelected(Value As Boolean)
AniControlEnabled += 1
SelectedMods.Clear()
- For Each Item As MyLocalModItem In GetShowingMods(True).Where(Function(m) ModItems.ContainsKey(m.RawFileName)).Select(Function(m) ModItems(m.RawFileName))
- Item.Checked = Value
- If Value Then SelectedMods.Add(Item.Entry.RawFileName)
+ For Each Item As MyLocalModItem In ModItems.Values
+ '#4992，Mod 从过滤器看可能不应在列表中，但因为刚切换状态所以依然保留在列表中，所以应该从列表 UI 判断，而非从过滤器判断
+ Dim ShouldSelected As Boolean = Value AndAlso PanList.Children.Contains(Item)
+ Item.Checked = ShouldSelected
+ If ShouldSelected Then SelectedMods.Add(Item.Entry.RawFileName)
Next
AniControlEnabled -= 1
RefreshBars()
@@ -384,14 +404,6 @@
Unavailable = 4
End Enum
- '''
- ''' 获取所有应该显示在 UI 中的 Mod。
- '''
- Private Function GetShowingMods(ApplyFilter As Boolean) As IEnumerable(Of McMod)
- If McModLoader.Output Is Nothing Then Return New List(Of McMod)
- Return If(IsSearching, SearchResult, McModLoader.Output).Where(Function(m) Not ApplyFilter OrElse CanPassFilter(m))
- End Function
-
'''
''' 检查该 Mod 项是否符合当前筛选的类别。
'''
diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb
index fbf344d9..467258cf 100644
--- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb
@@ -488,15 +488,16 @@ PreFin:
#Region "其他设置"
'版本隔离警告
+ Private IsReverting As Boolean = False
Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
If MyMsgBox("调整版本隔离后，你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf &
"如果修改后发现存档消失，把这项设置改回来就能恢复。" & vbCrLf &
"如果你不会迁移存档，不建议修改这项设置！",
"警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
- AniControlEnabled += 1
+ IsReverting = True
ComboArgumentIndie.SelectedItem = e.RemovedItems(0)
- AniControlEnabled -= 1
+ IsReverting = False
End If
End Sub