Public Module ModComp Public Enum CompType ''' ''' Mod。 ''' [Mod] ''' ''' 整合包。 ''' ModPack ''' ''' 资源包。 ''' ResourcePack End Enum Public Enum CompModLoaderType 'https://docs.curseforge.com/?http#tocS_ModLoaderType Any = 0 Forge = 1 Fabric = 4 Quilt = 5 End Enum Public Enum CompSourceType CurseForge = 1 Modrinth = 2 Any = CurseForge Or Modrinth End Enum #Region "CompDatabase | Mod 数据库" Private _CompDatabase As List(Of CompDatabaseEntry) = Nothing Private ReadOnly Property CompDatabase As List(Of CompDatabaseEntry) Get If _CompDatabase IsNot Nothing Then Return _CompDatabase '初始化数据库 _CompDatabase = New List(Of CompDatabaseEntry) Dim i As Integer = 0 For Each Line In DecodeBytes(GetResources("ModData")).Replace(vbCrLf, vbLf).Replace(vbCr, "").Split(vbLf) i += 1 If Line = "" Then Continue For For Each EntryData As String In Line.Split("¨") Dim Entry = New CompDatabaseEntry Dim SplitedLine = EntryData.Split("|") If SplitedLine(0).StartsWith("@") Then Entry.CurseForgeSlug = Nothing Entry.ModrinthSlug = SplitedLine(0).Replace("@", "") ElseIf SplitedLine(0).EndsWith("@") Then Entry.CurseForgeSlug = SplitedLine(0).TrimEnd("@") Entry.ModrinthSlug = Entry.CurseForgeSlug ElseIf SplitedLine(0).Contains("@") Then Entry.CurseForgeSlug = SplitedLine(0).Split("@")(0) Entry.ModrinthSlug = SplitedLine(0).Split("@")(1) Else Entry.CurseForgeSlug = SplitedLine(0) Entry.ModrinthSlug = Nothing End If Entry.WikiId = i If SplitedLine.Count >= 2 Then Entry.ChineseName = SplitedLine(1) Entry.MCBBS = If(SplitedLine.Count >= 3, SplitedLine(2), Nothing) If Entry.ChineseName.Contains("*") Then '处理 * Entry.ChineseName = Entry.ChineseName.Replace("*", " (" & String.Join(" ", If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Split("-").Select(Function(w) w.Substring(0, 1).ToUpper & w.Substring(1, w.Length - 1))) & ")") End If End If _CompDatabase.Add(Entry) Next Next Return _CompDatabase End Get End Property Private Class CompDatabaseEntry ''' ''' McMod 的对应 ID。 ''' Public WikiId As Integer ''' ''' 中文译名。空字符串代表没有翻译。 ''' Public ChineseName As String = "" ''' ''' MCBBS 发布帖编号(例如 195107)。若为 Nothing 则没有发布帖。 ''' Public MCBBS As Integer? ''' ''' CurseForge Slug(例如 advanced-solar-panels)。 ''' Public CurseForgeSlug As String = Nothing ''' ''' Modrinth Slug(例如 advanced-solar-panels)。 ''' Public ModrinthSlug As String = Nothing Public Overrides Function ToString() As String Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & WikiId & "|" & ChineseName & If(MCBBS Is Nothing, "", "|" & MCBBS) End Function End Class #End Region #Region "CompProject | 工程信息" '类定义 Public Class CompProject '源信息 ''' ''' 该工程信息来自 CurseForge 还是 Modrinth。 ''' Public ReadOnly FromCurseForge As Boolean ''' ''' 工程的种类。 ''' Public ReadOnly Type As CompType ''' ''' 工程的短名。例如 technical-enchant。 ''' Public ReadOnly Slug As String ''' ''' CurseForge 工程的数字 ID。Modrinth 工程的乱码 ID。 ''' Public ReadOnly Id As String ''' ''' CurseForge 文件列表的数字 ID。Modrinth 工程的此项无效。 ''' Public ReadOnly CurseForgeFileIds As List(Of Integer) '描述性信息 ''' ''' 原始的英文名称。 ''' Public ReadOnly RawName As String ''' ''' 英文描述。 ''' Public ReadOnly Description As String ''' ''' 来源网站的工程页面网址。确保格式一定标准。 ''' CurseForge:https://www.curseforge.com/minecraft/mc-mods/jei ''' Modrinth:https://modrinth.com/mod/technical-enchant ''' Public ReadOnly Website As String ''' ''' 最后一次更新的时间。可能为 Nothing。 ''' Public ReadOnly LastUpdate As Date? = Nothing ''' ''' 下载量计数。注意,该计数仅为一个来源,无法反应两边加起来的下载量! ''' Public ReadOnly DownloadCount As Integer ''' ''' 支持的 Mod 加载器列表。可能为空。 ''' Public ReadOnly ModLoaders As List(Of CompModLoaderType) ''' ''' 描述性标签的内容。已转换为中文。 ''' Public ReadOnly Tags As List(Of String) ''' ''' Logo 图片的下载地址。若为 Nothing 则没有。 ''' Public ReadOnly LogoUrl As String = Nothing ''' ''' 游戏大版本列表。例如:18, 16, 15…… ''' Public ReadOnly GameVersions As List(Of Integer) '数据库信息 Private LoadedDatabase As Boolean = False Private _DatabaseEntry As CompDatabaseEntry = Nothing ''' ''' 关联的数据库条目。若为 Nothing 则没有。 ''' Private Property DatabaseEntry As CompDatabaseEntry Get If Not LoadedDatabase Then LoadedDatabase = True _DatabaseEntry = CompDatabase.FirstOrDefault(Function(c) If(FromCurseForge, c.CurseForgeSlug, c.ModrinthSlug) = Slug) End If Return _DatabaseEntry End Get Set(value As CompDatabaseEntry) LoadedDatabase = True _DatabaseEntry = value End Set End Property ''' ''' MC 百科的页面 ID。若为 0 则没有。 ''' Public ReadOnly Property WikiId As Integer Get Return If(DatabaseEntry Is Nothing, 0, DatabaseEntry.WikiId) End Get End Property ''' ''' MCBBS 的帖子 ID。若为 0 则没有。 ''' Public ReadOnly Property MCBBS As Integer Get Return If(DatabaseEntry Is Nothing, 0, If(DatabaseEntry.MCBBS, 0)) End Get End Property ''' ''' 翻译后的中文名。若数据库没有则等同于 RawName。 ''' Public ReadOnly Property TranslatedName As String Get Return If(DatabaseEntry Is Nothing OrElse DatabaseEntry.ChineseName = "", RawName, DatabaseEntry.ChineseName) End Get End Property '实例化 ''' ''' 从工程 Json 中初始化实例。若出错会抛出异常。 ''' Public Sub New(Data As JObject) FromCurseForge = Data.ContainsKey("gameId") If FromCurseForge Then #Region "CurseForge" '简单信息 Id = Data("id") Slug = Data("slug") RawName = Data("name") Description = Data("summary") Website = Data("links")("websiteUrl").ToString.TrimEnd("/") LastUpdate = Data("dateReleased") '#1194 DownloadCount = Data("downloadCount") 'Logo If Data("logo").Count > 0 Then If GetPixelSize(1) > 1.25 Then LogoUrl = Data("logo")("thumbnailUrl").ToString '使用 256x256 图标 Else LogoUrl = Data("logo")("thumbnailUrl").ToString.Replace("/256/256/", "/64/64/") '使用 64x64 图标 End If End If 'FileIndexes / GameVersions Dim Files = If(CType(Data("latestFilesIndexes"), JArray), New JArray). Where(Function(i) i("gameVersion").ToString.Contains("1.")) CurseForgeFileIds = Files.Select(Of Integer)(Function(v) v("fileId")).ToList GameVersions = Files.Select(Of Integer)(Function(v) Val(v("gameVersion").ToString.Split(".")(1).Split("-").First)).Where(Function(v) v > 0). Distinct.OrderByDescending(Function(v) v).ToList 'Type If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then Type = CompType.Mod ElseIf Website.Contains("/modpacks/") Then Type = CompType.ModPack Else Type = CompType.ResourcePack End If 'Tags Tags = New List(Of String) For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c) Select Case Category 'Mod Case 406 : Tags.Add("世界元素") Case 407 : Tags.Add("生物群系") Case 410 : Tags.Add("维度") Case 408 : Tags.Add("矿物/资源") Case 409 : Tags.Add("天然结构") Case 412 : Tags.Add("科技") Case 415 : Tags.Add("管道/物流") Case 4843 : Tags.Add("自动化") Case 417 : Tags.Add("能源") Case 4558 : Tags.Add("红石") Case 436 : Tags.Add("食物/烹饪") Case 416 : Tags.Add("农业") Case 414 : Tags.Add("运输") Case 420 : Tags.Add("仓储") Case 419 : Tags.Add("魔法") Case 422 : Tags.Add("冒险") Case 424 : Tags.Add("装饰") Case 411 : Tags.Add("生物") Case 434 : Tags.Add("装备") Case 423 : Tags.Add("信息显示") Case 435 : Tags.Add("服务器") Case 5191 : Tags.Add("改良") Case 421 : Tags.Add("支持库") '整合包 Case 4484 : Tags.Add("多人") Case 4479 : Tags.Add("硬核") Case 4483 : Tags.Add("战斗") Case 4478 : Tags.Add("任务") Case 4472 : Tags.Add("科技") Case 4473 : Tags.Add("魔法") Case 4475 : Tags.Add("冒险") Case 4476 : Tags.Add("探索") Case 4477 : Tags.Add("小游戏") Case 4471 : Tags.Add("科幻") Case 4736 : Tags.Add("空岛") Case 5128 : Tags.Add("原版改良") Case 4487 : Tags.Add("FTB") Case 4480 : Tags.Add("基于地图") Case 4481 : Tags.Add("轻量") Case 4482 : Tags.Add("大型") 'FUTURE: Res End Select Next If Tags.Count = 0 Then Tags.Add("杂项") 'ModLoaders ModLoaders = New List(Of CompModLoaderType) For Each File In If(Data("latestFiles"), {}) Dim NewFile As New CompFile(File, Type) If Not NewFile.Available Then Continue For ModLoaders.AddRange(NewFile.ModLoaders) Next ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList #End Region Else #Region "Modrinth" '简单信息 Id = If(Data("project_id"), Data("id")) '两个 API 会返回的 key 不一样 Slug = Data("slug") RawName = Data("title") Description = Data("description") LastUpdate = Data("date_modified") DownloadCount = Data("downloads") LogoUrl = Data("icon_url") If LogoUrl = "" Then LogoUrl = Nothing Website = $"https://modrinth.com/{Data("project_type")}/{Slug}" 'GameVersions GameVersions = If(CType(Data("versions"), JArray), New JArray). Select(Function(v) v.ToString).Where(Function(v) v.StartsWith("1.")). Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0). Distinct.OrderByDescending(Function(v) v).ToList 'Type Select Case Data("project_type").ToString Case "mod" : Type = CompType.Mod Case "modpack" : Type = CompType.ModPack Case "resourcepack" : Type = CompType.ResourcePack End Select 'Tags & ModLoaders Tags = New List(Of String) ModLoaders = New List(Of CompModLoaderType) For Each Category In Data("categories").Select(Function(t) t.ToString) Select Case Category '加载器 Case "forge" : ModLoaders.Add(CompModLoaderType.Forge) Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric) Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt) 'Mod Case "worldgen" : Tags.Add("世界元素") Case "technology" : Tags.Add("科技") Case "food" : Tags.Add("食物/烹饪") Case "game-mechanics" : Tags.Add("游戏机制") Case "transportation" : Tags.Add("运输") Case "storage" : Tags.Add("仓储") Case "magic" : Tags.Add("魔法") Case "adventure" : Tags.Add("冒险") Case "decoration" : Tags.Add("装饰") Case "mobs" : Tags.Add("生物") Case "equipment" : Tags.Add("装备") Case "optimization" : Tags.Add("性能优化") Case "social" : Tags.Add("服务器") Case "utility" : Tags.Add("改良") Case "library" : Tags.Add("支持库") '整合包 Case "multiplayer" : Tags.Add("多人") Case "optimization" : Tags.Add("性能优化") Case "challenging" : Tags.Add("硬核") Case "combat" : Tags.Add("战斗") Case "quests" : Tags.Add("任务") Case "technology" : Tags.Add("科技") Case "magic" : Tags.Add("魔法") Case "adventure" : Tags.Add("冒险") Case "kitchen-sink" : Tags.Add("烹饪") Case "lightweight" : Tags.Add("轻量") 'FUTURE: Res End Select Next If Tags.Count = 0 Then Tags.Add("杂项") ModLoaders.Sort() #End Region End If '保存缓存 CompProjectCache(Id) = Me End Sub ''' ''' 将当前工程信息实例化为控件。 ''' Public Function ToCompItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean, Optional OnClick As MyCompItem.ClickEventHandler = Nothing) As MyCompItem '获取版本描述 Dim GameVersionDescription As String If GameVersions Is Nothing OrElse GameVersions.Count = 0 Then GameVersionDescription = "未知" Else Dim SpaVersions As New List(Of String) For i = 0 To GameVersions.Count - 1 Dim StartVersion As Integer = GameVersions(i), EndVersion As Integer = GameVersions(i) For ii = i + 1 To GameVersions.Count - 1 If GameVersions(ii) = EndVersion - 1 Then EndVersion = GameVersions(ii) i = ii Else Exit For End If Next If StartVersion = EndVersion Then SpaVersions.Add("1." & StartVersion) ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then SpaVersions.Add("1." & EndVersion & "+") ElseIf EndVersion <= 7 Then SpaVersions.Add("1." & StartVersion & "-") Exit For ElseIf StartVersion - EndVersion = 1 Then SpaVersions.Add("1." & StartVersion & ", 1." & EndVersion) Else SpaVersions.Add("1." & StartVersion & "~1." & EndVersion) End If Next GameVersionDescription = SpaVersions.Join(", ") End If '实例化 UI Dim NewItem As New MyCompItem With {.Tag = Me} '标题 Dim FinalName As String = TranslatedName.Split(" | ").First.Split(" - ").First.Split("(").First.Split("[").First Dim ExNameList As List(Of String) = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries). Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList ExNameList.RemoveAt(0) If TranslatedName = RawName AndAlso '没有中文翻译 Not ExNameList.Any(Function(s) s.Contains("orge") OrElse s.Contains("abric") OrElse s.Contains("uilt")) AndAlso '不是标注 XX 版 Not (ExNameList.Count = 1 AndAlso ExNameList.First.ToUpper <> ExNameList.First) Then '不是缩写 FinalName = RawName '使用原名 ExNameList.Clear() End If NewItem.LabTitle.Text = FinalName If ExNameList.Count = 0 Then NoExName: CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw) Else Dim ExName As String = "" For Each Ex In ExNameList '去除 “Forge/Fabric” 这一无意义提示 If Ex.Length < 19 AndAlso Ex.ToLower.Contains("fabric") AndAlso Ex.ToLower.Contains("forge") Then Continue For '将 “Forge” 等提示改为 “Forge 版” If (Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt")) AndAlso Not Ex.Contains("版") AndAlso Ex.Length < 19 Then Ex = Ex.Replace("Edition", "").Trim & " 版" ExName &= " | " & Ex.Trim Next If ExName = "" Then GoTo NoExName NewItem.LabTitleRaw.Text = ExName End If 'Tag For Each TagText In Tags Dim NewTag = GetObjectFromXML( " ") NewItem.PanTags.Children.Add(NewTag) Next '下边栏 If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then '全部隐藏 CType(NewItem.PathVersion.Parent, Grid).Children.Remove(NewItem.PathVersion) CType(NewItem.LabVersion.Parent, Grid).Children.Remove(NewItem.LabVersion) NewItem.ColumnVersion1.Width = New GridLength(0) NewItem.ColumnVersion2.MaxWidth = 0 NewItem.ColumnVersion3.Width = New GridLength(0) ElseIf ShowMcVersionDesc AndAlso ShowMcVersionDesc Then '全部显示 Dim ModLoaderDesc As String = If(ModLoaders.Count > 0 AndAlso ModLoaders.Count < 3 AndAlso Not (Type = CompType.Mod AndAlso Setup.Get("ToolDownloadIgnoreQuilt") AndAlso ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric)), ModLoaders.Join(" / ") & " ", "") Dim VersionDesc As String = If(GameVersionDescription = "1.7+", "全版本", GameVersionDescription) NewItem.LabVersion.Text = ModLoaderDesc & VersionDesc ElseIf ShowMcVersionDesc Then '仅显示版本 NewItem.LabVersion.Text = If(GameVersionDescription = "1.7+", "全版本", GameVersionDescription) Else '仅显示 Mod 加载器 Select Case ModLoaders.Count Case 0 NewItem.LabVersion.Text = "未知" Case 1 NewItem.LabVersion.Text = If(Type = CompType.Mod, "仅 ", "") & ModLoaders(0).ToString Case 2 If Type = CompType.Mod Then NewItem.LabVersion.Text = If(Not (Setup.Get("ToolDownloadIgnoreQuilt") AndAlso ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric)), ModLoaders.Join(" / "), "任意") Else NewItem.LabVersion.Text = ModLoaders.Join(" / ") End If Case 3 If Type = CompType.Mod Then NewItem.LabVersion.Text = "任意" Else NewItem.LabVersion.Text = ModLoaders.Join(" / ") End If End Select End If NewItem.LabInfo.Text = Description.Replace(vbCr, "").Replace(vbLf, "") 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.LabDownload.Text = If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿", If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount)) '其他 If LogoUrl Is Nothing Then NewItem.Logo = "pack://application:,,,/images/Icons/NoIcon.png" Else NewItem.Logo = LogoUrl End If If OnClick IsNot Nothing Then AddHandler NewItem.Click, OnClick NewItem.HasAnimation = True Else NewItem.HasAnimation = False End If Return NewItem End Function '辅助函数 ''' ''' 检查是否与某个 Project 是相同的工程,只是在不同的网站。 ''' Public Function IsLike(Project As CompProject) As Boolean If Id = Project.Id Then Return True '相同实例 '提取字符串中的字母和数字 Dim GetRaw = Function(Data As String) As String Dim Result As New StringBuilder() For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c)) Result.Append(r) Next Return Result.ToString.ToLower End Function '来自不同的网站 If FromCurseForge = Project.FromCurseForge Then Return False 'Mod 加载器一致 If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False 'MC 版本一致 If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False 'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同 If TranslatedName = Project.TranslatedName OrElse RawName = Project.RawName OrElse Description = Project.Description OrElse GetRaw(Slug) = GetRaw(Project.Slug) Then Log($"[Comp] 将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程") '如果只有一个有 DatabaseEntry,设置给另外一个 If DatabaseEntry Is Nothing AndAlso Project.DatabaseEntry IsNot Nothing Then DatabaseEntry = Project.DatabaseEntry If DatabaseEntry IsNot Nothing AndAlso Project.DatabaseEntry Is Nothing Then Project.DatabaseEntry = DatabaseEntry Return True End If Return False End Function Public Overrides Function ToString() As String Return $"{Id} ({Slug}): {RawName}" End Function Public Overrides Function Equals(obj As Object) As Boolean Dim project = TryCast(obj, CompProject) Return project IsNot Nothing AndAlso Id = project.Id End Function Public Shared Operator =(left As CompProject, right As CompProject) As Boolean Return EqualityComparer(Of CompProject).Default.Equals(left, right) End Operator Public Shared Operator <>(left As CompProject, right As CompProject) As Boolean Return Not left = right End Operator End Class '输入与输出 Public Class CompProjectRequest '结果要求 ''' ''' 加载后应输出到的结果存储器。 ''' Public Storage As CompProjectStorage ''' ''' 应当尽量达成的结果数量。 ''' Public TargetResultCount As Integer ''' ''' 根据加载位置记录,是否还可以继续获取内容。 ''' Public ReadOnly Property CanContinue As Boolean Get If Tag.StartsWith("/") Then Storage.CurseForgeTotal = 0 If Tag.EndsWith("/") Then Storage.ModrinthTotal = 0 If Storage.CurseForgeTotal = -1 OrElse Storage.ModrinthTotal = -1 Then Return True Return Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal End Get End Property '输入内容 ''' ''' 筛选资源种类。 ''' Public Type As CompType ''' ''' 筛选资源标签。空字符串代表不限制。格式例如 "406/worldgen",分别是 CurseForge 和 Modrinth 的 ID。 ''' Public Tag As String = "" ''' ''' 筛选 Mod 加载器类别。 ''' Public ModLoader As CompModLoaderType = CompModLoaderType.Any ''' ''' 筛选 MC 版本。 ''' Public GameVersion As String = Nothing ''' ''' 搜索的文本内容。 ''' Public SearchText As String = Nothing ''' ''' 允许的来源。 ''' Public Source As CompSourceType = CompSourceType.Any ''' ''' 构造函数。 ''' Public Sub New(Type As CompType, Storage As CompProjectStorage, TargetResultCount As Integer) Me.Type = Type Me.Storage = Storage Me.TargetResultCount = TargetResultCount End Sub '构造请求 ''' ''' 获取对应的 CurseForge API 请求链接。若返回 Nothing 则为不进行 CurseForge 请求。 ''' Public Function GetCurseForgeAddress() As String If Not Source.HasFlag(CompSourceType.CurseForge) Then Return Nothing If Tag.StartsWith("/") 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}" Select Case Type Case CompType.Mod Address += "&classId=6" Case CompType.ModPack Address += "&classId=4471" Case CompType.ResourcePack 'FUTURE: Res End Select Address += "&categoryId=" & If(Tag = "", "0", Tag.Split("/").First) If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer) If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText) If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset Return Address End Function ''' ''' 获取对应的 Modrinth API 请求链接。若返回 Nothing 则为不进行 Modrinth 请求。 ''' Public Function GetModrinthAddress() As String If Not Source.HasFlag(CompSourceType.Modrinth) Then Return Nothing If Tag.EndsWith("/") 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" 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}""]") If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.Split("/").Last}'""]") If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]") If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]") Address += "&facets=[" & String.Join(",", Facets) & "]" Return Address End Function '相同判断 Public Overrides Function Equals(obj As Object) As Boolean Dim request = TryCast(obj, CompProjectRequest) Return request IsNot Nothing AndAlso Type = request.Type AndAlso TargetResultCount = request.TargetResultCount AndAlso Tag = request.Tag AndAlso ModLoader = request.ModLoader AndAlso Source = request.Source AndAlso GameVersion = request.GameVersion AndAlso SearchText = request.SearchText End Function Public Shared Operator =(left As CompProjectRequest, right As CompProjectRequest) As Boolean Return EqualityComparer(Of CompProjectRequest).Default.Equals(left, right) End Operator Public Shared Operator <>(left As CompProjectRequest, right As CompProjectRequest) As Boolean Return Not left = right End Operator End Class Public Class CompProjectStorage '加载位置记录 Public CurseForgeOffset As Integer = 0 Public CurseForgeTotal As Integer = -1 Public ModrinthOffset As Integer = 0 Public ModrinthTotal As Integer = -1 '结果列表 ''' ''' 可供展示的所有工程的列表。 ''' Public Results As New List(Of CompProject) End Class '实际的获取 Private Const CompPageSize = 40 ''' ''' 已知工程信息的缓存。 ''' Private CompProjectCache As New Dictionary(Of String, CompProject) ''' ''' 根据搜索请求获取一系列的工程列表。需要基于加载器运行。 ''' Public Sub CompProjectsGet(Task As LoaderTask(Of CompProjectRequest, Integer)) Dim Storage = Task.Input.Storage '避免多线程问题 If Task.Input.Storage.Results.Count >= Task.Input.TargetResultCount Then Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,多于所需的 {Task.Input.TargetResultCount} 个结果,结束处理") Exit Sub ElseIf Not Task.Input.CanContinue Then If Task.Input.Storage.Results.Count = 0 Then Throw New Exception("没有符合条件的结果") Else Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,少于所需的 {Task.Input.TargetResultCount} 个结果,但无法继续获取,结束处理") Exit Sub End If End If #Region "拒绝 1.13- Quilt(这个版本根本没有 Quilt)" If Task.Input.ModLoader = CompModLoaderType.Quilt AndAlso VersionSortInteger(If(Task.Input.GameVersion, "1.15"), "1.14") = -1 Then Throw New Exception("Quilt 不支持 Minecraft " & Task.Input.GameVersion) End If #End Region #Region "处理搜索文本,赋值回 Task.Input.SearchText" Dim RawFilter As String = If(Task.Input.SearchText, "").Trim Task.Input.SearchText = RawFilter RawFilter = RawFilter.ToLower Log("[Comp] 工程列表搜索原始文本:" & RawFilter) '中文请求关键字处理 Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawFilter) If IsChineseSearch AndAlso Task.Input.Type = CompType.Mod Then '构造搜索请求 Dim SearchEntries As New List(Of SearchEntry(Of CompDatabaseEntry)) For Each Entry In CompDatabase If Entry.ChineseName.Contains("动态的树") Then Continue For '这玩意儿附属太多了 SearchEntries.Add(New SearchEntry(Of CompDatabaseEntry) With { .Item = Entry, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From { New KeyValuePair(Of String, Double)(Entry.ChineseName & If(Entry.CurseForgeSlug, "") & If(Entry.ModrinthSlug, ""), 1) } }) Next '获取搜索结果 Dim SearchResults = Search(SearchEntries, Task.Input.SearchText, 3) If SearchResults.Count = 0 Then Throw New Exception("无搜索结果,请尝试搜索英文名称") Dim SearchResult As String = "" For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的,也最多只要 5 个 If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度 If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ") & " " If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ") & " " SearchResult += SearchResults(i).Item.ChineseName.Split(" (").Last.TrimEnd(") ").Split(" - ").First. Replace(":", "").Replace("(", "").Replace(")", "").ToLower & " " Next Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer) '去除常见连接词 Dim RealFilter As String = "" For Each Word In SearchResult.Split(" ") If {"the", "of", "a", "mod"}.Contains(Word.ToLower) OrElse Val(Word) > 0 Then Continue For If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " " Next Task.Input.SearchText = RealFilter Log("[Comp] 中文搜索最终关键词:" & RealFilter, LogLevel.Developer) End If '驼峰英文请求关键字处理 Dim SpacedKeywords = RegexReplace(Task.Input.SearchText, "$& ", "([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)") Dim ConnectedKeywords = Task.Input.SearchText.Replace(" ", "") Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchText, ConnectedKeywords & " " & RawFilter)).ToLower '最终处理关键字:分割、去重 Dim RightKeywords As New List(Of String) For Each Keyword In AllPossibleKeywords.Split(" ") If Keyword.Trim = "" Then Continue For If {"forge", "fabric", "for", "mod", "forge/fabric", "fabric/forge", "fabric/quilt", "quilt/fabric"}.Contains(Keyword) Then '#208 Log("[Comp] 已跳过搜索关键词:" & Keyword) Continue For End If RightKeywords.Add(Keyword) Next If RawFilter.Length > 0 AndAlso RightKeywords.Count = 0 Then Task.Input.SearchText = RawFilter '全都被过滤掉了 Else Task.Input.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower End If '例外项:OptiForge、OptiFabric(拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod) If RawFilter.Replace(" ", "").ToLower.Contains("optiforge") Then Task.Input.SearchText = "optiforge" If RawFilter.Replace(" ", "").ToLower.Contains("optifabric") Then Task.Input.SearchText = "optifabric" Log("[Comp] 工程列表搜索最终文本:" & Task.Input.SearchText, LogLevel.Developer) Task.Progress = 0.1 #End Region Dim RealResults As New List(Of CompProject) Retry: Dim RawResults As New List(Of CompProject) Dim [Error] As Exception = Nothing #Region "从 CurseForge 和 Modrinth 获取结果列表,存储于 RawResults" Dim CurseForgeThread As Thread = Nothing Dim ModrinthThread As Thread = Nothing Dim ResultsLock As New Object Try '启动 CurseForge 线程 Dim CurseForgeUrl As String = Task.Input.GetCurseForgeAddress() If CurseForgeUrl IsNot Nothing Then CurseForgeThread = RunInNewThread( Sub() Try '获取工程列表 Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl) Dim RequestResult As JObject = NetGetCodeByRequestRetry(CurseForgeUrl, IsJson:=True, Encode:=Encoding.UTF8) Task.Progress += 0.2 Dim ProjectList As New List(Of CompProject) For Each JsonEntry As JObject In RequestResult("data") ProjectList.Add(New CompProject(JsonEntry)) Next '更新结果 SyncLock ResultsLock RawResults.AddRange(ProjectList) End SyncLock Storage.CurseForgeOffset += ProjectList.Count Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer) Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)") Catch ex As Exception Log(ex, "从 CurseForge 获取工程列表失败") Storage.CurseForgeTotal = Storage.CurseForgeOffset [Error] = ex End Try End Sub, "CurseForge Project Request") End If '启动 Modrinth 线程 Dim ModrinthUrl As String = Task.Input.GetModrinthAddress() If ModrinthUrl IsNot Nothing Then ModrinthThread = RunInNewThread( Sub() Try Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl) Dim RequestResult As JObject = NetGetCodeByRequestRetry(ModrinthUrl, IsJson:=True, Encode:=Encoding.UTF8) 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 RawResults.AddRange(ProjectList) End SyncLock Storage.ModrinthOffset += ProjectList.Count Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer) Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)") Catch ex As Exception Log(ex, "从 Modrinth 获取工程列表失败") Storage.ModrinthTotal = Storage.ModrinthOffset [Error] = ex End Try End Sub, "Modrinth Project Request") End If '等待线程结束 If CurseForgeThread IsNot Nothing Then CurseForgeThread.Join() If Task.IsAborted Then Exit Sub '会自动触发 Finally If ModrinthThread IsNot Nothing Then ModrinthThread.Join() If Task.IsAborted Then Exit Sub '确认存在结果 If RawResults.Count = 0 Then If [Error] IsNot Nothing Then Throw [Error] Else If IsChineseSearch AndAlso Task.Input.Type <> CompType.Mod Then Throw New Exception($"{If(Task.Input.Type = CompType.ModPack, "整合包", "资源包")}搜索仅支持英文") ElseIf Task.Input.Source = CompSourceType.CurseForge AndAlso Task.Input.Tag.StartsWith("/") Then Throw New Exception("CurseForge 不兼容所选的类型") ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWith("/") Then Throw New Exception("Modrinth 不兼容所选的类型") Else Throw New Exception("没有符合条件的结果") End If End If End If Finally If CurseForgeThread IsNot Nothing Then CurseForgeThread.Interrupt() If ModrinthThread IsNot Nothing Then ModrinthThread.Interrupt() End Try #End Region #Region "提取非重复项,存储于 RealResults" '将 Modrinth 排在 CurseForge 的前面,避免加载结束顺序不同导致排名不同 '这样做的话,去重后将优先保留 CurseForge 内容(考虑到 CurseForge 热度更高) RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList 'RawResults 去重 RawResults = Distinct(RawResults, Function(a, b) a.IsLike(b)) '已有内容去重 RawResults = RawResults.Where(Function(r) Not RealResults.Any(Function(b) r.IsLike(b)) AndAlso Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList '加入列表 RealResults.AddRange(RawResults) Log($"[Comp] 去重后累计新增结果 {RealResults.Count} 个") #End Region #Region "检查结果数量,如果不足且可继续,会继续加载下一页" If RealResults.Count + Storage.Results.Count < Task.Input.TargetResultCount Then Log($"[Comp] 总结果数需求最少 {Task.Input.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个") If Task.Input.CanContinue Then Log("[Comp] 将继续尝试加载下一页") GoTo Retry Else Log("[Comp] 无法继续加载,将强制结束") End If End If #End Region #Region "将结果排序并添加" Dim Scores As New Dictionary(Of CompProject, Double) '排序分 If String.IsNullOrEmpty(Task.Input.SearchText) Then '如果没有搜索文本,按下载量将结果排序 For Each Result As CompProject In RealResults Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 30)) Next Else '如果有搜索文本,按关联度将结果排序 '排序分 = 搜索相对相似度 (1) + 下载量权重 (对数,10 亿时为 1) + 有中文名 (0.2) Dim Entry 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) * If(Result.FromCurseForge, 1, 30)) / 9) Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From { New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1), New KeyValuePair(Of String, Double)(Result.Description, 0.05)}}) Next Dim SearchResult = Search(Entry, RawFilter, 101, -1) For Each OneResult In SearchResult Scores(OneResult.Item) += OneResult.Similarity / SearchResult(0).Similarity '最高 1 分的相似度分 Next End If '根据排序分得出结果并添加 Storage.Results.AddRange( Sort(Scores.ToList, Function(a, b) a.Value > b.Value).Select(Function(r) r.Key).ToList) #End Region End Sub #End Region #Region "CompFile | 文件信息" '类定义 Public Enum CompFileStatus Release = 1 '枚举值来源:https://docs.curseforge.com/#tocS_FileReleaseType Beta = 2 Alpha = 3 End Enum Public Class CompFile '源信息 ''' ''' 文件的种类。 ''' Public ReadOnly Type As CompType ''' ''' 该文件来自 CurseForge 还是 Modrinth。 ''' Public ReadOnly FromCurseForge As Boolean ''' ''' 用于唯一性鉴别该文件的 ID。CurseForge 中为 123456 的大整数,Modrinth 中为英文乱码的 Version 字段。 ''' Public ReadOnly Id As String '描述性信息 ''' ''' 文件描述名(并非文件名,是自定义的字段)。 ''' Public DisplayName As String ''' ''' 发布时间。 ''' Public ReadOnly ReleaseDate As Date ''' ''' 下载量计数。注意,该计数仅为一个来源,无法反应两边加起来的下载量,且 CurseForge 可能错误地返回 0。 ''' Public ReadOnly DownloadCount As Integer ''' ''' 支持的 Mod 加载器列表。可能为空。 ''' Public ReadOnly ModLoaders As List(Of CompModLoaderType) ''' ''' 支持的游戏版本列表。类型包括:"1.18.5","1.18","1.18 快照","21w15a","未知版本"。 ''' Public ReadOnly GameVersions As List(Of String) ''' ''' 发布状态:Release/Beta/Alpha。 ''' Public ReadOnly Status As CompFileStatus ''' ''' 发布状态的友好描述。例如:"正式版","Beta 版"。 ''' Public ReadOnly Property StatusDescription As String Get Select Case Status Case CompFileStatus.Release Return "正式版" Case CompFileStatus.Beta Return If(ModeDebug, "Beta 版", "测试版") Case Else Return If(ModeDebug, "Alpha 版", "测试版") End Select End Get End Property '下载信息 ''' ''' 下载信息是否可用。 ''' Public ReadOnly Property Available As Boolean Get Return FileName IsNot Nothing End Get End Property ''' ''' 下载的文件名。 ''' Public ReadOnly FileName As String = Nothing ''' ''' 文件所有可能的下载源。 ''' Private ReadOnly DownloadAddress As String() ''' ''' 该文件的所有依赖工程的原始 ID。 ''' 这些 ID 可能没有加载,在加载后会添加到 Dependencies 中(主要是因为 Modrinth 返回的是字符串 ID 而非 Slug,导致 Project.Id 查询不到)。 ''' Public ReadOnly RawDependencies As New List(Of String) ''' ''' 该文件的所有依赖工程的 Project.Id。 ''' Public ReadOnly Dependencies As New List(Of String) ''' ''' 获取下载信息。 ''' ''' 目标本地文件夹,或完整的文件路径。会自动判断类型。 Public Function ToNetFile(LocalAddress As String) As NetFile Return New NetFile(DownloadAddress, LocalAddress & If(LocalAddress.EndsWith("\"), FileName, "")) End Function '实例化 ''' ''' 从文件 Json 中初始化实例。若出错会抛出异常。 ''' Public Sub New(Data As JObject, Type As CompType) Me.Type = Type FromCurseForge = Data.ContainsKey("gameId") If FromCurseForge Then #Region "CurseForge" '简单信息 Id = Data("id") DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ") ReleaseDate = Data("fileDate") Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus) DownloadCount = Data("downloadCount") FileName = Data("fileName") 'DownloadAddress Dim Url = Data("downloadUrl").ToString If Url = "" Then Url = "https://media.forgecdn.net/files/" & Id.ToString.Substring(0, 4) & "/" & Id.ToString.Substring(4).TrimStart("0") & "/" & FileName Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码 DownloadAddress = {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"), Url.Replace("-service.overwolf.wtf", ".forgecdn.net"), Url.Replace("://edge", "://media"), Url}.Distinct.ToArray 'Dependencies If Type = CompType.Mod Then RawDependencies = Data("dependencies"). Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖 d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API 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 GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList If GameVersions.Count > 1 Then GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} ElseIf GameVersions.Count = 1 Then GameVersions = GameVersions.ToList Else GameVersions = New List(Of String) From {"未知版本"} End If 'ModLoaders ModLoaders = New List(Of CompModLoaderType) If RawVersions.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge) If RawVersions.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric) If RawVersions.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt) #End Region Else #Region "Modrinth" '简单信息 Id = Data("id") DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ") ReleaseDate = Data("date_published") Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha)) DownloadCount = Data("downloads") '可能为空 If CType(Data("files"), JArray).Count > 0 Then FileName = Data("files")(0)("filename") DownloadAddress = {Data("files")(0)("url").ToString.Replace(FileName, FileName)} End If 'Dependencies If Type = CompType.Mod Then RawDependencies = Data("dependencies"). Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖 d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API d("project_id").ToString.Length > 0). '有时候真的会空…… 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 GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.")). Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", v)).ToList If GameVersions.Count > 1 Then GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} ElseIf GameVersions.Count = 1 Then GameVersions = GameVersions.ToList ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList Else GameVersions = New List(Of String) From {"未知版本"} End If 'ModLoaders Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList ModLoaders = New List(Of CompModLoaderType) If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge) If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric) If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt) #End Region End If End Sub ''' ''' 将当前文件信息实例化为控件。 ''' Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing, Optional BadDisplayName As Boolean = False) As MyListItem '获取描述信息 Dim Info As String = "" Select Case Type Case CompType.Mod Info += If(ModLoaders.Count > 0, "适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & ",", "") Info += If(ModeDebug AndAlso Dependencies.Count > 0, Dependencies.Count & " 个前置 Mod,", "") Case CompType.ModPack If GameVersions.All(Function(v) v.Contains("w")) Then Info += $"游戏版本 {Join(GameVersions, "、")}," End If End Select If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0 Info += If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载,", DownloadCount & " 次下载,") End If Info += GetTimeSpanString(ReleaseDate - Date.Now, False) & "更新" Info += If(Status = CompFileStatus.Release, "", "," & StatusDescription) '建立控件 Dim NewItem As New MyListItem With { .Title = If(BadDisplayName, FileName, DisplayName), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me, .Info = Info } Select Case Status Case CompFileStatus.Release NewItem.Logo = "pack://application:,,,/images/Icons/R.png" Case CompFileStatus.Beta NewItem.Logo = "pack://application:,,,/images/Icons/B.png" Case Else 'Alpha NewItem.Logo = "pack://application:,,,/images/Icons/A.png" End Select AddHandler NewItem.Click, OnClick '建立另存为按钮 If OnSaveClick IsNot Nothing Then Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center) ToolTipService.SetVerticalOffset(BtnSave, 30) ToolTipService.SetHorizontalOffset(BtnSave, 2) AddHandler BtnSave.Click, OnSaveClick NewItem.Buttons = {BtnSave} NewItem.PaddingRight = 35 End If '结束 Return NewItem End Function '辅助函数 Public Overrides Function ToString() As String Return $"{Id}: {DisplayName}" End Function End Class '获取 ''' ''' 已知文件信息的缓存。 ''' Private CompFilesCache As New Dictionary(Of String, List(Of CompFile)) ''' ''' 获取某个工程下的全部文件列表。 ''' 必须在工作线程执行,失败会抛出异常。 ''' Public Function CompFilesGet(ProjectId As String, FromCurseForge As Boolean) As List(Of CompFile) '使用缓存 If CompFilesCache.ContainsKey(ProjectId) Then Return CompFilesCache(ProjectId) '获取工程对象 Dim TargetProject As CompProject If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存 TargetProject = CompProjectCache(ProjectId) ElseIf FromCurseForge Then 'CurseForge TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)("data")) Else 'Modrinth TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)) End If '获取工程对象的文件列表 Log("[Comp] 开始获取文件列表:" & ProjectId) Dim ResultJsonArray As JArray If FromCurseForge Then 'CurseForge If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件 ResultJsonArray = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data") Else '否则使用全部文件 ResultJsonArray = NetGetCodeByRequestRetry($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", Accept:="application/json", IsJson:=True)("data") End If Else 'Modrinth ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True) End If CompFilesCache(ProjectId) = Distinct(ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)). Where(Function(a) a.Available).ToList, Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330) '获取前置 Mod 列表 If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId) Dim Deps As List(Of String) = CompFilesCache(ProjectId). SelectMany(Function(f) f.RawDependencies).Distinct().ToList Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList '获取前置 Mod 工程信息 If UndoneDeps.Count > 0 Then Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}") Dim Projects As JArray If TargetProject.FromCurseForge Then Projects = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data") Else Projects = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", Accept:="application/json", IsJson:=True) End If For Each Project In Projects Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存 Next End If '更新前置 Mod 信息 If Deps.Count > 0 Then For Each DepProject In Deps.Select(Function(id) CompProjectCache(id)) For Each File In CompFilesCache(ProjectId) If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then File.Dependencies.Add(DepProject.Id) End If Next Next End If Return CompFilesCache(ProjectId) End Function ''' ''' 预载包含大量 CompFile 的卡片,添加必要的元素和前置 Mod 列表。 ''' Public Sub CompFilesCardPreload(Stack As StackPanel, Files As List(Of CompFile), OnClick As MyListItem.ClickEventHandler) '获取卡片对应的前置 ID '如果为整合包就不会有 Dependencies 信息,所以不用管 Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList() Deps.Sort() If Deps.Count = 0 Then Exit Sub Deps = Deps.Where(Function(dep) If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug) Return CompProjectCache.ContainsKey(dep) End Function).ToList '添加开头间隔 Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)}) '添加前置 Mod 列表 For Each Dep In Deps Dim Item = CompProjectCache(Dep).ToCompItem(False, False, AddressOf FrmDownloadMod.ProjectClick) Stack.Children.Add(Item) Next '添加结尾间隔 Stack.Children.Add(New TextBlock With {.Text = "可选版本", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 12, 0, 5)}) End Sub #End Region End Module