2.13.0.0
This commit is contained in:
龙腾猫跃
@@ -1,4 +1,4 @@
|
||||
'动画引擎模块
|
||||
'动画引擎模块
|
||||
'使用 Ani 作为方法或属性的开头，使用 Aa 作为单个动画对象的开头（便于自动补全）
|
||||
|
||||
Imports System.Windows.Media.Effects
|
||||
@@ -832,7 +832,12 @@ Public Module ModAnimation
|
||||
AniCount = 0
|
||||
AniTimer(DeltaTime * AniSpeed)
|
||||
If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
|
||||
Logger.Info($"FPS {AniFPS}, 动画 {AniCount}, 下载中 {NetManager.FileRemain}（{FormatFileSize(NetManager.Speed)}/s）")
|
||||
Logger.Info($"FPS {AniFPS}, 动画 {AniCount}, 下载中 {NetManager.FileRemain}（{StringUtils.FormatByteSize(NetManager.Speed)}/s）")
|
||||
If NetManager.FileRemain < 5 Then
|
||||
For Each File In NetManager.AllFiles.Values
|
||||
If File.State < NetState.Finished Then Logger.Trace($"- {File.State} {StringUtils.FormatByteSize(File.Speed)}/s {File.LocalPath}")
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
End Sub)
|
||||
Sleeper:
|
||||
@@ -1018,7 +1023,7 @@ NextAni:
|
||||
If Convert.ToInt32(Convert.ToChar(NextText)) >= Convert.ToInt32(Convert.ToChar(128)) Then
|
||||
NewText &= Encoding.GetEncoding("GB18030").GetString({RandomInteger(16 + 160, 87 + 160), RandomInteger(1 + 160, 89 + 160)})
|
||||
Else
|
||||
NewText &= RandomOne("0123456789./*-+\[]{};':/?,!@#$%^&*()_+-=qwwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM".ToCharArray)
|
||||
NewText &= RandomInteger(0, 85).ConvertRadix(86)
|
||||
End If
|
||||
End If
|
||||
'设置文本
|
||||
|
||||
@@ -1,21 +1,17 @@
|
||||
Imports System.Globalization
|
||||
Imports System.Runtime.CompilerServices
|
||||
Imports System.Security.Cryptography
|
||||
Imports System.Threading.Tasks
|
||||
Imports System.Xaml
|
||||
Imports Newtonsoft.Json
|
||||
|
||||
Public Module ModBase
|
||||
|
||||
#Region "声明"
|
||||
|
||||
'下列版本信息由更新器自动修改
|
||||
Public Const VersionBaseName As String = "2.12.8.2" '显示用版本名
|
||||
Public Const VersionBaseName As String = "2.13.0.0" '显示用版本名
|
||||
Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
|
||||
#If RELEASE Then
|
||||
Public Const VersionCode As Integer = 404 '正式版
|
||||
Public Const VersionCode As Integer = 406 '正式版
|
||||
#Else
|
||||
Public Const VersionCode As Integer = 403 '快照版
|
||||
Public Const VersionCode As Integer = 405 '快照版
|
||||
#End If
|
||||
|
||||
'版本信息
|
||||
@@ -41,13 +37,9 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
Public Handle As IntPtr
|
||||
''' <summary>
|
||||
''' 程序的启动路径，以 \ 结尾。
|
||||
''' </summary>
|
||||
Public PathExeFolder As String = AppDomain.CurrentDomain.SetupInformation.ApplicationBase
|
||||
''' <summary>
|
||||
''' 包含程序名的完整路径。
|
||||
''' </summary>
|
||||
Public PathExe As String = PathExeFolder & AppDomain.CurrentDomain.SetupInformation.ApplicationName
|
||||
Public PathExe As String = Paths.Base & AppDomain.CurrentDomain.SetupInformation.ApplicationName
|
||||
''' <summary>
|
||||
''' 程序内嵌图片文件夹路径，以 / 结尾。
|
||||
''' </summary>
|
||||
@@ -57,10 +49,6 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
Public PathTemp As String = If(Settings.Get(Of String)("SystemSystemCache") = "", Path.GetTempPath() & "PCL\", Settings.Get(Of String)("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\"
|
||||
''' <summary>
|
||||
''' AppData 中的 PCL 文件夹路径，以 \ 结尾。
|
||||
''' </summary>
|
||||
Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\PCL\"
|
||||
''' <summary>
|
||||
''' 当前程序的语言。
|
||||
''' </summary>
|
||||
Public Lang As String = "zh_CN"
|
||||
@@ -81,10 +69,6 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
Public IsProgramEnding As Boolean = False
|
||||
''' <summary>
|
||||
''' 是否为 32 位系统。
|
||||
''' </summary>
|
||||
Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem
|
||||
''' <summary>
|
||||
''' 是否使用 GBK 编码。
|
||||
''' </summary>
|
||||
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
|
||||
@@ -139,7 +123,7 @@ Public Module ModBase
|
||||
''' <summary>
|
||||
''' 图标按钮，刷新，0.85x
|
||||
''' </summary>
|
||||
Public Const IconButtonRefresh As String = "M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"
|
||||
Public Const IconButtonRefresh As String = "M512.0 838.3c-80.2 0-153.4-29.3-210.2-77.4l75.5-75.5c11.5-11.5 25.8-22.0 25.8-37.0a27.2 27.2 0 0 0-27.1-27.1H104.0c-27.1 0-27.1 23.9-27.1 27.1v271.9a27.1 27.1 0 0 0 27.1 27.1c15.0 0 27.8-16.6 42.5-31.2l77.9-77.9c76.6 67.7 177.1 108.9 287.4 108.9 221.7 0 404.5-166.0 431.2-380.6h-109.8c-25.9 154.2-159.7 271.9-321.3 271.9zM919.9 76.6c-15.0 0-27.8 16.6-42.5 31.3L799.5 185.8c-76.5-67.7-177.1-108.9-287.4-108.9-221.8 0-404.5 166.1-431.3 380.6H190.6c25.9-154.2 159.7-271.9 321.4-271.9 80.2 0 153.4 29.3 210.1 77.4l-75.5 75.5c-11.6 11.5-25.8 22.0-25.8 37.1a27.2 27.2 0 0 0 27.1 27.1h271.9c27.1 0 27.1-23.9 27.1-27.1V103.8a27.1 27.1 0 0 0-27.1-27.1z"
|
||||
''' <summary>
|
||||
''' 图标按钮，软盘，1x
|
||||
''' </summary>
|
||||
@@ -153,10 +137,18 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
Public Const IconButtonList As String = "M384 128h640v128H384zM160 192m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 448h640v128H384zM160 512m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 768h640v128H384zM160 832m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0Z"
|
||||
''' <summary>
|
||||
''' 图标按钮，文件夹，1.15x
|
||||
''' 图标按钮，文件夹，1.1x
|
||||
''' </summary>
|
||||
Public Const IconButtonOpen As String = "M889.018182 418.909091H884.363636V316.509091a93.090909 93.090909 0 0 0-99.607272-89.832727h-302.545455l-93.090909-76.334546A46.545455 46.545455 0 0 0 358.865455 139.636364H146.152727A93.090909 93.090909 0 0 0 46.545455 229.469091V837.818182a46.545455 46.545455 0 0 0 46.545454 46.545454 46.545455 46.545455 0 0 0 16.756364-3.258181 109.381818 109.381818 0 0 0 25.134545 3.258181h586.472727a85.178182 85.178182 0 0 0 87.04-63.301818l163.374546-302.545454a46.545455 46.545455 0 0 0 5.585454-21.876364A82.385455 82.385455 0 0 0 889.018182 418.909091z m-744.727273-186.181818h198.283636l93.09091 76.334545a46.545455 46.545455 0 0 0 29.323636 10.705455h319.301818a12.101818 12.101818 0 0 1 6.516364 0V418.909091H302.545455a85.178182 85.178182 0 0 0-87.04 63.301818L139.636364 622.778182V232.727273a19.549091 19.549091 0 0 1 6.516363 0z m578.094546 552.029091a27.461818 27.461818 0 0 0-2.792728 6.516363H154.530909l147.083636-272.290909a27.461818 27.461818 0 0 0 2.792728-6.981818h565.061818z"
|
||||
''' <summary>
|
||||
''' 图标按钮，上箭头，0.95x
|
||||
''' </summary>
|
||||
Public Const IconButtonArrowUp As String = "M554 333V853h-85V333l-228 228-60-60L512 170l331 331-60 60L554 333z"
|
||||
''' <summary>
|
||||
''' 图标按钮，下箭头，0.95x
|
||||
''' </summary>
|
||||
Public Const IconButtonArrowDown As String = "M554 691V171h-85V691L241 463l-60 60L512 854l331-331-60-60L554 691z"
|
||||
''' <summary>
|
||||
''' 图标按钮，名片，1.1x
|
||||
''' </summary>
|
||||
Public Const IconButtonCard As String = "M834.5 684.1c-31.2-70.4-98.9-120.9-179.1-127.3 63.5-8.5 112.6-63 112.6-128.8 0-71.8-58.2-130-130-130s-130 58.2-130 130c0 65.9 49 120.3 112.6 128.8-80.2 6.4-148 57-179.1 127.3-8.7 19.7 6 42 27.6 42 12.1 0 22.7-7.5 27.7-18.5 24.3-53.9 78.5-91.5 141.3-91.5s117 37.6 141.3 91.5c5 11.1 15.6 18.5 27.7 18.5 21.4 0 36.1-22.3 27.4-42zM567.9 427.9c0-38.6 31.4-70 70-70s70 31.4 70 70-31.4 70-70 70-70-31.4-70-70zM460.3 347.9H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h243.3c16.6 0 30-13.4 30-30 0.1-16.5-13.4-30-29.9-30zM367.4 459.6H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h150.4c16.6 0 30-13.4 30-30 0.1-16.6-13.4-30-29.9-30zM297.4 571.2H217c-16.6 0-30 13.4-30 30s13.4 30 30 30h80.4c16.6 0 30-13.4 30-30 0-16.5-13.5-30-30-30zM900 236v552H124V236h776m0-60H124c-33.1 0-60 26.9-60 60v552c0 33.1 26.9 60 60 60h776c33.1 0 60-26.9 60-60V236c0-33.1-26.9-60-60-60z"
|
||||
@@ -436,7 +428,7 @@ Public Module ModBase
|
||||
Loading
|
||||
Finished
|
||||
Failed
|
||||
Interrupted
|
||||
Canceled
|
||||
End Enum
|
||||
|
||||
''' <summary>
|
||||
@@ -531,7 +523,7 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
|
||||
Public Sub IniClearCache(FileName As String)
|
||||
If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
|
||||
If Not FileName.Contains(":\") Then FileName = $"{Paths.Base}PCL\{FileName}.ini"
|
||||
IniCache.Remove(FileName)
|
||||
End Sub
|
||||
''' <summary>
|
||||
@@ -542,7 +534,7 @@ Public Module ModBase
|
||||
Private Function IniGetContent(FileName As String) As ConcurrentDictionary(Of String, String)
|
||||
Try
|
||||
'还原文件路径
|
||||
If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
|
||||
If Not FileName.Contains(":\") Then FileName = $"{Paths.Base}PCL\{FileName}.ini"
|
||||
'检索缓存
|
||||
Dim Cache As ConcurrentDictionary(Of String, String) = Nothing
|
||||
If IniCache.TryGetValue(FileName, Cache) Then Return Cache
|
||||
@@ -616,9 +608,9 @@ Public Module ModBase
|
||||
FileContent.Append(Pair.Value)
|
||||
FileContent.Append(vbCrLf)
|
||||
Next
|
||||
If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
|
||||
If Not FileName.Contains(":\") Then FileName = $"{Paths.Base}PCL\{FileName}.ini"
|
||||
'处理相对路径
|
||||
FileName = If(FileName.Contains(":\"), FileName, PathExeFolder & FileName)
|
||||
FileName = If(FileName.Contains(":\"), FileName, Paths.Base & FileName)
|
||||
FileUtils.Write(FileName, FileContent.ToString)
|
||||
Catch ex As Exception
|
||||
Logger.Error(ex, $"写入文件失败（{FileName} → {Key}:{Value}）", LogBehavior.Toast)
|
||||
@@ -657,142 +649,12 @@ Public Module ModBase
|
||||
FileUtils.Delete(TestFilePath)
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 文件的校验规则。
|
||||
''' </summary>
|
||||
Public Class FileChecker
|
||||
''' <summary>
|
||||
''' 文件的准确大小。
|
||||
''' 不检查则为 -1。
|
||||
''' </summary>
|
||||
Public ActualSize As Long = -1
|
||||
''' <summary>
|
||||
''' 文件的最小大小。
|
||||
''' 不检查则为 -1。
|
||||
''' </summary>
|
||||
Public MinSize As Long = -1
|
||||
''' <summary>
|
||||
''' 文件的 MD5、SHA1 或 SHA256。会根据输入字符串的长度自动判断种类。
|
||||
''' 不检查则为 Nothing。
|
||||
''' </summary>
|
||||
Public Hash As String = Nothing
|
||||
''' <summary>
|
||||
''' 是否可以使用已经存在的文件。
|
||||
''' </summary>
|
||||
Public CanUseExistsFile As Boolean = True
|
||||
''' <summary>
|
||||
''' 是否要求为 JSON 文件。
|
||||
''' 即，开头结尾必须为 {} 或 []。
|
||||
''' </summary>
|
||||
Public IsJson As Boolean = False
|
||||
Public Sub New(Optional MinSize As Long = -1, Optional ActualSize As Long = -1, Optional Hash As String = Nothing, Optional CanUseExistsFile As Boolean = True, Optional IsJson As Boolean = False)
|
||||
Me.ActualSize = ActualSize
|
||||
Me.MinSize = MinSize
|
||||
Me.Hash = Hash
|
||||
Me.CanUseExistsFile = CanUseExistsFile
|
||||
Me.IsJson = IsJson
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 检查文件。若成功则返回 Nothing，失败则返回错误的描述文本，描述文本不以句号结尾。不会抛出错误。
|
||||
''' </summary>
|
||||
Public Function Check(LocalPath As String) As String
|
||||
Try
|
||||
Dim Info = FileUtils.GetInfo(LocalPath)
|
||||
If Not Info.Exists Then Return "文件不存在：" & LocalPath
|
||||
Dim FileSize As Long = Info.Length
|
||||
If ActualSize >= 0 AndAlso ActualSize <> FileSize Then
|
||||
Return $"文件大小应为 {ActualSize} B，实际为 {FileSize} B" &
|
||||
If(FileSize < 2000, "，内容为：" & FileUtils.ReadAsString(LocalPath), "")
|
||||
End If
|
||||
If MinSize >= 0 AndAlso MinSize > FileSize Then
|
||||
Return $"文件大小应大于 {MinSize} B，实际为 {FileSize} B" &
|
||||
If(FileSize < 2000, "，内容为：" & FileUtils.ReadAsString(LocalPath), "")
|
||||
End If
|
||||
If Not String.IsNullOrEmpty(Hash) Then
|
||||
If Hash.Length < 35 Then 'MD5
|
||||
Dim md5 As String = CryptographyUtils.ComputeFileHash(LocalPath, CryptographyUtils.HashMethod.Md5)
|
||||
If Hash.Lower <> md5 Then Return "文件 MD5 应为 " & Hash & "，实际为 " & md5
|
||||
ElseIf Hash.Length = 64 Then 'SHA256
|
||||
Dim sha256 As String = CryptographyUtils.ComputeFileHash(LocalPath, CryptographyUtils.HashMethod.Sha256)
|
||||
If Hash.Lower <> sha256 Then Return "文件 SHA256 应为 " & Hash & "，实际为 " & sha256
|
||||
Else 'SHA1 (40)
|
||||
Dim sha1 As String = CryptographyUtils.ComputeFileHash(LocalPath, CryptographyUtils.HashMethod.Sha1)
|
||||
If Hash.Lower <> sha1 Then Return "文件 SHA1 应为 " & Hash & "，实际为 " & sha1
|
||||
End If
|
||||
End If
|
||||
If IsJson Then
|
||||
Dim Content As String = FileUtils.ReadAsString(LocalPath)
|
||||
If Content = "" Then Throw New Exception("读取到的文件为空")
|
||||
Try
|
||||
GetJson(Content)
|
||||
Catch ex As Exception
|
||||
Throw New Exception("不是有效的 json 文件", ex)
|
||||
End Try
|
||||
End If
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "检查文件出错")
|
||||
Return ex.GetDisplay(False)
|
||||
End Try
|
||||
End Function
|
||||
End Class
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "文本"
|
||||
Public vbLQ As Char = Convert.ToChar(8220)
|
||||
Public vbRQ As Char = Convert.ToChar(8221)
|
||||
|
||||
''' <summary>
|
||||
''' 将对象转换为枚举类型，支持数字或原文两种格式，若为空字符串或 Nothing 则返回 0。
|
||||
''' 若转换失败会抛出异常。
|
||||
''' </summary>
|
||||
<Extension> Public Function ToEnum(Of T As Structure)(Value As Object) As T
|
||||
If IsNumeric(Value) Then
|
||||
Return CType(CInt(Value), Object)
|
||||
ElseIf String.IsNullOrEmpty(Value?.ToString) Then
|
||||
Return CType(0, Object)
|
||||
Else
|
||||
Return [Enum].Parse(GetType(T), Value.ToString(), True)
|
||||
End If
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 将文件大小转化为适合的文本形式，如“1.28 M”。
|
||||
''' </summary>
|
||||
''' <param name="FileSize">以字节为单位的大小表示。</param>
|
||||
Public Function FormatFileSize(FileSize As Long) As String
|
||||
Dim IsNegative = FileSize < 0
|
||||
If IsNegative Then FileSize *= -1
|
||||
If FileSize < 1000 Then
|
||||
'B 级
|
||||
Return If(IsNegative, "-", "") & FileSize & " B"
|
||||
ElseIf FileSize < 1024 * 1000 Then
|
||||
'K 级
|
||||
Dim RoundResult As String = Math.Round(FileSize / 1024)
|
||||
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " K"
|
||||
ElseIf FileSize < 1024 * 1024 * 1000 Then
|
||||
'M 级
|
||||
Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024)
|
||||
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " M"
|
||||
Else
|
||||
'G 级
|
||||
Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024 / 1024)
|
||||
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " G"
|
||||
End If
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 获取 JSON 对象。
|
||||
''' </summary>
|
||||
Public Function GetJson(Data As String) As JToken
|
||||
Try
|
||||
Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
|
||||
Catch ex As Exception
|
||||
Dim Length As Integer = If(Data, "").Length
|
||||
Throw New Exception("格式化 JSON 失败：" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data), ex)
|
||||
End Try
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 不会报错的 Val。
|
||||
''' 如果输入有误，返回 0。
|
||||
@@ -958,7 +820,7 @@ Public Module ModBase
|
||||
TokenSource.Cancel()
|
||||
Throw New TimeoutException($"任务超时（{TimeoutMs} ms）")
|
||||
End If
|
||||
Return TargetTask.GetAwaiter().GetResult()
|
||||
Return TargetTask.Run()
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 为 Task 设置超时，在超时时抛出 TimeoutException。
|
||||
@@ -969,7 +831,7 @@ Public Module ModBase
|
||||
TokenSource.Cancel()
|
||||
Throw New TimeoutException($"任务超时（{TimeoutMs} ms）")
|
||||
End If
|
||||
TargetTask.GetAwaiter().GetResult()
|
||||
TargetTask.Run()
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
@@ -977,10 +839,10 @@ Public Module ModBase
|
||||
''' </summary>
|
||||
Public PathPure As String = GetPureASCIIDir()
|
||||
Private Function GetPureASCIIDir() As String
|
||||
If (PathExeFolder & "PCL").IsAsciiOnly() Then
|
||||
Return PathExeFolder & "PCL\"
|
||||
ElseIf PathAppdata.IsAsciiOnly() Then
|
||||
Return PathAppdata
|
||||
If Paths.Base.IsAsciiOnly() Then
|
||||
Return Paths.Base & "PCL\"
|
||||
ElseIf Paths.AppDataThenName.IsAsciiOnly() Then
|
||||
Return Paths.AppDataThenName
|
||||
ElseIf PathTemp.IsAsciiOnly() Then
|
||||
Return PathTemp
|
||||
Else
|
||||
@@ -994,12 +856,6 @@ Public Module ModBase
|
||||
Public Class RestartException
|
||||
Inherits Exception
|
||||
End Class
|
||||
''' <summary>
|
||||
''' 指示用户手动取消了操作，或用户已知晓操作被取消的原因。
|
||||
''' </summary>
|
||||
Public Class CancelledException
|
||||
Inherits Exception
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 以管理员权限运行当前程序，并等待程序运行结束。
|
||||
@@ -1011,19 +867,6 @@ Public Module ModBase
|
||||
Return NewProcess.ExitCode
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 判断对象是否为某个泛型类型的实例。
|
||||
''' </summary>
|
||||
<Extension> Public Function IsInstanceOfGenericType(genericType As Type, obj As Object) As Boolean
|
||||
If obj Is Nothing Then Return False
|
||||
Dim t = obj.GetType()
|
||||
While t IsNot Nothing
|
||||
If t.IsGenericType AndAlso t.GetGenericTypeDefinition() Is genericType Then Return True
|
||||
t = t.BaseType
|
||||
End While
|
||||
Return False
|
||||
End Function
|
||||
|
||||
Private Uuid As Integer = 1
|
||||
Private UuidLock As Object
|
||||
''' <summary>
|
||||
@@ -1045,79 +888,6 @@ Public Module ModBase
|
||||
Return Stopwatch.GetTimestamp() \ (Stopwatch.Frequency \ 1000L)
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 将时间间隔转换为类似“5 分 10 秒前”的易于阅读的形式。
|
||||
''' </summary>
|
||||
Public Function GetTimeSpanString(Span As TimeSpan, IsShortForm As Boolean) As String
|
||||
Dim EndFix = If(Span.TotalMilliseconds > 0, "后", "前")
|
||||
If Span.TotalMilliseconds < 0 Then Span = -Span
|
||||
Dim TotalMonthes = Math.Floor(Span.Days / 30)
|
||||
Dim Result As String
|
||||
If IsShortForm Then
|
||||
If TotalMonthes >= 12 Then
|
||||
'1+ 年，“3 年”
|
||||
Result = Math.Floor(TotalMonthes / 12) & " 年"
|
||||
ElseIf TotalMonthes >= 2 Then
|
||||
'2~11 月，“5 个月”
|
||||
Result = TotalMonthes & " 个月"
|
||||
ElseIf Span.TotalDays >= 2 Then
|
||||
'2 天 ~ 2 月，“23 天”
|
||||
Result = Span.Days & " 天"
|
||||
ElseIf Span.TotalHours >= 1 Then
|
||||
'1 小时 ~ 2 天，“15 小时”
|
||||
Result = Span.Hours & " 小时"
|
||||
ElseIf Span.TotalMinutes >= 1 Then
|
||||
'1 分钟 ~ 1 小时，“49 分钟”
|
||||
Result = Span.Minutes & " 分钟"
|
||||
ElseIf Span.TotalSeconds >= 1 Then
|
||||
'1 秒 ~ 1 分钟，“23 秒”
|
||||
Result = Span.Seconds & " 秒"
|
||||
Else
|
||||
'不到 1 秒
|
||||
Result = "1 秒"
|
||||
End If
|
||||
Else
|
||||
If TotalMonthes >= 61 Then
|
||||
'5+ 年，“5 年”
|
||||
Result = Math.Floor(TotalMonthes / 12) & " 年"
|
||||
ElseIf TotalMonthes >= 12 Then
|
||||
'12~60 月，“1 年 2 个月”
|
||||
Result = Math.Floor(TotalMonthes / 12) & " 年" & If((TotalMonthes Mod 12) > 0, " " & (TotalMonthes Mod 12) & " 个月", "")
|
||||
ElseIf TotalMonthes >= 4 Then
|
||||
'4~11 月，“5 个月”
|
||||
Result = TotalMonthes & " 个月"
|
||||
ElseIf TotalMonthes >= 1 Then
|
||||
'1~4 月，“2 个月 13 天”
|
||||
Result = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
|
||||
ElseIf Span.TotalDays >= 4 Then
|
||||
'4~30 天，“23 天”
|
||||
Result = Span.Days & " 天"
|
||||
ElseIf Span.TotalDays >= 1 Then
|
||||
'1~3 天，“2 天 20 小时”
|
||||
Result = Span.Days & " 天" & If(Span.Hours > 0, " " & Span.Hours & " 小时", "")
|
||||
ElseIf Span.TotalHours >= 10 Then
|
||||
'10 小时 ~ 1 天，“15 小时”
|
||||
Result = Span.Hours & " 小时"
|
||||
ElseIf Span.TotalHours >= 1 Then
|
||||
'1~10 小时，“1 小时 20 分钟”
|
||||
Result = Span.Hours & " 小时" & If(Span.Minutes > 0, " " & Span.Minutes & " 分钟", "")
|
||||
ElseIf Span.TotalMinutes >= 10 Then
|
||||
'10 分钟 ~ 1 小时，“49 分钟”
|
||||
Result = Span.Minutes & " 分钟"
|
||||
ElseIf Span.TotalMinutes >= 1 Then
|
||||
'1~10 分钟，“9 分 23 秒”
|
||||
Result = Span.Minutes & " 分" & If(Span.Seconds > 0, " " & Span.Seconds & " 秒", "")
|
||||
ElseIf Span.TotalSeconds >= 1 Then
|
||||
'1 秒 ~ 1 分钟，“23 秒”
|
||||
Result = Span.Seconds & " 秒"
|
||||
Else
|
||||
'不到 1 秒
|
||||
Result = "1 秒"
|
||||
End If
|
||||
End If
|
||||
Result += EndFix
|
||||
Return Result
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 获取十进制 Unix 时间戳。
|
||||
''' </summary>
|
||||
Public Function GetUnixTimestampUtc() As Long
|
||||
@@ -1165,41 +935,6 @@ Public Module ModBase
|
||||
Logger.Info($"启动进程：{StartInfo.FileName} {StartInfo.Arguments}")
|
||||
Return Process.Start(StartInfo)
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 静默运行文件并返回输出流字符串。执行失败会抛出异常。
|
||||
''' </summary>
|
||||
''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
|
||||
''' <param name="Arguments">运行参数。</param>
|
||||
''' <param name="Timeout">等待该程序结束的最长时间（毫秒）。超时会抛出错误。</param>
|
||||
Public Function StartProcessAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000,
|
||||
Optional WorkingDirectory As String = Nothing, Optional Encoding As Encoding = Nothing, Optional PrintLog As Boolean = True) As String
|
||||
Dim Info = New ProcessStartInfo With {
|
||||
.Arguments = Arguments,
|
||||
.FileName = PathUtils.ToShortPath(FileName),
|
||||
.UseShellExecute = False,
|
||||
.CreateNoWindow = True,
|
||||
.RedirectStandardError = True,
|
||||
.RedirectStandardOutput = True,
|
||||
.WorkingDirectory = PathUtils.ToShortPath(If(WorkingDirectory, PathExeFolder.TrimEnd("\"c))),
|
||||
.StandardErrorEncoding = Encoding,
|
||||
.StandardOutputEncoding = Encoding
|
||||
}
|
||||
If WorkingDirectory IsNot Nothing Then
|
||||
If Info.EnvironmentVariables.ContainsKey("appdata") Then
|
||||
Info.EnvironmentVariables("appdata") = WorkingDirectory
|
||||
Else
|
||||
Info.EnvironmentVariables.Add("appdata", WorkingDirectory)
|
||||
End If
|
||||
End If
|
||||
If PrintLog Then Logger.Info($"执行命令并等待返回结果：{FileName} {Arguments}")
|
||||
Using Program As New Process With {.StartInfo = Info}
|
||||
Program.Start()
|
||||
Dim Result As String = Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd
|
||||
Program.WaitForExit(Timeout)
|
||||
If Not Program.HasExited Then Program.Kill()
|
||||
Return Result
|
||||
End Using
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 在新的工作线程中执行代码。
|
||||
@@ -1209,8 +944,6 @@ Public Module ModBase
|
||||
Sub()
|
||||
Try
|
||||
Action()
|
||||
Catch ex As ThreadInterruptedException
|
||||
Logger.Info($"{Name}：线程已中止")
|
||||
Catch ex As Exception
|
||||
Logger.Error(ex, $"{Name}：线程执行失败")
|
||||
End Try
|
||||
@@ -1341,7 +1074,7 @@ Public Module ModBase
|
||||
RunInThread(
|
||||
Sub()
|
||||
Try
|
||||
ResilientUtils.Retry(
|
||||
Retrier.Attempt(delay:=Function(Attempt) TimeSpan.FromMilliseconds(200), maxAttempts:=4, isRetryAllowed:=Function(ex) True, action:=
|
||||
Sub()
|
||||
RunInUi(
|
||||
Sub()
|
||||
@@ -1476,20 +1209,10 @@ Public Module ModBase
|
||||
''' <summary>
|
||||
''' 控件是否受到 TextTrimming 属性影响，导致内容被截取。
|
||||
''' </summary>
|
||||
<Extension> Public Function IsTextTrimmed(Control As TextBlock) As Boolean
|
||||
Control.Measure(New Size(Double.MaxValue, Double.MaxValue))
|
||||
Return Control.DesiredSize.Width > Control.ActualWidth
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 获取文本在被渲染后的宽度。
|
||||
''' </summary>
|
||||
Public Function MeasureStringWidth(text As String, Optional fontSize As Double = 14, Optional fontFamily As FontFamily = Nothing) As Double
|
||||
If fontFamily Is Nothing Then fontFamily = New FontFamily("微软雅黑")
|
||||
Dim formattedText = New FormattedText(
|
||||
text, CultureInfo.CurrentCulture, FlowDirection.LeftToRight, New Typeface(fontFamily, FontStyles.Normal, FontWeights.Normal, FontStretches.Normal),
|
||||
fontSize, Brushes.Black, New NumberSubstitution(), TextFormattingMode.Display, New DpiScale(1, 1).PixelsPerDip)
|
||||
Return formattedText.Width
|
||||
<Extension> Public Function IsTextTrimmed(TextBlock As TextBlock) As Boolean
|
||||
Dim typeface As New Typeface(TextBlock.FontFamily, TextBlock.FontStyle, TextBlock.FontWeight, TextBlock.FontStretch)
|
||||
Dim formattedText As New FormattedText(TextBlock.Text, Thread.CurrentThread.CurrentCulture, TextBlock.FlowDirection, typeface, TextBlock.FontSize, TextBlock.Foreground, DPI)
|
||||
Return formattedText.Width > TextBlock.ActualWidth
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Module ModLoader
|
||||
Public Module ModLoader
|
||||
|
||||
'各类加载器
|
||||
''' <summary>
|
||||
@@ -89,7 +89,8 @@
|
||||
Dim OldState = _State
|
||||
If value = LoadState.Finished AndAlso Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
|
||||
_State = value
|
||||
Logger.Log($"加载器 {Name} 状态改变：{value}", If(value = LoadState.Failed, LogLevel.Error, LogLevel.Info))
|
||||
If value = LoadState.Canceled Then CancellationTokenSource?.Cancel()
|
||||
Logger.Log($"加载器 {[GetType].Name} {Name} 状态改变：{value}", If(value = LoadState.Failed, LogLevel.Error, LogLevel.Info))
|
||||
'实现 ILoadingTrigger 接口与 OnStateChanged 回调
|
||||
RunInUi(
|
||||
Sub()
|
||||
@@ -163,14 +164,42 @@
|
||||
Private _Progress As Double = -1
|
||||
Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged
|
||||
''' <summary>
|
||||
''' 创建一个 ProgressProvider，在其进度改变时，并将其进度单向映射到此加载器上。
|
||||
''' 这是 Loader 对新框架的兼容层。
|
||||
''' </summary>
|
||||
Public Function CreateSyncProgressProvider(Optional FromPercentage As Double = 0, Optional ToPercentage As Double = 1) As ProgressProvider
|
||||
Dim Provider As New ProgressProvider
|
||||
AddHandler Provider.ProgressChanged,
|
||||
Sub(ChangedProgress)
|
||||
Dim RawProgress = Provider.GetRaw()
|
||||
Progress = FromPercentage + (RawProgress.actual + RawProgress.skiped) * (ToPercentage - FromPercentage)
|
||||
End Sub
|
||||
Return Provider
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 计算总进度时的权重。它应该为预计时间（秒）。
|
||||
''' </summary>
|
||||
Public Property ProgressWeight As Double = 1
|
||||
|
||||
'状态变化
|
||||
Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
|
||||
Public MustOverride Sub Interrupt()
|
||||
Public MustOverride Sub Cancel()
|
||||
Public MustOverride Sub Failed(Ex As Exception)
|
||||
Private CancellationTokenSource As CancellationTokenSource
|
||||
''' <summary>
|
||||
''' 创建一个随此加载器取消的取消令牌；令牌取消时也会调用此加载器的 Cancel。
|
||||
''' 这是 Loader 对新框架的兼容层。
|
||||
''' </summary>
|
||||
Public Function CreateCancellationToken() As CancellationToken
|
||||
SyncLock LockState
|
||||
If CancellationTokenSource Is Nothing OrElse CancellationTokenSource.IsCancellationRequested Then
|
||||
CancellationTokenSource = New CancellationTokenSource
|
||||
CancellationTokenSource.Token.Register(AddressOf Cancel)
|
||||
End If
|
||||
If State = LoadState.Canceled Then CancellationTokenSource.Cancel()
|
||||
Return CancellationTokenSource.Token
|
||||
End SyncLock
|
||||
End Function
|
||||
|
||||
'等待结束
|
||||
Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。"
|
||||
@@ -178,16 +207,19 @@
|
||||
''' <summary>
|
||||
''' 无限期地等待加载器完成，直到结束或抛出异常。若加载器尚未开始，则会开始执行。
|
||||
''' </summary>
|
||||
Public Sub WaitForExit(Optional Input As Object = Nothing, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional IsForceRestart As Boolean = False)
|
||||
Public Sub WaitForExit(Optional Input As Object = Nothing, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional IsForceRestart As Boolean = False,
|
||||
Optional c As CancellationToken = Nothing, Optional p As ProgressProvider = Nothing)
|
||||
Start(Input, IsForceRestart)
|
||||
Do While State = LoadState.Loading
|
||||
If LoaderToSyncProgress IsNot Nothing Then LoaderToSyncProgress.Progress = Progress
|
||||
p?.Set(Progress)
|
||||
c.ThrowIfCancellationRequested()
|
||||
Thread.Sleep(10)
|
||||
Loop
|
||||
If State = LoadState.Finished Then
|
||||
Return
|
||||
ElseIf State = LoadState.Interrupted Then
|
||||
Throw New ThreadInterruptedException("加载器执行已中断。")
|
||||
ElseIf State = LoadState.Canceled Then
|
||||
Throw New OperationCanceledException("加载器执行已中断")
|
||||
ElseIf IsNothing([Error]) Then
|
||||
Throw New Exception("未知错误！")
|
||||
Else
|
||||
@@ -209,8 +241,8 @@
|
||||
Loop
|
||||
If State = LoadState.Finished Then
|
||||
Return
|
||||
ElseIf State = LoadState.Interrupted Then
|
||||
Throw New ThreadInterruptedException("加载器执行已中断。")
|
||||
ElseIf State = LoadState.Canceled Then
|
||||
Throw New OperationCanceledException("加载器执行已中断")
|
||||
ElseIf IsNothing([Error]) Then
|
||||
Throw New Exception("未知错误！")
|
||||
Else
|
||||
@@ -240,16 +272,16 @@
|
||||
''' <summary>
|
||||
''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断，不可跨线程调用。
|
||||
''' </summary>
|
||||
Public ReadOnly Property IsInterrupted As Boolean
|
||||
Public ReadOnly Property IsCanceled As Boolean
|
||||
Get
|
||||
Return IsInterruptedWithThread(Thread.CurrentThread)
|
||||
Return IsCanceledWithThread(Thread.CurrentThread)
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 当前执行线程是否应当中断。需要手动提供加载器线程，用于需要跨线程检查的情况。
|
||||
''' </summary>
|
||||
Public Function IsInterruptedWithThread(Thread As Thread) As Boolean
|
||||
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Interrupted
|
||||
Public Function IsCanceledWithThread(Thread As Thread) As Boolean
|
||||
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Canceled
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 在输入相同时使用原有结果的超时，单位为毫秒。
|
||||
@@ -318,30 +350,29 @@
|
||||
Sub()
|
||||
Try
|
||||
IsForceRestarting = IsForceRestart
|
||||
Logger.Trace(Function() $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
|
||||
Logger.Trace(Function() $"加载线程 {Name} 已{If(IsForceRestarting, "强制", "")}启动")
|
||||
LoadDelegate(Me)
|
||||
If IsInterrupted Then
|
||||
Logger.Warn($"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束，输出被弃用（最新线程：{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)}）")
|
||||
If IsCanceled Then
|
||||
Logger.Warn($"加载线程 {Name} 已中断但线程正常运行至结束，输出被弃用（最新线程：{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)}）")
|
||||
Return
|
||||
End If
|
||||
Logger.Trace(Function() $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
|
||||
Logger.Trace(Function() $"加载线程 {Name} 已完成")
|
||||
RaisePreviewFinish()
|
||||
State = LoadState.Finished
|
||||
LastFinishedTime = GetTimeMs() '未中断，本次输出有效
|
||||
Catch ex As CancelledException
|
||||
Logger.Trace(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断，已完成 {Math.Round(Progress * 100)}%")
|
||||
If Not IsInterrupted Then State = LoadState.Interrupted
|
||||
Catch ex As ThreadInterruptedException
|
||||
Logger.Trace(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断，已完成 {Math.Round(Progress * 100)}%")
|
||||
'如果线程是因为判断到 IsInterrupted 而提前中止，则代表已有新线程被重启，此时不应当改为 Interrupted
|
||||
'如果线程是在没有 IsInterrupted 时手动引发了 ThreadInterruptedException，则代表没有重启线程，这通常代表用户手动取消，应当改为 Interrupted
|
||||
If Not IsInterrupted Then State = LoadState.Interrupted
|
||||
Catch ex As Exception
|
||||
Failed(ex)
|
||||
If ex.IsCanceled Then
|
||||
'如果线程是因为判断到 IsCanceled 而提前中止，则代表已有新线程被重启，此时不应当改为 Canceled
|
||||
'如果线程是在没有 IsCanceled 时手动引发了取消异常，则代表没有重启线程，这通常代表用户手动取消，应当改为 Canceled
|
||||
Logger.Trace(ex, $"加载线程 {Name} 已取消，当前已完成 {Math.Round(Progress * 100)}%")
|
||||
If Not IsCanceled Then State = LoadState.Canceled
|
||||
Else
|
||||
Failed(ex)
|
||||
End If
|
||||
End Try
|
||||
End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
|
||||
Try
|
||||
LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsInterrupted
|
||||
LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsCanceled
|
||||
Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”，则等待后重试
|
||||
Thread.Sleep(500)
|
||||
LastRunningThread.Start()
|
||||
@@ -350,16 +381,16 @@
|
||||
Public Overrides Sub Failed(ex As Exception)
|
||||
[Error] = ex
|
||||
SyncLock LockState
|
||||
If IsInterrupted OrElse State >= LoadState.Finished Then Return
|
||||
If IsCanceled OrElse State >= LoadState.Finished Then Return
|
||||
State = LoadState.Failed
|
||||
End SyncLock
|
||||
Logger.Warn(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错，已完成 {Math.Round(Progress * 100)}%")
|
||||
Logger.Warn(ex, $"加载线程 {Name} 出错，已完成 {Math.Round(Progress * 100)}%")
|
||||
TriggerThreadInterrupt()
|
||||
End Sub
|
||||
Public Overrides Sub Interrupt()
|
||||
Public Overrides Sub Cancel()
|
||||
SyncLock LockState
|
||||
If State <> LoadState.Loading Then Return
|
||||
State = LoadState.Interrupted
|
||||
State = LoadState.Canceled
|
||||
End SyncLock
|
||||
TriggerThreadInterrupt()
|
||||
End Sub
|
||||
@@ -367,7 +398,7 @@
|
||||
If LastRunningThread Is Nothing Then Return
|
||||
If LastRunningThread.IsAlive Then
|
||||
LastRunningThread.Interrupt()
|
||||
Logger.Trace(Function() $"加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
|
||||
Logger.Trace(Function() $"加载线程 {Name} 已中断")
|
||||
End If
|
||||
LastRunningThread = Nothing
|
||||
End Sub
|
||||
@@ -383,6 +414,53 @@
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 新 Worker 对老 Loader 的兼容包装类。
|
||||
''' </summary>
|
||||
Public Class LoaderWorker
|
||||
Inherits LoaderBase
|
||||
Public WithEvents Worker As IWorker
|
||||
Public Sub New(Name As String, Worker As IWorker)
|
||||
Me.Name = Name
|
||||
Me.Worker = Worker
|
||||
AddHandler Worker.Progress.ProgressChanged, Sub(Raw) Progress = Raw.actual + Raw.skiped
|
||||
End Sub
|
||||
|
||||
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
|
||||
SyncLock LockState
|
||||
State = LoadState.Loading
|
||||
End SyncLock
|
||||
Logger.Trace(Function() $"Worker {Name} 已启动")
|
||||
IsForceRestarting = IsForceRestart
|
||||
Worker.Start()
|
||||
End Sub
|
||||
Private Sub Worker_Succeeded() Handles Worker.Succeeded
|
||||
Logger.Trace(Function() $"Worker {Name} 已完成")
|
||||
RaisePreviewFinish()
|
||||
SyncLock LockState
|
||||
State = LoadState.Finished
|
||||
End SyncLock
|
||||
End Sub
|
||||
Public Overrides Sub Cancel() Handles Worker.Canceled
|
||||
SyncLock LockState
|
||||
If State <> LoadState.Loading Then Return
|
||||
State = LoadState.Canceled
|
||||
End SyncLock
|
||||
Logger.Trace(Function() $"Worker {Name} 已取消，当前已完成 {Math.Round(Progress * 100)}%")
|
||||
Worker.Cancel()
|
||||
End Sub
|
||||
Public Overrides Sub Failed(Ex As Exception) Handles Worker.Failed
|
||||
SyncLock LockState
|
||||
If State >= LoadState.Finished Then Return
|
||||
State = LoadState.Failed
|
||||
End SyncLock
|
||||
Logger.Warn(Ex, $"Worker {Name} 出错，已完成 {Math.Round(Progress * 100)}%")
|
||||
[Error] = Ex
|
||||
Worker.Cancel()
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 支持多个加载器连续运作的复合加载器。
|
||||
''' </summary>
|
||||
@@ -450,11 +528,11 @@
|
||||
End If
|
||||
RunInThread(AddressOf Update)
|
||||
End Sub
|
||||
Public Overrides Sub Interrupt()
|
||||
Public Overrides Sub Cancel()
|
||||
'改变状态
|
||||
SyncLock LockState
|
||||
If State = LoadState.Loading OrElse State = LoadState.Waiting Then
|
||||
State = LoadState.Interrupted
|
||||
State = LoadState.Canceled
|
||||
Else
|
||||
Return
|
||||
End If
|
||||
@@ -463,7 +541,7 @@
|
||||
Sub()
|
||||
'中断加载器
|
||||
For Each Loader In Loaders
|
||||
Loader.Interrupt()
|
||||
Loader.Cancel()
|
||||
Next
|
||||
End Sub)
|
||||
End Sub
|
||||
@@ -474,7 +552,7 @@
|
||||
State = LoadState.Failed
|
||||
End SyncLock
|
||||
For Each Loader In Loaders
|
||||
Loader.Interrupt()
|
||||
Loader.Cancel()
|
||||
Next
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
End Sub
|
||||
@@ -492,9 +570,9 @@
|
||||
Case LoadState.Finished
|
||||
'正常结束，触发刷新
|
||||
Update()
|
||||
Case LoadState.Interrupted
|
||||
Case LoadState.Canceled
|
||||
'被中断，这个任务也中断
|
||||
Interrupt()
|
||||
Cancel()
|
||||
Case LoadState.Failed
|
||||
'完蛋，出错了
|
||||
Failed(New Exception(Loader.Name & "失败", Loader.Error))
|
||||
@@ -504,15 +582,15 @@
|
||||
''' 触发一次更新，以启动新加载器或完成。
|
||||
''' </summary>
|
||||
Private Sub Update()
|
||||
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Interrupted Then Return
|
||||
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Canceled Then Return
|
||||
Dim IsFinished As Boolean = True
|
||||
Dim Blocked As Boolean = False
|
||||
Dim Input As Object = Me.Input
|
||||
For Each Loader In Loaders
|
||||
Select Case Loader.State
|
||||
Case LoadState.Finished
|
||||
'检查是否需要重启
|
||||
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型，必须用 StartsWith
|
||||
'检查 LoaderTask 是否需要重启
|
||||
If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) Then
|
||||
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
|
||||
Logger.Info($"由于输入条件变更，重启已完成的加载器 {Loader.Name}")
|
||||
GoTo Restart
|
||||
@@ -523,8 +601,8 @@
|
||||
'如果不让继续启动，且已有加载器正在加载中，就不继续启动
|
||||
If Loader.Block AndAlso Not IsFinished Then Blocked = True
|
||||
Case LoadState.Loading
|
||||
'检查是否需要重启
|
||||
If Loader.GetType.Name.StartsWithF("LoaderTask") Then
|
||||
'检查 LoaderTask 是否需要重启
|
||||
If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) Then
|
||||
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
|
||||
Logger.Warn($"由于输入条件变更，重启进行中的加载器 {Loader.Name}")
|
||||
GoTo Restart
|
||||
@@ -540,13 +618,14 @@ Restart:
|
||||
If Blocked Then Continue For
|
||||
If Input IsNot Nothing Then
|
||||
'若输入类型与下一个加载器相同才继续
|
||||
Dim LoaderType As String = Loader.GetType.Name
|
||||
If LoaderType.StartsWithF("LoaderTask") OrElse LoaderType.StartsWithF("LoaderCombo") Then
|
||||
If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) OrElse GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderCombo(Of ))) Then
|
||||
Loader.Start(If(Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IsForceRestarting)
|
||||
ElseIf LoaderType.StartsWithF("LoaderDownload") Then
|
||||
ElseIf TypeOf Loader Is LoaderWorker Then
|
||||
Loader.Start(IsForceRestart:=IsForceRestarting)
|
||||
ElseIf TypeOf Loader Is LoaderDownload Then
|
||||
Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting)
|
||||
Else
|
||||
Throw New Exception("未知的加载器类型（" & LoaderType & "）")
|
||||
Throw New Exception("未知的加载器类型（" & Loader.GetType.Name & "）")
|
||||
End If
|
||||
Else
|
||||
Loader.Start(IsForceRestart:=IsForceRestarting)
|
||||
@@ -569,7 +648,7 @@ Restart:
|
||||
Public Shared Sub GetLoaderList(Loader As Object, ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True)
|
||||
For Each SubLoader In Loader.Loaders
|
||||
If SubLoader.Show OrElse Not RequireShow Then List.Add(SubLoader)
|
||||
If SubLoader.GetType.Name.StartsWithF("LoaderCombo") Then GetLoaderList(SubLoader, List)
|
||||
If GeneralUtils.IsGenericInstanceOf(SubLoader, GetType(LoaderCombo(Of ))) Then GetLoaderList(SubLoader, List)
|
||||
Next
|
||||
End Sub
|
||||
''' <summary>
|
||||
@@ -606,7 +685,7 @@ Restart:
|
||||
'若单个任务已中止，或全部任务已完成，则刷新并移除
|
||||
For Each Task In LoaderTaskbar
|
||||
If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse
|
||||
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Interrupted) Then
|
||||
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Canceled) Then
|
||||
FrmSpeedLeft?.TaskRefresh(Task)
|
||||
LoaderTaskbar.Remove(Task)
|
||||
Logger.Info($"{Task.Name} 已移出任务列表")
|
||||
|
||||
@@ -1,5 +1,4 @@
|
||||
Imports System.Net.Sockets
|
||||
Imports System.Threading.Tasks
|
||||
Imports System.Net.Sockets
|
||||
|
||||
Public Module ModNet
|
||||
|
||||
@@ -32,10 +31,8 @@ Public Module ModNet
|
||||
Return Result
|
||||
Catch ex As FormatException
|
||||
Throw
|
||||
Catch ex As ThreadInterruptedException
|
||||
Throw
|
||||
Catch ex As Exception
|
||||
If MakeLog Then Logger.Warn(ex, "网络请求失败")
|
||||
If MakeLog Then Logger.Warn(ex, $"网络请求失败（{Method.Method}，{Url}）")
|
||||
Throw
|
||||
End Try
|
||||
End Function
|
||||
@@ -68,9 +65,8 @@ Retry:
|
||||
Throw RetryException
|
||||
End If
|
||||
End Select
|
||||
Catch ex As ThreadInterruptedException
|
||||
Throw
|
||||
Catch ex As Exception
|
||||
ex.ThrowIfCanceled()
|
||||
If TypeOf ex Is HttpRequestCodeException Then
|
||||
If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.Forbidden Then Throw
|
||||
If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.NotFound Then Throw
|
||||
@@ -161,7 +157,7 @@ RequestFinished:
|
||||
FileUtils.Delete(Temp)
|
||||
Return Result
|
||||
Finally
|
||||
NewTask.Interrupt()
|
||||
NewTask.Cancel()
|
||||
End Try
|
||||
End Function
|
||||
|
||||
@@ -179,11 +175,9 @@ RequestFinished:
|
||||
Retry:
|
||||
Try
|
||||
FileUtils.Write(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders))
|
||||
Catch ex As ThreadInterruptedException
|
||||
FileUtils.Delete(LocalPath)
|
||||
Throw
|
||||
Catch ex As Exception
|
||||
FileUtils.Delete(LocalPath)
|
||||
ex.ThrowIfCanceled()
|
||||
If RetryCount < 2 Then
|
||||
RetryCount += 1
|
||||
GoTo Retry
|
||||
@@ -210,7 +204,7 @@ Retry:
|
||||
Catch ex As Exception
|
||||
Throw New WebException($"多线程直接下载文件失败（第一下载源：" & Urls.First() & "）", ex)
|
||||
Finally
|
||||
NewTask.Interrupt()
|
||||
NewTask.Cancel()
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
@@ -226,32 +220,7 @@ Retry:
|
||||
Dim Request As HttpRequestMessage = Nothing, CancelToken As CancellationTokenSource = Nothing,
|
||||
Response As HttpResponseMessage = Nothing, HostIp As String = Nothing
|
||||
Try
|
||||
Url = SecretCdnSign(Url)
|
||||
Request = New HttpRequestMessage(Method, Url)
|
||||
'写入 Content
|
||||
If Content IsNot Nothing AndAlso Request.Method <> HttpMethod.Get AndAlso Request.Method <> HttpMethod.Head Then
|
||||
If TypeOf Content Is HttpContent Then
|
||||
Request.Content = DirectCast(Content, HttpContent)
|
||||
ElseIf TypeOf Content Is Byte() Then
|
||||
Request.Content = New ByteArrayContent(DirectCast(Content, Byte()))
|
||||
ElseIf Content IsNot Nothing Then
|
||||
Request.Content = New ByteArrayContent(If(Encoding, Encoding.UTF8).GetBytes(Content.ToString()))
|
||||
End If
|
||||
End If
|
||||
'写入 Headers
|
||||
For Each Header In If(Headers, New Dictionary(Of String, String))
|
||||
If Header.Key.Lower = "content-type" Then
|
||||
Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
|
||||
Else
|
||||
Request.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
|
||||
End If
|
||||
Next
|
||||
SecretHeadersSign(Url, Request, SimulateBrowserHeaders)
|
||||
'DNS 解析
|
||||
CancelToken = New CancellationTokenSource(Timeout)
|
||||
HostIp = DNSLookup(Request, CancelToken.Token)
|
||||
If HostIp IsNot Nothing Then IPReliability.GetOrAdd(HostIp, -0.01) '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率
|
||||
'发送请求
|
||||
'构建 RequestClient
|
||||
Directory.CreateDirectory(PathTemp & "Cache\Http\")
|
||||
SyncLock RequestClientLock
|
||||
If RequestClient Is Nothing Then '延迟初始化，以避免在程序启动前加载 CacheCow 导致 DLL 加载失败
|
||||
@@ -261,11 +230,41 @@ Retry:
|
||||
})
|
||||
End If
|
||||
End SyncLock
|
||||
ResilientUtils.RetryOn(Of FileNotFoundException, IOException)( 'CacheCow 读取缓存时若文件被占用，会调用不存在的 System.Net.Http.Formatting.resources，抛出此异常（#8150）
|
||||
Sub()
|
||||
CancelToken.Dispose() : CancelToken = New CancellationTokenSource(Timeout)
|
||||
Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
|
||||
'构建请求
|
||||
Url = SecretCdnSign(Url)
|
||||
Request = New HttpRequestMessage(Method, Url)
|
||||
If Content IsNot Nothing AndAlso Request.Method <> HttpMethod.Get AndAlso Request.Method <> HttpMethod.Head Then '写入 Content
|
||||
If TypeOf Content Is HttpContent Then
|
||||
Request.Content = DirectCast(Content, HttpContent).Clone()
|
||||
ElseIf TypeOf Content Is Byte() Then
|
||||
Request.Content = New ByteArrayContent(DirectCast(Content, Byte()))
|
||||
ElseIf Content IsNot Nothing Then
|
||||
Request.Content = New ByteArrayContent(If(Encoding, Encoding.UTF8).GetBytes(Content.ToString()))
|
||||
End If
|
||||
End If
|
||||
For Each Header In If(Headers, New Dictionary(Of String, String)) '写入 Headers
|
||||
If Header.Key.Lower = "content-type" Then
|
||||
Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
|
||||
Else
|
||||
Request.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
|
||||
End If
|
||||
Next
|
||||
SecretHeadersSign(Url, Request, SimulateBrowserHeaders)
|
||||
'发送请求
|
||||
'CacheCow 读取缓存时若文件被占用，会调用不存在的 System.Net.Http.Formatting.resources，抛出异常（#8150）
|
||||
Retrier.Attempt(delay:=Function() TimeSpan.FromMilliseconds(200), isRetryAllowed:=Function(ex) TypeOf ex Is FileNotFoundException OrElse TypeOf ex Is IOException, action:=
|
||||
Sub(Attempt)
|
||||
CancelToken?.Dispose() : CancelToken = New CancellationTokenSource(Timeout)
|
||||
HostIp = DNSLookup(Request, CancelToken.Token)
|
||||
If HostIp IsNot Nothing Then IPReliability.GetOrAdd(HostIp, -0.01) '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率
|
||||
Dim ClonedRequest As HttpRequestMessage = Request.Clone() 'HttpRequestMessage 只能发送一次，重试时需要克隆一个新的
|
||||
Try
|
||||
Response = RequestClient.SendAsync(ClonedRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
|
||||
Finally
|
||||
ClonedRequest.Dispose()
|
||||
End Try
|
||||
End Sub)
|
||||
'读取响应
|
||||
Dim ResponseBytes As Byte()
|
||||
CancelToken.Dispose() : CancelToken = New CancellationTokenSource(Timeout)
|
||||
Using ResponseStream = Response.Content.ReadAsStreamAsync().GetResultWithTimeout(CancelToken, Timeout)
|
||||
@@ -274,26 +273,24 @@ Retry:
|
||||
ResponseBytes = Stream.ToArray()
|
||||
End Using
|
||||
End Using
|
||||
'输出
|
||||
If Response.IsSuccessStatusCode Then
|
||||
RecordIPReliability(HostIp, 0.5)
|
||||
Return ResponseBytes
|
||||
Else
|
||||
If Not Response.IsSuccessStatusCode Then
|
||||
RecordIPReliability(HostIp, -0.7)
|
||||
Dim ResponseMessage = ResponseBytes.GetString(Encoding)
|
||||
Throw New HttpRequestCodeException(
|
||||
$"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Method}，{Url}，{HostIp}" &
|
||||
If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), Response.StatusCode, ResponseMessage)
|
||||
End If
|
||||
Catch ex As ThreadInterruptedException
|
||||
Throw
|
||||
'输出
|
||||
RecordIPReliability(HostIp, 0.5)
|
||||
Return ResponseBytes
|
||||
Catch ex As HttpRequestException
|
||||
Throw
|
||||
Catch ex As TimeoutException
|
||||
Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
|
||||
Catch ex As Exception
|
||||
ex.ThrowIfCanceled()
|
||||
RecordIPReliability(HostIp, -1)
|
||||
If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then 'CancellationToken 超时
|
||||
Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
|
||||
ElseIf ex.IsBadNetwork Then
|
||||
If ex.IsBadNetwork Then
|
||||
Throw New WebException($"网络请求失败，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
|
||||
Else
|
||||
Throw New Exception($"网络请求出现意外异常（{Method}, {Url}，{HostIp}）", ex)
|
||||
@@ -478,7 +475,7 @@ Retry:
|
||||
''' <summary>
|
||||
''' 已失败或中断。
|
||||
''' </summary>
|
||||
Interrupted = 6
|
||||
Canceled = 6
|
||||
End Enum
|
||||
''' <summary>
|
||||
''' 预下载检查行为。
|
||||
@@ -626,7 +623,7 @@ Retry:
|
||||
''' </summary>
|
||||
Public ReadOnly Property IsEnded As Boolean
|
||||
Get
|
||||
Return State = NetState.Finished OrElse State = NetState.Interrupted
|
||||
Return State = NetState.Finished OrElse State = NetState.Canceled
|
||||
End Get
|
||||
End Property
|
||||
|
||||
@@ -663,7 +660,7 @@ Retry:
|
||||
''' <summary>
|
||||
''' 所有下载源。
|
||||
''' </summary>
|
||||
Public Sources As ConcurrentList(Of NetSource)
|
||||
Public Sources As List(Of NetSource)
|
||||
''' <summary>
|
||||
''' 用于在第一个线程出错时切换下载源。
|
||||
''' </summary>
|
||||
@@ -819,7 +816,7 @@ Retry:
|
||||
Return OriginalProgress * 0.93 + 0.05
|
||||
Case NetState.Merging
|
||||
Return 0.99
|
||||
Case NetState.Finished, NetState.Interrupted
|
||||
Case NetState.Finished, NetState.Canceled
|
||||
Return 1
|
||||
Case Else
|
||||
Throw New ArgumentOutOfRangeException("文件状态未知：" & State)
|
||||
@@ -889,7 +886,7 @@ Retry:
|
||||
'条件检测
|
||||
SyncLock LockSource
|
||||
If NetTaskThreadCount >= NetTaskThreadLimit OrElse Not HasAvailableSource() OrElse
|
||||
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Interrupted) Then Return Nothing
|
||||
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Canceled) Then Return Nothing
|
||||
If State >= NetState.Merging OrElse State = NetState.WaitingToCheck Then Return Nothing
|
||||
SyncLock LockState
|
||||
If State < NetState.Connecting Then State = NetState.Connecting
|
||||
@@ -900,7 +897,7 @@ Retry:
|
||||
If IsNoSplit Then GoTo StartSingleThreadDownload
|
||||
'只剩下单线程可用点
|
||||
If Not HasAvailableSource(False) Then
|
||||
If SourcesOnce.First.SingleThread IsNot Nothing AndAlso SourcesOnce.First.SingleThread.State <> NetState.Interrupted Then Return Nothing
|
||||
If SourcesOnce.First.SingleThread IsNot Nothing AndAlso SourcesOnce.First.SingleThread.State <> NetState.Canceled Then Return Nothing
|
||||
StartSingleThreadDownload:
|
||||
Reset()
|
||||
State = NetState.Reading
|
||||
@@ -916,7 +913,7 @@ StartSingleThreadDownload:
|
||||
End If
|
||||
'寻找失败点
|
||||
For Each Thread As NetThread In Threads
|
||||
If Thread.State = NetState.Interrupted AndAlso Thread.DownloadUndone > 0 Then
|
||||
If Thread.State = NetState.Canceled AndAlso Thread.DownloadUndone > 0 Then
|
||||
StartPosition = Thread.DownloadStart + Thread.DownloadDone
|
||||
StartSource = GetSource(Thread.Source.Id + 1)
|
||||
GoTo StartThread
|
||||
@@ -997,7 +994,7 @@ StartThread:
|
||||
If Not Response.IsSuccessStatusCode Then '状态码检查
|
||||
Throw New HttpRequestCodeException($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Th.Source.Url}", Response.StatusCode, Nothing)
|
||||
End If
|
||||
If State = NetState.Interrupted Then GoTo SourceBreak '快速中断
|
||||
If State = NetState.Canceled Then GoTo SourceBreak '快速中断
|
||||
If Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Logger.Trace(Function() $"{LocalName}：重定向至 {Response.RequestMessage.RequestUri}")
|
||||
'文件大小校验
|
||||
ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1)
|
||||
@@ -1023,7 +1020,7 @@ StartThread:
|
||||
End If
|
||||
End If
|
||||
FileSize = ContentLength : IsUnknownSize = False
|
||||
Logger.Info($"{LocalName}：文件大小 {ContentLength}（{FormatFileSize(ContentLength)}）")
|
||||
Logger.Info($"{LocalName}：文件大小 {ContentLength}（{StringUtils.FormatByteSize(ContentLength)}）")
|
||||
'若文件大小大于 50 M，进行剩余磁盘空间校验
|
||||
If ContentLength > 50 * 1024 * 1024 Then
|
||||
For Each Drive As DriveInfo In DriveInfo.GetDrives
|
||||
@@ -1031,7 +1028,7 @@ StartThread:
|
||||
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) +
|
||||
If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0)
|
||||
If RequiredSpace > 0 AndAlso Drive.TotalFreeSpace < RequiredSpace Then
|
||||
Throw New Exception(DriveName & " 盘空间不足，无法进行下载。" & vbCrLf & "需要至少 " & FormatFileSize(RequiredSpace) & " 空间，但当前仅剩余 " & FormatFileSize(Drive.TotalFreeSpace) & "。" &
|
||||
Throw New Exception(DriveName & " 盘空间不足，无法进行下载。" & vbCrLf & "需要至少 " & StringUtils.FormatByteSize(RequiredSpace) & " 空间，但当前仅剩余 " & StringUtils.FormatByteSize(Drive.TotalFreeSpace) & "。" &
|
||||
If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存，你可以在设置中调整缓存文件夹的位置。", ""))
|
||||
End If
|
||||
Next
|
||||
@@ -1111,9 +1108,9 @@ NotSupportRange:
|
||||
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
|
||||
End While
|
||||
SourceBreak:
|
||||
If State = NetState.Interrupted OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
|
||||
If State = NetState.Canceled OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
|
||||
'被外部中断
|
||||
Th.State = NetState.Interrupted
|
||||
Th.State = NetState.Canceled
|
||||
Logger.Info($"{LocalName}：中断")
|
||||
ElseIf HttpDataCount = 0 AndAlso Th.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
|
||||
'服务器无返回数据
|
||||
@@ -1143,7 +1140,7 @@ SourceBreak:
|
||||
Interlocked.Decrement(NetTaskThreadCount)
|
||||
'合并
|
||||
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso
|
||||
State < NetState.Merging AndAlso Th.State <> NetState.Interrupted Then Merge(Th)
|
||||
State < NetState.Merging AndAlso Th.State <> NetState.Canceled Then Merge(Th)
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub SourceFail(Th As NetThread, ex As Exception, IsMergeFailure As Boolean)
|
||||
@@ -1152,7 +1149,7 @@ SourceBreak:
|
||||
For Each Task In Tasks
|
||||
Interlocked.Increment(Task.FailCount)
|
||||
Next
|
||||
Th.State = NetState.Interrupted
|
||||
Th.State = NetState.Canceled
|
||||
Th.Source.Ex = ex
|
||||
'根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传）
|
||||
Dim IsRangeNotSupported As Boolean = TypeOf ex Is RangeNotSupportedException OrElse ex.Message.Contains("(416)")
|
||||
@@ -1333,29 +1330,29 @@ Retry:
|
||||
If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
|
||||
'凉凉
|
||||
Logger.Info($"{LocalName}：已失败，当前状态 {State}")
|
||||
State = NetState.Interrupted
|
||||
State = NetState.Canceled
|
||||
End SyncLock
|
||||
InterruptInternal()
|
||||
CancelInternal()
|
||||
For Each Task In Tasks
|
||||
Task.OnFileFail(Me)
|
||||
Next
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 下载中断。
|
||||
''' 取消下载。
|
||||
''' </summary>
|
||||
Public Sub Interrupt(InterruptedTask As LoaderDownload)
|
||||
Public Sub Cancel(CanceledTask As LoaderDownload)
|
||||
'从特定任务中移除，如果它还属于其他任务，则继续下载
|
||||
Tasks.Remove(InterruptedTask)
|
||||
Tasks.Remove(CanceledTask)
|
||||
If Tasks.Any Then Return
|
||||
'确认中断
|
||||
SyncLock LockState
|
||||
If State >= NetState.Finished Then Return
|
||||
Logger.Info($"{LocalName}：已中断，当前状态 {State}")
|
||||
State = NetState.Interrupted
|
||||
State = NetState.Canceled
|
||||
End SyncLock
|
||||
InterruptInternal()
|
||||
CancelInternal()
|
||||
End Sub
|
||||
Private Sub InterruptInternal()
|
||||
Private Sub CancelInternal()
|
||||
On Error Resume Next
|
||||
Reset()
|
||||
Interlocked.Decrement(NetManager.FileRemain)
|
||||
@@ -1395,7 +1392,7 @@ Retry:
|
||||
''' <summary>
|
||||
''' 需要下载的文件。
|
||||
''' </summary>
|
||||
Public Files As ConcurrentList(Of NetFile)
|
||||
Public Files As ConcurrentQueue(Of NetFile)
|
||||
''' <summary>
|
||||
''' 剩余未完成的文件数。（用于减轻 FilesLock 的占用）
|
||||
''' </summary>
|
||||
@@ -1470,12 +1467,12 @@ FinishExCatch:
|
||||
|
||||
Public Sub New(Name As String, FileTasks As IEnumerable(Of NetFile))
|
||||
Me.Name = Name
|
||||
Files = New ConcurrentList(Of NetFile)(FileTasks)
|
||||
Files = New ConcurrentQueue(Of NetFile)(FileTasks)
|
||||
End Sub
|
||||
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
|
||||
If Input IsNot Nothing Then Files = New ConcurrentList(Of NetFile)(Input)
|
||||
If Input IsNot Nothing Then Files = New ConcurrentQueue(Of NetFile)(CType(Input, IEnumerable(Of NetFile)))
|
||||
'去重
|
||||
Files = New ConcurrentList(Of NetFile)(Files.DistinctBy(Function(a) a.LocalPath))
|
||||
Files = New ConcurrentQueue(Of NetFile)(Files.DistinctBy(Function(a) a.LocalPath))
|
||||
'设置剩余文件数
|
||||
SyncLock FileRemainLock
|
||||
FileRemain += Files.Where(Function(f) f.State <> NetState.Finished).Count
|
||||
@@ -1507,6 +1504,7 @@ FinishExCatch:
|
||||
'接入下载管理器，获取新开始下载的文件列表
|
||||
Dim NewFiles = NetManager.Start(Me)
|
||||
|
||||
|
||||
'====================================
|
||||
' 已存在文件查找
|
||||
'====================================
|
||||
@@ -1514,9 +1512,9 @@ FinishExCatch:
|
||||
'整理允许进行查找的文件
|
||||
Dim FilesToCheck As New List(Of NetFile)
|
||||
For Each File In NewFiles
|
||||
If File.Check?.CanUseExistsFile Then
|
||||
If File.Check IsNot Nothing Then
|
||||
FilesToCheck.Add(File)
|
||||
Else '不允许，直接开始下载
|
||||
Else '没有校验信息，直接开始下载
|
||||
SyncLock LockState
|
||||
File.State = NetState.WaitingToDownload
|
||||
File.IsCopy = False
|
||||
@@ -1526,7 +1524,7 @@ FinishExCatch:
|
||||
If Not FilesToCheck.Any Then Return
|
||||
'获取 MC 文件夹列表
|
||||
Dim Folders As New List(Of String)
|
||||
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里
|
||||
Folders.Add(Paths.AppData & ".minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里
|
||||
Folders.AddRange(McFolderList.Select(Function(f) f.Location))
|
||||
Folders = Folders.Distinct.Where(Function(f) DirectoryUtils.Exists(f)).ToList
|
||||
'平均分配到多个检查线程
|
||||
@@ -1555,7 +1553,7 @@ FinishExCatch:
|
||||
'列出 MC 文件夹中的各个版本文件夹
|
||||
Dim VersionFolders As New List(Of String)
|
||||
For Each McFolder In FolderList
|
||||
For Each VersionFolder In DirectoryUtils.GetDirectories(McFolder & "versions\", True)
|
||||
For Each VersionFolder In DirectoryUtils.EnumerateDirectories(McFolder & "versions\")
|
||||
VersionFolders.Add(PathUtils.AddSlashSuffix(VersionFolder))
|
||||
Next
|
||||
Next
|
||||
@@ -1625,7 +1623,7 @@ FinishExCatch:
|
||||
Case "versions\"
|
||||
'版本 jar 或 json：查找 MC 文件夹下的各个版本文件夹
|
||||
For Each VersionFolder In VersionFolders
|
||||
For Each Candidate In DirectoryUtils.GetFiles(VersionFolder, True, "*." & PathUtils.GetLastPart(File.LocalPath).AfterLast(".").Lower)
|
||||
For Each Candidate In DirectoryUtils.EnumerateFiles(VersionFolder, searchPattern:="*." & PathUtils.GetLastPart(File.LocalPath).AfterLast(".").Lower)
|
||||
If CheckCandidate(Candidate, File.Check) Then Return Candidate
|
||||
Next
|
||||
Next
|
||||
@@ -1633,7 +1631,7 @@ FinishExCatch:
|
||||
'社区资源
|
||||
If File.Check.ActualSize < 0 OrElse File.Check.Hash Is Nothing Then Return Nothing '必须要求指定了文件大小和 Hash
|
||||
For Each Folder In FolderList.Concat(VersionFolders)
|
||||
For Each Candidate In DirectoryUtils.GetFiles(Folder & Type, True)
|
||||
For Each Candidate In DirectoryUtils.EnumerateFiles(Folder & Type)
|
||||
If CheckCandidate(Candidate, File.Check) Then Return Candidate
|
||||
Next
|
||||
Next
|
||||
@@ -1671,12 +1669,12 @@ FinishExCatch:
|
||||
If State >= LoadState.Finished Then Return
|
||||
If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误！")}
|
||||
'寻找有效的错误信息
|
||||
Dim UsefulExs = ExList.Where(Function(e) TypeOf e IsNot OperationCanceledException AndAlso TypeOf e IsNot TimeoutException AndAlso TypeOf e IsNot ThreadInterruptedException).ToList
|
||||
Dim UsefulExs = ExList.Where(Function(e) Not e.IsCanceled AndAlso TypeOf e IsNot TimeoutException).ToList
|
||||
[Error] = If(UsefulExs.FirstOrDefault, ExList.FirstOrDefault)
|
||||
'获取实际失败的文件
|
||||
For Each File In Files
|
||||
If File.State <> NetState.Interrupted Then Continue For
|
||||
If File.Sources.All(Function(s) TypeOf s.Ex Is OperationCanceledException OrElse TypeOf s.Ex Is TimeoutException OrElse TypeOf s.Ex Is ThreadInterruptedException) Then Continue For
|
||||
If File.State <> NetState.Canceled Then Continue For
|
||||
If File.Sources.All(Function(s) s.Ex.IsCanceled OrElse TypeOf s.Ex Is TimeoutException) Then Continue For
|
||||
Dim Detail As String = File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetDisplay(False))}（{s.Url}）").Join(vbCrLf)
|
||||
[Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf &
|
||||
"各下载源的错误如下：" & vbCrLf & Detail, [Error])
|
||||
@@ -1691,20 +1689,20 @@ FinishExCatch:
|
||||
End SyncLock
|
||||
'中断所有文件
|
||||
For Each TaskFile In Files
|
||||
TaskFile.Interrupt(Me)
|
||||
TaskFile.Cancel(Me)
|
||||
Next
|
||||
'在退出同步锁后再进行日志输出
|
||||
Logger.Error(New AggregateException(ExList), "下载加载器失败", LogBehavior.None)
|
||||
End Sub
|
||||
Public Overrides Sub Interrupt()
|
||||
Public Overrides Sub Cancel()
|
||||
SyncLock LockState
|
||||
If State >= LoadState.Finished Then Return
|
||||
State = LoadState.Interrupted
|
||||
State = LoadState.Canceled
|
||||
End SyncLock
|
||||
Logger.Info($"{Name} 已取消！")
|
||||
'中断所有文件
|
||||
For Each TaskFile In Files
|
||||
TaskFile.Interrupt(Me)
|
||||
TaskFile.Cancel(Me)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
@@ -1726,7 +1724,7 @@ FinishExCatch:
|
||||
''' <summary>
|
||||
''' 当前的所有下载任务。
|
||||
''' </summary>
|
||||
Public Tasks As New ConcurrentList(Of LoaderDownload)
|
||||
Public Tasks As New ConcurrentBag(Of LoaderDownload)
|
||||
|
||||
''' <summary>
|
||||
''' 已下载完成的大小。
|
||||
@@ -1777,7 +1775,7 @@ FinishExCatch:
|
||||
If SpeedLast.Count >= 10 Then Limit = SpeedLast.Take(10).Average * 0.85 '取近 1 秒的平均速度的 85%
|
||||
If Limit > NetTaskSpeedLimitLow Then
|
||||
NetTaskSpeedLimitLow = Limit
|
||||
Logger.Info($"速度下限已提升到 {FormatFileSize(Limit)}")
|
||||
Logger.Info($"速度下限已提升到 {StringUtils.FormatByteSize(Limit)}")
|
||||
End If
|
||||
#End Region
|
||||
#Region "刷新下载任务属性"
|
||||
@@ -1894,14 +1892,13 @@ FinishExCatch:
|
||||
End SyncLock
|
||||
'添加每个文件
|
||||
Dim NewFiles As New List(Of NetFile)
|
||||
For i = 0 To Task.Files.Count - 1
|
||||
Dim File As NetFile = Task.Files(i)
|
||||
Dim NewFilesList As New List(Of NetFile)
|
||||
For Each File In Task.Files
|
||||
Dim OngoingFile As NetFile = Nothing
|
||||
If AllFiles.TryGetValue(File.LocalPath, OngoingFile) AndAlso OngoingFile.State < NetState.Finished Then
|
||||
'该文件正在被另一个任务下载
|
||||
Logger.Trace(Function() $"{File.LocalName}：无需开始，该文件已在下载中，目标 {File.LocalPath}")
|
||||
File = OngoingFile '将列表中的文件替换成下载中的文件，即两个任务指向同一个文件；抛弃现在的 File 对象
|
||||
Task.Files(i) = File
|
||||
Else
|
||||
'常规情况（该文件可能已在其他任务中下载完成，但这并不影响）
|
||||
Logger.Trace(Function() $"{File.LocalName}：开始，目标 {File.LocalPath}")
|
||||
@@ -1909,8 +1906,10 @@ FinishExCatch:
|
||||
NewFiles.Add(File)
|
||||
Interlocked.Increment(FileRemain)
|
||||
End If
|
||||
NewFilesList.Add(File)
|
||||
File.Tasks.Add(Task)
|
||||
Next
|
||||
Task.Files = New ConcurrentQueue(Of NetFile)(NewFilesList)
|
||||
Tasks.Add(Task)
|
||||
Return NewFiles
|
||||
End Function
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
'提供不同的输入验证方法，名称以 Validate 开头
|
||||
'提供不同的输入验证方法，名称以 Validate 开头
|
||||
Public Module ModValidate
|
||||
|
||||
''' <summary>
|
||||
@@ -66,6 +66,20 @@ Public Class ValidateNullOrWhiteSpace
|
||||
End Function
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 自定义的 Validate。
|
||||
''' </summary>
|
||||
Public Class ValidateFunc
|
||||
Inherits Validate
|
||||
Private ReadOnly _func As Func(Of String, String)
|
||||
Public Sub New(F As Func(Of String, String))
|
||||
_func = F
|
||||
End Sub
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
Return _func(Str)
|
||||
End Function
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 必须满足正则表达式。
|
||||
''' </summary>
|
||||
@@ -255,7 +269,7 @@ Public Class ValidateFolderName
|
||||
Me.IgnoreCase = IgnoreCase
|
||||
Me.UseMinecraftCharCheck = UseMinecraftCharCheck
|
||||
On Error Resume Next
|
||||
PathIgnore = DirectoryUtils.GetDirectories(Folder, True)
|
||||
PathIgnore = DirectoryUtils.EnumerateDirectories(Folder)
|
||||
End Sub
|
||||
Public Overrides Function Validate(Str As String) As String
|
||||
Try
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
'一个万能的自动图片类型转换工具类
|
||||
'一个万能的自动图片类型转换工具类
|
||||
|
||||
Imports System.Drawing.Imaging
|
||||
|
||||
@@ -126,9 +126,7 @@ Public Class MyBitmap
|
||||
End Sub
|
||||
Private Class WebPDecoder '将代码隔离在另外一个类中，这样只要不调用这个方法就不会加载 Imazen.WebP.dll
|
||||
Public Shared Function DecodeFromBytes(Bytes As Byte()) As System.Drawing.Bitmap
|
||||
If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
|
||||
Dim Decoder As New Imazen.WebP.SimpleDecoder()
|
||||
Return Decoder.DecodeFromBytes(Bytes, Bytes.Length)
|
||||
Return New Imazen.WebP.SimpleDecoder().DecodeFromBytes(Bytes, Bytes.Length)
|
||||
End Function
|
||||
End Class
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class PclLogger
|
||||
Public Class PclLogger
|
||||
Inherits FileLogger
|
||||
|
||||
''' <inheritdoc/>
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class CrashAnalyzer
|
||||
Public Class CrashAnalyzer
|
||||
|
||||
'构造函数
|
||||
Private TempFolder As String
|
||||
@@ -24,7 +24,7 @@
|
||||
'简单收集可能的日志文件路径
|
||||
Dim PossibleLogs As New List(Of String)
|
||||
Try
|
||||
PossibleLogs.AddRange(DirectoryUtils.GetFiles(VersionPathIndie & "crash-reports\"))
|
||||
PossibleLogs.AddRange(DirectoryUtils.EnumerateFiles(VersionPathIndie & "crash-reports\", True))
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败")
|
||||
End Try
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Module ModDownload
|
||||
Public Module ModDownload
|
||||
|
||||
#Region "DlClient* | Minecraft 客户端"
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
Throw New Exception("底层版本 " & Instance.Name & " 中无 jar 文件下载信息")
|
||||
End If
|
||||
'检查文件
|
||||
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Instance.JsonObject("downloads")("client")("size"), -1), Hash:=Instance.JsonObject("downloads")("client")("sha1"))
|
||||
Dim Checker As New FileChecker With {.MinSize = 1024, .ActualSize = If(Instance.JsonObject("downloads")("client")("size"), -1), .Hash = Instance.JsonObject("downloads")("client")("sha1")}
|
||||
If ReturnNothingOnFileUseable AndAlso Checker.Check(Instance.PathVersion & Instance.Name & ".jar") Is Nothing Then Return Nothing '通过校验
|
||||
'返回下载信息
|
||||
Dim JarUrl As String = Instance.JsonObject("downloads")("client")("url")
|
||||
@@ -44,14 +44,14 @@
|
||||
If IndexUrl = "" Then
|
||||
Return Nothing
|
||||
Else
|
||||
Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl), IndexAddress, New FileChecker(CanUseExistsFile:=False, IsJson:=True))
|
||||
Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl), IndexAddress, New FileChecker With {.IsJson = True})
|
||||
End If
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
|
||||
''' </summary>
|
||||
Public Function DlClientFix(Instance As McInstance, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
|
||||
Public Function DlClientFix(Instance As McInstance, CheckAssetsHash As Boolean, DownloadAssetIndexInBackground As Boolean) As List(Of LoaderBase)
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
|
||||
#Region "下载支持库文件"
|
||||
@@ -69,6 +69,8 @@
|
||||
Else
|
||||
Dim LoadersAssets As New List(Of LoaderBase)
|
||||
'获取资源文件索引地址
|
||||
Dim TempAddressMain As String = Nothing
|
||||
Dim RealAddressMain As String = Nothing
|
||||
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
|
||||
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Try
|
||||
@@ -76,9 +78,16 @@
|
||||
If IndexFile Is Nothing Then
|
||||
Task.Output = New List(Of NetFile)
|
||||
Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
|
||||
ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
|
||||
Task.Output = New List(Of NetFile)
|
||||
Else
|
||||
ElseIf DownloadAssetIndexInBackground Then
|
||||
If IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
|
||||
Task.Output = New List(Of NetFile)
|
||||
Else
|
||||
Task.Output = New List(Of NetFile) From {IndexFile}
|
||||
End If
|
||||
Else '强制要求重新下载
|
||||
RealAddressMain = IndexFile.LocalPath
|
||||
TempAddressMain = PathTemp & "Cache\" & IndexFile.LocalName
|
||||
IndexFile.LocalPath = TempAddressMain
|
||||
Task.Output = New List(Of NetFile) From {IndexFile}
|
||||
End If
|
||||
Catch ex As Exception
|
||||
@@ -87,65 +96,55 @@
|
||||
End Sub) With {.ProgressWeight = 0.5, .Show = False})
|
||||
'下载资源文件索引
|
||||
LoadersAssets.Add(New LoaderDownload("下载资源文件索引", New List(Of NetFile)) With {.ProgressWeight = 2})
|
||||
'要求独立更新索引
|
||||
If AssetsIndexBehaviour = AssetsIndexExistsBehaviour.DownloadInBackground Then
|
||||
'获取资源文件地址
|
||||
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("获取资源文件列表",
|
||||
Sub(Task)
|
||||
If TempAddressMain IsNot Nothing Then FileUtils.Move(TempAddressMain, RealAddressMain)
|
||||
Task.Output = McAssetsFixList(Instance, CheckAssetsHash, Task)
|
||||
End Sub) With {.ProgressWeight = 0.01})
|
||||
'下载资源文件
|
||||
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
|
||||
'构造加载器
|
||||
Loaders.Add(New LoaderCombo(Of String)("下载资源文件（主加载器）", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 27})
|
||||
|
||||
'后台独立更新索引
|
||||
If DownloadAssetIndexInBackground Then
|
||||
Dim RealAddressBg As String = Nothing
|
||||
Dim TempAddressBg As String = Nothing
|
||||
Dim LoadersAssetsUpdate As New List(Of LoaderBase)
|
||||
Dim TempAddress As String = Nothing
|
||||
Dim RealAddress As String = Nothing
|
||||
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
|
||||
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
|
||||
If BackAssetsFile Is Nothing Then
|
||||
Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
|
||||
Task.Interrupt()
|
||||
Throw New ThreadInterruptedException
|
||||
Task.Cancel()
|
||||
Throw New OperationCanceledException
|
||||
End If
|
||||
RealAddress = BackAssetsFile.LocalPath
|
||||
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
|
||||
BackAssetsFile.LocalPath = TempAddress
|
||||
RealAddressBg = BackAssetsFile.LocalPath
|
||||
TempAddressBg = PathTemp & "Cache\" & BackAssetsFile.LocalName & "_background"
|
||||
BackAssetsFile.LocalPath = TempAddressBg
|
||||
Task.Output = New List(Of NetFile) From {BackAssetsFile}
|
||||
'检查是否需要更新：每天只更新一次
|
||||
If FileUtils.Exists(RealAddress) AndAlso Math.Abs((FileUtils.GetInfo(RealAddress).LastWriteTime.Date - Now.Date).TotalDays) < 1 Then
|
||||
If FileUtils.Exists(RealAddressBg) AndAlso Math.Abs((FileUtils.GetInfo(RealAddressBg).LastWriteTime.Date - Now.Date).TotalDays) < 1 Then
|
||||
Logger.Info("无需更新资源文件索引，取消")
|
||||
Task.Interrupt()
|
||||
Task.Cancel()
|
||||
End If
|
||||
End Sub))
|
||||
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
|
||||
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
|
||||
Sub(Task As LoaderTask(Of List(Of NetFile), String))
|
||||
FileUtils.Copy(TempAddress, RealAddress)
|
||||
McLaunchLog("后台更新资源文件索引成功：" & TempAddress)
|
||||
FileUtils.Move(TempAddressBg, RealAddressBg)
|
||||
McLaunchLog("后台更新资源文件索引成功：" & TempAddressBg)
|
||||
End Sub))
|
||||
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
|
||||
Logger.Info("开始后台检查资源文件索引")
|
||||
Updater.Start()
|
||||
End If
|
||||
'获取资源文件地址
|
||||
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("获取资源文件列表",
|
||||
Sub(Task) Task.Output = McAssetsFixList(Instance, CheckAssetsHash, Task)) With {.ProgressWeight = 0.01})
|
||||
'下载资源文件
|
||||
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
|
||||
'构造加载器
|
||||
Loaders.Add(New LoaderCombo(Of String)("下载资源文件（主加载器）", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 27})
|
||||
End If
|
||||
#End Region
|
||||
|
||||
Return Loaders
|
||||
End Function
|
||||
Public Enum AssetsIndexExistsBehaviour
|
||||
''' <summary>
|
||||
''' 如果文件存在，则不进行下载。
|
||||
''' </summary>
|
||||
DontDownload
|
||||
''' <summary>
|
||||
''' 如果文件存在，则启动新的下载加载器进行独立的更新。
|
||||
''' </summary>
|
||||
DownloadInBackground
|
||||
''' <summary>
|
||||
''' 如果文件存在，也同样进行下载。
|
||||
''' </summary>
|
||||
AlwaysDownload
|
||||
End Enum
|
||||
|
||||
#End Region
|
||||
|
||||
@@ -227,7 +226,7 @@
|
||||
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
|
||||
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
|
||||
Dim StartTime As Long = GetTimeMs()
|
||||
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
|
||||
Dim Json As JObject = NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True).DeserializeJson()
|
||||
Try
|
||||
Dim Versions As JArray = Json("versions")
|
||||
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
|
||||
@@ -238,7 +237,7 @@
|
||||
Logger.Info($"Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
|
||||
End If
|
||||
'添加 PCL 特供项
|
||||
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(FileUtils.ReadAsString(PathTemp & "Cache\download.json")))
|
||||
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(FileUtils.ReadAsJson(PathTemp & "Cache\download.json"))
|
||||
'返回
|
||||
Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
|
||||
'MC 更新提示
|
||||
@@ -269,12 +268,12 @@
|
||||
''' </summary>
|
||||
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 = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True))
|
||||
Dim Json As JObject = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True).DeserializeJson()
|
||||
Try
|
||||
Dim Versions As JArray = Json("versions")
|
||||
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
|
||||
'添加 PCL 特供项
|
||||
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(FileUtils.ReadAsString(PathTemp & "Cache\download.json")))
|
||||
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(FileUtils.ReadAsJson(PathTemp & "Cache\download.json"))
|
||||
'检查是否有要求的版本（#5195）
|
||||
If Not String.IsNullOrEmpty(Loader.Input) Then
|
||||
Dim Id = Loader.Input
|
||||
@@ -308,7 +307,7 @@
|
||||
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
|
||||
Case LoadState.Loading
|
||||
DlClientListLoader.WaitForExit(Id)
|
||||
Case LoadState.Failed, LoadState.Interrupted, LoadState.Waiting
|
||||
Case LoadState.Failed, LoadState.Canceled, LoadState.Waiting
|
||||
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
|
||||
End Select
|
||||
'重新查找版本
|
||||
@@ -447,7 +446,7 @@
|
||||
''' </summary>
|
||||
Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
|
||||
Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
|
||||
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True))
|
||||
Dim Json As JArray = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True).DeserializeJson()
|
||||
Try
|
||||
Dim Versions As New List(Of DlOptiFineListEntry)
|
||||
For Each Token As JObject In Json
|
||||
@@ -531,8 +530,8 @@
|
||||
''' </summary>
|
||||
Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
|
||||
Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
|
||||
Dim Result As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
|
||||
Encoding:=Encoding.Default, RequireJson:=True))
|
||||
Dim Result As JArray = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
|
||||
Encoding:=Encoding.Default, RequireJson:=True).DeserializeJson()
|
||||
Dim Names As List(Of String) = Result.Select(Function(v) v.ToString).ToList
|
||||
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足")
|
||||
Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names}
|
||||
@@ -738,8 +737,8 @@
|
||||
''' Forge 版本列表，BMCLAPI。
|
||||
''' </summary>
|
||||
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
|
||||
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
|
||||
Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4，#4057
|
||||
Dim Json As JArray = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
|
||||
Loader.Input.Replace("-", "_"), RequireJson:=True).DeserializeJson() '兼容 Forge 1.7.10-pre4，#4057
|
||||
Dim Versions As New List(Of DlForgeVersionEntry)
|
||||
Try
|
||||
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
|
||||
@@ -1026,7 +1025,7 @@
|
||||
''' </summary>
|
||||
Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
|
||||
Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True))
|
||||
Dim Result As JObject = NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True).DeserializeJson()
|
||||
Try
|
||||
Dim Json As JObject = Result("versions")
|
||||
Dim Versions As New List(Of DlLiteLoaderListEntry)
|
||||
@@ -1054,7 +1053,7 @@
|
||||
''' </summary>
|
||||
Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
|
||||
Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True))
|
||||
Dim Result As JObject = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True).DeserializeJson()
|
||||
Try
|
||||
Dim Json As JObject = Result("versions")
|
||||
Dim Versions As New List(Of DlLiteLoaderListEntry)
|
||||
@@ -1125,7 +1124,7 @@
|
||||
''' </summary>
|
||||
Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain)
|
||||
Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True))
|
||||
Dim Result As JObject = NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True).DeserializeJson()
|
||||
Try
|
||||
Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result}
|
||||
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
|
||||
@@ -1140,7 +1139,7 @@
|
||||
''' </summary>
|
||||
Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
|
||||
Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
|
||||
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True))
|
||||
Dim Result As JObject = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True).DeserializeJson()
|
||||
Try
|
||||
Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
|
||||
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
|
||||
@@ -1197,7 +1196,7 @@
|
||||
Dim Exs As String = ""
|
||||
For Each Source In Urls
|
||||
Try
|
||||
Return GetJson(NetRequestByClient(Source.Url, Method, Content, ContentType, Timeout:=Source.Timeout * 1000, Encoding:=Encoding.UTF8, RequireJson:=True))
|
||||
Return NetRequestByClient(Source.Url, Method, Content, ContentType, Timeout:=Source.Timeout * 1000, Encoding:=Encoding.UTF8, RequireJson:=True).DeserializeJson()
|
||||
Catch ex As Exception
|
||||
Exs += ex.Message + vbCrLf
|
||||
End Try
|
||||
@@ -1328,7 +1327,7 @@
|
||||
If SubLoader.Key.State = LoadState.Finished Then
|
||||
'检查加载器成功
|
||||
MainLoader.Output = SubLoader.Key.Output
|
||||
DlSourceLoaderInterrupt(LoaderList)
|
||||
DlSourceLoaderCancel(LoaderList)
|
||||
Return
|
||||
ElseIf BeforeLoadersAllFailed Then
|
||||
'此前的加载器全部失败，直接启动后续加载器
|
||||
@@ -1360,7 +1359,7 @@
|
||||
End If
|
||||
Next
|
||||
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
|
||||
DlSourceLoaderInterrupt(LoaderList)
|
||||
DlSourceLoaderCancel(LoaderList)
|
||||
Throw ErrorInfo
|
||||
End If
|
||||
Exit For
|
||||
@@ -1369,15 +1368,15 @@
|
||||
Thread.Sleep(10)
|
||||
WaitCycle += 1
|
||||
'检查父加载器中断
|
||||
If MainLoader.IsInterrupted Then
|
||||
DlSourceLoaderInterrupt(LoaderList)
|
||||
If MainLoader.IsCanceled Then
|
||||
DlSourceLoaderCancel(LoaderList)
|
||||
Return
|
||||
End If
|
||||
Loop
|
||||
End Sub
|
||||
Private Sub DlSourceLoaderInterrupt(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
|
||||
Private Sub DlSourceLoaderCancel(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
|
||||
For Each Loader In LoaderList
|
||||
If Loader.Key.State = LoadState.Loading Then Loader.Key.Interrupt()
|
||||
If Loader.Key.State = LoadState.Loading Then Loader.Key.Cancel()
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,4 +1,4 @@
|
||||
Public Module ModLaunch
|
||||
Public Module ModLaunch
|
||||
|
||||
#Region "开始"
|
||||
|
||||
@@ -81,7 +81,7 @@
|
||||
Public McLaunchWatcher As Watcher
|
||||
Private Sub McLaunchState(Loader As LoaderTask(Of McLaunchOptions, Object))
|
||||
Select Case McLaunchLoader.State
|
||||
Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Interrupted
|
||||
Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Canceled
|
||||
FrmLaunchLeft.PageChangeToLogin()
|
||||
Case LoadState.Loading
|
||||
'在预检测结束后再触发动画
|
||||
@@ -91,7 +91,7 @@
|
||||
''' <summary>
|
||||
''' 指定启动中断时的提示文本。若不为 Nothing 则会显示为绿色。
|
||||
''' </summary>
|
||||
Private InterruptHint As String = Nothing
|
||||
Private CanceledHint As String = Nothing
|
||||
|
||||
'实际的启动方法
|
||||
Private Sub McLaunchStart(Loader As LoaderTask(Of McLaunchOptions, Object))
|
||||
@@ -102,7 +102,7 @@
|
||||
McLaunchPrecheck()
|
||||
McLaunchLog("预检测已通过")
|
||||
Catch ex As Exception
|
||||
If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Red)
|
||||
If Not ex.IsCanceled Then Hint(ex.Message, HintType.Red)
|
||||
Throw
|
||||
End Try
|
||||
Dim IsSavingBatch As Boolean = CurrentLaunchOptions?.SaveBatch IsNot Nothing
|
||||
@@ -113,7 +113,7 @@
|
||||
Dim Loaders As New List(Of LoaderBase) From {
|
||||
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
|
||||
McLoginLoader, '.ProgressWeight = 15, .Block = False
|
||||
New LoaderCombo(Of String)("补全文件", DlClientFix(McInstanceSelected, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
|
||||
New LoaderCombo(Of String)("补全文件", DlClientFix(McInstanceSelected, False, True)) With {.ProgressWeight = 15, .Show = False},
|
||||
New LoaderTask(Of String, Integer)("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
|
||||
New LoaderTask(Of Integer, Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
|
||||
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
|
||||
@@ -138,7 +138,7 @@
|
||||
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器，它会自行决定是否启动副加载器
|
||||
'等待加载器执行并更新 UI
|
||||
McLaunchLoaderReal = LaunchLoader
|
||||
InterruptHint = Nothing
|
||||
CanceledHint = Nothing
|
||||
LaunchLoader.Start()
|
||||
'任务栏进度条
|
||||
LoaderTaskbarAdd(LaunchLoader)
|
||||
@@ -157,11 +157,11 @@
|
||||
"Version", McInstanceSelected.VersionDisplayName,
|
||||
"LoginType", Settings.Get(Of McLoginType)("LoginType").ToString)
|
||||
End If
|
||||
Case LoadState.Interrupted
|
||||
If InterruptHint Is Nothing Then
|
||||
Case LoadState.Canceled
|
||||
If CanceledHint Is Nothing Then
|
||||
Hint(If(IsSavingBatch, "已取消导出启动脚本！", "已取消启动！"), HintType.Blue)
|
||||
Else
|
||||
Hint(InterruptHint, HintType.Green)
|
||||
Hint(CanceledHint, HintType.Green)
|
||||
End If
|
||||
Case LoadState.Failed
|
||||
Throw LaunchLoader.Error
|
||||
@@ -169,12 +169,12 @@
|
||||
Throw New Exception("错误的状态改变：" & LaunchLoader.State.ToString())
|
||||
End Select
|
||||
Catch ex As Exception
|
||||
ex.ThrowIfCanceled()
|
||||
Dim CurrentEx = ex
|
||||
NextInner:
|
||||
If CurrentEx.Message.StartsWithF("$") Then
|
||||
'若有以 $ 开头的错误信息，则以此为准显示提示
|
||||
'若错误信息为 $$，则不提示
|
||||
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
|
||||
MyMsgBox(CurrentEx.Message.TrimStart("$"), If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
|
||||
Throw
|
||||
ElseIf CurrentEx.InnerException IsNot Nothing Then
|
||||
'检查下一级错误
|
||||
@@ -208,7 +208,7 @@ NextInner:
|
||||
PageOtherTest.MemoryOptimize(False)
|
||||
Finished = True
|
||||
End Sub, "Launch Memory Optimize")
|
||||
Do While Not Finished AndAlso Not Loader.IsInterrupted
|
||||
Do While Not Finished AndAlso Not Loader.IsCanceled
|
||||
If Loader.Progress < 0.7 Then
|
||||
Loader.Progress += 0.007 '10s
|
||||
Else
|
||||
@@ -273,7 +273,7 @@ NextInner:
|
||||
Hint("游戏将以试玩模式启动！", HintType.Red)
|
||||
CurrentLaunchOptions.ExtraGameArgs.Add("--demo")
|
||||
Case 3
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
End Select
|
||||
End If
|
||||
End If
|
||||
@@ -353,7 +353,8 @@ NextInner:
|
||||
Type = McLoginType.Ms
|
||||
End Sub
|
||||
Public Overrides Function GetHashCode() As Integer
|
||||
Return (OAuthRefreshToken & AccessToken & Uuid & UserName & ProfileJson).GetStableHashCode() Mod Integer.MaxValue
|
||||
'不能使用全部信息，这俩就足以在登录输入时确保是同一个用户了
|
||||
Return (OAuthRefreshToken & UserName).GetStableHashCode() Mod Integer.MaxValue
|
||||
End Function
|
||||
End Class
|
||||
Public Class McLoginLegacy
|
||||
@@ -465,7 +466,7 @@ NextInner:
|
||||
Public McLoginLoader As New LoaderTask(Of McLoginData, McLoginResult)("登录", AddressOf McLoginStart, AddressOf McLoginInput, ThreadPriority.BelowNormal) With {.ReloadTimeout = 1, .ProgressWeight = 15, .Block = False}
|
||||
Public Function McLoginInput() As McLoginData
|
||||
Dim LoginData As McLoginData = Nothing
|
||||
Dim LoginType As McLoginType = Settings.Get(Of McLoginType)("LoginType")
|
||||
Dim LoginType = Settings.Get(Of McLoginType)("LoginType")
|
||||
Try
|
||||
Select Case LoginType
|
||||
Case McLoginType.Legacy
|
||||
@@ -489,10 +490,10 @@ NextInner:
|
||||
LoginData = PageLoginAuthSkin.GetLoginData()
|
||||
End If
|
||||
End Select
|
||||
Return LoginData
|
||||
Catch ex As Exception
|
||||
Logger.Error(ex, $"获取登录输入信息失败（{LoginType}）")
|
||||
Throw New Exception($"获取登录输入信息失败（{LoginType}）", ex)
|
||||
End Try
|
||||
Return LoginData
|
||||
End Function
|
||||
Private Sub McLoginStart(Data As LoaderTask(Of McLoginData, McLoginResult))
|
||||
McLaunchLog("登录加载已开始")
|
||||
@@ -559,24 +560,24 @@ Relogin:
|
||||
OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken)
|
||||
If OAuthTokens.OAuthAccessToken = "Relogin" Then GoTo Relogin '要求重新打开登录网页认证
|
||||
End If
|
||||
If Data.IsInterrupted Then Throw New ThreadInterruptedException
|
||||
If Data.IsCanceled Then Throw New OperationCanceledException
|
||||
Data.Progress = 0.25
|
||||
If Data.IsInterrupted Then Throw New ThreadInterruptedException
|
||||
If Data.IsCanceled Then Throw New OperationCanceledException
|
||||
Dim OAuthAccessToken As String = OAuthTokens.OAuthAccessToken
|
||||
Dim OAuthRefreshToken As String = OAuthTokens.OAuthRefreshToken
|
||||
Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
|
||||
Data.Progress = 0.4
|
||||
If Data.IsInterrupted Then Throw New ThreadInterruptedException
|
||||
If Data.IsCanceled Then Throw New OperationCanceledException
|
||||
Dim Tokens = MsLoginStep3(XBLToken)
|
||||
Data.Progress = 0.55
|
||||
If Data.IsInterrupted Then Throw New ThreadInterruptedException
|
||||
If Data.IsCanceled Then Throw New OperationCanceledException
|
||||
Dim LoginResult = MsLoginStep4(Tokens)
|
||||
ExpiresAt = LoginResult.ExpiresAt
|
||||
Data.Progress = 0.7
|
||||
If Data.IsInterrupted Then Throw New ThreadInterruptedException
|
||||
If Data.IsCanceled Then Throw New OperationCanceledException
|
||||
MsLoginStep5(LoginResult.AccessToken)
|
||||
Data.Progress = 0.85
|
||||
If Data.IsInterrupted Then Throw New ThreadInterruptedException
|
||||
If Data.IsCanceled Then Throw New OperationCanceledException
|
||||
Dim Result = MsLoginStep6(LoginResult.AccessToken)
|
||||
Data.Progress = 0.98
|
||||
'输出登录结果
|
||||
@@ -586,14 +587,14 @@ Relogin:
|
||||
Settings.Set("CacheMsV2Name", Result.UserName)
|
||||
Settings.Set("CacheMsV2ProfileJson", Result.ProfileJson)
|
||||
Settings.Set("CacheMsV2Expires", LoginResult.ExpiresAt)
|
||||
Dim MsJson As JObject = GetJson(Settings.Get(Of String)("LoginMsJson"))
|
||||
Dim MsJson As JObject = Settings.Get(Of String)("LoginMsJson").DeserializeJson()
|
||||
MsJson.Remove(Input.UserName) '如果更改了玩家名……
|
||||
MsJson(Result.UserName) = OAuthRefreshToken
|
||||
Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
|
||||
Data.Output = New McLoginResult With {.AccessToken = LoginResult.AccessToken, .Name = Result.UserName, .Uuid = Result.UUID, .Type = "Microsoft", .ClientToken = Result.UUID, .ProfileJson = Result.ProfileJson}
|
||||
'结束
|
||||
SkipLogin:
|
||||
McLaunchLog($"微软登录结束，AccessToken 将在 {DateTimeOffset.FromUnixTimeSeconds(ExpiresAt).Date.ToLocalTime} 过期")
|
||||
McLaunchLog($"微软登录结束，AccessToken 将在 {DateTimeOffset.FromUnixTimeSeconds(ExpiresAt).LocalDateTime} 过期")
|
||||
Settings.Set("HintBuy", True) '关闭正版购买提示
|
||||
If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持！" & vbCrLf & "隐藏主题 跳票红 已解锁！", "提示")
|
||||
End Sub
|
||||
@@ -612,7 +613,7 @@ SkipLogin:
|
||||
Settings.Get(Of String)("Cache" & Input.Token & "Name") <> "" Then
|
||||
'尝试验证登录
|
||||
Try
|
||||
If Data.IsInterrupted Then Throw New ThreadInterruptedException
|
||||
If Data.IsCanceled Then Throw New OperationCanceledException
|
||||
McLoginRequestValidate(Data)
|
||||
GoTo LoginFinish
|
||||
Catch ex As Exception
|
||||
@@ -623,7 +624,7 @@ SkipLogin:
|
||||
'尝试刷新登录
|
||||
Refresh:
|
||||
Try
|
||||
If Data.IsInterrupted Then Throw New ThreadInterruptedException
|
||||
If Data.IsCanceled Then Throw New OperationCanceledException
|
||||
McLoginRequestRefresh(Data, NeedRefresh)
|
||||
GoTo LoginFinish
|
||||
Catch ex As Exception
|
||||
@@ -634,7 +635,7 @@ Refresh:
|
||||
End If
|
||||
'尝试普通登录
|
||||
Try
|
||||
If Data.IsInterrupted Then Throw New ThreadInterruptedException
|
||||
If Data.IsCanceled Then Throw New OperationCanceledException
|
||||
NeedRefresh = McLoginRequestLogin(Data)
|
||||
Catch ex As Exception
|
||||
McLaunchLog("登录失败：" & ex.GetDisplay(True))
|
||||
@@ -718,7 +719,7 @@ LoginFinish:
|
||||
End Sub
|
||||
Private Sub McLoginRequestRefresh(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult), RequestUser As Boolean)
|
||||
McLaunchLog("刷新登录开始（Refresh, " & Data.Input.Token & "）")
|
||||
Dim LoginJson As JObject = GetJson(NetRequestByClientRetry(
|
||||
Dim LoginJson As JObject = NetRequestByClientRetry(
|
||||
Data.Input.BaseUrl & "/refresh", HttpMethod.Post,
|
||||
Content:=New JObject(
|
||||
New JProperty("selectedProfile", New JObject(
|
||||
@@ -729,7 +730,7 @@ LoginFinish:
|
||||
New JProperty("requestUser", True)
|
||||
).ToString(Newtonsoft.Json.Formatting.None),
|
||||
Headers:={{"Accept-Language", "zh-CN"}},
|
||||
ContentType:="application/json; charset=utf-8", RequireJson:=True))
|
||||
ContentType:="application/json; charset=utf-8", RequireJson:=True).DeserializeJson()
|
||||
'将登录结果输出
|
||||
If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Settings.Get(Of String)("Cache" & Data.Input.Token & "Name") & " 无效！")
|
||||
Data.Output.AccessToken = LoginJson("accessToken").ToString
|
||||
@@ -755,11 +756,11 @@ LoginFinish:
|
||||
New JProperty("username", Data.Input.UserName),
|
||||
New JProperty("password", Data.Input.Password),
|
||||
New JProperty("requestUser", True))
|
||||
Dim LoginJson As JObject = GetJson(NetRequestByClientRetry(
|
||||
Dim LoginJson As JObject = NetRequestByClientRetry(
|
||||
Data.Input.BaseUrl & "/authenticate", HttpMethod.Post,
|
||||
Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
|
||||
Headers:={{"Accept-Language", "zh-CN"}},
|
||||
ContentType:="application/json; charset=utf-8", RequireJson:=True))
|
||||
ContentType:="application/json; charset=utf-8", RequireJson:=True).DeserializeJson()
|
||||
'检查登录结果
|
||||
If LoginJson("availableProfiles").Count = 0 Then
|
||||
If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色，无法更换！", HintType.Red)
|
||||
@@ -824,7 +825,7 @@ LoginFinish:
|
||||
Dim ErrorMessage As String = Nothing
|
||||
Try
|
||||
Dim Response = DirectCast(ex, HttpRequestCodeException).Response
|
||||
If Response.ContainsIgnoreCase("errorMessage") Then ErrorMessage = GetJson(Response)("errorMessage").ToString()
|
||||
If Response.ContainsIgnoreCase("errorMessage") Then ErrorMessage = Response.DeserializeJson()("errorMessage").ToString()
|
||||
Catch
|
||||
End Try
|
||||
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
|
||||
@@ -874,14 +875,14 @@ LoginFinish:
|
||||
'初始请求
|
||||
Retry:
|
||||
McLaunchLog("开始微软登录步骤 1/6（原始登录）")
|
||||
Dim PrepareJson As JObject = GetJson(NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post,
|
||||
Dim PrepareJson As JObject = NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post,
|
||||
Content:=$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access",
|
||||
ContentType:="application/x-www-form-urlencoded", RequireJson:=True))
|
||||
ContentType:="application/x-www-form-urlencoded", RequireJson:=True).DeserializeJson()
|
||||
McLaunchLog("网页登录地址：" & PrepareJson("verification_uri").ToString)
|
||||
|
||||
'弹窗
|
||||
Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
|
||||
WaitingMyMsgBox.Add(Converter)
|
||||
WaitingMyMsgBox.Enqueue(Converter)
|
||||
While Converter.Result Is Nothing
|
||||
Thread.Sleep(100)
|
||||
End While
|
||||
@@ -891,7 +892,7 @@ Retry:
|
||||
Button2Action:=Sub() OpenWebsite("https://account.live.com/password/Change")) = 1 Then
|
||||
GoTo Retry
|
||||
Else
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
End If
|
||||
ElseIf TypeOf Converter.Result Is Exception Then
|
||||
Throw CType(Converter.Result, Exception)
|
||||
@@ -906,7 +907,7 @@ Retry:
|
||||
Dim Result As String
|
||||
Try
|
||||
Result = NetRequestByClientMultiple("https://login.live.com/oauth20_token.srf", HttpMethod.Post,
|
||||
Content:=$"client_id={OAuthClientId}&refresh_token={EscapeUtils.FormUrlEscape(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
|
||||
Content:=$"client_id={OAuthClientId}&refresh_token={StringUtils.FormUrlEscape(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
|
||||
ContentType:="application/x-www-form-urlencoded",
|
||||
Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}},
|
||||
ThreadCount:=2)
|
||||
@@ -919,16 +920,16 @@ Retry:
|
||||
Return ("Relogin", "")
|
||||
ElseIf Response.Contains("Account security interrupt") Then
|
||||
MyMsgBox("该账号由于安全问题无法登陆，请前往微软账户页获取更多信息。", "登录失败", "我知道了", IsWarn:=True)
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
ElseIf Response.Contains("service abuse") Then
|
||||
MyMsgBox("非常抱歉，该账号已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
Else
|
||||
Throw
|
||||
End If
|
||||
End Try
|
||||
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Dim ResultJson As JObject = Result.DeserializeJson()
|
||||
Dim AccessToken As String = ResultJson("access_token").ToString
|
||||
Dim RefreshToken As String = ResultJson("refresh_token").ToString
|
||||
Return (AccessToken, RefreshToken)
|
||||
@@ -946,9 +947,8 @@ Retry:
|
||||
""RelyingParty"": ""http://auth.xboxlive.com"",
|
||||
""TokenType"": ""JWT""
|
||||
}"
|
||||
Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
|
||||
Content:=Request, ContentType:="application/json", RequireJson:=True)
|
||||
Return GetJson(Result)("Token").ToString
|
||||
Return NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
|
||||
Content:=Request, ContentType:="application/json", RequireJson:=True).DeserializeJson()("Token").ToString
|
||||
End Function
|
||||
'微软登录步骤 3：从 XBLToken 获取 {XSTSToken, UHS}
|
||||
Private Function MsLoginStep3(XBLToken As String) As (XSTSToken As String, UHS As String)
|
||||
@@ -970,15 +970,15 @@ Retry:
|
||||
'参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
|
||||
If ex.Response.Contains("2148916227") Then
|
||||
MyMsgBox("该账号似乎已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
ElseIf ex.Response.Contains("2148916233") Then
|
||||
If MyMsgBox("你尚未注册 Xbox 账户，请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then
|
||||
OpenWebsite("https://signup.live.com/signup")
|
||||
End If
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
ElseIf ex.Response.Contains("2148916235") Then
|
||||
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN，然后再试。", "登录失败", "我知道了")
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
ElseIf ex.Response.Contains("2148916238") Then
|
||||
If MyMsgBox("该账号年龄不足，你需要先修改出生日期，然后才能登录。" & vbCrLf &
|
||||
"该账号目前填写的年龄是否在 13 岁以上？", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
|
||||
@@ -990,13 +990,13 @@ Retry:
|
||||
MyMsgBox("请根据打开的网页的说明，修改账号的出生日期（至少改为 18 岁以上）。" & vbCrLf &
|
||||
"在修改成功后等待一分钟，然后再回到 PCL，就可以正常登录了！", "登录提示")
|
||||
End If
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
Else
|
||||
Throw
|
||||
End If
|
||||
End Try
|
||||
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Dim ResultJson As JObject = Result.DeserializeJson()
|
||||
Return (
|
||||
ResultJson("Token").ToString(), 'XSTSToken
|
||||
ResultJson("DisplayClaims")("xui")(0)("uhs").ToString() 'UHS
|
||||
@@ -1018,15 +1018,18 @@ Retry:
|
||||
ElseIf ex.StatusCode = HttpStatusCode.Forbidden Then
|
||||
Logger.Warn(ex, "微软登录第 4 步汇报 403")
|
||||
Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器，请把它们关掉或更换节点后再试！")
|
||||
ElseIf ex.StatusCode = HttpStatusCode.ServiceUnavailable Then
|
||||
Logger.Warn(ex, "微软登录第 4 步汇报 503")
|
||||
Throw New Exception("$Mojang 服务器出现问题，请稍后再试。" & vbCrLf & "你的网络是正常的，PCL 也是正常的，是 Mojang 出问题了……")
|
||||
ElseIf ex.Response?.Contains("ACCOUNT_SUSPENDED") Then '#8655
|
||||
MyMsgBox("该账号似乎已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
Else
|
||||
Throw
|
||||
End If
|
||||
End Try
|
||||
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Dim ResultJson As JObject = Result.DeserializeJson()
|
||||
Return (
|
||||
ResultJson("access_token").ToString,
|
||||
ResultJson("expires_in").ToObject(Of Integer) + GetUnixTimestampUtc() - 1200) '提前 20 分钟视作过期
|
||||
@@ -1038,13 +1041,13 @@ Retry:
|
||||
Dim Result As String = NetRequestByClientMultiple("https://api.minecraftservices.com/entitlements/mcstore",
|
||||
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
|
||||
Try
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Dim ResultJson As JObject = Result.DeserializeJson()
|
||||
If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
|
||||
Select Case MyMsgBox("你尚未购买正版 Minecraft，或者 Xbox Game Pass 已到期。", "登录失败", "购买 Minecraft", "取消")
|
||||
Case 1
|
||||
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
|
||||
End Select
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, $"微软登录第 5 步异常：{Result}")
|
||||
@@ -1073,12 +1076,12 @@ Retry:
|
||||
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
|
||||
End Select
|
||||
End Sub, "Login Failed: Create Profile")
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
Case Else
|
||||
Throw
|
||||
End Select
|
||||
End Try
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Dim ResultJson As JObject = Result.DeserializeJson()
|
||||
Dim UUID As String = ResultJson("id").ToString
|
||||
Dim UserName As String = ResultJson("name").ToString
|
||||
Return (UUID, UserName, Result)
|
||||
@@ -1131,7 +1134,7 @@ Retry:
|
||||
If Len(Uuid) = 32 Then Return Uuid
|
||||
'从官网获取
|
||||
Try
|
||||
Dim GotJson As JObject = GetJson(NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, RequireJson:=True))
|
||||
Dim GotJson As JObject = NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, RequireJson:=True).DeserializeJson()
|
||||
If GotJson Is Nothing Then Throw New FileNotFoundException("正版玩家档案不存在（" & Name & "）")
|
||||
Uuid = If(GotJson("id"), "")
|
||||
Catch ex As Exception
|
||||
@@ -1156,183 +1159,16 @@ Retry:
|
||||
|
||||
#Region "Java 处理"
|
||||
|
||||
Public McLaunchJavaSelected As JavaEntry = Nothing
|
||||
Public McLaunchJavaSelected As Java = Nothing
|
||||
Private Sub McLaunchJava(Task As LoaderTask(Of Integer, Integer))
|
||||
Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
|
||||
|
||||
'原版 26-：通过版本号判断
|
||||
If (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2024, 4, 2)) OrElse
|
||||
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla >= New Version(20, 0, 5)) Then
|
||||
'1.20.5+（24w14a+）：至少 Java 21
|
||||
MinVer = New Version(1, 21, 0, 0)
|
||||
ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 11, 16)) OrElse
|
||||
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 18) Then
|
||||
'1.18 pre2+：至少 Java 17
|
||||
MinVer = New Version(1, 17, 0, 0)
|
||||
ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 5, 11)) OrElse
|
||||
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 17) Then
|
||||
'1.17+ (21w19a+)：至少 Java 16
|
||||
MinVer = New Version(1, 16, 0, 0)
|
||||
ElseIf McInstanceSelected.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年，太棒了
|
||||
'1.12+：至少 Java 8
|
||||
MinVer = New Version(1, 8, 0, 0)
|
||||
ElseIf McInstanceSelected.ReleaseTime <= New Date(2013, 5, 1) AndAlso McInstanceSelected.ReleaseTime.Year >= 2001 Then '避免某些版本写个 1960 年
|
||||
'1.5.2-：最高 Java 8
|
||||
MaxVer = New Version(1, 8, 999, 999)
|
||||
McLaunchJavaSelected = SelectOrDownloadJava(McInstanceSelected, True, Task.CreateCancellationToken, Task.CreateSyncProgressProvider)
|
||||
If Task.IsCanceled Then Return
|
||||
If McLaunchJavaSelected Is Nothing Then Throw New OperationCanceledException 'SelectOrDownloadJava 已经会给予适当的提示
|
||||
If ModeDebug Then
|
||||
McLaunchLog($"预期 Java 版本范围：{GetJavaRequirement(McInstanceSelected).Range}")
|
||||
McLaunchLog($"Java 版本设置类别：{Settings.Get(Of Integer)("VersionArgumentJavaV2", McInstanceSelected)}")
|
||||
End If
|
||||
|
||||
'原版 26+：获取 Mojang 要求的 Java 版本
|
||||
Dim RecommendedComponent As String = Nothing
|
||||
Dim RecommendedCode As Integer =
|
||||
If(McInstanceSelected.JsonObject?("javaVersion")?("majorVersion")?.ToObject(Of Integer),
|
||||
If(McInstanceSelected.JsonVersion?("java_version")?.ToObject(Of Integer), 0))
|
||||
If RecommendedCode >= 22 Then
|
||||
McLaunchLog("Mojang 要求至少使用 Java " & RecommendedCode)
|
||||
MinVer = New Version(1, RecommendedCode, 0, 0)
|
||||
RecommendedComponent =
|
||||
If(McInstanceSelected.JsonObject?("javaVersion")?("component")?.ToString,
|
||||
McInstanceSelected.JsonVersion?("java_component")?.ToString)
|
||||
If RecommendedComponent = "" Then RecommendedComponent = Nothing
|
||||
End If
|
||||
|
||||
'OptiFine 检测
|
||||
If McInstanceSelected.Version.HasOptiFine AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
|
||||
If McInstanceSelected.Version.Vanilla.Major < 7 Then
|
||||
'<1.7：至多 Java 8
|
||||
MaxVer = New Version(1, 8, 999, 999)
|
||||
ElseIf McInstanceSelected.Version.Vanilla.Major >= 8 AndAlso McInstanceSelected.Version.Vanilla.Major < 12 Then
|
||||
'1.8 - 1.11：必须恰好 Java 8
|
||||
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999)
|
||||
ElseIf McInstanceSelected.Version.Vanilla.Major = 12 Then
|
||||
'1.12：最高 Java 8
|
||||
MaxVer = New Version(1, 8, 999, 999)
|
||||
End If
|
||||
End If
|
||||
|
||||
'Forge 检测（部分测试结果见 #8432）
|
||||
If McInstanceSelected.Version.HasForge Then
|
||||
If McInstanceSelected.Version.Vanilla >= New Version(6, 0, 1) AndAlso McInstanceSelected.Version.Vanilla <= New Version(7, 0, 2) Then
|
||||
'1.6.1 - 1.7.2：必须 Java 7
|
||||
MinVer = If(New Version(1, 7, 0, 0) > MinVer, New Version(1, 7, 0, 0), MinVer)
|
||||
MaxVer = If(New Version(1, 7, 999, 999) < MaxVer, New Version(1, 7, 999, 999), MaxVer)
|
||||
ElseIf McInstanceSelected.Version.Vanilla.Major <= 12 OrElse Not McInstanceSelected.Version.Vaild Then '非标准版本
|
||||
'<=1.12：Java 8
|
||||
MaxVer = New Version(1, 8, 999, 999)
|
||||
ElseIf McInstanceSelected.Version.Vanilla.Major <= 14 Then
|
||||
'1.13 - 1.14：Java 8 - 10
|
||||
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
|
||||
MaxVer = If(New Version(1, 10, 999, 999) < MaxVer, New Version(1, 10, 999, 999), MaxVer)
|
||||
ElseIf McInstanceSelected.Version.Vanilla.Major = 15 Then
|
||||
'1.15：Java 8 - 15
|
||||
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
|
||||
MaxVer = If(New Version(1, 15, 999, 999) < MaxVer, New Version(1, 15, 999, 999), MaxVer)
|
||||
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "34.0.0") AndAlso CompareVersionGE("36.2.25", McInstanceSelected.Version.Forge) Then
|
||||
'1.16.3~5，Forge 34.0.0 ~ 36.2.25：最高 Java 8u320
|
||||
MaxVer = If(New Version(1, 8, 0, 320) < MaxVer, New Version(1, 8, 0, 320), MaxVer)
|
||||
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "36.2.26") AndAlso CompareVersionGE("36.999.999", McInstanceSelected.Version.Forge) Then
|
||||
'1.16.5，Forge 36.2.26+，<37.0.0：最高 Java 23
|
||||
MaxVer = If(New Version(1, 23, 999, 999) < MaxVer, New Version(1, 23, 999, 999), MaxVer)
|
||||
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "37.0.0") AndAlso CompareVersionGE("37.0.79", McInstanceSelected.Version.Forge) Then
|
||||
'1.17.1，Forge 37.0.0 ~ 37.0.79：最高 Java 16
|
||||
MaxVer = If(New Version(1, 16, 999, 999) < MaxVer, New Version(1, 16, 999, 999), MaxVer)
|
||||
ElseIf McInstanceSelected.Version.Vanilla.Major = 18 AndAlso McInstanceSelected.Version.HasOptiFine Then '#305
|
||||
'1.18：若安装了 OptiFine，最高 Java 18
|
||||
MaxVer = If(New Version(1, 18, 999, 999) < MaxVer, New Version(1, 18, 999, 999), MaxVer)
|
||||
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "45.0.21") AndAlso CompareVersionGE("45.0.65", McInstanceSelected.Version.Forge) Then
|
||||
'1.19.4，Forge 45.0.21 ~ 45.0.65：最高 Java 19
|
||||
MaxVer = If(New Version(1, 19, 999, 999) < MaxVer, New Version(1, 19, 999, 999), MaxVer)
|
||||
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "45.0.66") AndAlso CompareVersionGE("47.4.8", McInstanceSelected.Version.Forge) Then
|
||||
'1.19.4~1.20.1，Forge 45.0.66 ~ 47.4.8：最高 Java 21
|
||||
MaxVer = If(New Version(1, 21, 999, 999) < MaxVer, New Version(1, 21, 999, 999), MaxVer)
|
||||
End If
|
||||
End If
|
||||
|
||||
'NeoForge 检测
|
||||
If McInstanceSelected.Version.HasNeoForge Then
|
||||
If McInstanceSelected.Version.Vanilla = New Version(20, 0, 1) OrElse
|
||||
(CompareVersionGE("20.2.62-beta", McInstanceSelected.Version.NeoForge) AndAlso Not McInstanceSelected.Version.NeoForge.Contains("25w14craftmine")) Then
|
||||
'1.20.1，以及 1.20.2 的 20.2.62-beta 之前：最高 Java 21
|
||||
MaxVer = If(New Version(1, 21, 999, 999) < MaxVer, New Version(1, 21, 999, 999), MaxVer)
|
||||
End If
|
||||
End If
|
||||
|
||||
'Fabric 检测
|
||||
If McInstanceSelected.Version.HasFabric AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
|
||||
If McInstanceSelected.Version.Vanilla.Major >= 15 AndAlso McInstanceSelected.Version.Vanilla.Major <= 16 Then
|
||||
'1.15 - 1.16：Java 8+
|
||||
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
|
||||
ElseIf McInstanceSelected.Version.Vanilla.Major >= 18 Then
|
||||
'1.18+：Java 17+
|
||||
MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer)
|
||||
End If
|
||||
End If
|
||||
|
||||
'LiteLoader 检测
|
||||
If McInstanceSelected.Version.HasLiteLoader AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
|
||||
'最高 Java 8
|
||||
MaxVer = If(New Version(1, 8, 999, 999) < MaxVer, New Version(1, 8, 999, 999), MaxVer)
|
||||
End If
|
||||
|
||||
'统一通行证检测
|
||||
If Settings.Get(Of McLoginType)("LoginType") = McLoginType.Nide Then
|
||||
'至少 Java 8u101
|
||||
MinVer = If(New Version(1, 8, 0, 141) > MinVer, New Version(1, 8, 0, 141), MinVer)
|
||||
End If
|
||||
|
||||
SyncLock JavaLock
|
||||
|
||||
'选择 Java
|
||||
McLaunchLog("Java 版本需求：最低 " & MinVer.ToString & "，最高 " & MaxVer.ToString)
|
||||
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
|
||||
If Task.IsInterrupted Then Return
|
||||
If McLaunchJavaSelected IsNot Nothing Then
|
||||
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
|
||||
Return
|
||||
End If
|
||||
|
||||
'无合适的 Java
|
||||
If Task.IsInterrupted Then Return '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java
|
||||
McLaunchLog("无合适的 Java，准备自动下载")
|
||||
Dim JavaCode As String
|
||||
If MinVer >= New Version(1, 9) Then
|
||||
JavaCode = MinVer.Minor
|
||||
ElseIf MaxVer < New Version(1, 8) Then
|
||||
MyMsgBox($"你需要安装 Java 7 才能启动该版本。{vbCrLf}请自行搜索并安装 Java 7，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
|
||||
Throw New Exception("$$")
|
||||
ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
|
||||
MyMsgBox($"你需要安装 Java 8u141 ~ 8u320 才能启动该版本。{vbCrLf}请自行搜索并安装，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
|
||||
Throw New Exception("$$")
|
||||
ElseIf MinVer > New Version(1, 8, 0, 140) Then
|
||||
MyMsgBox($"你需要安装 Java 8u141 或更高版本的 Java 8 才能启动该版本。{vbCrLf}请自行搜索并安装，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
|
||||
Throw New Exception("$$")
|
||||
Else
|
||||
JavaCode = 8
|
||||
End If
|
||||
|
||||
'开始自动下载
|
||||
Dim JavaLoader = GetJavaDownloadLoader()
|
||||
Try
|
||||
JavaLoader.Start(If(RecommendedComponent, JavaCode), IsForceRestart:=True) '在 Java 22+ 时优先使用 Mojang 提供的 Component 字段
|
||||
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsInterrupted
|
||||
Task.Progress = JavaLoader.Progress
|
||||
Thread.Sleep(10)
|
||||
Loop
|
||||
Finally
|
||||
JavaLoader.Interrupt() '确保取消时中止 Java 下载
|
||||
End Try
|
||||
|
||||
'检查下载结果
|
||||
If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872#
|
||||
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
|
||||
If Task.IsInterrupted Then Return
|
||||
If McLaunchJavaSelected IsNot Nothing Then
|
||||
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
|
||||
Else
|
||||
Hint("没有可用的 Java，已取消启动！", HintType.Red)
|
||||
Throw New Exception("$$")
|
||||
End If
|
||||
|
||||
End SyncLock
|
||||
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
@@ -1427,7 +1263,7 @@ NextInstance:
|
||||
End If
|
||||
'Authlib-Injector
|
||||
If McLoginLoader.Output.Type = "Auth" Then
|
||||
If McLaunchJavaSelected.MajorVersion >= 6 Then Args.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
|
||||
If McLaunchJavaSelected.Version.Major >= 6 Then Args.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
|
||||
Dim Server As String = Settings.Get(Of String)("VersionServerAuthServer", Instance:=McInstanceSelected)
|
||||
Try
|
||||
McLaunchLog($"开始 Authlib Injector Prefetch")
|
||||
@@ -1444,13 +1280,13 @@ NextInstance:
|
||||
'非 GBK 编码下命令行参数乱码的问题（JDK-8272352）
|
||||
Dim UseJLW As Boolean =
|
||||
Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableJLW", McInstanceSelected) AndAlso
|
||||
Not IsGBKEncoding AndAlso Not McFolderSelected.IsAsciiOnly() '仅在该环境下才会触发该 Bug
|
||||
Not IsGBKEncoding '即使游戏文件夹名称不含非 ASCII 字符，但玩家名等也可能出现中文，因此依然需要 JLW（#8739）
|
||||
If UseJLW AndAlso CustomArg.Contains("-javaagent") Then
|
||||
UseJLW = False
|
||||
McLaunchLog("由于使用了自定义 javaagent，已禁用 JLW，这可能导致游戏崩溃！", LogLevel.Warn)
|
||||
End If
|
||||
If UseJLW Then
|
||||
If McLaunchJavaSelected.MajorVersion >= 9 Then
|
||||
If McLaunchJavaSelected.Version.Major >= 9 Then
|
||||
Args.Add("--add-exports") : Args.Add("cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
|
||||
End If
|
||||
Args.Add("-Doolloo.jlw.tmpdir=${pure_directory}") '这里需要不以 \ 结尾
|
||||
@@ -1467,7 +1303,7 @@ NextInstance:
|
||||
#Region "内存管理"
|
||||
|
||||
McLaunchLog("当前剩余内存：" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
|
||||
Dim TargetRam As Integer = Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024)
|
||||
Dim TargetRam As Integer = Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected) * 1024)
|
||||
Args.Add("-Xmx" & TargetRam & "m")
|
||||
|
||||
'获取设置的管理方式
|
||||
@@ -1480,17 +1316,17 @@ NextInstance:
|
||||
If SetupType <> 3 Then
|
||||
'确定是使用 G1GC 还是 ZGC
|
||||
Dim UseG1GC As Boolean = False
|
||||
If (SetupType = 0 AndAlso McLaunchJavaSelected.MajorVersion < 15) OrElse
|
||||
(SetupType = 1 AndAlso McLaunchJavaSelected.MajorVersion < 21) OrElse
|
||||
If (SetupType = 0 AndAlso McLaunchJavaSelected.Version.Major < 15) OrElse
|
||||
(SetupType = 1 AndAlso McLaunchJavaSelected.Version.Major < 21) OrElse
|
||||
(SetupType = 2 OrElse SetupType = 4) Then UseG1GC = True '检查 Java 版本，ZGC 在 Java 15+ 可用，分代 ZGC 在 Java 21+ 可用
|
||||
If Is32BitSystem OrElse Environment.OSVersion.Version.Major < 10 OrElse Environment.OSVersion.Version.Build < 17763 Then UseG1GC = True '检查系统兼容性，ZGC 需要 Windows 10 1809+
|
||||
McLaunchLog($"GC 设置：{SetupType}，选取 {If(UseG1GC, "G1GC", "ZGC")}，Java 版本：{McLaunchJavaSelected.MajorVersion}")
|
||||
If Environment.OSVersion.Version.Major < 10 OrElse Environment.OSVersion.Version.Build < 17763 Then UseG1GC = True '检查系统兼容性，ZGC 需要 Windows 10 1809+
|
||||
McLaunchLog($"GC 设置：{SetupType}，选取 {If(UseG1GC, "G1GC", "ZGC")}，Java 版本：{McLaunchJavaSelected.Version.Major}")
|
||||
'移除已有的 GC 参数
|
||||
Args = Args.Where(Function(a) Not a.RegexCheck(
|
||||
"( )*-XX:[+-]?(Use\w+GC|ZGenerational|UseCompactObjectHeaders|G1\w+Percent|G1\w+Size|(Max|Min)(GCPauseMillis|HeapFreeRatio))")).ToList
|
||||
'添加 GC 参数
|
||||
Args.Add("-XX:+UnlockExperimentalVMOptions")
|
||||
If McLaunchJavaSelected.MajorVersion >= 24 AndAlso McLaunchJavaSelected.Is64Bit Then Args.Add("-XX:+UseCompactObjectHeaders")
|
||||
If McLaunchJavaSelected.Version.Major >= 24 Then Args.Add("-XX:+UseCompactObjectHeaders")
|
||||
If UseG1GC AndAlso SetupType = 4 Then
|
||||
'优化的 G1GC
|
||||
Args.Add("-XX:+UseG1GC")
|
||||
@@ -1499,10 +1335,10 @@ NextInstance:
|
||||
Args.Add("-XX:G1HeapRegionSize=32M")
|
||||
Args.Add("-XX:MaxGCPauseMillis=50")
|
||||
If Not ModeDebug Then Args.Add("-XX:+PerfDisableSharedMem")
|
||||
If McLaunchJavaSelected.MajorVersion <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
|
||||
If McLaunchJavaSelected.MajorVersion = 8 Then Args.Add("-XX:+ParallelRefProcEnabled")
|
||||
If McLaunchJavaSelected.MajorVersion >= 12 Then Args.Add("-XX:MinHeapFreeRatio=25") '需要比 G1NewSizePercent 大一点
|
||||
If McLaunchJavaSelected.MajorVersion >= 12 Then Args.Add("-XX:MaxHeapFreeRatio=40") '需要比 MinHeapFreeRatio 大一些
|
||||
If McLaunchJavaSelected.Version.Major <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
|
||||
If McLaunchJavaSelected.Version.Major = 8 Then Args.Add("-XX:+ParallelRefProcEnabled")
|
||||
If McLaunchJavaSelected.Version.Major >= 12 Then Args.Add("-XX:MinHeapFreeRatio=25") '需要比 G1NewSizePercent 大一点
|
||||
If McLaunchJavaSelected.Version.Major >= 12 Then Args.Add("-XX:MaxHeapFreeRatio=40") '需要比 MinHeapFreeRatio 大一些
|
||||
ElseIf UseG1GC Then
|
||||
'Mojang G1GC
|
||||
Args.Add("-XX:+UseG1GC")
|
||||
@@ -1510,11 +1346,11 @@ NextInstance:
|
||||
Args.Add("-XX:G1ReservePercent=20")
|
||||
Args.Add("-XX:G1HeapRegionSize=32M")
|
||||
Args.Add("-XX:MaxGCPauseMillis=50")
|
||||
If McLaunchJavaSelected.MajorVersion <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
|
||||
If McLaunchJavaSelected.Version.Major <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
|
||||
Else
|
||||
'ZGC
|
||||
Args.Add("-XX:+UseZGC")
|
||||
If McLaunchJavaSelected.MajorVersion = 21 OrElse McLaunchJavaSelected.MajorVersion = 22 Then Args.Add("-XX:+ZGenerational") 'Java 23 起默认启用分代 ZGC，不需要再添加参数
|
||||
If McLaunchJavaSelected.Version.Major = 21 OrElse McLaunchJavaSelected.Version.Major = 22 Then Args.Add("-XX:+ZGenerational") 'Java 23 起默认启用分代 ZGC，不需要再添加参数
|
||||
End If
|
||||
End If
|
||||
|
||||
@@ -1526,9 +1362,9 @@ NextInstance:
|
||||
Args.Add("-Dlog4j2.formatMsgNoLookups=true")
|
||||
|
||||
'编码（#4700、#5892、#5909）
|
||||
If McLaunchJavaSelected.MajorVersion > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstdout.encoding=")) Then Args.Add("-Dstdout.encoding=UTF-8")
|
||||
If McLaunchJavaSelected.MajorVersion > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstderr.encoding=")) Then Args.Add("-Dstderr.encoding=UTF-8")
|
||||
If McLaunchJavaSelected.MajorVersion >= 18 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dfile.encoding=")) Then Args.Add("-Dfile.encoding=COMPAT") 'Dfile.encoding 需要放在 Dstdout.encoding 后面（#6934）
|
||||
If McLaunchJavaSelected.Version.Major > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstdout.encoding=")) Then Args.Add("-Dstdout.encoding=UTF-8")
|
||||
If McLaunchJavaSelected.Version.Major > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstderr.encoding=")) Then Args.Add("-Dstderr.encoding=UTF-8")
|
||||
If McLaunchJavaSelected.Version.Major >= 18 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dfile.encoding=")) Then Args.Add("-Dfile.encoding=COMPAT") 'Dfile.encoding 需要放在 Dstdout.encoding 后面（#6934）
|
||||
|
||||
'为 JLW 添加 -jar，它必须放在最后
|
||||
If UseJLW Then
|
||||
@@ -1597,7 +1433,9 @@ NextInstance:
|
||||
McLaunchLog("发现错误的 OptiFineForge TweakClass，目前的游戏参数：" & Arg)
|
||||
Arg = Arg.Replace(" --tweakClass optifine.OptiFineTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker"
|
||||
Try
|
||||
FileUtils.Write(McInstanceSelected.GetJsonPath(), FileUtils.ReadAsString(McInstanceSelected.GetJsonPath()).Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
|
||||
FileUtils.Write(
|
||||
McInstanceSelected.GetJsonPath(),
|
||||
FileUtils.ReadAsString(McInstanceSelected.GetJsonPath()).Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "替换 OptiFineForge TweakClass 失败")
|
||||
End Try
|
||||
@@ -1690,9 +1528,9 @@ NextInstance:
|
||||
TargetSize = New Size(854, 480)
|
||||
End Select
|
||||
If McInstanceSelected.Version.Vanilla.Major <= 12 AndAlso
|
||||
McLaunchJavaSelected.MajorVersion <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
|
||||
McLaunchJavaSelected.Version >= New Version(8, 0, 200) AndAlso McLaunchJavaSelected.Version <= New Version(8, 0, 321) AndAlso
|
||||
Not McInstanceSelected.Version.HasOptiFine AndAlso Not McInstanceSelected.Version.HasForge Then '修复 1.12.2- 下 JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍（#3463）
|
||||
McLaunchLog($"已应用窗口大小过大修复（{McLaunchJavaSelected.Version.Revision}）")
|
||||
McLaunchLog($"已应用窗口大小过大修复（Java 版本：{McLaunchJavaSelected.Version}）")
|
||||
TargetSize.Width /= DPI / 96
|
||||
TargetSize.Height /= DPI / 96
|
||||
End If
|
||||
@@ -1843,7 +1681,7 @@ NextInstance:
|
||||
Next
|
||||
|
||||
'删除多余文件
|
||||
For Each FileName As String In DirectoryUtils.GetFiles(Target, True)
|
||||
For Each FileName As String In DirectoryUtils.EnumerateFiles(Target)
|
||||
If ExistFiles.Contains(FileName) Then Continue For
|
||||
Try
|
||||
McLaunchLog("删除：" & FileName)
|
||||
@@ -1862,7 +1700,7 @@ NextInstance:
|
||||
Private Function GetNativesFolder() As String
|
||||
Dim Result As String = PathUtils.AddSlashSuffix(PathUtils.ToShortPath(McInstanceSelected.PathVersion)) & McInstanceSelected.Name & "-natives\"
|
||||
If Not (IsGBKEncoding OrElse Result.IsAsciiOnly()) Then
|
||||
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives\"
|
||||
Result = Paths.AppData & ".minecraft\bin\natives\"
|
||||
If Not Result.IsAsciiOnly() Then
|
||||
Result = OsDrive & "ProgramData\PCL\natives\"
|
||||
End If
|
||||
@@ -1880,15 +1718,15 @@ NextInstance:
|
||||
'使用高性能显卡
|
||||
If Settings.Get(Of Boolean)("LaunchAdvanceGraphicCard") Then
|
||||
Try
|
||||
SetGPUPreference(McLaunchJavaSelected.PathJava)
|
||||
SetGPUPreference(McLaunchJavaSelected.JavaExePath)
|
||||
SetGPUPreference(PathExe)
|
||||
Catch ex As Exception
|
||||
If SystemUtils.HasAdminRole() Then
|
||||
If WindowsUtils.HasAdminRole() Then
|
||||
Logger.Warn(ex, "直接调整显卡设置失败")
|
||||
Else
|
||||
Logger.Warn(ex, "直接调整显卡设置失败，将以管理员权限重启 PCL 再次尝试")
|
||||
Try
|
||||
If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJava}""") = ProcessReturnValues.TaskDone Then
|
||||
If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.JavaExePath}""") = ProcessReturnValues.TaskDone Then
|
||||
McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功")
|
||||
Else
|
||||
Throw New Exception("调整过程中出现异常")
|
||||
@@ -1924,9 +1762,9 @@ NextInstance:
|
||||
""profile"": ""66666555554444433333222221111100""
|
||||
}
|
||||
}"
|
||||
Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
|
||||
Dim ReplaceJson As JObject = (ReplaceJsonString).DeserializeJson()
|
||||
'更新文件
|
||||
Dim Profiles As JObject = GetJson(FileUtils.ReadAsString(McFolderSelected & "launcher_profiles.json"))
|
||||
Dim Profiles As JObject = FileUtils.ReadAsJson(McFolderSelected & "launcher_profiles.json")
|
||||
Profiles.Merge(ReplaceJson)
|
||||
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
|
||||
McLaunchLog("已更新 launcher_profiles.json")
|
||||
@@ -1954,9 +1792,9 @@ NextInstance:
|
||||
""profile"": ""66666555554444433333222221111100""
|
||||
}
|
||||
}"
|
||||
Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
|
||||
Dim ReplaceJson As JObject = ReplaceJsonString.DeserializeJson()
|
||||
'更新文件
|
||||
Dim Profiles As JObject = GetJson(FileUtils.ReadAsString(McFolderSelected & "launcher_profiles.json"))
|
||||
Dim Profiles As JObject = FileUtils.ReadAsJson(McFolderSelected & "launcher_profiles.json")
|
||||
Profiles.Merge(ReplaceJson)
|
||||
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
|
||||
McLaunchLog("已在删除后更新 launcher_profiles.json")
|
||||
@@ -2026,7 +1864,7 @@ NextInstance:
|
||||
Try
|
||||
Dim ZipFileAddress As String = McInstanceSelected.PathIndie & "resourcepacks\PCL2 Skin.zip"
|
||||
Dim NewTypeSetup As Boolean = McInstanceSelected.Version.Vanilla.Major >= 13 OrElse McInstanceSelected.Version.Vanilla.Major < 6
|
||||
If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Settings.Get(Of Integer)("LaunchSkinType") = 4 AndAlso FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
|
||||
If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Settings.Get(Of Integer)("LaunchSkinType") = 4 AndAlso FileUtils.Exists(Paths.AppDataThenName & "CustomSkin.png") Then
|
||||
Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
|
||||
Dim PackPicAddress As String = PathTemp & "pack.png"
|
||||
Dim PackFormat As Integer
|
||||
@@ -2076,12 +1914,12 @@ NextInstance:
|
||||
Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png")
|
||||
Bit.Save(PackPicAddress)
|
||||
FileUtils.Write(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
|
||||
Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png")
|
||||
Dim Skin As New MyBitmap(Paths.AppDataThenName & "CustomSkin.png")
|
||||
If (McInstanceSelected.Version.Vanilla.Major = 6 OrElse McInstanceSelected.Version.Vanilla.Major = 7) AndAlso Skin.Pic.Height = 64 Then
|
||||
McLaunchLog("该 Minecraft 版本不支持双层皮肤，已进行裁剪")
|
||||
Skin = Skin.Clip(0, 0, 64, 32)
|
||||
End If
|
||||
Skin.Save(PathExeFolder & "PCL\CustomSkin_Cliped.png")
|
||||
Skin.Save(Paths.Base & "PCL\CustomSkin_Cliped.png")
|
||||
'构建压缩文件
|
||||
Dim FilesToCompress As New Dictionary(Of String, String) From {
|
||||
{"pack.mcmeta", MetaFileAddress}, {"pack.png", PackPicAddress}}
|
||||
@@ -2090,15 +1928,15 @@ NextInstance:
|
||||
For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
|
||||
FilesToCompress.Add(
|
||||
$"assets/minecraft/textures/entity/player/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png",
|
||||
PathExeFolder & "PCL\CustomSkin_Cliped.png")
|
||||
Paths.Base & "PCL\CustomSkin_Cliped.png")
|
||||
Next
|
||||
Else
|
||||
FilesToCompress.Add(
|
||||
$"assets/minecraft/textures/entity/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "alex.png", "steve.png")}",
|
||||
PathExeFolder & "PCL\CustomSkin_Cliped.png")
|
||||
Paths.Base & "PCL\CustomSkin_Cliped.png")
|
||||
End If
|
||||
FileUtils.CreateZipFromFiles(ZipFileAddress, FilesToCompress)
|
||||
FileUtils.Delete(PathExeFolder & "PCL\CustomSkin_Cliped.png")
|
||||
FileUtils.Delete(Paths.Base & "PCL\CustomSkin_Cliped.png")
|
||||
'更改设置文件
|
||||
IniClearCache(SetupFileAddress)
|
||||
Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
|
||||
@@ -2159,25 +1997,25 @@ IgnoreCustomSkin:
|
||||
'输出 bat
|
||||
Try
|
||||
Dim CmdString As String =
|
||||
$"{If(McLaunchJavaSelected.MajorVersion > 8, "chcp 65001>nul" & vbCrLf, "")}" &
|
||||
$"{If(McLaunchJavaSelected.Version.Major > 8, "chcp 65001>nul" & vbCrLf, "")}" &
|
||||
"@echo off" & vbCrLf &
|
||||
$"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
|
||||
"echo 游戏正在启动，请稍候。" & vbCrLf &
|
||||
$"cd /D ""{PathUtils.ToShortPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
|
||||
CustomCommandGlobal & vbCrLf &
|
||||
CustomCommandVersion & vbCrLf &
|
||||
$"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf &
|
||||
$"""{McLaunchJavaSelected.JavaExePath}"" {McLaunchArgument}" & vbCrLf &
|
||||
"echo 游戏已退出。" & vbCrLf &
|
||||
"pause"
|
||||
FileUtils.Write(
|
||||
filePath:=If(CurrentLaunchOptions.SaveBatch, PathExeFolder & "PCL\LatestLaunch.bat"),
|
||||
filePath:=If(CurrentLaunchOptions.SaveBatch, Paths.Base & "PCL\LatestLaunch.bat"),
|
||||
text:=FilterAccessToken(CmdString, "F").Replace("%", "%%"),
|
||||
encoding:=If(McLaunchJavaSelected.MajorVersion > 8, Encoding.UTF8, Encoding.Default))
|
||||
encoding:=If(McLaunchJavaSelected.Version.Major > 8, Encoding.UTF8, Encoding.Default))
|
||||
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
|
||||
McLaunchLog("导出启动脚本完成，强制结束启动过程")
|
||||
InterruptHint = "导出启动脚本成功！"
|
||||
CanceledHint = "导出启动脚本成功！"
|
||||
OpenExplorer(CurrentLaunchOptions.SaveBatch)
|
||||
Loader.Parent.Interrupt()
|
||||
Loader.Parent.Cancel()
|
||||
Return '导出脚本完成
|
||||
End If
|
||||
Catch ex As Exception
|
||||
@@ -2198,14 +2036,14 @@ IgnoreCustomSkin:
|
||||
.CreateNoWindow = True
|
||||
})
|
||||
If Settings.Get(Of Boolean)("LaunchAdvanceRunWait") Then
|
||||
Do Until CustomProcess.HasExited OrElse Loader.IsInterrupted
|
||||
Do Until CustomProcess.HasExited OrElse Loader.IsCanceled
|
||||
Thread.Sleep(10)
|
||||
Loop
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Logger.Error(ex, "执行全局自定义命令失败", LogBehavior.Toast)
|
||||
Finally
|
||||
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
|
||||
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsCanceled Then
|
||||
McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
|
||||
CustomProcess.Kill()
|
||||
End If
|
||||
@@ -2223,14 +2061,14 @@ IgnoreCustomSkin:
|
||||
.CreateNoWindow = True
|
||||
})
|
||||
If Settings.Get(Of Boolean)("VersionAdvanceRunWait", Instance:=McInstanceSelected) Then
|
||||
Do Until CustomProcess.HasExited OrElse Loader.IsInterrupted
|
||||
Do Until CustomProcess.HasExited OrElse Loader.IsCanceled
|
||||
Thread.Sleep(10)
|
||||
Loop
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Logger.Error(ex, "执行版本自定义命令失败", LogBehavior.Toast)
|
||||
Finally
|
||||
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
|
||||
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsCanceled Then
|
||||
McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
|
||||
CustomProcess.Kill()
|
||||
End If
|
||||
@@ -2241,13 +2079,13 @@ IgnoreCustomSkin:
|
||||
Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process))
|
||||
|
||||
'启动信息
|
||||
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJava) '使用 javaw.exe 会导致 #6263
|
||||
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.JavaExePath) '使用 javaw.exe 会导致 #6263
|
||||
|
||||
'设置环境变量
|
||||
Dim PathEnv As String = StartInfo.EnvironmentVariables("Path")
|
||||
Dim Paths As New List(Of String)
|
||||
If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
|
||||
Paths.Add(PathUtils.ToShortPath(McLaunchJavaSelected.PathFolder))
|
||||
Paths.Add(PathUtils.ToShortPath(McLaunchJavaSelected.Folder))
|
||||
StartInfo.EnvironmentVariables("Path") = Paths.Distinct.Join(";"c)
|
||||
StartInfo.EnvironmentVariables("appdata") = PathUtils.ToShortPath(McFolderSelected)
|
||||
|
||||
@@ -2261,8 +2099,8 @@ IgnoreCustomSkin:
|
||||
|
||||
'开始进程
|
||||
Dim GameProcess = StartProcess(StartInfo)
|
||||
McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.PathJava)
|
||||
If Loader.IsInterrupted Then
|
||||
McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.JavaExePath)
|
||||
If Loader.IsCanceled Then
|
||||
McLaunchLog("由于取消启动，已强制结束游戏进程") '#1631
|
||||
GameProcess.Kill()
|
||||
Return
|
||||
@@ -2294,13 +2132,12 @@ IgnoreCustomSkin:
|
||||
McLaunchLog($"游戏版本：{McInstanceSelected.VersionDisplayName}（{McInstanceSelected.Version.Vanilla}，Drop {McInstanceSelected.Version.Drop}{If(McInstanceSelected.Version.Reliable, "", "，无法完全确定")}）")
|
||||
McLaunchLog("资源版本：" & McAssetsGetIndexName(McInstanceSelected))
|
||||
McLaunchLog("版本继承：" & If(McInstanceSelected.InheritName = "", "无", McInstanceSelected.InheritName))
|
||||
McLaunchLog("分配的内存：" & PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) & " GB（" & Math.Round(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB）")
|
||||
McLaunchLog("分配的内存：" & PageInstanceSetup.GetRam(McInstanceSelected) & " GB（" & Math.Round(PageInstanceSetup.GetRam(McInstanceSelected) * 1024) & " MB）")
|
||||
McLaunchLog("MC 文件夹：" & McFolderSelected)
|
||||
McLaunchLog("版本文件夹：" & McInstanceSelected.PathVersion)
|
||||
McLaunchLog("版本隔离：" & (McInstanceSelected.PathIndie = McInstanceSelected.PathVersion))
|
||||
McLaunchLog("HMCL 格式：" & McInstanceSelected.IsHmclFormatJson)
|
||||
McLaunchLog("Java 信息：" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
|
||||
McLaunchLog("环境变量：" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置"))
|
||||
McLaunchLog("Natives 文件夹：" & GetNativesFolder())
|
||||
McLaunchLog("")
|
||||
McLaunchLog("~ 登录参数 ~")
|
||||
@@ -2325,7 +2162,7 @@ IgnoreCustomSkin:
|
||||
Thread.Sleep(100)
|
||||
Loop
|
||||
If Watcher.State = Watcher.MinecraftState.Crashed Then
|
||||
Throw New Exception("$$")
|
||||
Throw New OperationCanceledException
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Module ModMinecraft
|
||||
Public Module ModMinecraft
|
||||
|
||||
#Region "文件夹"
|
||||
|
||||
@@ -16,9 +16,9 @@
|
||||
End Property
|
||||
Private Sub SetMcFolder(Value As String) '等同 McFolderSelected.Set
|
||||
If _McFolderSelected = Value Then Return
|
||||
_McFolderSelected = Value.Replace("$", PathExeFolder)
|
||||
_McFolderSelected = Value.Replace("$", Paths.Base)
|
||||
_McFolderSelected = PathUtils.AddSlashSuffix(PathUtils.ForCompare(_McFolderSelected))
|
||||
Settings.Set("LaunchFolderSelect", Value.Replace(PathExeFolder, "$"))
|
||||
Settings.Set("LaunchFolderSelect", Value.Replace(Paths.Base, "$"))
|
||||
Logger.Info($"当前选择的 Minecraft 文件夹：{_McFolderSelected}")
|
||||
End Sub
|
||||
Private _McFolderSelected As String
|
||||
@@ -64,8 +64,8 @@
|
||||
|
||||
'扫描当前文件夹
|
||||
Try
|
||||
If DirectoryUtils.Exists(PathExeFolder & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder, .Type = McFolder.Types.Vanilla})
|
||||
For Each Folder As DirectoryInfo In DirectoryUtils.GetInfo(PathExeFolder).GetDirectories
|
||||
If DirectoryUtils.Exists(Paths.Base & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Paths.Base, .Type = McFolder.Types.Vanilla})
|
||||
For Each Folder As DirectoryInfo In DirectoryUtils.GetInfo(Paths.Base).GetDirectories
|
||||
If DirectoryUtils.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then
|
||||
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathUtils.AddSlashSuffix(PathUtils.ForCompare(Folder.FullName)), .Type = McFolder.Types.Vanilla})
|
||||
End If
|
||||
@@ -75,7 +75,7 @@
|
||||
End Try
|
||||
|
||||
'扫描官启文件夹
|
||||
Dim MojangPath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\"
|
||||
Dim MojangPath As String = Paths.AppData & ".minecraft\"
|
||||
If (Not CacheMcFolderList.Any OrElse MojangPath <> CacheMcFolderList(0).Location) AndAlso '当前文件夹不是官启文件夹
|
||||
DirectoryUtils.Exists(MojangPath & "versions\") Then '具有权限且存在 versions 文件夹
|
||||
CacheMcFolderList.Add(New McFolder With {.Name = "官方启动器文件夹", .Location = MojangPath, .Type = McFolder.Types.Vanilla})
|
||||
@@ -123,8 +123,8 @@
|
||||
|
||||
'若没有可用文件夹，则创建 .minecraft
|
||||
If Not CacheMcFolderList.Any() Then
|
||||
DirectoryUtils.Create(PathExeFolder & ".minecraft\versions\")
|
||||
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder & ".minecraft\", .Type = McFolder.Types.Vanilla})
|
||||
DirectoryUtils.Create(Paths.Base & ".minecraft\versions\")
|
||||
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Paths.Base & ".minecraft\", .Type = McFolder.Types.Vanilla})
|
||||
End If
|
||||
|
||||
For Each Folder As McFolder In CacheMcFolderList
|
||||
@@ -463,9 +463,9 @@ VersionSearchFinish:
|
||||
If Not FileUtils.Exists(JsonPath) Then
|
||||
'尝试寻找 JSON 文件
|
||||
JsonPath = Nothing
|
||||
For Each JsonCandidatePath In DirectoryUtils.GetFiles(PathVersion, True, "*.json")
|
||||
For Each JsonCandidatePath In DirectoryUtils.EnumerateFiles(PathVersion, searchPattern:="*.json")
|
||||
Try
|
||||
Dim JsonCandidate As JObject = GetJson(FileUtils.ReadAsString(JsonCandidatePath))
|
||||
Dim JsonCandidate As JObject = FileUtils.ReadAsJson(JsonCandidatePath)
|
||||
If Not JsonCandidate.ContainsKey("mainClass") Then Continue For
|
||||
If Not JsonCandidate.ContainsKey("type") Then Continue For
|
||||
If Not JsonCandidate.ContainsKey("id") Then Continue For
|
||||
@@ -501,12 +501,12 @@ VersionSearchFinish:
|
||||
If Not FastJsonCheck(_JsonText) Then
|
||||
If RunInUi() Then
|
||||
Logger.Warn("版本 JSON 文件为空或有误，由于代码在主线程运行，将不再进行重试")
|
||||
GetJson(_JsonText) '触发异常
|
||||
_JsonText.DeserializeJson() '触发异常
|
||||
Else
|
||||
Logger.Warn($"版本 JSON 文件为空或有误，将在 2s 后重试读取（{JsonPath}）")
|
||||
Thread.Sleep(2000)
|
||||
_JsonText = FileUtils.ReadAsString(JsonPath)
|
||||
If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
|
||||
If Not FastJsonCheck(_JsonText) Then _JsonText.DeserializeJson() '触发异常
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
@@ -526,7 +526,7 @@ VersionSearchFinish:
|
||||
If _JsonObject Is Nothing Then
|
||||
Dim Text As String = JsonText '触发 JsonText 的 Get 事件
|
||||
Try
|
||||
_JsonObject = GetJson(Text)
|
||||
_JsonObject = Text.DeserializeJson()
|
||||
'转换 HMCL 关键项
|
||||
If _JsonObject.ContainsKey("patches") AndAlso Not _JsonObject.ContainsKey("time") Then
|
||||
IsHmclFormatJson = True
|
||||
@@ -626,7 +626,7 @@ Recheck:
|
||||
Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json")
|
||||
If VersionJson Is Nothing Then Exit Try
|
||||
Using VersionJsonStream As New StreamReader(VersionJson.Open)
|
||||
_JsonVersion = GetJson(VersionJsonStream.ReadToEnd)
|
||||
_JsonVersion = VersionJsonStream.ReadToEnd().DeserializeJson()
|
||||
End Using
|
||||
End Using
|
||||
Catch ex As Exception
|
||||
@@ -659,22 +659,23 @@ Recheck:
|
||||
End Property
|
||||
Private _InheritName As String = Nothing
|
||||
|
||||
Public Sub ResetIniCache()
|
||||
Public Config As JsonConfigProvider
|
||||
Public Sub ResetSettingsCache()
|
||||
IniClearCache(PathIndie & "options.txt")
|
||||
IniClearCache(PathVersion & "PCL\Setup.ini")
|
||||
Config.DiscardCache()
|
||||
For Each Entry In Settings.Entries.Values
|
||||
If Entry.Source = Settings.Sources.Instance Then Entry.ValueCache.Remove(PathVersion)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 从版本名，或版本文件夹的完整路径初始化（不规定是否以 \ 结尾）。
|
||||
''' 从版本名，或版本文件夹的完整路径初始化。
|
||||
''' </summary>
|
||||
Public Sub New(Name As String)
|
||||
Name = PathUtils.RemoveExtendedPrefix(Name)
|
||||
PathVersion = If(Name.Contains(":"), "", McFolderSelected & "versions\") & '补全完整路径
|
||||
Name &
|
||||
If(Name.EndsWithF("\"), "", "\") '补全右划线
|
||||
Public Sub New(NameOrFullPath As String)
|
||||
NameOrFullPath = PathUtils.RemoveExtendedPrefix(NameOrFullPath)
|
||||
PathVersion = PathUtils.AddSlashSuffix(If(NameOrFullPath.Contains(":"), "", McFolderSelected & "versions\") & NameOrFullPath)
|
||||
Config = New JsonConfigProvider(Path.Combine(PathVersion, "PCL\config.json"))
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
@@ -1286,7 +1287,7 @@ ExitDataLoad:
|
||||
GoTo OnLoaded
|
||||
End If
|
||||
'有可用版本
|
||||
Dim FolderListCheck As Integer = (Versions.MCINSTANCE_CACHE_VERSION & "#" & FolderList.Join("#"c)).GetStableHashCode() Mod (Integer.MaxValue - 1) '根据文件夹名列表生成辨识码
|
||||
Dim FolderListCheck As Integer = (Versions.McInstanceCacheVersion & "#" & FolderList.Join("#"c)).GetStableHashCode() Mod (Integer.MaxValue - 1) '根据文件夹名列表生成辨识码
|
||||
If Not McInstanceListForceRefresh AndAlso Val(ReadIni(PathMc & "PCL.ini", "InstanceCache")) = FolderListCheck Then
|
||||
'可以使用缓存
|
||||
Dim Result = InitMcInstanceListWithCache(PathMc)
|
||||
@@ -1307,7 +1308,7 @@ Reload:
|
||||
|
||||
'改变当前选择的版本
|
||||
OnLoaded:
|
||||
If Loader.IsInterrupted Then Return
|
||||
If Loader.IsCanceled Then Return
|
||||
If McInstanceList.Any(Function(v) v.Key <> McInstanceCardType.Error) Then
|
||||
'尝试读取已储存的选择
|
||||
Dim SavedSelection As String = ReadIni(PathMc & "PCL.ini", "Version")
|
||||
@@ -1333,9 +1334,8 @@ OnLoaded:
|
||||
Logger.Info("未找到可用 Minecraft 版本")
|
||||
End If
|
||||
If Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000))
|
||||
Catch ex As ThreadInterruptedException
|
||||
Catch ex As Exception
|
||||
If Loader.IsInterrupted Then Return '#5617
|
||||
If Loader.IsCanceled OrElse ex.IsCanceled Then Return '#5617
|
||||
WriteIni(PathMc & "PCL.ini", "InstanceCache", "") '要求下次重新加载
|
||||
Logger.Error(ex, "加载 .minecraft 版本列表失败")
|
||||
End Try
|
||||
@@ -1716,7 +1716,7 @@ OnLoaded:
|
||||
'处理皮肤地址
|
||||
Dim SkinValue As String
|
||||
Try
|
||||
For Each SkinProperty In GetJson(SkinString)("properties")
|
||||
For Each SkinProperty In SkinString.DeserializeJson()("properties")
|
||||
If SkinProperty("name") = "textures" Then
|
||||
SkinValue = SkinProperty("value")
|
||||
Exit Try
|
||||
@@ -1728,7 +1728,7 @@ OnLoaded:
|
||||
Throw New Exception("皮肤返回值中不包含皮肤数据项，可能是未设置自定义皮肤的用户", ex)
|
||||
End Try
|
||||
SkinString = Encoding.UTF8.GetString(Convert.FromBase64String(SkinValue))
|
||||
Dim SkinJson As JObject = GetJson(SkinString.Lower)
|
||||
Dim SkinJson As JObject = SkinString.Lower.DeserializeJson()
|
||||
If SkinJson("textures") Is Nothing OrElse SkinJson("textures")("skin") Is Nothing OrElse SkinJson("textures")("skin")("url") Is Nothing Then
|
||||
Throw New Exception("用户未设置自定义皮肤")
|
||||
Else
|
||||
@@ -1751,7 +1751,6 @@ OnLoaded:
|
||||
SyncLock McSkinDownloadLock
|
||||
If Not FileUtils.Exists(FileAddress) Then
|
||||
NetDownloadByClient(Address, FileAddress & ".PCLDownloading")
|
||||
FileUtils.Delete(FileAddress)
|
||||
FileUtils.Move(FileAddress & ".PCLDownloading", FileAddress)
|
||||
Logger.Info($"皮肤下载成功：{FileAddress}")
|
||||
End If
|
||||
@@ -1835,7 +1834,7 @@ OnLoaded:
|
||||
Public OriginalName As String
|
||||
|
||||
Public Overrides Function ToString() As String
|
||||
Return If(IsNatives, "[Native] ", "") & FormatFileSize(Size) & " | " & LocalPath
|
||||
Return If(IsNatives, "[Native] ", "") & StringUtils.FormatByteSize(Size) & " | " & LocalPath
|
||||
End Function
|
||||
End Class
|
||||
|
||||
@@ -1865,7 +1864,7 @@ OnLoaded:
|
||||
End If
|
||||
End If
|
||||
If Rule("os")("arch") IsNot Nothing Then '操作系统架构
|
||||
IsRightRule = IsRightRule AndAlso ((Rule("os")("arch").ToString = "x86") = Is32BitSystem)
|
||||
IsRightRule = IsRightRule AndAlso Rule("os")("arch").ToString <> "x86" AndAlso Not Rule("os")("arch").Contains("arm")
|
||||
End If
|
||||
End If
|
||||
If Not IsNothing(Rule("features")) Then '标签
|
||||
@@ -2078,11 +2077,11 @@ OnLoaded:
|
||||
Try
|
||||
'测试链接：https://auth.mc-user.com:233/00000000000000000000000000000000/
|
||||
Logger.Info("开始获取统一通行证下载信息")
|
||||
Dim DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Settings.Get(Of String)("VersionServerNide", Instance:=Instance), RequireJson:=True))
|
||||
Dim DownloadInfo As JObject = NetRequestByClientRetry("https://auth.mc-user.com:233/" & Settings.Get(Of String)("VersionServerNide", Instance:=Instance), RequireJson:=True).DeserializeJson()
|
||||
Result.Add(New NetFile(
|
||||
Urls:={"https://login.mc-user.com:233/index/jar"},
|
||||
LocalPath:=TargetFile,
|
||||
Checker:=New FileChecker(Hash:=DownloadInfo("jarHash").ToString)))
|
||||
Checker:=New FileChecker With {.Hash = DownloadInfo("jarHash").ToString}))
|
||||
Catch ex As Exception
|
||||
If FileUtils.Exists(TargetFile) Then
|
||||
Logger.Warn(ex, "获取统一通行证下载信息失败")
|
||||
@@ -2097,15 +2096,15 @@ OnLoaded:
|
||||
Dim TargetFile = PathPure & "authlib-injector.jar"
|
||||
Try
|
||||
Logger.Info("开始获取 Authlib-Injector 下载信息")
|
||||
Dim DownloadInfo = GetJson(NetRequestByClientRetry(
|
||||
Dim DownloadInfo As JObject = NetRequestByClientRetry(
|
||||
"https://authlib-injector.yushi.moe/artifact/latest.json",
|
||||
BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json", RequireJson:=True))
|
||||
BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json", RequireJson:=True).DeserializeJson()
|
||||
Dim DownloadAddress As String = DownloadInfo("download_url").ToString.
|
||||
Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe")
|
||||
Result.Add(New NetFile({
|
||||
DownloadAddress,
|
||||
DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector")
|
||||
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
|
||||
}, TargetFile, New FileChecker With {.Hash = DownloadInfo("checksums")("sha256").ToString}))
|
||||
Catch ex As Exception
|
||||
If FileUtils.Exists(TargetFile) Then
|
||||
Logger.Warn(ex, "获取 Authlib-Injector 下载信息失败")
|
||||
@@ -2144,7 +2143,7 @@ OnLoaded:
|
||||
If Token.Name.ContainsIgnoreCase("labymod") Then
|
||||
Checker = New FileChecker '不检查 LabyMod 的文件，它们提供的文件校验信息是错的（#3225）
|
||||
Else
|
||||
Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
|
||||
Checker = New FileChecker With {.ActualSize = If(Token.Size = 0, -1, Token.Size), .Hash = Token.SHA1}
|
||||
End If
|
||||
'URL
|
||||
Dim Urls As New List(Of String)
|
||||
@@ -2238,16 +2237,16 @@ OnLoaded:
|
||||
'返回 assets 文件名会由于没有下载地址导致全局失败
|
||||
'If AssetsName IsNot Nothing AndAlso AssetsName <> "legacy" Then
|
||||
' Log("[Minecraft] 无法获取资源文件索引下载地址，使用 assets 项提供的资源文件名：" & AssetsName)
|
||||
' Return GetJson("{""id"": """ & AssetsName & """}")
|
||||
' Return ("{""id"": """ & AssetsName & """}").DeserializeJson()
|
||||
'Else
|
||||
Logger.Info("无法获取资源文件索引下载地址，使用默认的 legacy 下载地址")
|
||||
Return GetJson("{
|
||||
Return "{
|
||||
""id"": ""legacy"",
|
||||
""sha1"": ""c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729"",
|
||||
""size"": 134284,
|
||||
""url"": ""https://launchermeta.mojang.com/mc-staging/assets/legacy/c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729/legacy.json"",
|
||||
""totalSize"": 111220701
|
||||
}")
|
||||
}".DeserializeJson()
|
||||
'End If
|
||||
Else
|
||||
Throw New Exception("该版本不存在资源文件索引信息")
|
||||
@@ -2294,7 +2293,7 @@ OnLoaded:
|
||||
Public Hash As String
|
||||
|
||||
Public Overrides Function ToString() As String
|
||||
Return FormatFileSize(Size) & " | " & LocalPath
|
||||
Return StringUtils.FormatByteSize(Size) & " | " & LocalPath
|
||||
End Function
|
||||
End Structure
|
||||
''' <summary>
|
||||
@@ -2307,7 +2306,7 @@ OnLoaded:
|
||||
'初始化
|
||||
If Not FileUtils.Exists($"{McFolderSelected}assets\indexes\{IndexName}.json") Then Throw New FileNotFoundException("未找到 Asset Index", McFolderSelected & "assets\indexes\" & IndexName & ".json")
|
||||
Dim Result As New List(Of McAssetsToken)
|
||||
Dim Json As JObject = GetJson(FileUtils.ReadAsString($"{McFolderSelected}assets\indexes\{IndexName}.json"))
|
||||
Dim Json As JObject = FileUtils.ReadAsJson($"{McFolderSelected}assets\indexes\{IndexName}.json")
|
||||
|
||||
'读取列表
|
||||
For Each File As JProperty In Json("objects").Children
|
||||
@@ -2347,8 +2346,7 @@ OnLoaded:
|
||||
Select(Function(Token As McAssetsToken) New NetFile(
|
||||
DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"),
|
||||
LocalPath:=Token.LocalPath,
|
||||
Checker:=New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size),
|
||||
Hash:=Token.Hash))).ToList
|
||||
Checker:=New FileChecker With {.ActualSize = If(Token.Size = 0, -1, Token.Size), .Hash = Token.Hash})).ToList
|
||||
End If
|
||||
'如果不检查 Hash，则立即处理
|
||||
Dim Result As New List(Of NetFile)
|
||||
@@ -2365,7 +2363,7 @@ OnLoaded:
|
||||
Dim File = FileUtils.GetInfo(Token.LocalPath)
|
||||
If File.Exists AndAlso (Token.Size = 0 OrElse Token.Size = File.Length) Then Continue For
|
||||
'文件不存在，添加下载
|
||||
Result.Add(New NetFile(DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"), Token.LocalPath, New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.Hash)))
|
||||
Result.Add(New NetFile(DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"), Token.LocalPath, New FileChecker With {.ActualSize = If(Token.Size = 0, -1, Token.Size), .Hash = Token.Hash}))
|
||||
Next
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "获取版本缺失的资源文件下载列表失败")
|
||||
@@ -2394,7 +2392,7 @@ OnLoaded:
|
||||
If Version Is Nothing Then Return
|
||||
Dim Time As Date = Version("releaseTime")
|
||||
Dim MsgBoxText As String = $"新版本：{VersionName}{vbCrLf}" &
|
||||
If((Date.Now - Time).TotalDays > 1, "更新时间：" & Time.ToString, "更新于：" & GetTimeSpanString(Time - Date.Now, False))
|
||||
If((Date.Now - Time).TotalDays > 1, "更新时间：" & Time.ToString, "更新于：" & StringUtils.FormatTimeSpan(Time - Date.Now, False))
|
||||
Dim MsgResult = MyMsgBox(MsgBoxText, "Minecraft 更新提示", "确定", "下载", If((Date.Now - Time).TotalHours > 3, "更新日志", ""),
|
||||
Button3Action:=Sub() McUpdateLogShow(Version))
|
||||
'弹窗结果
|
||||
|
||||
@@ -1,4 +1,7 @@
|
||||
Public Module ModModpack
|
||||
Imports System.Collections.ObjectModel
|
||||
Imports System.Text.RegularExpressions
|
||||
|
||||
Public Module ModModpack
|
||||
|
||||
'触发整合包安装的外部接口
|
||||
''' <summary>
|
||||
@@ -11,8 +14,8 @@
|
||||
Sub()
|
||||
Try
|
||||
ModpackInstall(File)
|
||||
Catch ex As CancelledException
|
||||
Catch ex As Exception
|
||||
ex.ThrowIfCanceled()
|
||||
Logger.Error(ex, "手动安装整合包失败", LogBehavior.Alert)
|
||||
End Try
|
||||
End Sub)
|
||||
@@ -21,7 +24,6 @@
|
||||
''' 构建并启动安装给定的整合包文件的加载器，并返回该加载器。若失败则抛出异常。
|
||||
''' 必须在工作线程执行。
|
||||
''' </summary>
|
||||
''' <exception cref="CancelledException" />
|
||||
Public Function ModpackInstall(File As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
|
||||
Logger.Info($"整合包安装请求：{If(File, "null")}")
|
||||
Dim Archive As ZipArchive = Nothing
|
||||
@@ -29,7 +31,7 @@
|
||||
Try
|
||||
'字符校验
|
||||
Dim TargetFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
|
||||
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Red) : Throw New CancelledException
|
||||
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Red) : Throw New OperationCanceledException
|
||||
'获取整合包种类与关键 Json
|
||||
Dim PackType As Integer = -1
|
||||
Try
|
||||
@@ -39,7 +41,7 @@
|
||||
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
|
||||
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
|
||||
If Archive.GetEntry("manifest.json") IsNot Nothing Then
|
||||
Dim Json As JObject = GetJson(Archive.GetEntry("manifest.json").Open().ReadString(Encoding.UTF8))
|
||||
Dim Json As JObject = Archive.GetEntry("manifest.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
|
||||
If Json("addons") Is Nothing Then
|
||||
PackType = 0 : Exit Try 'CurseForge 整合包
|
||||
Else
|
||||
@@ -59,7 +61,7 @@
|
||||
If PathSplits(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
|
||||
If PathSplits(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
|
||||
If PathSplits(1) = "manifest.json" Then
|
||||
Dim Json As JObject = GetJson(Entry.Open().ReadString(Encoding.UTF8))
|
||||
Dim Json As JObject = Entry.Open().ReadString(Encoding.UTF8).DeserializeJson()
|
||||
If Json("addons") Is Nothing Then
|
||||
PackType = 0 : Exit Try 'CurseForge 整合包
|
||||
Else
|
||||
@@ -163,22 +165,21 @@ Retry:
|
||||
''' 弹窗提示整合包中存在不兼容的加载器。
|
||||
''' 如果取消，则抛出 CancelledException。
|
||||
''' </summary>
|
||||
''' <exception cref="CancelledException" />
|
||||
Private Sub NotifyIncompatibleLoader(LoaderName As String)
|
||||
If MyMsgBox($"整合包中存在不兼容的加载器：{LoaderName}{vbCrLf}如果你知道如何手动安装它，可以先选择跳过，然后在整合包下载结束后手动安装。",
|
||||
"不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New CancelledException
|
||||
"不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New OperationCanceledException
|
||||
End Sub
|
||||
|
||||
#Region "不同类型整合包的安装方法"
|
||||
|
||||
'CurseForge
|
||||
Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
|
||||
Private Function InstallPackCurseForge(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String,
|
||||
Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
|
||||
|
||||
'读取 Json 文件
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString)
|
||||
Json = Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString().DeserializeJson()
|
||||
Catch ex As Exception
|
||||
Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
|
||||
End Try
|
||||
@@ -189,8 +190,8 @@ Retry:
|
||||
InstanceName = If(Json("name"), "")
|
||||
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
|
||||
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
|
||||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
|
||||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
|
||||
End If
|
||||
|
||||
'获取 Mod API 版本信息
|
||||
@@ -272,9 +273,9 @@ Retry:
|
||||
MissingDesc.Add($"{Project.TranslatedName} (文件 ID {Missing.FileId})")
|
||||
End If
|
||||
Next
|
||||
If MyMsgBox($"未找到该整合包所需的以下内容，它们可能已被原作者删除：{vbCrLf}- {MissingDesc.Join(vbCrLf & "- ")}{vbCrLf}{vbCrLf}是否继续安装？缺失这些内容可能导致整合包出现异常！",
|
||||
If MyMsgBox($"未找到该整合包所需的以下内容，它们可能已被原作者删除：{vbCrLf}- {MissingDesc.Join(vbCrLf + "- ")}{vbCrLf}{vbCrLf}是否继续安装？缺失这些内容可能导致整合包出现异常！",
|
||||
"整合包内容缺失", "继续", "取消", IsWarn:=True) = 2 Then
|
||||
Task.Interrupt()
|
||||
Task.Cancel()
|
||||
End If
|
||||
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
|
||||
'构造 NetFile
|
||||
@@ -364,7 +365,7 @@ Retry:
|
||||
Dim LoaderName As String = "CurseForge 整合包安装：" & InstanceName & " "
|
||||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||||
Hint("该整合包正在安装中！", HintType.Red)
|
||||
Throw New CancelledException
|
||||
Throw New OperationCanceledException
|
||||
End If
|
||||
|
||||
'启动
|
||||
@@ -377,12 +378,12 @@ Retry:
|
||||
End Function
|
||||
|
||||
'Modrinth
|
||||
Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
|
||||
Private Function InstallPackModrinth(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
|
||||
|
||||
'读取 Json 文件
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open().ReadString)
|
||||
Json = Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open().ReadString().DeserializeJson()
|
||||
Catch ex As Exception
|
||||
Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
|
||||
End Try
|
||||
@@ -412,8 +413,8 @@ Retry:
|
||||
InstanceName = If(Json("name"), "")
|
||||
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
|
||||
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
|
||||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
|
||||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
|
||||
End If
|
||||
'解压
|
||||
Dim InstallTemp As String = RequestTaskTempFolder()
|
||||
@@ -452,10 +453,10 @@ Retry:
|
||||
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
|
||||
If Not Path.GetFullPath(TargetPath).StartsWithF(Path.GetFullPath($"{McFolderSelected}versions\{InstanceName}\")) Then
|
||||
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！{vbCrLf}目标：{Path.GetFullPath(TargetPath)}{vbCrLf}错误的文件：{TargetPath}", "文件路径校验失败", IsWarn:=True)
|
||||
Throw New CancelledException
|
||||
Throw New OperationCanceledException
|
||||
End If
|
||||
FileList.Add(New NetFile(Urls, TargetPath,
|
||||
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
|
||||
New FileChecker With {.ActualSize = File("fileSize").ToObject(Of Long), .Hash = File("hashes")("sha1").ToString}, True))
|
||||
Next
|
||||
If FileList.Any Then
|
||||
InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
|
||||
@@ -502,7 +503,7 @@ Retry:
|
||||
Dim LoaderName As String = $"Modrinth 整合包安装：{InstanceName} "
|
||||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||||
Hint("该整合包正在安装中！", HintType.Red)
|
||||
Throw New CancelledException
|
||||
Throw New OperationCanceledException
|
||||
End If
|
||||
|
||||
'启动
|
||||
@@ -515,11 +516,11 @@ Retry:
|
||||
End Function
|
||||
|
||||
'HMCL
|
||||
Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||||
Private Function InstallPackHMCL(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||||
'读取 Json 文件
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open().ReadString(Encoding.UTF8))
|
||||
Json = Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
|
||||
Catch ex As Exception
|
||||
Throw New Exception("HMCL 整合包安装信息存在问题", ex)
|
||||
End Try
|
||||
@@ -527,8 +528,8 @@ Retry:
|
||||
Dim InstanceName As String = If(Json("name"), "")
|
||||
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
|
||||
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
|
||||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
|
||||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
|
||||
'解压
|
||||
Dim InstallTemp As String = RequestTaskTempFolder()
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
@@ -556,7 +557,7 @@ Retry:
|
||||
Dim LoaderName As String = "HMCL 整合包安装：" & InstanceName & " "
|
||||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||||
Hint("该整合包正在安装中！", HintType.Red)
|
||||
Throw New CancelledException
|
||||
Throw New OperationCanceledException
|
||||
End If
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||||
@@ -568,11 +569,11 @@ Retry:
|
||||
End Function
|
||||
|
||||
'MMC
|
||||
Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||||
Private Function InstallPackMMC(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||||
'读取 Json 文件
|
||||
Dim PackJson As JObject, PackInstance As String
|
||||
Try
|
||||
PackJson = GetJson(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open().ReadString(Encoding.UTF8))
|
||||
PackJson = Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
|
||||
PackInstance = Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open().ReadString(Encoding.UTF8)
|
||||
Catch ex As Exception
|
||||
Throw New Exception("MMC 整合包安装信息存在问题", ex)
|
||||
@@ -581,8 +582,8 @@ Retry:
|
||||
Dim InstanceName As String = If(PackInstance.RegexSeek("(?<=\nname\=)[^\n]+"), "")
|
||||
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
|
||||
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
|
||||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
|
||||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
|
||||
'解压
|
||||
Dim InstallTemp As String = RequestTaskTempFolder()
|
||||
Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
|
||||
@@ -609,7 +610,7 @@ Retry:
|
||||
Dim PreLaunchCommand As String = ReadIni(MmcSetupFile, "PreLaunchCommand")
|
||||
If PreLaunchCommand <> "" Then
|
||||
PreLaunchCommand = PreLaunchCommand.Replace("\""", """").
|
||||
Replace("$INST_JAVA", "{java}javaw.exe").
|
||||
Replace("$INST_JAVA", "{java}java.exe").
|
||||
Replace("$INST_MC_DIR\", "{minecraft}").Replace("$INST_MC_DIR", "{minecraft}").
|
||||
Replace("$INST_DIR\", "{verpath}").Replace("$INST_DIR", "{verpath}").
|
||||
Replace("$INST_ID", "{name}").Replace("$INST_NAME", "{name}")
|
||||
@@ -622,10 +623,6 @@ Retry:
|
||||
WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
|
||||
Logger.Info($"迁移 MultiMC 版本独立设置：自动进入服务器：{ServerAddress}")
|
||||
End If
|
||||
If ReadIni(MmcSetupFile, "IgnoreJavaCompatibility", False) Then
|
||||
WriteIni(SetupFile, "VersionAdvanceJava", True)
|
||||
Logger.Info("迁移 MultiMC 版本独立设置：忽略 Java 兼容性警告")
|
||||
End If
|
||||
Dim Logo As String = ReadIni(MmcSetupFile, "iconKey", "")
|
||||
If Logo <> "" AndAlso FileUtils.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
|
||||
WriteIni(SetupFile, "LogoCustom", True)
|
||||
@@ -685,7 +682,7 @@ Retry:
|
||||
Dim LoaderName As String = "MMC 整合包安装：" & InstanceName & " "
|
||||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||||
Hint("该整合包正在安装中！", HintType.Red)
|
||||
Throw New CancelledException
|
||||
Throw New OperationCanceledException
|
||||
End If
|
||||
|
||||
'启动
|
||||
@@ -698,13 +695,13 @@ Retry:
|
||||
End Function
|
||||
|
||||
'MCBBS
|
||||
Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
|
||||
Private Function InstallPackMCBBS(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String,
|
||||
Optional InstanceName As String = Nothing) As LoaderCombo(Of String)
|
||||
'读取 Json 文件
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
|
||||
Json = GetJson(Entry.Open().ReadString(Encoding.UTF8))
|
||||
Json = Entry.Open().ReadString(Encoding.UTF8).DeserializeJson()
|
||||
Catch ex As Exception
|
||||
Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
|
||||
End Try
|
||||
@@ -713,8 +710,8 @@ Retry:
|
||||
InstanceName = If(Json("name"), "")
|
||||
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
|
||||
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
|
||||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
|
||||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
|
||||
End If
|
||||
'解压
|
||||
Dim InstallTemp As String = RequestTaskTempFolder()
|
||||
@@ -742,7 +739,7 @@ Retry:
|
||||
If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息，无法安装！")
|
||||
If Addons.ContainsKey("quilt") Then
|
||||
Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Red)
|
||||
Throw New CancelledException
|
||||
Throw New OperationCanceledException
|
||||
End If
|
||||
Dim Request As New McInstallRequest With {
|
||||
.NewInstanceName = InstanceName,
|
||||
@@ -763,7 +760,7 @@ Retry:
|
||||
Dim LoaderName As String = "MCBBS 整合包安装：" & InstanceName & " "
|
||||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||||
Hint("该整合包正在安装中！", HintType.Red)
|
||||
Throw New CancelledException
|
||||
Throw New OperationCanceledException
|
||||
End If
|
||||
|
||||
'启动
|
||||
@@ -777,12 +774,12 @@ Retry:
|
||||
End Function
|
||||
|
||||
'带启动器的压缩包
|
||||
Private Function InstallPackLauncherPack(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||||
Private Function InstallPackLauncherPack(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||||
'获取解压路径
|
||||
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
|
||||
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
|
||||
If TargetFolder Is Nothing Then Throw New CancelledException
|
||||
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
|
||||
If TargetFolder Is Nothing Then Throw New OperationCanceledException
|
||||
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New OperationCanceledException
|
||||
'解压
|
||||
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
|
||||
New LoaderTask(Of String, Integer)("解压压缩包",
|
||||
@@ -792,7 +789,7 @@ Retry:
|
||||
Thread.Sleep(400) '避免文件争用
|
||||
'查找解压后的 exe 文件
|
||||
Dim Launcher As String = Nothing
|
||||
For Each ExeFile In DirectoryUtils.GetFiles(TargetFolder, True, "*.exe")
|
||||
For Each ExeFile In DirectoryUtils.EnumerateFiles(TargetFolder, searchPattern:="*.exe")
|
||||
Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
|
||||
Logger.Info($"文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
|
||||
If Info.ProductName = "Plain Craft Launcher" Then
|
||||
@@ -826,7 +823,7 @@ Retry:
|
||||
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
|
||||
InstanceName, False)
|
||||
'调用 modpack 文件进行安装
|
||||
Dim ModpackFile = DirectoryUtils.GetFiles(TargetFolder, "modpack.*").First
|
||||
Dim ModpackFile = DirectoryUtils.EnumerateFiles(TargetFolder, True, "modpack.*").First
|
||||
Logger.Info($"调用 modpack 文件继续安装：{ModpackFile}")
|
||||
ModpackInstall(ModpackFile)
|
||||
End Sub)
|
||||
@@ -839,10 +836,10 @@ Retry:
|
||||
End Function
|
||||
|
||||
'普通压缩包
|
||||
Private Function InstallPackCompress(FileAddress As String, Archive As Compression.ZipArchive) As LoaderCombo(Of String)
|
||||
Private Function InstallPackCompress(FileAddress As String, Archive As 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)
|
||||
Dim Match As Match = Nothing
|
||||
Dim Regex As New Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegexOptions.IgnoreCase)
|
||||
For Each Entry In Archive.Entries
|
||||
Dim EntryMatch = Regex.Match("/" & Entry.FullName)
|
||||
If EntryMatch.Success Then
|
||||
@@ -856,9 +853,9 @@ Retry:
|
||||
'获取解压路径
|
||||
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
|
||||
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
|
||||
If TargetFolder Is Nothing Then Throw New CancelledException
|
||||
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Throw New CancelledException
|
||||
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
|
||||
If TargetFolder Is Nothing Then Throw New OperationCanceledException
|
||||
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Throw New OperationCanceledException
|
||||
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New OperationCanceledException
|
||||
'解压
|
||||
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
|
||||
New LoaderTask(Of String, Integer)("解压压缩包",
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Module ModWatcher
|
||||
Public Module ModWatcher
|
||||
|
||||
'对全体的监视
|
||||
Public McWatcherList As New List(Of Watcher)
|
||||
@@ -91,7 +91,7 @@
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Interrupted
|
||||
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Canceled
|
||||
TimerWindow()
|
||||
TimerLog()
|
||||
'设置窗口标题
|
||||
@@ -177,7 +177,7 @@
|
||||
Logger.Error(ex, "输出 Minecraft 日志失败")
|
||||
End Try
|
||||
End Sub
|
||||
Public LatestLog As New Queue(Of String)
|
||||
Public LatestLog As New ConcurrentQueue(Of String)
|
||||
Private Sub GameLog(Text As String)
|
||||
'预处理
|
||||
If Text Is Nothing Then Return
|
||||
@@ -185,7 +185,7 @@
|
||||
'If Text.Contains("�����") Then Hint("检测到错误的日志编码：" & Text)
|
||||
'加入预存储
|
||||
LatestLog.Enqueue(Text)
|
||||
If LatestLog.Count >= 501 Then LatestLog.Dequeue()
|
||||
If LatestLog.Count >= 501 Then LatestLog.TryDequeue(Nothing)
|
||||
Logger.Trace(Text)
|
||||
'进度处理
|
||||
If LogProgress < 1 Then
|
||||
@@ -362,7 +362,7 @@
|
||||
Analyzer.Prepare()
|
||||
Analyzer.Analyze()
|
||||
Analyzer.Output(False, New List(Of String) From
|
||||
{Instance.PathVersion & Instance.Name & ".json", PathExeFolder & "PCL\Log1.txt", PathExeFolder & "PCL\LatestLaunch.bat"})
|
||||
{Instance.PathVersion & Instance.Name & ".json", Paths.Base & "PCL\Log1.txt", Paths.Base & "PCL\LatestLaunch.bat"})
|
||||
Catch ex As Exception
|
||||
Logger.Error(ex, "崩溃分析失败")
|
||||
End Try
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class ModDevelop
|
||||
Public Class ModDevelop
|
||||
|
||||
Public Shared Sub Start()
|
||||
End Sub
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
|
||||
|
||||
#Region "附加属性"
|
||||
|
||||
''' <summary>
|
||||
@@ -267,12 +267,12 @@ Public Class CustomEvent
|
||||
MyMsgBox(Args(1).Replace("\n", vbCrLf), Args(0).Replace("\n", vbCrLf), If(Args.Length > 2, Args(2), "确定"))
|
||||
|
||||
Case EventType.弹出提示
|
||||
Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, Args(1).ToEnum(Of HintType)))
|
||||
Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, EnumUtils.FromString(Of HintType)(Args(1))))
|
||||
|
||||
Case EventType.切换页面
|
||||
RunInUi(Sub() FrmMain.PageChange(
|
||||
Args(0).ToEnum(Of FormMain.PageType),
|
||||
If(Args.Length = 1, FormMain.PageSubType.Default, Args(1).ToEnum(Of FormMain.PageSubType))))
|
||||
EnumUtils.FromString(Of FormMain.PageType)(Args(0)),
|
||||
If(Args.Length = 1, FormMain.PageSubType.Default, EnumUtils.FromString(Of FormMain.PageSubType)(Args(1)))))
|
||||
|
||||
Case EventType.导入整合包, EventType.安装整合包
|
||||
RunInUi(Sub() ModpackInstall())
|
||||
@@ -372,20 +372,20 @@ Public Class CustomEvent
|
||||
RelativeUrl = RelativeUrl.Replace("/", "\").Lower.TrimStart("\")
|
||||
|
||||
'确认实际路径
|
||||
Dim Location As String, WorkingDir As String = PathExeFolder & "PCL"
|
||||
Dim Location As String, WorkingDir As String = Paths.Base & "PCL"
|
||||
HelpTryExtract()
|
||||
If RelativeUrl.Contains(":\") Then
|
||||
'绝对路径
|
||||
Location = RelativeUrl
|
||||
Logger.Info($"自定义事件中由绝对路径{Type}：{Location}")
|
||||
ElseIf FileUtils.Exists(PathExeFolder & "PCL\" & RelativeUrl) Then
|
||||
ElseIf FileUtils.Exists(Paths.Base & "PCL\" & RelativeUrl) Then
|
||||
'相对 PCL 文件夹的路径
|
||||
Location = PathExeFolder & "PCL\" & RelativeUrl
|
||||
Location = Paths.Base & "PCL\" & RelativeUrl
|
||||
Logger.Info($"自定义事件中由相对 PCL 文件夹的路径{Type}：{Location}")
|
||||
ElseIf FileUtils.Exists(PathExeFolder & "PCL\Help\" & RelativeUrl) Then
|
||||
ElseIf FileUtils.Exists(Paths.Base & "PCL\Help\" & RelativeUrl) Then
|
||||
'相对 PCL 本地帮助文件夹的路径
|
||||
Location = PathExeFolder & "PCL\Help\" & RelativeUrl
|
||||
WorkingDir = PathExeFolder & "PCL\Help\"
|
||||
Location = Paths.Base & "PCL\Help\" & RelativeUrl
|
||||
WorkingDir = Paths.Base & "PCL\Help\"
|
||||
Logger.Info($"自定义事件中由相对 PCL 本地帮助文件夹的路径{Type}：{Location}")
|
||||
ElseIf Type = EventType.打开帮助 AndAlso FileUtils.Exists(PathTemp & "Help\" & RelativeUrl) Then
|
||||
'相对 PCL 自带帮助文件夹的路径
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
Imports System.Windows.Interop
|
||||
Imports System.Collections.ObjectModel
|
||||
Imports System.Windows.Interop
|
||||
Imports System.Windows.Threading
|
||||
|
||||
Public Module ModMain
|
||||
@@ -23,27 +24,24 @@ Public Module ModMain
|
||||
''' <summary>
|
||||
''' 等待弹出的提示列表。以 {String, HintType, Log As Boolean} 形式存储为数组。
|
||||
''' </summary>
|
||||
Private HintWaiting As ConcurrentList(Of HintMessage) = If(HintWaiting, New ConcurrentList(Of HintMessage))
|
||||
Private HintWaiting As New ConcurrentQueue(Of HintMessage)
|
||||
''' <summary>
|
||||
''' 在窗口左下角弹出提示文本。
|
||||
''' </summary>
|
||||
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Blue, Optional Log As Boolean = True)
|
||||
If HintWaiting Is Nothing Then HintWaiting = New ConcurrentList(Of HintMessage)
|
||||
HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
|
||||
HintWaiting.Enqueue(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
|
||||
End Sub
|
||||
|
||||
Private Sub HintTick()
|
||||
Try
|
||||
|
||||
'Tag 存储了：{ 是否可以重用, Uuid }
|
||||
If Not HintWaiting.Any() Then Return
|
||||
Do While HintWaiting.Any
|
||||
Dim CurrentHint As HintMessage = Nothing
|
||||
Do While HintWaiting.TryDequeue(CurrentHint)
|
||||
''清除空提示
|
||||
'If IsNothing(HintWaiting(0)) OrElse IsNothing(HintWaiting(0)(0)) Then
|
||||
' HintWaiting.RemoveAt(0)
|
||||
' Continue Do
|
||||
'End If
|
||||
Dim CurrentHint = HintWaiting(0)
|
||||
'去回车
|
||||
CurrentHint.Text = CurrentHint.Text.ReplaceLineEndings(" ", mergeMultiple:=True)
|
||||
'超量提示直接忽略
|
||||
@@ -134,7 +132,6 @@ Public Module ModMain
|
||||
'结束处理
|
||||
EndHint:
|
||||
If CurrentHint.Log Then Logger.Info($"弹出提示：{CurrentHint.Text}")
|
||||
HintWaiting.RemoveAt(0)
|
||||
Loop
|
||||
Catch ex As Exception
|
||||
Logger.Info(ex, "显示弹出提示失败")
|
||||
@@ -173,7 +170,7 @@ EndHint:
|
||||
''' <summary>
|
||||
''' 输入模式：输入验证规则。
|
||||
''' </summary>
|
||||
Public ValidateRules As ObjectModel.Collection(Of Validate)
|
||||
Public ValidateRules As Collection(Of Validate)
|
||||
''' <summary>
|
||||
''' 输入模式：提示文本。
|
||||
''' </summary>
|
||||
@@ -236,14 +233,13 @@ EndHint:
|
||||
Optional Button1Action As Action = Nothing, Optional Button2Action As Action = Nothing, Optional Button3Action As Action = Nothing) As Integer
|
||||
'将弹窗列入队列
|
||||
Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Text, .Button1 = Button1, .Button2 = Button2, .Button3 = Button3, .Text = Caption, .IsWarn = IsWarn, .Title = Title, .HighLight = HighLight, .ForceWait = True, .Button1Action = Button1Action, .Button2Action = Button2Action, .Button3Action = Button3Action}
|
||||
WaitingMyMsgBox.Add(Converter)
|
||||
If Button2.Length > 0 OrElse ForceWait Then
|
||||
'若有多个按钮则开始等待
|
||||
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then
|
||||
'主窗体尚未加载，用老土的弹窗来替代
|
||||
WaitingMyMsgBox.Remove(Converter)
|
||||
If Button2.Length > 0 Then
|
||||
Dim RawResult As MsgBoxResult = MsgBox(Caption, If(Button3.Length > 0, MsgBoxStyle.YesNoCancel, MsgBoxStyle.YesNo) + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
|
||||
Dim RawResult As MsgBoxResult =
|
||||
MsgBox(Caption, If(Button3.Length > 0, MsgBoxStyle.YesNoCancel, MsgBoxStyle.YesNo) + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
|
||||
Select Case RawResult
|
||||
Case MsgBoxResult.Yes
|
||||
Converter.Result = 1
|
||||
@@ -258,6 +254,7 @@ EndHint:
|
||||
End If
|
||||
Logger.Warn($"主窗体加载完成前出现意料外的等待弹窗：{Button1},{Button2},{Button3}")
|
||||
Else
|
||||
WaitingMyMsgBox.Enqueue(Converter)
|
||||
Try
|
||||
FrmMain.DragStop()
|
||||
If RunInUi() Then MyMsgBoxTick()
|
||||
@@ -271,6 +268,7 @@ EndHint:
|
||||
Return Converter.Result
|
||||
Else
|
||||
'不进行等待，直接返回
|
||||
WaitingMyMsgBox.Enqueue(Converter)
|
||||
Return 1
|
||||
End If
|
||||
End Function
|
||||
@@ -285,10 +283,10 @@ EndHint:
|
||||
''' <param name="Button1">显示的第一个按钮，默认为“确定”。</param>
|
||||
''' <param name="Button2">显示的第二个按钮，默认为“取消”。</param>
|
||||
''' <param name="IsWarn">是否为警告弹窗，若为 True，弹窗配色和背景会变为红色。</param>
|
||||
Public Function MyMsgBoxInput(Title As String, Optional Text As String = Nothing, Optional DefaultInput As String = Nothing, Optional ValidateRules As ObjectModel.Collection(Of Validate) = Nothing, Optional HintText As String = "", Optional Button1 As String = "确定", Optional Button2 As String = "取消", Optional IsWarn As Boolean = False) As String
|
||||
Public Function MyMsgBoxInput(Title As String, Optional Text As String = Nothing, Optional DefaultInput As String = Nothing, Optional ValidateRules As Collection(Of Validate) = Nothing, Optional HintText As String = "", Optional Button1 As String = "确定", Optional Button2 As String = "取消", Optional IsWarn As Boolean = False) As String
|
||||
'将弹窗列入队列
|
||||
Dim Converter As New MyMsgBoxConverter With {.Text = If(Text, ""), .HintText = If(HintText, ""), .Type = MyMsgBoxType.Input, .ValidateRules = If(ValidateRules, New ObjectModel.Collection(Of Validate)), .Button1 = Button1, .Button2 = Button2, .Content = DefaultInput, .IsWarn = IsWarn, .Title = Title}
|
||||
WaitingMyMsgBox.Add(Converter)
|
||||
Dim Converter As New MyMsgBoxConverter With {.Text = If(Text, ""), .HintText = If(HintText, ""), .Type = MyMsgBoxType.Input, .ValidateRules = If(ValidateRules, New Collection(Of Validate)), .Button1 = Button1, .Button2 = Button2, .Content = DefaultInput, .IsWarn = IsWarn, .Title = Title}
|
||||
WaitingMyMsgBox.Enqueue(Converter)
|
||||
'虽然我也不知道这是啥但是能用就成了 :)
|
||||
Try
|
||||
If FrmMain IsNot Nothing Then FrmMain.DragStop()
|
||||
@@ -311,7 +309,7 @@ EndHint:
|
||||
Public Function MyMsgBoxSelect(Selections As IEnumerable(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
|
||||
'将弹窗列入队列
|
||||
Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Select, .Button1 = Button1, .Button2 = Button2, .Content = Selections, .IsWarn = IsWarn, .Title = Title}
|
||||
WaitingMyMsgBox.Add(Converter)
|
||||
WaitingMyMsgBox.Enqueue(Converter)
|
||||
'虽然我也不知道这是啥但是能用就成了 :)
|
||||
Try
|
||||
If FrmMain IsNot Nothing Then FrmMain.DragStop()
|
||||
@@ -328,27 +326,27 @@ EndHint:
|
||||
''' <summary>
|
||||
''' 等待显示的弹窗。
|
||||
''' </summary>
|
||||
Public WaitingMyMsgBox As List(Of MyMsgBoxConverter) = If(WaitingMyMsgBox, New List(Of MyMsgBoxConverter))
|
||||
Public WaitingMyMsgBox As New ConcurrentQueue(Of MyMsgBoxConverter)
|
||||
Public Sub MyMsgBoxTick()
|
||||
Try
|
||||
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Return
|
||||
If FrmMain?.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Return
|
||||
Dim TargetMsgBox As MyMsgBoxConverter = Nothing
|
||||
If FrmMain.PanMsg.Children.Count > 0 Then
|
||||
'弹窗中
|
||||
FrmMain.PanMsg.Visibility = Visibility.Visible
|
||||
ElseIf WaitingMyMsgBox.Any Then
|
||||
ElseIf WaitingMyMsgBox.TryDequeue(TargetMsgBox) Then
|
||||
'没有弹窗，显示一个等待的弹窗
|
||||
FrmMain.PanMsg.Visibility = Visibility.Visible
|
||||
Select Case WaitingMyMsgBox(0).Type
|
||||
Select Case TargetMsgBox.Type
|
||||
Case MyMsgBoxType.Input
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgInput(WaitingMyMsgBox(0)))
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgInput(TargetMsgBox))
|
||||
Case MyMsgBoxType.Select
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0)))
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgSelect(TargetMsgBox))
|
||||
Case MyMsgBoxType.Text
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0)))
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgText(TargetMsgBox))
|
||||
Case MyMsgBoxType.Login
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgLogin(WaitingMyMsgBox(0)))
|
||||
FrmMain.PanMsg.Children.Add(New MyMsgLogin(TargetMsgBox))
|
||||
End Select
|
||||
WaitingMyMsgBox.RemoveAt(0)
|
||||
Else
|
||||
'没有弹窗，没有等待的弹窗
|
||||
If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
|
||||
@@ -489,7 +487,7 @@ EndHint:
|
||||
Public Sub New(FilePath As String)
|
||||
RawPath = FilePath
|
||||
If Not FileUtils.Exists(FilePath) Then Throw New FileNotFoundException("未找到帮助文件：" & FilePath, FilePath)
|
||||
Dim JsonData As JObject = GetJson(ArgumentReplace(FileUtils.ReadAsString(FilePath), AddressOf EscapeUtils.XmlEscape))
|
||||
Dim JsonData As JObject = ArgumentReplace(FileUtils.ReadAsString(FilePath), AddressOf StringUtils.XmlEscape).DeserializeJson()
|
||||
'加载常规信息
|
||||
If JsonData("Title") IsNot Nothing Then
|
||||
Title = JsonData("Title")
|
||||
@@ -503,7 +501,7 @@ EndHint:
|
||||
ShowInPublic = If(JsonData("ShowInPublic"), ShowInPublic)
|
||||
ShowInSnapshot = If(JsonData("ShowInSnapshot"), ShowInSnapshot)
|
||||
Types = New List(Of String)
|
||||
For Each NameOfType In If(JsonData("Types"), GetJson("[]"))
|
||||
For Each NameOfType In If(JsonData("Types"), New JArray)
|
||||
Types.Add(NameOfType)
|
||||
Next
|
||||
'加载事件信息
|
||||
@@ -577,8 +575,8 @@ EndHint:
|
||||
Try
|
||||
Dim IgnoreList As New List(Of String)
|
||||
'读取自定义文件
|
||||
If DirectoryUtils.Exists(PathExeFolder & "PCL\Help\") Then
|
||||
For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Help\")
|
||||
If DirectoryUtils.Exists(Paths.Base & "PCL\Help\") Then
|
||||
For Each File In DirectoryUtils.EnumerateFiles(Paths.Base & "PCL\Help\", True)
|
||||
Select Case PathUtils.GetExtension(File)
|
||||
Case "helpignore"
|
||||
'加载忽略列表
|
||||
@@ -596,7 +594,7 @@ EndHint:
|
||||
End If
|
||||
Logger.Info($"已扫描 PCL 文件夹下的帮助文件，目前总计 {FileList.Count} 条")
|
||||
'读取自带文件
|
||||
For Each File In DirectoryUtils.GetFiles(PathTemp & "Help")
|
||||
For Each File In DirectoryUtils.EnumerateFiles(PathTemp & "Help", True)
|
||||
'跳过非 json 文件与以 . 开头的文件夹
|
||||
If PathUtils.RemoveLastPart(File).Replace(PathTemp & "Help", "").Contains("\.") OrElse PathUtils.GetExtension(File) <> "json" Then Continue For
|
||||
'检查忽略列表
|
||||
@@ -614,7 +612,7 @@ NextFile:
|
||||
Catch ex As Exception
|
||||
Logger.Error(ex, "检查帮助文件夹失败", LogBehavior.Alert)
|
||||
End Try
|
||||
If Loader.IsInterrupted Then Return
|
||||
If Loader.IsCanceled Then Return
|
||||
|
||||
'将文件实例化
|
||||
Dim Dict As New List(Of HelpEntry)
|
||||
@@ -630,7 +628,7 @@ NextFile:
|
||||
|
||||
'回设
|
||||
If Not Dict.Any() Then Throw New Exception("未找到可用的帮助；若不需要帮助页面，可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
|
||||
If Loader.IsInterrupted Then Return
|
||||
If Loader.IsCanceled Then Return
|
||||
Loader.Output = Dict
|
||||
|
||||
Catch ex As Exception
|
||||
@@ -648,7 +646,7 @@ NextFile:
|
||||
ExtractResources(PathTemp & "Cache\Help.zip", "Help")
|
||||
FileUtils.ExtractToDirectory(PathTemp & "Cache\Help.zip", PathTemp & "Help")
|
||||
Settings.Set("SystemHelpVersion", VersionCode)
|
||||
Logger.Warn($"已解压内置帮助文件，目前状态：{FileUtils.Exists(PathTemp & "Help\启动器\备份设置.xaml")}")
|
||||
Logger.Info($"已解压内置帮助文件，目前状态：{FileUtils.Exists(PathTemp + "Help\启动器\备份设置.xaml")}")
|
||||
End If
|
||||
End Sub
|
||||
|
||||
@@ -662,7 +660,7 @@ NextFile:
|
||||
If _IsAprilEnabled Is Nothing Then
|
||||
_IsAprilEnabled =
|
||||
Date.Now.Month = 4 AndAlso Date.Now.Day = 1 AndAlso
|
||||
Settings.Get(Of Integer)("AprilDoneYear") <> Date.Now.Year '成功后同年内则不再触发
|
||||
Settings.Get(Of Integer)("AprilYear") <> Date.Now.Year '成功后同年内则不再触发
|
||||
End If
|
||||
Return _IsAprilEnabled.Value
|
||||
End Get
|
||||
@@ -847,7 +845,7 @@ NextFile:
|
||||
Text = Text.Replace("{pcl_build_type}", Replacer(BuildType.ToString))
|
||||
Text = Text.Replace("{pcl_branch}", Replacer(VersionBranchMain))
|
||||
Text = Text.Replace("{identify}", Replacer(Identify))
|
||||
Text = Text.Replace("{path}", Replacer(PathUtils.CurrentFolder))
|
||||
Text = Text.Replace("{path}", Replacer(Paths.Base))
|
||||
Text = Text.Replace("{path_with_name}", Replacer(PathExe))
|
||||
Text = Text.Replace("{path_temp}", Replacer(PathTemp))
|
||||
Text = Text.Replace("{pcl_md5}", Function() Replacer(CryptographyUtils.ComputeFileHash(PathExe, CryptographyUtils.HashMethod.Md5)))
|
||||
@@ -858,7 +856,7 @@ NextFile:
|
||||
Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH':'mm':'ss")))
|
||||
End If
|
||||
'Minecraft
|
||||
Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.PathFolder))
|
||||
Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.Folder))
|
||||
Text = Text.Replace("{minecraft}", Replacer(McFolderSelected))
|
||||
If McInstanceSelected?.IsLoaded Then
|
||||
Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion))
|
||||
@@ -968,7 +966,7 @@ NextFile:
|
||||
On Error Resume Next
|
||||
FeedbackInfo()
|
||||
If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug，请点击 打开文件夹 按钮，并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关，请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
|
||||
OpenExplorer(PathExeFolder & "PCL\Log1.txt")
|
||||
OpenExplorer(Paths.Base & "PCL\Log1.txt")
|
||||
End If
|
||||
OpenWebsite("https://github.com/Meloong-Git/PCL/issues/")
|
||||
End Sub
|
||||
@@ -978,11 +976,11 @@ NextFile:
|
||||
Public Sub FeedbackInfo()
|
||||
On Error Resume Next
|
||||
Logger.Warn($"诊断信息：{vbCrLf}" &
|
||||
"操作系统：" & My.Computer.Info.OSFullName & "（32 位：" & Is32BitSystem & "）" & vbCrLf &
|
||||
"操作系统：" & My.Computer.Info.OSFullName & vbCrLf &
|
||||
"剩余内存：" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
|
||||
"DPI：" & DPI & "（" & Math.Round(DPI / 96, 2) * 100 & "%）" & vbCrLf &
|
||||
"MC 文件夹：" & If(McFolderSelected, "Nothing") & vbCrLf &
|
||||
"文件位置：" & PathExeFolder)
|
||||
"文件位置：" & Paths.Base)
|
||||
End Sub
|
||||
|
||||
'遥测
|
||||
@@ -994,9 +992,9 @@ NextFile:
|
||||
Sub()
|
||||
Try
|
||||
Logger.Info($"匿名数据上报：{[Event]}")
|
||||
Dim Url As String = $"{ClsBaseUrl}&Event={EscapeUtils.UrlEscape([Event])}"
|
||||
Dim Url As String = $"{ClsBaseUrl}&Event={StringUtils.UrlEscape([Event])}"
|
||||
For i = 0 To Datas.Length - 1 Step 2
|
||||
Url &= "&" & EscapeUtils.UrlEscape(Datas(i)) & "=" & EscapeUtils.UrlEscape(Datas(i + 1).ReplaceLineEndings(vbLf, mergeMultiple:=True))
|
||||
Url &= "&" & StringUtils.UrlEscape(Datas(i)) & "=" & StringUtils.UrlEscape(Datas(i + 1).ReplaceLineEndings(vbLf, mergeMultiple:=True))
|
||||
Next
|
||||
NetRequestByClient(Url, MakeLog:=False)
|
||||
Catch ex As Exception
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Imports NAudio.Wave
|
||||
Imports NAudio.Wave
|
||||
|
||||
Public Module ModMusic
|
||||
|
||||
@@ -23,8 +23,8 @@ Public Module ModMusic
|
||||
'初始化全部可用音乐列表
|
||||
If MusicAllList Is Nothing Then
|
||||
MusicAllList = New List(Of String)
|
||||
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\")
|
||||
For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Musics\")
|
||||
DirectoryUtils.Create(Paths.Base & "PCL\Musics\")
|
||||
For Each File In DirectoryUtils.EnumerateFiles(Paths.Base & "PCL\Musics\", True)
|
||||
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
|
||||
If {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(PathUtils.GetExtension(File)) Then Continue For
|
||||
MusicAllList.Add(File)
|
||||
@@ -99,7 +99,6 @@ Public Module ModMusic
|
||||
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()
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
'由于包含加解密等安全信息，本文件中的部分代码已被删除
|
||||
'由于包含加解密等安全信息，本文件中的部分代码已被删除
|
||||
|
||||
Friend Module ModSecret
|
||||
|
||||
@@ -33,7 +33,7 @@ Friend Module ModSecret
|
||||
End If
|
||||
End If
|
||||
If Not SimulateBrowserHeaders Then Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
|
||||
If Url.Contains("api.curseforge.com") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey)
|
||||
If Url.Contains("api.curseforge.com") OrElse Url.Contains("forgecdn.net") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
''' <summary>
|
||||
''' <summary>
|
||||
''' 本地的社区资源文件。
|
||||
''' </summary>
|
||||
Public Class LocalResourceFile
|
||||
@@ -106,235 +106,6 @@ Public Class LocalResourceFile
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "从 JAR 获取信息"
|
||||
|
||||
''' <summary>
|
||||
''' 从 JAR 文件中获取 Mod 信息。
|
||||
''' </summary>
|
||||
Public Sub LoadMetadataFromJar()
|
||||
Static IsLoaded As Boolean = False
|
||||
If IsLoaded Then Return
|
||||
IsLoaded = True
|
||||
Dim Jar As ZipArchive = Nothing
|
||||
Try
|
||||
'基础可用性检查
|
||||
If Not FileUtils.Exists(File.FullName) Then Throw New FileNotFoundException("未找到 Mod 文件（" & File.FullName & "）")
|
||||
'打开 Jar 文件
|
||||
Jar = FileUtils.OpenZip(File.FullName)
|
||||
'信息获取
|
||||
LoadMetadataFromJar(Jar)
|
||||
Catch ex As UnauthorizedAccessException
|
||||
Logger.Warn(ex, $"Mod 文件由于无权限无法打开（{File.FullName}）")
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, $"Mod 文件无法打开（{File.FullName}）")
|
||||
Finally
|
||||
If Jar IsNot Nothing Then Jar.Dispose()
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub LoadMetadataFromJar(Jar As ZipArchive)
|
||||
|
||||
#Region "尝试使用 mcmod.info"
|
||||
Try
|
||||
'获取信息文件
|
||||
Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info")
|
||||
Dim InfoString As String = Nothing
|
||||
If InfoEntry IsNot Nothing Then
|
||||
InfoString = InfoEntry.Open().ReadString()
|
||||
If InfoString.Length < 15 Then InfoString = Nothing
|
||||
End If
|
||||
If InfoString Is Nothing Then Exit Try
|
||||
'获取可用 Json 项
|
||||
Dim InfoObject As JObject
|
||||
Dim JsonObject = GetJson(InfoString)
|
||||
If JsonObject.Type = JTokenType.Array Then
|
||||
InfoObject = JsonObject(0)
|
||||
Else
|
||||
InfoObject = JsonObject("modList")(0)
|
||||
End If
|
||||
'从文件中获取 Mod 信息项
|
||||
Display = InfoObject("name")
|
||||
Description = InfoObject("description")
|
||||
Version = InfoObject("version")
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, $"读取 mcmod.info 时出现未知错误（{File.FullName}）")
|
||||
End Try
|
||||
#End Region
|
||||
#Region "尝试使用 fabric.mod.json"
|
||||
Try
|
||||
'获取 fabric.mod.json 文件
|
||||
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
|
||||
Dim FabricText As String = Nothing
|
||||
If FabricEntry IsNot Nothing Then
|
||||
FabricText = FabricEntry.Open().ReadString(Encoding.UTF8)
|
||||
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
|
||||
End If
|
||||
If FabricText Is Nothing Then Exit Try
|
||||
Dim FabricObject As JObject = GetJson(FabricText)
|
||||
GotFabric:
|
||||
'从文件中获取 Mod 信息项
|
||||
If FabricObject.ContainsKey("name") Then Display = FabricObject("name")
|
||||
If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
|
||||
If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
|
||||
'加载成功
|
||||
GoTo Finished
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, $"读取 fabric.mod.json 时出现未知错误（{File.FullName}）")
|
||||
End Try
|
||||
#End Region
|
||||
#Region "尝试使用 mods.toml"
|
||||
Try
|
||||
'获取 mods.toml 文件
|
||||
Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml")
|
||||
Dim TomlText As String = Nothing
|
||||
If TomlEntry IsNot Nothing Then
|
||||
TomlText = TomlEntry.Open().ReadString()
|
||||
If TomlText.Length < 15 Then TomlText = Nothing
|
||||
End If
|
||||
If TomlText Is Nothing Then Exit Try
|
||||
'文件标准化：统一换行符为 vbLf，去除注释、头尾的空格、空行
|
||||
Dim Lines As New List(Of String)
|
||||
For Each Line In TomlText.SplitLines(True)
|
||||
If Line.StartsWithF("#") Then '去除注释
|
||||
Continue For
|
||||
ElseIf Line.Contains("#") Then
|
||||
Line = Line.Substring(0, Line.IndexOfF("#"))
|
||||
End If
|
||||
Line = Line.Trim(New Char() {" "c, " "c, " "c}) '去除头尾的空格
|
||||
If Line.Any Then Lines.Add(Line) '去除空行
|
||||
Next
|
||||
'读取文件数据
|
||||
Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))}
|
||||
For i = 0 To Lines.Count - 1
|
||||
Dim Line As String = Lines(i)
|
||||
If Line.StartsWithF("[") AndAlso Line.EndsWithF("]") Then
|
||||
'段落标记
|
||||
Dim Header = Line.Trim("[]".ToCharArray)
|
||||
TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object)))
|
||||
ElseIf Line.Contains("=") Then
|
||||
'字段标记
|
||||
Dim Key As String = Line.Substring(0, Line.IndexOfF("=")).TrimEnd(New Char() {" "c, " "c, " "c})
|
||||
Dim RawValue As String = Line.Substring(Line.IndexOfF("=") + 1).TrimStart(New Char() {" "c, " "c, " "c})
|
||||
Dim Value As Object
|
||||
If RawValue.StartsWithF("""") AndAlso RawValue.EndsWithF("""") Then
|
||||
'单行字符串
|
||||
Value = RawValue.Trim("""")
|
||||
ElseIf RawValue.StartsWithF("'''") Then
|
||||
'多行字符串
|
||||
Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")}
|
||||
If ValueLines(0).EndsWithF("'''") Then '把多行字符串按单行写法写的错误处理（#2732）
|
||||
ValueLines(0) = ValueLines(0).TrimEnd("'")
|
||||
Else
|
||||
Do Until i >= Lines.Count - 1
|
||||
i += 1
|
||||
Dim ValueLine As String = Lines(i)
|
||||
If ValueLine.EndsWithF("'''") Then
|
||||
ValueLines.Add(ValueLine.TrimEnd("'"))
|
||||
Exit Do
|
||||
Else
|
||||
ValueLines.Add(ValueLine)
|
||||
End If
|
||||
Loop
|
||||
End If
|
||||
Value = ValueLines.Join(vbLf).Trim(vbLf).ReplaceLineEndings(vbCrLf)
|
||||
ElseIf RawValue.Lower = "true" OrElse RawValue.Lower = "false" Then
|
||||
'布尔型
|
||||
Value = (RawValue.Lower = "true")
|
||||
ElseIf Val(RawValue).ToString = RawValue Then
|
||||
'数字型
|
||||
Value = Val(RawValue)
|
||||
Else
|
||||
'不知道是个啥玩意儿，直接存储
|
||||
Value = RawValue
|
||||
End If
|
||||
TomlData.Last.Value(Key) = Value
|
||||
Else
|
||||
'不知道是个啥玩意儿
|
||||
Exit Try
|
||||
End If
|
||||
Next
|
||||
'从文件数据中获取信息
|
||||
Dim ModEntry As Dictionary(Of String, Object) = Nothing
|
||||
For Each TomlSubData In TomlData
|
||||
If TomlSubData.Key = "mods" Then
|
||||
ModEntry = TomlSubData.Value
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try
|
||||
If ModEntry.ContainsKey("displayName") Then Display = ModEntry("displayName")
|
||||
If ModEntry.ContainsKey("description") Then Description = ModEntry("description")
|
||||
If ModEntry.ContainsKey("version") Then Version = ModEntry("version")
|
||||
'加载成功
|
||||
GoTo Finished
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, $"读取 mods.toml 时出现未知错误（{File.FullName}）")
|
||||
End Try
|
||||
#End Region
|
||||
#Region "尝试使用 fml_cache_annotation.json"
|
||||
Try
|
||||
'获取 fml_cache_annotation.json 文件
|
||||
Dim FmlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/fml_cache_annotation.json")
|
||||
Dim FmlText As String = Nothing
|
||||
If FmlEntry IsNot Nothing Then
|
||||
FmlText = FmlEntry.Open().ReadString(Encoding.UTF8)
|
||||
If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing
|
||||
End If
|
||||
If FmlText Is Nothing Then Exit Try
|
||||
Dim FmlJson As JObject = GetJson(FmlText)
|
||||
'获取可用 Json 项
|
||||
Dim FmlObject As JObject = Nothing
|
||||
For Each ModFilePair In FmlJson
|
||||
Dim ModFileAnnos As JArray = ModFilePair.Value("annotations")
|
||||
If ModFileAnnos IsNot Nothing Then
|
||||
'先获取 Mod
|
||||
For Each ModFileAnno In ModFileAnnos
|
||||
Dim Name As String = If(ModFileAnno("name"), "")
|
||||
If Name = "Lnet/minecraftforge/fml/common/Mod;" Then
|
||||
FmlObject = ModFileAnno("values")
|
||||
GoTo Got
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Next
|
||||
Exit Try
|
||||
Got:
|
||||
'从文件中获取 Mod 信息项
|
||||
If FmlObject.ContainsKey("name") Then Display = FmlObject("name")("value")
|
||||
If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value")
|
||||
'加载成功
|
||||
GoTo Finished
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, $"读取 fml_cache_annotation.json 时出现未知错误（{File.FullName}）")
|
||||
End Try
|
||||
#End Region
|
||||
Return '没能成功获取任何信息
|
||||
|
||||
Finished:
|
||||
#Region "将 Version 代号转换为 META-INF 中的版本"
|
||||
If _Version = "version" Then
|
||||
Try
|
||||
Dim MetaEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/MANIFEST.MF")
|
||||
If MetaEntry IsNot Nothing Then
|
||||
Dim MetaString As String = MetaEntry.Open().ReadString().Replace(" :", ":").Replace(": ", ":")
|
||||
If MetaString.Contains("Implementation-Version:") Then
|
||||
MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
|
||||
MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
|
||||
Version = MetaString
|
||||
End If
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Logger.Warn($"获取 META-INF 中的版本信息失败（{File.FullName}）")
|
||||
Version = Nothing
|
||||
End Try
|
||||
End If
|
||||
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
|
||||
#End Region
|
||||
RaiseEvent OnUpdate(Me)
|
||||
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "网络信息"
|
||||
|
||||
''' <summary>
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Module LocalResourceLoaders
|
||||
Public Module LocalResourceLoaders
|
||||
|
||||
'加载 Mod 列表
|
||||
Public LocalResourceLoader As New LoaderTask(Of String, List(Of LocalResourceFile))("LocalResourceLoader", AddressOf LocalResourceFileLoad)
|
||||
@@ -12,7 +12,7 @@
|
||||
Try
|
||||
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
|
||||
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
|
||||
If Loader.IsInterrupted Then Return
|
||||
If Loader.IsCanceled Then Return
|
||||
Thread.Sleep(100)
|
||||
Loop
|
||||
Finally
|
||||
@@ -25,7 +25,7 @@
|
||||
Dim ModFileList As New List(Of String)
|
||||
If DirectoryUtils.Exists(Loader.Input) Then
|
||||
Dim RawName As String = Loader.Input.Lower
|
||||
For Each File In DirectoryUtils.GetFiles(Loader.Input)
|
||||
For Each File In DirectoryUtils.EnumerateFiles(Loader.Input, True)
|
||||
If File.BeforeLast("\").Lower & "\" <> RawName Then
|
||||
'仅当 Forge 1.13- 且文件夹名与版本号相同时，才加载该子文件夹下的 Mod
|
||||
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
|
||||
@@ -53,8 +53,8 @@
|
||||
Try
|
||||
Dim CacheContent As String = FileUtils.TryReadAsString(CachePath)
|
||||
If Not String.IsNullOrWhiteSpace(CacheContent) Then
|
||||
Cache = GetJson(CacheContent)
|
||||
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> Versions.LOCAL_MOD_CACHE_VERSION Then
|
||||
Cache = CacheContent.DeserializeJson()
|
||||
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> Versions.LocalModCacheVersion Then
|
||||
Logger.Warn($"本地 Mod 信息缓存版本已过期，将弃用这些缓存信息")
|
||||
Cache = New JObject
|
||||
End If
|
||||
@@ -63,12 +63,12 @@
|
||||
Logger.Warn(ex, "读取本地 Mod 信息缓存失败，已重置")
|
||||
Cache = New JObject
|
||||
End Try
|
||||
Cache("version") = Versions.LOCAL_MOD_CACHE_VERSION
|
||||
Cache("version") = Versions.LocalModCacheVersion
|
||||
|
||||
'加载 Mod 列表
|
||||
Dim ModList As New List(Of LocalResourceFile)
|
||||
For Each ModFile In ModFileList
|
||||
If Loader.IsInterrupted Then Return
|
||||
If Loader.IsCanceled Then Return
|
||||
Dim ModEntry As New LocalResourceFile(ModFile)
|
||||
Dim DumpMod As LocalResourceFile = ModList.FirstOrDefault(Function(m) m.EnabledName = ModEntry.EnabledName) '存在两个文件，名称相同，但一个启用一个禁用
|
||||
If DumpMod IsNot Nothing Then
|
||||
@@ -88,7 +88,7 @@
|
||||
ModList = ModList.OrderBy(Function(m) m.File.Name).ToList
|
||||
|
||||
'回设
|
||||
If Loader.IsInterrupted Then Return
|
||||
If Loader.IsCanceled Then Return
|
||||
Loader.Output = ModList
|
||||
|
||||
'开始联网加载
|
||||
@@ -109,7 +109,7 @@
|
||||
Dim ModLoaders = Loader.Input.Target.ModLoaders
|
||||
'读取缓存，获取需要更新的 Mod 列表
|
||||
For Each ModEntry As LocalResourceFile In Loader.Input.ModList
|
||||
If Loader.IsInterrupted Then Return
|
||||
If Loader.IsCanceled Then Return
|
||||
Dim CacheKey = ModEntry.ModrinthHash & Loader.Input.Target.VanillaName & ModLoaders
|
||||
If Cache.ContainsKey(CacheKey) Then
|
||||
ModEntry.FromJson(Cache(CacheKey))
|
||||
@@ -119,10 +119,7 @@
|
||||
Mods.Add(ModEntry)
|
||||
Next
|
||||
Logger.Info($"有 {Mods.Where(Function(m) m.Project Is Nothing).Count} 个 Mod 需要联网获取信息，{Mods.Where(Function(m) m.Project IsNot Nothing).Count} 个 Mod 需要更新信息")
|
||||
If Not Mods.Any Then
|
||||
Loader.Input.ModList.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar()) '从 JAR 中获取缺失的版本信息（下面有另一个分支）
|
||||
Return
|
||||
End If
|
||||
If Not Mods.Any Then Return
|
||||
'获取作为检查目标的加载器和版本
|
||||
'此处不应向下扩展检查的 MC 小版本，例如 Mod 在更新 1.16.5 后，对早期的 1.16.2 版本发布了修补补丁，这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
|
||||
Dim TargetMcVersion As McVersion = Loader.Input.Target
|
||||
@@ -158,7 +155,7 @@
|
||||
Entry.ProjectVersion.Version = File.Version '使用来自 Modrinth 的版本号
|
||||
End If
|
||||
Next
|
||||
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
|
||||
If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
|
||||
Logger.Info($"需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
|
||||
'步骤 3：获取工程信息
|
||||
If Not ModrinthMapping.Any() Then Return
|
||||
@@ -211,7 +208,7 @@
|
||||
Dim Hashes As New List(Of UInteger)
|
||||
For Each Entry In Mods
|
||||
Hashes.Add(Entry.CurseForgeHash)
|
||||
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
|
||||
If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
|
||||
Next
|
||||
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
|
||||
$"{{""fingerprints"": [{Hashes.Join(",")}]}}", "application/json")("data")("exactMatches")
|
||||
@@ -232,7 +229,7 @@
|
||||
If Entry.ProjectVersion Is Nothing OrElse Entry.ProjectVersion.ReleaseDate < File.ReleaseDate Then Entry.ProjectVersion = File
|
||||
Next
|
||||
Next
|
||||
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
|
||||
If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
|
||||
Logger.Info($"需要从 CurseForge 获取 {ProjectIdToLocalFiles.Count} 个本地 Mod 的工程信息")
|
||||
If Not ProjectIdToLocalFiles.Any() Then Return
|
||||
|
||||
@@ -313,25 +310,23 @@
|
||||
EndedThreadCount += 1
|
||||
End Try
|
||||
End Sub, "Mod List Detail Loader CurseForge")
|
||||
'从 JAR 中获取缺失的版本信息（上面有另一个分支）
|
||||
Loader.Input.ModList.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar())
|
||||
'等待线程结束
|
||||
Do Until EndedThreadCount = 2
|
||||
Thread.Sleep(10)
|
||||
If Loader.IsInterrupted Then Return
|
||||
If Loader.IsCanceled Then Return
|
||||
Loop
|
||||
'保存缓存
|
||||
Mods = Mods.Where(Function(m) m.Project IsNot Nothing).ToList()
|
||||
Logger.Info($"联网获取本地 Mod 信息完成，为 {Mods.Count} 个 Mod 更新缓存")
|
||||
If Not Mods.Any() Then Return
|
||||
If Loader.IsInterrupted Then Return
|
||||
If Loader.IsCanceled Then Return
|
||||
For Each Entry In Mods
|
||||
Entry.OnlineDataLoaded = Not IsFailed
|
||||
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders) = Entry.ToJson()
|
||||
Next
|
||||
FileUtils.Write(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
|
||||
'刷新边栏
|
||||
If Loader.IsInterrupted Then Return
|
||||
If Loader.IsCanceled Then Return
|
||||
If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
|
||||
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
|
||||
Else
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
''' <summary>
|
||||
''' <summary>
|
||||
''' 社区资源的项目信息。
|
||||
''' </summary>
|
||||
Public Class ResourceProject
|
||||
@@ -88,7 +88,7 @@ Public Class ResourceProject
|
||||
If Not LoadedDatabase Then
|
||||
LoadedDatabase = True
|
||||
If Types.HasFlag(ResourceTypes.Mod) OrElse Types.HasFlag(ResourceTypes.DataPack) Then
|
||||
_WikiEntry = WikiEntry.All.FirstOrDefault(Function(c) If(Platform = ResourcePlatforms.CurseForge, c.CurseForgeSlug, c.ModrinthSlug) = Slug)
|
||||
_WikiEntry = WikiEntry.All.Value.FirstOrDefault(Function(c) c.Slugs.GetOrDefault(Platform) = Slug)
|
||||
End If
|
||||
End If
|
||||
Return _WikiEntry
|
||||
@@ -111,7 +111,7 @@ Public Class ResourceProject
|
||||
''' </summary>
|
||||
Public ReadOnly Property TranslatedName As String
|
||||
Get
|
||||
Return If(WikiEntry Is Nothing OrElse WikiEntry.ChineseName = "", RawName, WikiEntry.ChineseName)
|
||||
Return If(WikiEntry?.ChineseName, RawName)
|
||||
End Get
|
||||
End Property
|
||||
|
||||
@@ -441,7 +441,7 @@ Public Class ResourceProject
|
||||
Json("Website") = Website
|
||||
Json("LastUpdate") = LastUpdate
|
||||
Json("DownloadCount") = DownloadCount
|
||||
If ModLoaders <> ModLoaders.None Then Json("ModLoaders") = ModLoaders
|
||||
If ModLoaders <> ModLoaders.None Then Json("ModLoaders") = CInt(ModLoaders)
|
||||
Json("Tags") = New JArray(Tags)
|
||||
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
|
||||
If Drops.Any Then Json("Drops") = New JArray(Drops)
|
||||
@@ -561,7 +561,7 @@ Public Class ResourceProject
|
||||
NewItem.LabVersion.Text = ModLoaderDescriptionFull
|
||||
End If
|
||||
NewItem.LabSource.Text = Platform.ToString
|
||||
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
|
||||
NewItem.LabTime.Text = StringUtils.FormatTimeSpan(LastUpdate - Date.Now, True)
|
||||
NewItem.LabDownload.Text =
|
||||
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
|
||||
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
Public Class ResourceSearcher
|
||||
Public Class ResourceSearcher
|
||||
Private Const RESULT_PAGE_SIZE = 40
|
||||
Private Const MSG_NO_CHINESE_RESULT As String = "无搜索结果，请尝试搜索其英文名称"
|
||||
|
||||
@@ -86,7 +86,7 @@
|
||||
If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/")
|
||||
If ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then Address += "&modLoaderType=" & Resource.ToCurseForgeModLoaderType(ModLoaders.Flags.First)
|
||||
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
|
||||
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & EscapeUtils.UrlEscape(SearchText)
|
||||
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & StringUtils.UrlEscape(SearchText)
|
||||
If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
|
||||
Return Address
|
||||
End Function
|
||||
@@ -97,7 +97,7 @@
|
||||
If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
|
||||
'应用筛选参数
|
||||
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={RESULT_PAGE_SIZE}&index=relevance"
|
||||
If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & EscapeUtils.UrlEscape(SearchText)
|
||||
If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & StringUtils.UrlEscape(SearchText)
|
||||
If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
|
||||
'facets=[["categories:'game-mechanics'"],["categories:'forge',categories:'fabric'"],["versions:1.19.3"],["project_type:mod"]]
|
||||
Dim Facets As New List(Of String)
|
||||
@@ -189,9 +189,9 @@
|
||||
#Region "中文搜索"
|
||||
|
||||
Dim RawSearchText As String = If(Request.SearchText, "").Trim
|
||||
RawSearchText = StrConv(RawSearchText, VbStrConv.SimplifiedChinese) '繁体转简体
|
||||
RawSearchText = RawSearchText.Lower
|
||||
Logger.Info($"工程列表搜索原始文本：{RawSearchText}")
|
||||
RawSearchText = StrConv(RawSearchText, VbStrConv.SimplifiedChinese) '繁体转简体
|
||||
|
||||
Dim IsChineseSearch As Boolean =
|
||||
RawSearchText.RegexCheck("[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawSearchText) AndAlso
|
||||
@@ -203,14 +203,14 @@
|
||||
Function(Result As SearchEntry(Of WikiEntry), Source As ResourcePlatforms) As IEnumerable(Of String)
|
||||
'从各个可能的来源提取候选
|
||||
Dim Candidates As New List(Of String)
|
||||
If Result.Item.CurseForgeSlug IsNot Nothing AndAlso Source = ResourcePlatforms.CurseForge Then
|
||||
Candidates.Add(Result.Item.CurseForgeSlug.Replace("-", " ").Replace("/", " "))
|
||||
If Result.Item.Slugs.ContainsKey(Source) Then
|
||||
Candidates.Add(Result.Item.Slugs(Source).
|
||||
Replace("-", " ").Replace("/", " "))
|
||||
End If
|
||||
If Result.Item.ModrinthSlug IsNot Nothing AndAlso Source = ResourcePlatforms.Modrinth Then
|
||||
Candidates.Add(Result.Item.ModrinthSlug.Replace("-", " ").Replace("/", " "))
|
||||
If Result.Item.ChineseName IsNot Nothing Then
|
||||
Candidates.Add(Result.Item.ChineseName.
|
||||
AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").Replace("-", " ").Replace("/", " ").Replace(":", " ").Replace("(", " ").Replace(")", ""))
|
||||
End If
|
||||
Candidates.Add(Result.Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
|
||||
Replace("-", " ").Replace("/", " ").Replace(":", " ").Replace("(", " ").Replace(")", ""))
|
||||
'分词、清洗、去重
|
||||
Candidates = Candidates.
|
||||
SelectMany(Function(c) c.Split(" ")).
|
||||
@@ -220,6 +220,7 @@
|
||||
If w.Length <= 1 Then Return False '单字或空白
|
||||
If {"the", "of", "mod", "and", "forge", "fabric", "for", "quilt", "neoforge"}.Contains(w) Then Return False '常见词
|
||||
If Val(w) > 0 Then Return False '数字
|
||||
If Not w.IsAsciiOnly Then Return False '非纯英文
|
||||
Return True
|
||||
End Function).Distinct.ToList
|
||||
'如果一个词可以由其他词拼成，则去掉这个词（例如将 ender io enderio 的 enderio 剔除，只保留 ender io）
|
||||
@@ -228,17 +229,26 @@
|
||||
Candidates = Candidates.Where(Function(w) Not Candidates.Any(Function(c) c.Length < w.Length AndAlso w.StartsWith(c) AndAlso CanForm(w.Substring(c.Length)))).ToList()
|
||||
Return Candidates
|
||||
End Function
|
||||
Dim GetSearchEntries =
|
||||
Iterator Function(Source As ResourcePlatforms)
|
||||
For Each Entry In WikiEntry.All.Value
|
||||
If Not Entry.Slugs.ContainsKey(Source) Then Continue For
|
||||
If Entry.ChineseName IsNot Nothing Then
|
||||
Yield New SearchEntry(Of WikiEntry) With {.Item = Entry, .SearchSource = New List(Of SearchSource) From {
|
||||
New SearchSource(StrConv(Entry.ChineseName.BeforeFirst(" ("), VbStrConv.SimplifiedChinese).Split("/"c, True), 1), '部分 Mod 有别名
|
||||
New SearchSource(StrConv(Entry.ChineseName.AfterFirst(" ("), VbStrConv.SimplifiedChinese) & Entry.Slugs(Source), 0.5)
|
||||
}}
|
||||
Else
|
||||
Yield New SearchEntry(Of WikiEntry) With {.Item = Entry, .SearchSource = New List(Of SearchSource) From {
|
||||
New SearchSource(Entry.Slugs(Source), 0.5)
|
||||
}}
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
'CurseForge
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.CurseForge) Then
|
||||
'数据库搜索
|
||||
Static CurseForgeSearchEntries As List(Of SearchEntry(Of WikiEntry)) =
|
||||
WikiEntry.All.Where(Function(Entry) Entry.CurseForgeSlug IsNot Nothing).Select(
|
||||
Function(Entry) New SearchEntry(Of WikiEntry) With {
|
||||
.Item = Entry,
|
||||
.SearchSource = New List(Of SearchSource) From {
|
||||
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split("/"c, True), 1), '部分 Mod 有别名
|
||||
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.CurseForgeSlug, 0.5)}
|
||||
}).ToList
|
||||
Static CurseForgeSearchEntries As List(Of SearchEntry(Of WikiEntry)) = GetSearchEntries(ResourcePlatforms.CurseForge).ToList()
|
||||
Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25)
|
||||
If CurseForgeSearchResults.Any Then
|
||||
'选取目标（CurseForge 要求每个词都必须匹配上，所以只能选择一个 Mod 进行搜索）
|
||||
@@ -255,14 +265,7 @@
|
||||
'Modrinth
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) Then
|
||||
'数据库搜索
|
||||
Static ModrinthSearchEntries As List(Of SearchEntry(Of WikiEntry)) =
|
||||
WikiEntry.All.Where(Function(Entry) Entry.ModrinthSlug IsNot Nothing).Select(
|
||||
Function(Entry) New SearchEntry(Of WikiEntry) With {
|
||||
.Item = Entry,
|
||||
.SearchSource = New List(Of SearchSource) From {
|
||||
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split("/"c, True), 1), '部分 Mod 有别名
|
||||
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.ModrinthSlug, 0.5)}
|
||||
}).ToList
|
||||
Static ModrinthSearchEntries As List(Of SearchEntry(Of WikiEntry)) = GetSearchEntries(ResourcePlatforms.Modrinth).ToList()
|
||||
Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25)
|
||||
If ModrinthSearchResults.Any Then
|
||||
'分词
|
||||
@@ -277,7 +280,7 @@
|
||||
ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key
|
||||
Logger.Warn($"中文搜索关键词（Modrinth）：{ModrinthAltSearchText}")
|
||||
'直接请求工程
|
||||
ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.ModrinthSlug).ToList
|
||||
ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.Slugs(ResourcePlatforms.Modrinth)).ToList
|
||||
End If
|
||||
End If
|
||||
'结束
|
||||
@@ -291,16 +294,17 @@
|
||||
|
||||
Dim RealResults As New List(Of ResourceProject)
|
||||
NextPage:
|
||||
Dim RawResults As New ConcurrentList(Of ResourceProject)
|
||||
Dim RawResults As New List(Of ResourceProject)
|
||||
|
||||
#Region "从 CurseForge 和 Modrinth 获取结果列表，存储于 RawResults"
|
||||
|
||||
Dim WorkThreads As New List(Of Thread)
|
||||
Dim Errors As New ConcurrentList(Of (Ex As Exception, Source As ResourcePlatforms))
|
||||
Dim Errors As New ConcurrentBag(Of (Ex As Exception, Source As ResourcePlatforms))
|
||||
|
||||
'在 1.14-，部分老 Mod 没有设置支持的加载器，因此添加 Forge 筛选就会出现遗漏
|
||||
'所以，在发起请求时不筛选加载器，然后在返回的结果中自行筛除不是 Forge 的 Mod
|
||||
Dim IgnoreModLoaderFilter = Request.ModLoaders = ModLoaders.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140
|
||||
Dim SearchResults As New ConcurrentBag(Of ResourceProject)
|
||||
Try
|
||||
|
||||
'CurseForge 搜索
|
||||
@@ -322,7 +326,7 @@ NextPage:
|
||||
ProjectList.Add(Project)
|
||||
Next
|
||||
'更新结果
|
||||
ProjectList.ForEach(Sub(p) RawResults.Add(p))
|
||||
ProjectList.ForEach(Sub(p) SearchResults.Add(p))
|
||||
Storage.CurseForgeOffset += RequestResult("data").Count
|
||||
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
|
||||
Logger.Info($"从 CurseForge 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）")
|
||||
@@ -350,7 +354,7 @@ NextPage:
|
||||
ProjectList.Add(New ResourceProject(JsonEntry))
|
||||
Next
|
||||
'更新结果
|
||||
ProjectList.ForEach(Sub(p) RawResults.Add(p))
|
||||
ProjectList.ForEach(Sub(p) SearchResults.Add(p))
|
||||
Storage.ModrinthOffset += RequestResult("hits").Count
|
||||
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
|
||||
Logger.Info($"从 Modrinth 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）")
|
||||
@@ -386,7 +390,7 @@ NextPage:
|
||||
ProjectList.Add(Project)
|
||||
Next
|
||||
'更新结果
|
||||
ProjectList.ForEach(Sub(p) RawResults.Add(p))
|
||||
ProjectList.ForEach(Sub(p) SearchResults.Add(p))
|
||||
Logger.Info($"从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
|
||||
ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
|
||||
Catch ex As Exception
|
||||
@@ -400,8 +404,9 @@ NextPage:
|
||||
'等待线程结束
|
||||
For Each Thread In WorkThreads
|
||||
Thread.Join()
|
||||
If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程
|
||||
If Task.IsCanceled Then Return '会自动触发 Finally 以清理线程
|
||||
Next
|
||||
RawResults = New List(Of ResourceProject)(SearchResults)
|
||||
|
||||
'仅保留兼容 Forge 的 Mod，或老版本中没有标注任何 Mod Loader 的 Mod
|
||||
If IgnoreModLoaderFilter Then
|
||||
@@ -510,7 +515,7 @@ NextPage:
|
||||
Next
|
||||
End If
|
||||
'根据排序分得出结果并添加
|
||||
If Task.IsInterrupted Then Throw New ThreadInterruptedException '#8246
|
||||
If Task.IsCanceled Then Throw New OperationCanceledException '#8246
|
||||
Storage.Results.AddRange(
|
||||
Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
''' <summary>
|
||||
''' <summary>
|
||||
''' 社区资源的单个可下载版本。
|
||||
''' </summary>
|
||||
Public Class ResourceVersion
|
||||
@@ -132,7 +132,7 @@ Public Class ResourceVersion
|
||||
'DownloadAddress
|
||||
Dim Url = Data("downloadUrl").ToString
|
||||
If Url = "" Then Url = $"https://edge.forgecdn.net/files/{CInt(.Id.ToString.Substring(0, 4))}/{CInt(.Id.ToString.Substring(4))}/{ .FileName}"
|
||||
.DownloadUrls = ParseCurseForgeDownloadUrls(Url.Replace(.FileName, EscapeUtils.UrlEscape(.FileName))) '对脑残 CurseForge 的下载地址进行多种修正
|
||||
.DownloadUrls = ParseCurseForgeDownloadUrls(Url.Replace(.FileName, StringUtils.UrlEscape(.FileName))) '对脑残 CurseForge 的下载地址进行多种修正
|
||||
.DownloadUrls.Add(DlSourceModGet(Url)) '添加镜像源；注意 MCIM 源不支持 URL 编码后的文件名，必须传入 URL 编码前的文件名
|
||||
.DownloadUrls = .DownloadUrls.Distinct.ToList '最终去重
|
||||
'Dependencies
|
||||
@@ -178,21 +178,20 @@ Public Class ResourceVersion
|
||||
.Size = File("size")
|
||||
.Hash = File("hashes")("sha1")
|
||||
End If
|
||||
'类别
|
||||
'类别与 Loaders
|
||||
'结果可能混杂着 Mod、数据包和服务端插件
|
||||
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
|
||||
.ModLoaders = ModLoaders.None
|
||||
If .ResourceType.HasFlag(ResourceTypes.Mod) OrElse .ResourceType.HasFlag(ResourceTypes.DataPack) Then
|
||||
If RawLoaders.Intersect({"bukkit", "folia", "paper", "purpur", "spigot"}).Any() Then .ResourceType = ResourceTypes.Plugin 'Veinminer Enchantment 同时支持服务端与 Fabric
|
||||
If RawLoaders.Contains("datapack") Then .ResourceType = ResourceTypes.DataPack
|
||||
If EnumUtils.GetAllFlags(Of ModLoaders)().Any() Then .ResourceType = ResourceTypes.Mod
|
||||
Else
|
||||
'使用传入的类别，不作修改（#8377）
|
||||
End If
|
||||
'Loaders
|
||||
For Each Loader As ModLoaders In EnumUtils.GetAllFlags(Of ModLoaders)()
|
||||
If RawLoaders.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader
|
||||
Next
|
||||
If .ResourceType.HasFlag(ResourceTypes.Mod) OrElse .ResourceType.HasFlag(ResourceTypes.DataPack) Then
|
||||
If RawLoaders.Intersect({"bukkit", "folia", "paper", "purpur", "spigot"}).Any() Then .ResourceType = ResourceTypes.Plugin 'Veinminer Enchantment 同时支持服务端与 Fabric
|
||||
If RawLoaders.Contains("datapack") Then .ResourceType = ResourceTypes.DataPack
|
||||
If .ModLoaders.Flags().Any() Then .ResourceType = ResourceTypes.Mod
|
||||
Else
|
||||
'使用传入的类别，不作修改（#8377）
|
||||
End If
|
||||
'Dependencies
|
||||
If Data.ContainsKey("dependencies") Then
|
||||
.RawDependencies = Data("dependencies").
|
||||
@@ -256,7 +255,7 @@ Public Class ResourceVersion
|
||||
Else 'Modrinth
|
||||
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version?include_changelog=false")
|
||||
End If
|
||||
ProjectFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) ResourceVersion.FromPlatformJson(a, TargetProject.Types)).
|
||||
ProjectFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) FromPlatformJson(a, TargetProject.Types)).
|
||||
Where(Function(a) a.DownloadAvailable).
|
||||
DistinctBy(Function(a) a.Id).ToList 'CurseForge 可能会重复返回相同项（#1330）
|
||||
End If
|
||||
@@ -313,13 +312,13 @@ Public Class ResourceVersion
|
||||
Public Function ToCacheJson() As JObject
|
||||
Dim Result As New JObject
|
||||
With Result
|
||||
.Add("ResourceType", ResourceType)
|
||||
.Add("ResourceType", CInt(ResourceType))
|
||||
.Add("Id", Id)
|
||||
If Version IsNot Nothing Then .Add("Version", Version)
|
||||
.Add("DisplayName", Display)
|
||||
.Add("ReleaseDate", ReleaseDate)
|
||||
.Add("DownloadCount", DownloadCount)
|
||||
.Add("ModLoaders", ModLoaders)
|
||||
.Add("ModLoaders", CInt(ModLoaders))
|
||||
.Add("GameVersions", New JArray(GameVersions))
|
||||
.Add("ReleaseType", CInt(ReleaseType))
|
||||
If FileName IsNot Nothing Then .Add("FileName", FileName)
|
||||
@@ -359,17 +358,14 @@ Public Class ResourceVersion
|
||||
If .Title <> FileName.BeforeLast(".") Then Yield FileName.BeforeLast(".")
|
||||
If Dependencies.Any Then Yield $"{Dependencies.Count} 项前置"
|
||||
If GameVersions.All(Function(v) Not v.Contains(".") OrElse {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) v.ContainsIgnoreCase(s))) Then Yield $"游戏版本 {GameVersions.Join("、"c)}"
|
||||
If DownloadCount > 0 Then Yield $"下载 {If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万", DownloadCount & " ")}次" 'CurseForge 的下载次数经常错误地返回 0
|
||||
Yield $"更新于 {GetTimeSpanString(ReleaseDate - Date.Now, False)}"
|
||||
If DownloadCount > 0 Then Yield $"下载 {If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万", DownloadCount.ToString() + " ")}次" 'CurseForge 的下载次数经常错误地返回 0
|
||||
Yield $"更新于 {StringUtils.FormatTimeSpan(ReleaseDate - Date.Now, False)}"
|
||||
If ReleaseType <> ReleaseTypes.Release Then Yield ReleaseTypeDisplay
|
||||
End Function().Join("，"c)
|
||||
|
||||
'另存为按钮
|
||||
If SaveAsButtonHandler IsNot Nothing Then
|
||||
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
|
||||
ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
|
||||
ToolTipService.SetVerticalOffset(BtnSave, 30)
|
||||
ToolTipService.SetHorizontalOffset(BtnSave, 2)
|
||||
AddHandler BtnSave.Click, SaveAsButtonHandler
|
||||
.Buttons = {BtnSave}
|
||||
End If
|
||||
@@ -383,17 +379,18 @@ Public Class ResourceVersion
|
||||
''' </summary>
|
||||
''' <param name="LocalFileOrFolder">目标本地文件夹，或完整的文件路径。会自动判断类型。</param>
|
||||
Public Function ToNetFile(LocalFileOrFolder As String,
|
||||
Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As NetFile
|
||||
Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As NetFile
|
||||
Return New NetFile(
|
||||
ParseModrinthTrackArguments(DownloadUrls, TrackDownloadReason, TrackGameVersion, TrackLoader),
|
||||
LocalFileOrFolder & If(LocalFileOrFolder.EndsWithF("\"), FileName, ""),
|
||||
New FileChecker(Hash:=Hash, ActualSize:=Size),
|
||||
New FileChecker With {.Hash = Hash, .ActualSize = Size},
|
||||
SimulateBrowserHeaders:=True)
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 添加 Modrinth 追踪参数。
|
||||
''' </summary>
|
||||
Public Shared Iterator Function ParseModrinthTrackArguments(Urls As List(Of String), Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As IEnumerable(Of String)
|
||||
Public Shared Iterator Function ParseModrinthTrackArguments(Urls As List(Of String),
|
||||
Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As IEnumerable(Of String)
|
||||
Dim Arguments As New Dictionary(Of String, String)
|
||||
If TrackDownloadReason IsNot Nothing Then Arguments.Add("mr_download_reason", TrackDownloadReason.ToString.Lower)
|
||||
If TrackGameVersion IsNot Nothing Then Arguments.Add("mr_game_version", TrackGameVersion)
|
||||
|
||||
@@ -1,84 +0,0 @@
|
||||
'获取所有条目：WikiEntry.All
|
||||
|
||||
''' <summary>
|
||||
''' MC 百科条目。
|
||||
''' </summary>
|
||||
Public Class WikiEntry
|
||||
|
||||
'属性
|
||||
|
||||
''' <summary>
|
||||
''' 在 MC 百科中的对应 ID。
|
||||
''' </summary>
|
||||
Public Id As Integer
|
||||
''' <summary>
|
||||
''' 中文译名。空字符串代表没有翻译。
|
||||
''' </summary>
|
||||
Public ChineseName As String = ""
|
||||
''' <summary>
|
||||
''' CurseForge Slug（例如 advanced-solar-panels）。
|
||||
''' </summary>
|
||||
Public CurseForgeSlug As String = Nothing
|
||||
''' <summary>
|
||||
''' Modrinth Slug（例如 advanced-solar-panels）。
|
||||
''' </summary>
|
||||
Public ModrinthSlug As String = Nothing
|
||||
''' <summary>
|
||||
''' MC 百科的浏览量逆序排行，1 代表浏览量最低。
|
||||
''' </summary>
|
||||
Public Popularity As Integer
|
||||
Public Overrides Function ToString() As String
|
||||
Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & Id & "|" & ChineseName & ", Rank " & Popularity
|
||||
End Function
|
||||
|
||||
'读取
|
||||
|
||||
''' <summary>
|
||||
''' 内置数据库中的所有 MC 百科条目。
|
||||
''' </summary>
|
||||
Public Shared ReadOnly Property All As List(Of WikiEntry)
|
||||
Get
|
||||
Static Cache As List(Of WikiEntry) = Nothing
|
||||
If Cache IsNot Nothing Then Return Cache
|
||||
'实际加载
|
||||
Cache = New List(Of WikiEntry)
|
||||
Dim i As Integer = 0
|
||||
Dim DataLines As List(Of String) = DirectCast(My.Resources.ResourceManager.GetObject("ModData"), String).SplitLines().ToList()
|
||||
Dim Ranks = DataLines.Last.Split("|")
|
||||
DataLines.RemoveAt(DataLines.Count - 1)
|
||||
For Each Line In DataLines
|
||||
i += 1
|
||||
If Line = "" Then Continue For
|
||||
For Each EntryData As String In Line.Split("¨")
|
||||
Dim Entry = New WikiEntry
|
||||
Dim Splited = EntryData.Split("|")
|
||||
If Splited(0).StartsWithF("@") Then
|
||||
Entry.CurseForgeSlug = Nothing
|
||||
Entry.ModrinthSlug = Splited(0).Replace("@", "")
|
||||
ElseIf Splited(0).EndsWithF("@") Then
|
||||
Entry.CurseForgeSlug = Splited(0).TrimEnd("@")
|
||||
Entry.ModrinthSlug = Entry.CurseForgeSlug
|
||||
ElseIf Splited(0).Contains("@") Then
|
||||
Entry.CurseForgeSlug = Splited(0).Split("@")(0)
|
||||
Entry.ModrinthSlug = Splited(0).Split("@")(1)
|
||||
Else
|
||||
Entry.CurseForgeSlug = Splited(0)
|
||||
Entry.ModrinthSlug = Nothing
|
||||
End If
|
||||
Entry.Id = i
|
||||
Entry.Popularity = Val(Ranks(i - 1))
|
||||
If Splited.Count >= 2 Then
|
||||
Entry.ChineseName = Splited.Last
|
||||
If Entry.ChineseName.Contains("*") Then '处理 *
|
||||
Entry.ChineseName = Entry.ChineseName.Replace("*",
|
||||
$" ({If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Replace("-", " ").Capitalize})")
|
||||
End If
|
||||
End If
|
||||
Cache.Add(Entry)
|
||||
Next
|
||||
Next
|
||||
Return Cache
|
||||
End Get
|
||||
End Property
|
||||
|
||||
End Class
|
||||
+1
-1
@@ -1,4 +1,4 @@
|
||||
'来源：https://blog.csdn.net/simpleman2000/article/details/140952294
|
||||
'来源：https://blog.csdn.net/simpleman2000/article/details/140952294
|
||||
|
||||
Imports System.ComponentModel
|
||||
Imports System.Runtime.InteropServices
|
||||
|
||||
Reference in New Issue
Block a user