ModComp.vb 90 KB

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