This commit is contained in:
龙腾猫跃
2026-05-15 22:06:22 +08:00
parent 277c020186
commit 53fe8204cf
110 changed files with 30470 additions and 4729 deletions
@@ -1,7 +1,7 @@
''' <summary>
''' 本地的社区资源文件。
''' </summary>
Public Class ResourceFile
Public Class LocalResourceFile
#Region "文件信息"
@@ -13,7 +13,7 @@ Public Class ResourceFile
Me.File = FileInfo
End Sub
Public Sub New(FullName As String)
Me.New(New FileInfo(FullName))
Me.New(FileUtils.GetInfo(FullName))
End Sub
''' <summary>
@@ -48,7 +48,7 @@ Public Class ResourceFile
''' <summary>
''' 在初始化结束之后,任何信息被后续更新时触发此事件。
''' </summary>
Public Event OnUpdate(sender As ResourceFile)
Public Event OnUpdate(sender As LocalResourceFile)
''' <summary>
''' 可读名称。
@@ -57,7 +57,7 @@ Public Class ResourceFile
Public Property Display As String
Get
If _Display Is Nothing Then _Display = ProjectVersion?.Display
If _Display Is Nothing Then _Display = Path.GetFileNameWithoutExtension(File.FullName)
If _Display Is Nothing Then _Display = PathUtils.GetFileNameWithoutExtension(File.FullName)
Return _Display
End Get
Set(value As String)
@@ -97,7 +97,7 @@ Public Class ResourceFile
Return _Version
End Get
Set(value As String)
If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
If _Version IsNot Nothing AndAlso _Version.RegexCheck("[0-9.\-]+") Then Return
If value IsNot Nothing AndAlso value.ContainsIgnoreCase("version") Then value = "version" '需要修改的标识
_Version = value
End Set
@@ -118,16 +118,15 @@ Public Class ResourceFile
Dim Jar As ZipArchive = Nothing
Try
'基础可用性检查
If File.FullName.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径(" & If(File.FullName, "null") & ")")
If Not IO.File.Exists(File.FullName) Then Throw New FileNotFoundException("未找到 Mod 文件(" & File.FullName & ")")
If Not FileUtils.Exists(File.FullName) Then Throw New FileNotFoundException("未找到 Mod 文件(" & File.FullName & ")")
'打开 Jar 文件
Jar = New ZipArchive(New FileStream(File.FullName, FileMode.Open, FileAccess.Read, FileShare.Read))
Jar = FileUtils.OpenZip(File.FullName)
'信息获取
LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException
Log(ex, $"Mod 文件由于无权限无法打开({File.FullName})", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"Mod 文件由于无权限无法打开({File.FullName})")
Catch ex As Exception
Log(ex, $"Mod 文件无法打开({File.FullName})", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"Mod 文件无法打开({File.FullName})")
Finally
If Jar IsNot Nothing Then Jar.Dispose()
End Try
@@ -140,7 +139,7 @@ Public Class ResourceFile
Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info")
Dim InfoString As String = Nothing
If InfoEntry IsNot Nothing Then
InfoString = ReadFile(InfoEntry.Open())
InfoString = InfoEntry.Open().ReadString()
If InfoString.Length < 15 Then InfoString = Nothing
End If
If InfoString Is Nothing Then Exit Try
@@ -157,7 +156,7 @@ Public Class ResourceFile
Description = InfoObject("description")
Version = InfoObject("version")
Catch ex As Exception
Log(ex, $"读取 mcmod.info 时出现未知错误({File.FullName})", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"读取 mcmod.info 时出现未知错误({File.FullName})")
End Try
#End Region
#Region "尝试使用 fabric.mod.json"
@@ -166,7 +165,7 @@ Public Class ResourceFile
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
Dim FabricText As String = Nothing
If FabricEntry IsNot Nothing Then
FabricText = ReadFile(FabricEntry.Open(), Encoding.UTF8)
FabricText = FabricEntry.Open().ReadString(Encoding.UTF8)
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
End If
If FabricText Is Nothing Then Exit Try
@@ -179,7 +178,7 @@ GotFabric:
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fabric.mod.json 时出现未知错误(" & File.FullName & ")", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"读取 fabric.mod.json 时出现未知错误({File.FullName})")
End Try
#End Region
#Region "尝试使用 mods.toml"
@@ -188,13 +187,13 @@ GotFabric:
Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml")
Dim TomlText As String = Nothing
If TomlEntry IsNot Nothing Then
TomlText = ReadFile(TomlEntry.Open())
TomlText = TomlEntry.Open().ReadString()
If TomlText.Length < 15 Then TomlText = Nothing
End If
If TomlText Is Nothing Then Exit Try
'文件标准化:统一换行符为 vbLf,去除注释、头尾的空格、空行
Dim Lines As New List(Of String)
For Each Line In TomlText.ReplaceLineEndings(vbLf).Split(vbLf) '统一换行符
For Each Line In TomlText.SplitLines(True)
If Line.StartsWithF("#") Then '去除注释
Continue For
ElseIf Line.Contains("#") Then
@@ -268,7 +267,7 @@ GotFabric:
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, $"读取 mods.toml 时出现未知错误({File.FullName})", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"读取 mods.toml 时出现未知错误({File.FullName})")
End Try
#End Region
#Region "尝试使用 fml_cache_annotation.json"
@@ -277,7 +276,7 @@ GotFabric:
Dim FmlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/fml_cache_annotation.json")
Dim FmlText As String = Nothing
If FmlEntry IsNot Nothing Then
FmlText = ReadFile(FmlEntry.Open(), Encoding.UTF8)
FmlText = FmlEntry.Open().ReadString(Encoding.UTF8)
If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing
End If
If FmlText Is Nothing Then Exit Try
@@ -305,7 +304,7 @@ Got:
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, $"读取 fml_cache_annotation.json 时出现未知错误({File.FullName})", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"读取 fml_cache_annotation.json 时出现未知错误({File.FullName})")
End Try
#End Region
Return '没能成功获取任何信息
@@ -316,7 +315,7 @@ Finished:
Try
Dim MetaEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/MANIFEST.MF")
If MetaEntry IsNot Nothing Then
Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":")
Dim MetaString As String = MetaEntry.Open().ReadString().Replace(" :", ":").Replace(": ", ":")
If MetaString.Contains("Implementation-Version:") Then
MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
@@ -324,7 +323,7 @@ Finished:
End If
End If
Catch ex As Exception
Log($"获取 META-INF 中的版本信息失败({File.FullName})", NotifyLevel.DevelopOnly)
Logger.Warn($"获取 META-INF 中的版本信息失败({File.FullName})")
Version = Nothing
End Try
End If
@@ -408,7 +407,7 @@ Finished:
''' </summary>
Public ReadOnly Property HasUpdate As Boolean
Get
Return Not Settings.Get("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
Return Not Settings.Get(Of Boolean)("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
End Get
End Property
@@ -421,13 +420,13 @@ Finished:
'读取缓存
Dim CacheKey As String = GetHash($"{EnabledFullName}-{File.LastWriteTime.ToLongTimeString}-{File.Length}-C")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" AndAlso RegexCheck(Cached, "^\d+$") Then '#5062
If Cached <> "" AndAlso Cached.RegexCheck("^\d+$") Then '#5062
_CurseForgeHash = Cached
Return _CurseForgeHash
End If
'读取文件
Dim data As New List(Of Byte)
For Each b As Byte In ReadFileBytes(File.FullName)
For Each b As Byte In FileUtils.ReadAsBytes(File.FullName)
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
data.Add(b)
Next
@@ -481,7 +480,7 @@ Finished:
Return _ModrinthHash
End If
'计算 SHA1
_ModrinthHash = GetFileSHA1(File.FullName)
_ModrinthHash = HashUtils.ComputeFromFile(File.FullName, HashUtils.HashMethod.Sha1)
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
End If
@@ -498,7 +497,7 @@ Finished:
Return File.FullName
End Function
Public Overrides Function Equals(obj As Object) As Boolean
Dim Target = TryCast(obj, ResourceFile)
Dim Target = TryCast(obj, LocalResourceFile)
Return Target IsNot Nothing AndAlso File.FullName = Target.File.FullName
End Function
@@ -1,15 +1,14 @@
Public Module ResourceFileLoader
Private Const ResourceFileCacheVersion As Integer = 16
Public Module LocalResourceLoaders
'加载 Mod 列表
Public McModLoader As New LoaderTask(Of String, List(Of ResourceFile))("Mod List Loader", AddressOf McModLoad)
Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of ResourceFile)))
Public LocalResourceLoader As New LoaderTask(Of String, List(Of LocalResourceFile))("LocalResourceLoader", AddressOf LocalResourceFileLoad)
Private Sub LocalResourceFileLoad(Loader As LoaderTask(Of String, List(Of LocalResourceFile)))
Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.ShowProgress = False)
'等待 Mod 更新完成
If PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表:" & Loader.Input)
Logger.Info($"等待 Mod 更新完成后才能继续加载 Mod 列表:{Loader.Input}")
Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
@@ -23,15 +22,15 @@
End If
'获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo)
If Directory.Exists(Loader.Input) Then
Dim ModFileList As New List(Of String)
If DirectoryUtils.Exists(Loader.Input) Then
Dim RawName As String = Loader.Input.Lower
For Each File As FileInfo In EnumerateFiles(Loader.Input)
If File.DirectoryName.Lower & "\" <> RawName Then
For Each File In DirectoryUtils.GetFiles(Loader.Input)
If File.BeforeLast("\").Lower & "\" <> RawName Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
File.Directory.Name = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then
PathUtils.GetLastPart(PathUtils.RemoveLastPart(File)) = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then
Continue For
End If
End If
@@ -44,7 +43,7 @@
FullName.EndsWithF(".jar.old", True) OrElse FullName.EndsWithF(".zip.old", True) OrElse FullName.EndsWithF(".litemod.old", True) Then Return True
Return False
End Function
If IsModFile(File.FullName) Then ModFileList.Add(File)
If IsModFile(File) Then ModFileList.Add(File)
Next
End If
@@ -52,29 +51,29 @@
Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
Dim Cache As New JObject
Try
Dim CacheContent As String = ReadFile(CachePath)
Dim CacheContent As String = FileUtils.TryReadAsString(CachePath)
If Not String.IsNullOrWhiteSpace(CacheContent) Then
Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> ResourceFileCacheVersion Then
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", NotifyLevel.DebugModeOnly)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> Versions.LOCAL_MOD_CACHE_VERSION Then
Logger.Warn($"本地 Mod 信息缓存版本已过期,将弃用这些缓存信息")
Cache = New JObject
End If
End If
Catch ex As Exception
Log(ex, "读取本地 Mod 信息缓存失败,已重置")
Logger.Warn(ex, "读取本地 Mod 信息缓存失败,已重置")
Cache = New JObject
End Try
Cache("version") = ResourceFileCacheVersion
Cache("version") = Versions.LOCAL_MOD_CACHE_VERSION
'加载 Mod 列表
Dim ModList As New List(Of ResourceFile)
For Each ModFile As FileInfo In ModFileList
Dim ModList As New List(Of LocalResourceFile)
For Each ModFile In ModFileList
If Loader.IsInterrupted Then Return
Dim ModEntry As New ResourceFile(ModFile)
Dim DumpMod As ResourceFile = ModList.FirstOrDefault(Function(m) m.EnabledName = ModEntry.EnabledName) '存在两个文件,名称相同,但一个启用一个禁用
Dim ModEntry As New LocalResourceFile(ModFile)
Dim DumpMod As LocalResourceFile = ModList.FirstOrDefault(Function(m) m.EnabledName = ModEntry.EnabledName) '存在两个文件,名称相同,但一个启用一个禁用
If DumpMod IsNot Nothing Then
Dim DisabledMod As ResourceFile = If(DumpMod.IsEnabled, ModEntry, DumpMod)
Log($"[Mod] 重复的 Mod 文件:{DumpMod.File.Name} 与 {ModEntry.File.Name},已忽略 {DisabledMod.File.Name}", NotifyLevel.DebugModeOnly)
Dim DisabledMod As LocalResourceFile = If(DumpMod.IsEnabled, ModEntry, DumpMod)
Logger.Warn($"重复的 Mod 文件:{DumpMod.File.Name} 与 {ModEntry.File.Name},已忽略 {DisabledMod.File.Name}")
If DisabledMod Is ModEntry Then
Continue For
Else
@@ -83,7 +82,7 @@
End If
ModList.Add(ModEntry)
Next
Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
Logger.Info($"共发现 {ModList.Count} 个 Mod")
'排序
ModList = ModList.OrderBy(Function(m) m.File.Name).ToList
@@ -94,33 +93,24 @@
'开始联网加载
'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of ResourceFile), JObject)(ModList, Cache), IsForceRestart:=True)
LocalResourceOnlineLoader.Start((ModList, Cache, PageInstanceLeft.Instance.Version), IsForceRestart:=True)
Catch ex As Exception
Log(ex, "Mod 列表加载失败", NotifyLevel.DebugModeOnly)
Logger.Warn(ex, "Mod 列表加载失败")
Throw
End Try
End Sub
'联网加载 Mod 详情
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of ResourceFile), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of ResourceFile), JObject), Integer))
Dim Mods As New List(Of ResourceFile)
Dim Cache As JObject = Loader.Input.Value
Static GetTargetModLoaders As Func(Of List(Of ModLoaderTypes)) =
Function() As List(Of ModLoaderTypes)
Dim Loaders As New List(Of ModLoaderTypes)
If PageInstanceLeft.Instance.Version.HasForge Then Loaders.Add(ModLoaderTypes.Forge)
If PageInstanceLeft.Instance.Version.HasNeoForge Then Loaders.Add(ModLoaderTypes.NeoForge)
If PageInstanceLeft.Instance.Version.HasFabric Then Loaders.Add(ModLoaderTypes.Fabric)
If PageInstanceLeft.Instance.Version.HasLiteLoader Then Loaders.Add(ModLoaderTypes.LiteLoader)
If Not Loaders.Any() Then Loaders.AddRange({ModLoaderTypes.Forge, ModLoaderTypes.NeoForge, ModLoaderTypes.Fabric, ModLoaderTypes.LiteLoader, ModLoaderTypes.Quilt})
Return Loaders
End Function
Public LocalResourceOnlineLoader As New LoaderTask(Of (ModList As List(Of LocalResourceFile), Cache As JObject, Target As McVersion), Integer)("LocalResourceOnlineLoader", AddressOf LocalResourceOnlineLoad)
Private Sub LocalResourceOnlineLoad(Loader As LoaderTask(Of (ModList As List(Of LocalResourceFile), Cache As JObject, Target As McVersion), Integer))
Dim Mods As New List(Of LocalResourceFile)
Dim Cache As JObject = Loader.Input.Cache
Dim ModLoaders = Loader.Input.Target.ModLoaders
'读取缓存,获取需要更新的 Mod 列表
For Each ModEntry As ResourceFile In Loader.Input.Key
For Each ModEntry As LocalResourceFile In Loader.Input.ModList
If Loader.IsInterrupted Then Return
Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("")
Dim CacheKey = ModEntry.ModrinthHash & Loader.Input.Target.VanillaName & ModLoaders
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
@@ -128,18 +118,17 @@
End If
Mods.Add(ModEntry)
Next
Log($"[Mod] 有 {Mods.Where(Function(m) m.Project Is Nothing).Count} 个 Mod 需要联网获取信息,{Mods.Where(Function(m) m.Project IsNot Nothing).Count} 个 Mod 需要更新信息")
Logger.Info($"有 {Mods.Where(Function(m) m.Project Is Nothing).Count} 个 Mod 需要联网获取信息,{Mods.Where(Function(m) m.Project IsNot Nothing).Count} 个 Mod 需要更新信息")
If Not Mods.Any Then
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar()) '从 JAR 中获取缺失的版本信息(下面有另一个分支)
Loader.Input.ModList.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar()) '从 JAR 中获取缺失的版本信息(下面有另一个分支)
Return
End If
'获取作为检查目标的加载器和版本
'此处不应向下扩展检查的 MC 小版本,例如 Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
Dim TargetMcVersion As McVersion = PageInstanceLeft.Instance.Version
Dim ModLoaders = GetTargetModLoaders()
Dim TargetMcVersion As McVersion = Loader.Input.Target
Dim VanillaVersion = TargetMcVersion.VanillaName
'开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{VanillaVersion}")
Logger.Info($"目标加载器:{ModLoaders},版本:{VanillaVersion}")
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim CurrentTaskThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
@@ -150,16 +139,16 @@
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthVersion As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
Logger.Info($"从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If ModrinthVersion.Count = 0 Then Return
Dim ModrinthMapping As New Dictionary(Of String, List(Of ResourceFile))
Dim ModrinthMapping As New Dictionary(Of String, List(Of LocalResourceFile))
For Each Entry In Mods
If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
If ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash Then Continue For
Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString
If ResourceProject.Cache.ContainsKey(ProjectId) AndAlso Entry.Project Is Nothing Then Entry.Project = ResourceProject.Cache(ProjectId) '读取已加载的缓存,加快结果出现速度
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of ResourceFile)
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of LocalResourceFile)
ModrinthMapping(ProjectId).Add(Entry)
'记录对应的 ProjectVersion
Dim File = ResourceVersion.FromPlatformJson(ModrinthVersion(Entry.ModrinthHash), ResourceTypes.Mod)
@@ -170,7 +159,7 @@
End If
Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
Logger.Info($"需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Return
Dim ModrinthProject As JArray = DlModRequest(
@@ -181,16 +170,20 @@
Entry.Project = Project
Next
Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
Logger.Info($"已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息
If ModLoaders = ModLoaders.None Then
Logger.Warn("该 Minecraft 版本没有可用的 Mod 加载器,不获取 Mod 更新信息")
Return
End If
Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").Lower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
""loaders"": [""{ModLoaders.Flags.Join(""",""").Lower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.ProjectVersion Is Nothing Then Continue For
Dim UpdateFile = ResourceVersion.FromPlatformJson(ModrinthUpdate(Entry.ModrinthHash), ResourceTypes.Mod)
If Not UpdateFile.DownloadAvailable Then Continue For
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.ProjectVersion.FileName} 在 Modrinth 上的最新版为 {UpdateFile.FileName}")
Logger.Trace(Function() $"本地文件 {Entry.ProjectVersion.FileName} 在 Modrinth 上的最新版为 {UpdateFile.FileName}")
If Entry.ProjectVersion.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.ProjectVersion.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
@@ -202,9 +195,9 @@
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
Logger.Info($"从 Modrinth 获取本地 Mod 信息结束")
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
Logger.Warn(ex, "从 Modrinth 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
@@ -215,90 +208,92 @@
Sub()
Try
'步骤 1:获取 Hash 与对应的工程 ID
Dim CurseForgeHashes As New List(Of UInteger)
Dim Hashes As New List(Of UInteger)
For Each Entry In Mods
CurseForgeHashes.Add(Entry.CurseForgeHash)
Hashes.Add(Entry.CurseForgeHash)
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Next
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
$"{{""fingerprints"": [{Hashes.Join(",")}]}}", "application/json")("data")("exactMatches")
Logger.Info($"从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
If Not CurseForgeRaw.Any() Then Return
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of ResourceFile))
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
Dim ProjectIdToLocalFiles As New Dictionary(Of Integer, List(Of LocalResourceFile))
For Each Project In CurseForgeRaw
Dim ProjectId = Project("id").ToString
Dim Hash As UInteger = Project("file")("fileFingerprint")
For Each Entry In Mods
If Entry.CurseForgeHash <> Hash Then Continue For
If ResourceProject.Cache.ContainsKey(ProjectId) AndAlso Entry.Project Is Nothing Then Entry.Project = ResourceProject.Cache(ProjectId) '读取已加载的缓存,加快结果出现速度
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of ResourceFile)
CurseForgeMapping(ProjectId).Add(Entry)
ProjectIdToLocalFiles.AddIntoValueCollection(ProjectId, Entry)
'记录对应的 ProjectVersion
Dim File = ResourceVersion.FromPlatformJson(Project("file"), ResourceTypes.Mod)
If Entry.ProjectVersion Is Nothing OrElse Entry.ProjectVersion.ReleaseDate < File.ReleaseDate Then Entry.ProjectVersion = File
Next
Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
Logger.Info($"需要从 CurseForge 获取 {ProjectIdToLocalFiles.Count} 个本地 Mod 的工程信息")
If Not ProjectIdToLocalFiles.Any() Then Return
'步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Return
Dim CurseForgeProject = DlModRequest("https://api.curseforge.com/v1/mods", HttpMethod.Post,
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of ResourceFile)) 'FileId -> 本地 Mod 文件列表
$"{{""modIds"": [{ProjectIdToLocalFiles.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of LocalResourceFile)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject
If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息
Dim Project As New ResourceProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Project IsNot Nothing AndAlso Entry.Project.Platform = ResourcePlatforms.Modrinth Then
Entry.Project = Entry.Project '再次触发修改事件
Continue For
Dim TargetLoaders As ModLoaders = ModLoaders.None
For Each LocalFile In ProjectIdToLocalFiles(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If LocalFile.Project?.Platform = ResourcePlatforms.Modrinth Then
LocalFile.Project = LocalFile.Project '再次触发修改事件
Else
LocalFile.Project = Project
TargetLoaders = TargetLoaders Or LocalFile.Project.ModLoaders
End If
Entry.Project = Project
Next
TargetLoaders = TargetLoaders And ModLoaders '与目标 MC 版本的加载器取交集
'查找或许版本更新的文件列表
If ModLoaders.IsSingle Then
Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes")
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion")
If IndexVersion <> VanillaVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
If NewestVersion IsNot Nothing AndAlso CompareVersion(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then
NewestVersion = IndexVersion
NewestFileIds.Clear()
End If
NewestFileIds.Add(IndexEntry("fileId").ToObject(Of Integer))
Next
For Each FileId In NewestFileIds
If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of ResourceFile)
UpdateFileIds(FileId).AddRange(CurseForgeMapping(Project.Id))
FileIdToProjectSlug(FileId) = Project.Slug
Next
End If
If ModLoaders = ModLoaders.None Then Continue For '无法判断 MC 版本使用的加载器,跳过更新检查
Dim LatestFiles = ProjectJson("latestFilesIndexes").Where(
Function(Entry)
'Mod Loader 匹配
If Entry("modLoader") Is Nothing Then Return False
Dim EntryLoader As ModLoaders = Resource.FromCurseForgeModLoaderType(Entry("modLoader").ToObject(Of Integer))
If Not TargetLoaders.HasFlag(EntryLoader) Then Return False
'MC 版本匹配
Dim EntryVersion As String = Entry("gameVersion")
Return EntryVersion IsNot Nothing AndAlso EntryVersion = VanillaVersion
End Function).
MaxByAll(Function(Entry) Entry("gameVersion").ToString, New VersionComparer) '只保留最新的 MC 版本
For Each Entry In LatestFiles
Dim FileId = Entry("fileId").ToObject(Of Integer)
If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of LocalResourceFile)
UpdateFileIds(FileId).AddRange(ProjectIdToLocalFiles(Project.Id))
FileIdToProjectSlug(FileId) = Project.Slug
Next
Next
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息
Logger.Info($"已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
If Not UpdateFileIds.Any() Then Return
'步骤 4:获取更新文件信息
Dim CurseForgeFiles = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post,
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFiles As New Dictionary(Of ResourceFile, ResourceVersion)
Dim UpdateFiles As New Dictionary(Of LocalResourceFile, ResourceVersion)
For Each FileJson In CurseForgeFiles
Dim File = ResourceVersion.FromPlatformJson(FileJson, ResourceTypes.Mod)
If Not File.DownloadAvailable Then Continue For
For Each Entry As ResourceFile In UpdateFileIds(File.Id)
For Each Entry As LocalResourceFile In UpdateFileIds(File.Id)
If UpdateFiles.ContainsKey(Entry) AndAlso UpdateFiles(Entry).ReleaseDate >= File.ReleaseDate Then Continue For
UpdateFiles(Entry) = File
Next
Next
For Each Pair In UpdateFiles
Dim Entry As ResourceFile = Pair.Key
Dim Entry As LocalResourceFile = Pair.Key
Dim UpdateFile As ResourceVersion = Pair.Value
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.ProjectVersion.FileName} 在 CurseForge 上的最新版为 {UpdateFile.FileName}")
Logger.Trace(Function() $"本地文件 {Entry.ProjectVersion.FileName} 在 CurseForge 上的最新版为 {UpdateFile.FileName}")
If Entry.ProjectVersion.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.ProjectVersion.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
@@ -309,16 +304,17 @@
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
Logger.Info($"从 CurseForge 获取 Mod 更新信息结束")
Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
Logger.Warn(ex, "从 CurseForge 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader CurseForge")
'从 JAR 中获取缺失的版本信息(上面有另一个分支)
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar())
Loader.Input.ModList.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar())
'等待线程结束
Do Until EndedThreadCount = 2
Thread.Sleep(10)
@@ -326,11 +322,12 @@
Loop
'保存缓存
Mods = Mods.Where(Function(m) m.Project IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
Logger.Info($"联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Return
If Loader.IsInterrupted Then Return
For Each Entry In Mods
Entry.OnlineDataLoaded = Not IsFailed
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = Entry.ToJson()
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders) = Entry.ToJson()
Next
FileUtils.Write(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
@@ -342,4 +339,4 @@
End If
End Sub
End Module
End Module
@@ -52,9 +52,9 @@ Public Class ResourceProject
''' </summary>
Public ReadOnly DownloadCount As Integer
''' <summary>
''' 支持的 Mod 加载器列表。可能为空。
''' 所有支持的 Mod 加载器。可能为 <see cref="ModLoaders.None"/>。
''' </summary>
Public ReadOnly Loaders As List(Of ModLoaderTypes)
Public ReadOnly ModLoaders As ModLoaders = ModLoaders.None
''' <summary>
''' 描述性标签的内容。已转换为中文。
''' </summary>
@@ -133,11 +133,7 @@ Public Class ResourceProject
Website = Data("Website")
LastUpdate = Data("LastUpdate")
DownloadCount = Data("DownloadCount")
If Data.ContainsKey("ModLoaders") Then
Loaders = CType(Data("ModLoaders"), JArray).Select(Function(t) CType(t.ToObject(Of Integer), ModLoaderTypes)).ToList
Else
Loaders = New List(Of ModLoaderTypes)
End If
If Data.ContainsKey("ModLoaders") Then ModLoaders = Data("ModLoaders").ToObject(Of Integer)
Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList
If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl")
If Data.ContainsKey("Drops") Then
@@ -181,12 +177,12 @@ Public Class ResourceProject
Types = ResourceTypes.DataPack
End If
'FileIndexes / VanillaMajorVersions / ModLoaders
Loaders = New List(Of ModLoaderTypes)
ModLoaders = ModLoaders.None
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
For Each File In If(Data("latestFiles"), New JArray)
Dim NewFile = ResourceVersion.FromPlatformJson(File, Types)
If Not NewFile.DownloadAvailable Then Continue For
Loaders.AddRange(NewFile.Loaders)
ModLoaders = ModLoaders Or NewFile.ModLoaders
Dim GameVersions = File("gameVersions").ToObject(Of List(Of String))
If Not GameVersions.Any(Function(v) McVersion.IsFormatFit(v)) Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions))
@@ -198,7 +194,6 @@ Public Class ResourceProject
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
Drops = Files.SelectMany(Function(f) f.Value).
Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v <> 209).Distinct.OrderByDescending(Function(v) v).ToList
Loaders = Loaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Tags
Tags = New List(Of String)
For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段 (4267#issuecomment-2254590831)
@@ -303,24 +298,17 @@ Public Class ResourceProject
End Select
'Tags & ModLoaders
Tags = New List(Of String)
Loaders = New List(Of ModLoaderTypes)
If Data.ContainsKey("loaders") Then
For Each Category In Data("loaders").Select(Function(t) t.ToString)
Select Case Category
Case "forge" : Loaders.Add(ModLoaderTypes.Forge)
Case "fabric" : Loaders.Add(ModLoaderTypes.Fabric)
Case "quilt" : Loaders.Add(ModLoaderTypes.Quilt)
Case "neoforge" : Loaders.Add(ModLoaderTypes.NeoForge)
End Select
ModLoaders = ModLoaders.None
For Each Category In If(Data("loaders")?.Select(Function(t) t.ToString), {}).Concat(Data("categories").Select(Function(t) t.ToString))
For Each Loader In EnumUtils.GetAllFlags(Of ModLoaders)()
If Category = Loader.ToString.Lower Then
ModLoaders = ModLoaders Or Loader
Exit For
End If
Next
End If
Next
For Each Category In Data("categories").Select(Function(t) t.ToString)
Select Case Category
'加载器
Case "forge" : Loaders.Add(ModLoaderTypes.Forge)
Case "fabric" : Loaders.Add(ModLoaderTypes.Fabric)
Case "quilt" : Loaders.Add(ModLoaderTypes.Quilt)
Case "neoforge" : Loaders.Add(ModLoaderTypes.NeoForge)
Case "datapack" : Types = ResourceTypes.DataPack
'共用
Case "technology" : Tags.Add("科技")
@@ -388,12 +376,11 @@ Public Class ResourceProject
Case "vanilla" : Tags.Add("原版可用")
End Select
Next
If Types = ResourceTypes.DataPack AndAlso Loaders.Any Then Types = ResourceTypes.DataPack Or ResourceTypes.Mod
If Types = ResourceTypes.DataPack AndAlso ModLoaders <> ModLoaders.None Then Types = ResourceTypes.DataPack Or ResourceTypes.Mod
#End Region
End If
If Not Tags.Any() Then Tags.Add("其他")
Tags.Sort()
Loaders.Sort()
End If
'保存缓存
Cache(Id) = Me
@@ -454,7 +441,7 @@ Public Class ResourceProject
Json("Website") = Website
Json("LastUpdate") = LastUpdate
Json("DownloadCount") = DownloadCount
If Loaders IsNot Nothing AndAlso Loaders.Any Then Json("ModLoaders") = New JArray(Loaders.Select(Function(m) CInt(m)))
If ModLoaders <> ModLoaders.None Then Json("ModLoaders") = ModLoaders
Json("Tags") = New JArray(Tags)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If Drops.Any Then Json("Drops") = New JArray(Drops)
@@ -514,13 +501,13 @@ Public Class ResourceProject
End If
'获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
Dim ModLoadersForDesc As New List(Of ModLoaderTypes)(Loaders)
If Settings.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(ModLoaderTypes.Quilt)
Dim ModLoadersForDesc = ModLoaders.Flags().ToList()
If Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(ModLoaders.Quilt)
Select Case ModLoadersForDesc.Count
Case 0
If Loaders.IsSingle Then
ModLoaderDescriptionFull = "仅 " & Loaders.Single.ToString
ModLoaderDescriptionPart = Loaders.Single.ToString
If ModLoadersForDesc.IsSingle Then
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
Else
ModLoaderDescriptionFull = "未知"
ModLoaderDescriptionPart = ""
@@ -530,10 +517,10 @@ Public Class ResourceProject
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
Case Else
Dim NewestDrop As Integer = If(Drops.Any, Drops.First, 9999)
If Loaders.Contains(ModLoaderTypes.Forge) AndAlso
(NewestDrop < 140 OrElse Loaders.Contains(ModLoaderTypes.Fabric)) AndAlso
(NewestDrop < 200 OrElse Loaders.Contains(ModLoaderTypes.NeoForge)) AndAlso
(NewestDrop < 140 OrElse Loaders.Contains(ModLoaderTypes.Quilt) OrElse Settings.Get("ToolDownloadIgnoreQuilt")) Then
If ModLoadersForDesc.Contains(ModLoaders.Forge) AndAlso
(NewestDrop < 140 OrElse ModLoadersForDesc.Contains(ModLoaders.Fabric)) AndAlso
(NewestDrop < 200 OrElse ModLoadersForDesc.Contains(ModLoaders.NeoForge)) AndAlso
(NewestDrop < 140 OrElse ModLoadersForDesc.Contains(ModLoaders.Quilt) OrElse Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt")) Then
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
Else
@@ -596,7 +583,7 @@ Public Class ResourceProject
If TranslatedName = RawName Then
'没有中文翻译
'将所有名称分段
Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, True).
Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w))
If NameLists.IsSingle Then GoTo NoSubtitle
'查找其中的缩写、Forge/Fabric 等版本标记
@@ -608,7 +595,7 @@ Public Class ResourceProject
'缩写
SubtitleList.Add(Name)
ElseIf {"neoforge", "forge", "fabric", "quilt"}.Any(Function(l) LowerName.Contains(l)) AndAlso
Not RegexCheck(LowerName.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", ""), "[a-z]+") Then '去掉关键词后没有其他字母
Not LowerName.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", "").RegexCheck("[a-z]+") Then '去掉关键词后没有其他字母
'Forge/Fabric 等版本标记
SubtitleList.Add(Name)
Else
@@ -631,7 +618,7 @@ Public Class ResourceProject
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
'中段的额外信息截取
SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, True).
Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList
If SubtitleList.Count > 1 AndAlso
Not SubtitleList.Any(Function(s) s.Lower.Contains("forge") OrElse s.Lower.Contains("fabric") OrElse s.Lower.Contains("quilt")) AndAlso '不是标注 XX 版
@@ -690,16 +677,16 @@ NoSubtitle:
'来自不同的网站
If Platform = Project.Platform Then Return False
'Mod 加载器一致
If Loaders.Count <> Project.Loaders.Count OrElse Loaders.Except(Project.Loaders).Any() Then Return False
If ModLoaders <> Project.ModLoaders Then Return False
'若不为光影,则要求 MC 版本一致
If Types <> ResourceTypes.Shader AndAlso (Drops.Count <> Project.Drops.Count OrElse Drops.Except(Project.Drops).Any()) Then Return False
If Types <> ResourceTypes.Shader AndAlso Drops.Ordered.SequenceEqual(Project.Drops.Ordered) Then Return False
'最近更新时间差距在一周以内
If Math.Abs((LastUpdate - Project.LastUpdate).TotalDays) > 7 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($"[Resource] 将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程")
Logger.Info($"将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程")
'如果只有一个有 DatabaseEntry,设置给另外一个
If WikiEntry Is Nothing AndAlso Project.WikiEntry IsNot Nothing Then WikiEntry = Project.WikiEntry
If WikiEntry IsNot Nothing AndAlso Project.WikiEntry Is Nothing Then Project.WikiEntry = WikiEntry
@@ -40,8 +40,10 @@
Public Tag As String = ""
''' <summary>
''' 筛选 Mod 加载器类别。
''' <see cref="ModLoaders.None"/> 代表不筛选。
''' 对于 Modrinth 请求,支持多个枚举值。
''' </summary>
Public ModLoader As ModLoaderTypes = ModLoaderTypes.Any
Public ModLoaders As ModLoaders = ModLoaders.None
''' <summary>
''' 筛选 MC 版本。
''' </summary>
@@ -82,7 +84,7 @@
Address += "&classId=12"
End Select
If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/")
If ModLoader <> ModLoaderTypes.Any AndAlso Not IgnoreModLoaderFilter Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
If ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then Address += "&modLoaderType=" & Resource.ToCurseForgeModLoaderType(ModLoaders.Flags.First)
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & EscapeUtils.UrlEscape(SearchText)
If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
@@ -97,11 +99,13 @@
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={RESULT_PAGE_SIZE}&index=relevance"
If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & EscapeUtils.UrlEscape(SearchText)
If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
'facets=[["categories:'game-mechanics'"],["categories:'forge',categories:'fabric'"],["versions:1.19.3"],["project_type:mod"]]
Dim Facets As New List(Of String)
Facets.Add($"[""project_type:{Type.ToString.Lower}""]")
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
If ModLoader <> ModLoaderTypes.Any AndAlso Not IgnoreModLoaderFilter Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).Lower}'""]")
If ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then
Facets.Add($"[""categories:'{ModLoaders.Flags.Select(Function(f) f.ToString.Lower).Join("',categories:'")}'""]")
End If
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
Address += "&facets=[" & String.Join(",", Facets) & "]"
Return Address
@@ -112,7 +116,7 @@
Dim request = TryCast(obj, SearchRequest)
Return request IsNot Nothing AndAlso
Type = request.Type AndAlso TargetResultCount = request.TargetResultCount AndAlso
Tag = request.Tag AndAlso ModLoader = request.ModLoader AndAlso Sources = request.Sources AndAlso
Tag = request.Tag AndAlso ModLoaders = request.ModLoaders AndAlso Sources = request.Sources AndAlso
GameVersion = request.GameVersion AndAlso SearchText = request.SearchText
End Function
Public Shared Operator =(left As SearchRequest, right As SearchRequest) As Boolean
@@ -122,7 +126,7 @@
Return Not left = right
End Operator
Public Overrides Function GetHashCode() As Integer
Return (Type, Tag, ModLoader, GameVersion, SearchText, Sources).GetHashCode()
Return (Type, Tag, ModLoaders, GameVersion, SearchText, Sources).GetHashCode()
End Function
End Class
@@ -164,19 +168,19 @@
#Region "前置检查"
If Storage.Results.Count >= Request.TargetResultCount Then
Log($"[Resource] 已有 {Storage.Results.Count} 个结果,多于所需的 {Request.TargetResultCount} 个结果,结束处理")
Logger.Info($"已有 {Storage.Results.Count} 个结果,多于所需的 {Request.TargetResultCount} 个结果,结束处理")
Return
ElseIf Not Request.CanContinue Then
If Not Storage.Results.Any() Then
Throw New Exception("没有符合条件的结果")
Else
Log($"[Resource] 已有 {Storage.Results.Count} 个结果,少于所需的 {Request.TargetResultCount} 个结果,但无法继续获取,结束处理")
Logger.Info($"已有 {Storage.Results.Count} 个结果,少于所需的 {Request.TargetResultCount} 个结果,但无法继续获取,结束处理")
Return
End If
End If
'拒绝 1.13- Quilt(这个版本根本没有 Quilt)
If Request.ModLoader = ModLoaderTypes.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
If Request.ModLoaders = ModLoaders.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
End If
@@ -186,10 +190,10 @@
Dim RawSearchText As String = If(Request.SearchText, "").Trim
RawSearchText = RawSearchText.Lower
Log("[Resource] 工程列表搜索原始文本:" & RawSearchText)
Logger.Info($"工程列表搜索原始文本:{RawSearchText}")
Dim IsChineseSearch As Boolean =
RegexCheck(RawSearchText, "[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawSearchText) AndAlso
RawSearchText.RegexCheck("[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawSearchText) AndAlso
(Request.Type = ResourceTypes.Mod OrElse Request.Type = ResourceTypes.DataPack) '目前仅对 Mod 和数据包进行中文搜索,注意整合包的名称可能已经有中文了
Dim CurseForgeAltSearchText As String = Nothing, ModrinthAltSearchText As String = Nothing, ModrinthSlugs As New List(Of String) '从中文转为英文的替代搜索内容
If IsChineseSearch Then
@@ -231,7 +235,7 @@
Function(Entry) New SearchEntry(Of WikiEntry) With {
.Item = Entry,
.SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split("/"c, True), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.CurseForgeSlug, 0.5)}
}).ToList
Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25)
@@ -244,7 +248,7 @@
MaxBy(Function(s) s.Item.Popularity) '然后从中选择最受欢迎的那一个
'后处理
CurseForgeAltSearchText = ExtractWords(CurseForgeTarget, ResourcePlatforms.CurseForge).Join(" ")
Log("[Resource] 中文搜索关键词(CurseForge):" & CurseForgeAltSearchText, NotifyLevel.DebugModeOnly)
Logger.Warn($"中文搜索关键词(CurseForge):{CurseForgeAltSearchText}")
End If
End If
'Modrinth
@@ -255,7 +259,7 @@
Function(Entry) New SearchEntry(Of WikiEntry) With {
.Item = Entry,
.SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split("/"c, True), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.ModrinthSlug, 0.5)}
}).ToList
Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25)
@@ -270,7 +274,7 @@
Next
Next
ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key
Log("[Resource] 中文搜索关键词(Modrinth):" & ModrinthAltSearchText, NotifyLevel.DebugModeOnly)
Logger.Warn($"中文搜索关键词(Modrinth):{ModrinthAltSearchText}")
'直接请求工程
ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.ModrinthSlug).ToList
End If
@@ -295,7 +299,7 @@ NextPage:
'在 1.14-,部分老 Mod 没有设置支持的加载器,因此添加 Forge 筛选就会出现遗漏
'所以,在发起请求时不筛选加载器,然后在返回的结果中自行筛除不是 Forge 的 Mod
Dim IgnoreModLoaderFilter = Request.ModLoader = ModLoaderTypes.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140
Dim IgnoreModLoaderFilter = Request.ModLoaders = ModLoaders.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140
Try
'CurseForge 搜索
@@ -307,21 +311,22 @@ NextPage:
Try
'获取工程列表
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress(If(CurseForgeAltSearchText, RawSearchText), IgnoreModLoaderFilter)
Log("[Resource] 开始 CurseForge 搜索:" & CurseForgeUrl)
Logger.Info($"开始 CurseForge 搜索:{CurseForgeUrl}")
Dim RequestResult As JObject = DlModRequest(CurseForgeUrl)
Dim ProjectList As New List(Of ResourceProject)
For Each JsonEntry As JObject In RequestResult("data")
Dim Project As New ResourceProject(JsonEntry)
If Request.Type = ResourceTypes.ResourcePack AndAlso Project.Tags.Contains("数据包") Then Continue For 'CurseForge 将一些数据包分类成了资源包
If Request.Type <> ResourceTypes.Any AndAlso Not Project.Types.HasFlag(Request.Type) Then Continue For '过滤分区不匹配的搜索结果(#8265)
ProjectList.Add(Project)
Next
'更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p))
Storage.CurseForgeOffset += RequestResult("data").Count
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
Log($"[Resource] 从 CurseForge 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
Logger.Info($"从 CurseForge 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
Catch ex As Exception
Log(ex, "CurseForge 搜索失败")
Logger.Warn(ex, "CurseForge 搜索失败")
Storage.CurseForgeTotal = -1
Errors.Add((ex, ResourcePlatforms.CurseForge))
End Try
@@ -337,7 +342,7 @@ NextPage:
Sub()
Try
Dim ModrinthUrl As String = Request.GetModrinthAddress(If(ModrinthAltSearchText, RawSearchText), IgnoreModLoaderFilter)
Log("[Resource] 开始 Modrinth 搜索:" & ModrinthUrl)
Logger.Info($"开始 Modrinth 搜索:{ModrinthUrl}")
Dim RequestResult As JObject = DlModRequest(ModrinthUrl)
Dim ProjectList As New List(Of ResourceProject)
For Each JsonEntry As JObject In RequestResult("hits")
@@ -347,9 +352,9 @@ NextPage:
ProjectList.ForEach(Sub(p) RawResults.Add(p))
Storage.ModrinthOffset += RequestResult("hits").Count
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
Log($"[Resource] 从 Modrinth 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
Logger.Info($"从 Modrinth 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
Catch ex As Exception
Log(ex, "Modrinth 搜索失败")
Logger.Warn(ex, "Modrinth 搜索失败")
Storage.ModrinthTotal = -1
Errors.Add((ex, ResourcePlatforms.Modrinth))
End Try
@@ -365,7 +370,7 @@ NextPage:
Sub()
Try
Dim ModrinthUrl As String = $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthSlugs.Join(""",""")}""]"
Log("[Resource] 开始 Modrinth 直接获取:" & ModrinthUrl)
Logger.Info($"开始 Modrinth 直接获取:{ModrinthUrl}")
Dim ProjectList As New List(Of ResourceProject)
For Each JsonEntry As JObject In DlModRequest(ModrinthUrl)
Dim Project As New ResourceProject(JsonEntry)
@@ -373,18 +378,18 @@ NextPage:
If Request.Type <> ResourceTypes.Any AndAlso Not Project.Types.HasFlag(Request.Type) Then Continue For
If Not String.IsNullOrEmpty(Request.Tag) AndAlso
Not JsonEntry("categories").Any(Function(c) c.ToString = Request.Tag.AfterLast("/")) Then Continue For 'Project.Tags 已经转换成中文了,只能从 json 判
If Request.ModLoader <> ModLoaderTypes.Any AndAlso Not IgnoreModLoaderFilter AndAlso
Not Project.Loaders.Any(Function(m) m = Request.ModLoader) Then Continue For
If Request.ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter AndAlso
Not Project.ModLoaders.Flags.Intersect(Request.ModLoaders.Flags).Any() Then Continue For
If Not String.IsNullOrEmpty(Request.GameVersion) AndAlso
Not Project.UnsafeGameVersions.Any(Function(d) d = Request.GameVersion) Then Continue For
ProjectList.Add(Project)
Next
'更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p))
Log($"[Resource] 从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
Logger.Info($"从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
Catch ex As Exception
Log(ex, "Modrinth 直接获取失败")
Logger.Warn(ex, "Modrinth 直接获取失败")
Errors.Add((ex, ResourcePlatforms.Modrinth))
End Try
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页,所以不能直接给够
@@ -397,9 +402,9 @@ NextPage:
If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程
Next
'筛除不是 Forge 的 Mod
'仅保留兼容 Forge 的 Mod,或老版本中没有标注任何 Mod Loader 的 Mod
If IgnoreModLoaderFilter Then
RawResults = RawResults.Where(Function(p) Not p.Loaders.Any() OrElse p.Loaders.Contains(ModLoaderTypes.Forge)).ToList
RawResults.KeepIf(Function(p) p.ModLoaders = ModLoaders.None OrElse p.ModLoaders.HasFlag(ModLoaders.Forge))
End If
'确保存在结果
@@ -446,19 +451,19 @@ NextPage:
Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList
'加入列表
RealResults.AddRange(RawResults)
Log($"[Resource] 去重、筛选后累计新增结果 {RealResults.Count} 个(目前已有结果 {Storage.Results.Count} 个)")
Logger.Info($"去重、筛选后累计新增结果 {RealResults.Count} 个(目前已有结果 {Storage.Results.Count} 个)")
#End Region
#Region "检查结果数量,如果不足且可继续,会继续加载下一页"
If RealResults.Count + Storage.Results.Count < Request.TargetResultCount Then
Log($"[Resource] 总结果数需求最少 {Request.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
Logger.Info($"总结果数需求最少 {Request.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
If Request.CanContinue AndAlso Not Errors.Any Then '如果有某个源失败则不再重试,这时候重试可能导致无限循环
Log("[Resource] 将继续尝试加载下一页")
Logger.Info("将继续尝试加载下一页")
GoTo NextPage
Else
Log("[Resource] 无法继续加载,将强制结束")
Logger.Info("无法继续加载,将强制结束")
End If
End If
@@ -493,7 +498,7 @@ NextPage:
Scores(Result) = If(Result.WikiId > 0, 0.2, 0) +
Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9
SearchEntries.Add(New SearchEntry(Of ResourceProject) With {.Item = Result, .SearchSource = New List(Of SearchSource) From {
New SearchSource(If(IsChineseSearch, Result.TranslatedName, Result.RawName).Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1),
New SearchSource(If(IsChineseSearch, Result.TranslatedName, Result.RawName).Split("/"c, True), 1),
New SearchSource(Result.Description, 0.05)}})
Next
Dim SearchResult = Search(SearchEntries, RawSearchText, 10000, -1)
@@ -36,10 +36,9 @@ Public Class ResourceVersion
''' </summary>
Public Version As String
''' <summary>
''' 支持的 Mod 加载器列表。
''' 可能为空列表,不为 Nothing。
''' 所有支持的 Mod 加载器列表。可能为 <see cref="ModLoaders.None"/>。
''' </summary>
Public Loaders As List(Of ModLoaderTypes)
Public ModLoaders As ModLoaders = ModLoaders.None
''' <summary>
''' 支持的游戏版本列表。类型包括:"26.1.5","26.1","26.1 预览版","1.18.5","1.18","1.18 预览版","21w15a","未知版本"。
''' </summary>
@@ -158,11 +157,10 @@ Public Class ResourceVersion
.GameVersions = New List(Of String) From {"未知版本"}
End If
'ModLoaders
.Loaders = New List(Of ModLoaderTypes)
If RawVersions.Contains("forge") Then .Loaders.Add(ModLoaderTypes.Forge)
If RawVersions.Contains("fabric") Then .Loaders.Add(ModLoaderTypes.Fabric)
If RawVersions.Contains("quilt") Then .Loaders.Add(ModLoaderTypes.Quilt)
If RawVersions.Contains("neoforge") Then .Loaders.Add(ModLoaderTypes.NeoForge)
.ModLoaders = ModLoaders.None
For Each Loader In EnumUtils.GetAllFlags(Of ModLoaders)()
If RawVersions.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader
Next
#End Region
Else
#Region "Modrinth"
@@ -183,14 +181,13 @@ Public Class ResourceVersion
'Loaders
'结果可能混杂着 Mod、数据包和服务端插件
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
.Loaders = New List(Of ModLoaderTypes)
.ModLoaders = ModLoaders.None
If .ResourceType.HasFlag(ResourceTypes.Mod) OrElse .ResourceType.HasFlag(ResourceTypes.DataPack) Then
If RawLoaders.Intersect({"bukkit", "folia", "paper", "purpur", "spigot"}).Any() Then .ResourceType = ResourceTypes.Plugin 'Veinminer Enchantment 同时支持服务端与 Fabric
If RawLoaders.Contains("datapack") Then .ResourceType = ResourceTypes.DataPack
If RawLoaders.Contains("forge") Then .Loaders.Add(ModLoaderTypes.Forge) : .ResourceType = ResourceTypes.Mod
If RawLoaders.Contains("neoforge") Then .Loaders.Add(ModLoaderTypes.NeoForge) : .ResourceType = ResourceTypes.Mod
If RawLoaders.Contains("fabric") Then .Loaders.Add(ModLoaderTypes.Fabric) : .ResourceType = ResourceTypes.Mod
If RawLoaders.Contains("quilt") Then .Loaders.Add(ModLoaderTypes.Quilt) : .ResourceType = ResourceTypes.Mod
For Each Loader As ModLoaders In EnumUtils.GetAllFlags(Of ModLoaders)()
If RawLoaders.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader : .ResourceType = ResourceTypes.Mod
Next
Else
'使用传入的类别,不作修改(#8377)
End If
@@ -212,8 +209,8 @@ Public Class ResourceVersion
ElseIf .GameVersions.Count > 1 Then
.GameVersions = .GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
If .ResourceType = ResourceTypes.ModPack Then .GameVersions = New List(Of String) From { .GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")) Then
.GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")).ToList
ElseIf RawVersions.Any(Function(v) v.RegexCheck("[0-9]{2}w[0-9]{2}[a-z]")) Then
.GameVersions = RawVersions.Where(Function(v) v.RegexCheck("[0-9]{2}w[0-9]{2}[a-z]")).ToList
Else
.GameVersions = New List(Of String) From {"未知版本"}
End If
@@ -230,7 +227,7 @@ Public Class ResourceVersion
Dim TargetProject = ResourceProject.FromProjectId(ProjectId, Platform)
'获取项目对象的文件列表
If Not ProjectFilesCache.ContainsKey(ProjectId) Then
Log("[Resource] 开始获取项目版本列表:" & ProjectId)
Logger.Info($"开始获取项目版本列表:{ProjectId}")
Dim ResultJsonArray As JArray = Nothing
If Platform = ResourcePlatforms.CurseForge Then
For RetryCount As Integer = 0 To 2
@@ -247,10 +244,10 @@ Public Class ResourceVersion
ResultJsonArray = ResultJson("data")
Exit For
ElseIf RetryCount < 2 Then
Log($"[Resource] CurseForge 返回的资源版本列表存在缺失,即将进行第 {RetryCount + 1} 次重试", NotifyLevel.DebugModeOnly) '#6224
Log($"[Resource] 返回的原始内容如下:{vbCrLf}{ResultJson}")
Logger.Warn($"CurseForge 返回的资源版本列表存在缺失,即将进行第 {RetryCount + 1} 次重试") '#6224
Logger.Info($"返回的原始内容如下:{vbCrLf}{ResultJson}")
Else
Log($"[Resource] CurseForge 返回的资源版本列表存在缺失,返回的原始内容如下:{vbCrLf}{ResultJson}")
Logger.Info($"CurseForge 返回的资源版本列表存在缺失,返回的原始内容如下:{vbCrLf}{ResultJson}")
Throw New Exception("CurseForge 返回的资源版本列表存在缺失")
End If
Next
@@ -266,7 +263,7 @@ Public Class ResourceVersion
'加载前置信息
Dim Dependencies As List(Of String) = Result.SelectMany(Function(f) f.RawDependencies).Distinct().ToList
If Dependencies.Any Then
Log($"[Resource] 项目 {ProjectId} 中需要加载的前置:{Dependencies.Join(",")}")
Logger.Info($"项目 {ProjectId} 中需要加载的前置:{Dependencies.Join(",")}")
For Each DependencyProject In ResourceProject.FromProjectIds(Dependencies, TargetProject.Platform)
For Each File In Result
If File.RawDependencies.Contains(DependencyProject.Id) AndAlso DependencyProject.Id <> ProjectId AndAlso Not File.Dependencies.Contains(DependencyProject.Id) Then
@@ -290,16 +287,16 @@ Public Class ResourceVersion
Public Shared Function FromCacheJson(Data As JObject) As ResourceVersion
Dim Result As New ResourceVersion
With Result
.ResourceType = CType(Data("ResourceType").ToObject(Of Integer), ResourceTypes)
.ResourceType = Data("ResourceType").ToObject(Of ResourceTypes)
.Id = Data("Id").ToString
.Display = Data("DisplayName").ToString
If Data.ContainsKey("Version") Then .Version = Data("Version").ToString
.ReleaseDate = Data("ReleaseDate").ToObject(Of Date)
.DownloadCount = Data("DownloadCount").ToObject(Of Integer)
.ReleaseType = CType(Data("ReleaseType").ToObject(Of Integer), ReleaseTypes)
.ReleaseType = Data("ReleaseType").ToObject(Of ReleaseTypes)
If Data.ContainsKey("FileName") Then .FileName = Data("FileName").ToString
If Data.ContainsKey("DownloadUrls") Then .DownloadUrls = Data("DownloadUrls").ToObject(Of List(Of String))
If Data.ContainsKey("ModLoaders") Then .Loaders = Data("ModLoaders").ToObject(Of List(Of ModLoaderTypes))
If Data.ContainsKey("ModLoaders") Then .ModLoaders = Data("ModLoaders").ToObject(Of ModLoaders)
If Data.ContainsKey("Size") Then .Size = Data("Size").ToObject(Of Integer)
If Data.ContainsKey("Hash") Then .Hash = Data("Hash").ToString
If Data.ContainsKey("GameVersions") Then .GameVersions = Data("GameVersions").ToObject(Of List(Of String))
@@ -320,7 +317,7 @@ Public Class ResourceVersion
.Add("DisplayName", Display)
.Add("ReleaseDate", ReleaseDate)
.Add("DownloadCount", DownloadCount)
.Add("ModLoaders", New JArray(Loaders.Select(Function(m) CInt(m))))
.Add("ModLoaders", ModLoaders)
.Add("GameVersions", New JArray(GameVersions))
.Add("ReleaseType", CInt(ReleaseType))
If FileName IsNot Nothing Then .Add("FileName", FileName)
@@ -383,10 +380,35 @@ Public Class ResourceVersion
''' 获取下载信息。
''' </summary>
''' <param name="LocalFileOrFolder">目标本地文件夹,或完整的文件路径。会自动判断类型。</param>
Public Function ToNetFile(LocalFileOrFolder As String) As NetFile
Return New NetFile(DownloadUrls, LocalFileOrFolder & If(LocalFileOrFolder.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash, ActualSize:=Size), SimulateBrowserHeaders:=True)
Public Function ToNetFile(LocalFileOrFolder As String,
Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As NetFile
Return New NetFile(
ParseModrinthTrackArguments(DownloadUrls, TrackDownloadReason, TrackGameVersion, TrackLoader),
LocalFileOrFolder & If(LocalFileOrFolder.EndsWithF("\"), FileName, ""),
New FileChecker(Hash:=Hash, ActualSize:=Size),
SimulateBrowserHeaders:=True)
End Function
''' <summary>
''' 添加 Modrinth 追踪参数。
''' </summary>
Public Shared Iterator Function ParseModrinthTrackArguments(Urls As List(Of String), Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As IEnumerable(Of String)
Dim Arguments As New Dictionary(Of String, String)
If TrackDownloadReason IsNot Nothing Then Arguments.Add("mr_download_reason", TrackDownloadReason.ToString.Lower)
If TrackGameVersion IsNot Nothing Then Arguments.Add("mr_game_version", TrackGameVersion)
If TrackLoader.Flags.Any Then Arguments.Add("mr_loader", TrackLoader.Flags.First.ToString.Lower)
Dim Argument = Arguments.Select(Function(a) $"{a.Key}={a.Value}").Join("&")
For Each Url In Urls
If Not Url.ContainsIgnoreCase("cdn.modrinth.com/") Then Yield Url
Yield $"{Url}{If(Url.Contains("?"), "&", "?")}{Argument}"
Next
End Function
Public Enum DownloadReason
Standalone
Dependency
ModPack
Update
End Enum
''' <summary>
''' 重新整理 CurseForge 的下载地址。
''' </summary>
Public Shared Function ParseCurseForgeDownloadUrls(Url As String) As List(Of String)
@@ -42,33 +42,32 @@ Public Class WikiEntry
If Cache IsNot Nothing Then Return Cache
'实际加载
Cache = New List(Of WikiEntry)
Dim Data As String
Using Archive As New ZipArchive(New MemoryStream(GetResources("ModData")), ZipArchiveMode.Read)
Data = ReadFile(Archive.GetEntry("moddata.txt").Open(), Encoding.UTF8)
End Using
Dim i As Integer = 0
For Each Line In Data.ReplaceLineEndings(vbLf).Split(vbLf)
Dim DataLines As List(Of String) = DirectCast(My.Resources.ResourceManager.GetObject("ModData"), String).SplitLines().ToList()
Dim Ranks = DataLines.Last.Split("|")
DataLines.RemoveAt(DataLines.Count - 1)
For Each Line In DataLines
i += 1
If Line = "" Then Continue For
For Each EntryData As String In Line.Split("¨")
Dim Entry = New WikiEntry
Dim Splited = EntryData.Split("|")
Entry.Popularity = Val(Splited(0))
If Splited(1).StartsWithF("@") Then
If Splited(0).StartsWithF("@") Then
Entry.CurseForgeSlug = Nothing
Entry.ModrinthSlug = Splited(1).Replace("@", "")
ElseIf Splited(1).EndsWithF("@") Then
Entry.CurseForgeSlug = Splited(1).TrimEnd("@")
Entry.ModrinthSlug = Splited(0).Replace("@", "")
ElseIf Splited(0).EndsWithF("@") Then
Entry.CurseForgeSlug = Splited(0).TrimEnd("@")
Entry.ModrinthSlug = Entry.CurseForgeSlug
ElseIf Splited(1).Contains("@") Then
Entry.CurseForgeSlug = Splited(1).Split("@")(0)
Entry.ModrinthSlug = Splited(1).Split("@")(1)
ElseIf Splited(0).Contains("@") Then
Entry.CurseForgeSlug = Splited(0).Split("@")(0)
Entry.ModrinthSlug = Splited(0).Split("@")(1)
Else
Entry.CurseForgeSlug = Splited(1)
Entry.CurseForgeSlug = Splited(0)
Entry.ModrinthSlug = Nothing
End If
Entry.Id = i
If Splited.Count >= 3 Then
Entry.Popularity = Val(Ranks(i - 1))
If Splited.Count >= 2 Then
Entry.ChineseName = Splited.Last
If Entry.ChineseName.Contains("*") Then '处理 *
Entry.ChineseName = Entry.ChineseName.Replace("*",