| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323 |
- Public Module ModComp
- Public Enum CompType
- ''' <summary>
- ''' Mod。
- ''' </summary>
- [Mod]
- ''' <summary>
- ''' 整合包。
- ''' </summary>
- ModPack
- ''' <summary>
- ''' 资源包。
- ''' </summary>
- ResourcePack
- End Enum
- Public Enum CompModLoaderType
- 'https://docs.curseforge.com/?http#tocS_ModLoaderType
- Any = 0
- Forge = 1
- Fabric = 4
- Quilt = 5
- End Enum
- #Region "CompDatabase | Mod 数据库"
- Private _CompDatabase As List(Of CompDatabaseEntry) = Nothing
- Private ReadOnly Property CompDatabase As List(Of CompDatabaseEntry)
- Get
- If _CompDatabase IsNot Nothing Then Return _CompDatabase
- '初始化数据库
- _CompDatabase = New List(Of CompDatabaseEntry)
- Dim i As Integer = 0
- For Each Line In DecodeBytes(GetResources("ModData")).Replace(vbCrLf, vbLf).Replace(vbCr, "").Split(vbLf)
- i += 1
- If Line = "" Then Continue For
- For Each EntryData As String In Line.Split("¨")
- Dim Entry = New CompDatabaseEntry
- Dim SplitedLine = EntryData.Split("|")
- If SplitedLine(0).StartsWith("@") Then
- Entry.CurseForgeSlug = Nothing
- Entry.ModrinthSlug = SplitedLine(0).Replace("@", "")
- ElseIf SplitedLine(0).EndsWith("@") Then
- Entry.CurseForgeSlug = SplitedLine(0).TrimEnd("@")
- Entry.ModrinthSlug = Entry.CurseForgeSlug
- ElseIf SplitedLine(0).Contains("@") Then
- Entry.CurseForgeSlug = SplitedLine(0).Split("@")(0)
- Entry.ModrinthSlug = SplitedLine(0).Split("@")(1)
- Else
- Entry.CurseForgeSlug = SplitedLine(0)
- Entry.ModrinthSlug = Nothing
- End If
- Entry.WikiId = i
- If SplitedLine.Count >= 2 Then
- Entry.ChineseName = SplitedLine(1)
- Entry.MCBBS = If(SplitedLine.Count >= 3, SplitedLine(2), Nothing)
- If Entry.ChineseName.Contains("*") Then '处理 *
- Entry.ChineseName = Entry.ChineseName.Replace("*", " (" &
- String.Join(" ", If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Split("-").Select(Function(w) w.Substring(0, 1).ToUpper & w.Substring(1, w.Length - 1))) & ")")
- End If
- End If
- _CompDatabase.Add(Entry)
- Next
- Next
- Return _CompDatabase
- End Get
- End Property
- Private Class CompDatabaseEntry
- ''' <summary>
- ''' McMod 的对应 ID。
- ''' </summary>
- Public WikiId As Integer
- ''' <summary>
- ''' 中文译名。空字符串代表没有翻译。
- ''' </summary>
- Public ChineseName As String = ""
- ''' <summary>
- ''' MCBBS 发布帖编号(例如 195107)。若为 Nothing 则没有发布帖。
- ''' </summary>
- Public MCBBS As Integer?
- ''' <summary>
- ''' CurseForge Slug(例如 advanced-solar-panels)。
- ''' </summary>
- Public CurseForgeSlug As String = Nothing
- ''' <summary>
- ''' Modrinth Slug(例如 advanced-solar-panels)。
- ''' </summary>
- Public ModrinthSlug As String = Nothing
- Public Overrides Function ToString() As String
- Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & WikiId & "|" & ChineseName & If(MCBBS Is Nothing, "", "|" & MCBBS)
- End Function
- End Class
- #End Region
- #Region "CompProject | 工程信息"
- '类定义
- Public Class CompProject
- '源信息
- ''' <summary>
- ''' 该工程信息来自 CurseForge 还是 Modrinth。
- ''' </summary>
- Public ReadOnly FromCurseForge As Boolean
- ''' <summary>
- ''' 工程的种类。
- ''' </summary>
- Public ReadOnly Type As CompType
- ''' <summary>
- ''' 工程的短名。例如 technical-enchant。
- ''' </summary>
- Public ReadOnly Slug As String
- ''' <summary>
- ''' CurseForge 工程的数字 ID。Modrinth 工程的乱码 ID。
- ''' </summary>
- Public ReadOnly Id As String
- ''' <summary>
- ''' CurseForge 文件列表的数字 ID。Modrinth 工程的此项无效。
- ''' </summary>
- Public ReadOnly CurseForgeFileIds As List(Of Integer)
- '描述性信息
- ''' <summary>
- ''' 原始的英文名称。
- ''' </summary>
- Public ReadOnly RawName As String
- ''' <summary>
- ''' 英文描述。
- ''' </summary>
- Public ReadOnly Description As String
- ''' <summary>
- ''' 来源网站的工程页面网址。确保格式一定标准。
- ''' CurseForge:https://www.curseforge.com/minecraft/mc-mods/jei
- ''' Modrinth:https://modrinth.com/mod/technical-enchant
- ''' </summary>
- Public ReadOnly Website As String
- ''' <summary>
- ''' 最后一次更新的时间。可能为 Nothing。
- ''' </summary>
- Public ReadOnly LastUpdate As Date? = Nothing
- ''' <summary>
- ''' 下载量计数。注意,该计数仅为一个来源,无法反应两边加起来的下载量!
- ''' </summary>
- Public ReadOnly DownloadCount As Integer
- ''' <summary>
- ''' 支持的 Mod 加载器列表。可能为空。
- ''' </summary>
- Public ReadOnly ModLoaders As List(Of CompModLoaderType)
- ''' <summary>
- ''' 描述性标签的内容。已转换为中文。
- ''' </summary>
- Public ReadOnly Tags As List(Of String)
- ''' <summary>
- ''' Logo 图片的下载地址。若为 Nothing 则没有。
- ''' </summary>
- Public ReadOnly LogoUrl As String = Nothing
- ''' <summary>
- ''' 游戏大版本列表。例如:18, 16, 15……
- ''' </summary>
- Public ReadOnly GameVersions As List(Of Integer)
- '数据库信息
- Private LoadedDatabase As Boolean = False
- Private _DatabaseEntry As CompDatabaseEntry = Nothing
- ''' <summary>
- ''' 关联的数据库条目。若为 Nothing 则没有。
- ''' </summary>
- Private Property DatabaseEntry As CompDatabaseEntry
- Get
- If Not LoadedDatabase Then
- LoadedDatabase = True
- _DatabaseEntry = CompDatabase.FirstOrDefault(Function(c) If(FromCurseForge, c.CurseForgeSlug, c.ModrinthSlug) = Slug)
- End If
- Return _DatabaseEntry
- End Get
- Set(value As CompDatabaseEntry)
- LoadedDatabase = True
- _DatabaseEntry = value
- End Set
- End Property
- ''' <summary>
- ''' MC 百科的页面 ID。若为 0 则没有。
- ''' </summary>
- Public ReadOnly Property WikiId As Integer
- Get
- Return If(DatabaseEntry Is Nothing, 0, DatabaseEntry.WikiId)
- End Get
- End Property
- ''' <summary>
- ''' MCBBS 的帖子 ID。若为 0 则没有。
- ''' </summary>
- Public ReadOnly Property MCBBS As Integer
- Get
- Return If(DatabaseEntry Is Nothing, 0, If(DatabaseEntry.MCBBS, 0))
- End Get
- End Property
- ''' <summary>
- ''' 翻译后的中文名。若数据库没有则等同于 RawName。
- ''' </summary>
- Public ReadOnly Property TranslatedName As String
- Get
- Return If(DatabaseEntry Is Nothing OrElse DatabaseEntry.ChineseName = "", RawName, DatabaseEntry.ChineseName)
- End Get
- End Property
- '实例化
- ''' <summary>
- ''' 从工程 Json 中初始化实例。若出错会抛出异常。
- ''' </summary>
- Public Sub New(Data As JObject)
- FromCurseForge = Data.ContainsKey("gameId")
- If FromCurseForge Then
- #Region "CurseForge"
- '简单信息
- Id = Data("id")
- Slug = Data("slug")
- RawName = Data("name")
- Description = Data("summary")
- Website = Data("links")("websiteUrl").ToString.TrimEnd("/")
- LastUpdate = Data("dateReleased") '#1194
- DownloadCount = Data("downloadCount")
- 'Logo
- If Data("logo").Count > 0 Then
- If GetPixelSize(1) > 1.25 Then
- LogoUrl = Data("logo")("thumbnailUrl").ToString '使用 256x256 图标
- Else
- LogoUrl = Data("logo")("thumbnailUrl").ToString.Replace("/256/256/", "/64/64/") '使用 64x64 图标
- End If
- End If
- 'FileIndexes / GameVersions
- Dim Files = If(CType(Data("latestFilesIndexes"), JArray), New JArray).
- Where(Function(i) i("gameVersion").ToString.Contains("1."))
- CurseForgeFileIds = Files.Select(Of Integer)(Function(v) v("fileId")).ToList
- GameVersions = Files.Select(Of Integer)(Function(v) Val(v("gameVersion").ToString.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
- Distinct.OrderByDescending(Function(v) v).ToList
- 'Type
- If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
- Type = CompType.Mod
- ElseIf Website.Contains("/modpacks/") Then
- Type = CompType.ModPack
- Else
- Type = CompType.ResourcePack
- End If
- 'Tags
- Tags = New List(Of String)
- For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
- Select Case Category
- 'Mod
- Case 406 : Tags.Add("世界元素")
- Case 407 : Tags.Add("生物群系")
- Case 410 : Tags.Add("维度")
- Case 408 : Tags.Add("矿物/资源")
- Case 409 : Tags.Add("天然结构")
- Case 412 : Tags.Add("科技")
- Case 415 : Tags.Add("管道/物流")
- Case 4843 : Tags.Add("自动化")
- Case 417 : Tags.Add("能源")
- Case 4558 : Tags.Add("红石")
- Case 436 : Tags.Add("食物/烹饪")
- Case 416 : Tags.Add("农业")
- Case 414 : Tags.Add("运输")
- Case 420 : Tags.Add("仓储")
- Case 419 : Tags.Add("魔法")
- Case 422 : Tags.Add("冒险")
- Case 424 : Tags.Add("装饰")
- Case 411 : Tags.Add("生物")
- Case 434 : Tags.Add("装备")
- Case 423 : Tags.Add("信息显示")
- Case 435 : Tags.Add("服务器")
- Case 5191 : Tags.Add("改良")
- Case 421 : Tags.Add("支持库")
- '整合包
- Case 4484 : Tags.Add("多人")
- Case 4479 : Tags.Add("硬核")
- Case 4483 : Tags.Add("战斗")
- Case 4478 : Tags.Add("任务")
- Case 4472 : Tags.Add("科技")
- Case 4473 : Tags.Add("魔法")
- Case 4475 : Tags.Add("冒险")
- Case 4476 : Tags.Add("探索")
- Case 4477 : Tags.Add("小游戏")
- Case 4471 : Tags.Add("科幻")
- Case 4736 : Tags.Add("空岛")
- Case 5128 : Tags.Add("原版改良")
- Case 4487 : Tags.Add("FTB")
- Case 4480 : Tags.Add("基于地图")
- Case 4481 : Tags.Add("轻量")
- Case 4482 : Tags.Add("大型")
- 'FUTURE: Res
- End Select
- Next
- If Tags.Count = 0 Then Tags.Add("杂项")
- 'ModLoaders
- ModLoaders = New List(Of CompModLoaderType)
- For Each File In If(Data("latestFiles"), {})
- Dim NewFile As New CompFile(File, Type)
- If Not NewFile.Available Then Continue For
- ModLoaders.AddRange(NewFile.ModLoaders)
- Next
- ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
- #End Region
- Else
- #Region "Modrinth"
- '简单信息
- Id = If(Data("project_id"), Data("id")) '两个 API 会返回的 key 不一样
- Slug = Data("slug")
- RawName = Data("title")
- Description = Data("description")
- LastUpdate = Data("date_modified")
- DownloadCount = Data("downloads")
- LogoUrl = Data("icon_url")
- If LogoUrl = "" Then LogoUrl = Nothing
- Website = $"https://modrinth.com/{Data("project_type")}/{Slug}"
- 'GameVersions
- GameVersions = If(CType(Data("versions"), JArray), New JArray).
- Select(Function(v) v.ToString).Where(Function(v) v.StartsWith("1.")).
- Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
- Distinct.OrderByDescending(Function(v) v).ToList
- 'Type
- Select Case Data("project_type").ToString
- Case "mod" : Type = CompType.Mod
- Case "modpack" : Type = CompType.ModPack
- Case "resourcepack" : Type = CompType.ResourcePack
- End Select
- 'Tags & ModLoaders
- Tags = New List(Of String)
- ModLoaders = New List(Of CompModLoaderType)
- For Each Category In Data("categories").Select(Function(t) t.ToString)
- Select Case Category
- '加载器
- Case "forge" : ModLoaders.Add(CompModLoaderType.Forge)
- Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric)
- Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt)
- 'Mod
- Case "worldgen" : Tags.Add("世界元素")
- Case "technology" : Tags.Add("科技")
- Case "food" : Tags.Add("食物/烹饪")
- Case "game-mechanics" : Tags.Add("游戏机制")
- Case "transportation" : Tags.Add("运输")
- Case "storage" : Tags.Add("仓储")
- Case "magic" : Tags.Add("魔法")
- Case "adventure" : Tags.Add("冒险")
- Case "decoration" : Tags.Add("装饰")
- Case "mobs" : Tags.Add("生物")
- Case "equipment" : Tags.Add("装备")
- Case "optimization" : Tags.Add("性能优化")
- Case "social" : Tags.Add("服务器")
- Case "utility" : Tags.Add("改良")
- Case "library" : Tags.Add("支持库")
- '整合包
- Case "multiplayer" : Tags.Add("多人")
- Case "optimization" : Tags.Add("性能优化")
- Case "challenging" : Tags.Add("硬核")
- Case "combat" : Tags.Add("战斗")
- Case "quests" : Tags.Add("任务")
- Case "technology" : Tags.Add("科技")
- Case "magic" : Tags.Add("魔法")
- Case "adventure" : Tags.Add("冒险")
- Case "kitchen-sink" : Tags.Add("烹饪")
- Case "lightweight" : Tags.Add("轻量")
- 'FUTURE: Res
- End Select
- Next
- If Tags.Count = 0 Then Tags.Add("杂项")
- ModLoaders.Sort()
- #End Region
- End If
- '保存缓存
- CompProjectCache(Id) = Me
- End Sub
- ''' <summary>
- ''' 将当前工程信息实例化为控件。
- ''' </summary>
- Public Function ToCompItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean, Optional OnClick As MyCompItem.ClickEventHandler = Nothing) As MyCompItem
- '获取版本描述
- Dim GameVersionDescription As String
- If GameVersions Is Nothing OrElse GameVersions.Count = 0 Then
- GameVersionDescription = ""
- Else
- Dim SpaVersions As New List(Of String)
- For i = 0 To GameVersions.Count - 1
- Dim StartVersion As Integer = GameVersions(i), EndVersion As Integer = GameVersions(i)
- For ii = i + 1 To GameVersions.Count - 1
- If GameVersions(ii) = EndVersion - 1 Then
- EndVersion = GameVersions(ii)
- i = ii
- Else
- Exit For
- End If
- Next
- If StartVersion = EndVersion Then
- SpaVersions.Add("1." & StartVersion)
- ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then
- SpaVersions.Add("1." & EndVersion & "+")
- ElseIf EndVersion <= 7 Then
- SpaVersions.Add("1." & StartVersion & "-")
- Exit For
- ElseIf StartVersion - EndVersion = 1 Then
- SpaVersions.Add("1." & StartVersion & ", 1." & EndVersion)
- Else
- SpaVersions.Add("1." & StartVersion & "~1." & EndVersion)
- End If
- Next
- GameVersionDescription = SpaVersions.Join(", ")
- End If
- '实例化 UI
- Dim NewItem As New MyCompItem With {.Tag = Me}
- '标题
- Dim FinalName As String = TranslatedName.Split(" | ").First.Split(" - ").First.Split(" (").First.Split(" [").First
- NewItem.LabTitle.Text = FinalName
- Dim ExNameList As New List(Of String)
- If TranslatedName.Contains(" (") Then ExNameList.Add(TranslatedName.Split(" (").Last.Split(")").First)
- If TranslatedName.Contains(" [") Then ExNameList.Add(TranslatedName.Split(" [").Last.Split("]").First)
- If TranslatedName.Contains(" - ") Then ExNameList.Add(TranslatedName.Split(" - ").Last.Split(" | ").First.Split(" (").First.Split(" [").First)
- If TranslatedName.Contains(" | ") Then ExNameList.Add(TranslatedName.Split(" | ").Last.Split(" - ").First.Split(" (").First.Split(" [").First)
- If ExNameList.Count = 0 Then
- NoExName:
- CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
- Else
- Dim ExName As String = ""
- For Each Ex In ExNameList
- '去除 “Forge/Fabric” 一类的无意义提示
- If Ex.Length < 19 AndAlso Ex.ToLower.Contains("fabric") AndAlso Ex.ToLower.Contains("forge") Then Continue For
- '将 “Forge” 等提示改为 “Forge 版”
- If (Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt")) AndAlso
- Not Ex.Contains("版") AndAlso Ex.Length < 19 Then Ex = Ex.Replace("Edition", "").Trim & " 版"
- ExName &= " | " & Ex.Trim
- Next
- If ExName = "" Then GoTo NoExName
- NewItem.LabTitleRaw.Text = ExName
- End If
- 'Tag
- For Each TagText In Tags
- Dim NewTag = GetObjectFromXML(
- "<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
- Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
- SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
- <TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
- </Border>")
- NewItem.PanTags.Children.Add(NewTag)
- Next
- '下边栏
- If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then
- '全部隐藏
- CType(NewItem.PathVersion.Parent, Grid).Children.Remove(NewItem.PathVersion)
- CType(NewItem.LabVersion.Parent, Grid).Children.Remove(NewItem.LabVersion)
- NewItem.ColumnVersionMargin.Width = New GridLength(0)
- ElseIf ShowMcVersionDesc AndAlso ShowMcVersionDesc Then
- '全部显示
- Dim ModLoaderDesc As String = If(ModLoaders.Count > 0 AndAlso ModLoaders.Count < 3 AndAlso
- Not (Type = CompType.Mod AndAlso Setup.Get("ToolDownloadIgnoreQuilt") AndAlso ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric)),
- ModLoaders.Join(" / ") & " ", "")
- Dim VersionDesc As String = If(GameVersionDescription = "1.7+", "全版本", GameVersionDescription)
- NewItem.LabVersion.Text = ModLoaderDesc & VersionDesc
- ElseIf ShowMcVersionDesc Then
- '仅显示版本
- NewItem.LabVersion.Text = If(GameVersionDescription = "1.7+", "全版本", GameVersionDescription)
- Else
- '仅显示 Mod 加载器
- Select Case ModLoaders.Count
- Case 0
- NewItem.LabVersion.Text = "未知"
- Case 1
- NewItem.LabVersion.Text = If(Type = CompType.Mod, "仅 ", "") & ModLoaders(0).ToString
- Case 2
- If Type = CompType.Mod Then
- NewItem.LabVersion.Text =
- If(Not (Setup.Get("ToolDownloadIgnoreQuilt") AndAlso
- ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric)),
- ModLoaders.Join(" / "), "任意")
- Else
- NewItem.LabVersion.Text = ModLoaders.Join(" / ")
- End If
- Case 3
- If Type = CompType.Mod Then
- NewItem.LabVersion.Text = "任意"
- Else
- NewItem.LabVersion.Text = ModLoaders.Join(" / ")
- End If
- End Select
- End If
- NewItem.LabInfo.Text = Description.Replace(vbCr, "").Replace(vbLf, "")
- NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth")
- If LastUpdate IsNot Nothing Then
- NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
- End If
- NewItem.LabDownload.Text =
- If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
- If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
- '其他
- If LogoUrl Is Nothing Then
- NewItem.Logo = "pack://application:,,,/images/Icons/NoIcon.png"
- Else
- NewItem.Logo = LogoUrl
- End If
- If OnClick IsNot Nothing Then
- AddHandler NewItem.Click, OnClick
- NewItem.HasAnimation = True
- Else
- NewItem.HasAnimation = False
- End If
- Return NewItem
- End Function
- '辅助函数
- ''' <summary>
- ''' 检查是否与某个 Project 是相同的工程,只是在不同的网站。
- ''' </summary>
- Public Function IsLike(Project As CompProject) As Boolean
- If Id = Project.Id Then Return True '相同实例
- '提取字符串中的字母和数字
- Dim GetRaw =
- Function(Data As String) As String
- Dim Result As New StringBuilder()
- For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
- Result.Append(r)
- Next
- Return Result.ToString.ToLower
- End Function
- '来自不同的网站
- If FromCurseForge = Project.FromCurseForge Then Return False
- 'Mod 加载器一致
- If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False
- 'MC 版本一致
- If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False
- 'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
- If TranslatedName = Project.TranslatedName OrElse
- RawName = Project.RawName OrElse Description = Project.Description OrElse
- GetRaw(Slug) = GetRaw(Project.Slug) Then
- Log($"[Comp] 将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程")
- '如果只有一个有 DatabaseEntry,设置给另外一个
- If DatabaseEntry Is Nothing AndAlso Project.DatabaseEntry IsNot Nothing Then DatabaseEntry = Project.DatabaseEntry
- If DatabaseEntry IsNot Nothing AndAlso Project.DatabaseEntry Is Nothing Then Project.DatabaseEntry = DatabaseEntry
- Return True
- End If
- Return False
- End Function
- Public Overrides Function ToString() As String
- Return $"{Id} ({Slug}): {RawName}"
- End Function
- Public Overrides Function Equals(obj As Object) As Boolean
- Dim project = TryCast(obj, CompProject)
- Return project IsNot Nothing AndAlso Id = project.Id
- End Function
- Public Shared Operator =(left As CompProject, right As CompProject) As Boolean
- Return EqualityComparer(Of CompProject).Default.Equals(left, right)
- End Operator
- Public Shared Operator <>(left As CompProject, right As CompProject) As Boolean
- Return Not left = right
- End Operator
- End Class
- '输入与输出
- Public Class CompProjectRequest
- '结果要求
- ''' <summary>
- ''' 加载后应输出到的结果存储器。
- ''' </summary>
- Public Storage As CompProjectStorage
- ''' <summary>
- ''' 应当尽量达成的结果数量。
- ''' </summary>
- Public TargetResultCount As Integer
- ''' <summary>
- ''' 根据加载位置记录,是否还可以继续获取内容。
- ''' </summary>
- Public ReadOnly Property CanContinue As Boolean
- Get
- If Tag.StartsWith("/") Then Storage.CurseForgeTotal = 0
- If Tag.EndsWith("/") Then Storage.ModrinthTotal = 0
- If Storage.CurseForgeTotal = -1 OrElse Storage.ModrinthTotal = -1 Then Return True
- Return Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
- End Get
- End Property
- '输入内容
- ''' <summary>
- ''' 筛选资源种类。
- ''' </summary>
- Public Type As CompType
- ''' <summary>
- ''' 筛选资源标签。空字符串代表不限制。格式例如 "406/worldgen",分别是 CurseForge 和 Modrinth 的 ID。
- ''' </summary>
- Public Tag As String = ""
- ''' <summary>
- ''' 筛选 Mod 加载器类别。
- ''' </summary>
- Public ModLoader As CompModLoaderType = CompModLoaderType.Any
- ''' <summary>
- ''' 筛选 MC 版本。
- ''' </summary>
- Public GameVersion As String = Nothing
- ''' <summary>
- ''' 搜索的文本内容。
- ''' </summary>
- Public SearchText As String = Nothing
- ''' <summary>
- ''' 构造函数。
- ''' </summary>
- Public Sub New(Type As CompType, Storage As CompProjectStorage, TargetResultCount As Integer)
- Me.Type = Type
- Me.Storage = Storage
- Me.TargetResultCount = TargetResultCount
- End Sub
- '构造请求
- ''' <summary>
- ''' 获取对应的 CurseForge API 请求链接。若返回 Nothing 则为不进行 CurseForge 请求。
- ''' </summary>
- Public Function GetCurseForgeAddress() As String
- If Tag.StartsWith("/") Then Storage.CurseForgeTotal = 0
- If Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset Then Return Nothing
- '应用筛选参数
- Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={CompPageSize}"
- Select Case Type
- Case CompType.Mod
- Address += "&classId=6"
- Case CompType.ModPack
- Address += "&classId=4471"
- Case CompType.ResourcePack
- 'FUTURE: Res
- End Select
- Address += "&categoryId=" & If(Tag = "", "0", Tag.Split("/").First)
- If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
- If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
- If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
- If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
- Return Address
- End Function
- ''' <summary>
- ''' 获取对应的 Modrinth API 请求链接。若返回 Nothing 则为不进行 Modrinth 请求。
- ''' </summary>
- Public Function GetModrinthAddress() As String
- If Tag.EndsWith("/") Then Storage.ModrinthTotal = 0
- If Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset Then Return Nothing
- '应用筛选参数
- Dim Address As String = $"https://api.modrinth.com/v2/search?limit={CompPageSize}&index=relevance"
- If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & Net.WebUtility.UrlEncode(SearchText)
- If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
- 'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
- Dim Facets As New List(Of String)
- Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]")
- If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.Split("/").Last}'""]")
- If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]")
- If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
- Address += "&facets=[" & String.Join(",", Facets) & "]"
- Return Address
- End Function
- '相同判断
- Public Overrides Function Equals(obj As Object) As Boolean
- Dim request = TryCast(obj, CompProjectRequest)
- Return request IsNot Nothing AndAlso
- Type = request.Type AndAlso TargetResultCount = request.TargetResultCount AndAlso
- Tag = request.Tag AndAlso ModLoader = request.ModLoader AndAlso
- GameVersion = request.GameVersion AndAlso SearchText = request.SearchText
- End Function
- Public Shared Operator =(left As CompProjectRequest, right As CompProjectRequest) As Boolean
- Return EqualityComparer(Of CompProjectRequest).Default.Equals(left, right)
- End Operator
- Public Shared Operator <>(left As CompProjectRequest, right As CompProjectRequest) As Boolean
- Return Not left = right
- End Operator
- End Class
- Public Class CompProjectStorage
- '加载位置记录
- Public CurseForgeOffset As Integer = 0
- Public CurseForgeTotal As Integer = -1
- Public ModrinthOffset As Integer = 0
- Public ModrinthTotal As Integer = -1
- '结果列表
- ''' <summary>
- ''' 可供展示的所有工程的列表。
- ''' </summary>
- Public Results As New List(Of CompProject)
- End Class
- '实际的获取
- Private Const CompPageSize = 40
- ''' <summary>
- ''' 已知工程信息的缓存。
- ''' </summary>
- Private CompProjectCache As New Dictionary(Of String, CompProject)
- ''' <summary>
- ''' 根据搜索请求获取一系列的工程列表。需要基于加载器运行。
- ''' </summary>
- Public Sub CompProjectsGet(Task As LoaderTask(Of CompProjectRequest, Integer))
- Dim Storage = Task.Input.Storage '避免多线程问题
- If Task.Input.Storage.Results.Count >= Task.Input.TargetResultCount Then
- Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,多于所需的 {Task.Input.TargetResultCount} 个结果,结束处理")
- Exit Sub
- ElseIf Not Task.Input.CanContinue Then
- If Task.Input.Storage.Results.Count = 0 Then
- Throw New Exception("没有符合条件的结果")
- Else
- Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,少于所需的 {Task.Input.TargetResultCount} 个结果,但无法继续获取,结束处理")
- Exit Sub
- End If
- End If
- #Region "拒绝 1.13- Quilt(这个版本根本没有 Quilt)"
- If Task.Input.ModLoader = CompModLoaderType.Quilt AndAlso VersionSortInteger(If(Task.Input.GameVersion, "1.15"), "1.14") = -1 Then
- Throw New Exception("Quilt 不支持 Minecraft " & Task.Input.GameVersion)
- End If
- #End Region
- #Region "处理搜索文本,赋值回 Task.Input.SearchText"
- Dim RawFilter As String = If(Task.Input.SearchText, "").Trim
- Task.Input.SearchText = RawFilter
- RawFilter = RawFilter.ToLower
- Log("[Comp] 工程列表搜索原始文本:" & RawFilter)
- '中文请求关键字处理
- Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawFilter)
- If IsChineseSearch AndAlso Task.Input.Type = CompType.Mod Then
- '构造搜索请求
- Dim SearchEntries As New List(Of SearchEntry(Of CompDatabaseEntry))
- For Each Entry In CompDatabase
- If Entry.ChineseName.Contains("动态的树") Then Continue For '这玩意儿附属太多了
- SearchEntries.Add(New SearchEntry(Of CompDatabaseEntry) With {
- .Item = Entry,
- .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
- New KeyValuePair(Of String, Double)(Entry.ChineseName & If(Entry.CurseForgeSlug, "") & If(Entry.ModrinthSlug, ""), 1)
- }
- })
- Next
- '获取搜索结果
- Dim SearchResults = Search(SearchEntries, Task.Input.SearchText, 3)
- If SearchResults.Count = 0 Then Throw New Exception("无搜索结果,请尝试搜索英文名称")
- Dim SearchResult As String = ""
- For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的,也最多只要 5 个
- If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
- If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ") & " "
- If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ") & " "
- SearchResult += SearchResults(i).Item.ChineseName.Split(" (").Last.TrimEnd(") ").Split(" - ").First.
- Replace(":", "").Replace("(", "").Replace(")", "").ToLower & " "
- Next
- Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer)
- '去除常见连接词
- Dim RealFilter As String = ""
- For Each Word In SearchResult.Split(" ")
- If {"the", "of", "a", "mod"}.Contains(Word.ToLower) OrElse Val(Word) > 0 Then Continue For
- If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For
- RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " "
- Next
- Task.Input.SearchText = RealFilter
- Log("[Comp] 中文搜索最终关键词:" & RealFilter, LogLevel.Developer)
- End If
- '驼峰英文请求关键字处理
- Dim SpacedKeywords = RegexReplace(Task.Input.SearchText, "$& ", "([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)")
- Dim ConnectedKeywords = Task.Input.SearchText.Replace(" ", "")
- Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchText, ConnectedKeywords & " " & RawFilter)).ToLower
- '最终处理关键字:分割、去重
- Dim RightKeywords As New List(Of String)
- For Each Keyword In AllPossibleKeywords.Split(" ")
- If Keyword.Trim = "" Then Continue For
- If {"forge", "fabric", "for", "mod",
- "forge/fabric", "fabric/forge", "fabric/quilt", "quilt/fabric"}.Contains(Keyword) Then '#208
- Log("[Comp] 已跳过搜索关键词:" & Keyword)
- Continue For
- End If
- RightKeywords.Add(Keyword)
- Next
- If RawFilter.Length > 0 AndAlso RightKeywords.Count = 0 Then
- Task.Input.SearchText = RawFilter '全都被过滤掉了
- Else
- Task.Input.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower
- End If
- '例外项:OptiForge、OptiFabric(拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod)
- If RawFilter.Replace(" ", "").ToLower.Contains("optiforge") Then Task.Input.SearchText = "optiforge"
- If RawFilter.Replace(" ", "").ToLower.Contains("optifabric") Then Task.Input.SearchText = "optifabric"
- Log("[Comp] 工程列表搜索最终文本:" & Task.Input.SearchText, LogLevel.Developer)
- Task.Progress = 0.1
- #End Region
- Dim RealResults As New List(Of CompProject)
- Retry:
- Dim RawResults As New List(Of CompProject)
- Dim [Error] As Exception = Nothing
- #Region "从 CurseForge 和 Modrinth 获取结果列表,存储于 RawResults"
- Dim CurseForgeThread As Thread = Nothing
- Dim ModrinthThread As Thread = Nothing
- Dim ResultsLock As New Object
- Try
- '启动 CurseForge 线程
- Dim CurseForgeUrl As String = Task.Input.GetCurseForgeAddress()
- If CurseForgeUrl IsNot Nothing Then
- CurseForgeThread = RunInNewThread(
- Sub()
- Try
- '获取工程列表
- Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
- Dim RequestResult As JObject = NetGetCodeByRequestRetry(CurseForgeUrl, IsJson:=True, Encode:=Encoding.UTF8)
- Task.Progress += 0.2
- Dim ProjectList As New List(Of CompProject)
- For Each JsonEntry As JObject In RequestResult("data")
- ProjectList.Add(New CompProject(JsonEntry))
- Next
- '更新结果
- SyncLock ResultsLock
- RawResults.AddRange(ProjectList)
- End SyncLock
- Storage.CurseForgeOffset += ProjectList.Count
- Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
- Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
- Catch ex As Exception
- Log(ex, "从 CurseForge 获取工程列表失败")
- Storage.CurseForgeTotal = Storage.CurseForgeOffset
- [Error] = ex
- End Try
- End Sub, "CurseForge Project Request")
- End If
- '启动 Modrinth 线程
- Dim ModrinthUrl As String = Task.Input.GetModrinthAddress()
- If ModrinthUrl IsNot Nothing Then
- ModrinthThread = RunInNewThread(
- Sub()
- Try
- Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
- Dim RequestResult As JObject = NetGetCodeByRequestRetry(ModrinthUrl, IsJson:=True, Encode:=Encoding.UTF8)
- Task.Progress += 0.2
- Dim ProjectList As New List(Of CompProject)
- For Each JsonEntry As JObject In RequestResult("hits")
- ProjectList.Add(New CompProject(JsonEntry))
- Next
- '更新结果
- SyncLock ResultsLock
- RawResults.AddRange(ProjectList)
- End SyncLock
- Storage.ModrinthOffset += ProjectList.Count
- Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
- Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
- Catch ex As Exception
- Log(ex, "从 Modrinth 获取工程列表失败")
- Storage.ModrinthTotal = Storage.ModrinthOffset
- [Error] = ex
- End Try
- End Sub, "Modrinth Project Request")
- End If
- '等待线程结束
- If CurseForgeThread IsNot Nothing Then CurseForgeThread.Join()
- If Task.IsAborted Then Exit Sub '会自动触发 Finally
- If ModrinthThread IsNot Nothing Then ModrinthThread.Join()
- If Task.IsAborted Then Exit Sub
- '确认存在结果
- If RawResults.Count = 0 Then
- If [Error] IsNot Nothing Then
- Throw [Error]
- Else
- If IsChineseSearch AndAlso Task.Input.Type <> CompType.Mod Then
- Throw New Exception($"{If(Task.Input.Type = CompType.ModPack, "整合包", "资源包")}搜索仅支持英文")
- Else
- Throw New Exception("没有符合条件的结果")
- End If
- End If
- End If
- Finally
- If CurseForgeThread IsNot Nothing Then CurseForgeThread.Interrupt()
- If ModrinthThread IsNot Nothing Then ModrinthThread.Interrupt()
- End Try
- #End Region
- #Region "提取非重复项,存储于 RealResults"
- '将 Modrinth 排在 CurseForge 的前面,避免加载结束顺序不同导致排名不同
- '这样做的话,去重后将优先保留 CurseForge 内容(考虑到 CurseForge 热度更高)
- RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList
- 'RawResults 去重
- RawResults = Distinct(RawResults, Function(a, b) a.IsLike(b))
- '已有内容去重
- RawResults = RawResults.Where(Function(r) Not RealResults.Any(Function(b) r.IsLike(b)) AndAlso
- Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList
- '加入列表
- RealResults.AddRange(RawResults)
- Log($"[Comp] 去重后累计新增结果 {RealResults.Count} 个")
- #End Region
- #Region "检查结果数量,如果不足且可继续,会继续加载下一页"
- If RealResults.Count + Storage.Results.Count < Task.Input.TargetResultCount Then
- Log($"[Comp] 总结果数需求最少 {Task.Input.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
- If Task.Input.CanContinue Then
- Log("[Comp] 将继续尝试加载下一页")
- GoTo Retry
- Else
- Log("[Comp] 无法继续加载,将强制结束")
- End If
- End If
- #End Region
- #Region "将结果排序并添加"
- Dim Scores As New Dictionary(Of CompProject, Double) '排序分
- If String.IsNullOrEmpty(Task.Input.SearchText) Then
- '如果没有搜索文本,按下载量将结果排序
- For Each Result As CompProject In RealResults
- Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 30))
- Next
- Else
- '如果有搜索文本,按关联度将结果排序
- '排序分 = 搜索相对相似度 (1) + 下载量权重 (对数,10 亿时为 1) + 有中文名 (0.2)
- Dim Entry As New List(Of SearchEntry(Of CompProject))
- For Each Result As CompProject In RealResults
- Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
- Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 30)) / 9)
- Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
- New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
- New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
- Next
- Dim SearchResult = Search(Entry, RawFilter, 101, -1)
- For Each OneResult In SearchResult
- Scores(OneResult.Item) += OneResult.Similarity / SearchResult(0).Similarity '最高 1 分的相似度分
- Next
- End If
- '根据排序分得出结果并添加
- Storage.Results.AddRange(
- Sort(Scores.ToList, Function(a, b) a.Value > b.Value).Select(Function(r) r.Key).ToList)
- #End Region
- End Sub
- #End Region
- #Region "CompFile | 文件信息"
- '类定义
- Public Enum CompFileStatus
- Release = 1 '枚举值来源:https://docs.curseforge.com/#tocS_FileReleaseType
- Beta = 2
- Alpha = 3
- End Enum
- Public Class CompFile
- '源信息
- ''' <summary>
- ''' 文件的种类。
- ''' </summary>
- Public ReadOnly Type As CompType
- ''' <summary>
- ''' 该文件来自 CurseForge 还是 Modrinth。
- ''' </summary>
- Public ReadOnly FromCurseForge As Boolean
- ''' <summary>
- ''' 用于唯一性鉴别该文件的 ID。CurseForge 中为 123456 的大整数,Modrinth 中为英文乱码的 Version 字段。
- ''' </summary>
- Public ReadOnly Id As String
- '描述性信息
- ''' <summary>
- ''' 文件描述名(并非文件名,是自定义的字段)。
- ''' </summary>
- Public DisplayName As String
- ''' <summary>
- ''' 发布时间。
- ''' </summary>
- Public ReadOnly ReleaseDate As Date
- ''' <summary>
- ''' 下载量计数。注意,该计数仅为一个来源,无法反应两边加起来的下载量,且 CurseForge 可能错误地返回 0。
- ''' </summary>
- Public ReadOnly DownloadCount As Integer
- ''' <summary>
- ''' 支持的 Mod 加载器列表。可能为空。
- ''' </summary>
- Public ReadOnly ModLoaders As List(Of CompModLoaderType)
- ''' <summary>
- ''' 支持的游戏版本列表。类型包括:"1.18.5","1.18","1.18 快照","21w15a","未知版本"。
- ''' </summary>
- Public ReadOnly GameVersions As List(Of String)
- ''' <summary>
- ''' 发布状态:Release/Beta/Alpha。
- ''' </summary>
- Public ReadOnly Status As CompFileStatus
- ''' <summary>
- ''' 发布状态的友好描述。例如:"正式版","Beta 版"。
- ''' </summary>
- Public ReadOnly Property StatusDescription As String
- Get
- Select Case Status
- Case CompFileStatus.Release
- Return "正式版"
- Case CompFileStatus.Beta
- Return If(ModeDebug, "Beta 版", "测试版")
- Case Else
- Return If(ModeDebug, "Alpha 版", "测试版")
- End Select
- End Get
- End Property
- '下载信息
- ''' <summary>
- ''' 下载信息是否可用。
- ''' </summary>
- Public ReadOnly Property Available As Boolean
- Get
- Return FileName IsNot Nothing
- End Get
- End Property
- ''' <summary>
- ''' 下载的文件名。
- ''' </summary>
- Public ReadOnly FileName As String = Nothing
- ''' <summary>
- ''' 文件所有可能的下载源。
- ''' </summary>
- Private ReadOnly DownloadAddress As String()
- ''' <summary>
- ''' 该文件的所有依赖工程的原始 ID。
- ''' 这些 ID 可能没有加载,在加载后会添加到 Dependencies 中(主要是因为 Modrinth 返回的是字符串 ID 而非 Slug,导致 Project.Id 查询不到)。
- ''' </summary>
- Public ReadOnly RawDependencies As New List(Of String)
- ''' <summary>
- ''' 该文件的所有依赖工程的 Project.Id。
- ''' </summary>
- Public ReadOnly Dependencies As New List(Of String)
- ''' <summary>
- ''' 获取下载信息。
- ''' </summary>
- ''' <param name="LocalAddress">目标本地文件夹,或完整的文件路径。会自动判断类型。</param>
- Public Function ToNetFile(LocalAddress As String) As NetFile
- Return New NetFile(DownloadAddress, LocalAddress & If(LocalAddress.EndsWith("\"), FileName, ""))
- End Function
- '实例化
- ''' <summary>
- ''' 从文件 Json 中初始化实例。若出错会抛出异常。
- ''' </summary>
- Public Sub New(Data As JObject, Type As CompType)
- Me.Type = Type
- FromCurseForge = Data.ContainsKey("gameId")
- If FromCurseForge Then
- #Region "CurseForge"
- '简单信息
- Id = Data("id")
- DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
- ReleaseDate = Data("fileDate")
- Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
- DownloadCount = Data("downloadCount")
- FileName = Data("fileName")
- 'DownloadAddress
- Dim Url = Data("downloadUrl").ToString
- If Url = "" Then Url = "https://media.forgecdn.net/files/" & Id.ToString.Substring(0, 4) & "/" & Id.ToString.Substring(4).TrimStart("0") & "/" & FileName
- Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
- DownloadAddress = {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
- Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
- Url.Replace("://edge", "://media"),
- Url}.Distinct.ToArray
- 'Dependencies
- If Type = CompType.Mod Then
- RawDependencies = Data("dependencies").
- Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖
- d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API
- Select(Function(d) d("modId").ToString).ToList
- End If
- 'GameVersions
- Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
- GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList
- If GameVersions.Count > 1 Then
- GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
- If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
- ElseIf GameVersions.Count = 1 Then
- GameVersions = GameVersions.ToList
- Else
- GameVersions = New List(Of String) From {"未知版本"}
- End If
- 'ModLoaders
- ModLoaders = New List(Of CompModLoaderType)
- If RawVersions.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
- If RawVersions.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
- If RawVersions.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
- #End Region
- Else
- #Region "Modrinth"
- '简单信息
- Id = Data("id")
- DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ")
- ReleaseDate = Data("date_published")
- Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
- DownloadCount = Data("downloads")
- '可能为空
- If CType(Data("files"), JArray).Count > 0 Then
- FileName = Data("files")(0)("filename")
- DownloadAddress = {Data("files")(0)("url").ToString.Replace(FileName, Net.WebUtility.UrlEncode(FileName))}
- End If
- 'Dependencies
- If Type = CompType.Mod Then
- RawDependencies = Data("dependencies").
- Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖
- d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API
- d("project_id").ToString.Length > 0). '有时候真的会空……
- Select(Function(d) d("project_id").ToString).ToList
- End If
- 'GameVersions
- Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
- GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.")).
- Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", v)).ToList
- If GameVersions.Count > 1 Then
- GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
- If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
- ElseIf GameVersions.Count = 1 Then
- GameVersions = GameVersions.ToList
- ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
- GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
- Else
- GameVersions = New List(Of String) From {"未知版本"}
- End If
- 'ModLoaders
- Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
- ModLoaders = New List(Of CompModLoaderType)
- If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
- If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
- If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
- #End Region
- End If
- End Sub
- ''' <summary>
- ''' 将当前文件信息实例化为控件。
- ''' </summary>
- Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing,
- Optional BadDisplayName As Boolean = False) As MyListItem
- '获取描述信息
- Dim Info As String = ""
- Select Case Type
- Case CompType.Mod
- Info += If(ModLoaders.Count > 0,
- "适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & ",", "")
- Info += If(ModeDebug AndAlso Dependencies.Count > 0, Dependencies.Count & " 个前置 Mod,", "")
- Case CompType.ModPack
- If GameVersions.All(Function(v) v.Contains("w")) Then
- Info += $"游戏版本 {Join(GameVersions, "、")},"
- End If
- End Select
- If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
- Info += If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载,", DownloadCount & " 次下载,")
- End If
- Info += GetTimeSpanString(ReleaseDate - Date.Now, False) & "更新"
- Info += If(Status = CompFileStatus.Release, "", "," & StatusDescription)
- '建立控件
- Dim NewItem As New MyListItem With {
- .Title = If(BadDisplayName, FileName, DisplayName),
- .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
- .Info = Info
- }
- Select Case Status
- Case CompFileStatus.Release
- NewItem.Logo = "pack://application:,,,/images/Icons/R.png"
- Case CompFileStatus.Beta
- NewItem.Logo = "pack://application:,,,/images/Icons/B.png"
- Case Else 'Alpha
- NewItem.Logo = "pack://application:,,,/images/Icons/A.png"
- End Select
- AddHandler NewItem.Click, OnClick
- '建立另存为按钮
- If OnSaveClick IsNot Nothing Then
- Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
- ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
- ToolTipService.SetVerticalOffset(BtnSave, 30)
- ToolTipService.SetHorizontalOffset(BtnSave, 2)
- AddHandler BtnSave.Click, OnSaveClick
- NewItem.Buttons = {BtnSave}
- NewItem.PaddingRight = 35
- End If
- '结束
- Return NewItem
- End Function
- '辅助函数
- Public Overrides Function ToString() As String
- Return $"{Id}: {DisplayName}"
- End Function
- End Class
- '获取
- ''' <summary>
- ''' 已知文件信息的缓存。
- ''' </summary>
- Private CompFilesCache As New Dictionary(Of String, List(Of CompFile))
- ''' <summary>
- ''' 获取某个工程下的全部文件列表。
- ''' 必须在工作线程执行,失败会抛出异常。
- ''' </summary>
- Public Function CompFilesGet(ProjectId As String, FromCurseForge As Boolean) As List(Of CompFile)
- '使用缓存
- If CompFilesCache.ContainsKey(ProjectId) Then Return CompFilesCache(ProjectId)
- '获取工程对象
- Dim TargetProject As CompProject
- If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
- TargetProject = CompProjectCache(ProjectId)
- ElseIf FromCurseForge Then 'CurseForge
- TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)("data"))
- Else 'Modrinth
- TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8))
- End If
- '获取工程对象的文件列表
- Log("[Comp] 开始获取文件列表:" & ProjectId)
- Dim ResultJsonArray As JArray
- If FromCurseForge Then
- 'CurseForge
- If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
- ResultJsonArray = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
- Else '否则使用全部文件
- ResultJsonArray = NetGetCodeByRequestRetry($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", Accept:="application/json", IsJson:=True)("data")
- End If
- Else
- 'Modrinth
- ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True)
- End If
- CompFilesCache(ProjectId) = Distinct(ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
- Where(Function(a) a.Available).ToList, Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
- '获取前置 Mod 列表
- If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId)
- Dim Deps As List(Of String) = CompFilesCache(ProjectId).
- SelectMany(Function(f) f.RawDependencies).Distinct().ToList
- Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
- '获取前置 Mod 工程信息
- If UndoneDeps.Count > 0 Then
- Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}")
- Dim Projects As JArray
- If TargetProject.FromCurseForge Then
- Projects = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods",
- "POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data")
- Else
- Projects = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]",
- Accept:="application/json", IsJson:=True)
- End If
- For Each Project In Projects
- Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存
- Next
- End If
- '更新前置 Mod 信息
- If Deps.Count > 0 Then
- For Each DepProject In Deps.Select(Function(id) CompProjectCache(id))
- For Each File In CompFilesCache(ProjectId)
- If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
- File.Dependencies.Add(DepProject.Id)
- End If
- Next
- Next
- End If
- Return CompFilesCache(ProjectId)
- End Function
- ''' <summary>
- ''' 预载包含大量 CompFile 的卡片,添加必要的元素和前置 Mod 列表。
- ''' </summary>
- Public Sub CompFilesCardPreload(Stack As StackPanel, Files As List(Of CompFile), OnClick As MyListItem.ClickEventHandler)
- '获取卡片对应的前置 ID
- '如果为整合包就不会有 Dependencies 信息,所以不用管
- Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
- Deps.Sort()
- If Deps.Count = 0 Then Exit Sub
- Deps = Deps.Where(Function(dep)
- If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
- Return CompProjectCache.ContainsKey(dep)
- End Function).ToList
- '添加开头间隔
- Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
- '添加前置 Mod 列表
- For Each Dep In Deps
- Dim Item = CompProjectCache(Dep).ToCompItem(True, True, AddressOf FrmDownloadMod.ProjectClick)
- Stack.Children.Add(Item)
- Next
- '添加结尾间隔
- Stack.Children.Add(New TextBlock With {.Text = "可选版本", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 12, 0, 5)})
- End Sub
- #End Region
- End Module
|