ModComp.vb 79 KB

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