2.8.10
This commit is contained in:
@@ -12,13 +12,13 @@ Public Module ModBase
|
||||
#Region "声明"
|
||||
|
||||
'下列版本信息由更新器自动修改
|
||||
Public Const VersionBaseName As String = "2.8.9" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.8.9." & VersionBranchCode '标准格式的四段式版本号
|
||||
Public Const VersionBaseName As String = "2.8.10" '不含分支前缀的显示用版本名
|
||||
Public Const VersionStandardCode As String = "2.8.10." & VersionBranchCode '标准格式的四段式版本号
|
||||
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
|
||||
#If BETA Then
|
||||
Public Const VersionCode As Integer = 340 'Release
|
||||
Public Const VersionCode As Integer = 342 'Release
|
||||
#Else
|
||||
Public Const VersionCode As Integer = 341 'Snapshot
|
||||
Public Const VersionCode As Integer = 343 'Snapshot
|
||||
#End If
|
||||
'自动生成的版本信息
|
||||
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
|
||||
@@ -990,7 +990,7 @@ Public Module ModBase
|
||||
End Using
|
||||
End Function
|
||||
''' <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 +1207,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 +1224,9 @@ Re:
|
||||
Else
|
||||
'以 zip 方式解压
|
||||
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
|
||||
Dim TotalCount As Integer = Archive.Entries.Count
|
||||
For Each Entry As ZipArchiveEntry In Archive.Entries
|
||||
If ProgressIncrementHandler IsNot Nothing Then ProgressIncrementHandler(1 / TotalCount)
|
||||
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
|
||||
If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
|
||||
Continue For '不创建空文件夹
|
||||
@@ -1293,13 +1296,16 @@ RetryDir:
|
||||
''' <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 +1558,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 +1570,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 +1606,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 +1874,31 @@ RetryDir:
|
||||
|
||||
#Region "系统"
|
||||
|
||||
''' <summary>
|
||||
''' 线程安全的,可以直接使用 For Each 的 List。
|
||||
''' 在使用 For Each 循环时,列表的结果可能并非最新,但不会抛出异常。
|
||||
''' </summary>
|
||||
Public Class SafeList(Of T)
|
||||
Inherits SynchronizedCollection(Of T)
|
||||
Public Sub New()
|
||||
MyBase.New()
|
||||
End Sub
|
||||
Public Sub New(Data As IEnumerable(Of T))
|
||||
MyBase.New(New Object, Data)
|
||||
End Sub
|
||||
Public Shared Widening Operator CType(Data As List(Of T)) As SafeList(Of T)
|
||||
Return New SafeList(Of T)(Data)
|
||||
End Operator
|
||||
Public Shared Widening Operator CType(Data As SafeList(Of T)) As List(Of T)
|
||||
Return New List(Of T)(Data)
|
||||
End Operator
|
||||
Public Overloads Function GetEnumerator() As IEnumerator(Of T)
|
||||
SyncLock SyncRoot
|
||||
Return Items.ToList.GetEnumerator()
|
||||
End SyncLock
|
||||
End Function
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 可用于临时存放文件的,不含任何特殊字符的文件夹路径,以“\”结尾。
|
||||
''' </summary>
|
||||
@@ -1866,6 +1921,12 @@ RetryDir:
|
||||
Public Class RestartException
|
||||
Inherits Exception
|
||||
End Class
|
||||
''' <summary>
|
||||
''' 指示用户手动取消了操作,或用户已知晓操作被取消的原因。
|
||||
''' </summary>
|
||||
Public Class CancelledException
|
||||
Inherits Exception
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 当前程序是否拥有管理员权限。
|
||||
@@ -1983,11 +2044,11 @@ NextElement:
|
||||
'12~60 月,“1 年 2 个月”
|
||||
GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年" & If((TotalMonthes Mod 12) > 0, " " & (TotalMonthes Mod 12) & " 个月", "")
|
||||
ElseIf TotalMonthes >= 4 Then
|
||||
'4~11 月,“5 月”
|
||||
GetTimeSpanString = TotalMonthes & " 月"
|
||||
'4~11 月,“5 个月”
|
||||
GetTimeSpanString = TotalMonthes & " 个月"
|
||||
ElseIf TotalMonthes >= 1 Then
|
||||
'1~4 月,“2 月 13 天”
|
||||
GetTimeSpanString = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
|
||||
'1~4 月,“2 个月 13 天”
|
||||
GetTimeSpanString = TotalMonthes & " 个月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
|
||||
ElseIf Span.TotalDays >= 4 Then
|
||||
'4~30 天,“23 天”
|
||||
GetTimeSpanString = Span.Days & " 天"
|
||||
@@ -2108,7 +2169,7 @@ NextElement:
|
||||
''' <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 +2179,7 @@ NextElement:
|
||||
Catch ex As Exception
|
||||
Log(ex, Name & ":线程执行失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub) With {.Name = Name, .Priority = Priority}
|
||||
End Sub) With {.Name = If(Name, "Runtime New Invoke " & GetUuid() & "#"), .Priority = Priority}
|
||||
th.Start()
|
||||
Return th
|
||||
End Function
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -701,7 +701,7 @@ RequestFinished:
|
||||
''' <summary>
|
||||
''' 所属的文件列表任务。
|
||||
''' </summary>
|
||||
Public Tasks As New SynchronizedCollection(Of LoaderDownload)
|
||||
Public Tasks As New SafeList(Of LoaderDownload)
|
||||
''' <summary>
|
||||
''' 所有下载源。
|
||||
''' </summary>
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -271,7 +271,7 @@
|
||||
Next
|
||||
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
|
||||
GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")).
|
||||
Select(Function(v) CInt(Val(v.Split(".")(1).Before("-")))).Where(Function(v) v > 0).
|
||||
Select(Function(v) CInt(Val(v.Split(".")(1).BeforeFirst("-")))).Where(Function(v) v > 0).
|
||||
Distinct.OrderByDescending(Function(v) v).ToList
|
||||
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
|
||||
'Type
|
||||
@@ -349,7 +349,7 @@
|
||||
'搜索结果的键为 versions,获取特定工程的键为 game_versions
|
||||
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
|
||||
Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")).
|
||||
Select(Of Integer)(Function(v) Val(v.Split(".")(1).Before("-"))).Where(Function(v) v > 0).
|
||||
Select(Of Integer)(Function(v) Val(v.Split(".")(1).BeforeFirst("-"))).Where(Function(v) v > 0).
|
||||
Distinct.OrderByDescending(Function(v) v).ToList
|
||||
'Type
|
||||
Select Case Data("project_type").ToString
|
||||
@@ -583,9 +583,9 @@
|
||||
'有中文翻译
|
||||
'尝试将文本分为三段:Title (EnglishName) - Suffix
|
||||
'检查时注意 Carpet:它没有中文译名,但有 Suffix
|
||||
Title = TranslatedName.Before(" (").Before(" - ")
|
||||
Title = TranslatedName.BeforeFirst(" (").BeforeFirst(" - ")
|
||||
Dim Suffix As String = ""
|
||||
If TranslatedName.After(")").Contains(" - ") Then Suffix = TranslatedName.After(")").After(" - ")
|
||||
If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ")
|
||||
Dim EnglishName As String = TranslatedName
|
||||
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
|
||||
EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
|
||||
@@ -758,7 +758,7 @@ NoSubtitle:
|
||||
Case CompType.ResourcePack
|
||||
'FUTURE: Res
|
||||
End Select
|
||||
Address += "&categoryId=" & If(Tag = "", "0", Tag.Before("/"))
|
||||
Address += "&categoryId=" & If(Tag = "", "0", Tag.BeforeFirst("/"))
|
||||
If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
|
||||
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
|
||||
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
|
||||
@@ -779,7 +779,7 @@ NoSubtitle:
|
||||
'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
|
||||
Dim Facets As New List(Of String)
|
||||
Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]")
|
||||
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.After("/")}'""]")
|
||||
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
|
||||
If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]")
|
||||
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
|
||||
Address += "&facets=[" & String.Join(",", Facets) & "]"
|
||||
@@ -887,7 +887,7 @@ NoSubtitle:
|
||||
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
|
||||
If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " "
|
||||
If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " "
|
||||
SearchResult += SearchResults(i).Item.ChineseName.After(" (").TrimEnd(") ").Before(" - ").
|
||||
SearchResult += SearchResults(i).Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
|
||||
Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " "
|
||||
Next
|
||||
Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer)
|
||||
@@ -1313,7 +1313,7 @@ Retry:
|
||||
'GameVersions
|
||||
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
|
||||
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
|
||||
Select(Function(v) If(v.Contains("-"), v.Before("-") & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
|
||||
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
|
||||
If GameVersions.Count > 1 Then
|
||||
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
|
||||
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
|
||||
@@ -1362,28 +1362,26 @@ Retry:
|
||||
Optional BadDisplayName As Boolean = False) As MyListItem
|
||||
|
||||
'获取描述信息
|
||||
Dim Info As String = ""
|
||||
Dim Title As String = If(BadDisplayName, FileName, DisplayName)
|
||||
Dim Info As New List(Of String)
|
||||
If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast("."))
|
||||
Select Case Type
|
||||
Case CompType.Mod
|
||||
Info += If(ModLoaders.Any,
|
||||
"适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & ",", "")
|
||||
Info += If(ModeDebug AndAlso Dependencies.Any, Dependencies.Count & " 个前置 Mod,", "")
|
||||
If Dependencies.Any Then Info.Add(Dependencies.Count & " 个前置 Mod")
|
||||
Case CompType.ModPack
|
||||
If GameVersions.All(Function(v) v.Contains("w")) Then
|
||||
Info += $"游戏版本 {Join(GameVersions, "、")},"
|
||||
End If
|
||||
If GameVersions.All(Function(v) v.Contains("w")) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
|
||||
End Select
|
||||
If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
|
||||
Info += If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载,", DownloadCount & " 次下载,")
|
||||
Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
|
||||
End If
|
||||
Info += GetTimeSpanString(ReleaseDate - Date.Now, False) & "更新"
|
||||
Info += If(Status = CompFileStatus.Release, "", "," & StatusDescription)
|
||||
Info.Add("更新于 " & GetTimeSpanString(ReleaseDate - Date.Now, False))
|
||||
If Status <> CompFileStatus.Release Then Info.Add(StatusDescription)
|
||||
|
||||
'建立控件
|
||||
Dim NewItem As New MyListItem With {
|
||||
.Title = If(BadDisplayName, FileName, DisplayName),
|
||||
.Title = Title,
|
||||
.SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
|
||||
.Info = Info
|
||||
.Info = Info.Join(",")
|
||||
}
|
||||
Select Case Status
|
||||
Case CompFileStatus.Release
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -780,7 +780,7 @@
|
||||
Inherit = "1.20.1"
|
||||
Else '20.4.30-beta
|
||||
VersionName = ApiName
|
||||
Version = New Version(ApiName.Before("-"))
|
||||
Version = New Version(ApiName.BeforeFirst("-"))
|
||||
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor)
|
||||
End If
|
||||
End Sub
|
||||
@@ -1089,7 +1089,7 @@
|
||||
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
|
||||
If McimUrl <> Url Then
|
||||
Select Case Setup.Get("ToolDownloadMod")
|
||||
'UNDONE: 在 MCIM 源稳定后回调
|
||||
'TODO: 在 MCIM 源稳定后回调
|
||||
Case 0
|
||||
If ModeDebug Then
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
|
||||
@@ -1138,7 +1138,7 @@
|
||||
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
|
||||
If McimUrl <> Url Then
|
||||
Select Case Setup.Get("ToolDownloadMod")
|
||||
'UNDONE: 在 MCIM 源稳定后回调
|
||||
'TODO: 在 MCIM 源稳定后回调
|
||||
Case 0
|
||||
If ModeDebug Then
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
|
||||
|
||||
@@ -681,8 +681,8 @@ Wait:
|
||||
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
|
||||
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
|
||||
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
|
||||
If IsFullSearch OrElse FolderInfo.Parent.Name.ToLower = "users" OrElse
|
||||
Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
|
||||
If IsFullSearch OrElse
|
||||
FolderInfo.Parent.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
|
||||
JavaSearchFolder(FolderInfo, Results, Source)
|
||||
End If
|
||||
Next
|
||||
|
||||
@@ -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}
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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()
|
||||
|
||||
@@ -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"))
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user