| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520 |
- Public Class ResourceSearcher
- Private Const RESULT_PAGE_SIZE = 40
- Private Const MSG_NO_CHINESE_RESULT As String = "无搜索结果,请尝试搜索其英文名称"
- '输入
- Public Class SearchRequest
- '结果要求
- ''' <summary>
- ''' 结果存储器,会从中获取需加载的页面等。
- ''' 加载后也应输出到此处。
- ''' </summary>
- Public Storage As SearchResult
- ''' <summary>
- ''' 应当尽量达成的结果数量。
- ''' </summary>
- Public TargetResultCount As Integer
- ''' <summary>
- ''' 根据加载位置记录,是否还可以继续获取内容。
- ''' </summary>
- Public ReadOnly Property CanContinue As Boolean
- Get
- If Tag.StartsWithF("/") OrElse Not Sources.HasFlag(ResourcePlatforms.CurseForge) Then Storage.CurseForgeTotal = 0
- If Tag.EndsWithF("/") OrElse Not Sources.HasFlag(ResourcePlatforms.Modrinth) 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
- '输入内容
- ''' <summary>
- ''' 筛选资源种类。
- ''' </summary>
- Public Type As ResourceTypes
- ''' <summary>
- ''' 筛选资源标签。空字符串代表不限制。格式例如 "406/worldgen",分别是 CurseForge 和 Modrinth 的 ID。
- ''' </summary>
- Public Tag As String = ""
- ''' <summary>
- ''' 筛选 Mod 加载器类别。
- ''' <see cref="ModLoaders.None"/> 代表不筛选。
- ''' 对于 Modrinth 请求,支持多个枚举值。
- ''' </summary>
- Public ModLoaders As ModLoaders = ModLoaders.None
- ''' <summary>
- ''' 筛选 MC 版本。
- ''' </summary>
- Public GameVersion As String = Nothing
- ''' <summary>
- ''' 搜索的初始内容。
- ''' </summary>
- Public SearchText As String = Nothing
- ''' <summary>
- ''' 允许的来源。
- ''' </summary>
- Public Sources As ResourcePlatforms = ResourcePlatforms.Any
- Public Sub New(Type As ResourceTypes, Storage As SearchResult, TargetResultCount As Integer)
- Me.Type = Type
- Me.Storage = Storage
- Me.TargetResultCount = TargetResultCount
- End Sub
- '构造请求
- ''' <summary>
- ''' 获取对应的 CurseForge API 请求链接。
- ''' </summary>
- Public Function GetCurseForgeAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
- If Tag.StartsWithF("/") Then Storage.CurseForgeTotal = 0
- '应用筛选参数
- Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={RESULT_PAGE_SIZE}"
- Select Case Type
- Case ResourceTypes.Mod
- Address += "&classId=6"
- Case ResourceTypes.ModPack
- Address += "&classId=4471"
- Case ResourceTypes.DataPack
- Address += "&classId=6945"
- Case ResourceTypes.Shader
- Address += "&classId=6552"
- Case ResourceTypes.ResourcePack
- Address += "&classId=12"
- End Select
- If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/")
- If ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then Address += "&modLoaderType=" & Resource.ToCurseForgeModLoaderType(ModLoaders.Flags.First)
- If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
- If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & EscapeUtils.UrlEscape(SearchText)
- If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
- Return Address
- End Function
- ''' <summary>
- ''' 获取对应的 Modrinth API 请求链接。
- ''' </summary>
- Public Function GetModrinthAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
- If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
- '应用筛选参数
- Dim Address As String = $"https://api.modrinth.com/v2/search?limit={RESULT_PAGE_SIZE}&index=relevance"
- If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & EscapeUtils.UrlEscape(SearchText)
- If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
- 'facets=[["categories:'game-mechanics'"],["categories:'forge',categories:'fabric'"],["versions:1.19.3"],["project_type:mod"]]
- Dim Facets As New List(Of String)
- Facets.Add($"[""project_type:{Type.ToString.Lower}""]")
- If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
- If ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then
- Facets.Add($"[""categories:'{ModLoaders.Flags.Select(Function(f) f.ToString.Lower).Join("',categories:'")}'""]")
- End If
- 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, SearchRequest)
- Return request IsNot Nothing AndAlso
- Type = request.Type AndAlso TargetResultCount = request.TargetResultCount AndAlso
- Tag = request.Tag AndAlso ModLoaders = request.ModLoaders AndAlso Sources = request.Sources AndAlso
- GameVersion = request.GameVersion AndAlso SearchText = request.SearchText
- End Function
- Public Shared Operator =(left As SearchRequest, right As SearchRequest) As Boolean
- Return EqualityComparer(Of SearchRequest).Default.Equals(left, right)
- End Operator
- Public Shared Operator <>(left As SearchRequest, right As SearchRequest) As Boolean
- Return Not left = right
- End Operator
- Public Overrides Function GetHashCode() As Integer
- Return (Type, Tag, ModLoaders, GameVersion, SearchText, Sources).GetHashCode()
- End Function
- End Class
- '输出
- Public Class SearchResult
- '加载位置记录
- Public CurseForgeOffset As Integer = 0
- Public CurseForgeTotal As Integer = -1
- Public ModrinthOffset As Integer = 0
- Public ModrinthTotal As Integer = -1
- '结果列表
- ''' <summary>
- ''' 可供展示的所有工程的列表。
- ''' </summary>
- Public Results As New List(Of ResourceProject)
- ''' <summary>
- ''' 当前的错误信息。如果没有则为 Nothing。
- ''' </summary>
- Public ErrorMessage As String = Nothing
- End Class
- ''' <summary>
- ''' 根据搜索请求获取一系列的工程列表。
- ''' </summary>
- Public Shared Function GetLoader(InputDelegate As Func(Of SearchRequest)) As LoaderTask(Of SearchRequest, Integer)
- Return New LoaderTask(Of SearchRequest, Integer)("社区资源获取", AddressOf Run, InputDelegate) With {.ReloadTimeout = 60 * 1000}
- End Function
- Private Shared Sub Run(Task As LoaderTask(Of SearchRequest, Integer))
- Dim Request As SearchRequest = Task.Input
- Dim Storage = Request.Storage '避免其他线程对 Request.Storage 重新进行了赋值
- #Region "前置检查"
- If Storage.Results.Count >= Request.TargetResultCount Then
- Logger.Info($"已有 {Storage.Results.Count} 个结果,多于所需的 {Request.TargetResultCount} 个结果,结束处理")
- Return
- ElseIf Not Request.CanContinue Then
- If Not Storage.Results.Any() Then
- Throw New Exception("没有符合条件的结果")
- Else
- Logger.Info($"已有 {Storage.Results.Count} 个结果,少于所需的 {Request.TargetResultCount} 个结果,但无法继续获取,结束处理")
- Return
- End If
- End If
- '拒绝 1.13- Quilt(这个版本根本没有 Quilt)
- If Request.ModLoaders = ModLoaders.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
- Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
- End If
- #End Region
- #Region "中文搜索"
- Dim RawSearchText As String = If(Request.SearchText, "").Trim
- RawSearchText = RawSearchText.Lower
- Logger.Info($"工程列表搜索原始文本:{RawSearchText}")
- Dim IsChineseSearch As Boolean =
- RawSearchText.RegexCheck("[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawSearchText) AndAlso
- (Request.Type = ResourceTypes.Mod OrElse Request.Type = ResourceTypes.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 WikiEntry), Source As ResourcePlatforms) As IEnumerable(Of String)
- '从各个可能的来源提取候选
- Dim Candidates As New List(Of String)
- If Result.Item.CurseForgeSlug IsNot Nothing AndAlso Source = ResourcePlatforms.CurseForge Then
- Candidates.Add(Result.Item.CurseForgeSlug.Replace("-", " ").Replace("/", " "))
- End If
- If Result.Item.ModrinthSlug IsNot Nothing AndAlso Source = ResourcePlatforms.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.Sources.HasFlag(ResourcePlatforms.CurseForge) Then
- '数据库搜索
- Static CurseForgeSearchEntries As List(Of SearchEntry(Of WikiEntry)) =
- WikiEntry.All.Where(Function(Entry) Entry.CurseForgeSlug IsNot Nothing).Select(
- Function(Entry) New SearchEntry(Of WikiEntry) With {
- .Item = Entry,
- .SearchSource = New List(Of SearchSource) From {
- New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split("/"c, True), 1), '部分 Mod 有别名
- New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.CurseForgeSlug, 0.5)}
- }).ToList
- 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, ResourcePlatforms.CurseForge).Join(" ")
- Logger.Warn($"中文搜索关键词(CurseForge):{CurseForgeAltSearchText}")
- End If
- End If
- 'Modrinth
- If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) Then
- '数据库搜索
- Static ModrinthSearchEntries As List(Of SearchEntry(Of WikiEntry)) =
- WikiEntry.All.Where(Function(Entry) Entry.ModrinthSlug IsNot Nothing).Select(
- Function(Entry) New SearchEntry(Of WikiEntry) With {
- .Item = Entry,
- .SearchSource = New List(Of SearchSource) From {
- New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split("/"c, True), 1), '部分 Mod 有别名
- New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.ModrinthSlug, 0.5)}
- }).ToList
- 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, ResourcePlatforms.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
- Logger.Warn($"中文搜索关键词(Modrinth):{ModrinthAltSearchText}")
- '直接请求工程
- 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_RESULT)
- End If
- End If
- Task.Progress = 0.05
- #End Region
- Dim RealResults As New List(Of ResourceProject)
- NextPage:
- Dim RawResults As New ConcurrentList(Of ResourceProject)
- #Region "从 CurseForge 和 Modrinth 获取结果列表,存储于 RawResults"
- Dim WorkThreads As New List(Of Thread)
- Dim Errors As New ConcurrentList(Of (Ex As Exception, Source As ResourcePlatforms))
- '在 1.14-,部分老 Mod 没有设置支持的加载器,因此添加 Forge 筛选就会出现遗漏
- '所以,在发起请求时不筛选加载器,然后在返回的结果中自行筛除不是 Forge 的 Mod
- Dim IgnoreModLoaderFilter = Request.ModLoaders = ModLoaders.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140
- Try
- 'CurseForge 搜索
- If Request.Sources.HasFlag(ResourcePlatforms.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
- '获取工程列表
- Dim CurseForgeUrl As String = Request.GetCurseForgeAddress(If(CurseForgeAltSearchText, RawSearchText), IgnoreModLoaderFilter)
- Logger.Info($"开始 CurseForge 搜索:{CurseForgeUrl}")
- Dim RequestResult As JObject = DlModRequest(CurseForgeUrl)
- Dim ProjectList As New List(Of ResourceProject)
- For Each JsonEntry As JObject In RequestResult("data")
- Dim Project As New ResourceProject(JsonEntry)
- If Request.Type = ResourceTypes.ResourcePack AndAlso Project.Tags.Contains("数据包") Then Continue For 'CurseForge 将一些数据包分类成了资源包
- If Request.Type <> ResourceTypes.Any AndAlso Not Project.Types.HasFlag(Request.Type) Then Continue For '过滤分区不匹配的搜索结果(#8265)
- ProjectList.Add(Project)
- Next
- '更新结果
- ProjectList.ForEach(Sub(p) RawResults.Add(p))
- Storage.CurseForgeOffset += RequestResult("data").Count
- Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
- Logger.Info($"从 CurseForge 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
- Catch ex As Exception
- Logger.Warn(ex, "CurseForge 搜索失败")
- Storage.CurseForgeTotal = -1
- Errors.Add((ex, ResourcePlatforms.CurseForge))
- End Try
- If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页,所以不能直接给够
- End Sub, "CurseForge Search"))
- End If
- 'Modrinth 搜索
- If Request.Sources.HasFlag(ResourcePlatforms.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
- Dim ModrinthUrl As String = Request.GetModrinthAddress(If(ModrinthAltSearchText, RawSearchText), IgnoreModLoaderFilter)
- Logger.Info($"开始 Modrinth 搜索:{ModrinthUrl}")
- Dim RequestResult As JObject = DlModRequest(ModrinthUrl)
- Dim ProjectList As New List(Of ResourceProject)
- For Each JsonEntry As JObject In RequestResult("hits")
- ProjectList.Add(New ResourceProject(JsonEntry))
- Next
- '更新结果
- ProjectList.ForEach(Sub(p) RawResults.Add(p))
- Storage.ModrinthOffset += RequestResult("hits").Count
- Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
- Logger.Info($"从 Modrinth 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
- Catch ex As Exception
- Logger.Warn(ex, "Modrinth 搜索失败")
- Storage.ModrinthTotal = -1
- Errors.Add((ex, ResourcePlatforms.Modrinth))
- End Try
- If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页,所以不能直接给够
- End Sub, "Modrinth Search"))
- End If
- 'Modrinth 直接获取工程
- If Request.Sources.HasFlag(ResourcePlatforms.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(""",""")}""]"
- Logger.Info($"开始 Modrinth 直接获取:{ModrinthUrl}")
- Dim ProjectList As New List(Of ResourceProject)
- For Each JsonEntry As JObject In DlModRequest(ModrinthUrl)
- Dim Project As New ResourceProject(JsonEntry)
- '应用筛选
- If Request.Type <> ResourceTypes.Any AndAlso Not Project.Types.HasFlag(Request.Type) Then Continue For
- If Not String.IsNullOrEmpty(Request.Tag) AndAlso
- Not JsonEntry("categories").Any(Function(c) c.ToString = Request.Tag.AfterLast("/")) Then Continue For 'Project.Tags 已经转换成中文了,只能从 json 判
- If Request.ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter AndAlso
- Not Project.ModLoaders.Flags.Intersect(Request.ModLoaders.Flags).Any() Then Continue For
- If Not String.IsNullOrEmpty(Request.GameVersion) AndAlso
- Not Project.UnsafeGameVersions.Any(Function(d) d = Request.GameVersion) Then Continue For
- ProjectList.Add(Project)
- Next
- '更新结果
- ProjectList.ForEach(Sub(p) RawResults.Add(p))
- Logger.Info($"从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
- ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
- Catch ex As Exception
- Logger.Warn(ex, "Modrinth 直接获取失败")
- Errors.Add((ex, ResourcePlatforms.Modrinth))
- End Try
- If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页,所以不能直接给够
- End Sub, "Modrinth Get"))
- End If
- '等待线程结束
- For Each Thread In WorkThreads
- Thread.Join()
- If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程
- Next
- '仅保留兼容 Forge 的 Mod,或老版本中没有标注任何 Mod Loader 的 Mod
- If IgnoreModLoaderFilter Then
- RawResults.KeepIf(Function(p) p.ModLoaders = ModLoaders.None OrElse p.ModLoaders.HasFlag(ModLoaders.Forge))
- End If
- '确保存在结果
- Storage.ErrorMessage = Nothing
- If Not RawResults.Any() Then
- If Errors.Any() Then
- Throw Errors.First.Ex
- Else
- If IsChineseSearch AndAlso Not (Request.Type = ResourceTypes.Mod OrElse Request.Type = ResourceTypes.DataPack) Then
- Throw New Exception(MSG_NO_CHINESE_RESULT)
- ElseIf Request.Sources = ResourcePlatforms.CurseForge AndAlso Request.Tag.StartsWithF("/") Then
- Throw New Exception("CurseForge 不兼容所选的类型")
- ElseIf Request.Sources = ResourcePlatforms.Modrinth AndAlso Request.Tag.EndsWithF("/") Then
- Throw New Exception("Modrinth 不兼容所选的类型")
- Else
- Throw New Exception("没有搜索结果")
- End If
- End If
- ElseIf Errors.Any() Then
- '有结果但是有错误
- If Errors.Any(Function(e) e.Source = ResourcePlatforms.CurseForge) Then
- Storage.ErrorMessage = $"无法连接到 CurseForge,所以目前仅显示了来自 Modrinth 的内容,搜索结果可能不全。{vbCrLf}请稍后再试,或使用 VPN 改善网络环境。"
- Else
- Storage.ErrorMessage = $"无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。{vbCrLf}请稍后再试,或使用 VPN 改善网络环境。"
- End If
- End If
- Finally
- For Each Thread In WorkThreads
- If Thread.IsAlive Then Thread.Interrupt()
- Next
- End Try
- #End Region
- #Region "提取非重复项,存储于 RealResults"
- '将 CurseForge 排在 Modrinth 的前面,避免加载结束顺序不同导致排名不同
- RawResults = RawResults.Where(Function(x) x.Platform = ResourcePlatforms.CurseForge).Concat(RawResults.Where(Function(x) x.Platform <> ResourcePlatforms.CurseForge)).ToList
- '去重
- RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b)).ToList
- '已有内容去重
- 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)
- Logger.Info($"去重、筛选后累计新增结果 {RealResults.Count} 个(目前已有结果 {Storage.Results.Count} 个)")
- #End Region
- #Region "检查结果数量,如果不足且可继续,会继续加载下一页"
- If RealResults.Count + Storage.Results.Count < Request.TargetResultCount Then
- Logger.Info($"总结果数需求最少 {Request.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
- If Request.CanContinue AndAlso Not Errors.Any Then '如果有某个源失败则不再重试,这时候重试可能导致无限循环
- Logger.Info("将继续尝试加载下一页")
- GoTo NextPage
- Else
- Logger.Info("无法继续加载,将强制结束")
- End If
- End If
- #End Region
- #Region "将结果排序并添加"
- Dim Scores As New Dictionary(Of ResourceProject, Double) '排序分
- Dim GetDownloadCountMult =
- Function(Project As ResourceProject) As Double
- Select Case Request.Type
- Case ResourceTypes.Mod, ResourceTypes.ModPack
- Return If(Project.Platform = ResourcePlatforms.CurseForge, 1, 5)
- Case ResourceTypes.DataPack
- Return If(Project.Platform = ResourcePlatforms.CurseForge, 10, 1)
- Case ResourceTypes.ResourcePack, ResourceTypes.Shader
- Return If(Project.Platform = ResourcePlatforms.CurseForge, 1, 4)
- Case Else
- Return 1
- End Select
- End Function
- If String.IsNullOrEmpty(RawSearchText) Then
- '如果没有搜索文本,按下载量将结果排序
- For Each Result As ResourceProject In RealResults
- Scores(Result) = Result.DownloadCount * GetDownloadCountMult(Result)
- Next
- Else
- '如果有搜索文本,按关联度将结果排序
- '排序分 = 搜索相对相似度 (1) + 下载量权重 (对数,10 亿时为 1) + 有中文名 (0.2)
- Dim SearchEntries As New List(Of SearchEntry(Of ResourceProject))
- For Each Result As ResourceProject In RealResults
- Scores(Result) = If(Result.WikiId > 0, 0.2, 0) +
- Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9
- SearchEntries.Add(New SearchEntry(Of ResourceProject) With {.Item = Result, .SearchSource = New List(Of SearchSource) From {
- New SearchSource(If(IsChineseSearch, Result.TranslatedName, Result.RawName).Split("/"c, True), 1),
- New SearchSource(Result.Description, 0.05)}})
- Next
- Dim SearchResult = Search(SearchEntries, RawSearchText, 10000, -1)
- For Each OneResult In SearchResult
- Scores(OneResult.Item) +=
- If(OneResult.AbsoluteRight, 10, OneResult.Similarity) /
- If(SearchResult.First.AbsoluteRight, 10, SearchResult.First.Similarity) '最高 1 分的相似度分
- Next
- End If
- '根据排序分得出结果并添加
- If Task.IsInterrupted Then Throw New ThreadInterruptedException '#8246
- Storage.Results.AddRange(
- Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
- #End Region
- End Sub
- End Class
|