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

2.12.4

Browse Source
This commit is contained in:
龙腾猫跃
2026-03-24 22:53:27 +08:00
parent 43963f8f7c
commit 6a140ce5b9
72 changed files with 28308 additions and 27967 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+261 -253
View File
@@ -60,23 +60,24 @@
If Line = "" Then Continue For
For Each EntryData As String In Line.Split("¨")
Dim Entry = New CompDatabaseEntry
Dim SplitedLine = EntryData.Split("|")
If SplitedLine(0).StartsWithF("@") Then
Dim Splited = EntryData.Split("|")
Entry.Popularity = Val(Splited(0))
If Splited(1).StartsWithF("@") Then
Entry.CurseForgeSlug = Nothing
Entry.ModrinthSlug = SplitedLine(0).Replace("@", "")
ElseIf SplitedLine(0).EndsWithF("@") Then
Entry.CurseForgeSlug = SplitedLine(0).TrimEnd("@")
Entry.ModrinthSlug = Splited(1).Replace("@", "")
ElseIf Splited(1).EndsWithF("@") Then
Entry.CurseForgeSlug = Splited(1).TrimEnd("@")
Entry.ModrinthSlug = Entry.CurseForgeSlug
ElseIf SplitedLine(0).Contains("@") Then
Entry.CurseForgeSlug = SplitedLine(0).Split("@")(0)
Entry.ModrinthSlug = SplitedLine(0).Split("@")(1)
ElseIf Splited(1).Contains("@") Then
Entry.CurseForgeSlug = Splited(1).Split("@")(0)
Entry.ModrinthSlug = Splited(1).Split("@")(1)
Else
Entry.CurseForgeSlug = SplitedLine(0)
Entry.CurseForgeSlug = Splited(1)
Entry.ModrinthSlug = Nothing
End If
Entry.WikiId = i
If SplitedLine.Count >= 2 Then
Entry.ChineseName = SplitedLine(1)
If Splited.Count >= 3 Then
Entry.ChineseName = Splited.Last
If Entry.ChineseName.Contains("*") Then '处理 *
Entry.ChineseName = Entry.ChineseName.Replace("*",
$" ({If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Replace("-", " ").Capitalize})")
@@ -106,9 +107,13 @@
''' 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, "") & "|" & WikiId & "|" & ChineseName
Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & WikiId & "|" & ChineseName & ", Rank " & Popularity
End Function
End Class
@@ -161,9 +166,9 @@
''' </summary>
Public ReadOnly Website As String
''' <summary>
''' 最后一次更新的时间。可能为 Nothing。
''' 最后一次更新的时间。
''' </summary>
Public ReadOnly LastUpdate As Date? = Nothing
Public ReadOnly LastUpdate As Date
''' <summary>
''' 下载量计数。注意，该计数仅为一个来源，无法反应两边加起来的下载量！
''' </summary>
@@ -242,7 +247,7 @@
RawName = Data("RawName")
Description = Data("Description")
Website = Data("Website")
If Data.ContainsKey("LastUpdate") Then LastUpdate = Data("LastUpdate")
LastUpdate = Data("LastUpdate")
DownloadCount = Data("DownloadCount")
If Data.ContainsKey("ModLoaders") Then
ModLoaders = CType(Data("ModLoaders"), JArray).Select(Function(t) CType(t.ToObject(Of Integer), CompModLoaderType)).ToList
@@ -396,7 +401,7 @@
Slug = Data("slug")
RawName = Data("title")
Description = Data("description")
LastUpdate = Data("date_modified")
LastUpdate = If(Data("date_modified"), Data("updated"))
DownloadCount = Data("downloads")
LogoUrl = Data("icon_url")
If LogoUrl = "" Then LogoUrl = Nothing
@@ -521,7 +526,7 @@
Json("RawName") = RawName
Json("Description") = Description
Json("Website") = Website
If LastUpdate IsNot Nothing Then Json("LastUpdate") = LastUpdate
Json("LastUpdate") = LastUpdate
Json("DownloadCount") = DownloadCount
If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
Json("Tags") = New JArray(Tags)
@@ -583,10 +588,10 @@
'获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
Dim ModLoadersForDesc As New List(Of CompModLoaderType)(ModLoaders)
If Setup.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(CompModLoaderType.Quilt)
If Settings.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(CompModLoaderType.Quilt)
Select Case ModLoadersForDesc.Count
Case 0
If ModLoaders.Count = 1 Then
If ModLoaders.IsSingle Then
ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString
ModLoaderDescriptionPart = ModLoaders.Single.ToString
Else
@@ -601,7 +606,7 @@
If ModLoaders.Contains(CompModLoaderType.Forge) AndAlso
(NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso
(NewestDrop < 200 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso
(NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then
(NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Settings.Get("ToolDownloadIgnoreQuilt")) Then
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
Else
@@ -614,12 +619,12 @@
Function()
Dim NewItem As New MyCompItem With {.Tag = Me}
ApplyLogoToMyImage(NewItem.PathLogo)
Dim Title = GetControlTitle(True)
NewItem.Title = Title.Key
If Title.Value = "" Then
Dim Titles = GetControlTitle(True)
NewItem.Title = Titles.Title
If Titles.SubTitle = "" Then
CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
Else
NewItem.SubTitle = Title.Value
NewItem.SubTitle = Titles.SubTitle
End If
NewItem.Tags = Tags
NewItem.Description = Description.Replace(vbCr, "").Replace(vbLf, "")
@@ -642,17 +647,10 @@
NewItem.LabVersion.Text = ModLoaderDescriptionFull
End If
NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth")
If LastUpdate IsNot Nothing Then
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
Else
NewItem.LabTime.Visibility = Visibility.Collapsed
NewItem.ColumnTime1.Width = New GridLength(0)
NewItem.ColumnTime2.Width = New GridLength(0)
NewItem.ColumnTime3.Width = New GridLength(0)
End If
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
NewItem.LabDownload.Text =
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
Return NewItem
End Function) With {.Height = 64}
End Function
@@ -664,7 +662,7 @@
Img.FallbackSource = DlSourceModGet(LogoUrl)
End If
End Sub
Public Function GetControlTitle(HasModLoaderDescription As Boolean) As KeyValuePair(Of String, String)
Public Function GetControlTitle(HasModLoaderDescription As Boolean) As (Title As String, SubTitle As String)
'检查下列代码时可以参考 #1567 的测试例
Dim Title As String = RawName
Dim SubtitleList As List(Of String)
@@ -672,18 +670,18 @@
'没有中文翻译
'将所有名称分段
Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList
If NameLists.Count = 1 Then GoTo NoSubtitle
Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w))
If NameLists.IsSingle Then GoTo NoSubtitle
'查找其中的缩写、Forge/Fabric 等版本标记
SubtitleList = New List(Of String)
Dim NormalNameList = New List(Of String)
For Each Name In NameLists
Dim LowerName As String = Name.ToLower
If Name.ToUpper = Name AndAlso Name <> "FPS" AndAlso Name <> "HUD" Then
Dim LowerName As String = Name.Lower
If Name = Name.Upper AndAlso Name <> "FPS" AndAlso Name <> "HUD" Then
'缩写
SubtitleList.Add(Name)
ElseIf (LowerName.Contains("forge") OrElse LowerName.Contains("fabric") OrElse LowerName.Contains("quilt")) AndAlso
Not RegexCheck(LowerName.Replace("forge", "").Replace("fabric", "").Replace("quilt", ""), "[a-z]+") Then '去掉关键词后没有其他字母
ElseIf {"neoforge", "forge", "fabric", "quilt"}.Any(Function(l) LowerName.Contains(l)) AndAlso
Not RegexCheck(LowerName.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", ""), "[a-z]+") Then '去掉关键词后没有其他字母
'Forge/Fabric 等版本标记
SubtitleList.Add(Name)
Else
@@ -698,8 +696,8 @@
Else
'有中文翻译
'尝试将文本分为三段：Title (EnglishName) - Suffix
'检查时注意 Carpet：它没有中文译名，但有 Suffix
Title = TranslatedName.BeforeFirst(" (").BeforeFirst(" - ")
'检查时注意 Carpet（它没有中文译名，但有 Suffix）和 “汤姆存储 - 星的奇妙优化 (Tom's balabala)”
Title = If(TranslatedName.Contains(" ("), TranslatedName.BeforeFirst(" ("), TranslatedName.BeforeLast(" - "))
Dim Suffix As String = ""
If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ")
Dim EnglishName As String = TranslatedName
@@ -709,8 +707,8 @@
SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList
If SubtitleList.Count > 1 AndAlso
Not SubtitleList.Any(Function(s) s.ToLower.Contains("forge") OrElse s.ToLower.Contains("fabric") OrElse s.ToLower.Contains("quilt")) AndAlso '不是标注 XX 版
Not (SubtitleList.Count = 2 AndAlso SubtitleList.Last.ToUpper = SubtitleList.Last) Then '不是缩写
Not SubtitleList.Any(Function(s) s.Lower.Contains("forge") OrElse s.Lower.Contains("fabric") OrElse s.Lower.Contains("quilt")) AndAlso '不是标注 XX 版
Not (SubtitleList.Count = 2 AndAlso SubtitleList.Last.Upper = SubtitleList.Last) Then '不是缩写
SubtitleList = New List(Of String) From {EnglishName} '使用原名
End If
'添加后缀
@@ -722,25 +720,25 @@
If SubtitleList.Any Then
For Each Ex In SubtitleList
Dim IsModLoaderDescription As Boolean =
Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt")
Ex.Lower.Contains("neoforge") OrElse Ex.Lower.Contains("forge") OrElse Ex.Lower.Contains("fabric") OrElse Ex.Lower.Contains("quilt")
'是否显示 ModLoader 信息
If Not HasModLoaderDescription AndAlso IsModLoaderDescription Then Continue For
'去除 “Forge/Fabric” 这一无意义提示
If Ex.Length < 16 AndAlso Ex.ToLower.Contains("fabric") AndAlso Ex.ToLower.Contains("forge") Then Continue For
If Ex.Length < 16 AndAlso Ex.Lower.Contains("fabric") AndAlso Ex.Lower.Contains("forge") Then Continue For
'将 “Forge” 等提示改为 “Forge 版”
If IsModLoaderDescription AndAlso Not Ex.Contains("版") AndAlso
Ex.ToLower.Replace("forge", "").Replace("fabric", "").Replace("quilt", "").Length <= 3 Then
Ex.Lower.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", "").Length <= 3 Then
Ex = Ex.Replace("Edition", "").Replace("edition", "").Trim.Capitalize & " 版"
End If
'将 “forge” 等词语的首字母大写
Ex = Ex.Replace("forge", "Forge").Replace("neo", "Neo").Replace("fabric", "Fabric").Replace("quilt", "Quilt")
Ex = Ex.Replace("neoforge", "NeoForge").Replace("forge", "Forge").Replace("neo", "Neo").Replace("fabric", "Fabric").Replace("quilt", "Quilt")
Subtitle &= " | " & Ex.Trim
Next
Else
NoSubtitle:
Subtitle = ""
End If
Return New KeyValuePair(Of String, String)(Title, Subtitle)
Return (Title, Subtitle)
End Function
'辅助函数
@@ -757,7 +755,7 @@ NoSubtitle:
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r)
Next
Return Result.ToString.ToLower
Return Result.ToString.Lower
End Function
'来自不同的网站
If FromCurseForge = Project.FromCurseForge Then Return False
@@ -766,8 +764,7 @@ NoSubtitle:
'若不为光影，则要求 MC 版本一致
If Type <> CompType.Shader AndAlso (Drops.Count <> Project.Drops.Count OrElse Drops.Except(Project.Drops).Any()) Then Return False
'最近更新时间差距在一周以内
If LastUpdate IsNot Nothing AndAlso Project.LastUpdate IsNot Nothing AndAlso
Math.Abs((LastUpdate - Project.LastUpdate).Value.TotalDays) > 7 Then Return False
If Math.Abs((LastUpdate - Project.LastUpdate).TotalDays) > 7 Then Return False
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -842,21 +839,13 @@ NoSubtitle:
''' </summary>
Public GameVersion As String = Nothing
''' <summary>
''' 搜索的文本内容。
''' 搜索的初始内容。
''' </summary>
Public SearchText As String = Nothing
''' <summary>
''' 在进行中文搜索时，CurseForge 的替代搜索文本。
''' 由于 CurseForge API 在有任意关键词未匹配的时候就不显示结果，所以不能使用与 Modrinth 相同的算法。
''' </summary>
Public CurseForgeAltSearchText As String = Nothing
''' <summary>
''' 允许的来源。
''' </summary>
Public Source As CompSourceType = CompSourceType.Any
''' <summary>
''' 构造函数。
''' </summary>
Public Sub New(Type As CompType, Storage As CompProjectStorage, TargetResultCount As Integer)
Me.Type = Type
Me.Storage = Storage
@@ -866,14 +855,12 @@ NoSubtitle:
'构造请求
''' <summary>
''' 获取对应的 CurseForge API 请求链接。若返回 Nothing 则为不进行 CurseForge 请求。
''' 获取对应的 CurseForge API 请求链接。
''' </summary>
Public Function GetCurseForgeAddress() As String
If Not Source.HasFlag(CompSourceType.CurseForge) Then Return Nothing
Public Function GetCurseForgeAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
If Tag.StartsWithF("/") Then Storage.CurseForgeTotal = 0
If Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset Then Return Nothing
'应用筛选参数
Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={CompPageSize}"
Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={COMP_PAGE_SIZE}"
Select Case Type
Case CompType.Mod
Address += "&classId=6"
@@ -887,28 +874,26 @@ NoSubtitle:
Address += "&classId=12"
End Select
If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/")
If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
If ModLoader <> CompModLoaderType.Any AndAlso Not IgnoreModLoaderFilter Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
If Not String.IsNullOrEmpty(If(CurseForgeAltSearchText, SearchText)) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(If(CurseForgeAltSearchText, SearchText))
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
Return Address
End Function
''' <summary>
''' 获取对应的 Modrinth API 请求链接。若返回 Nothing 则为不进行 Modrinth 请求。
''' 获取对应的 Modrinth API 请求链接。
''' </summary>
Public Function GetModrinthAddress() As String
If Not Source.HasFlag(CompSourceType.Modrinth) Then Return Nothing
Public Function GetModrinthAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
If Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset Then Return Nothing
'应用筛选参数
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={CompPageSize}&index=relevance"
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={COMP_PAGE_SIZE}&index=relevance"
If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & Net.WebUtility.UrlEncode(SearchText)
If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
Dim Facets As New List(Of String)
Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]")
Facets.Add($"[""project_type:{GetStringFromEnum(Type).Lower}""]")
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]")
If ModLoader <> CompModLoaderType.Any AndAlso Not IgnoreModLoaderFilter Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).Lower}'""]")
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
Address += "&facets=[" & String.Join(",", Facets) & "]"
Return Address
@@ -928,6 +913,9 @@ NoSubtitle:
Public Shared Operator <>(left As CompProjectRequest, right As CompProjectRequest) As Boolean
Return Not left = right
End Operator
Public Overrides Function GetHashCode() As Integer
Return (Type, Tag, ModLoader, GameVersion, SearchText, Source).GetHashCode()
End Function
End Class
Public Class CompProjectStorage
@@ -955,7 +943,8 @@ NoSubtitle:
'实际的获取
Private Const CompPageSize = 40
Private Const COMP_PAGE_SIZE = 40
Private Const MSG_NO_CHINESE_SEARCH_RESULT As String = "无搜索结果，请尝试搜索其英文名称"
''' <summary>
''' 已知工程信息的缓存。
''' </summary>
@@ -965,157 +954,156 @@ NoSubtitle:
''' </summary>
Public Sub CompProjectsGet(Task As LoaderTask(Of CompProjectRequest, Integer))
Dim Request As CompProjectRequest = Task.Input
Dim Storage = Request.Storage '避免多线程问题
Dim Storage = Request.Storage '避免其他线程对 Request.Storage 重新进行了赋值
If Request.Storage.Results.Count >= Request.TargetResultCount Then
Log($"[Comp] 已有 {Request.Storage.Results.Count} 个结果，多于所需的 {Request.TargetResultCount} 个结果，结束处理")
#Region "前置检查"
If Storage.Results.Count >= Request.TargetResultCount Then
Log($"[Comp] 已有 {Storage.Results.Count} 个结果，多于所需的 {Request.TargetResultCount} 个结果，结束处理")
Return
ElseIf Not Request.CanContinue Then
If Not Request.Storage.Results.Any() Then
If Not Storage.Results.Any() Then
Throw New Exception("没有符合条件的结果")
Else
Log($"[Comp] 已有 {Request.Storage.Results.Count} 个结果，少于所需的 {Request.TargetResultCount} 个结果，但无法继续获取，结束处理")
Log($"[Comp] 已有 {Storage.Results.Count} 个结果，少于所需的 {Request.TargetResultCount} 个结果，但无法继续获取，结束处理")
Return
End If
End If
#Region "拒绝 1.13- Quilt（这个版本根本没有 Quilt）"
'拒绝 1.13- Quilt（这个版本根本没有 Quilt）
If Request.ModLoader = CompModLoaderType.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
End If
#End Region
#Region "处理搜索文本，赋值回 Task.Input.SearchText"
#Region "中文搜索"
Dim RawFilter As String = If(Request.SearchText, "").Trim
Request.SearchText = RawFilter
RawFilter = RawFilter.ToLower
Log("[Comp] 工程列表搜索原始文本：" & RawFilter)
Dim RawSearchText As String = If(Request.SearchText, "").Trim
RawSearchText = RawSearchText.Lower
Log("[Comp] 工程列表搜索原始文本：" & RawSearchText)
'中文请求关键字处理
Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawFilter)
If IsChineseSearch AndAlso (Request.Type = CompType.Mod OrElse Request.Type = CompType.DataPack) Then
'构造搜索请求
Dim SearchEntries As New List(Of SearchEntry(Of CompDatabaseEntry))
For Each Entry In CompDatabase
SearchEntries.Add(New SearchEntry(Of CompDatabaseEntry) With {
Dim IsChineseSearch As Boolean =
RegexCheck(RawSearchText, "[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawSearchText) AndAlso
(Request.Type = CompType.Mod OrElse Request.Type = CompType.DataPack) '目前仅对 Mod 和数据包进行中文搜索，注意整合包的名称可能已经有中文了
Dim CurseForgeAltSearchText As String = Nothing, ModrinthAltSearchText As String = Nothing, ModrinthSlugs As New List(Of String) '从中文转为英文的替代搜索内容
If IsChineseSearch Then
'帮助方法：从搜索项提取可能的英文单词
Dim ExtractWords =
Function(Result As SearchEntry(Of CompDatabaseEntry), Source As CompSourceType) As IEnumerable(Of String)
'从各个可能的来源提取候选
Dim Candidates As New List(Of String)
If Result.Item.CurseForgeSlug IsNot Nothing AndAlso Source = CompSourceType.CurseForge Then
Candidates.Add(Result.Item.CurseForgeSlug.Replace("-", " ").Replace("/", " "))
End If
If Result.Item.ModrinthSlug IsNot Nothing AndAlso Source = CompSourceType.Modrinth Then
Candidates.Add(Result.Item.ModrinthSlug.Replace("-", " ").Replace("/", " "))
End If
Candidates.Add(Result.Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
Replace("-", " ").Replace("/", " ").Replace(":", " ").Replace("(", " ").Replace(")", ""))
'分词、清洗、去重
Candidates = Candidates.
SelectMany(Function(c) c.Split(" ")).
Select(Function(w) w.TrimStart("{[(").TrimEnd("}])").Lower).
Where(
Function(w)
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 '数字
Return True
End Function).Distinct.ToList
'如果一个词可以由其他词拼成，则去掉这个词（例如将 ender io enderio 的 enderio 剔除，只保留 ender io）
Dim CanForm As Func(Of String, Boolean) = Nothing
CanForm = Function(s) Candidates.Contains(s) OrElse Candidates.Any(Function(c) s.StartsWith(c) AndAlso CanForm(s.Substring(c.Length)))
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
'CurseForge
If Request.Source.HasFlag(CompSourceType.CurseForge) Then
'数据库搜索
Static CurseForgeSearchEntries As List(Of SearchEntry(Of CompDatabaseEntry)) =
CompDatabase.Where(Function(Entry) Entry.CurseForgeSlug IsNot Nothing).Select(
Function(Entry) New SearchEntry(Of CompDatabaseEntry) With {
.Item = Entry,
.SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.AfterFirst(" (") & If(Entry.CurseForgeSlug, "") & If(Entry.ModrinthSlug, ""), 0.5)
}
})
Next
Dim SearchResults = Search(SearchEntries, Request.SearchText, 40, 0.2)
If Not SearchResults.Any() Then Throw New Exception("无搜索结果，请尝试搜索英文名称")
'提取可能的英文名
Dim ExtractWords =
Function(Result As SearchEntry(Of CompDatabaseEntry)) As String()
Dim Word As String = ""
If Result.Item.CurseForgeSlug IsNot Nothing Then Word += Result.Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " "
If Result.Item.ModrinthSlug IsNot Nothing Then Word += Result.Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " "
Word += Result.Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ").Replace("-", " ")
Dim Words = Word.ToLower.Split(" ")
Words = Words.Select(Function(w) w.TrimStart("{[(").TrimEnd("}])")).Where(
Function(w)
If w.Length <= 1 Then Return False '单字词
If {"the", "of", "mod", "and"}.Contains(w) Then Return False '常见词
If Val(w) > 0 Then Return False '数字
If w.Split(" ").Count > 3 AndAlso w.Contains("ftb") Then Return False '神秘 FTB
Return True
End Function).Distinct.ToArray
Return Words
End Function
Dim WordWeights As New Dictionary(Of String, Double) '各个单词及其出现的权重
For Each Result In SearchResults
For Each Word In ExtractWords(Result)
Dim Similarity = If(Result.SearchSource.Any(Function(s) s.Aliases.Contains(Request.SearchText)), 100000, Result.Similarity) '完全匹配为 100000
If Not WordWeights.ContainsKey(Word) Then WordWeights.Add(Word, 0)
WordWeights(Word) += Similarity
Next
Next
If Not WordWeights.Any() Then Throw New Exception("无搜索结果，请尝试搜索英文名称")
'根据权重选取英文单词
Dim SortedWords = WordWeights.OrderByDescending(Function(w) w.Value).ToList
If SortedWords.First.Value >= 100000 Then '如果有完全匹配的，就只选完全匹配的
Request.SearchText = SortedWords.Where(Function(w) w.Value >= 100000).Select(Function(w) w.Key).Join(" ")
Else '否则，CurseForge 选第一个结果，Modrinth 选前 5 个单词
Request.SearchText = SortedWords.Take(5).Select(Function(w) w.Key).Join(" ")
Request.CurseForgeAltSearchText = ExtractWords(SearchResults.First).Join(" ")
Log("[Comp] 中文搜索基础关键词（CurseForge）：" & Request.CurseForgeAltSearchText, LogLevel.Developer)
End If
Log("[Comp] 中文搜索基础关键词：" & Request.SearchText, LogLevel.Developer)
End If
'最终处理关键字：分割、去重
Dim ProcessKeywords =
Sub(ByRef Text As String)
If Text Is Nothing Then Return
Text = Text.ToLowerInvariant
Dim Words As New List(Of String)
For Each Keyword In Text.Split(" ")
Keyword = Keyword.Trim("["c, "]"c)
If Keyword = "" Then Continue For
If {"forge", "fabric", "for", "mod", "quilt"}.Contains(Keyword) Then '#208
Log("[Comp] 已跳过搜索关键词：" & Keyword, LogLevel.Developer)
Continue For
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.CurseForgeSlug, 0.5)}
}).ToList
Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25)
If CurseForgeSearchResults.Any Then
'选取目标（CurseForge 要求每个词都必须匹配上，所以只能选择一个 Mod 进行搜索）
Dim CurseForgeTarget =
If(CurseForgeSearchResults.First.AbsoluteRight,
CurseForgeSearchResults.Where(Function(s) s.AbsoluteRight).ToList, '优先使用所有完全匹配的
CurseForgeSearchResults.MaxByAll(Function(s) s.Similarity)). '其次使用所有相似度最高的
MaxBy(Function(s) s.Item.Popularity) '然后从中选择最受欢迎的那一个
'后处理
CurseForgeAltSearchText = ExtractWords(CurseForgeTarget, CompSourceType.CurseForge).Join(" ")
Log("[Comp] 中文搜索关键词（CurseForge）：" & CurseForgeAltSearchText, LogLevel.Debug)
End If
Words.Add(Keyword)
Next
If RawFilter.Length > 0 AndAlso Not Words.Any() Then
Text = RawFilter '全都被过滤掉了
Else
Text = Join(Words.Distinct.ToList, " ")
End If
'例外项：OptiForge、OptiFabric（拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod）
If RawFilter.Replace(" ", "").ContainsF("optiforge", True) Then Text = "optiforge"
If RawFilter.Replace(" ", "").ContainsF("optifabric", True) Then Text = "optifabric"
End Sub
If Request.CurseForgeAltSearchText IsNot Nothing Then
ProcessKeywords(Request.CurseForgeAltSearchText)
Log("[Comp] 工程列表搜索最终文本（CurseForge）：" & Request.CurseForgeAltSearchText, LogLevel.Debug)
'Modrinth
If Request.Source.HasFlag(CompSourceType.Modrinth) Then
'数据库搜索
Static ModrinthSearchEntries As List(Of SearchEntry(Of CompDatabaseEntry)) =
CompDatabase.Where(Function(Entry) Entry.ModrinthSlug IsNot Nothing).Select(
Function(Entry) New SearchEntry(Of CompDatabaseEntry) With {
.Item = Entry,
.SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.ModrinthSlug, 0.5)}
}).ToList
Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25)
If ModrinthSearchResults.Any Then
'分词
Dim WordWeights As New Dictionary(Of String, Double) '各个单词及其出现的权重
For Each Result In ModrinthSearchResults
For Each Word In ExtractWords(Result, CompSourceType.Modrinth)
If Not WordWeights.ContainsKey(Word) Then WordWeights.Add(Word, 0)
Dim Similarity = If(Result.SearchSource.Any(Function(s) s.Aliases.Contains(RawSearchText)), 1000, Result.Similarity) '完全匹配为 1000
WordWeights(Word) += Similarity * Result.Item.Popularity '权重 += 相似度 * 受欢迎程度
Next
Next
ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key
Log("[Comp] 中文搜索关键词（Modrinth）：" & ModrinthAltSearchText, LogLevel.Debug)
'直接请求工程
ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.ModrinthSlug).ToList
End If
End If
'结束
If String.IsNullOrEmpty(CurseForgeAltSearchText) AndAlso String.IsNullOrEmpty(ModrinthAltSearchText) AndAlso Not ModrinthSlugs.Any Then
Throw New Exception(MSG_NO_CHINESE_SEARCH_RESULT)
End If
End If
ProcessKeywords(Request.SearchText)
Log("[Comp] 工程列表搜索最终文本：" & Request.SearchText, LogLevel.Debug)
Task.Progress = 0.1
Task.Progress = 0.05
#End Region
Dim RealResults As New List(Of CompProject)
Retry:
Dim RawResults As New List(Of CompProject)
Dim [Error] As Exception = Nothing
NextPage:
Dim RawResults As New SafeList(Of CompProject)
#Region "从 CurseForge 和 Modrinth 获取结果列表，存储于 RawResults"
Dim CurseForgeThread As Thread = Nothing
Dim ModrinthThread As Thread = Nothing
Dim ResultsLock As New Object
Dim WorkThreads As New List(Of Thread)
Dim Errors As New SafeList(Of (Ex As Exception, Source As CompSourceType))
'在 1.14-，部分老 Mod 没有设置支持的加载器，因此添加 Forge 筛选就会出现遗漏
'所以，在发起请求时不筛选加载器，然后在返回的结果中自行筛除不是 Forge 的 Mod
Dim IsOldForgeRequest = Request.ModLoader = CompModLoaderType.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion, True) < 140
If IsOldForgeRequest Then Request.ModLoader = CompModLoaderType.Any
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress()
Dim ModrinthUrl As String = Request.GetModrinthAddress()
If IsOldForgeRequest Then Request.ModLoader = CompModLoaderType.Forge '设置回去
Dim IgnoreModLoaderFilter = Request.ModLoader = CompModLoaderType.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion, True) < 140
Try
'启动 CurseForge 线程
Dim CurseForgeFailed As Boolean = False
If CurseForgeUrl IsNot Nothing Then
CurseForgeThread = RunInNewThread(
'CurseForge 搜索
If Request.Source.HasFlag(CompSourceType.CurseForge) AndAlso
Not (Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset) AndAlso '剩余的未显示的搜索结果不足
(Not IsChineseSearch OrElse (IsChineseSearch AndAlso Not String.IsNullOrEmpty(CurseForgeAltSearchText))) Then '如果是中文搜索，就只在有对应搜索关键词的时候才继续
WorkThreads.Add(RunInNewThread(
Sub()
Try
'获取工程列表
Log("[Comp] 开始从 CurseForge 获取工程列表：" & CurseForgeUrl)
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress(If(CurseForgeAltSearchText, RawSearchText), IgnoreModLoaderFilter)
Log("[Comp] 开始 CurseForge 搜索：" & CurseForgeUrl)
Dim RequestResult As JObject = DlModRequest(CurseForgeUrl)
Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("data")
Dim Project As New CompProject(JsonEntry)
@@ -1123,71 +1111,91 @@ Retry:
ProjectList.Add(Project)
Next
'更新结果
SyncLock ResultsLock
RawResults.AddRange(ProjectList)
End SyncLock
Storage.CurseForgeOffset += ProjectList.Count
ProjectList.ForEach(Sub(p) RawResults.Add(p))
Storage.CurseForgeOffset += RequestResult("data").Count
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）")
Log($"[Comp] 从 CurseForge 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）")
Catch ex As Exception
Log(ex, "从 CurseForge 获取工程列表失败")
Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
[Error] = ex
CurseForgeFailed = True
Log(ex, "CurseForge 搜索失败")
Storage.CurseForgeTotal = -1
Errors.Add((ex, CompSourceType.CurseForge))
End Try
End Sub, "CurseForge Project Request")
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够
End Sub, "CurseForge Search"))
End If
'启动 Modrinth 线程
Dim ModrinthFailed As Boolean = False
If ModrinthUrl IsNot Nothing Then
ModrinthThread = RunInNewThread(
'Modrinth 搜索
If Request.Source.HasFlag(CompSourceType.Modrinth) AndAlso
Not (Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset) AndAlso '剩余的未显示的搜索结果不足
(Not IsChineseSearch OrElse (IsChineseSearch AndAlso Not String.IsNullOrEmpty(ModrinthAltSearchText))) Then '如果是中文搜索，就只在有对应搜索关键词的时候才继续
WorkThreads.Add(RunInNewThread(
Sub()
Try
Log("[Comp] 开始从 Modrinth 获取工程列表：" & ModrinthUrl)
Dim ModrinthUrl As String = Request.GetModrinthAddress(If(ModrinthAltSearchText, RawSearchText), IgnoreModLoaderFilter)
Log("[Comp] 开始 Modrinth 搜索：" & ModrinthUrl)
Dim RequestResult As JObject = DlModRequest(ModrinthUrl)
Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("hits")
ProjectList.Add(New CompProject(JsonEntry))
Next
'更新结果
SyncLock ResultsLock
For Each Project In ProjectList
RawResults.Add(Project)
Next
End SyncLock
Storage.ModrinthOffset += ProjectList.Count
ProjectList.ForEach(Sub(p) RawResults.Add(p))
Storage.ModrinthOffset += RequestResult("hits").Count
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程（已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）")
Log($"[Comp] 从 Modrinth 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）")
Catch ex As Exception
Log(ex, "从 Modrinth 获取工程列表失败")
Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
[Error] = ex
ModrinthFailed = True
Log(ex, "Modrinth 搜索失败")
Storage.ModrinthTotal = -1
Errors.Add((ex, CompSourceType.Modrinth))
End Try
End Sub, "Modrinth Project Request")
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够
End Sub, "Modrinth Search"))
End If
'Modrinth 直接获取工程
If Request.Source.HasFlag(CompSourceType.Modrinth) AndAlso
Not (Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset) AndAlso '剩余的未显示的搜索结果不足
ModrinthSlugs.Any Then '有直接获取的 Slug
WorkThreads.Add(RunInNewThread(
Sub()
Try
Dim ModrinthUrl As String = $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthSlugs.Join(""",""")}""]"
Log("[Comp] 开始 Modrinth 直接获取：" & ModrinthUrl)
Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In DlModRequest(ModrinthUrl)
ProjectList.Add(New CompProject(JsonEntry))
Next
'更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p))
Log($"[Comp] 从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
Catch ex As Exception
Log(ex, "Modrinth 直接获取失败")
Errors.Add((ex, CompSourceType.Modrinth))
End Try
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够
End Sub, "Modrinth Get"))
End If
'等待线程结束
If CurseForgeThread IsNot Nothing Then CurseForgeThread.Join()
If Task.IsAborted Then Return '会自动触发 Finally
If ModrinthThread IsNot Nothing Then ModrinthThread.Join()
If Task.IsAborted Then Return
For Each Thread In WorkThreads
Thread.Join()
If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程
Next
'筛除不是 Forge 的 Mod
If IsOldForgeRequest Then
If IgnoreModLoaderFilter Then
RawResults = RawResults.Where(Function(p) Not p.ModLoaders.Any() OrElse p.ModLoaders.Contains(CompModLoaderType.Forge)).ToList
End If
'确保存在结果
Storage.ErrorMessage = Nothing
If Not RawResults.Any() Then
If [Error] IsNot Nothing Then
Throw [Error]
If Errors.Any() Then
Throw Errors.First.Ex
Else
If IsChineseSearch AndAlso Not (Request.Type = CompType.Mod OrElse Request.Type = CompType.DataPack) Then
Throw New Exception("没有搜索结果，请尝试使用英文搜索")
Throw New Exception(MSG_NO_CHINESE_SEARCH_RESULT)
ElseIf Request.Source = CompSourceType.CurseForge AndAlso Request.Tag.StartsWithF("/") Then
Throw New Exception("CurseForge 不兼容所选的类型")
ElseIf Request.Source = CompSourceType.Modrinth AndAlso Request.Tag.EndsWithF("/") Then
@@ -1196,9 +1204,9 @@ Retry:
Throw New Exception("没有搜索结果")
End If
End If
ElseIf [Error] IsNot Nothing Then
ElseIf Errors.Any() Then
'有结果但是有错误
If CurseForgeFailed Then
If Errors.Any(Function(e) e.Source = CompSourceType.CurseForge) Then
Storage.ErrorMessage = $"无法连接到 CurseForge，所以目前仅显示了来自 Modrinth 的内容，搜索结果可能不全。{vbCrLf}请稍后再试，或使用 VPN 改善网络环境。"
Else
Storage.ErrorMessage = $"无法连接到 Modrinth，所以目前仅显示了来自 CurseForge 的内容，搜索结果可能不全。{vbCrLf}请稍后再试，或使用 VPN 改善网络环境。"
@@ -1206,8 +1214,9 @@ Retry:
End If
Finally
CurseForgeThread?.Interrupt()
ModrinthThread?.Interrupt()
For Each Thread In WorkThreads
If Thread.IsAlive Then Thread.Interrupt()
Next
End Try
#End Region
@@ -1215,9 +1224,8 @@ Retry:
#Region "提取非重复项，存储于 RealResults"
'将 CurseForge 排在 Modrinth 的前面，避免加载结束顺序不同导致排名不同
'这样做的话，去重后将优先保留 Modrinth 的内容
RawResults = RawResults.Where(Function(x) x.FromCurseForge).Concat(RawResults.Where(Function(x) Not x.FromCurseForge)).ToList
'RawResults 去重
'去重
RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b))
'已有内容去重
RawResults = RawResults.Where(Function(r) Not RealResults.Any(Function(b) r.IsLike(b)) AndAlso
@@ -1232,9 +1240,9 @@ Retry:
If RealResults.Count + Storage.Results.Count < Request.TargetResultCount Then
Log($"[Comp] 总结果数需求最少 {Request.TargetResultCount} 个，仅获得了 {RealResults.Count + Storage.Results.Count} 个")
If Request.CanContinue AndAlso [Error] Is Nothing Then '如果有下载源失败则不再重试，这时候重试可能导致无限循环
If Request.CanContinue AndAlso Not Errors.Any Then '如果有某个源失败则不再重试，这时候重试可能导致无限循环
Log("[Comp] 将继续尝试加载下一页")
GoTo Retry
GoTo NextPage
Else
Log("[Comp] 无法继续加载，将强制结束")
End If
@@ -1258,23 +1266,23 @@ Retry:
Return 1
End Select
End Function
If String.IsNullOrEmpty(Request.SearchText) Then
If String.IsNullOrEmpty(RawSearchText) Then
'如果没有搜索文本，按下载量将结果排序
For Each Result As CompProject In RealResults
Scores.Add(Result, Result.DownloadCount * GetDownloadCountMult(Result))
Scores(Result) = Result.DownloadCount * GetDownloadCountMult(Result)
Next
Else
'如果有搜索文本，按关联度将结果排序
'排序分 = 搜索相对相似度 (1) + 下载量权重 (对数，10 亿时为 1) + 有中文名 (0.2)
Dim Entry As New List(Of SearchEntry(Of CompProject))
Dim SearchEntries As New List(Of SearchEntry(Of CompProject))
For Each Result As CompProject In RealResults
Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9)
Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of SearchSource) From {
Scores(Result) = If(Result.WikiId > 0, 0.2, 0) +
Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9
SearchEntries.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of SearchSource) From {
New SearchSource(If(IsChineseSearch, Result.TranslatedName, Result.RawName).Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1),
New SearchSource(Result.Description, 0.05)}})
Next
Dim SearchResult = Search(Entry, RawFilter, 101, -1)
Dim SearchResult = Search(SearchEntries, RawSearchText, 10000, -1)
For Each OneResult In SearchResult
Scores(OneResult.Item) +=
If(OneResult.AbsoluteRight, 10, OneResult.Similarity) /
@@ -1282,7 +1290,7 @@ Retry:
Next
End If
'根据排序分得出结果并添加
If Task.IsAborted Then Throw New ThreadInterruptedException '#8246
If Task.IsInterrupted Then Throw New ThreadInterruptedException '#8246
Storage.Results.AddRange(
Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
@@ -1461,16 +1469,16 @@ Retry:
Select(Function(d) d("modId").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.Lower).ToList
GameVersions = RawVersions.
Where(Function(v) McVersion.IsFormatFit(v)).
Select(Function(v) v.Replace("-snapshot", " 预览版")).
Distinct.ToList
If GameVersions.Count > 1 Then
If GameVersions.IsSingle Then
GameVersions = GameVersions.ToList
ElseIf GameVersions.Count > 1 Then
GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
@@ -1525,15 +1533,15 @@ Retry:
Select(Function(d) d("project_id").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.Lower).ToList
GameVersions = RawVersions.Where(Function(v) v.Contains(".")).
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).
Distinct.ToList
If GameVersions.Count > 1 Then
If GameVersions.IsSingle Then
'无需处理
ElseIf GameVersions.Count > 1 Then
GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then
'无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")).ToList
Else
@@ -1594,7 +1602,7 @@ Retry:
If GameVersions.All(
Function(VerName)
Return Not VerName.Contains(".") OrElse {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) VerName.ContainsF(s, True))
End Function) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
End Function) Then Info.Add($"游戏版本 {GameVersions.Join("、"c)}")
If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
End If
@@ -1605,7 +1613,7 @@ Retry:
Dim NewItem As New MyListItem With {
.Title = Title,
.SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
.Info = Info.Join("，")
.Info = Info.Join("，"c)
}
Select Case Status
Case CompFileStatus.Release
@@ -1695,13 +1703,13 @@ Retry:
Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
'获取前置工程信息
If UndoneDeps.Any Then
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置：{Join(UndoneDeps, "，")}")
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置：{UndoneDeps.Join("，"c)}")
Dim Projects As JArray
If TargetProject.FromCurseForge Then
Projects = DlModRequest("https://api.curseforge.com/v1/mods",
HttpMethod.Post, "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json")("data")
HttpMethod.Post, "{""modIds"": [" & UndoneDeps.Join(","c) & "]}", "application/json")("data")
Else
Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]")
Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{UndoneDeps.Join(""",""")}""]")
End If
For Each Project In Projects
Dim Unused As New CompProject(Project) '在 New 的时候会添加缓存以便之后读取
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+37 -37
View File
@@ -79,7 +79,7 @@
End Try
Next
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
Dim RawOutput As String = Join(LatestLog, vbCrLf)
Dim RawOutput As String = LatestLog.Join(vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容：" & vbCrLf & RawOutput)
WriteFile(TempFolder & "RawOutput.log", RawOutput)
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray))
@@ -113,7 +113,7 @@ Extracted:
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList()
Try
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.ToLower
Dim Ext As String = TargetFile.Extension.Lower
If Ext = ".log" OrElse Ext = ".txt" Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
Else
@@ -147,7 +147,7 @@ Extracted:
DirectFile = Nothing
Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
For Each LogFile In AnalyzeRawFiles
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).Lower
Dim TargetType As AnalyzeFileType
If MatchName.StartsWithF("hs_err") Then
TargetType = AnalyzeFileType.HsErr
@@ -229,7 +229,7 @@ Extracted:
'创建文件名词典
Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String()))
For Each SelectedFile In SelectedFiles
FileNameDict(GetFileNameFromPath(SelectedFile.Key).ToLower) = SelectedFile
FileNameDict(GetFileNameFromPath(SelectedFile.Key).Lower) = SelectedFile
OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告：" & SelectedFile.Key & "，作为 Minecraft 或启动器日志")
Next
@@ -307,7 +307,7 @@ Extracted:
''' 输出字符串的前后某些行，并统一行尾为 vbLf (正则 \n)、删除空行和重复行。
''' </summary>
Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String
If Raw.Length <= HeadLines + TailLines Then Return Join(Raw.Distinct, vbLf)
If Raw.Length <= HeadLines + TailLines Then Return Raw.Distinct.Join(vbLf)
Dim Lines As New List(Of String)
Dim RealHeadLines As Integer = 0, ViewedLines As Integer
For ViewedLines = 0 To Raw.Length - 1
@@ -448,7 +448,7 @@ Done:
Else
Log("[Crash] 步骤 3：分析崩溃原因完成，找到 " & CrashReasons.Count & " 条可能的原因")
For Each Reason In CrashReasons
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "（" & Join(Reason.Value, "；") & "）", ""))
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "（" & Reason.Value.Join("；"c) & "）", ""))
Next
End If
End Sub
@@ -464,7 +464,7 @@ Done:
Else
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
End If
Log("[Crash] 可能的崩溃原因：" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "（" & Join(Additional, "；") & "）", ""))
Log("[Crash] 可能的崩溃原因：" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "（" & Additional.Join("；"c) & "）", ""))
End Sub
Private Sub AppendReason(Reason As CrashReason, Additional As String)
AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional}))
@@ -623,9 +623,9 @@ Done:
Dim IsMixin As Boolean = MixinAnalyze(LogMc)
'常规信息
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf))
If LogMc.Contains("确定了一种可能的解决方法，这样做可能会解决你的问题：") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法，这样做可能会解决你的问题：\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("确定了一种可能的解决方法，这样做可能会解决你的问题：") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法，这样做可能会解决你的问题：\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下，这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
@@ -714,18 +714,18 @@ NextStack:
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "fake", "oshi", "impl", "data", "pool", "task",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", "lwjgl", "fakes",
"gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "script", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"fabric", "gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "script", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service", "scripts", "network",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge", "external",
"injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft",
"transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill", "concurrent"
}.Contains(Word.ToLower) Then Continue For
}.Contains(Word.Lower) Then Continue For
PossibleWords.Add(Word.Trim)
Next
Next
PossibleWords = PossibleWords.Distinct.ToList
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
If PossibleWords.Any Then Log("[Crash] - " & Join(PossibleWords, ", "))
If PossibleWords.Any Then Log("[Crash] - " & PossibleWords.Join(", "))
If PossibleWords.Count > 10 Then
Log("[Crash] 关键词过多，考虑匹配出错，不纳入考虑")
Return New List(Of String)
@@ -773,8 +773,8 @@ NextStack:
Dim HintLines As New List(Of String)
For Each KeyWord As String In Keywords
For Each ModString As String In ModNameLines
Dim RealModString As String = ModString.ToLower.Replace("_", "")
If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For
Dim RealModString As String = ModString.Lower.Replace("_", "")
If Not RealModString.Contains(KeyWord.Lower.Replace("_", "")) Then Continue For
If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For
HintLines.Add(ModString.Trim(vbCrLf.ToCharArray))
Exit For
@@ -874,7 +874,7 @@ NextStack:
StartProcess(DirectFile.Value.Key)
Else
Dim FilePath As String = PathTemp & "Crash.txt"
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
WriteFile(FilePath, DirectFile.Value.Value.Join(vbCrLf))
StartProcess(FilePath)
End If
End Sub))
@@ -974,35 +974,35 @@ NextStack:
End If
Case CrashReason.Mod缺少前置或MC版本错误
If Additional.Any Then
Results.Add("由于未安装正确的前置 Mod，导致游戏退出。\n缺失的依赖项：\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。")
Results.Add("由于未安装正确的前置 Mod，导致游戏退出。\n缺失的依赖项：\n - " & Additional.Join("\n - ") & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。")
Else
Results.Add("由于未安装正确的前置 Mod，导致游戏退出。\n请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.堆栈分析发现关键字
If Additional.Count = 1 Then
If Additional.IsSingle Then
Results.Add("你的游戏遇到了一些问题，PCL 为此找到了一个可疑的关键词：" & Additional.First & "。\n\n如果你知道某个关键词对应的 Mod，那么有可能就是它引起的错误，你也可以查看错误报告获取详情。\h")
Else
Results.Add("你的游戏遇到了一些问题，PCL 为此找到了以下可疑的关键词：\n - " & Join(Additional, ", ") & "\n\n如果你知道某个关键词对应的 Mod，那么有可能就是它引起的错误，你也可以查看错误报告获取详情。\h")
Results.Add("你的游戏遇到了一些问题，PCL 为此找到了以下可疑的关键词：\n - " & Additional.Join(", ") & "\n\n如果你知道某个关键词对应的 Mod，那么有可能就是它引起的错误，你也可以查看错误报告获取详情。\h")
End If
Case CrashReason.堆栈分析发现Mod名称, CrashReason.怀疑Mod导致游戏崩溃
If Additional.Count = 1 Then
If Additional.IsSingle Then
Results.Add("PCL 怀疑名为 " & Additional.First & " 的 Mod 导致了游戏出错，但不能完全确定。\n你可以尝试禁用此 Mod，然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("PCL 怀疑以下 Mod 导致了游戏出错，但不能完全确定：\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h")
Results.Add("PCL 怀疑以下 Mod 导致了游戏出错，但不能完全确定：\n - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.确定Mod导致游戏崩溃
If Additional.Count = 1 Then
If Additional.IsSingle Then
Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错。\n你可以尝试禁用此 Mod，然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h")
Results.Add("以下 Mod 导致了游戏出错：\n - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.ModMixin失败
If Additional.Count = 0 Then
Results.Add("部分 Mod 注入失败，导致游戏出错。\n这一般代表着部分 Mod 与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试逐步禁用 Mod，然后观察游戏是否还会崩溃，以此定位导致崩溃的 Mod。\n\e\h")
ElseIf Additional.Count = 1 Then
ElseIf Additional.IsSingle Then
Results.Add("名为 " & Additional.First & " 的 Mod 注入失败，导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试禁用此 Mod，然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h")
Results.Add("以下 Mod 导致了游戏出错：\n - " & Additional.Join("\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容，或是它存在 Bug。\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.Mod配置文件导致游戏崩溃
If Additional(1) Is Nothing Then
@@ -1011,25 +1011,25 @@ NextStack:
Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错：\n其配置文件 " & Additional(1) & " 存在异常，无法读取。")
End If
Case CrashReason.Mod初始化失败
If Additional.Count = 1 Then
If Additional.IsSingle Then
Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败，导致游戏无法继续加载。\n你可以尝试禁用此 Mod，然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("以下 Mod 初始化失败，导致游戏出错：\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h")
Results.Add("以下 Mod 初始化失败，导致游戏出错：\n - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod，然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.特定方块导致崩溃
If Additional.Count = 1 Then
If Additional.IsSingle Then
Results.Add("游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界，并观察游戏的运行情况：\n - 若正常运行，则是该方块导致出错，你或许需要使用一些方式删除此方块。\n - 若仍然出错，问题就可能来自其他原因……\h")
Else
Results.Add("游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界，并观察游戏的运行情况：\n - 若正常运行，则是某些方块导致出错，你或许需要删除该世界。\n - 若仍然出错，问题就可能来自其他原因……\h")
End If
Case CrashReason.Mod重复安装
If Additional.Count >= 2 Then
Results.Add("你重复安装了多个相同的 Mod：\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次，请删除重复的 Mod，然后再启动游戏。")
Results.Add("你重复安装了多个相同的 Mod：\n - " & Additional.Join("\n - ") & "\n\n每个 Mod 只能出现一次，请删除重复的 Mod，然后再启动游戏。")
Else
Results.Add("你可能重复安装了多个相同的 Mod，导致游戏出错。\n\n每个 Mod 只能出现一次，请删除重复的 Mod，然后再启动游戏。\e\h")
End If
Case CrashReason.特定实体导致崩溃
If Additional.Count = 1 Then
If Additional.IsSingle Then
If Additional.First.Contains("minecraft:player") Then
If Additional.First.Contains(" ") Then
Results.Add($"游戏因为位于 {Additional.First.AfterFirst(" ")} 的玩家实体导致了崩溃。\h")
@@ -1040,7 +1040,7 @@ NextStack:
Results.Add($"游戏因为实体 {Additional.First} 导致了崩溃。\h")
End If
Else
Results.Add($"游戏因为下列实体导致了崩溃：{Additional.Join("、")}\h")
Results.Add($"游戏因为下列实体导致了崩溃：{Additional.Join("、"c)}\h")
End If
Case CrashReason.OptiFine与Forge不兼容
Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容，导致了游戏崩溃。\n\n请前往 OptiFine 官网（https://optifine.net/downloads）查看 OptiFine 所兼容的 Forge 版本，并严格按照对应版本重新安装游戏。")
@@ -1077,31 +1077,31 @@ NextStack:
Case CrashReason.Forge安装不完整
Results.Add("由于安装的 Forge 文件丢失，导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge，然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h")
Case CrashReason.Fabric报错
If Additional.Count = 1 Then
If Additional.IsSingle Then
Results.Add("Fabric 提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Fabric 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.Mod互不兼容
If Additional.Count = 1 Then
If Additional.IsSingle Then
Results.Add("你所安装的 Mod 不兼容：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。")
Else
Results.Add("你所安装的 Mod 不兼容，Mod 加载器可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.Mod加载器报错
If Additional.Count = 1 Then
If Additional.IsSingle Then
Results.Add("Mod 加载器提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Mod 加载器可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.Fabric报错并给出解决方案
If Additional.Count = 1 Then
If Additional.IsSingle Then
Results.Add("Fabric 提供了以下解决方案：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Fabric 可能已经提供了解决方案，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.Forge报错
If Additional.Count = 1 Then
If Additional.IsSingle Then
Results.Add("Forge 提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。")
Else
Results.Add("Forge 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h")
@@ -1113,7 +1113,7 @@ NextStack:
End Select
Next
Return Join(Results, "\n\n此外，").
Return Results.Join("\n\n此外，").
Replace("\n", vbCrLf).
Replace("\h", "").
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+31 -31
View File
@@ -97,7 +97,7 @@
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
If BackAssetsFile Is Nothing Then
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
Task.Abort()
Task.Interrupt()
Throw New ThreadInterruptedException
End If
RealAddress = BackAssetsFile.LocalPath
@@ -107,7 +107,7 @@
'检查是否需要更新：每天只更新一次
If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then
Log("[Download] 无需更新资源文件索引，取消")
Task.Abort()
Task.Interrupt()
End If
End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
@@ -158,14 +158,14 @@
Public Property AllDrops As List(Of Integer)
Get
If _AllDrops Is Nothing Then
_AllDrops = Setup.Get("CacheDrops").ToString.
_AllDrops = Settings.Get("CacheDrops").ToString.
Split(",".ToCharArray, StringSplitOptions.RemoveEmptyEntries).Select(Function(d) CInt(Val(d))).ToList()
End If
Return If(_AllDrops.Any, _AllDrops, Nothing) '不要将 _AllDrops 再设为 Nothing，以防止反复获取设置尝试初始化
End Get
Set(value As List(Of Integer))
_AllDrops = value
Setup.Set("CacheDrops", value.Join(","))
Settings.Set("CacheDrops", value.Join(","c))
End Set
End Property
Private _AllDrops As List(Of Integer) = Nothing
@@ -191,7 +191,7 @@
''' </summary>
Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult))
Select Case Setup.Get("ToolDownloadVersion")
Select Case Settings.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
@@ -242,20 +242,20 @@
Dim Version As String
'快照版
Version = Json("latest")("snapshot")
If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso
Setup.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
If Settings.Get("ToolUpdateSnapshot") AndAlso Not Settings.Get("ToolUpdateSnapshotLast") = "" AndAlso
Settings.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json)
End If
Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
Settings.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
'正式版
Version = Json("latest")("release")
If Setup.Get("ToolUpdateRelease") AndAlso Not Setup.Get("ToolUpdateReleaseLast") = "" AndAlso
Setup.Get("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
If Settings.Get("ToolUpdateRelease") AndAlso Not Settings.Get("ToolUpdateReleaseLast") = "" AndAlso
Settings.Get("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json)
End If
Setup.Set("ToolUpdateReleaseLast", Version)
Settings.Set("ToolUpdateReleaseLast", Version)
Catch ex As Exception
Throw New Exception("Minecraft 官方源版本列表解析失败", ex)
End Try
@@ -304,7 +304,7 @@
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
Case LoadState.Loading
DlClientListLoader.WaitForExit(Id)
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
Case LoadState.Failed, LoadState.Interrupted, LoadState.Waiting
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
End Select
'重新查找版本
@@ -383,7 +383,7 @@
''' </summary>
Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain)
Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Select Case Setup.Get("ToolDownloadVersion")
Select Case Settings.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30),
@@ -423,7 +423,7 @@
Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With {
.DisplayName = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.ReleaseTime = {ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}.Join("/"c),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.FileName = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
@@ -489,7 +489,7 @@
''' </summary>
Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain)
Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Select Case Setup.Get("ToolDownloadVersion")
Select Case Settings.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30),
@@ -638,7 +638,7 @@
Public Sub DlForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim DlForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Official", AddressOf DlForgeVersionOfficialMain)
Dim DlForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Bmclapi", AddressOf DlForgeVersionBmclapiMain)
Select Case Setup.Get("ToolDownloadVersion")
Select Case Settings.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30),
@@ -849,7 +849,7 @@
VersionName = ApiName.Replace("1.20.1-", "")
Version = New Version("19." & VersionName)
Inherit = "1.20.1"
ElseIf ApiName.StartsWith("0.") Then '0.25w14craftmine.3-beta
ElseIf ApiName.StartsWithF("0.") Then '0.25w14craftmine.3-beta
VersionName = ApiName
Dim Segments = ApiName.BeforeFirst("-").Split("."c)
Version = New Version(0, 0, Segments.Last)
@@ -872,7 +872,7 @@
''' </summary>
Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain)
Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Select Case Setup.Get("ToolDownloadVersion")
Select Case Settings.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
@@ -997,7 +997,7 @@
''' </summary>
Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain)
Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Select Case Setup.Get("ToolDownloadVersion")
Select Case Settings.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30),
@@ -1031,7 +1031,7 @@
Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key,
.IsLegacy = Pair.Key.Split(".")(1) < 8,
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
.IsPreview = RealEntry("stream").ToString.Lower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
@@ -1059,7 +1059,7 @@
Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key,
.IsLegacy = Pair.Key.Split(".")(1) < 8,
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
.IsPreview = RealEntry("stream").ToString.Lower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
@@ -1096,7 +1096,7 @@
''' </summary>
Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain)
Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Select Case Setup.Get("ToolDownloadVersion")
Select Case Settings.Get("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30),
@@ -1170,7 +1170,7 @@
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
Dim McimUrl As String = DlSourceModGet(Url)
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
Select Case Settings.Get("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
@@ -1210,7 +1210,7 @@
''' </summary>
Public ReadOnly Property DlSourcePreferMojang As Boolean
Get
Return Setup.Get("ToolDownloadSource") = 2 OrElse (Setup.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang)
Return Settings.Get("ToolDownloadSource") = 2 OrElse (Settings.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang)
End Get
End Property
''' <summary>
@@ -1224,7 +1224,7 @@
''' </summary>
Public ReadOnly Property DlVersionListPreferMojang As Boolean
Get
Return Setup.Get("ToolDownloadVersion") = 2 OrElse (Setup.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang)
Return Settings.Get("ToolDownloadVersion") = 2 OrElse (Settings.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang)
End Get
End Property
''' <summary>
@@ -1323,7 +1323,7 @@
If SubLoader.Key.State = LoadState.Finished Then
'检查加载器成功
MainLoader.Output = SubLoader.Key.Output
DlSourceLoaderAbort(LoaderList)
DlSourceLoaderInterrupt(LoaderList)
Return
ElseIf BeforeLoadersAllFailed Then
'此前的加载器全部失败，直接启动后续加载器
@@ -1355,7 +1355,7 @@
End If
Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderAbort(LoaderList)
DlSourceLoaderInterrupt(LoaderList)
Throw ErrorInfo
End If
Exit For
@@ -1364,15 +1364,15 @@
Thread.Sleep(10)
WaitCycle += 1
'检查父加载器中断
If MainLoader.IsAborted Then
DlSourceLoaderAbort(LoaderList)
If MainLoader.IsInterrupted Then
DlSourceLoaderInterrupt(LoaderList)
Return
End If
Loop
End Sub
Private Sub DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
Private Sub DlSourceLoaderInterrupt(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.Abort()
If Loader.Key.State = LoadState.Loading Then Loader.Key.Interrupt()
Next
End Sub
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+37 -44
View File
@@ -95,11 +95,11 @@
Try
'确定文件存在
If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
If PathJava.ContainsF("finalshell", True) Then Throw New Exception("不兼容 FinalShell 的 Java") '#8080
If {"finalshell", "Paranoia File"}.Any(Function(n) PathJava.ContainsF(n, True)) Then Throw New Exception("不兼容该精简版 Java") '#2249、#8080
If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
IsJre = Not File.Exists(PathFolder & "javac.exe")
'运行 -version
Output = StartProcessAndGetOutput(PathJava, "-version", 15000).ToLower
Output = StartProcessAndGetOutput(PathJava, "-version", 15000).Lower
If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
If ModeDebug Then Log("[Java] Java 检查输出：" & PathJava & vbCrLf & Output)
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java，请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
@@ -124,8 +124,6 @@
If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败，获取的版本为 " & Version.ToString)
'#3649：在 64 位系统上禁用 32 位 Java
If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本，请安装 64 位的 Java")
'#2249：JRE 17 似乎会导致 Forge 安装失败，干脆禁用更多版本的 JRE
If IsJre AndAlso MajorVersion >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差，因此不再允许使用。你可以使用对应版本的 JDK，而非 JRE！")
Catch ex As ApplicationException
Throw ex
Catch ex As ThreadInterruptedException
@@ -167,13 +165,13 @@
Public Sub JavaListInit()
JavaList = New List(Of JavaEntry)
Try
If Setup.Get("CacheJavaListVersion") < JavaListCacheVersion Then
If Settings.Get("CacheJavaListVersion") < JavaListCacheVersion Then
'不使用缓存
Log("[Java] 要求 Java 列表缓存更新")
Setup.Set("CacheJavaListVersion", JavaListCacheVersion)
Settings.Set("CacheJavaListVersion", JavaListCacheVersion)
Else
'使用缓存
For Each JsonEntry In GetJson(Setup.Get("LaunchArgumentJavaAll"))
For Each JsonEntry In GetJson(Settings.Get("LaunchArgumentJavaAll"))
JavaList.Add(JavaEntry.FromJson(JsonEntry))
Next
End If
@@ -186,7 +184,7 @@
End If
Catch ex As Exception
Log(ex, "初始化 Java 列表失败", LogLevel.Feedback)
Setup.Set("LaunchArgumentJavaAll", "[]")
Settings.Set("LaunchArgumentJavaAll", "[]")
End Try
End Sub
@@ -234,7 +232,7 @@
'获取版本独立设置中指定的 Java
Dim VersionSelect As String = ""
If GameInstance IsNot Nothing Then
VersionSelect = Setup.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
VersionSelect = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If VersionSelect.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
@@ -243,22 +241,22 @@
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Settings.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Log(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", LogLevel.Hint)
End Try
End If
End If
'获取全局设置中指定的 Java
If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then
If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Settings.Get("LaunchArgumentJavaSelect") <> "" Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("LaunchArgumentJavaSelect")))
UserJava = JavaEntry.FromJson(GetJson(Settings.Get("LaunchArgumentJavaSelect")))
UserJava.Check()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("LaunchArgumentJavaSelect")
Settings.Reset("LaunchArgumentJavaSelect")
Log(ex, "全局设置中指定的 Java 已无法使用，此设置已重置", LogLevel.Hint)
End Try
End If
@@ -277,7 +275,7 @@ RetryGet:
Select Case JavaSearchLoader.State
Case LoadState.Failed
Throw JavaSearchLoader.Error
Case LoadState.Aborted
Case LoadState.Interrupted
Throw New ThreadInterruptedException("Java 搜索加载器已中断")
End Select
@@ -332,7 +330,7 @@ RetryGet:
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If
Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If GameInstance IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", GameInstance) Then
If GameInstance IsNot Nothing AndAlso Settings.Get("VersionAdvanceJava", GameInstance) Then
'直接跳过弹窗
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & "，但当前版本" & Requirement & "，这可能会导致游戏崩溃！", LogLevel.Debug)
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
@@ -412,9 +410,9 @@ UserPass:
Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean
Try
'检查强制指定
Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect")
Dim UserSetup As String = Settings.Get("LaunchArgumentJavaSelect")
If GameInstance IsNot Nothing Then
Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
Dim UserSetupVersion As String = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion
End If
If UserSetup <> "" Then
@@ -423,7 +421,7 @@ UserPass:
UserJava = JavaEntry.FromJson(GetJson(UserSetup))
Catch ex As Exception
Log(ex, "版本指定的 Java 信息已损坏，已重置版本设置中指定的 Java")
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance)
Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance)
GoTo NoUserJava
End Try
For Each Java In JavaList
@@ -438,7 +436,7 @@ NoUserJava:
Return False
Catch ex As Exception
Log(ex, "检查 Java 类别时出错", LogLevel.Feedback)
Setup.Set("LaunchArgumentJavaSelect", "")
Settings.Set("LaunchArgumentJavaSelect", "")
Return True
End Try
End Function
@@ -519,19 +517,14 @@ NoUserJava:
If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器（#3705）
JavaSearchFolder(Disk.Name, JavaPreList, False)
Next
'查找 .jdks 文件夹中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False, True)
'查找 SDKMAN 安装目录中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.sdkman\candidates\java\", JavaPreList, False, True)
'查找 APPDATA 文件夹中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\", JavaPreList, False)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\", JavaPreList, False)
'查找用户文件夹中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile), JavaPreList, False)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False, IsFullSearch:=True)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.sdkman\candidates\java\", JavaPreList, False, IsFullSearch:=True)
'查找启动器目录中的 Java
JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
'查找所选 Minecraft 文件夹中的 Java
If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso Path <> McFolderSelected Then
JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
End If
If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso Path <> McFolderSelected Then JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
'若不全为符号链接，则清除符号链接的地址
Dim JavaWithoutReparse As New Dictionary(Of String, Boolean)
@@ -565,7 +558,7 @@ NoUserJava:
#Region "添加玩家手动导入的 Java"
Dim ImportedJava As String = Setup.Get("LaunchArgumentJavaAll")
Dim ImportedJava As String = Settings.Get("LaunchArgumentJavaAll")
Try
For Each JavaJsonObject In GetJson(ImportedJava)
Dim Entry = JavaEntry.FromJson(JavaJsonObject)
@@ -573,14 +566,14 @@ NoUserJava:
Next
Catch ex As Exception
Log(ex, "Java 列表已损坏", LogLevel.Feedback)
Setup.Set("LaunchArgumentJavaAll", "[]")
Settings.Set("LaunchArgumentJavaAll", "[]")
End Try
#End Region
'确保可用并获取详细信息，转入正式列表
Dim NewJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794
For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.Lower = b.Key.Lower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next
NewJavaList = JavaCheckList(NewJavaList).SortByComparison(AddressOf JavaSorter)
@@ -590,7 +583,7 @@ NoUserJava:
For Each Java In NewJavaList
AllList.Add(Java.ToJson)
Next
Setup.Set("LaunchArgumentJavaAll", AllList.ToString(Newtonsoft.Json.Formatting.None))
Settings.Set("LaunchArgumentJavaAll", AllList.ToString(Newtonsoft.Json.Formatting.None))
JavaList = NewJavaList
Catch ex As Exception
@@ -599,7 +592,7 @@ NoUserJava:
End Try
Log("[Java] Java 搜索完成，发现 " & JavaList.Count & " 个 Java")
If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.RefreshJavaComboBox())
If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.UpdateJavaComboBox())
If FrmInstanceSetup IsNot Nothing Then RunInUi(Sub() FrmInstanceSetup.RefreshJavaComboBox())
End Sub
@@ -672,18 +665,18 @@ Wait:
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹
'不应使用网易的 Java：https://github.com/Meloong-Git/PCL/issues/1279#issuecomment-2761489121
Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon", "bin",
"soft", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
"游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
"应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot",
"runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
"4297127d64ec6", "1.", "启动", "jbr"}
Static Keywords As String() = {
"java", "jdk", "jre", "env", "环境", "run", "软件", "mc", "dragon", "well", "bin", "sdk", "candidate", "current",
"software", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
"游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
"应用", "运行", "前置", "mojang", "官启", "官方", "新建文件夹", "eclipse", "microsoft", "hotspot",
"runtime", "x86", "x64", "arm", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "forge", "fabric",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages", "4297127d64ec6", "1.", "启动", "jbr"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).Lower '用于搜索的字符串
If IsFullSearch OrElse
OriginalPath.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
OriginalPath.Name.Lower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
JavaSearchFolder(FolderInfo, Results, Source)
End If
Next
@@ -710,7 +703,7 @@ Wait:
})
AddHandler JavaDownloadLoader.OnStateChangedThread,
Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState)
If (NewState = LoadState.Failed OrElse NewState = LoadState.Aborted) AndAlso LastJavaBaseDir IsNot Nothing Then
If (NewState = LoadState.Failed OrElse NewState = LoadState.Interrupted) AndAlso LastJavaBaseDir IsNot Nothing Then
Log($"[Java] 由于下载未完成，清理未下载完成的 Java 文件：{LastJavaBaseDir}", LogLevel.Debug)
DeleteDirectory(LastJavaBaseDir)
ElseIf NewState = LoadState.Finished Then
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+524 -568
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+78 -68
View File
@@ -5,9 +5,21 @@ Public Module ModMinecraft
#Region "文件夹"
''' <summary>
''' 当前的 Minecraft 文件夹路径，以“\”结尾。
''' 当前的 Minecraft 文件夹路径，以 \ 结尾。
''' </summary>
Public McFolderSelected As String
Public Property McFolderSelected As String
Get
If _McFolderSelected Is Nothing Then McFolderSelected = Settings.Get("LaunchFolderSelect") '仅在首次读取时触发
Return _McFolderSelected
End Get
Set(Value As String)
If _McFolderSelected = Value Then Return
_McFolderSelected = Value.Replace("$", Path)
Settings.Set("LaunchFolderSelect", Value.Replace(Path, "$"))
Log("[Minecraft] 当前选择的 Minecraft 文件夹：" & _McFolderSelected)
End Set
End Property
Private _McFolderSelected As String
''' <summary>
''' 当前的 Minecraft 文件夹列表。
''' </summary>
@@ -22,8 +34,8 @@ Public Module ModMinecraft
Public Location As String
Public Type As Types
Public Enum Types
Original
RenamedOriginal
Vanilla
RenamedVanilla
Custom
End Enum
@@ -50,9 +62,9 @@ Public Module ModMinecraft
'扫描当前文件夹
Try
If Directory.Exists(Path & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path, .Type = McFolder.Types.Original})
If Directory.Exists(Path & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path, .Type = McFolder.Types.Vanilla})
For Each Folder As DirectoryInfo In New DirectoryInfo(Path).GetDirectories
If Directory.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Folder.FullName & "\", .Type = McFolder.Types.Original})
If Directory.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Folder.FullName & "\", .Type = McFolder.Types.Vanilla})
Next
Catch ex As Exception
Log(ex, "扫描 PCL 所在文件夹中是否有 MC 文件夹失败")
@@ -62,7 +74,7 @@ Public Module ModMinecraft
Dim MojangPath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\"
If (Not CacheMcFolderList.Any OrElse MojangPath <> CacheMcFolderList(0).Location) AndAlso '当前文件夹不是官启文件夹
Directory.Exists(MojangPath & "versions\") Then '具有权限且存在 versions 文件夹
CacheMcFolderList.Add(New McFolder With {.Name = "官方启动器文件夹", .Location = MojangPath, .Type = McFolder.Types.Original})
CacheMcFolderList.Add(New McFolder With {.Name = "官方启动器文件夹", .Location = MojangPath, .Type = McFolder.Types.Vanilla})
End If
#End Region
@@ -70,54 +82,51 @@ Public Module ModMinecraft
#Region "读取自定义（Custom）文件夹，可能没有结果"
'格式：TMZ 12>C://xxx/xx/|Test>D://xxx/xx/|名称>路径
For Each Folder As String In Setup.Get("LaunchFolders").Split("|")
For Each Folder As String In Settings.Get("LaunchFolders").ToString.Split({"|"c}, StringSplitOptions.RemoveEmptyEntries)
If Folder = "" Then Continue For
If Not Folder.Contains(">") OrElse Not Folder.EndsWithF("\") Then
Hint("无效的 Minecraft 文件夹：" & Folder, HintType.Red)
Continue For
End If
Dim Name As String = Folder.Split(">")(0)
Dim Path As String = Folder.Split(">")(1)
Dim FolderName As String = Folder.BeforeFirst(">"), FolderPath As String = Folder.AfterFirst(">")
Try
CheckPermissionWithException(Path)
CheckPermissionWithException(FolderPath)
'若已有该文件夹，则直接重命名；没有则添加
Dim Renamed As Boolean = False
For Each OriginalFolder As McFolder In CacheMcFolderList
If OriginalFolder.Location = Path Then
OriginalFolder.Name = Name
OriginalFolder.Type = McFolder.Types.RenamedOriginal
If OriginalFolder.Location = FolderPath Then
OriginalFolder.Name = FolderName
OriginalFolder.Type = McFolder.Types.RenamedVanilla
Renamed = True
End If
Next
If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Location = Path, .Type = McFolder.Types.Custom})
If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = FolderName, .Location = FolderPath, .Type = McFolder.Types.Custom})
Catch ex As Exception
MyMsgBox("失效的 Minecraft 文件夹：" & vbCrLf & Path & vbCrLf & vbCrLf & ex.GetBrief(), "Minecraft 文件夹失效", IsWarn:=True)
Log(ex, $"无法访问 Minecraft 文件夹 {Path}")
MyMsgBox("失效的 Minecraft 文件夹：" & vbCrLf & FolderPath & vbCrLf & vbCrLf & ex.GetBrief(), "Minecraft 文件夹失效", IsWarn:=True)
Log(ex, $"无法访问 Minecraft 文件夹 {FolderPath}")
End Try
Next
'将自定义文件夹情况同步到设置
Dim NewSetup As New List(Of String)
For Each Folder As McFolder In CacheMcFolderList
If Not Folder.Type = McFolder.Types.Original Then NewSetup.Add(Folder.Name & ">" & Folder.Location)
If Not Folder.Type = McFolder.Types.Vanilla Then NewSetup.Add(Folder.Name & ">" & Folder.Location)
Next
If Not NewSetup.Any() Then NewSetup.Add("") '防止 0 元素 Join 返回 Nothing
Setup.Set("LaunchFolders", Join(NewSetup, "|"))
Settings.Set("LaunchFolders", NewSetup.Join("|"c))
#End Region
'若没有可用文件夹，则创建 .minecraft
If Not CacheMcFolderList.Any() Then
Directory.CreateDirectory(Path & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path & ".minecraft\", .Type = McFolder.Types.Original})
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path & ".minecraft\", .Type = McFolder.Types.Vanilla})
End If
For Each Folder As McFolder In CacheMcFolderList
#Region "更新 launcher_profiles.json"
McFolderLauncherProfilesJsonCreate(Folder.Location)
#End Region
Next
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 2000))
If Settings.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 2000))
'回设
McFolderList = CacheMcFolderList
@@ -173,30 +182,34 @@ Public Module ModMinecraft
If ReferenceEquals(_McInstanceSelectedLast, value) Then Return
_McInstanceSelected = value '由于有可能是 Nothing，导致无法初始化，才得这样弄一圈
_McInstanceSelectedLast = value
Settings.MakeInstanceDirty()
'更新 MC 文件夹所选取的 Minecraft 版本
Log("[Launch] 当前选择的 Minecraft 版本：" & If(value?.PathVersion, "无"))
WriteIni(McFolderSelected & "PCL.ini", "Version", If(value?.Name, ""))
If value Is Nothing Then Return
'重置缓存的下载文件夹
PageDownloadCompDetail.CachedFolder.Clear()
'统一通行证重判
If AniControlEnabled = 0 AndAlso
Setup.Get("VersionServerNide", Instance:=value) <> Setup.Get("CacheNideServer") AndAlso
Setup.Get("VersionServerLogin", Instance:=value) = 3 Then
Setup.Set("CacheNideAccess", "")
Settings.Get("VersionServerNide", Instance:=value) <> Settings.Get("CacheNideServer") AndAlso
Settings.Get("VersionServerLogin", Instance:=value) = 3 Then
Settings.Set("CacheNideAccess", "")
Log("[Launch] 服务器改变，要求重新登录统一通行证")
End If
If Setup.Get("VersionServerLogin", Instance:=value) = 3 Then
Setup.Set("CacheNideServer", Setup.Get("VersionServerNide", Instance:=value))
If Settings.Get("VersionServerLogin", Instance:=value) = 3 Then
Settings.Set("CacheNideServer", Settings.Get("VersionServerNide", Instance:=value))
End If
'Authlib-Injector 重判
If AniControlEnabled = 0 AndAlso
Setup.Get("VersionServerAuthServer", Instance:=value) <> Setup.Get("CacheAuthServerServer") AndAlso
Setup.Get("VersionServerLogin", Instance:=value) = 4 Then
Setup.Set("CacheAuthAccess", "")
Settings.Get("VersionServerAuthServer", Instance:=value) <> Settings.Get("CacheAuthServerServer") AndAlso
Settings.Get("VersionServerLogin", Instance:=value) = 4 Then
Settings.Set("CacheAuthAccess", "")
Log("[Launch] 服务器改变，要求重新登录 Authlib-Injector")
End If
If Setup.Get("VersionServerLogin", Instance:=value) = 4 Then
Setup.Set("CacheAuthServerServer", Setup.Get("VersionServerAuthServer", Instance:=value))
Setup.Set("CacheAuthServerName", Setup.Get("VersionServerAuthName", Instance:=value))
Setup.Set("CacheAuthServerRegister", Setup.Get("VersionServerAuthRegister", Instance:=value))
If Settings.Get("VersionServerLogin", Instance:=value) = 4 Then
Settings.Set("CacheAuthServerServer", Settings.Get("VersionServerAuthServer", Instance:=value))
Settings.Set("CacheAuthServerName", Settings.Get("VersionServerAuthName", Instance:=value))
Settings.Set("CacheAuthServerRegister", Settings.Get("VersionServerAuthRegister", Instance:=value))
End If
End Set
End Property
@@ -212,15 +225,15 @@ Public Module ModMinecraft
''' </summary>
Public ReadOnly Property PathIndie As String
Get
If Setup.IsUnset("VersionArgumentIndieV2", Instance:=Me) Then
If Not Settings.HasSaved("VersionArgumentIndieV2", Instance:=Me) Then
If Not IsLoaded Then Load()
'决定该版本是否应该被隔离
Dim ShouldBeIndie =
Function() As Boolean
'从老的版本独立设置中迁移：-1 未决定，0 使用全局设置，1 手动开启，2 手动关闭
If Not Setup.IsUnset("VersionArgumentIndie", Instance:=Me) AndAlso Setup.Get("VersionArgumentIndie", Instance:=Me) > 0 Then
If Settings.HasSaved("VersionArgumentIndie", Instance:=Me) AndAlso Settings.Get("VersionArgumentIndie", Instance:=Me) > 0 Then
Log($"[Minecraft] 版本隔离初始化（{Name}）：从老的版本独立设置中迁移")
Return Setup.Get("VersionArgumentIndie", Instance:=Me) = 1
Return Settings.Get("VersionArgumentIndie", Instance:=Me) = 1
End If
'若版本文件夹下包含 mods 或 saves 文件夹，则自动开启版本隔离
Dim ModFolder As New DirectoryInfo(PathVersion & "mods\")
@@ -231,8 +244,8 @@ Public Module ModMinecraft
End If
'根据全局的默认设置决定是否隔离
Dim IsRelease As Boolean = State <> McInstanceState.Fool AndAlso State <> McInstanceState.Old AndAlso State <> McInstanceState.Snapshot
Log($"[Minecraft] 版本隔离初始化（{Name}）：从全局默认设置中（{Setup.Get("LaunchArgumentIndieV2")}）判断，State {GetStringFromEnum(State)}，IsRelease {IsRelease}，Modable {Modable}")
Select Case Setup.Get("LaunchArgumentIndieV2")
Log($"[Minecraft] 版本隔离初始化（{Name}）：从全局默认设置中（{Settings.Get("LaunchArgumentIndieV2")}）判断，State {GetStringFromEnum(State)}，IsRelease {IsRelease}，Modable {Modable}")
Select Case Settings.Get("LaunchArgumentIndieV2")
Case 0 '关闭
Return False
Case 1 '仅隔离可安装 Mod 的版本
@@ -245,9 +258,9 @@ Public Module ModMinecraft
Return True
End Select
End Function
Setup.Set("VersionArgumentIndieV2", ShouldBeIndie(), Instance:=Me)
Settings.Set("VersionArgumentIndieV2", ShouldBeIndie(), Instance:=Me)
End If
Return If(Setup.Get("VersionArgumentIndieV2", Instance:=Me), PathVersion, McFolderSelected)
Return If(Settings.Get("VersionArgumentIndieV2", Instance:=Me), PathVersion, McFolderSelected)
End Get
End Property
@@ -692,7 +705,7 @@ Recheck:
End Try
'确认 Json 可用性
Try
Dim JsonObjCheck = JsonObject
If JsonObject("mainClass") Is Nothing Then Throw New Exception("版本 JSON 中没有 mainClass 项！") '这里也会触发 JsonObject 的 Get 事件
Catch ex As Exception
Log(ex, "版本 JSON 可用性检查失败（" & PathVersion & "）")
JsonText = ""
@@ -817,8 +830,8 @@ ExitDataLoad:
If State = McInstanceState.Fool Then
Info = GetMcFoolName(Version.VanillaName)
ElseIf State <> McInstanceState.Error Then
If Setup.Get("VersionServerLogin", Instance:=Me) = 3 Then Info += ", 统一通行证验证"
If Setup.Get("VersionServerLogin", Instance:=Me) = 4 Then Info += ", Authlib 验证"
If Settings.Get("VersionServerLogin", Instance:=Me) = 3 Then Info += ", 统一通行证验证"
If Settings.Get("VersionServerLogin", Instance:=Me) = 4 Then Info += ", Authlib 验证"
End If
End If
'确定版本收藏状态
@@ -914,7 +927,7 @@ ExitDataLoad:
End If
'Logo
Try
If Logo.EndsWith("PCL\Logo.png") Then
If Logo.EndsWithF("PCL\Logo.png") Then
NewItem.Logo = PathVersion & "PCL\Logo.png" '修复老版本中，存储的自定义 Logo 使用完整路径，导致移动后无法加载的 Bug
Else
NewItem.Logo = Logo
@@ -1012,7 +1025,7 @@ ExitDataLoad:
Get
If String.IsNullOrEmpty(OptiFine) OrElse OptiFine = "未知版本" Then Return 0
'字母编号，如 G2 中的 G（7）
Dim Result As Integer = Asc(OptiFine.ToUpper.First) - Asc("A"c) + 1
Dim Result As Integer = Asc(OptiFine.Upper.First) - Asc("A"c) + 1
'末尾数字，如 C5 beta4 中的 5
Result *= 100
Result += Val(RegexSeek(Right(OptiFine, OptiFine.Length - 1), "[0-9]+"))
@@ -1023,7 +1036,7 @@ ExitDataLoad:
If Val(Right(OptiFine, 1)) = 0 AndAlso Right(OptiFine, 1) <> "0" Then
Result += 1 '为 pre 或 beta 结尾，视作 1
Else
Result += Val(RegexSeek(OptiFine.ToLower, "(?<=((pre)|(beta)))[0-9]+"))
Result += Val(RegexSeek(OptiFine.Lower, "(?<=((pre)|(beta)))[0-9]+"))
End If
Else
Result += 99
@@ -1145,7 +1158,7 @@ ExitDataLoad:
''' 根据版本名获取对应的愚人节版本描述。非愚人节版本会返回空字符串。
''' </summary>
Public Function GetMcFoolName(Name As String) As String
Name = Name.ToLower
Name = Name.Lower
If Name.StartsWithF("2.0") Then
Return "2013 | 这个秘密计划了两年的更新将游戏推向了一个新高度！"
ElseIf Name = "15w14a" Then
@@ -1216,7 +1229,7 @@ ExitDataLoad:
GoTo OnLoaded
End If
'有可用版本
Dim FolderListCheck As Integer = GetHash(McInstanceCacheVersion & "#" & Join(FolderList.ToArray, "#")) Mod (Integer.MaxValue - 1) '根据文件夹名列表生成辨识码
Dim FolderListCheck As Integer = GetHash(McInstanceCacheVersion & "#" & FolderList.Join("#"c)) Mod (Integer.MaxValue - 1) '根据文件夹名列表生成辨识码
If Not McInstanceListForceRefresh AndAlso Val(ReadIni(PathMc & "PCL.ini", "InstanceCache")) = FolderListCheck Then
'可以使用缓存
Dim Result = InitMcInstanceListWithCache(PathMc)
@@ -1237,7 +1250,7 @@ Reload:
'改变当前选择的版本
OnLoaded:
If Loader.IsAborted Then Return
If Loader.IsInterrupted Then Return
If McInstanceList.Any(Function(v) v.Key <> McInstanceCardType.Error) Then
'尝试读取已储存的选择
Dim SavedSelection As String = ReadIni(PathMc & "PCL.ini", "Version")
@@ -1247,7 +1260,6 @@ OnLoaded:
If Instance.Name = SavedSelection AndAlso Not Instance.State = McInstanceState.Error Then
'使用已储存的选择
McInstanceSelected = Instance
Setup.Set("LaunchVersionSelect", McInstanceSelected.Name)
Log("[Minecraft] 选择该文件夹储存的 Minecraft 版本：" & McInstanceSelected.PathVersion)
Return
End If
@@ -1257,18 +1269,16 @@ OnLoaded:
If Not McInstanceList.First.Value(0).State = McInstanceState.Error Then
'自动选择第一项
McInstanceSelected = McInstanceList.First.Value(0)
Setup.Set("LaunchVersionSelect", McInstanceSelected.Name)
Log("[Launch] 自动选择 Minecraft 版本：" & McInstanceSelected.PathVersion)
End If
Else
McInstanceSelected = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Minecraft] 未找到可用 Minecraft 版本")
End If
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000))
If Settings.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000))
Catch ex As ThreadInterruptedException
Catch ex As Exception
If Loader.IsAborted Then Return '#5617
If Loader.IsInterrupted Then Return '#5617
WriteIni(PathMc & "PCL.ini", "InstanceCache", "") '要求下次重新加载
Log(ex, "加载 .minecraft 版本列表失败", LogLevel.Feedback)
End Try
@@ -1642,9 +1652,9 @@ OnLoaded:
Case "Mojang", "Ms"
Url = "https://sessionserver.mojang.com/session/minecraft/profile/"
Case "Nide"
Url = "https://auth.mc-user.com:233/" & If(McInstanceSelected Is Nothing, Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Instance:=McInstanceSelected)) & "/sessionserver/session/minecraft/profile/"
Url = "https://auth.mc-user.com:233/" & If(McInstanceSelected Is Nothing, Settings.Get("CacheNideServer"), Settings.Get("VersionServerNide", Instance:=McInstanceSelected)) & "/sessionserver/session/minecraft/profile/"
Case "Auth"
Url = If(McInstanceSelected Is Nothing, Setup.Get("CacheAuthServerServer"), Setup.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/sessionserver/session/minecraft/profile/"
Url = If(McInstanceSelected Is Nothing, Settings.Get("CacheAuthServerServer"), Settings.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/sessionserver/session/minecraft/profile/"
Case Else
Throw New ArgumentException("皮肤地址种类无效：" & If(Type, "null"))
End Select
@@ -1665,7 +1675,7 @@ OnLoaded:
Throw New Exception("皮肤返回值中不包含皮肤数据项，可能是未设置自定义皮肤的用户", ex)
End Try
SkinString = Encoding.GetEncoding("utf-8").GetString(Convert.FromBase64String(SkinValue))
Dim SkinJson As JObject = GetJson(SkinString.ToLower)
Dim SkinJson As JObject = GetJson(SkinString.Lower)
If SkinJson("textures") Is Nothing OrElse SkinJson("textures")("skin") Is Nothing OrElse SkinJson("textures")("skin")("url") Is Nothing Then
Throw New Exception("用户未设置自定义皮肤")
Else
@@ -1689,7 +1699,7 @@ OnLoaded:
If Not File.Exists(FileAddress) Then
NetDownloadByClient(Address, FileAddress & ".PCLDownloading")
File.Delete(FileAddress)
FileSystem.Rename(FileAddress & ".PCLDownloading", FileAddress)
File.Move(FileAddress & ".PCLDownloading", FileAddress)
Log("[Minecraft] 皮肤下载成功：" & FileAddress)
End If
Return FileAddress
@@ -1763,7 +1773,7 @@ OnLoaded:
If OriginalName Is Nothing Then Return Nothing
Dim Splited As New List(Of String)(OriginalName.Split(":"))
Splited.RemoveAt(2) 'Java 的此格式下版本号固定为第三段，第四段可能包含架构、分包等其他信息
Return Join(Splited, ":")
Return Splited.Join(":"c)
End Get
End Property
''' <summary>
@@ -2009,12 +2019,12 @@ OnLoaded:
Result.AddRange(McLibNetFilesFromTokens(McLibListGet(Instance, False)))
'统一通行证文件
If Setup.Get("VersionServerLogin", Instance:=Instance) = 3 Then
Dim TargetFile As String = PathAppdata & "nide8auth.jar"
If Settings.Get("VersionServerLogin", Instance:=Instance) = 3 Then
Dim TargetFile As String = PathPure & "nide8auth.jar"
Try
'测试链接：https://auth.mc-user.com:233/00000000000000000000000000000000/
Log("[Minecraft] 开始获取统一通行证下载信息")
Dim DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Instance:=Instance), RequireJson:=True))
Dim DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Settings.Get("VersionServerNide", Instance:=Instance), RequireJson:=True))
Result.Add(New NetFile(
Urls:={"https://login.mc-user.com:233/index/jar"},
LocalPath:=TargetFile,
@@ -2029,7 +2039,7 @@ OnLoaded:
End If
'Authlib-Injector 文件
If Setup.Get("VersionServerLogin", Instance:=Instance) = 4 Then
If Settings.Get("VersionServerLogin", Instance:=Instance) = 4 Then
Dim TargetFile = PathPure & "authlib-injector.jar"
Try
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
@@ -2143,7 +2153,7 @@ OnLoaded:
''' 检查设置，是否应当忽略文件检查？
''' </summary>
Public Function ShouldIgnoreFileCheck(Instance As McInstance)
Return Setup.Get("VersionAdvanceAssetsV2", Instance:=Instance) OrElse (Setup.Get("VersionAdvanceAssets", Instance:=Instance) = 2)
Return Settings.Get("VersionAdvanceAssetsV2", Instance:=Instance) OrElse (Settings.Get("VersionAdvanceAssets", Instance:=Instance) = 2)
End Function
#End Region
@@ -2366,8 +2376,8 @@ OnLoaded:
If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0
If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1
End If
Left = Left.ToLowerInvariant
Right = Right.ToLowerInvariant
Left = Left.Lower
Right = Right.Lower
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
Dim i As Integer = 0
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
+22 -22
View File
@@ -1,7 +1,7 @@
Imports System.IO.Compression
Public Module ModMod
Private Const LocalModCacheVersion As Integer = 11
Private Const LocalModCacheVersion As Integer = 12
Public Class McMod
@@ -79,7 +79,7 @@ Public Module ModMod
End Get
Set(value As String)
If _Name Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso
value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
value.Lower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
_Name = value
End If
End Set
@@ -98,7 +98,7 @@ Public Module ModMod
If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then
_Description = value.ToString.Trim(vbLf)
'优化显示：若以 [a-zA-Z0-9] 结尾，加上小数点句号
If _Description.ToLower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "."
If _Description.Lower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "."
End If
End Set
End Property
@@ -252,10 +252,10 @@ GotFabric:
End If
Loop
End If
Value = Join(ValueLines, vbLf).Trim(vbLf).Replace(vbLf, vbCrLf)
ElseIf RawValue.ToLower = "true" OrElse RawValue.ToLower = "false" Then
Value = ValueLines.Join(vbLf).Trim(vbLf).Replace(vbLf, vbCrLf)
ElseIf RawValue.Lower = "true" OrElse RawValue.Lower = "false" Then
'布尔型
Value = (RawValue.ToLower = "true")
Value = (RawValue.Lower = "true")
ElseIf Val(RawValue).ToString = RawValue Then
'数字型
Value = Val(RawValue)
@@ -424,7 +424,7 @@ Finished:
''' </summary>
Public ReadOnly Property CanUpdate As Boolean
Get
Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso Not Setup.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
Return Not Settings.Get("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
End Get
End Property
@@ -526,7 +526,7 @@ Finished:
''' 是否可能为前置 Mod。目前非常不准确。
''' </summary>
Public Function IsPresetMod() As Boolean
Return DisplayName IsNot Nothing AndAlso (DisplayName.ToLower.Contains("core") OrElse DisplayName.ToLower.Contains("lib"))
Return DisplayName IsNot Nothing AndAlso (DisplayName.Lower.Contains("core") OrElse DisplayName.Lower.Contains("lib"))
End Function
''' <summary>
@@ -534,7 +534,7 @@ Finished:
''' </summary>
Public Shared Function IsModFile(Path As String)
If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
Path = Path.ToLower
Path = Path.Lower
If Path.EndsWithF(".jar", True) OrElse Path.EndsWithF(".zip", True) OrElse Path.EndsWithF(".litemod", True) OrElse
Path.EndsWithF(".jar.disabled", True) OrElse Path.EndsWithF(".zip.disabled", True) OrElse Path.EndsWithF(".litemod.disabled", True) OrElse
Path.EndsWithF(".jar.old", True) OrElse Path.EndsWithF(".zip.old", True) OrElse Path.EndsWithF(".litemod.old", True) Then Return True
@@ -555,7 +555,7 @@ Finished:
Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
If Loader.IsAborted Then Return
If Loader.IsInterrupted Then Return
Thread.Sleep(100)
Loop
Finally
@@ -567,9 +567,9 @@ Finished:
'获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo)
If Directory.Exists(Loader.Input) Then
Dim RawName As String = Loader.Input.ToLower
Dim RawName As String = Loader.Input.Lower
For Each File As FileInfo In EnumerateFiles(Loader.Input)
If File.DirectoryName.ToLower & "\" <> RawName Then
If File.DirectoryName.Lower & "\" <> RawName Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时，才加载该子文件夹下的 Mod
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
@@ -602,7 +602,7 @@ Finished:
'加载 Mod 列表
Dim ModList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList
If Loader.IsAborted Then Return
If Loader.IsInterrupted Then Return
Dim ModEntry As New McMod(ModFile.FullName)
Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName) '存在两个文件，名称相同，但一个启用一个禁用
If DumpMod IsNot Nothing Then
@@ -622,7 +622,7 @@ Finished:
ModList = ModList.OrderBy(Function(m) m.FileName).ToList
'回设
If Loader.IsAborted Then Return
If Loader.IsInterrupted Then Return
Loader.Output = ModList
'开始联网加载
@@ -641,7 +641,7 @@ Finished:
Dim Cache As JObject = Loader.Input.Value
'读取 Comp 缓存，获取需要更新的 Mod 列表
For Each ModEntry As McMod In Loader.Input.Key
If Loader.IsAborted Then Return
If Loader.IsInterrupted Then Return
Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
@@ -691,7 +691,7 @@ Finished:
Entry.CompFile.Version = File.Version '使用来自 Modrinth 的版本号
End If
Next
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3：获取工程信息
If Not ModrinthMapping.Any() Then Return
@@ -707,7 +707,7 @@ Finished:
'步骤 4：获取更新信息
Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
""loaders"": [""{ModLoaders.Join(""",""").Lower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
@@ -740,7 +740,7 @@ Finished:
Dim CurseForgeHashes As New List(Of UInteger)
For Each Entry In Mods
CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Next
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
@@ -761,7 +761,7 @@ Finished:
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next
Next
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3：获取工程信息
If Not CurseForgeMapping.Any() Then Return
@@ -781,7 +781,7 @@ Finished:
Entry.Comp = Project
Next
'查找或许版本更新的文件列表
If ModLoaders.Count = 1 Then
If ModLoaders.IsSingle Then
Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes")
@@ -844,7 +844,7 @@ Finished:
'等待线程结束
Do Until EndedThreadCount = 2
Thread.Sleep(10)
If Loader.IsAborted Then Return
If Loader.IsInterrupted Then Return
Loop
'保存缓存
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
@@ -856,7 +856,7 @@ Finished:
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
If Loader.IsAborted Then Return
If Loader.IsInterrupted Then Return
If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+5 -5
View File
@@ -200,7 +200,7 @@ Retry:
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.ToLower
Dim Id As String = If(Entry("id"), "").ToString.Lower
If Id.StartsWithF("forge-") Then
'Forge 指定
If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老，已不支持进行安装！")
@@ -250,7 +250,7 @@ Retry:
'获取 Mod 下载信息
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray))
Task.Output = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json")("data")
Task.Output = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & ModList.Join(",") & "]}", "application/json")("data")
'如果文件已被删除，则 API 会跳过那一项
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除，所以没法继续安装了，请向整合包作者反馈该问题")
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
@@ -369,7 +369,7 @@ Retry:
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.ToLower
Select Case Entry.Name.Lower
Case "minecraft"
MinecraftVersion = Entry.Value.ToString
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
@@ -584,7 +584,7 @@ Retry:
If Not Line.Contains("=") Then Continue For
Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
Next
WriteFile(MMCSetupFile, Join(Lines, vbCrLf))
WriteFile(MMCSetupFile, Lines.Join(vbCrLf))
'读取文件
If ReadIni(MMCSetupFile, "OverrideCommands", False) Then
Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand")
@@ -621,7 +621,7 @@ Retry:
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数（覆盖）：" & JvmArgs)
Else
JvmArgs += " " & Setup.Get("LaunchAdvanceJvm")
JvmArgs += " " & Settings.Get("LaunchAdvanceJvm")
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数（追加）：" & JvmArgs)
End If
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+5 -5
View File
@@ -33,13 +33,13 @@
HasRunningMinecraft = False
FrmMain.BtnExtraShutdown.ShowRefresh()
'音乐播放
If Setup.Get("UiMusicStop") Then
If Settings.Get("UiMusicStop") Then
RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置，在结束后开始音乐播放"))
ElseIf Setup.Get("UiMusicStart") Then
ElseIf Settings.Get("UiMusicStart") Then
RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置，在结束后暂停音乐播放"))
End If
'启动器可见性
Select Case Setup.Get("LaunchArgumentVisible")
Select Case Settings.Get("LaunchArgumentVisible")
Case 2
'直接关闭
If TriggerLauncherShutdown Then
@@ -91,7 +91,7 @@
RunInNewThread(
Sub()
Try
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Interrupted
TimerWindow()
TimerLog()
'设置窗口标题
@@ -277,7 +277,7 @@
WatcherLog($"Minecraft 窗口已加载：{MinecraftWindowName}（{MinecraftWindowHandle.ToInt64}）")
IsWindowFinished = True
'最大化
If Setup.Get("LaunchArgumentWindowType") = 4 Then
If Settings.Get("LaunchArgumentWindowType") = 4 Then
RunInNewThread(
Sub()
Try