ModComp.vb 73 KB

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