1
0

ModComp.vb 66 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349
  1. Public Module ModComp
  2. Public Enum CompType
  3. ''' <summary>
  4. ''' Mod。
  5. ''' </summary>
  6. [Mod]
  7. ''' <summary>
  8. ''' 整合包。
  9. ''' </summary>
  10. ModPack
  11. ''' <summary>
  12. ''' 资源包。
  13. ''' </summary>
  14. ResourcePack
  15. End Enum
  16. Public Enum CompModLoaderType
  17. 'https://docs.curseforge.com/?http#tocS_ModLoaderType
  18. Any = 0
  19. Forge = 1
  20. Fabric = 4
  21. Quilt = 5
  22. End Enum
  23. <Flags> Public Enum CompSourceType
  24. CurseForge = 1
  25. Modrinth = 2
  26. Any = CurseForge Or Modrinth
  27. End Enum
  28. #Region "CompDatabase | Mod 数据库"
  29. Private _CompDatabase As List(Of CompDatabaseEntry) = Nothing
  30. Private ReadOnly Property CompDatabase As List(Of CompDatabaseEntry)
  31. Get
  32. If _CompDatabase IsNot Nothing Then Return _CompDatabase
  33. '初始化数据库
  34. _CompDatabase = New List(Of CompDatabaseEntry)
  35. Dim i As Integer = 0
  36. For Each Line In DecodeBytes(GetResources("ModData")).Replace(vbCrLf, vbLf).Replace(vbCr, "").Split(vbLf)
  37. i += 1
  38. If Line = "" Then Continue For
  39. For Each EntryData As String In Line.Split("¨")
  40. Dim Entry = New CompDatabaseEntry
  41. Dim SplitedLine = EntryData.Split("|")
  42. If SplitedLine(0).StartsWith("@") Then
  43. Entry.CurseForgeSlug = Nothing
  44. Entry.ModrinthSlug = SplitedLine(0).Replace("@", "")
  45. ElseIf SplitedLine(0).EndsWith("@") Then
  46. Entry.CurseForgeSlug = SplitedLine(0).TrimEnd("@")
  47. Entry.ModrinthSlug = Entry.CurseForgeSlug
  48. ElseIf SplitedLine(0).Contains("@") Then
  49. Entry.CurseForgeSlug = SplitedLine(0).Split("@")(0)
  50. Entry.ModrinthSlug = SplitedLine(0).Split("@")(1)
  51. Else
  52. Entry.CurseForgeSlug = SplitedLine(0)
  53. Entry.ModrinthSlug = Nothing
  54. End If
  55. Entry.WikiId = i
  56. If SplitedLine.Count >= 2 Then
  57. Entry.ChineseName = SplitedLine(1)
  58. Entry.MCBBS = If(SplitedLine.Count >= 3, SplitedLine(2), Nothing)
  59. If Entry.ChineseName.Contains("*") Then '处理 *
  60. Entry.ChineseName = Entry.ChineseName.Replace("*", " (" &
  61. String.Join(" ", If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Split("-").Select(Function(w) w.Substring(0, 1).ToUpper & w.Substring(1, w.Length - 1))) & ")")
  62. End If
  63. End If
  64. _CompDatabase.Add(Entry)
  65. Next
  66. Next
  67. Return _CompDatabase
  68. End Get
  69. End Property
  70. Private Class CompDatabaseEntry
  71. ''' <summary>
  72. ''' McMod 的对应 ID。
  73. ''' </summary>
  74. Public WikiId As Integer
  75. ''' <summary>
  76. ''' 中文译名。空字符串代表没有翻译。
  77. ''' </summary>
  78. Public ChineseName As String = ""
  79. ''' <summary>
  80. ''' MCBBS 发布帖编号(例如 195107)。若为 Nothing 则没有发布帖。
  81. ''' </summary>
  82. Public MCBBS As Integer?
  83. ''' <summary>
  84. ''' CurseForge Slug(例如 advanced-solar-panels)。
  85. ''' </summary>
  86. Public CurseForgeSlug As String = Nothing
  87. ''' <summary>
  88. ''' Modrinth Slug(例如 advanced-solar-panels)。
  89. ''' </summary>
  90. Public ModrinthSlug As String = Nothing
  91. Public Overrides Function ToString() As String
  92. Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & WikiId & "|" & ChineseName & If(MCBBS Is Nothing, "", "|" & MCBBS)
  93. End Function
  94. End Class
  95. #End Region
  96. #Region "CompProject | 工程信息"
  97. '类定义
  98. Public Class CompProject
  99. '源信息
  100. ''' <summary>
  101. ''' 该工程信息来自 CurseForge 还是 Modrinth。
  102. ''' </summary>
  103. Public ReadOnly FromCurseForge As Boolean
  104. ''' <summary>
  105. ''' 工程的种类。
  106. ''' </summary>
  107. Public ReadOnly Type As CompType
  108. ''' <summary>
  109. ''' 工程的短名。例如 technical-enchant。
  110. ''' </summary>
  111. Public ReadOnly Slug As String
  112. ''' <summary>
  113. ''' CurseForge 工程的数字 ID。Modrinth 工程的乱码 ID。
  114. ''' </summary>
  115. Public ReadOnly Id As String
  116. ''' <summary>
  117. ''' CurseForge 文件列表的数字 ID。Modrinth 工程的此项无效。
  118. ''' </summary>
  119. Public ReadOnly CurseForgeFileIds As List(Of Integer)
  120. '描述性信息
  121. ''' <summary>
  122. ''' 原始的英文名称。
  123. ''' </summary>
  124. Public ReadOnly RawName As String
  125. ''' <summary>
  126. ''' 英文描述。
  127. ''' </summary>
  128. Public ReadOnly Description As String
  129. ''' <summary>
  130. ''' 来源网站的工程页面网址。确保格式一定标准。
  131. ''' CurseForge:https://www.curseforge.com/minecraft/mc-mods/jei
  132. ''' Modrinth:https://modrinth.com/mod/technical-enchant
  133. ''' </summary>
  134. Public ReadOnly Website As String
  135. ''' <summary>
  136. ''' 最后一次更新的时间。可能为 Nothing。
  137. ''' </summary>
  138. Public ReadOnly LastUpdate As Date? = Nothing
  139. ''' <summary>
  140. ''' 下载量计数。注意,该计数仅为一个来源,无法反应两边加起来的下载量!
  141. ''' </summary>
  142. Public ReadOnly DownloadCount As Integer
  143. ''' <summary>
  144. ''' 支持的 Mod 加载器列表。可能为空。
  145. ''' </summary>
  146. Public ReadOnly ModLoaders As List(Of CompModLoaderType)
  147. ''' <summary>
  148. ''' 描述性标签的内容。已转换为中文。
  149. ''' </summary>
  150. Public ReadOnly Tags As List(Of String)
  151. ''' <summary>
  152. ''' Logo 图片的下载地址。若为 Nothing 则没有。
  153. ''' </summary>
  154. Public ReadOnly LogoUrl As String = Nothing
  155. ''' <summary>
  156. ''' 游戏大版本列表。例如:18, 16, 15……
  157. ''' </summary>
  158. Public ReadOnly GameVersions As List(Of Integer)
  159. '数据库信息
  160. Private LoadedDatabase As Boolean = False
  161. Private _DatabaseEntry As CompDatabaseEntry = Nothing
  162. ''' <summary>
  163. ''' 关联的数据库条目。若为 Nothing 则没有。
  164. ''' </summary>
  165. Private Property DatabaseEntry As CompDatabaseEntry
  166. Get
  167. If Not LoadedDatabase Then
  168. LoadedDatabase = True
  169. If Type = CompType.Mod Then _DatabaseEntry = CompDatabase.FirstOrDefault(Function(c) If(FromCurseForge, c.CurseForgeSlug, c.ModrinthSlug) = Slug)
  170. End If
  171. Return _DatabaseEntry
  172. End Get
  173. Set(value As CompDatabaseEntry)
  174. LoadedDatabase = True
  175. _DatabaseEntry = value
  176. End Set
  177. End Property
  178. ''' <summary>
  179. ''' MC 百科的页面 ID。若为 0 则没有。
  180. ''' </summary>
  181. Public ReadOnly Property WikiId As Integer
  182. Get
  183. Return If(DatabaseEntry Is Nothing, 0, DatabaseEntry.WikiId)
  184. End Get
  185. End Property
  186. ''' <summary>
  187. ''' MCBBS 的帖子 ID。若为 0 则没有。
  188. ''' </summary>
  189. Public ReadOnly Property MCBBS As Integer
  190. Get
  191. Return If(DatabaseEntry Is Nothing, 0, If(DatabaseEntry.MCBBS, 0))
  192. End Get
  193. End Property
  194. ''' <summary>
  195. ''' 翻译后的中文名。若数据库没有则等同于 RawName。
  196. ''' </summary>
  197. Public ReadOnly Property TranslatedName As String
  198. Get
  199. Return If(DatabaseEntry Is Nothing OrElse DatabaseEntry.ChineseName = "", RawName, DatabaseEntry.ChineseName)
  200. End Get
  201. End Property
  202. '实例化
  203. ''' <summary>
  204. ''' 从工程 Json 中初始化实例。若出错会抛出异常。
  205. ''' </summary>
  206. Public Sub New(Data As JObject)
  207. FromCurseForge = Data.ContainsKey("gameId")
  208. If FromCurseForge Then
  209. #Region "CurseForge"
  210. '简单信息
  211. Id = Data("id")
  212. Slug = Data("slug")
  213. RawName = Data("name")
  214. Description = Data("summary")
  215. Website = Data("links")("websiteUrl").ToString.TrimEnd("/")
  216. LastUpdate = Data("dateReleased") '#1194
  217. DownloadCount = Data("downloadCount")
  218. 'Logo
  219. If Data("logo").Count > 0 Then
  220. If GetPixelSize(1) > 1.25 Then
  221. LogoUrl = Data("logo")("thumbnailUrl").ToString '使用 256x256 图标
  222. Else
  223. LogoUrl = Data("logo")("thumbnailUrl").ToString.Replace("/256/256/", "/64/64/") '使用 64x64 图标
  224. End If
  225. End If
  226. 'FileIndexes / GameVersions
  227. Dim Files = If(CType(Data("latestFilesIndexes"), JArray), New JArray).
  228. Where(Function(i) i("gameVersion").ToString.Contains("1."))
  229. CurseForgeFileIds = Files.Select(Of Integer)(Function(v) v("fileId")).ToList
  230. GameVersions = Files.Select(Of Integer)(Function(v) Val(v("gameVersion").ToString.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
  231. Distinct.OrderByDescending(Function(v) v).ToList
  232. 'Type
  233. If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
  234. Type = CompType.Mod
  235. ElseIf Website.Contains("/modpacks/") Then
  236. Type = CompType.ModPack
  237. Else
  238. Type = CompType.ResourcePack
  239. End If
  240. 'Tags
  241. Tags = New List(Of String)
  242. For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
  243. Select Case Category
  244. 'Mod
  245. Case 406 : Tags.Add("世界元素")
  246. Case 407 : Tags.Add("生物群系")
  247. Case 410 : Tags.Add("维度")
  248. Case 408 : Tags.Add("矿物/资源")
  249. Case 409 : Tags.Add("天然结构")
  250. Case 412 : Tags.Add("科技")
  251. Case 415 : Tags.Add("管道/物流")
  252. Case 4843 : Tags.Add("自动化")
  253. Case 417 : Tags.Add("能源")
  254. Case 4558 : Tags.Add("红石")
  255. Case 436 : Tags.Add("食物/烹饪")
  256. Case 416 : Tags.Add("农业")
  257. Case 414 : Tags.Add("运输")
  258. Case 420 : Tags.Add("仓储")
  259. Case 419 : Tags.Add("魔法")
  260. Case 422 : Tags.Add("冒险")
  261. Case 424 : Tags.Add("装饰")
  262. Case 411 : Tags.Add("生物")
  263. Case 434 : Tags.Add("装备")
  264. Case 423 : Tags.Add("信息显示")
  265. Case 435 : Tags.Add("服务器")
  266. Case 5191 : Tags.Add("改良")
  267. Case 421 : Tags.Add("支持库")
  268. '整合包
  269. Case 4484 : Tags.Add("多人")
  270. Case 4479 : Tags.Add("硬核")
  271. Case 4483 : Tags.Add("战斗")
  272. Case 4478 : Tags.Add("任务")
  273. Case 4472 : Tags.Add("科技")
  274. Case 4473 : Tags.Add("魔法")
  275. Case 4475 : Tags.Add("冒险")
  276. Case 4476 : Tags.Add("探索")
  277. Case 4477 : Tags.Add("小游戏")
  278. Case 4471 : Tags.Add("科幻")
  279. Case 4736 : Tags.Add("空岛")
  280. Case 5128 : Tags.Add("原版改良")
  281. Case 4487 : Tags.Add("FTB")
  282. Case 4480 : Tags.Add("基于地图")
  283. Case 4481 : Tags.Add("轻量")
  284. Case 4482 : Tags.Add("大型")
  285. 'FUTURE: Res
  286. End Select
  287. Next
  288. If Tags.Count = 0 Then Tags.Add("杂项")
  289. 'ModLoaders
  290. ModLoaders = New List(Of CompModLoaderType)
  291. For Each File In If(Data("latestFiles"), {})
  292. Dim NewFile As New CompFile(File, Type)
  293. If Not NewFile.Available Then Continue For
  294. ModLoaders.AddRange(NewFile.ModLoaders)
  295. Next
  296. ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
  297. #End Region
  298. Else
  299. #Region "Modrinth"
  300. '简单信息
  301. Id = If(Data("project_id"), Data("id")) '两个 API 会返回的 key 不一样
  302. Slug = Data("slug")
  303. RawName = Data("title")
  304. Description = Data("description")
  305. LastUpdate = Data("date_modified")
  306. DownloadCount = Data("downloads")
  307. LogoUrl = Data("icon_url")
  308. If LogoUrl = "" Then LogoUrl = Nothing
  309. Website = $"https://modrinth.com/{Data("project_type")}/{Slug}"
  310. 'GameVersions
  311. GameVersions = If(CType(Data("versions"), JArray), New JArray).
  312. Select(Function(v) v.ToString).Where(Function(v) v.StartsWith("1.")).
  313. Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
  314. Distinct.OrderByDescending(Function(v) v).ToList
  315. 'Type
  316. Select Case Data("project_type").ToString
  317. Case "mod" : Type = CompType.Mod
  318. Case "modpack" : Type = CompType.ModPack
  319. Case "resourcepack" : Type = CompType.ResourcePack
  320. End Select
  321. 'Tags & ModLoaders
  322. Tags = New List(Of String)
  323. ModLoaders = New List(Of CompModLoaderType)
  324. For Each Category In Data("categories").Select(Function(t) t.ToString)
  325. Select Case Category
  326. '加载器
  327. Case "forge" : ModLoaders.Add(CompModLoaderType.Forge)
  328. Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric)
  329. Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt)
  330. 'Mod
  331. Case "worldgen" : Tags.Add("世界元素")
  332. Case "technology" : Tags.Add("科技")
  333. Case "food" : Tags.Add("食物/烹饪")
  334. Case "game-mechanics" : Tags.Add("游戏机制")
  335. Case "transportation" : Tags.Add("运输")
  336. Case "storage" : Tags.Add("仓储")
  337. Case "magic" : Tags.Add("魔法")
  338. Case "adventure" : Tags.Add("冒险")
  339. Case "decoration" : Tags.Add("装饰")
  340. Case "mobs" : Tags.Add("生物")
  341. Case "equipment" : Tags.Add("装备")
  342. Case "optimization" : Tags.Add("性能优化")
  343. Case "social" : Tags.Add("服务器")
  344. Case "utility" : Tags.Add("改良")
  345. Case "library" : Tags.Add("支持库")
  346. '整合包
  347. Case "multiplayer" : Tags.Add("多人")
  348. Case "optimization" : Tags.Add("性能优化")
  349. Case "challenging" : Tags.Add("硬核")
  350. Case "combat" : Tags.Add("战斗")
  351. Case "quests" : Tags.Add("任务")
  352. Case "technology" : Tags.Add("科技")
  353. Case "magic" : Tags.Add("魔法")
  354. Case "adventure" : Tags.Add("冒险")
  355. Case "kitchen-sink" : Tags.Add("烹饪")
  356. Case "lightweight" : Tags.Add("轻量")
  357. 'FUTURE: Res
  358. End Select
  359. Next
  360. If Tags.Count = 0 Then Tags.Add("杂项")
  361. ModLoaders.Sort()
  362. #End Region
  363. End If
  364. '保存缓存
  365. CompProjectCache(Id) = Me
  366. End Sub
  367. ''' <summary>
  368. ''' 将当前工程信息实例化为控件。
  369. ''' </summary>
  370. Public Function ToCompItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean, Optional OnClick As MyCompItem.ClickEventHandler = Nothing) As MyCompItem
  371. '获取版本描述
  372. Dim GameVersionDescription As String
  373. If GameVersions Is Nothing OrElse GameVersions.Count = 0 Then
  374. GameVersionDescription = "未知"
  375. Else
  376. Dim SpaVersions As New List(Of String)
  377. For i = 0 To GameVersions.Count - 1
  378. Dim StartVersion As Integer = GameVersions(i), EndVersion As Integer = GameVersions(i)
  379. For ii = i + 1 To GameVersions.Count - 1
  380. If GameVersions(ii) = EndVersion - 1 Then
  381. EndVersion = GameVersions(ii)
  382. i = ii
  383. Else
  384. Exit For
  385. End If
  386. Next
  387. If StartVersion = EndVersion Then
  388. SpaVersions.Add("1." & StartVersion)
  389. ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then
  390. SpaVersions.Add("1." & EndVersion & "+")
  391. ElseIf EndVersion <= 7 Then
  392. SpaVersions.Add("1." & StartVersion & "-")
  393. Exit For
  394. ElseIf StartVersion - EndVersion = 1 Then
  395. SpaVersions.Add("1." & StartVersion & ", 1." & EndVersion)
  396. Else
  397. SpaVersions.Add("1." & StartVersion & "~1." & EndVersion)
  398. End If
  399. Next
  400. GameVersionDescription = SpaVersions.Join(", ")
  401. End If
  402. '实例化 UI
  403. Dim NewItem As New MyCompItem With {.Tag = Me}
  404. '标题
  405. Dim FinalName As String = TranslatedName.Split(" | ").First.Split(" - ").First.Split("(").First.Split("[").First
  406. Dim ExNameList As List(Of String) = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
  407. Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList
  408. ExNameList.RemoveAt(0)
  409. If TranslatedName = RawName AndAlso '没有中文翻译
  410. Not ExNameList.Any(Function(s) s.Contains("orge") OrElse s.Contains("abric") OrElse s.Contains("uilt")) AndAlso '不是标注 XX 版
  411. Not (ExNameList.Count = 1 AndAlso ExNameList.First.ToUpper <> ExNameList.First) Then '不是缩写
  412. FinalName = RawName '使用原名
  413. ExNameList.Clear()
  414. End If
  415. NewItem.LabTitle.Text = FinalName
  416. If ExNameList.Count = 0 Then
  417. NoExName:
  418. CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
  419. Else
  420. Dim ExName As String = ""
  421. For Each Ex In ExNameList
  422. '去除 “Forge/Fabric” 这一无意义提示
  423. If Ex.Length < 19 AndAlso Ex.ToLower.Contains("fabric") AndAlso Ex.ToLower.Contains("forge") Then Continue For
  424. '将 “Forge” 等提示改为 “Forge 版”
  425. If (Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt")) AndAlso
  426. Not Ex.Contains("版") AndAlso Ex.Length < 19 Then Ex = Ex.Replace("Edition", "").Trim & " 版"
  427. ExName &= " | " & Ex.Trim
  428. Next
  429. If ExName = "" Then GoTo NoExName
  430. NewItem.LabTitleRaw.Text = ExName
  431. End If
  432. 'Tag
  433. For Each TagText In Tags
  434. Dim NewTag = GetObjectFromXML(
  435. "<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
  436. Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
  437. SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
  438. <TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
  439. </Border>")
  440. NewItem.PanTags.Children.Add(NewTag)
  441. Next
  442. '下边栏
  443. If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then
  444. '全部隐藏
  445. CType(NewItem.PathVersion.Parent, Grid).Children.Remove(NewItem.PathVersion)
  446. CType(NewItem.LabVersion.Parent, Grid).Children.Remove(NewItem.LabVersion)
  447. NewItem.ColumnVersion1.Width = New GridLength(0)
  448. NewItem.ColumnVersion2.MaxWidth = 0
  449. NewItem.ColumnVersion3.Width = New GridLength(0)
  450. ElseIf ShowMcVersionDesc AndAlso ShowMcVersionDesc Then
  451. '全部显示
  452. Dim ModLoaderDesc As String = If(ModLoaders.Count > 0 AndAlso ModLoaders.Count < 3 AndAlso
  453. Not (Type = CompType.Mod AndAlso Setup.Get("ToolDownloadIgnoreQuilt") AndAlso ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric)),
  454. ModLoaders.Join(" / ") & " ", "")
  455. Dim VersionDesc As String = If(GameVersionDescription = "1.7+", "全版本", GameVersionDescription)
  456. NewItem.LabVersion.Text = ModLoaderDesc & VersionDesc
  457. ElseIf ShowMcVersionDesc Then
  458. '仅显示版本
  459. NewItem.LabVersion.Text = If(GameVersionDescription = "1.7+", "全版本", GameVersionDescription)
  460. Else
  461. '仅显示 Mod 加载器
  462. Select Case ModLoaders.Count
  463. Case 0
  464. NewItem.LabVersion.Text = "未知"
  465. Case 1
  466. NewItem.LabVersion.Text = If(Type = CompType.Mod, "仅 ", "") & ModLoaders(0).ToString
  467. Case 2
  468. If Type = CompType.Mod Then
  469. NewItem.LabVersion.Text =
  470. If(Not (Setup.Get("ToolDownloadIgnoreQuilt") AndAlso
  471. ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric)),
  472. ModLoaders.Join(" / "), "任意")
  473. Else
  474. NewItem.LabVersion.Text = ModLoaders.Join(" / ")
  475. End If
  476. Case 3
  477. If Type = CompType.Mod Then
  478. NewItem.LabVersion.Text = "任意"
  479. Else
  480. NewItem.LabVersion.Text = ModLoaders.Join(" / ")
  481. End If
  482. End Select
  483. End If
  484. NewItem.LabInfo.Text = Description.Replace(vbCr, "").Replace(vbLf, "")
  485. NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth")
  486. If LastUpdate IsNot Nothing Then
  487. NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
  488. Else
  489. NewItem.LabTime.Visibility = Visibility.Collapsed
  490. NewItem.ColumnTime1.Width = New GridLength(0)
  491. NewItem.ColumnTime2.Width = New GridLength(0)
  492. NewItem.ColumnTime3.Width = New GridLength(0)
  493. End If
  494. NewItem.LabDownload.Text =
  495. If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
  496. If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
  497. '其他
  498. If LogoUrl Is Nothing Then
  499. NewItem.Logo = "pack://application:,,,/images/Icons/NoIcon.png"
  500. Else
  501. NewItem.Logo = LogoUrl
  502. End If
  503. If OnClick IsNot Nothing Then
  504. AddHandler NewItem.Click, OnClick
  505. NewItem.HasAnimation = True
  506. Else
  507. NewItem.HasAnimation = False
  508. End If
  509. Return NewItem
  510. End Function
  511. '辅助函数
  512. ''' <summary>
  513. ''' 检查是否与某个 Project 是相同的工程,只是在不同的网站。
  514. ''' </summary>
  515. Public Function IsLike(Project As CompProject) As Boolean
  516. If Id = Project.Id Then Return True '相同实例
  517. '提取字符串中的字母和数字
  518. Dim GetRaw =
  519. Function(Data As String) As String
  520. Dim Result As New StringBuilder()
  521. For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
  522. Result.Append(r)
  523. Next
  524. Return Result.ToString.ToLower
  525. End Function
  526. '来自不同的网站
  527. If FromCurseForge = Project.FromCurseForge Then Return False
  528. 'Mod 加载器一致
  529. If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False
  530. 'MC 版本一致
  531. If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False
  532. 'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
  533. If TranslatedName = Project.TranslatedName OrElse
  534. RawName = Project.RawName OrElse Description = Project.Description OrElse
  535. GetRaw(Slug) = GetRaw(Project.Slug) Then
  536. Log($"[Comp] 将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程")
  537. '如果只有一个有 DatabaseEntry,设置给另外一个
  538. If DatabaseEntry Is Nothing AndAlso Project.DatabaseEntry IsNot Nothing Then DatabaseEntry = Project.DatabaseEntry
  539. If DatabaseEntry IsNot Nothing AndAlso Project.DatabaseEntry Is Nothing Then Project.DatabaseEntry = DatabaseEntry
  540. Return True
  541. End If
  542. Return False
  543. End Function
  544. Public Overrides Function ToString() As String
  545. Return $"{Id} ({Slug}): {RawName}"
  546. End Function
  547. Public Overrides Function Equals(obj As Object) As Boolean
  548. Dim project = TryCast(obj, CompProject)
  549. Return project IsNot Nothing AndAlso Id = project.Id
  550. End Function
  551. Public Shared Operator =(left As CompProject, right As CompProject) As Boolean
  552. Return EqualityComparer(Of CompProject).Default.Equals(left, right)
  553. End Operator
  554. Public Shared Operator <>(left As CompProject, right As CompProject) As Boolean
  555. Return Not left = right
  556. End Operator
  557. End Class
  558. '输入与输出
  559. Public Class CompProjectRequest
  560. '结果要求
  561. ''' <summary>
  562. ''' 加载后应输出到的结果存储器。
  563. ''' </summary>
  564. Public Storage As CompProjectStorage
  565. ''' <summary>
  566. ''' 应当尽量达成的结果数量。
  567. ''' </summary>
  568. Public TargetResultCount As Integer
  569. ''' <summary>
  570. ''' 根据加载位置记录,是否还可以继续获取内容。
  571. ''' </summary>
  572. Public ReadOnly Property CanContinue As Boolean
  573. Get
  574. If Tag.StartsWith("/") OrElse Not Source.HasFlag(CompSourceType.CurseForge) Then Storage.CurseForgeTotal = 0
  575. If Tag.EndsWith("/") OrElse Not Source.HasFlag(CompSourceType.Modrinth) Then Storage.ModrinthTotal = 0
  576. If Storage.CurseForgeTotal = -1 OrElse Storage.ModrinthTotal = -1 Then Return True
  577. Return Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
  578. End Get
  579. End Property
  580. '输入内容
  581. ''' <summary>
  582. ''' 筛选资源种类。
  583. ''' </summary>
  584. Public Type As CompType
  585. ''' <summary>
  586. ''' 筛选资源标签。空字符串代表不限制。格式例如 "406/worldgen",分别是 CurseForge 和 Modrinth 的 ID。
  587. ''' </summary>
  588. Public Tag As String = ""
  589. ''' <summary>
  590. ''' 筛选 Mod 加载器类别。
  591. ''' </summary>
  592. Public ModLoader As CompModLoaderType = CompModLoaderType.Any
  593. ''' <summary>
  594. ''' 筛选 MC 版本。
  595. ''' </summary>
  596. Public GameVersion As String = Nothing
  597. ''' <summary>
  598. ''' 搜索的文本内容。
  599. ''' </summary>
  600. Public SearchText As String = Nothing
  601. ''' <summary>
  602. ''' 允许的来源。
  603. ''' </summary>
  604. Public Source As CompSourceType = CompSourceType.Any
  605. ''' <summary>
  606. ''' 构造函数。
  607. ''' </summary>
  608. Public Sub New(Type As CompType, Storage As CompProjectStorage, TargetResultCount As Integer)
  609. Me.Type = Type
  610. Me.Storage = Storage
  611. Me.TargetResultCount = TargetResultCount
  612. End Sub
  613. '构造请求
  614. ''' <summary>
  615. ''' 获取对应的 CurseForge API 请求链接。若返回 Nothing 则为不进行 CurseForge 请求。
  616. ''' </summary>
  617. Public Function GetCurseForgeAddress() As String
  618. If Not Source.HasFlag(CompSourceType.CurseForge) Then Return Nothing
  619. If Tag.StartsWith("/") Then Storage.CurseForgeTotal = 0
  620. If Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset Then Return Nothing
  621. '应用筛选参数
  622. Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={CompPageSize}"
  623. Select Case Type
  624. Case CompType.Mod
  625. Address += "&classId=6"
  626. Case CompType.ModPack
  627. Address += "&classId=4471"
  628. Case CompType.ResourcePack
  629. 'FUTURE: Res
  630. End Select
  631. Address += "&categoryId=" & If(Tag = "", "0", Tag.Split("/").First)
  632. If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
  633. If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
  634. If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
  635. If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
  636. Return Address
  637. End Function
  638. ''' <summary>
  639. ''' 获取对应的 Modrinth API 请求链接。若返回 Nothing 则为不进行 Modrinth 请求。
  640. ''' </summary>
  641. Public Function GetModrinthAddress() As String
  642. If Not Source.HasFlag(CompSourceType.Modrinth) Then Return Nothing
  643. If Tag.EndsWith("/") Then Storage.ModrinthTotal = 0
  644. If Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset Then Return Nothing
  645. '应用筛选参数
  646. Dim Address As String = $"https://api.modrinth.com/v2/search?limit={CompPageSize}&index=relevance"
  647. If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & Net.WebUtility.UrlEncode(SearchText)
  648. If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
  649. 'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
  650. Dim Facets As New List(Of String)
  651. Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]")
  652. If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.Split("/").Last}'""]")
  653. If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]")
  654. If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
  655. Address += "&facets=[" & String.Join(",", Facets) & "]"
  656. Return Address
  657. End Function
  658. '相同判断
  659. Public Overrides Function Equals(obj As Object) As Boolean
  660. Dim request = TryCast(obj, CompProjectRequest)
  661. Return request IsNot Nothing AndAlso
  662. Type = request.Type AndAlso TargetResultCount = request.TargetResultCount AndAlso
  663. Tag = request.Tag AndAlso ModLoader = request.ModLoader AndAlso Source = request.Source AndAlso
  664. GameVersion = request.GameVersion AndAlso SearchText = request.SearchText
  665. End Function
  666. Public Shared Operator =(left As CompProjectRequest, right As CompProjectRequest) As Boolean
  667. Return EqualityComparer(Of CompProjectRequest).Default.Equals(left, right)
  668. End Operator
  669. Public Shared Operator <>(left As CompProjectRequest, right As CompProjectRequest) As Boolean
  670. Return Not left = right
  671. End Operator
  672. End Class
  673. Public Class CompProjectStorage
  674. '加载位置记录
  675. Public CurseForgeOffset As Integer = 0
  676. Public CurseForgeTotal As Integer = -1
  677. Public ModrinthOffset As Integer = 0
  678. Public ModrinthTotal As Integer = -1
  679. '结果列表
  680. ''' <summary>
  681. ''' 可供展示的所有工程的列表。
  682. ''' </summary>
  683. Public Results As New List(Of CompProject)
  684. End Class
  685. '实际的获取
  686. Private Const CompPageSize = 40
  687. ''' <summary>
  688. ''' 已知工程信息的缓存。
  689. ''' </summary>
  690. Private CompProjectCache As New Dictionary(Of String, CompProject)
  691. ''' <summary>
  692. ''' 根据搜索请求获取一系列的工程列表。需要基于加载器运行。
  693. ''' </summary>
  694. Public Sub CompProjectsGet(Task As LoaderTask(Of CompProjectRequest, Integer))
  695. Dim Storage = Task.Input.Storage '避免多线程问题
  696. If Task.Input.Storage.Results.Count >= Task.Input.TargetResultCount Then
  697. Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,多于所需的 {Task.Input.TargetResultCount} 个结果,结束处理")
  698. Exit Sub
  699. ElseIf Not Task.Input.CanContinue Then
  700. If Task.Input.Storage.Results.Count = 0 Then
  701. Throw New Exception("没有符合条件的结果")
  702. Else
  703. Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,少于所需的 {Task.Input.TargetResultCount} 个结果,但无法继续获取,结束处理")
  704. Exit Sub
  705. End If
  706. End If
  707. #Region "拒绝 1.13- Quilt(这个版本根本没有 Quilt)"
  708. If Task.Input.ModLoader = CompModLoaderType.Quilt AndAlso VersionSortInteger(If(Task.Input.GameVersion, "1.15"), "1.14") = -1 Then
  709. Throw New Exception("Quilt 不支持 Minecraft " & Task.Input.GameVersion)
  710. End If
  711. #End Region
  712. #Region "处理搜索文本,赋值回 Task.Input.SearchText"
  713. Dim RawFilter As String = If(Task.Input.SearchText, "").Trim
  714. Task.Input.SearchText = RawFilter
  715. RawFilter = RawFilter.ToLower
  716. Log("[Comp] 工程列表搜索原始文本:" & RawFilter)
  717. '中文请求关键字处理
  718. Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawFilter)
  719. If IsChineseSearch AndAlso Task.Input.Type = CompType.Mod Then
  720. '构造搜索请求
  721. Dim SearchEntries As New List(Of SearchEntry(Of CompDatabaseEntry))
  722. For Each Entry In CompDatabase
  723. If Entry.ChineseName.Contains("动态的树") Then Continue For '这玩意儿附属太多了
  724. SearchEntries.Add(New SearchEntry(Of CompDatabaseEntry) With {
  725. .Item = Entry,
  726. .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
  727. New KeyValuePair(Of String, Double)(Entry.ChineseName & If(Entry.CurseForgeSlug, "") & If(Entry.ModrinthSlug, ""), 1)
  728. }
  729. })
  730. Next
  731. '获取搜索结果
  732. Dim SearchResults = Search(SearchEntries, Task.Input.SearchText, 3)
  733. If SearchResults.Count = 0 Then Throw New Exception("无搜索结果,请尝试搜索英文名称")
  734. Dim SearchResult As String = ""
  735. For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的,也最多只要 5 个
  736. If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
  737. If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ") & " "
  738. If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ") & " "
  739. SearchResult += SearchResults(i).Item.ChineseName.Split(" (").Last.TrimEnd(") ").Split(" - ").First.
  740. Replace(":", "").Replace("(", "").Replace(")", "").ToLower & " "
  741. Next
  742. Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer)
  743. '去除常见连接词
  744. Dim RealFilter As String = ""
  745. For Each Word In SearchResult.Split(" ")
  746. If {"the", "of", "a", "mod"}.Contains(Word.ToLower) OrElse Val(Word) > 0 Then Continue For
  747. If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For
  748. RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " "
  749. Next
  750. Task.Input.SearchText = RealFilter
  751. Log("[Comp] 中文搜索最终关键词:" & RealFilter, LogLevel.Developer)
  752. End If
  753. '驼峰英文请求关键字处理
  754. Dim SpacedKeywords = RegexReplace(Task.Input.SearchText, "$& ", "([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)")
  755. Dim ConnectedKeywords = Task.Input.SearchText.Replace(" ", "")
  756. Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchText, ConnectedKeywords & " " & RawFilter)).ToLower
  757. '最终处理关键字:分割、去重
  758. Dim RightKeywords As New List(Of String)
  759. For Each Keyword In AllPossibleKeywords.Split(" ")
  760. If Keyword.Trim = "" Then Continue For
  761. If {"forge", "fabric", "for", "mod",
  762. "forge/fabric", "fabric/forge", "fabric/quilt", "quilt/fabric"}.Contains(Keyword) Then '#208
  763. Log("[Comp] 已跳过搜索关键词:" & Keyword)
  764. Continue For
  765. End If
  766. RightKeywords.Add(Keyword)
  767. Next
  768. If RawFilter.Length > 0 AndAlso RightKeywords.Count = 0 Then
  769. Task.Input.SearchText = RawFilter '全都被过滤掉了
  770. Else
  771. Task.Input.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower
  772. End If
  773. '例外项:OptiForge、OptiFabric(拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod)
  774. If RawFilter.Replace(" ", "").ToLower.Contains("optiforge") Then Task.Input.SearchText = "optiforge"
  775. If RawFilter.Replace(" ", "").ToLower.Contains("optifabric") Then Task.Input.SearchText = "optifabric"
  776. Log("[Comp] 工程列表搜索最终文本:" & Task.Input.SearchText, LogLevel.Developer)
  777. Task.Progress = 0.1
  778. #End Region
  779. Dim RealResults As New List(Of CompProject)
  780. Retry:
  781. Dim RawResults As New List(Of CompProject)
  782. Dim [Error] As Exception = Nothing
  783. #Region "从 CurseForge 和 Modrinth 获取结果列表,存储于 RawResults"
  784. Dim CurseForgeThread As Thread = Nothing
  785. Dim ModrinthThread As Thread = Nothing
  786. Dim ResultsLock As New Object
  787. Try
  788. '启动 CurseForge 线程
  789. Dim CurseForgeUrl As String = Task.Input.GetCurseForgeAddress()
  790. If CurseForgeUrl IsNot Nothing Then
  791. CurseForgeThread = RunInNewThread(
  792. Sub()
  793. Try
  794. '获取工程列表
  795. Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
  796. Dim RequestResult As JObject = NetGetCodeByRequestRetry(CurseForgeUrl, IsJson:=True, Encode:=Encoding.UTF8)
  797. Task.Progress += 0.2
  798. Dim ProjectList As New List(Of CompProject)
  799. For Each JsonEntry As JObject In RequestResult("data")
  800. ProjectList.Add(New CompProject(JsonEntry))
  801. Next
  802. '更新结果
  803. SyncLock ResultsLock
  804. RawResults.AddRange(ProjectList)
  805. End SyncLock
  806. Storage.CurseForgeOffset += ProjectList.Count
  807. Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
  808. Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
  809. Catch ex As Exception
  810. Log(ex, "从 CurseForge 获取工程列表失败")
  811. Storage.CurseForgeTotal = Storage.CurseForgeOffset
  812. [Error] = ex
  813. End Try
  814. End Sub, "CurseForge Project Request")
  815. End If
  816. '启动 Modrinth 线程
  817. Dim ModrinthUrl As String = Task.Input.GetModrinthAddress()
  818. If ModrinthUrl IsNot Nothing Then
  819. ModrinthThread = RunInNewThread(
  820. Sub()
  821. Try
  822. Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
  823. Dim RequestResult As JObject = NetGetCodeByRequestRetry(ModrinthUrl, IsJson:=True, Encode:=Encoding.UTF8)
  824. Task.Progress += 0.2
  825. Dim ProjectList As New List(Of CompProject)
  826. For Each JsonEntry As JObject In RequestResult("hits")
  827. ProjectList.Add(New CompProject(JsonEntry))
  828. Next
  829. '更新结果
  830. SyncLock ResultsLock
  831. RawResults.AddRange(ProjectList)
  832. End SyncLock
  833. Storage.ModrinthOffset += ProjectList.Count
  834. Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
  835. Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
  836. Catch ex As Exception
  837. Log(ex, "从 Modrinth 获取工程列表失败")
  838. Storage.ModrinthTotal = Storage.ModrinthOffset
  839. [Error] = ex
  840. End Try
  841. End Sub, "Modrinth Project Request")
  842. End If
  843. '等待线程结束
  844. If CurseForgeThread IsNot Nothing Then CurseForgeThread.Join()
  845. If Task.IsAborted Then Exit Sub '会自动触发 Finally
  846. If ModrinthThread IsNot Nothing Then ModrinthThread.Join()
  847. If Task.IsAborted Then Exit Sub
  848. '确认存在结果
  849. If RawResults.Count = 0 Then
  850. If [Error] IsNot Nothing Then
  851. Throw [Error]
  852. Else
  853. If IsChineseSearch AndAlso Task.Input.Type <> CompType.Mod Then
  854. Throw New Exception($"{If(Task.Input.Type = CompType.ModPack, "整合包", "资源包")}搜索仅支持英文")
  855. ElseIf Task.Input.Source = CompSourceType.CurseForge AndAlso Task.Input.Tag.StartsWith("/") Then
  856. Throw New Exception("CurseForge 不兼容所选的类型")
  857. ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWith("/") Then
  858. Throw New Exception("Modrinth 不兼容所选的类型")
  859. Else
  860. Throw New Exception("没有符合条件的结果")
  861. End If
  862. End If
  863. End If
  864. Finally
  865. If CurseForgeThread IsNot Nothing Then CurseForgeThread.Interrupt()
  866. If ModrinthThread IsNot Nothing Then ModrinthThread.Interrupt()
  867. End Try
  868. #End Region
  869. #Region "提取非重复项,存储于 RealResults"
  870. '将 Modrinth 排在 CurseForge 的前面,避免加载结束顺序不同导致排名不同
  871. '这样做的话,去重后将优先保留 CurseForge 内容(考虑到 CurseForge 热度更高)
  872. RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList
  873. 'RawResults 去重
  874. RawResults = Distinct(RawResults, Function(a, b) a.IsLike(b))
  875. '已有内容去重
  876. RawResults = RawResults.Where(Function(r) Not RealResults.Any(Function(b) r.IsLike(b)) AndAlso
  877. Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList
  878. '加入列表
  879. RealResults.AddRange(RawResults)
  880. Log($"[Comp] 去重后累计新增结果 {RealResults.Count} 个")
  881. #End Region
  882. #Region "检查结果数量,如果不足且可继续,会继续加载下一页"
  883. If RealResults.Count + Storage.Results.Count < Task.Input.TargetResultCount Then
  884. Log($"[Comp] 总结果数需求最少 {Task.Input.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
  885. If Task.Input.CanContinue Then
  886. Log("[Comp] 将继续尝试加载下一页")
  887. GoTo Retry
  888. Else
  889. Log("[Comp] 无法继续加载,将强制结束")
  890. End If
  891. End If
  892. #End Region
  893. #Region "将结果排序并添加"
  894. Dim Scores As New Dictionary(Of CompProject, Double) '排序分
  895. If String.IsNullOrEmpty(Task.Input.SearchText) Then
  896. '如果没有搜索文本,按下载量将结果排序
  897. For Each Result As CompProject In RealResults
  898. Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 30))
  899. Next
  900. Else
  901. '如果有搜索文本,按关联度将结果排序
  902. '排序分 = 搜索相对相似度 (1) + 下载量权重 (对数,10 亿时为 1) + 有中文名 (0.2)
  903. Dim Entry As New List(Of SearchEntry(Of CompProject))
  904. For Each Result As CompProject In RealResults
  905. Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
  906. Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 30)) / 9)
  907. Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
  908. New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
  909. New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
  910. Next
  911. Dim SearchResult = Search(Entry, RawFilter, 101, -1)
  912. For Each OneResult In SearchResult
  913. Scores(OneResult.Item) += OneResult.Similarity / SearchResult(0).Similarity '最高 1 分的相似度分
  914. Next
  915. End If
  916. '根据排序分得出结果并添加
  917. Storage.Results.AddRange(
  918. Sort(Scores.ToList, Function(a, b) a.Value > b.Value).Select(Function(r) r.Key).ToList)
  919. #End Region
  920. End Sub
  921. #End Region
  922. #Region "CompFile | 文件信息"
  923. '类定义
  924. Public Enum CompFileStatus
  925. Release = 1 '枚举值来源:https://docs.curseforge.com/#tocS_FileReleaseType
  926. Beta = 2
  927. Alpha = 3
  928. End Enum
  929. Public Class CompFile
  930. '源信息
  931. ''' <summary>
  932. ''' 文件的种类。
  933. ''' </summary>
  934. Public ReadOnly Type As CompType
  935. ''' <summary>
  936. ''' 该文件来自 CurseForge 还是 Modrinth。
  937. ''' </summary>
  938. Public ReadOnly FromCurseForge As Boolean
  939. ''' <summary>
  940. ''' 用于唯一性鉴别该文件的 ID。CurseForge 中为 123456 的大整数,Modrinth 中为英文乱码的 Version 字段。
  941. ''' </summary>
  942. Public ReadOnly Id As String
  943. '描述性信息
  944. ''' <summary>
  945. ''' 文件描述名(并非文件名,是自定义的字段)。
  946. ''' </summary>
  947. Public DisplayName As String
  948. ''' <summary>
  949. ''' 发布时间。
  950. ''' </summary>
  951. Public ReadOnly ReleaseDate As Date
  952. ''' <summary>
  953. ''' 下载量计数。注意,该计数仅为一个来源,无法反应两边加起来的下载量,且 CurseForge 可能错误地返回 0。
  954. ''' </summary>
  955. Public ReadOnly DownloadCount As Integer
  956. ''' <summary>
  957. ''' 支持的 Mod 加载器列表。可能为空。
  958. ''' </summary>
  959. Public ReadOnly ModLoaders As List(Of CompModLoaderType)
  960. ''' <summary>
  961. ''' 支持的游戏版本列表。类型包括:"1.18.5","1.18","1.18 快照","21w15a","未知版本"。
  962. ''' </summary>
  963. Public ReadOnly GameVersions As List(Of String)
  964. ''' <summary>
  965. ''' 发布状态:Release/Beta/Alpha。
  966. ''' </summary>
  967. Public ReadOnly Status As CompFileStatus
  968. ''' <summary>
  969. ''' 发布状态的友好描述。例如:"正式版","Beta 版"。
  970. ''' </summary>
  971. Public ReadOnly Property StatusDescription As String
  972. Get
  973. Select Case Status
  974. Case CompFileStatus.Release
  975. Return "正式版"
  976. Case CompFileStatus.Beta
  977. Return If(ModeDebug, "Beta 版", "测试版")
  978. Case Else
  979. Return If(ModeDebug, "Alpha 版", "测试版")
  980. End Select
  981. End Get
  982. End Property
  983. '下载信息
  984. ''' <summary>
  985. ''' 下载信息是否可用。
  986. ''' </summary>
  987. Public ReadOnly Property Available As Boolean
  988. Get
  989. Return FileName IsNot Nothing
  990. End Get
  991. End Property
  992. ''' <summary>
  993. ''' 下载的文件名。
  994. ''' </summary>
  995. Public ReadOnly FileName As String = Nothing
  996. ''' <summary>
  997. ''' 文件所有可能的下载源。
  998. ''' </summary>
  999. Private ReadOnly DownloadAddress As String()
  1000. ''' <summary>
  1001. ''' 该文件的所有依赖工程的原始 ID。
  1002. ''' 这些 ID 可能没有加载,在加载后会添加到 Dependencies 中(主要是因为 Modrinth 返回的是字符串 ID 而非 Slug,导致 Project.Id 查询不到)。
  1003. ''' </summary>
  1004. Public ReadOnly RawDependencies As New List(Of String)
  1005. ''' <summary>
  1006. ''' 该文件的所有依赖工程的 Project.Id。
  1007. ''' </summary>
  1008. Public ReadOnly Dependencies As New List(Of String)
  1009. ''' <summary>
  1010. ''' 获取下载信息。
  1011. ''' </summary>
  1012. ''' <param name="LocalAddress">目标本地文件夹,或完整的文件路径。会自动判断类型。</param>
  1013. Public Function ToNetFile(LocalAddress As String) As NetFile
  1014. Return New NetFile(DownloadAddress, LocalAddress & If(LocalAddress.EndsWith("\"), FileName, ""))
  1015. End Function
  1016. '实例化
  1017. ''' <summary>
  1018. ''' 从文件 Json 中初始化实例。若出错会抛出异常。
  1019. ''' </summary>
  1020. Public Sub New(Data As JObject, Type As CompType)
  1021. Me.Type = Type
  1022. FromCurseForge = Data.ContainsKey("gameId")
  1023. If FromCurseForge Then
  1024. #Region "CurseForge"
  1025. '简单信息
  1026. Id = Data("id")
  1027. DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
  1028. ReleaseDate = Data("fileDate")
  1029. Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
  1030. DownloadCount = Data("downloadCount")
  1031. FileName = Data("fileName")
  1032. 'DownloadAddress
  1033. Dim Url = Data("downloadUrl").ToString
  1034. If Url = "" Then Url = "https://media.forgecdn.net/files/" & Id.ToString.Substring(0, 4) & "/" & Id.ToString.Substring(4).TrimStart("0") & "/" & FileName
  1035. Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
  1036. DownloadAddress = {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
  1037. Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
  1038. Url.Replace("://edge", "://media"),
  1039. Url}.Distinct.ToArray
  1040. 'Dependencies
  1041. If Type = CompType.Mod Then
  1042. RawDependencies = Data("dependencies").
  1043. Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖
  1044. d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API
  1045. Select(Function(d) d("modId").ToString).ToList
  1046. End If
  1047. 'GameVersions
  1048. Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
  1049. GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList
  1050. If GameVersions.Count > 1 Then
  1051. GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
  1052. If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
  1053. ElseIf GameVersions.Count = 1 Then
  1054. GameVersions = GameVersions.ToList
  1055. Else
  1056. GameVersions = New List(Of String) From {"未知版本"}
  1057. End If
  1058. 'ModLoaders
  1059. ModLoaders = New List(Of CompModLoaderType)
  1060. If RawVersions.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
  1061. If RawVersions.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
  1062. If RawVersions.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
  1063. #End Region
  1064. Else
  1065. #Region "Modrinth"
  1066. '简单信息
  1067. Id = Data("id")
  1068. DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ")
  1069. ReleaseDate = Data("date_published")
  1070. Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
  1071. DownloadCount = Data("downloads")
  1072. '可能为空
  1073. If CType(Data("files"), JArray).Count > 0 Then
  1074. FileName = Data("files")(0)("filename")
  1075. DownloadAddress = {Data("files")(0)("url").ToString.Replace(FileName, FileName)}
  1076. End If
  1077. 'Dependencies
  1078. If Type = CompType.Mod Then
  1079. RawDependencies = Data("dependencies").
  1080. Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖
  1081. d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API
  1082. d("project_id").ToString.Length > 0). '有时候真的会空……
  1083. Select(Function(d) d("project_id").ToString).ToList
  1084. End If
  1085. 'GameVersions
  1086. Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
  1087. GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.")).
  1088. Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", v)).ToList
  1089. If GameVersions.Count > 1 Then
  1090. GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
  1091. If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
  1092. ElseIf GameVersions.Count = 1 Then
  1093. GameVersions = GameVersions.ToList
  1094. ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
  1095. GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
  1096. Else
  1097. GameVersions = New List(Of String) From {"未知版本"}
  1098. End If
  1099. 'ModLoaders
  1100. Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
  1101. ModLoaders = New List(Of CompModLoaderType)
  1102. If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
  1103. If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
  1104. If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
  1105. #End Region
  1106. End If
  1107. End Sub
  1108. ''' <summary>
  1109. ''' 将当前文件信息实例化为控件。
  1110. ''' </summary>
  1111. Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing,
  1112. Optional BadDisplayName As Boolean = False) As MyListItem
  1113. '获取描述信息
  1114. Dim Info As String = ""
  1115. Select Case Type
  1116. Case CompType.Mod
  1117. Info += If(ModLoaders.Count > 0,
  1118. "适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & ",", "")
  1119. Info += If(ModeDebug AndAlso Dependencies.Count > 0, Dependencies.Count & " 个前置 Mod,", "")
  1120. Case CompType.ModPack
  1121. If GameVersions.All(Function(v) v.Contains("w")) Then
  1122. Info += $"游戏版本 {Join(GameVersions, "、")},"
  1123. End If
  1124. End Select
  1125. If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
  1126. Info += If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载,", DownloadCount & " 次下载,")
  1127. End If
  1128. Info += GetTimeSpanString(ReleaseDate - Date.Now, False) & "更新"
  1129. Info += If(Status = CompFileStatus.Release, "", "," & StatusDescription)
  1130. '建立控件
  1131. Dim NewItem As New MyListItem With {
  1132. .Title = If(BadDisplayName, FileName, DisplayName),
  1133. .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
  1134. .Info = Info
  1135. }
  1136. Select Case Status
  1137. Case CompFileStatus.Release
  1138. NewItem.Logo = "pack://application:,,,/images/Icons/R.png"
  1139. Case CompFileStatus.Beta
  1140. NewItem.Logo = "pack://application:,,,/images/Icons/B.png"
  1141. Case Else 'Alpha
  1142. NewItem.Logo = "pack://application:,,,/images/Icons/A.png"
  1143. End Select
  1144. AddHandler NewItem.Click, OnClick
  1145. '建立另存为按钮
  1146. If OnSaveClick IsNot Nothing Then
  1147. Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
  1148. ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
  1149. ToolTipService.SetVerticalOffset(BtnSave, 30)
  1150. ToolTipService.SetHorizontalOffset(BtnSave, 2)
  1151. AddHandler BtnSave.Click, OnSaveClick
  1152. NewItem.Buttons = {BtnSave}
  1153. NewItem.PaddingRight = 35
  1154. End If
  1155. '结束
  1156. Return NewItem
  1157. End Function
  1158. '辅助函数
  1159. Public Overrides Function ToString() As String
  1160. Return $"{Id}: {DisplayName}"
  1161. End Function
  1162. End Class
  1163. '获取
  1164. ''' <summary>
  1165. ''' 已知文件信息的缓存。
  1166. ''' </summary>
  1167. Private CompFilesCache As New Dictionary(Of String, List(Of CompFile))
  1168. ''' <summary>
  1169. ''' 获取某个工程下的全部文件列表。
  1170. ''' 必须在工作线程执行,失败会抛出异常。
  1171. ''' </summary>
  1172. Public Function CompFilesGet(ProjectId As String, FromCurseForge As Boolean) As List(Of CompFile)
  1173. '使用缓存
  1174. If CompFilesCache.ContainsKey(ProjectId) Then Return CompFilesCache(ProjectId)
  1175. '获取工程对象
  1176. Dim TargetProject As CompProject
  1177. If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
  1178. TargetProject = CompProjectCache(ProjectId)
  1179. ElseIf FromCurseForge Then 'CurseForge
  1180. TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)("data"))
  1181. Else 'Modrinth
  1182. TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8))
  1183. End If
  1184. '获取工程对象的文件列表
  1185. Log("[Comp] 开始获取文件列表:" & ProjectId)
  1186. Dim ResultJsonArray As JArray
  1187. If FromCurseForge Then
  1188. 'CurseForge
  1189. If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
  1190. ResultJsonArray = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
  1191. Else '否则使用全部文件
  1192. ResultJsonArray = NetGetCodeByRequestRetry($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", Accept:="application/json", IsJson:=True)("data")
  1193. End If
  1194. Else
  1195. 'Modrinth
  1196. ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True)
  1197. End If
  1198. CompFilesCache(ProjectId) = Distinct(ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
  1199. Where(Function(a) a.Available).ToList, Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
  1200. '获取前置 Mod 列表
  1201. If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId)
  1202. Dim Deps As List(Of String) = CompFilesCache(ProjectId).
  1203. SelectMany(Function(f) f.RawDependencies).Distinct().ToList
  1204. Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
  1205. '获取前置 Mod 工程信息
  1206. If UndoneDeps.Count > 0 Then
  1207. Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}")
  1208. Dim Projects As JArray
  1209. If TargetProject.FromCurseForge Then
  1210. Projects = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods",
  1211. "POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data")
  1212. Else
  1213. Projects = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]",
  1214. Accept:="application/json", IsJson:=True)
  1215. End If
  1216. For Each Project In Projects
  1217. Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存
  1218. Next
  1219. End If
  1220. '更新前置 Mod 信息
  1221. If Deps.Count > 0 Then
  1222. For Each DepProject In Deps.Select(Function(id) CompProjectCache(id))
  1223. For Each File In CompFilesCache(ProjectId)
  1224. If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
  1225. File.Dependencies.Add(DepProject.Id)
  1226. End If
  1227. Next
  1228. Next
  1229. End If
  1230. Return CompFilesCache(ProjectId)
  1231. End Function
  1232. ''' <summary>
  1233. ''' 预载包含大量 CompFile 的卡片,添加必要的元素和前置 Mod 列表。
  1234. ''' </summary>
  1235. Public Sub CompFilesCardPreload(Stack As StackPanel, Files As List(Of CompFile), OnClick As MyListItem.ClickEventHandler)
  1236. '获取卡片对应的前置 ID
  1237. '如果为整合包就不会有 Dependencies 信息,所以不用管
  1238. Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
  1239. Deps.Sort()
  1240. If Deps.Count = 0 Then Exit Sub
  1241. Deps = Deps.Where(Function(dep)
  1242. If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
  1243. Return CompProjectCache.ContainsKey(dep)
  1244. End Function).ToList
  1245. '添加开头间隔
  1246. Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
  1247. '添加前置 Mod 列表
  1248. For Each Dep In Deps
  1249. Dim Item = CompProjectCache(Dep).ToCompItem(False, False, AddressOf FrmDownloadMod.ProjectClick)
  1250. Stack.Children.Add(Item)
  1251. Next
  1252. '添加结尾间隔
  1253. Stack.Children.Add(New TextBlock With {.Text = "可选版本", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 12, 0, 5)})
  1254. End Sub
  1255. #End Region
  1256. End Module