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

Merge branch 'main' into NAudio

Browse Source
This commit is contained in:
tangge233
2025-01-13 21:22:52 +08:00
parent 9786a447ca a8bb82b033
commit 5034866c8f
80 changed files with 2512 additions and 1456 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+113 -24
View File
@@ -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.12" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.12." & 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 = 347 'Release
#Else
Public Const VersionCode As Integer = 341 'Snapshot
Public Const VersionCode As Integer = 346 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -971,7 +971,7 @@ Public Module ModBase
End Using
End Function
''' <summary>
''' 弹出选取文件对话框并且要求选取文件。
''' 弹出选取文件对话框，要求选择一个文件。
''' </summary>
''' <param name="FileFilter">要求的格式。如：“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
''' <param name="Title">弹窗的标题。</param>
@@ -985,12 +985,32 @@ Public Module ModBase
fileDialog.Title = Title
fileDialog.ValidateNames = True
fileDialog.ShowDialog()
SelectFile = fileDialog.FileName
Log("[UI] 选择文件返回：" & SelectFile)
Log("[UI] 选择单个文件返回：" & fileDialog.FileName)
Return fileDialog.FileName
End Using
End Function
''' <summary>
''' 弹出选取文件夹对话框并且要求选取文件夹。如果没有选择就返回空字符串。
''' 弹出选取文件对话框，要求选择多个文件。
''' </summary>
''' <param name="FileFilter">要求的格式。如：“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
''' <param name="Title">弹窗的标题。</param>
Public Function SelectFiles(FileFilter As String, Title As String) As String()
Using fileDialog As New Forms.OpenFileDialog
fileDialog.AddExtension = True
fileDialog.AutoUpgradeEnabled = True
fileDialog.CheckFileExists = True
fileDialog.Filter = FileFilter
fileDialog.Multiselect = True
fileDialog.Title = Title
fileDialog.ValidateNames = True
fileDialog.ShowDialog()
Log("[UI] 选择多个文件返回：" & fileDialog.FileNames.Join(","))
Return fileDialog.FileNames
End Using
End Function
''' <summary>
''' 弹出选取文件夹对话框，要求选取文件夹。
''' 返回以 \ 结尾的完整路径，如果没有选择则返回空字符串。
''' </summary>
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 +1227,8 @@ Re:
''' 尝试根据后缀名判断文件种类并解压文件，支持 gz 与 zip，会尝试将 jar 以 zip 方式解压。
''' 会尝试创建，但不会清空目标文件夹。
''' </summary>
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 +1244,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 +1316,16 @@ RetryDir:
''' <summary>
''' 复制文件夹，失败会抛出异常。
''' </summary>
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
''' <summary>
@@ -1552,10 +1578,10 @@ RetryDir:
End Function
''' <summary>
''' 获取在子字符串之前的部分。
''' 会裁切尽可能多的内容，但如果未找到子字符串则不裁切。
''' 获取在子字符串第一次出现之前的部分，例如对 2024/11/08 拆切 / 会得到 2024。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function Before(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
<Extension> 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 +1590,34 @@ RetryDir:
End If
End Function
''' <summary>
''' 获取在子字符串之后的部分。
''' 会裁切尽可能多的内容，但如果未找到子字符串则不裁切。
''' 获取在子字符串最后一次出现之前的部分，例如对 2024/11/08 拆切 / 会得到 2024/11。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function After(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
<Extension> 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
''' <summary>
''' 获取在子字符串第一次出现之后的部分，例如对 2024/11/08 拆切 / 会得到 11/08。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> 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
''' <summary>
''' 获取在子字符串最后一次出现之后的部分，例如对 2024/11/08 拆切 / 会得到 08。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> 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 +1626,8 @@ RetryDir:
End If
End Function
''' <summary>
''' 获取处于两个子字符串之间的部分。
''' 会裁切尽可能多的内容：匹配开始使用 LastIndexOf，匹配结束使用 IndexOf，但如果未找到子字符串则不裁切。
''' 获取处于两个子字符串之间的部分，裁切尽可能多的内容。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> 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 +1894,39 @@ RetryDir:
#Region "系统"
''' <summary>
''' 线程安全的，可以直接使用 For Each 的 List。
''' 在使用 For Each 循环时，列表的结果可能并非最新，但不会抛出异常。
''' </summary>
Public Class SafeList(Of T)
Inherits SynchronizedCollection(Of T)
Implements IEnumerable, IEnumerable(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
'基于 SyncLock 覆写
Public Overloads Function GetEnumerator() As IEnumerator(Of T) Implements IEnumerable(Of T).GetEnumerator
SyncLock SyncRoot
Return Items.ToList.GetEnumerator()
End SyncLock
End Function
Private Overloads Function GetEnumeratorGeneral() As IEnumerator Implements IEnumerable.GetEnumerator
SyncLock SyncRoot
Return Items.ToList.GetEnumerator()
End SyncLock
End Function
End Class
''' <summary>
''' 可用于临时存放文件的，不含任何特殊字符的文件夹路径，以“\”结尾。
''' </summary>
@@ -1866,6 +1949,12 @@ RetryDir:
Public Class RestartException
Inherits Exception
End Class
''' <summary>
''' 指示用户手动取消了操作，或用户已知晓操作被取消的原因。
''' </summary>
Public Class CancelledException
Inherits Exception
End Class
''' <summary>
''' 当前程序是否拥有管理员权限。
@@ -1983,10 +2072,10 @@ 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 天”
'1~4 月，“2 个月 13 天”
GetTimeSpanString = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
ElseIf Span.TotalDays >= 4 Then
'4~30 天，“23 天”
@@ -2108,7 +2197,7 @@ NextElement:
''' <summary>
''' 在新的工作线程中执行代码。
''' </summary>
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 +2207,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
Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+1 -1
View File
@@ -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
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+69 -90
View File
@@ -701,7 +701,7 @@ RequestFinished:
''' <summary>
''' 所属的文件列表任务。
''' </summary>
Public Tasks As New SynchronizedCollection(Of LoaderDownload)
Public Tasks As New SafeList(Of LoaderDownload)
''' <summary>
''' 所有下载源。
''' </summary>
@@ -930,7 +930,7 @@ RequestFinished:
'条件检测
If NetTaskThreadCount >= NetTaskThreadLimit OrElse IsSourceFailed() OrElse
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing
SyncLock LockState
If State < NetState.Connect Then State = NetState.Connect
@@ -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:
''' <summary>
''' 需要下载的文件。
''' </summary>
Public Files As List(Of NetFile)
Private ReadOnly FilesLock As New Object
Public Files As SafeList(Of NetFile)
''' <summary>
''' 剩余未完成的文件数。（用于减轻 FilesLock 的占用）
''' </summary>
@@ -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:
''' <summary>
''' 当前的所有下载任务。
''' </summary>
Public Tasks As New List(Of LoaderDownload)
Private ReadOnly LockTasks As New Object
Public Tasks As New SafeList(Of LoaderDownload)
''' <summary>
''' 已下载完成的大小。
@@ -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
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
+8
View File
@@ -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
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+58 -55
View File
@@ -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
@@ -458,14 +458,14 @@
If StartVersion = EndVersion Then
SpaVersions.Add("1." & StartVersion)
ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then
If EndVersion <= 10 Then
If EndVersion < 10 Then
SpaVersions.Clear()
SpaVersions.Add("全版本")
Exit For
Else
SpaVersions.Add("1." & EndVersion & "+")
End If
ElseIf EndVersion <= 10 Then
ElseIf EndVersion < 10 Then
SpaVersions.Add("1." & StartVersion & "-")
Exit For
ElseIf StartVersion - EndVersion = 1 Then
@@ -478,25 +478,31 @@
End If
'获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
Select Case ModLoaders.Count
Dim ModLoadersForDesc As New List(Of CompModLoaderType)(ModLoaders)
If Setup.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(CompModLoaderType.Quilt)
Select Case ModLoadersForDesc.Count
Case 0
ModLoaderDescriptionFull = "未知"
ModLoaderDescriptionPart = ""
If ModLoaders.Count = 1 Then
ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString
ModLoaderDescriptionPart = ModLoaders.Single.ToString
Else
ModLoaderDescriptionFull = "未知"
ModLoaderDescriptionPart = ""
End If
Case 1
ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString
ModLoaderDescriptionPart = ModLoaders.Single.ToString
Case 2, 3
If Setup.Get("ToolDownloadIgnoreQuilt") AndAlso
ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric) Then
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
Case Else
If ModLoaders.Contains(CompModLoaderType.Forge) AndAlso
(GameVersions.Max < 14 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso
(GameVersions.Max < 20 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso
(GameVersions.Max < 14 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
Else
ModLoaderDescriptionFull = ModLoaders.Join(" / ")
ModLoaderDescriptionPart = ModLoaders.Join(" / ")
ModLoaderDescriptionFull = ModLoadersForDesc.Join(" / ")
ModLoaderDescriptionPart = ModLoadersForDesc.Join(" / ")
End If
Case Else
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
End Select
'实例化 UI
Dim NewItem As New MyCompItem With {.Tag = Me, .Logo = GetControlLogo()}
@@ -583,9 +589,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 +764,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 +785,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 +893,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)
@@ -1156,7 +1162,7 @@ Retry:
''' </summary>
Public ReadOnly ModLoaders As List(Of CompModLoaderType)
''' <summary>
''' 支持的游戏版本列表。类型包括："1.18.5"，"1.18"，"1.18 快照"，"21w15a"，"未知版本"。
''' 支持的游戏版本列表。类型包括："1.18.5"，"1.18"，"1.18 预览版"，"21w15a"，"未知版本"。
''' </summary>
Public ReadOnly GameVersions As List(Of String)
''' <summary>
@@ -1272,7 +1278,7 @@ Retry:
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 预览版")).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)}
@@ -1313,7 +1319,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 +1368,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
@@ -1422,14 +1426,12 @@ Retry:
''' <summary>
''' 已知文件信息的缓存。
''' </summary>
Private CompFilesCache As New Dictionary(Of String, List(Of CompFile))
Public CompFilesCache As New Dictionary(Of String, List(Of CompFile))
''' <summary>
''' 获取某个工程下的全部文件列表。
''' 必须在工作线程执行，失败会抛出异常。
''' </summary>
Public Function CompFilesGet(ProjectId As String, FromCurseForge As Boolean) As List(Of CompFile)
'使用缓存
If CompFilesCache.ContainsKey(ProjectId) Then Return CompFilesCache(ProjectId)
'获取工程对象
Dim TargetProject As CompProject
If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
@@ -1440,25 +1442,26 @@ Retry:
TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
End If
'获取工程对象的文件列表
Log("[Comp] 开始获取文件列表：" & ProjectId)
Dim ResultJsonArray As JArray
If FromCurseForge Then
'CurseForge
If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
Else '否则使用全部文件
ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
If Not CompFilesCache.ContainsKey(ProjectId) Then '有缓存也不能直接返回，这时候前置 Mod 可能没获取（#5173）
Log("[Comp] 开始获取文件列表：" & ProjectId)
Dim ResultJsonArray As JArray
If FromCurseForge Then
'CurseForge
If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
Else '否则使用全部文件
ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
End If
Else
'Modrinth
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
End If
Else
'Modrinth
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项（#1330）
End If
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项（#1330）
'获取前置 Mod 列表
If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId)
Dim Deps As List(Of String) = CompFilesCache(ProjectId).
SelectMany(Function(f) f.RawDependencies).Distinct().ToList
Dim Deps As List(Of String) = CompFilesCache(ProjectId).SelectMany(Function(f) f.RawDependencies).Distinct().ToList
Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
'获取前置 Mod 工程信息
If UndoneDeps.Any Then
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+62 -32
View File
@@ -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:
''' </summary>
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
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+97 -92
View File
@@ -167,24 +167,25 @@
End Structure
''' <summary>
''' Minecraft 客户端 版本列表，主加载器。
''' 若要求镜像源必须包含某个版本，则将该版本 ID 作为输入（#5195）。
''' </summary>
Public DlClientListLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult))
Select Case Setup.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60)
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 35)
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 5),
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60)
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 60),
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -193,9 +194,9 @@
''' <summary>
''' Minecraft 客户端 版本列表，Mojang 官方源加载器。
''' </summary>
Public DlClientListMojangLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private IsNewClientVersionHinted As Boolean = False
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim Json As JObject = NetGetCodeByRequestRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", IsJson:=True)
Try
Dim Versions As JArray = Json("versions")
@@ -225,14 +226,21 @@
''' <summary>
''' Minecraft 客户端 版本列表，BMCLAPI 源加载器。
''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", IsJson:=True)
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
'添加 PCL 特供项
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
'检查是否有要求的版本（#5195）
If Not String.IsNullOrEmpty(Loader.Input) Then
Dim Id = Loader.Input
If Not DlClientListLoader.Output.Value("versions").Any(Function(v) v("id") = Id) Then
Throw New Exception("BMCLAPI 源未包含目标版本 " & Id)
End If
End If
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json}
Catch ex As Exception
@@ -245,26 +253,31 @@
''' </summary>
Public Function DlClientListGet(Id As String)
Try
'确认 Minecraft 版本列表已完成获取
Select Case DlClientListLoader.State
Case LoadState.Loading
DlClientListLoader.WaitForExit()
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
DlClientListLoader.WaitForExit(IsForceRestart:=True)
End Select
'确认版本格式标准
Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4
If Id <> "1.0" AndAlso Id.EndsWithF(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题，显示版本为 1.8.0
'查找版本并开始
'获取 Minecraft 版本列表
Select Case DlClientListLoader.State
Case LoadState.Finished
'从当前的结果获取目标版本…
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then Return Version("url").ToString
Next
'…如果没有，则重新尝试获取（在版本刚更新时可能出现这种情况，#5195）
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
Case LoadState.Loading
DlClientListLoader.WaitForExit(Id)
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
End Select
'重新查找版本
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then
Return Version("url").ToString
End If
If Version("id") = Id Then Return Version("url").ToString
Next
Log("未发现版本 " & Id & " 的 json 下载地址，版本列表返回为：" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug)
Log($"未发现版本 {Id} 的 json 下载地址，版本列表返回为：{vbCrLf}{DlClientListLoader.Output.Value.ToString}", LogLevel.Debug)
Return Nothing
Catch ex As Exception
Log(ex, "获取版本 " & Id & " 的 json 下载地址失败")
Log(ex, $"获取版本 {Id} 的 json 下载地址失败")
Return Nothing
End Try
End Function
@@ -337,17 +350,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -443,17 +456,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -588,17 +601,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -780,7 +793,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
@@ -795,17 +808,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -920,17 +933,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -1019,17 +1032,17 @@
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting)
Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 35)
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting)
Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60)
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
End Sub
@@ -1089,7 +1102,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 +1151,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))
@@ -1235,71 +1248,63 @@
Optional IsForceRestart As Boolean = False)
Dim WaitCycle As Integer = 0
Do While True
'检查加载结束
Dim IsAllFailed As Boolean = True
'检查状态
Dim BeforeLoadersAllFailed As Boolean = True
For Each SubLoader In LoaderList
If WaitCycle = 0 Then
'如果要强制刷新，就不使用已经加载好的值
If IsForceRestart Then Exit For
'如果输入不一样，就不使用已经加载好的值
If WaitCycle = 0 Then '判断是否可以不加载，直接使用已经加载好的结果
If IsForceRestart Then Continue For '强制刷新，不行
If (SubLoader.Key.Input Is Nothing Xor MainLoader.Input Is Nothing) OrElse
(SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For
(SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For '父子加载器的输入不一样，也不行
End If
If SubLoader.Key.State <> LoadState.Failed Then IsAllFailed = False
If SubLoader.Key.State <> LoadState.Failed Then BeforeLoadersAllFailed = False
If SubLoader.Key.State = LoadState.Finished Then
'检查加载器成功
MainLoader.Output = SubLoader.Key.Output
DlSourceLoaderAbort(LoaderList)
Exit Sub
ElseIf IsAllFailed Then
ElseIf BeforeLoadersAllFailed Then
'此前的加载器全部失败，直接启动后续加载器
If WaitCycle < SubLoader.Value * 100 Then WaitCycle = SubLoader.Value * 100
End If
'由于 Forge BMCLAPI 没有可用版本导致强制失败
'在没有可用版本时，官方源会一直卡住，直接使用 BMCLAPI 判定失败即可
If SubLoader.Key.Error IsNot Nothing AndAlso SubLoader.Key.Error.Message.Contains("没有可用版本") Then
For Each SubLoader2 In LoaderList
If WaitCycle < SubLoader2.Value * 100 Then WaitCycle = SubLoader2.Value * 100
Next
End If
Next
'启动加载源
'第一轮时：既然不直接使用已经加载好的结果，那就启动第一个加载器
If WaitCycle = 0 Then
'启动第一个源
LoaderList(0).Key.Start(MainLoader.Input, IsForceRestart)
'将其他源标记为未启动，以确保可以切换下载源（#184）
For i = 1 To LoaderList.Count - 1
LoaderList(i).Key.State = LoadState.Waiting
LoaderList.First.Key.Start(MainLoader.Input, IsForceRestart)
For Each Loader In LoaderList.Skip(1)
Loader.Key.State = LoadState.Waiting '将其他源标记为未启动，以确保可以切换下载源（#184）
Next
End If
'检查加载器失败或超时
For i = 0 To LoaderList.Count - 1
If WaitCycle = LoaderList(i).Value * 100 Then
If i < LoaderList.Count - 1 Then
'启动下一个源
LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart)
Else
'失败
Dim ErrorInfo As Exception = Nothing
For ii = 0 To LoaderList.Count - 1
LoaderList(ii).Key.Input = Nothing '重置输入，以免以同样的输入“重试加载”时直接失败
If LoaderList(ii).Key.Error IsNot Nothing Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("没有可用版本") Then
ErrorInfo = LoaderList(ii).Key.Error
End If
If WaitCycle <> LoaderList(i).Value * 100 Then Continue For
If i < LoaderList.Count - 1 AndAlso Not LoaderList.All(Function(l) l.Key.State = LoadState.Failed) Then
'若还有下一个源，则启动下一个源
LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart)
Else
'若没有，则失败
Dim ErrorInfo As Exception = Nothing
For ii = 0 To LoaderList.Count - 1
LoaderList(ii).Key.Input = Nothing '重置输入，以免以同样的输入“重试加载”时直接失败
If LoaderList(ii).Key.Error IsNot Nothing Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("没有可用版本") Then
ErrorInfo = LoaderList(ii).Key.Error
End If
Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderAbort(LoaderList)
Throw ErrorInfo
End If
Exit For
End If
Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderAbort(LoaderList)
Throw ErrorInfo
End If
Exit For
Next
'计时
Thread.Sleep(10)
WaitCycle += 1
'检查父加载器中断
If MainLoader.IsAborted Then
DlSourceLoaderAbort(LoaderList)
Exit Sub
End If
Thread.Sleep(10)
WaitCycle += 1
Loop
End Sub
Private Sub DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+13 -10
View File
@@ -489,16 +489,18 @@ NoUserJava:
Public JavaSearchLoader As New LoaderTask(Of Integer, Integer)("查找 Java", AddressOf JavaSearchLoaderSub) With {.ProgressWeight = 2}
Private Sub JavaSearchLoaderSub(Loader As LoaderTask(Of Integer, Integer))
If FrmSetupLaunch IsNot Nothing Then
RunInUiWait(Sub()
FrmSetupLaunch.ComboArgumentJava.Items.Clear()
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
RunInUiWait(
Sub()
FrmSetupLaunch.ComboArgumentJava.Items.Clear()
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
End If
If FrmVersionSetup IsNot Nothing Then
RunInUiWait(Sub()
FrmVersionSetup.ComboArgumentJava.Items.Clear()
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
RunInUiWait(
Sub()
FrmVersionSetup.ComboArgumentJava.Items.Clear()
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
End If
Try
@@ -520,6 +522,7 @@ NoUserJava:
Next
'查找磁盘中的 Java
For Each Disk As DriveInfo In DriveInfo.GetDrives()
If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器（#3705）
JavaSearchFolder(Disk.Name, JavaPreList, False)
Next
'查找 APPDATA 文件夹中的 Java
@@ -681,8 +684,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
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+27 -12
View File
@@ -225,9 +225,9 @@ NextInner:
Select Case Setup.Get("SystemLaunchCount")
Case 10, 20, 40, 60, 80, 100, 120, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦！" & vbCrLf &
"如果觉得 PCL 还算好用的话，也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
"毕竟一个人开发也不容易（悲）……",
"求赞助啦……", "这就赞助！", "但是我拒绝") = 1 Then
"如果 PCL 还算好用的话，能不能考虑赞助一下 PCL……" & vbCrLf &
"如果没有大家的支持，PCL 很难在免费、无任何广告的情况下维持数年的更新（磕头）……！",
Setup.Get("SystemLaunchCount") & " 次启动！", "支持 PCL！", "但是我拒绝") = 1 Then
OpenWebsite("https://afdian.com/a/LTCat")
End If
End Select
@@ -237,10 +237,10 @@ NextInner:
If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
If IsSystemLanguageChinese() Then
Select Case Setup.Get("SystemLaunchCount")
Case 2, 5, 10, 15, 20, 40, 60, 80, 100, 125, 150, 175, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
Case 3, 8, 15, 30, 50, 70, 90, 110, 130, 180, 220, 280, 330, 380, 450, 550, 660, 750, 880, 950, 1100, 1300, 1500, 1700, 1900
If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦！" & vbCrLf &
"如果觉得 Minecraft 还不错，可以购买正版支持一下，毕竟开发游戏也真的很不容易……" & vbCrLf & vbCrLf &
"在你登录一次正版账号后，就不会再出现这个提示了！",
"如果觉得 Minecraft 还不错，可以购买正版支持一下，毕竟开发游戏也真的很不容易……不要一直白嫖啦。" & vbCrLf & vbCrLf &
"在登录一次正版账号后，就不会再出现这个提示了！",
"考虑一下正版？", "支持正版游戏！", "下次一定") = 1 Then
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End If
@@ -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
''' <summary>
@@ -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}
@@ -805,7 +805,19 @@ LoginFinish:
ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage")
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then Throw New Exception("$登录失败：" & ErrorMessage)
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
If ErrorMessage.Contains("密码错误") OrElse ErrorMessage.ContainsF("Incorrect username or password", True) Then
'密码错误，退出登录 (#5090)
McLaunchLog("密码错误，退出登录")
Select Case Data.Input.Type
Case McLoginType.Auth
RunInUi(AddressOf PageLoginAuthSkin.ExitLogin)
Case McLoginType.Nide
RunInUi(AddressOf PageLoginNideSkin.ExitLogin)
End Select
End If
Throw New Exception("$登录失败：" & ErrorMessage)
End If
End If
'通用关键字检测
If AllMessage.Contains("403") Then
@@ -1643,8 +1655,11 @@ NextVersion:
GameSize = New Size(875 - 2, 540 - 2)
End Select
GameSize.Height -= 29.5 * DPI / 96 '标题栏高度
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 AndAlso
Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then '修复 #3463：1.12.2-，JRE 8 下窗口大小为设置大小的 DPI% 倍
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso
McLaunchJavaSelected.VersionCode <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then
'修复 #3463：1.12.2-，JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍
McLaunchLog($"已应用窗口大小过大修复（{McLaunchJavaSelected.Version.Revision}）")
GameSize.Width /= DPI / 96
GameSize.Height /= DPI / 96
End If
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+10 -11
View File
@@ -85,7 +85,7 @@ Public Module ModMinecraft
Next
If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Path = Path, .Type = McFolderType.Custom})
Else
Hint("无效的 Minecraft 文件夹：" & Path, HintType.Critical)
Hint("无法访问 Minecraft 文件夹：" & Path, HintType.Critical)
End If
Next
@@ -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)
@@ -2305,8 +2308,8 @@ OnLoaded:
End If
Left = Left.ToLowerInvariant
Right = Right.ToLowerInvariant
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
Dim i As Integer = 0
While True
'两边均缺失，感觉是一个东西
@@ -2355,15 +2358,11 @@ NextEntry:
''' <summary>
''' 比较两个版本名的排序器。
''' </summary>
Public Class VersionSorter
Public Class VersionComparer
Implements IComparer(Of String)
Public IsDecreased As Boolean = True
Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare
Return VersionSortInteger(x, y) * If(IsDecreased, -1, 1)
Return VersionSortInteger(x, y)
End Function
Public Sub New(Optional IsDecreased As Boolean = True)
Me.IsDecreased = IsDecreased
End Sub
End Class
''' <summary>
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
+2 -2
View File
@@ -688,7 +688,7 @@ Finished:
''' </summary>
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
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+181 -149
View File
@@ -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
''' <summary>
''' 安装一个给定的整合包文件，返回启动的安装加载器，如果未成功启动则返回 Nothing。
''' 构建并启动安装给定的整合包文件的加载器，并返回该加载器。若失败则抛出异常。
''' 必须在工作线程执行。
''' </summary>
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)
''' <exception cref="CancelledException" />
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 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 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.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(TargetFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Function
'普通压缩包
Private Function InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) As LoaderCombo(Of String)
MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹，它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True)
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\/(?<ver>[^\/]+)\/(\k<ver>)\.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 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)
})
Loader.Start()
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()
Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb
+1 -1
View File
@@ -96,7 +96,7 @@
'记录当前展开的卡片标题（#2712）
Dim Titles As New List(Of String)
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
For Each Card As MyCard In FrmDownloadCompDetail.PanMain.Children
For Each Card As MyCard In FrmDownloadCompDetail.PanResults.Children
If Card.Title <> "" AndAlso Not Card.IsSwaped Then Titles.Add(Card.Title)
Next
Log("[Comp] 记录当前已展开的卡片：" & String.Join("、", Titles))
Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml
+2 -2
View File
@@ -30,12 +30,12 @@
<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0"
SnapsToDevicePixels="False" UseLayoutRounding="False" x:Name="PanTitle">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" x:Name="ColumnTitle" />
<ColumnDefinition Width="Auto" x:Name="ColumnSubtitle" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" x:Name="ColumnExtend" />
</Grid.ColumnDefinitions>
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabTitle" TextTrimming="CharacterEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabSubtitle" Grid.Column="1" HorizontalAlignment="Left"
TextTrimming="CharacterEllipsis" FontSize="12" IsHitTestVisible="False"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb
+68 -28
View File
@@ -303,30 +303,33 @@ Public Class MyLocalModItem
#End Region
Private Function GetUpdateCompareDescription() As String
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
'简化名称对比
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
Dim NewestSegs = NewestName.Split("-"c).ToList()
Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For
CurrentSegs.Remove(Seg)
NewestSegs.Remove(Seg)
Shortened = True
Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentName = Join(CurrentSegs, "-")
NewestName = Join(NewestSegs, "-")
Entry._Version = CurrentName '使用网络信息作为显示的版本号
End If
Return $"当前版本：{CurrentName}（{GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}）{vbCrLf}最新版本：{NewestName}（{GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)}）"
End Function
Public Sub Refresh() Handles Me.Loaded
RunInUi(
Sub()
'更新
If Entry.CanUpdate Then
BtnUpdate.Visibility = Visibility.Visible
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
'简化名称对比
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
Dim NewestSegs = NewestName.Split("-"c).ToList()
Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For
CurrentSegs.Remove(Seg)
NewestSegs.Remove(Seg)
Shortened = True
Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentName = Join(CurrentSegs, "-")
NewestName = Join(NewestSegs, "-")
Entry._Version = CurrentName '使用网络信息作为显示的版本号
End If
BtnUpdate.ToolTip = $"当前版本：{CurrentName} ({Entry.CompFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}最新版本：{NewestName} ({Entry.UpdateFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}点击以更新，右键查看更新日志。"
BtnUpdate.ToolTip = $"{GetUpdateCompareDescription()}{vbCrLf}点击以更新，右键查看更新日志。"
Else
BtnUpdate.Visibility = Visibility.Collapsed
End If
@@ -476,20 +479,57 @@ Public Class MyLocalModItem
'触发更新
Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
If MyMsgBox($"是否要更新 {Entry.Name}？{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "取消") = 2 Then Return
FrmVersionMod.UpdateMods({Entry})
End Sub
'自适应（#4465）
Private Sub PanTitle_SizeChanged(sender As Object, e As SizeChangedEventArgs) Handles PanTitle.SizeChanged
If ColumnExtend.Width.IsStar AndAlso ColumnExtend.ActualWidth < 0.5 Then
'压缩 Subtitle
ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
ElseIf Not ColumnExtend.Width.IsStar AndAlso Not LabSubtitle.IsTextTrimmed Then
'向右展开 Subtitle
ColumnSubtitle.Width = GridLength.Auto
ColumnExtend.Width = New GridLength(1, GridUnitType.Star)
End If
Private Sub PanTitle_SizeChanged() Handles PanTitle.SizeChanged
'0：全部舒展：Auto - Auto - (Auto) - 1*
'1：压缩 Subtitle：Auto - 1* - (Auto) - 0
'2：继续压缩 Title：1* - 0 - (Auto) - 0
Dim CurrentCompressLevel As Integer =
If(ColumnExtend.Width.IsStar, 0, If(ColumnTitle.Width.IsStar, 2, 1)) 'Subtitle 可能是 Collapsed
Dim NewCompressLevel As Integer
Select Case CurrentCompressLevel
Case 0
If ColumnExtend.ActualWidth < 0.5 Then
NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 2, 1)
Else
Return
End If
Case 1
If ColumnSubtitle.ActualWidth < 0.5 Then
NewCompressLevel = 2
ElseIf Not LabSubtitle.IsTextTrimmed Then
NewCompressLevel = 0
Else
Return
End If
Case 2
If Not LabTitle.IsTextTrimmed Then
NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 0, 1)
Else
Return
End If
End Select
Select Case NewCompressLevel
Case 0
'全部舒展：Auto - Auto - (Auto) - 1*
ColumnTitle.Width = GridLength.Auto
ColumnSubtitle.Width = GridLength.Auto
ColumnExtend.Width = New GridLength(1, GridUnitType.Star)
Case 1
'压缩 Subtitle：Auto - 1* - (Auto) - 0
ColumnTitle.Width = GridLength.Auto
ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
Case 2
'继续压缩 Title：1* - 0 - (Auto) - 0
ColumnTitle.Width = New GridLength(1, GridUnitType.Star)
ColumnSubtitle.Width = New GridLength(0, GridUnitType.Pixel)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
End Select
End Sub
End Class
Plain Craft Launcher 2/Modules/ModEvent.vb
-1
View File
@@ -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"))
Plain Craft Launcher 2/Modules/ModMain.vb
+6 -1
View File
@@ -443,6 +443,10 @@ EndHint:
#Region "帮助"
Public Class HelpEntry
''' <summary>
''' 原始信息路径。用于刷新。
''' </summary>
Public RawPath As String
'基础
@@ -501,6 +505,7 @@ EndHint:
''' 从文件初始化 HelpEntry 对象，失败会抛出异常。
''' </summary>
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)
Plain Craft Launcher 2/Modules/ModMusic.vb
+71 -50
View File
@@ -17,8 +17,8 @@ Public Module ModMusic
''' 初始化音乐播放列表。
''' </summary>
''' <param name="ForceReload">强制全部重新载入列表。</param>
''' <param name="IgnoreFirst">在重载列表时避免让某项成为第一项。</param>
Private Sub MusicListInit(ForceReload As Boolean, Optional IgnoreFirst As String = "")
''' <param name="PreventFirst">在重载列表时避免让某项成为第一项。</param>
Private Sub MusicListInit(ForceReload As Boolean, Optional PreventFirst As String = Nothing)
If ForceReload Then MusicAllList = Nothing
Try
'初始化全部可用音乐列表
@@ -34,10 +34,10 @@ Public Module ModMusic
End If
'打乱顺序播放
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
If Not IgnoreFirst = "" AndAlso Not Not MusicWaitingList.Any() AndAlso MusicWaitingList(0) = IgnoreFirst Then
If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then
'若需要避免成为第一项的为第一项，则将它放在最后
MusicWaitingList.RemoveAt(0)
MusicWaitingList.Add(IgnoreFirst)
MusicWaitingList.Add(PreventFirst)
End If
Catch ex As Exception
Log(ex, "初始化音乐列表失败", LogLevel.Feedback)
@@ -45,13 +45,18 @@ Public Module ModMusic
End Sub
''' <summary>
''' 获取下一首播放的音乐路径并将其从列表中移除。
''' 如果没有，可能会返回 Nothing。
''' </summary>
Private Function DequeueNextMusicAddress() As String
'初始化，确保存在音乐
If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False)
'出列下一个音乐，如果出列结束则生成新列表
DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
If MusicWaitingList.Any() Then
DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
Else
DequeueNextMusicAddress = Nothing
End If
If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress)
End Function
@@ -63,44 +68,45 @@ Public Module ModMusic
''' 刷新背景音乐按钮 UI 与设置页 UI。
''' </summary>
Private Sub MusicRefreshUI()
RunInUi(Sub()
Try
RunInUi(
Sub()
Try
If Not MusicAllList.Any() Then
'无背景音乐
FrmMain.BtnExtraMusic.Show = False
If Not MusicAllList.Any() Then
'无背景音乐
FrmMain.BtnExtraMusic.Show = False
Else
'有背景音乐
FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
ToolTipText = "已暂停：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。"
Else
'有背景音乐
FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
ToolTipText = "已暂停：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键恢复播放，右键重新从头播放。"
End If
Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
ToolTipText = "正在播放：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键暂停，右键重新从头播放。"
End If
End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
ToolTipText += vbCrLf & "左键恢复播放，右键重新从头播放。"
End If
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
ToolTipText = "正在播放：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键暂停，右键重新从头播放。"
End If
End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
End If
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
Catch ex As Exception
Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
End Try
End Sub)
Catch ex As Exception
Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
End Try
End Sub)
End Sub
''' <summary>
@@ -131,8 +137,12 @@ Public Module ModMusic
Hint("重新播放：" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
Else
Dim Address As String = DequeueNextMusicAddress()
MusicStartPlay(Address)
Hint("正在播放：" & GetFileNameFromPath(Address), HintType.Finish)
If Address Is Nothing Then
Hint("没有可以播放的音乐！", HintType.Critical)
Else
MusicStartPlay(Address)
Hint("正在播放：" & GetFileNameFromPath(Address), HintType.Finish)
End If
End If
MusicRefreshUI()
End Sub
@@ -182,11 +192,15 @@ Public Module ModMusic
End If
Else
Dim Address As String = DequeueNextMusicAddress()
Try
MusicStartPlay(Address, IsFirstLoad)
If ShowHint Then Hint("背景音乐已刷新：" & GetFileNameFromPath(Address), HintType.Finish, False)
Catch
End Try
If Address Is Nothing Then
If ShowHint Then Hint("没有可以播放的音乐！", HintType.Critical)
Else
Try
MusicStartPlay(Address, IsFirstLoad)
If ShowHint Then Hint("背景音乐已刷新：" & GetFileNameFromPath(Address), HintType.Finish, False)
Catch
End Try
End If
End If
MusicRefreshUI()
@@ -198,6 +212,7 @@ Public Module ModMusic
''' 开始播放音乐。
''' </summary>
Private Sub MusicStartPlay(Address As String, Optional IsFirstLoad As Boolean = False)
If Address Is Nothing Then Return
Log("[Music] 播放开始：" & Address)
MusicCurrent = Address
RunInNewThread(Sub() MusicLoop(IsFirstLoad), "Music", ThreadPriority.BelowNormal)
@@ -292,15 +307,21 @@ Public Module ModMusic
End If
If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) Then
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
ex.Message.Contains("0xC00D36C4") Then '#5096：不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
Else
Log(ex, "播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）", LogLevel.Hint)
End If
Thread.Sleep(1000)
'将播放错误的音乐从列表中移除
MusicAllList.Remove(MusicCurrent)
MusicWaitingList.Remove(MusicCurrent)
MusicRefreshUI()
'等待 2 秒后继续播放
Thread.Sleep(2000)
If TypeOf ex Is FileNotFoundException Then
MusicRefreshPlay(True, IsFirstLoad)
ElseIf MusicAllList.Count > 1 Then
Else
MusicStartPlay(DequeueNextMusicAddress(), IsFirstLoad)
End If
Finally
Plain Craft Launcher 2/Modules/ModSecret.vb
+2 -2
View File
@@ -109,7 +109,7 @@ Friend Module ModSecret
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
End If
Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.open.server/"
Client.Headers("x-api-key") = CurseForgeAPIKey
If Url.Contains("api.curseforge.com") Then Client.Headers("x-api-key") = CurseForgeAPIKey
End Sub
''' <summary>
''' 设置 Headers 的 UA、Referer。
@@ -123,7 +123,7 @@ Friend Module ModSecret
Request.UserAgent = "PCL2/" & VersionStandardCode
End If
Request.Referer = "http://" & VersionCode & ".pcl2.open.server/"
Request.Headers("x-api-key") = CurseForgeAPIKey
If Url.Contains("api.curseforge.com") Then Request.Headers("x-api-key") = CurseForgeAPIKey
End Sub
#End Region