2.12.7.0
This commit is contained in:
龙腾猫跃
@@ -0,0 +1,507 @@
|
||||
''' <summary>
|
||||
''' 本地的社区资源文件。
|
||||
''' </summary>
|
||||
Public Class ResourceFile
|
||||
|
||||
#Region "文件信息"
|
||||
|
||||
''' <summary>
|
||||
''' 该文件的文件信息。
|
||||
''' </summary>
|
||||
Public ReadOnly File As FileInfo
|
||||
Public Sub New(FileInfo As FileInfo)
|
||||
Me.File = FileInfo
|
||||
End Sub
|
||||
Public Sub New(FullName As String)
|
||||
Me.New(New FileInfo(FullName))
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 该文件是否没有被禁用。
|
||||
''' </summary>
|
||||
Public ReadOnly Property IsEnabled As Boolean
|
||||
Get
|
||||
Return {".jar", ".zip", ".litemod"}.Contains(File.Extension.Lower)
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 假若该资源未被禁用时，文件的文件名。
|
||||
''' </summary>
|
||||
Public ReadOnly Property EnabledName As String
|
||||
Get
|
||||
Return File.Name.Replace(".disabled", "").Replace(".old", "")
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 假若该资源未被禁用时，文件的完整路径。
|
||||
''' </summary>
|
||||
Public ReadOnly Property EnabledFullName As String
|
||||
Get
|
||||
Return $"{File.DirectoryName}\{EnabledName}"
|
||||
End Get
|
||||
End Property
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "信息项"
|
||||
|
||||
''' <summary>
|
||||
''' 在初始化结束之后，任何信息被后续更新时触发此事件。
|
||||
''' </summary>
|
||||
Public Event OnUpdate(sender As ResourceFile)
|
||||
|
||||
''' <summary>
|
||||
''' 可读名称。
|
||||
''' 可能为无扩展的文件名，但不会是 Nothing。
|
||||
''' </summary>
|
||||
Public Property Display As String
|
||||
Get
|
||||
If _Display Is Nothing Then _Display = ProjectVersion?.Display
|
||||
If _Display Is Nothing Then _Display = Path.GetFileNameWithoutExtension(File.FullName)
|
||||
Return _Display
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Display Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso
|
||||
value.Lower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
|
||||
_Display = value
|
||||
End If
|
||||
End Set
|
||||
End Property
|
||||
Private _Display As String = Nothing
|
||||
|
||||
''' <summary>
|
||||
''' Mod 的描述信息。
|
||||
''' 可能为 Nothing。
|
||||
''' </summary>
|
||||
Public Property Description As String
|
||||
Get
|
||||
Return _Description
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then
|
||||
_Description = value.ToString.Trim(vbLf)
|
||||
'优化显示：若以 [a-zA-Z0-9] 结尾，加上小数点句号
|
||||
If _Description.Lower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "."
|
||||
End If
|
||||
End Set
|
||||
End Property
|
||||
Private _Description As String = Nothing
|
||||
|
||||
''' <summary>
|
||||
''' Mod 的版本。
|
||||
''' 不保证符合版本格式规范，且可能为 Nothing。
|
||||
''' </summary>
|
||||
Public Property Version As String
|
||||
Get
|
||||
If _Version Is Nothing Then _Version = ProjectVersion?.Version
|
||||
Return _Version
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
|
||||
If value IsNot Nothing AndAlso value.ContainsIgnoreCase("version") Then value = "version" '需要修改的标识
|
||||
_Version = value
|
||||
End Set
|
||||
End Property
|
||||
Public _Version As String = Nothing
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "从 JAR 获取信息"
|
||||
|
||||
''' <summary>
|
||||
''' 从 JAR 文件中获取 Mod 信息。
|
||||
''' </summary>
|
||||
Public Sub LoadMetadataFromJar()
|
||||
Static IsLoaded As Boolean = False
|
||||
If IsLoaded Then Return
|
||||
IsLoaded = True
|
||||
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 & "）")
|
||||
'打开 Jar 文件
|
||||
Jar = New ZipArchive(New FileStream(File.FullName, FileMode.Open, FileAccess.Read, FileShare.Read))
|
||||
'信息获取
|
||||
LoadMetadataFromJar(Jar)
|
||||
Catch ex As UnauthorizedAccessException
|
||||
Log(ex, $"Mod 文件由于无权限无法打开（{File.FullName}）", NotifyLevel.DevelopOnly)
|
||||
Catch ex As Exception
|
||||
Log(ex, $"Mod 文件无法打开（{File.FullName}）", NotifyLevel.DevelopOnly)
|
||||
Finally
|
||||
If Jar IsNot Nothing Then Jar.Dispose()
|
||||
End Try
|
||||
End Sub
|
||||
Private Sub LoadMetadataFromJar(Jar As ZipArchive)
|
||||
|
||||
#Region "尝试使用 mcmod.info"
|
||||
Try
|
||||
'获取信息文件
|
||||
Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info")
|
||||
Dim InfoString As String = Nothing
|
||||
If InfoEntry IsNot Nothing Then
|
||||
InfoString = ReadFile(InfoEntry.Open())
|
||||
If InfoString.Length < 15 Then InfoString = Nothing
|
||||
End If
|
||||
If InfoString Is Nothing Then Exit Try
|
||||
'获取可用 Json 项
|
||||
Dim InfoObject As JObject
|
||||
Dim JsonObject = GetJson(InfoString)
|
||||
If JsonObject.Type = JTokenType.Array Then
|
||||
InfoObject = JsonObject(0)
|
||||
Else
|
||||
InfoObject = JsonObject("modList")(0)
|
||||
End If
|
||||
'从文件中获取 Mod 信息项
|
||||
Display = InfoObject("name")
|
||||
Description = InfoObject("description")
|
||||
Version = InfoObject("version")
|
||||
Catch ex As Exception
|
||||
Log(ex, $"读取 mcmod.info 时出现未知错误（{File.FullName}）", NotifyLevel.DevelopOnly)
|
||||
End Try
|
||||
#End Region
|
||||
#Region "尝试使用 fabric.mod.json"
|
||||
Try
|
||||
'获取 fabric.mod.json 文件
|
||||
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)
|
||||
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
|
||||
End If
|
||||
If FabricText Is Nothing Then Exit Try
|
||||
Dim FabricObject As JObject = GetJson(FabricText)
|
||||
GotFabric:
|
||||
'从文件中获取 Mod 信息项
|
||||
If FabricObject.ContainsKey("name") Then Display = FabricObject("name")
|
||||
If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
|
||||
If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
|
||||
'加载成功
|
||||
GoTo Finished
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取 fabric.mod.json 时出现未知错误（" & File.FullName & "）", NotifyLevel.DevelopOnly)
|
||||
End Try
|
||||
#End Region
|
||||
#Region "尝试使用 mods.toml"
|
||||
Try
|
||||
'获取 mods.toml 文件
|
||||
Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml")
|
||||
Dim TomlText As String = Nothing
|
||||
If TomlEntry IsNot Nothing Then
|
||||
TomlText = ReadFile(TomlEntry.Open())
|
||||
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) '统一换行符
|
||||
If Line.StartsWithF("#") Then '去除注释
|
||||
Continue For
|
||||
ElseIf Line.Contains("#") Then
|
||||
Line = Line.Substring(0, Line.IndexOfF("#"))
|
||||
End If
|
||||
Line = Line.Trim(New Char() {" "c, " "c, " "c}) '去除头尾的空格
|
||||
If Line.Any Then Lines.Add(Line) '去除空行
|
||||
Next
|
||||
'读取文件数据
|
||||
Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))}
|
||||
For i = 0 To Lines.Count - 1
|
||||
Dim Line As String = Lines(i)
|
||||
If Line.StartsWithF("[") AndAlso Line.EndsWithF("]") Then
|
||||
'段落标记
|
||||
Dim Header = Line.Trim("[]".ToCharArray)
|
||||
TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object)))
|
||||
ElseIf Line.Contains("=") Then
|
||||
'字段标记
|
||||
Dim Key As String = Line.Substring(0, Line.IndexOfF("=")).TrimEnd(New Char() {" "c, " "c, " "c})
|
||||
Dim RawValue As String = Line.Substring(Line.IndexOfF("=") + 1).TrimStart(New Char() {" "c, " "c, " "c})
|
||||
Dim Value As Object
|
||||
If RawValue.StartsWithF("""") AndAlso RawValue.EndsWithF("""") Then
|
||||
'单行字符串
|
||||
Value = RawValue.Trim("""")
|
||||
ElseIf RawValue.StartsWithF("'''") Then
|
||||
'多行字符串
|
||||
Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")}
|
||||
If ValueLines(0).EndsWithF("'''") Then '把多行字符串按单行写法写的错误处理（#2732）
|
||||
ValueLines(0) = ValueLines(0).TrimEnd("'")
|
||||
Else
|
||||
Do Until i >= Lines.Count - 1
|
||||
i += 1
|
||||
Dim ValueLine As String = Lines(i)
|
||||
If ValueLine.EndsWithF("'''") Then
|
||||
ValueLines.Add(ValueLine.TrimEnd("'"))
|
||||
Exit Do
|
||||
Else
|
||||
ValueLines.Add(ValueLine)
|
||||
End If
|
||||
Loop
|
||||
End If
|
||||
Value = ValueLines.Join(vbLf).Trim(vbLf).ReplaceLineEndings(vbCrLf)
|
||||
ElseIf RawValue.Lower = "true" OrElse RawValue.Lower = "false" Then
|
||||
'布尔型
|
||||
Value = (RawValue.Lower = "true")
|
||||
ElseIf Val(RawValue).ToString = RawValue Then
|
||||
'数字型
|
||||
Value = Val(RawValue)
|
||||
Else
|
||||
'不知道是个啥玩意儿，直接存储
|
||||
Value = RawValue
|
||||
End If
|
||||
TomlData.Last.Value(Key) = Value
|
||||
Else
|
||||
'不知道是个啥玩意儿
|
||||
Exit Try
|
||||
End If
|
||||
Next
|
||||
'从文件数据中获取信息
|
||||
Dim ModEntry As Dictionary(Of String, Object) = Nothing
|
||||
For Each TomlSubData In TomlData
|
||||
If TomlSubData.Key = "mods" Then
|
||||
ModEntry = TomlSubData.Value
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try
|
||||
If ModEntry.ContainsKey("displayName") Then Display = ModEntry("displayName")
|
||||
If ModEntry.ContainsKey("description") Then Description = ModEntry("description")
|
||||
If ModEntry.ContainsKey("version") Then Version = ModEntry("version")
|
||||
'加载成功
|
||||
GoTo Finished
|
||||
Catch ex As Exception
|
||||
Log(ex, $"读取 mods.toml 时出现未知错误（{File.FullName}）", NotifyLevel.DevelopOnly)
|
||||
End Try
|
||||
#End Region
|
||||
#Region "尝试使用 fml_cache_annotation.json"
|
||||
Try
|
||||
'获取 fml_cache_annotation.json 文件
|
||||
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)
|
||||
If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing
|
||||
End If
|
||||
If FmlText Is Nothing Then Exit Try
|
||||
Dim FmlJson As JObject = GetJson(FmlText)
|
||||
'获取可用 Json 项
|
||||
Dim FmlObject As JObject = Nothing
|
||||
For Each ModFilePair In FmlJson
|
||||
Dim ModFileAnnos As JArray = ModFilePair.Value("annotations")
|
||||
If ModFileAnnos IsNot Nothing Then
|
||||
'先获取 Mod
|
||||
For Each ModFileAnno In ModFileAnnos
|
||||
Dim Name As String = If(ModFileAnno("name"), "")
|
||||
If Name = "Lnet/minecraftforge/fml/common/Mod;" Then
|
||||
FmlObject = ModFileAnno("values")
|
||||
GoTo Got
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Next
|
||||
Exit Try
|
||||
Got:
|
||||
'从文件中获取 Mod 信息项
|
||||
If FmlObject.ContainsKey("name") Then Display = FmlObject("name")("value")
|
||||
If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value")
|
||||
'加载成功
|
||||
GoTo Finished
|
||||
Catch ex As Exception
|
||||
Log(ex, $"读取 fml_cache_annotation.json 时出现未知错误（{File.FullName}）", NotifyLevel.DevelopOnly)
|
||||
End Try
|
||||
#End Region
|
||||
Return '没能成功获取任何信息
|
||||
|
||||
Finished:
|
||||
#Region "将 Version 代号转换为 META-INF 中的版本"
|
||||
If _Version = "version" Then
|
||||
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(": ", ":")
|
||||
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
|
||||
Version = MetaString
|
||||
End If
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log($"获取 META-INF 中的版本信息失败（{File.FullName}）", NotifyLevel.DevelopOnly)
|
||||
Version = Nothing
|
||||
End Try
|
||||
End If
|
||||
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
|
||||
#End Region
|
||||
RaiseEvent OnUpdate(Me)
|
||||
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "网络信息"
|
||||
|
||||
''' <summary>
|
||||
''' 该 Mod 关联的网络项目。
|
||||
''' </summary>
|
||||
Public Property Project As ResourceProject
|
||||
Get
|
||||
Return _Project
|
||||
End Get
|
||||
Set(value As ResourceProject)
|
||||
_Project = value
|
||||
RaiseEvent OnUpdate(Me)
|
||||
End Set
|
||||
End Property
|
||||
Private _Project As ResourceProject
|
||||
|
||||
''' <summary>
|
||||
''' 本地文件对应的联网文件信息。
|
||||
''' </summary>
|
||||
Public ProjectVersion As ResourceVersion
|
||||
|
||||
''' <summary>
|
||||
''' 该 Mod 对应的联网最新版本。
|
||||
''' </summary>
|
||||
Public Property UpdateFile As ResourceVersion
|
||||
Get
|
||||
Return _UpdateFile
|
||||
End Get
|
||||
Set(value As ResourceVersion)
|
||||
_UpdateFile = value
|
||||
RaiseEvent OnUpdate(Me)
|
||||
End Set
|
||||
End Property
|
||||
Private _UpdateFile As ResourceVersion
|
||||
|
||||
''' <summary>
|
||||
''' 该 Mod 的更新日志网址。
|
||||
''' </summary>
|
||||
Public ChangelogUrls As New List(Of String)
|
||||
''' <summary>
|
||||
''' 所有网络信息是否已成功加载。
|
||||
''' </summary>
|
||||
Public OnlineDataLoaded As Boolean = False
|
||||
|
||||
''' <summary>
|
||||
''' 将网络信息保存为 JSON。
|
||||
''' </summary>
|
||||
Public Function ToJson() As JObject
|
||||
Dim Json As New JObject
|
||||
If Project IsNot Nothing Then Json.Add("Project", Project.ToJson())
|
||||
Json.Add("ChangelogUrls", New JArray(ChangelogUrls))
|
||||
Json.Add("OnlineDataLoaded", OnlineDataLoaded)
|
||||
If ProjectVersion IsNot Nothing Then Json.Add("Version", ProjectVersion.ToCacheJson())
|
||||
If UpdateFile IsNot Nothing Then Json.Add("UpdateFile", UpdateFile.ToCacheJson())
|
||||
Return Json
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 从 JSON 中读取网络信息。
|
||||
''' </summary>
|
||||
Public Sub FromJson(Json As JObject)
|
||||
OnlineDataLoaded = Json("OnlineDataLoaded")
|
||||
If Json.ContainsKey("Project") Then Project = New ResourceProject(Json("Project"))
|
||||
If Json.ContainsKey("ChangelogUrls") Then ChangelogUrls = Json("ChangelogUrls").ToObject(Of List(Of String))
|
||||
If Json.ContainsKey("Version") Then ProjectVersion = ResourceVersion.FromCacheJson(Json("Version"))
|
||||
If Json.ContainsKey("UpdateFile") Then UpdateFile = ResourceVersion.FromCacheJson(Json("UpdateFile"))
|
||||
End Sub
|
||||
|
||||
''' <summary>
|
||||
''' 该文件是否可以更新。
|
||||
''' </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
|
||||
End Get
|
||||
End Property
|
||||
|
||||
''' <summary>
|
||||
''' 获取用于 CurseForge 信息获取的 Hash 值（MurmurHash2）。
|
||||
''' </summary>
|
||||
Public ReadOnly Property CurseForgeHash As UInteger
|
||||
Get
|
||||
If _CurseForgeHash Is Nothing Then
|
||||
'读取缓存
|
||||
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
|
||||
_CurseForgeHash = Cached
|
||||
Return _CurseForgeHash
|
||||
End If
|
||||
'读取文件
|
||||
Dim data As New List(Of Byte)
|
||||
For Each b As Byte In ReadFileBytes(File.FullName)
|
||||
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
|
||||
data.Add(b)
|
||||
Next
|
||||
'计算 MurmurHash2
|
||||
Dim length As Integer = data.Count
|
||||
Dim h As UInteger = 1 Xor length '1 是种子
|
||||
Dim i As Integer
|
||||
For i = 0 To length - 4 Step 4
|
||||
Dim k As UInteger = data(i) Or CUInt(data(i + 1)) << 8 Or CUInt(data(i + 2)) << 16 Or CUInt(data(i + 3)) << 24
|
||||
k = (k * &H5BD1E995L) And &HFFFFFFFFL
|
||||
k = k Xor (k >> 24)
|
||||
k = (k * &H5BD1E995L) And &HFFFFFFFFL
|
||||
h = (h * &H5BD1E995L) And &HFFFFFFFFL
|
||||
h = h Xor k
|
||||
Next
|
||||
Select Case length - i
|
||||
Case 3
|
||||
h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
|
||||
h = h Xor (CUInt(data(i + 2)) << 16)
|
||||
h = (h * &H5BD1E995L) And &HFFFFFFFFL
|
||||
Case 2
|
||||
h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
|
||||
h = (h * &H5BD1E995L) And &HFFFFFFFFL
|
||||
Case 1
|
||||
h = h Xor data(i)
|
||||
h = (h * &H5BD1E995L) And &HFFFFFFFFL
|
||||
End Select
|
||||
h = h Xor (h >> 13)
|
||||
h = (h * &H5BD1E995L) And &HFFFFFFFFL
|
||||
h = h Xor (h >> 15)
|
||||
_CurseForgeHash = h
|
||||
'写入缓存
|
||||
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, h.ToString)
|
||||
End If
|
||||
Return _CurseForgeHash
|
||||
End Get
|
||||
End Property
|
||||
Private _CurseForgeHash As UInteger?
|
||||
|
||||
''' <summary>
|
||||
''' 获取用于 Modrinth 信息获取的 Hash 值（SHA1）。
|
||||
''' </summary>
|
||||
Public ReadOnly Property ModrinthHash As String
|
||||
Get
|
||||
If _ModrinthHash Is Nothing Then
|
||||
'读取缓存
|
||||
Dim CacheKey As String = GetHash($"{EnabledFullName}-{File.LastWriteTime.ToLongTimeString}-{File.Length}-M")
|
||||
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
|
||||
If Cached <> "" Then
|
||||
_ModrinthHash = Cached
|
||||
Return _ModrinthHash
|
||||
End If
|
||||
'计算 SHA1
|
||||
_ModrinthHash = GetFileSHA1(File.FullName)
|
||||
'写入缓存
|
||||
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
|
||||
End If
|
||||
Return _ModrinthHash
|
||||
End Get
|
||||
End Property
|
||||
Private _ModrinthHash As String
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "API"
|
||||
|
||||
Public Overrides Function ToString() As String
|
||||
Return File.FullName
|
||||
End Function
|
||||
Public Overrides Function Equals(obj As Object) As Boolean
|
||||
Dim Target = TryCast(obj, ResourceFile)
|
||||
Return Target IsNot Nothing AndAlso File.FullName = Target.File.FullName
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
End Class
|
||||
@@ -0,0 +1,345 @@
|
||||
Public Module ResourceFileLoader
|
||||
Private Const ResourceFileCacheVersion As Integer = 16
|
||||
|
||||
'加载 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)))
|
||||
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)
|
||||
Try
|
||||
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
|
||||
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
|
||||
If Loader.IsInterrupted Then Return
|
||||
Thread.Sleep(100)
|
||||
Loop
|
||||
Finally
|
||||
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在加载 Mod 列表")
|
||||
End Try
|
||||
FrmInstanceMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
|
||||
End If
|
||||
|
||||
'获取 Mod 文件夹下的可用文件列表
|
||||
Dim ModFileList As New List(Of FileInfo)
|
||||
If Directory.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
|
||||
'仅当 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
|
||||
Continue For
|
||||
End If
|
||||
End If
|
||||
Static IsModFile As Func(Of String, Boolean) =
|
||||
Function(FullName As String)
|
||||
If FullName Is Nothing OrElse Not FullName.Contains(".") Then Return False
|
||||
FullName = FullName.Lower
|
||||
If FullName.EndsWithF(".jar", True) OrElse FullName.EndsWithF(".zip", True) OrElse FullName.EndsWithF(".litemod", True) OrElse
|
||||
FullName.EndsWithF(".jar.disabled", True) OrElse FullName.EndsWithF(".zip.disabled", True) OrElse FullName.EndsWithF(".litemod.disabled", True) OrElse
|
||||
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)
|
||||
Next
|
||||
End If
|
||||
|
||||
'获取本地文件缓存
|
||||
Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
|
||||
Dim Cache As New JObject
|
||||
Try
|
||||
Dim CacheContent As String = ReadFile(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)
|
||||
Cache = New JObject
|
||||
End If
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取本地 Mod 信息缓存失败，已重置")
|
||||
Cache = New JObject
|
||||
End Try
|
||||
Cache("version") = ResourceFileCacheVersion
|
||||
|
||||
'加载 Mod 列表
|
||||
Dim ModList As New List(Of ResourceFile)
|
||||
For Each ModFile As FileInfo 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) '存在两个文件，名称相同，但一个启用一个禁用
|
||||
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)
|
||||
If DisabledMod Is ModEntry Then
|
||||
Continue For
|
||||
Else
|
||||
ModList.Remove(DisabledMod)
|
||||
End If
|
||||
End If
|
||||
ModList.Add(ModEntry)
|
||||
Next
|
||||
Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
|
||||
|
||||
'排序
|
||||
ModList = ModList.OrderBy(Function(m) m.File.Name).ToList
|
||||
|
||||
'回设
|
||||
If Loader.IsInterrupted Then Return
|
||||
Loader.Output = ModList
|
||||
|
||||
'开始联网加载
|
||||
'TODO: 添加信息获取中提示
|
||||
McModDetailLoader.Start(New KeyValuePair(Of List(Of ResourceFile), JObject)(ModList, Cache), IsForceRestart:=True)
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "Mod 列表加载失败", NotifyLevel.DebugModeOnly)
|
||||
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
|
||||
'读取缓存，获取需要更新的 Mod 列表
|
||||
For Each ModEntry As ResourceFile In Loader.Input.Key
|
||||
If Loader.IsInterrupted Then Return
|
||||
Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("")
|
||||
If Cache.ContainsKey(CacheKey) Then
|
||||
ModEntry.FromJson(Cache(CacheKey))
|
||||
'如果缓存中的信息在 6 小时以内更新过，则无需重新获取
|
||||
If ModEntry.OnlineDataLoaded AndAlso Date.Now - Cache(CacheKey)("Project")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
|
||||
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 需要更新信息")
|
||||
If Not Mods.Any Then
|
||||
Loader.Input.Key.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 VanillaVersion = TargetMcVersion.VanillaName
|
||||
'开始网络获取
|
||||
Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{VanillaVersion}")
|
||||
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
|
||||
Dim CurrentTaskThread As Thread = Thread.CurrentThread
|
||||
'从 Modrinth 获取信息
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
'步骤 1：获取 Hash 与对应的工程 ID
|
||||
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 的对应信息")
|
||||
'步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
|
||||
If ModrinthVersion.Count = 0 Then Return
|
||||
Dim ModrinthMapping As New Dictionary(Of String, List(Of ResourceFile))
|
||||
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)
|
||||
ModrinthMapping(ProjectId).Add(Entry)
|
||||
'记录对应的 ProjectVersion
|
||||
Dim File = ResourceVersion.FromPlatformJson(ModrinthVersion(Entry.ModrinthHash), ResourceTypes.Mod)
|
||||
If Entry.ProjectVersion Is Nothing OrElse Entry.ProjectVersion.ReleaseDate < File.ReleaseDate Then
|
||||
Entry.ProjectVersion = File
|
||||
Else
|
||||
Entry.ProjectVersion.Version = File.Version '使用来自 Modrinth 的版本号
|
||||
End If
|
||||
Next
|
||||
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
|
||||
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
|
||||
'步骤 3：获取工程信息
|
||||
If Not ModrinthMapping.Any() Then Return
|
||||
Dim ModrinthProject As JArray = DlModRequest(
|
||||
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]")
|
||||
For Each ProjectJson In ModrinthProject
|
||||
Dim Project As New ResourceProject(ProjectJson)
|
||||
For Each Entry In ModrinthMapping(Project.Id)
|
||||
Entry.Project = Project
|
||||
Next
|
||||
Next
|
||||
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息，继续获取更新信息")
|
||||
'步骤 4：获取更新信息
|
||||
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")
|
||||
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}")
|
||||
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 '合并
|
||||
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}")
|
||||
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
|
||||
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
|
||||
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
|
||||
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}"}
|
||||
Entry.UpdateFile = UpdateFile
|
||||
End If
|
||||
Next
|
||||
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
|
||||
IsFailed = True
|
||||
Finally
|
||||
EndedThreadCount += 1
|
||||
End Try
|
||||
End Sub, "Mod List Detail Loader Modrinth")
|
||||
'从 CurseForge 获取信息
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
'步骤 1：获取 Hash 与对应的工程 ID
|
||||
Dim CurseForgeHashes As New List(Of UInteger)
|
||||
For Each Entry In Mods
|
||||
CurseForgeHashes.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 的对应关系
|
||||
If Not CurseForgeRaw.Any() Then Return
|
||||
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of ResourceFile))
|
||||
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)
|
||||
'记录对应的 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 的工程信息")
|
||||
'步骤 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 文件列表
|
||||
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
|
||||
End If
|
||||
Entry.Project = Project
|
||||
Next
|
||||
'查找或许版本更新的文件列表
|
||||
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
|
||||
Next
|
||||
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息，需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
|
||||
'步骤 4：获取更新文件信息
|
||||
If Not UpdateFileIds.Any() Then Return
|
||||
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)
|
||||
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)
|
||||
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 UpdateFile As ResourceVersion = Pair.Value
|
||||
If ModeDebug Then Log($"[Mod] 本地文件 {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 '合并
|
||||
Entry.ChangelogUrls.Add($"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}")
|
||||
Entry.UpdateFile.DownloadUrls.AddRange(UpdateFile.DownloadUrls) '合并下载源
|
||||
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate > Entry.UpdateFile.ReleaseDate Then '替换
|
||||
Entry.ChangelogUrls = New List(Of String) From {$"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}"}
|
||||
Entry.UpdateFile = UpdateFile
|
||||
End If
|
||||
Next
|
||||
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
|
||||
Catch ex As Exception
|
||||
Log(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())
|
||||
'等待线程结束
|
||||
Do Until EndedThreadCount = 2
|
||||
Thread.Sleep(10)
|
||||
If Loader.IsInterrupted Then Return
|
||||
Loop
|
||||
'保存缓存
|
||||
Mods = Mods.Where(Function(m) m.Project IsNot Nothing).ToList()
|
||||
Log($"[Mod] 联网获取本地 Mod 信息完成，为 {Mods.Count} 个 Mod 更新缓存")
|
||||
If Not Mods.Any() Then Return
|
||||
For Each Entry In Mods
|
||||
Entry.OnlineDataLoaded = Not IsFailed
|
||||
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = Entry.ToJson()
|
||||
Next
|
||||
FileUtils.Write(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
|
||||
'刷新边栏
|
||||
If Loader.IsInterrupted Then Return
|
||||
If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
|
||||
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
|
||||
Else
|
||||
RunInUi(Sub() FrmInstanceMod?.RefreshBars())
|
||||
End If
|
||||
End Sub
|
||||
|
||||
End Module
|
||||
@@ -0,0 +1,726 @@
|
||||
''' <summary>
|
||||
''' 社区资源的项目信息。
|
||||
''' </summary>
|
||||
Public Class ResourceProject
|
||||
|
||||
'源信息
|
||||
|
||||
''' <summary>
|
||||
''' 该项目信息的所属平台。
|
||||
''' </summary>
|
||||
Public ReadOnly Platform As ResourcePlatforms
|
||||
''' <summary>
|
||||
''' 工程中包含的文件种类。
|
||||
''' 若为 Modrinth 工程，可能为 Mod 或 数据包。
|
||||
''' </summary>
|
||||
Public ReadOnly Types As ResourceTypes
|
||||
''' <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>
|
||||
''' 最后一次更新的时间。
|
||||
''' </summary>
|
||||
Public ReadOnly LastUpdate As Date
|
||||
''' <summary>
|
||||
''' 下载量计数。注意，该计数仅为一个来源，无法反应两边加起来的下载量！
|
||||
''' </summary>
|
||||
Public ReadOnly DownloadCount As Integer
|
||||
''' <summary>
|
||||
''' 支持的 Mod 加载器列表。可能为空。
|
||||
''' </summary>
|
||||
Public ReadOnly Loaders As List(Of ModLoaderTypes)
|
||||
''' <summary>
|
||||
''' 描述性标签的内容。已转换为中文。
|
||||
''' </summary>
|
||||
Public ReadOnly Tags As List(Of String)
|
||||
''' <summary>
|
||||
''' Logo 图片的下载地址。
|
||||
''' 若为 Nothing 则没有，保证不为空字符串。
|
||||
''' </summary>
|
||||
Public LogoUrl As String = Nothing
|
||||
''' <summary>
|
||||
''' 支持的 Drop 编号，从高到低排序，不为 Nothing。
|
||||
''' 例如：261（26.1.x）、180（1.18.x）。
|
||||
''' </summary>
|
||||
Public ReadOnly Drops As List(Of Integer)
|
||||
''' <summary>
|
||||
''' Modrinth API 返回的原始版本列表。
|
||||
''' 仅用于 Modrinth 工程的二次筛选，不会被缓存，不会被预处理。
|
||||
''' 若非从 Modrinth 获取则为 Nothing。
|
||||
''' </summary>
|
||||
Public ReadOnly UnsafeGameVersions As List(Of String)
|
||||
|
||||
'数据库信息
|
||||
|
||||
Private LoadedDatabase As Boolean = False
|
||||
Private _WikiEntry As WikiEntry = Nothing
|
||||
''' <summary>
|
||||
''' 关联的数据库条目。若为 Nothing 则没有。
|
||||
''' </summary>
|
||||
Private Property WikiEntry As WikiEntry
|
||||
Get
|
||||
If Not LoadedDatabase Then
|
||||
LoadedDatabase = True
|
||||
If Types.HasFlag(ResourceTypes.Mod) OrElse Types.HasFlag(ResourceTypes.DataPack) Then
|
||||
_WikiEntry = WikiEntry.All.FirstOrDefault(Function(c) If(Platform = ResourcePlatforms.CurseForge, c.CurseForgeSlug, c.ModrinthSlug) = Slug)
|
||||
End If
|
||||
End If
|
||||
Return _WikiEntry
|
||||
End Get
|
||||
Set(value As WikiEntry)
|
||||
LoadedDatabase = True
|
||||
_WikiEntry = value
|
||||
End Set
|
||||
End Property
|
||||
''' <summary>
|
||||
''' MC 百科的页面 ID。若为 0 则没有。
|
||||
''' </summary>
|
||||
Public ReadOnly Property WikiId As Integer
|
||||
Get
|
||||
Return If(WikiEntry Is Nothing, 0, WikiEntry.Id)
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 翻译后的中文名。若数据库没有则等同于 RawName。
|
||||
''' </summary>
|
||||
Public ReadOnly Property TranslatedName As String
|
||||
Get
|
||||
Return If(WikiEntry Is Nothing OrElse WikiEntry.ChineseName = "", RawName, WikiEntry.ChineseName)
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'实例化
|
||||
|
||||
''' <summary>
|
||||
''' 从工程 Json 中初始化实例。若出错会抛出异常。
|
||||
''' </summary>
|
||||
Public Sub New(Data As JObject)
|
||||
If Data.ContainsKey("Tags") Then
|
||||
#Region "缓存 JSON"
|
||||
Platform = Data("Platform").ToObject(Of Integer)
|
||||
Types = Data("Types").ToObject(Of Integer)
|
||||
Slug = Data("Slug")
|
||||
Id = Data("Id")
|
||||
If Data.ContainsKey("CurseForgeFileIds") Then CurseForgeFileIds = CType(Data("CurseForgeFileIds"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
|
||||
RawName = Data("RawName")
|
||||
Description = Data("Description")
|
||||
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
|
||||
Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList
|
||||
If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl")
|
||||
If Data.ContainsKey("Drops") Then
|
||||
Drops = CType(Data("Drops"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
|
||||
Else
|
||||
Drops = New List(Of Integer)
|
||||
End If
|
||||
#End Region
|
||||
Else
|
||||
Platform = If(Data.ContainsKey("summary"), ResourcePlatforms.CurseForge, ResourcePlatforms.Modrinth)
|
||||
If Platform = ResourcePlatforms.CurseForge 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")
|
||||
If Data("logo").Count > 0 Then
|
||||
If Data("logo")("thumbnailUrl") Is Nothing OrElse Data("logo")("thumbnailUrl") = "" Then
|
||||
LogoUrl = Data("logo")("url")
|
||||
Else
|
||||
LogoUrl = Data("logo")("thumbnailUrl")
|
||||
End If
|
||||
End If
|
||||
If LogoUrl = "" Then LogoUrl = Nothing
|
||||
'Type
|
||||
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
|
||||
Types = ResourceTypes.Mod
|
||||
ElseIf Website.Contains("/modpacks/") Then
|
||||
Types = ResourceTypes.ModPack
|
||||
ElseIf Website.Contains("/resourcepacks/") Then
|
||||
Types = ResourceTypes.ResourcePack
|
||||
ElseIf Website.Contains("/texture-packs/") Then
|
||||
Types = ResourceTypes.ResourcePack
|
||||
ElseIf Website.Contains("/shaders/") Then
|
||||
Types = ResourceTypes.Shader
|
||||
Else
|
||||
Types = ResourceTypes.DataPack
|
||||
End If
|
||||
'FileIndexes / VanillaMajorVersions / ModLoaders
|
||||
Loaders = New List(Of ModLoaderTypes)
|
||||
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)
|
||||
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))
|
||||
Next
|
||||
For Each File In If(Data("latestFilesIndexes"), New JArray) '这俩玩意儿包含的文件不一样，见 #3599
|
||||
If Not McVersion.IsFormatFit(File("gameVersion")) Then Continue For
|
||||
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("fileId"), {File("gameVersion").ToString}.ToList))
|
||||
Next
|
||||
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)
|
||||
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 6814 : Tags.Add("性能优化")
|
||||
Case 9026 : 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 4474 : 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("大型")
|
||||
'资源包
|
||||
Case 403 : Tags.Add("原版风")
|
||||
Case 400 : Tags.Add("写实风")
|
||||
Case 401 : Tags.Add("现代风")
|
||||
Case 402 : Tags.Add("中世纪")
|
||||
Case 399 : Tags.Add("蒸汽朋克")
|
||||
Case 5244 : Tags.Add("含字体")
|
||||
Case 404 : Tags.Add("动态效果")
|
||||
Case 4465 : Tags.Add("兼容 Mod")
|
||||
Case 393 : Tags.Add("16x")
|
||||
Case 394 : Tags.Add("32x")
|
||||
Case 395 : Tags.Add("64x")
|
||||
Case 396 : Tags.Add("128x")
|
||||
Case 397 : Tags.Add("256x")
|
||||
Case 398 : Tags.Add("超高清")
|
||||
Case 5193 : Tags.Add("数据包") '有这个 Tag 的项会从资源包请求中被移除
|
||||
'光影包
|
||||
Case 6553 : Tags.Add("写实风")
|
||||
Case 6554 : Tags.Add("幻想风")
|
||||
Case 6555 : Tags.Add("原版风")
|
||||
'数据包
|
||||
Case 6948 : Tags.Add("冒险")
|
||||
Case 6949 : Tags.Add("幻想")
|
||||
Case 6950 : Tags.Add("支持库")
|
||||
Case 6952 : Tags.Add("魔法")
|
||||
Case 6946 : Tags.Add("Mod 相关")
|
||||
Case 6951 : Tags.Add("科技")
|
||||
Case 6953 : Tags.Add("实用")
|
||||
End Select
|
||||
Next
|
||||
#End Region
|
||||
Else
|
||||
#Region "Modrinth"
|
||||
'简单信息
|
||||
Id = If(Data("project_id"), Data("id")) '两个 API 会返回的 key 不一样
|
||||
Slug = Data("slug")
|
||||
RawName = Data("title")
|
||||
Description = Data("description")
|
||||
LastUpdate = If(Data("date_modified"), Data("updated"))
|
||||
DownloadCount = Data("downloads")
|
||||
LogoUrl = Data("icon_url")
|
||||
If LogoUrl = "" Then LogoUrl = Nothing
|
||||
Website = $"https://modrinth.com/{Data("project_type")}/{Slug}"
|
||||
'GameVersions
|
||||
'搜索结果的键为 versions，获取特定工程的键为 game_versions
|
||||
UnsafeGameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).Select(Function(v) v.ToString).Distinct.ToList
|
||||
Drops = UnsafeGameVersions.Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v <> 209).Distinct.OrderByDescending(Function(v) v).ToList
|
||||
'Type
|
||||
Select Case Data("project_type").ToString
|
||||
Case "modpack" : Types = ResourceTypes.ModPack
|
||||
Case "resourcepack" : Types = ResourceTypes.ResourcePack
|
||||
Case "shader" : Types = ResourceTypes.Shader
|
||||
Case Else : Types = ResourceTypes.Mod 'Modrinth 将数据包标为 Mod，但 categories 字段里有 datapack
|
||||
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
|
||||
Next
|
||||
End If
|
||||
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("科技")
|
||||
Case "magic" : Tags.Add("魔法")
|
||||
Case "adventure" : Tags.Add("冒险")
|
||||
Case "utility" : Tags.Add("实用")
|
||||
Case "optimization" : Tags.Add("性能优化")
|
||||
Case "vanilla-like" : Tags.Add("原版风")
|
||||
Case "realistic" : Tags.Add("写实风")
|
||||
'Mod/数据包
|
||||
Case "worldgen" : Tags.Add("世界元素")
|
||||
Case "food" : Tags.Add("食物/烹饪")
|
||||
Case "game-mechanics" : Tags.Add("游戏机制")
|
||||
Case "transportation" : Tags.Add("运输")
|
||||
Case "storage" : Tags.Add("仓储")
|
||||
Case "decoration" : If Types <> ResourceTypes.ResourcePack Then Tags.Add("装饰")
|
||||
Case "mobs" : If Types <> ResourceTypes.ResourcePack Then Tags.Add("生物")
|
||||
Case "equipment" : If Types <> ResourceTypes.ResourcePack Then Tags.Add("装备")
|
||||
Case "social" : Tags.Add("服务器")
|
||||
Case "library" : Tags.Add("支持库")
|
||||
'整合包
|
||||
Case "multiplayer" : Tags.Add("多人")
|
||||
Case "challenging" : Tags.Add("硬核")
|
||||
Case "combat" : Tags.Add("战斗")
|
||||
Case "quests" : Tags.Add("任务")
|
||||
Case "kitchen-sink" : Tags.Add("水槽包")
|
||||
Case "lightweight" : Tags.Add("轻量")
|
||||
'资源包
|
||||
Case "simplistic" : Tags.Add("简洁")
|
||||
Case "combat" : Tags.Add("战斗")
|
||||
Case "tweaks" : Tags.Add("改良")
|
||||
|
||||
Case "8x-" : Tags.Add("极简")
|
||||
Case "16x" : Tags.Add("16x")
|
||||
Case "32x" : Tags.Add("32x")
|
||||
Case "48x" : Tags.Add("48x")
|
||||
Case "64x" : Tags.Add("64x")
|
||||
Case "128x" : Tags.Add("128x")
|
||||
Case "256x" : Tags.Add("256x")
|
||||
Case "512x+" : Tags.Add("超高清")
|
||||
|
||||
Case "audio" : Tags.Add("含声音")
|
||||
Case "fonts" : Tags.Add("含字体")
|
||||
Case "models" : Tags.Add("含模型")
|
||||
Case "gui" : Tags.Add("含 UI")
|
||||
Case "locale" : Tags.Add("含语言")
|
||||
Case "core-shaders" : Tags.Add("核心着色器")
|
||||
Case "modded" : Tags.Add("兼容 Mod")
|
||||
'光影包
|
||||
Case "fantasy" : Tags.Add("幻想风")
|
||||
Case "semi-realistic" : Tags.Add("半写实风")
|
||||
Case "cartoon" : Tags.Add("卡通风")
|
||||
'暂时不添加性能负荷 Tag
|
||||
'Case "potato" : Tags.Add("极低")
|
||||
'Case "low" : Tags.Add("低")
|
||||
'Case "medium" : Tags.Add("中")
|
||||
'Case "high" : Tags.Add("高")
|
||||
Case "colored-lighting" : Tags.Add("彩色光照")
|
||||
Case "path-tracing" : Tags.Add("路径追踪")
|
||||
Case "pbr" : Tags.Add("PBR")
|
||||
Case "reflections" : Tags.Add("反射")
|
||||
|
||||
Case "iris" : Tags.Add("Iris")
|
||||
Case "optifine" : Tags.Add("OptiFine")
|
||||
Case "vanilla" : Tags.Add("原版可用")
|
||||
End Select
|
||||
Next
|
||||
If Types = ResourceTypes.DataPack AndAlso Loaders.Any 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
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 从工程 ID 联网获取对应工程的信息。
|
||||
''' </summary>
|
||||
Public Shared Function FromProjectId(ProjectId As String, Platform As ResourcePlatforms) As ResourceProject
|
||||
If Not Platform.Flags.IsSingle Then Throw New ArgumentException($"必须指定单一平台，当前值为 {Platform}")
|
||||
If Cache.ContainsKey(ProjectId) Then '存在缓存
|
||||
Return Cache(ProjectId)
|
||||
ElseIf Platform = ResourcePlatforms.CurseForge Then 'CurseForge
|
||||
Return New ResourceProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId)("data"))
|
||||
Else 'Modrinth
|
||||
Return New ResourceProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId))
|
||||
End If
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 从工程 ID 列表联网获取工程信息，结果不按原顺序排列。
|
||||
''' </summary>
|
||||
Public Shared Iterator Function FromProjectIds(ProjectIds As IEnumerable(Of String), Platform As ResourcePlatforms) As IEnumerable(Of ResourceProject)
|
||||
If Not Platform.Flags.IsSingle Then Throw New ArgumentException($"必须指定单一平台，当前值为 {Platform}")
|
||||
'获取缓存
|
||||
Dim MissingProjectIds As New List(Of String)
|
||||
For Each ProjectId In ProjectIds
|
||||
If Cache.ContainsKey(ProjectId) Then
|
||||
Yield Cache(ProjectId)
|
||||
Else
|
||||
MissingProjectIds.Add(ProjectId)
|
||||
End If
|
||||
Next
|
||||
If Not MissingProjectIds.Any() Then Return
|
||||
'联网获取剩余的工程对象
|
||||
Dim Projects As JArray
|
||||
If Platform.HasFlag(ResourcePlatforms.CurseForge) Then
|
||||
Projects = DlModRequest("https://api.curseforge.com/v1/mods",
|
||||
HttpMethod.Post, "{""modIds"": [" & MissingProjectIds.Join(","c) & "]}", "application/json")("data")
|
||||
Else
|
||||
Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{MissingProjectIds.Join(""",""")}""]")
|
||||
End If
|
||||
For Each Project In Projects
|
||||
Yield New ResourceProject(Project)
|
||||
Next
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 将当前实例转为可用于保存缓存的 Json。
|
||||
''' </summary>
|
||||
Public Function ToJson() As JObject
|
||||
Dim Json As New JObject
|
||||
Json("Platform") = CInt(Platform)
|
||||
Json("Types") = CInt(Types)
|
||||
Json("Slug") = Slug
|
||||
Json("Id") = Id
|
||||
If CurseForgeFileIds IsNot Nothing Then Json("CurseForgeFileIds") = New JArray(CurseForgeFileIds)
|
||||
Json("RawName") = RawName
|
||||
Json("Description") = Description
|
||||
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)))
|
||||
Json("Tags") = New JArray(Tags)
|
||||
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
|
||||
If Drops.Any Then Json("Drops") = New JArray(Drops)
|
||||
Json("CacheTime") = Date.Now '用于检查缓存时间
|
||||
Return Json
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 将当前工程信息实例化为控件。
|
||||
''' </summary>
|
||||
Public Function ToResourceItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean) As MyVirtualizingElement(Of MyResourceItem)
|
||||
'获取版本描述
|
||||
Dim GameVersionDescription As String
|
||||
If Drops Is Nothing OrElse Not Drops.Any() Then
|
||||
GameVersionDescription = "仅快照版本" '#5412
|
||||
Else
|
||||
Dim Segments As New List(Of String)
|
||||
Dim IsOld As Boolean = False
|
||||
For i = 0 To Drops.Count - 1 '版本号一定为降序
|
||||
'获取当前连续的版本号段
|
||||
Dim StartDrop As Integer = Drops(i), EndDrop As Integer = Drops(i)
|
||||
If StartDrop < 120 Then '如果支持新版本，则不显示 1.11-
|
||||
If Segments.Any() AndAlso Not IsOld Then
|
||||
Exit For
|
||||
Else
|
||||
IsOld = True
|
||||
End If
|
||||
End If
|
||||
For ii = i + 1 To Drops.Count - 1
|
||||
If AllDrops Is Nothing OrElse AllDrops.IndexOf(Drops(ii)) <> AllDrops.IndexOf(EndDrop) + 1 Then Exit For
|
||||
EndDrop = Drops(ii)
|
||||
i = ii
|
||||
Next
|
||||
'将版本号段转为描述文本
|
||||
Dim StartName = McVersion.DropToVersion(StartDrop)
|
||||
Dim EndName = McVersion.DropToVersion(EndDrop)
|
||||
If StartDrop = EndDrop Then
|
||||
Segments.Add(StartName)
|
||||
ElseIf AllDrops IsNot Nothing AndAlso StartDrop >= AllDrops.First Then
|
||||
If EndDrop < 120 Then
|
||||
Segments.Clear()
|
||||
Segments.Add("全版本")
|
||||
Exit For
|
||||
Else
|
||||
Segments.Add(EndName & "+")
|
||||
End If
|
||||
ElseIf EndDrop < 120 Then
|
||||
Segments.Add(StartName & "-")
|
||||
Exit For
|
||||
ElseIf AllDrops Is Nothing OrElse AllDrops.IndexOf(EndDrop) - AllDrops.IndexOf(StartDrop) = 1 Then
|
||||
Segments.Add(StartName & ", " & EndName)
|
||||
Else
|
||||
Segments.Add(StartName & "~" & EndName)
|
||||
End If
|
||||
Next
|
||||
GameVersionDescription = Segments.Join(", ")
|
||||
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)
|
||||
Select Case ModLoadersForDesc.Count
|
||||
Case 0
|
||||
If Loaders.IsSingle Then
|
||||
ModLoaderDescriptionFull = "仅 " & Loaders.Single.ToString
|
||||
ModLoaderDescriptionPart = Loaders.Single.ToString
|
||||
Else
|
||||
ModLoaderDescriptionFull = "未知"
|
||||
ModLoaderDescriptionPart = ""
|
||||
End If
|
||||
Case 1
|
||||
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
|
||||
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
|
||||
ModLoaderDescriptionFull = "任意"
|
||||
ModLoaderDescriptionPart = ""
|
||||
Else
|
||||
ModLoaderDescriptionFull = ModLoadersForDesc.Join(" / ")
|
||||
ModLoaderDescriptionPart = ModLoadersForDesc.Join(" / ")
|
||||
End If
|
||||
End Select
|
||||
'实例化 UI
|
||||
Return New MyVirtualizingElement(Of MyResourceItem)(
|
||||
Function()
|
||||
Dim NewItem As New MyResourceItem With {.Tag = Me}
|
||||
ApplyLogoToMyImage(NewItem.PathLogo)
|
||||
Dim Titles = GetControlTitle(True)
|
||||
NewItem.Title = Titles.Title
|
||||
If Titles.SubTitle = "" Then
|
||||
CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
|
||||
Else
|
||||
NewItem.SubTitle = Titles.SubTitle
|
||||
End If
|
||||
NewItem.Tags = Tags
|
||||
NewItem.Description = Description.ReplaceLineEndings("")
|
||||
'下边栏
|
||||
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.ColumnVersion1.Width = New GridLength(0)
|
||||
NewItem.ColumnVersion2.MaxWidth = 0
|
||||
NewItem.ColumnVersion3.Width = New GridLength(0)
|
||||
ElseIf ShowMcVersionDesc AndAlso ShowLoaderDesc Then
|
||||
'全部显示
|
||||
NewItem.LabVersion.Text = If(ModLoaderDescriptionPart = "", "", ModLoaderDescriptionPart & " ") & GameVersionDescription
|
||||
ElseIf ShowMcVersionDesc Then
|
||||
'仅显示版本
|
||||
NewItem.LabVersion.Text = GameVersionDescription
|
||||
Else
|
||||
'仅显示 Mod 加载器
|
||||
NewItem.LabVersion.Text = ModLoaderDescriptionFull
|
||||
End If
|
||||
NewItem.LabSource.Text = Platform.ToString
|
||||
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
|
||||
NewItem.LabDownload.Text =
|
||||
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
|
||||
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
|
||||
Return NewItem
|
||||
End Function) With {.Height = 64}
|
||||
End Function
|
||||
Public Sub ApplyLogoToMyImage(Img As MyImage)
|
||||
If String.IsNullOrEmpty(LogoUrl) Then
|
||||
Img.Source = PathImage & "Icons/NoIcon.png"
|
||||
Else
|
||||
Img.Source = LogoUrl
|
||||
Img.FallbackSource = DlSourceModGet(LogoUrl)
|
||||
End If
|
||||
End Sub
|
||||
Public Function GetControlTitle(HasModLoaderDescription As Boolean) As (Title As String, SubTitle As String)
|
||||
'检查下列代码时可以参考 #1567 的测试例
|
||||
Dim Title As String = RawName
|
||||
Dim SubtitleList As List(Of String)
|
||||
If TranslatedName = RawName Then
|
||||
'没有中文翻译
|
||||
'将所有名称分段
|
||||
Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
|
||||
Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w))
|
||||
If NameLists.IsSingle Then GoTo NoSubtitle
|
||||
'查找其中的缩写、Forge/Fabric 等版本标记
|
||||
SubtitleList = New List(Of String)
|
||||
Dim NormalNameList = New List(Of String)
|
||||
For Each Name In NameLists
|
||||
Dim LowerName As String = Name.Lower
|
||||
If Name = Name.Upper AndAlso Name <> "FPS" AndAlso Name <> "HUD" Then
|
||||
'缩写
|
||||
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 '去掉关键词后没有其他字母
|
||||
'Forge/Fabric 等版本标记
|
||||
SubtitleList.Add(Name)
|
||||
Else
|
||||
'其他部分
|
||||
NormalNameList.Add(Name)
|
||||
End If
|
||||
Next
|
||||
'根据分类后的结果处理
|
||||
If Not NormalNameList.Any() OrElse Not SubtitleList.Any() Then GoTo NoSubtitle
|
||||
'同时包含 NormalName 和 Subtitle
|
||||
Title = NormalNameList.Join(" - ")
|
||||
Else
|
||||
'有中文翻译
|
||||
'尝试将文本分为三段：Title (EnglishName) - Suffix
|
||||
'检查时注意 Carpet（它没有中文译名，但有 Suffix）和 “汤姆存储 - 星的奇妙优化 (Tom's balabala)”
|
||||
Title = If(TranslatedName.Contains(" ("), TranslatedName.BeforeFirst(" ("), TranslatedName.BeforeLast(" - "))
|
||||
Dim Suffix As String = ""
|
||||
If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ")
|
||||
Dim EnglishName As String = TranslatedName
|
||||
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
|
||||
EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
|
||||
'中段的额外信息截取
|
||||
SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
|
||||
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 版
|
||||
Not (SubtitleList.Count = 2 AndAlso SubtitleList.Last.Upper = SubtitleList.Last) Then '不是缩写
|
||||
SubtitleList = New List(Of String) From {EnglishName} '使用原名
|
||||
End If
|
||||
'添加后缀
|
||||
If Suffix <> "" Then SubtitleList.Add(Suffix)
|
||||
End If
|
||||
SubtitleList = SubtitleList.Distinct.ToList()
|
||||
'设置标题与描述
|
||||
Dim Subtitle As String = ""
|
||||
If SubtitleList.Any Then
|
||||
For Each Ex In SubtitleList
|
||||
Dim IsModLoaderDescription As Boolean =
|
||||
Ex.Lower.Contains("neoforge") OrElse Ex.Lower.Contains("forge") OrElse Ex.Lower.Contains("fabric") OrElse Ex.Lower.Contains("quilt")
|
||||
'是否显示 ModLoader 信息
|
||||
If Not HasModLoaderDescription AndAlso IsModLoaderDescription Then Continue For
|
||||
'去除 “Forge/Fabric” 这一无意义提示
|
||||
If Ex.Length < 16 AndAlso Ex.Lower.Contains("fabric") AndAlso Ex.Lower.Contains("forge") Then Continue For
|
||||
'将 “Forge” 等提示改为 “Forge 版”
|
||||
If IsModLoaderDescription AndAlso Not Ex.Contains("版") AndAlso
|
||||
Ex.Lower.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", "").Length <= 3 Then
|
||||
Ex = Ex.Replace("Edition", "").Replace("edition", "").Trim.Capitalize & " 版"
|
||||
End If
|
||||
'将 “forge” 等词语的首字母大写
|
||||
Ex = Ex.Replace("neoforge", "NeoForge").Replace("forge", "Forge").Replace("neo", "Neo").Replace("fabric", "Fabric").Replace("quilt", "Quilt")
|
||||
Subtitle &= " | " & Ex.Trim
|
||||
Next
|
||||
Else
|
||||
NoSubtitle:
|
||||
Subtitle = ""
|
||||
End If
|
||||
Return (Title, Subtitle)
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 工程 ID 对应的工程实例的缓存。不会保存到文件。
|
||||
''' </summary>
|
||||
Protected Friend Shared Cache As New Dictionary(Of String, ResourceProject)
|
||||
|
||||
''' <summary>
|
||||
''' 检查是否与某个 Project 是相同的工程，只是在不同的网站。
|
||||
''' </summary>
|
||||
Public Function IsLike(Project As ResourceProject) 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.Lower
|
||||
End Function
|
||||
'来自不同的网站
|
||||
If Platform = Project.Platform Then Return False
|
||||
'Mod 加载器一致
|
||||
If Loaders.Count <> Project.Loaders.Count OrElse Loaders.Except(Project.Loaders).Any() Then Return False
|
||||
'若不为光影，则要求 MC 版本一致
|
||||
If Types <> ResourceTypes.Shader AndAlso (Drops.Count <> Project.Drops.Count OrElse Drops.Except(Project.Drops).Any()) 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}) 认定为相似工程")
|
||||
'如果只有一个有 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
|
||||
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, ResourceProject)
|
||||
Return project IsNot Nothing AndAlso Id = project.Id
|
||||
End Function
|
||||
Public Shared Operator =(left As ResourceProject, right As ResourceProject) As Boolean
|
||||
Return EqualityComparer(Of ResourceProject).Default.Equals(left, right)
|
||||
End Operator
|
||||
Public Shared Operator <>(left As ResourceProject, right As ResourceProject) As Boolean
|
||||
Return Not left = right
|
||||
End Operator
|
||||
|
||||
End Class
|
||||
@@ -0,0 +1,515 @@
|
||||
Public Class ResourceSearcher
|
||||
Private Const RESULT_PAGE_SIZE = 40
|
||||
Private Const MSG_NO_CHINESE_RESULT As String = "无搜索结果，请尝试搜索其英文名称"
|
||||
|
||||
'输入
|
||||
Public Class SearchRequest
|
||||
|
||||
'结果要求
|
||||
|
||||
''' <summary>
|
||||
''' 结果存储器，会从中获取需加载的页面等。
|
||||
''' 加载后也应输出到此处。
|
||||
''' </summary>
|
||||
Public Storage As SearchResult
|
||||
''' <summary>
|
||||
''' 应当尽量达成的结果数量。
|
||||
''' </summary>
|
||||
Public TargetResultCount As Integer
|
||||
''' <summary>
|
||||
''' 根据加载位置记录，是否还可以继续获取内容。
|
||||
''' </summary>
|
||||
Public ReadOnly Property CanContinue As Boolean
|
||||
Get
|
||||
If Tag.StartsWithF("/") OrElse Not Sources.HasFlag(ResourcePlatforms.CurseForge) Then Storage.CurseForgeTotal = 0
|
||||
If Tag.EndsWithF("/") OrElse Not Sources.HasFlag(ResourcePlatforms.Modrinth) 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 ResourceTypes
|
||||
''' <summary>
|
||||
''' 筛选资源标签。空字符串代表不限制。格式例如 "406/worldgen"，分别是 CurseForge 和 Modrinth 的 ID。
|
||||
''' </summary>
|
||||
Public Tag As String = ""
|
||||
''' <summary>
|
||||
''' 筛选 Mod 加载器类别。
|
||||
''' </summary>
|
||||
Public ModLoader As ModLoaderTypes = ModLoaderTypes.Any
|
||||
''' <summary>
|
||||
''' 筛选 MC 版本。
|
||||
''' </summary>
|
||||
Public GameVersion As String = Nothing
|
||||
''' <summary>
|
||||
''' 搜索的初始内容。
|
||||
''' </summary>
|
||||
Public SearchText As String = Nothing
|
||||
''' <summary>
|
||||
''' 允许的来源。
|
||||
''' </summary>
|
||||
Public Sources As ResourcePlatforms = ResourcePlatforms.Any
|
||||
Public Sub New(Type As ResourceTypes, Storage As SearchResult, TargetResultCount As Integer)
|
||||
Me.Type = Type
|
||||
Me.Storage = Storage
|
||||
Me.TargetResultCount = TargetResultCount
|
||||
End Sub
|
||||
|
||||
'构造请求
|
||||
|
||||
''' <summary>
|
||||
''' 获取对应的 CurseForge API 请求链接。
|
||||
''' </summary>
|
||||
Public Function GetCurseForgeAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
|
||||
If Tag.StartsWithF("/") Then Storage.CurseForgeTotal = 0
|
||||
'应用筛选参数
|
||||
Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={RESULT_PAGE_SIZE}"
|
||||
Select Case Type
|
||||
Case ResourceTypes.Mod
|
||||
Address += "&classId=6"
|
||||
Case ResourceTypes.ModPack
|
||||
Address += "&classId=4471"
|
||||
Case ResourceTypes.DataPack
|
||||
Address += "&classId=6945"
|
||||
Case ResourceTypes.Shader
|
||||
Address += "&classId=6552"
|
||||
Case ResourceTypes.ResourcePack
|
||||
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 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
|
||||
Return Address
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 获取对应的 Modrinth API 请求链接。
|
||||
''' </summary>
|
||||
Public Function GetModrinthAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
|
||||
If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
|
||||
'应用筛选参数
|
||||
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"]]
|
||||
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 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, 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
|
||||
GameVersion = request.GameVersion AndAlso SearchText = request.SearchText
|
||||
End Function
|
||||
Public Shared Operator =(left As SearchRequest, right As SearchRequest) As Boolean
|
||||
Return EqualityComparer(Of SearchRequest).Default.Equals(left, right)
|
||||
End Operator
|
||||
Public Shared Operator <>(left As SearchRequest, right As SearchRequest) As Boolean
|
||||
Return Not left = right
|
||||
End Operator
|
||||
Public Overrides Function GetHashCode() As Integer
|
||||
Return (Type, Tag, ModLoader, GameVersion, SearchText, Sources).GetHashCode()
|
||||
End Function
|
||||
|
||||
End Class
|
||||
|
||||
'输出
|
||||
Public Class SearchResult
|
||||
|
||||
'加载位置记录
|
||||
|
||||
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 ResourceProject)
|
||||
''' <summary>
|
||||
''' 当前的错误信息。如果没有则为 Nothing。
|
||||
''' </summary>
|
||||
Public ErrorMessage As String = Nothing
|
||||
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
''' 根据搜索请求获取一系列的工程列表。
|
||||
''' </summary>
|
||||
Public Shared Function GetLoader(InputDelegate As Func(Of SearchRequest)) As LoaderTask(Of SearchRequest, Integer)
|
||||
Return New LoaderTask(Of SearchRequest, Integer)("社区资源获取", AddressOf Run, InputDelegate) With {.ReloadTimeout = 60 * 1000}
|
||||
End Function
|
||||
Private Shared Sub Run(Task As LoaderTask(Of SearchRequest, Integer))
|
||||
Dim Request As SearchRequest = Task.Input
|
||||
Dim Storage = Request.Storage '避免其他线程对 Request.Storage 重新进行了赋值
|
||||
|
||||
#Region "前置检查"
|
||||
|
||||
If Storage.Results.Count >= Request.TargetResultCount Then
|
||||
Log($"[Resource] 已有 {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} 个结果，但无法继续获取，结束处理")
|
||||
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
|
||||
Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
|
||||
End If
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "中文搜索"
|
||||
|
||||
Dim RawSearchText As String = If(Request.SearchText, "").Trim
|
||||
RawSearchText = RawSearchText.Lower
|
||||
Log("[Resource] 工程列表搜索原始文本：" & RawSearchText)
|
||||
|
||||
Dim IsChineseSearch As Boolean =
|
||||
RegexCheck(RawSearchText, "[\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
|
||||
'帮助方法：从搜索项提取可能的英文单词
|
||||
Dim ExtractWords =
|
||||
Function(Result As SearchEntry(Of WikiEntry), Source As ResourcePlatforms) As IEnumerable(Of String)
|
||||
'从各个可能的来源提取候选
|
||||
Dim Candidates As New List(Of String)
|
||||
If Result.Item.CurseForgeSlug IsNot Nothing AndAlso Source = ResourcePlatforms.CurseForge Then
|
||||
Candidates.Add(Result.Item.CurseForgeSlug.Replace("-", " ").Replace("/", " "))
|
||||
End If
|
||||
If Result.Item.ModrinthSlug IsNot Nothing AndAlso Source = ResourcePlatforms.Modrinth Then
|
||||
Candidates.Add(Result.Item.ModrinthSlug.Replace("-", " ").Replace("/", " "))
|
||||
End If
|
||||
Candidates.Add(Result.Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
|
||||
Replace("-", " ").Replace("/", " ").Replace(":", " ").Replace("(", " ").Replace(")", ""))
|
||||
'分词、清洗、去重
|
||||
Candidates = Candidates.
|
||||
SelectMany(Function(c) c.Split(" ")).
|
||||
Select(Function(w) w.TrimStart("{[(").TrimEnd("}])").Lower).
|
||||
Where(
|
||||
Function(w)
|
||||
If w.Length <= 1 Then Return False '单字或空白
|
||||
If {"the", "of", "mod", "and", "forge", "fabric", "for", "quilt", "neoforge"}.Contains(w) Then Return False '常见词
|
||||
If Val(w) > 0 Then Return False '数字
|
||||
Return True
|
||||
End Function).Distinct.ToList
|
||||
'如果一个词可以由其他词拼成，则去掉这个词（例如将 ender io enderio 的 enderio 剔除，只保留 ender io）
|
||||
Dim CanForm As Func(Of String, Boolean) = Nothing
|
||||
CanForm = Function(s) Candidates.Contains(s) OrElse Candidates.Any(Function(c) s.StartsWith(c) AndAlso CanForm(s.Substring(c.Length)))
|
||||
Candidates = Candidates.Where(Function(w) Not Candidates.Any(Function(c) c.Length < w.Length AndAlso w.StartsWith(c) AndAlso CanForm(w.Substring(c.Length)))).ToList()
|
||||
Return Candidates
|
||||
End Function
|
||||
'CurseForge
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.CurseForge) Then
|
||||
'数据库搜索
|
||||
Static CurseForgeSearchEntries As List(Of SearchEntry(Of WikiEntry)) =
|
||||
WikiEntry.All.Where(Function(Entry) Entry.CurseForgeSlug IsNot Nothing).Select(
|
||||
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.AfterFirst(" (") & Entry.CurseForgeSlug, 0.5)}
|
||||
}).ToList
|
||||
Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25)
|
||||
If CurseForgeSearchResults.Any Then
|
||||
'选取目标（CurseForge 要求每个词都必须匹配上，所以只能选择一个 Mod 进行搜索）
|
||||
Dim CurseForgeTarget =
|
||||
If(CurseForgeSearchResults.First.AbsoluteRight,
|
||||
CurseForgeSearchResults.Where(Function(s) s.AbsoluteRight).ToList, '优先使用所有完全匹配的
|
||||
CurseForgeSearchResults.MaxByAll(Function(s) s.Similarity)). '其次使用所有相似度最高的
|
||||
MaxBy(Function(s) s.Item.Popularity) '然后从中选择最受欢迎的那一个
|
||||
'后处理
|
||||
CurseForgeAltSearchText = ExtractWords(CurseForgeTarget, ResourcePlatforms.CurseForge).Join(" ")
|
||||
Log("[Resource] 中文搜索关键词（CurseForge）：" & CurseForgeAltSearchText, NotifyLevel.DebugModeOnly)
|
||||
End If
|
||||
End If
|
||||
'Modrinth
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) Then
|
||||
'数据库搜索
|
||||
Static ModrinthSearchEntries As List(Of SearchEntry(Of WikiEntry)) =
|
||||
WikiEntry.All.Where(Function(Entry) Entry.ModrinthSlug IsNot Nothing).Select(
|
||||
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.AfterFirst(" (") & Entry.ModrinthSlug, 0.5)}
|
||||
}).ToList
|
||||
Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25)
|
||||
If ModrinthSearchResults.Any Then
|
||||
'分词
|
||||
Dim WordWeights As New Dictionary(Of String, Double) '各个单词及其出现的权重
|
||||
For Each Result In ModrinthSearchResults
|
||||
For Each Word In ExtractWords(Result, ResourcePlatforms.Modrinth)
|
||||
If Not WordWeights.ContainsKey(Word) Then WordWeights.Add(Word, 0)
|
||||
Dim Similarity = If(Result.SearchSource.Any(Function(s) s.Aliases.Contains(RawSearchText)), 1000, Result.Similarity) '完全匹配为 1000
|
||||
WordWeights(Word) += Similarity * Result.Item.Popularity '权重 += 相似度 * 受欢迎程度
|
||||
Next
|
||||
Next
|
||||
ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key
|
||||
Log("[Resource] 中文搜索关键词（Modrinth）：" & ModrinthAltSearchText, NotifyLevel.DebugModeOnly)
|
||||
'直接请求工程
|
||||
ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.ModrinthSlug).ToList
|
||||
End If
|
||||
End If
|
||||
'结束
|
||||
If String.IsNullOrEmpty(CurseForgeAltSearchText) AndAlso String.IsNullOrEmpty(ModrinthAltSearchText) AndAlso Not ModrinthSlugs.Any Then
|
||||
Throw New Exception(MSG_NO_CHINESE_RESULT)
|
||||
End If
|
||||
End If
|
||||
Task.Progress = 0.05
|
||||
|
||||
#End Region
|
||||
|
||||
Dim RealResults As New List(Of ResourceProject)
|
||||
NextPage:
|
||||
Dim RawResults As New ConcurrentList(Of ResourceProject)
|
||||
|
||||
#Region "从 CurseForge 和 Modrinth 获取结果列表，存储于 RawResults"
|
||||
|
||||
Dim WorkThreads As New List(Of Thread)
|
||||
Dim Errors As New ConcurrentList(Of (Ex As Exception, Source As ResourcePlatforms))
|
||||
|
||||
'在 1.14-，部分老 Mod 没有设置支持的加载器，因此添加 Forge 筛选就会出现遗漏
|
||||
'所以，在发起请求时不筛选加载器，然后在返回的结果中自行筛除不是 Forge 的 Mod
|
||||
Dim IgnoreModLoaderFilter = Request.ModLoader = ModLoaderTypes.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140
|
||||
Try
|
||||
|
||||
'CurseForge 搜索
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.CurseForge) AndAlso
|
||||
Not (Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset) AndAlso '剩余的未显示的搜索结果不足
|
||||
(Not IsChineseSearch OrElse (IsChineseSearch AndAlso Not String.IsNullOrEmpty(CurseForgeAltSearchText))) Then '如果是中文搜索，就只在有对应搜索关键词的时候才继续
|
||||
WorkThreads.Add(RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
'获取工程列表
|
||||
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress(If(CurseForgeAltSearchText, RawSearchText), IgnoreModLoaderFilter)
|
||||
Log("[Resource] 开始 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 将一些数据包分类成了资源包
|
||||
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} 个）")
|
||||
Catch ex As Exception
|
||||
Log(ex, "CurseForge 搜索失败")
|
||||
Storage.CurseForgeTotal = -1
|
||||
Errors.Add((ex, ResourcePlatforms.CurseForge))
|
||||
End Try
|
||||
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够
|
||||
End Sub, "CurseForge Search"))
|
||||
End If
|
||||
|
||||
'Modrinth 搜索
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) AndAlso
|
||||
Not (Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset) AndAlso '剩余的未显示的搜索结果不足
|
||||
(Not IsChineseSearch OrElse (IsChineseSearch AndAlso Not String.IsNullOrEmpty(ModrinthAltSearchText))) Then '如果是中文搜索，就只在有对应搜索关键词的时候才继续
|
||||
WorkThreads.Add(RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Dim ModrinthUrl As String = Request.GetModrinthAddress(If(ModrinthAltSearchText, RawSearchText), IgnoreModLoaderFilter)
|
||||
Log("[Resource] 开始 Modrinth 搜索：" & ModrinthUrl)
|
||||
Dim RequestResult As JObject = DlModRequest(ModrinthUrl)
|
||||
Dim ProjectList As New List(Of ResourceProject)
|
||||
For Each JsonEntry As JObject In RequestResult("hits")
|
||||
ProjectList.Add(New ResourceProject(JsonEntry))
|
||||
Next
|
||||
'更新结果
|
||||
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} 个）")
|
||||
Catch ex As Exception
|
||||
Log(ex, "Modrinth 搜索失败")
|
||||
Storage.ModrinthTotal = -1
|
||||
Errors.Add((ex, ResourcePlatforms.Modrinth))
|
||||
End Try
|
||||
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够
|
||||
End Sub, "Modrinth Search"))
|
||||
End If
|
||||
|
||||
'Modrinth 直接获取工程
|
||||
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) AndAlso
|
||||
Not (Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset) AndAlso '剩余的未显示的搜索结果不足
|
||||
ModrinthSlugs.Any Then '有直接获取的 Slug
|
||||
WorkThreads.Add(RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Dim ModrinthUrl As String = $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthSlugs.Join(""",""")}""]"
|
||||
Log("[Resource] 开始 Modrinth 直接获取：" & ModrinthUrl)
|
||||
Dim ProjectList As New List(Of ResourceProject)
|
||||
For Each JsonEntry As JObject In DlModRequest(ModrinthUrl)
|
||||
Dim Project As New ResourceProject(JsonEntry)
|
||||
'应用筛选
|
||||
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 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} 个工程")
|
||||
ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
|
||||
Catch ex As Exception
|
||||
Log(ex, "Modrinth 直接获取失败")
|
||||
Errors.Add((ex, ResourcePlatforms.Modrinth))
|
||||
End Try
|
||||
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够
|
||||
End Sub, "Modrinth Get"))
|
||||
End If
|
||||
|
||||
'等待线程结束
|
||||
For Each Thread In WorkThreads
|
||||
Thread.Join()
|
||||
If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程
|
||||
Next
|
||||
|
||||
'筛除不是 Forge 的 Mod
|
||||
If IgnoreModLoaderFilter Then
|
||||
RawResults = RawResults.Where(Function(p) Not p.Loaders.Any() OrElse p.Loaders.Contains(ModLoaderTypes.Forge)).ToList
|
||||
End If
|
||||
|
||||
'确保存在结果
|
||||
Storage.ErrorMessage = Nothing
|
||||
If Not RawResults.Any() Then
|
||||
If Errors.Any() Then
|
||||
Throw Errors.First.Ex
|
||||
Else
|
||||
If IsChineseSearch AndAlso Not (Request.Type = ResourceTypes.Mod OrElse Request.Type = ResourceTypes.DataPack) Then
|
||||
Throw New Exception(MSG_NO_CHINESE_RESULT)
|
||||
ElseIf Request.Sources = ResourcePlatforms.CurseForge AndAlso Request.Tag.StartsWithF("/") Then
|
||||
Throw New Exception("CurseForge 不兼容所选的类型")
|
||||
ElseIf Request.Sources = ResourcePlatforms.Modrinth AndAlso Request.Tag.EndsWithF("/") Then
|
||||
Throw New Exception("Modrinth 不兼容所选的类型")
|
||||
Else
|
||||
Throw New Exception("没有搜索结果")
|
||||
End If
|
||||
End If
|
||||
ElseIf Errors.Any() Then
|
||||
'有结果但是有错误
|
||||
If Errors.Any(Function(e) e.Source = ResourcePlatforms.CurseForge) Then
|
||||
Storage.ErrorMessage = $"无法连接到 CurseForge，所以目前仅显示了来自 Modrinth 的内容，搜索结果可能不全。{vbCrLf}请稍后再试，或使用 VPN 改善网络环境。"
|
||||
Else
|
||||
Storage.ErrorMessage = $"无法连接到 Modrinth，所以目前仅显示了来自 CurseForge 的内容，搜索结果可能不全。{vbCrLf}请稍后再试，或使用 VPN 改善网络环境。"
|
||||
End If
|
||||
End If
|
||||
|
||||
Finally
|
||||
For Each Thread In WorkThreads
|
||||
If Thread.IsAlive Then Thread.Interrupt()
|
||||
Next
|
||||
End Try
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "提取非重复项，存储于 RealResults"
|
||||
|
||||
'将 CurseForge 排在 Modrinth 的前面，避免加载结束顺序不同导致排名不同
|
||||
RawResults = RawResults.Where(Function(x) x.Platform = ResourcePlatforms.CurseForge).Concat(RawResults.Where(Function(x) x.Platform <> ResourcePlatforms.CurseForge)).ToList
|
||||
'去重
|
||||
RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b)).ToList
|
||||
'已有内容去重
|
||||
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($"[Resource] 去重、筛选后累计新增结果 {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} 个")
|
||||
If Request.CanContinue AndAlso Not Errors.Any Then '如果有某个源失败则不再重试，这时候重试可能导致无限循环
|
||||
Log("[Resource] 将继续尝试加载下一页")
|
||||
GoTo NextPage
|
||||
Else
|
||||
Log("[Resource] 无法继续加载，将强制结束")
|
||||
End If
|
||||
End If
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "将结果排序并添加"
|
||||
|
||||
Dim Scores As New Dictionary(Of ResourceProject, Double) '排序分
|
||||
Dim GetDownloadCountMult =
|
||||
Function(Project As ResourceProject) As Double
|
||||
Select Case Request.Type
|
||||
Case ResourceTypes.Mod, ResourceTypes.ModPack
|
||||
Return If(Project.Platform = ResourcePlatforms.CurseForge, 1, 5)
|
||||
Case ResourceTypes.DataPack
|
||||
Return If(Project.Platform = ResourcePlatforms.CurseForge, 10, 1)
|
||||
Case ResourceTypes.ResourcePack, ResourceTypes.Shader
|
||||
Return If(Project.Platform = ResourcePlatforms.CurseForge, 1, 4)
|
||||
Case Else
|
||||
Return 1
|
||||
End Select
|
||||
End Function
|
||||
If String.IsNullOrEmpty(RawSearchText) Then
|
||||
'如果没有搜索文本，按下载量将结果排序
|
||||
For Each Result As ResourceProject In RealResults
|
||||
Scores(Result) = Result.DownloadCount * GetDownloadCountMult(Result)
|
||||
Next
|
||||
Else
|
||||
'如果有搜索文本，按关联度将结果排序
|
||||
'排序分 = 搜索相对相似度 (1) + 下载量权重 (对数，10 亿时为 1) + 有中文名 (0.2)
|
||||
Dim SearchEntries As New List(Of SearchEntry(Of ResourceProject))
|
||||
For Each Result As ResourceProject In RealResults
|
||||
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(Result.Description, 0.05)}})
|
||||
Next
|
||||
Dim SearchResult = Search(SearchEntries, RawSearchText, 10000, -1)
|
||||
For Each OneResult In SearchResult
|
||||
Scores(OneResult.Item) +=
|
||||
If(OneResult.AbsoluteRight, 10, OneResult.Similarity) /
|
||||
If(SearchResult.First.AbsoluteRight, 10, SearchResult.First.Similarity) '最高 1 分的相似度分
|
||||
Next
|
||||
End If
|
||||
'根据排序分得出结果并添加
|
||||
If Task.IsInterrupted Then Throw New ThreadInterruptedException '#8246
|
||||
Storage.Results.AddRange(
|
||||
Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
|
||||
|
||||
#End Region
|
||||
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
@@ -0,0 +1,405 @@
|
||||
''' <summary>
|
||||
''' 社区资源的单个可下载版本。
|
||||
''' </summary>
|
||||
Public Class ResourceVersion
|
||||
|
||||
'基础字段
|
||||
|
||||
''' <summary>
|
||||
''' 用于唯一性鉴别该版本的 ID。CurseForge 中为 123456 的大整数，Modrinth 中为英文乱码的 Version 字段。
|
||||
''' </summary>
|
||||
Public Id As String
|
||||
''' <summary>
|
||||
''' 该版本所对应的单一资源类别。
|
||||
''' </summary>
|
||||
Public ResourceType As ResourceTypes
|
||||
|
||||
'描述性字段
|
||||
|
||||
''' <summary>
|
||||
''' 版本描述名。
|
||||
''' 并非文件名或版本号，是由上传者完全自定义的字段。
|
||||
''' </summary>
|
||||
Public Display As String
|
||||
''' <summary>
|
||||
''' 发布时间。
|
||||
''' </summary>
|
||||
Public ReleaseDate As Date
|
||||
''' <summary>
|
||||
''' 下载量计数。
|
||||
''' 注意，仅为一个平台的计数，无法反映多平台加起来的下载量，且 CurseForge 可能错误地返回 0。
|
||||
''' </summary>
|
||||
Public DownloadCount As Integer
|
||||
''' <summary>
|
||||
''' 版本号。
|
||||
''' 不一定是标准格式。CurseForge 默认为 Nothing。
|
||||
''' </summary>
|
||||
Public Version As String
|
||||
''' <summary>
|
||||
''' 支持的 Mod 加载器列表。
|
||||
''' 可能为空列表，不为 Nothing。
|
||||
''' </summary>
|
||||
Public Loaders As List(Of ModLoaderTypes)
|
||||
''' <summary>
|
||||
''' 支持的游戏版本列表。类型包括："26.1.5"，"26.1"，"26.1 预览版"，"1.18.5"，"1.18"，"1.18 预览版"，"21w15a"，"未知版本"。
|
||||
''' </summary>
|
||||
Public GameVersions As List(Of String)
|
||||
|
||||
''' <summary>
|
||||
''' 发布状态。
|
||||
''' </summary>
|
||||
Public ReleaseType As ReleaseTypes
|
||||
''' <summary>
|
||||
''' 发布状态的友好描述。
|
||||
''' 例如："正式版"，"Beta 版"。
|
||||
''' </summary>
|
||||
Public ReadOnly Property ReleaseTypeDisplay As String
|
||||
Get
|
||||
Select Case ReleaseType
|
||||
Case ReleaseTypes.Release
|
||||
Return "正式版"
|
||||
Case ReleaseTypes.Beta
|
||||
Return If(ModeDebug, "Beta 版", "测试版")
|
||||
Case Else
|
||||
Return If(ModeDebug, "Alpha 版", "早期测试版")
|
||||
End Select
|
||||
End Get
|
||||
End Property
|
||||
Public Enum ReleaseTypes
|
||||
'https://docs.curseforge.com/rest-api/#tocS_FileReleaseType
|
||||
Release = 1
|
||||
Beta = 2
|
||||
Alpha = 3
|
||||
End Enum
|
||||
|
||||
'下载信息
|
||||
|
||||
''' <summary>
|
||||
''' 下载信息是否可用。
|
||||
''' </summary>
|
||||
Public ReadOnly Property DownloadAvailable As Boolean
|
||||
Get
|
||||
Return FileName IsNot Nothing AndAlso DownloadUrls IsNot Nothing
|
||||
End Get
|
||||
End Property
|
||||
''' <summary>
|
||||
''' 文件名。
|
||||
''' </summary>
|
||||
Public FileName As String = Nothing
|
||||
''' <summary>
|
||||
''' 对应文件的所有可能的下载 URL。
|
||||
''' </summary>
|
||||
Public DownloadUrls As List(Of String)
|
||||
''' <summary>
|
||||
''' 对应文件的 SHA1 或 MD5。
|
||||
''' </summary>
|
||||
Public Hash As String = Nothing
|
||||
''' <summary>
|
||||
''' 文件大小。不可用时为 -1。
|
||||
''' </summary>
|
||||
Public Size As Integer = -1
|
||||
''' <summary>
|
||||
''' 作为该版本依赖项的项目 ID。
|
||||
''' 它们可能没有加载，在加载后会添加到 Dependencies 中（主要是因为 Modrinth 返回的是字符串 ID 而非 Slug，导致 Project.Id 查询不到）。
|
||||
''' </summary>
|
||||
Private RawDependencies As New List(Of String)
|
||||
''' <summary>
|
||||
''' 作为该版本依赖项的项目 ID。
|
||||
''' </summary>
|
||||
Public Dependencies As New List(Of String)
|
||||
|
||||
'初始化
|
||||
|
||||
''' <summary>
|
||||
''' 从平台 API 返回的 JSON 中初始化实例。若出错会抛出异常。
|
||||
''' </summary>
|
||||
Public Shared Function FromPlatformJson(Data As JObject, ExpectedResourceType As ResourceTypes) As ResourceVersion
|
||||
Dim Result As New ResourceVersion
|
||||
With Result
|
||||
.ResourceType = ExpectedResourceType
|
||||
If Data.ContainsKey("gameId") Then
|
||||
#Region "CurseForge"
|
||||
'简单信息
|
||||
.Id = Data("id")
|
||||
.Display = Data("displayName").ToString.Replace(" ", "").Trim(" ")
|
||||
.Version = Nothing
|
||||
.ReleaseDate = Data("fileDate")
|
||||
.ReleaseType = CType(Data("releaseType").ToObject(Of Integer), ReleaseTypes)
|
||||
.DownloadCount = Data("downloadCount")
|
||||
.FileName = Data("fileName")
|
||||
.Size = Data("fileLength")
|
||||
.Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 1)?("value")
|
||||
If .Hash Is Nothing Then .Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
|
||||
'DownloadAddress
|
||||
Dim Url = Data("downloadUrl").ToString
|
||||
If Url = "" Then Url = $"https://edge.forgecdn.net/files/{CInt(.Id.ToString.Substring(0, 4))}/{CInt(.Id.ToString.Substring(4))}/{ .FileName}"
|
||||
.DownloadUrls = ParseCurseForgeDownloadUrls(Url.Replace(.FileName, EscapeUtils.UrlEscape(.FileName))) '对脑残 CurseForge 的下载地址进行多种修正
|
||||
.DownloadUrls.Add(DlSourceModGet(Url)) '添加镜像源；注意 MCIM 源不支持 URL 编码后的文件名，必须传入 URL 编码前的文件名
|
||||
.DownloadUrls = .DownloadUrls.Distinct.ToList '最终去重
|
||||
'Dependencies
|
||||
If Data.ContainsKey("dependencies") 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.Lower).ToList
|
||||
.GameVersions = RawVersions.
|
||||
Where(Function(v) McVersion.IsFormatFit(v)).
|
||||
Select(Function(v) v.Replace("-snapshot", " 预览版")).
|
||||
Distinct.ToList
|
||||
If .GameVersions.IsSingle Then
|
||||
.GameVersions = .GameVersions.ToList
|
||||
ElseIf .GameVersions.Count > 1 Then
|
||||
.GameVersions = .GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
|
||||
If .ResourceType = ResourceTypes.ModPack Then .GameVersions = { .GameVersions(0)}.ToList '整合包理应只 “支持” 一个版本
|
||||
Else
|
||||
.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)
|
||||
#End Region
|
||||
Else
|
||||
#Region "Modrinth"
|
||||
'简单信息
|
||||
.Id = Data("id")
|
||||
.Display = Data("name").ToString.Replace(" ", "").Trim(" ")
|
||||
.Version = Data("version_number")
|
||||
.ReleaseDate = Data("date_published")
|
||||
.ReleaseType = If(Data("version_type").ToString = "release", ReleaseTypes.Release, If(Data("version_type").ToString = "beta", ReleaseTypes.Beta, ReleaseTypes.Alpha))
|
||||
.DownloadCount = Data("downloads")
|
||||
If CType(Data("files"), JArray).Any() Then '可能为空
|
||||
Dim File As JToken = Data("files")(0)
|
||||
.FileName = File("filename")
|
||||
.DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
|
||||
.Size = File("size")
|
||||
.Hash = File("hashes")("sha1")
|
||||
End If
|
||||
'Loaders
|
||||
'结果可能混杂着 Mod、数据包和服务端插件
|
||||
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
|
||||
.Loaders = New List(Of ModLoaderTypes)
|
||||
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
|
||||
Else
|
||||
'使用传入的类别，不作修改（#8377）
|
||||
End If
|
||||
'Dependencies
|
||||
If Data.ContainsKey("dependencies") 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.Lower).ToList
|
||||
.GameVersions = RawVersions.Where(Function(v) v.Contains(".")).
|
||||
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).
|
||||
Distinct.ToList
|
||||
If .GameVersions.IsSingle Then
|
||||
'无需处理
|
||||
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
|
||||
Else
|
||||
.GameVersions = New List(Of String) From {"未知版本"}
|
||||
End If
|
||||
#End Region
|
||||
End If
|
||||
End With
|
||||
Return Result
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 从项目 ID 获取其下的全部版本列表，并获取其前置项目信息。
|
||||
''' </summary>
|
||||
Public Shared Function FromProjectId(ProjectId As String, Platform As ResourcePlatforms, Optional LoadDependencies As Boolean = True) As List(Of ResourceVersion)
|
||||
If Not Platform.Flags.IsSingle Then Throw New ArgumentException($"必须指定单一平台，当前值为 {Platform}")
|
||||
Dim TargetProject = ResourceProject.FromProjectId(ProjectId, Platform)
|
||||
'获取项目对象的文件列表
|
||||
If Not ProjectFilesCache.ContainsKey(ProjectId) Then
|
||||
Log("[Resource] 开始获取项目版本列表：" & ProjectId)
|
||||
Dim ResultJsonArray As JArray = Nothing
|
||||
If Platform = ResourcePlatforms.CurseForge Then
|
||||
For RetryCount As Integer = 0 To 2
|
||||
Dim ResultJson As JObject = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=" &
|
||||
(10000 + RetryCount)) '每次重试多请求一个文件，以避免触发 CDN 缓存
|
||||
'HMCL 一次性请求了 10000 个文件，虽然不知道会不会出问题但先这样吧……（#5522）
|
||||
'之前只请求一部分文件的方法备份如下：
|
||||
'If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
|
||||
' ResultJsonArray = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json")("data")
|
||||
'Else '否则使用全部文件
|
||||
' ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999")("data")
|
||||
'End If
|
||||
If ResultJson("pagination")("resultCount").ToObject(Of Integer) = ResultJson("pagination")("totalCount").ToObject(Of Integer) Then
|
||||
ResultJsonArray = ResultJson("data")
|
||||
Exit For
|
||||
ElseIf RetryCount < 2 Then
|
||||
Log($"[Resource] CurseForge 返回的资源版本列表存在缺失，即将进行第 {RetryCount + 1} 次重试", NotifyLevel.DebugModeOnly) '#6224
|
||||
Log($"[Resource] 返回的原始内容如下：{vbCrLf}{ResultJson}")
|
||||
Else
|
||||
Log($"[Resource] CurseForge 返回的资源版本列表存在缺失，返回的原始内容如下：{vbCrLf}{ResultJson}")
|
||||
Throw New Exception("CurseForge 返回的资源版本列表存在缺失")
|
||||
End If
|
||||
Next
|
||||
Else 'Modrinth
|
||||
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version?include_changelog=false")
|
||||
End If
|
||||
ProjectFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) ResourceVersion.FromPlatformJson(a, TargetProject.Types)).
|
||||
Where(Function(a) a.DownloadAvailable).
|
||||
DistinctBy(Function(a) a.Id).ToList 'CurseForge 可能会重复返回相同项（#1330）
|
||||
End If
|
||||
Dim Result As List(Of ResourceVersion) = ProjectFilesCache(ProjectId)
|
||||
If Not LoadDependencies Then Return Result
|
||||
'加载前置信息
|
||||
Dim Dependencies As List(Of String) = Result.SelectMany(Function(f) f.RawDependencies).Distinct().ToList
|
||||
If Dependencies.Any Then
|
||||
Log($"[Resource] 项目 {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
|
||||
File.Dependencies.Add(DependencyProject.Id)
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
End If
|
||||
Return Result
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 项目 ID 对应的版本信息的缓存。不会保存到文件。
|
||||
''' </summary>
|
||||
Protected Friend Shared ProjectFilesCache As New Dictionary(Of String, List(Of ResourceVersion))
|
||||
|
||||
'序列化
|
||||
|
||||
''' <summary>
|
||||
''' 从缓存 JSON 读取字段数据。
|
||||
''' </summary>
|
||||
Public Shared Function FromCacheJson(Data As JObject) As ResourceVersion
|
||||
Dim Result As New ResourceVersion
|
||||
With Result
|
||||
.ResourceType = CType(Data("ResourceType").ToObject(Of Integer), 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)
|
||||
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("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))
|
||||
If Data.ContainsKey("RawDependencies") Then .RawDependencies = Data("RawDependencies").ToObject(Of List(Of String))
|
||||
If Data.ContainsKey("Dependencies") Then .Dependencies = Data("Dependencies").ToObject(Of List(Of String))
|
||||
End With
|
||||
Return Result
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 转为缓存 JSON。
|
||||
''' </summary>
|
||||
Public Function ToCacheJson() As JObject
|
||||
Dim Result As New JObject
|
||||
With Result
|
||||
.Add("ResourceType", ResourceType)
|
||||
.Add("Id", Id)
|
||||
If Version IsNot Nothing Then .Add("Version", Version)
|
||||
.Add("DisplayName", Display)
|
||||
.Add("ReleaseDate", ReleaseDate)
|
||||
.Add("DownloadCount", DownloadCount)
|
||||
.Add("ModLoaders", New JArray(Loaders.Select(Function(m) CInt(m))))
|
||||
.Add("GameVersions", New JArray(GameVersions))
|
||||
.Add("ReleaseType", CInt(ReleaseType))
|
||||
If FileName IsNot Nothing Then .Add("FileName", FileName)
|
||||
If DownloadUrls IsNot Nothing Then .Add("DownloadUrls", New JArray(DownloadUrls))
|
||||
If Hash IsNot Nothing Then .Add("Hash", Hash)
|
||||
If Size >= 0 Then .Add("Size", Size)
|
||||
.Add("RawDependencies", New JArray(RawDependencies))
|
||||
.Add("Dependencies", New JArray(Dependencies))
|
||||
End With
|
||||
Return Result
|
||||
End Function
|
||||
|
||||
'杂项
|
||||
|
||||
''' <summary>
|
||||
''' 转为列表项。
|
||||
''' </summary>
|
||||
Public Function ToListItem(ClickHandler As MyListItem.ClickEventHandler, Optional SaveAsButtonHandler As MyIconButton.ClickEventHandler = Nothing,
|
||||
Optional IsBadDisplay As Boolean = False) As MyVirtualizingElement(Of MyListItem)
|
||||
Return New MyVirtualizingElement(Of MyListItem)(
|
||||
Function()
|
||||
Dim Result As New MyListItem
|
||||
With Result
|
||||
|
||||
'基础属性
|
||||
.SnapsToDevicePixels = True
|
||||
.Height = 42
|
||||
.Type = MyListItem.CheckType.Clickable
|
||||
.Tag = Me
|
||||
.Title = If(IsBadDisplay, FileName, Display)
|
||||
.Logo = $"{PathImage}ReleaseTypes/{ReleaseType}.png"
|
||||
AddHandler .Click, ClickHandler
|
||||
|
||||
'描述
|
||||
.Info =
|
||||
Iterator Function()
|
||||
If .Title <> FileName.BeforeLast(".") Then Yield FileName.BeforeLast(".")
|
||||
If Dependencies.Any Then Yield $"{Dependencies.Count} 项前置"
|
||||
If GameVersions.All(Function(v) Not v.Contains(".") OrElse {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) v.ContainsIgnoreCase(s))) Then Yield $"游戏版本 {GameVersions.Join("、"c)}"
|
||||
If DownloadCount > 0 Then Yield $"下载 {If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万", DownloadCount)} 次" 'CurseForge 的下载次数经常错误地返回 0
|
||||
Yield $"更新于 {GetTimeSpanString(ReleaseDate - Date.Now, False)}"
|
||||
If ReleaseType <> ReleaseTypes.Release Then Yield ReleaseTypeDisplay
|
||||
End Function().Join("，"c)
|
||||
|
||||
'另存为按钮
|
||||
If SaveAsButtonHandler 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, SaveAsButtonHandler
|
||||
.Buttons = {BtnSave}
|
||||
End If
|
||||
|
||||
End With
|
||||
Return Result
|
||||
End Function) With {.Height = 42}
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 获取下载信息。
|
||||
''' </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)
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 重新整理 CurseForge 的下载地址。
|
||||
''' </summary>
|
||||
Public Shared Function ParseCurseForgeDownloadUrls(Url As String) As List(Of String)
|
||||
Return {
|
||||
Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge.", "://mediafilez.").Replace("://media.", "://mediafilez."),
|
||||
Url.Replace("://edge.", "://mediafilez.").Replace("://media.", "://mediafilez."),
|
||||
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
|
||||
Url.Replace("://media.", "://edge."),
|
||||
Url
|
||||
}.Distinct.ToList
|
||||
End Function
|
||||
Public Overrides Function ToString() As String
|
||||
Return $"{Id}: {FileName}"
|
||||
End Function
|
||||
|
||||
End Class
|
||||
@@ -0,0 +1,85 @@
|
||||
'获取所有条目：WikiEntry.All
|
||||
|
||||
''' <summary>
|
||||
''' MC 百科条目。
|
||||
''' </summary>
|
||||
Public Class WikiEntry
|
||||
|
||||
'属性
|
||||
|
||||
''' <summary>
|
||||
''' 在 MC 百科中的对应 ID。
|
||||
''' </summary>
|
||||
Public Id As Integer
|
||||
''' <summary>
|
||||
''' 中文译名。空字符串代表没有翻译。
|
||||
''' </summary>
|
||||
Public ChineseName As String = ""
|
||||
''' <summary>
|
||||
''' CurseForge Slug（例如 advanced-solar-panels）。
|
||||
''' </summary>
|
||||
Public CurseForgeSlug As String = Nothing
|
||||
''' <summary>
|
||||
''' Modrinth Slug（例如 advanced-solar-panels）。
|
||||
''' </summary>
|
||||
Public ModrinthSlug As String = Nothing
|
||||
''' <summary>
|
||||
''' MC 百科的浏览量逆序排行，1 代表浏览量最低。
|
||||
''' </summary>
|
||||
Public Popularity As Integer
|
||||
Public Overrides Function ToString() As String
|
||||
Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & Id & "|" & ChineseName & ", Rank " & Popularity
|
||||
End Function
|
||||
|
||||
'读取
|
||||
|
||||
''' <summary>
|
||||
''' 内置数据库中的所有 MC 百科条目。
|
||||
''' </summary>
|
||||
Public Shared ReadOnly Property All As List(Of WikiEntry)
|
||||
Get
|
||||
Static Cache As List(Of WikiEntry) = Nothing
|
||||
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)
|
||||
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
|
||||
Entry.CurseForgeSlug = Nothing
|
||||
Entry.ModrinthSlug = Splited(1).Replace("@", "")
|
||||
ElseIf Splited(1).EndsWithF("@") Then
|
||||
Entry.CurseForgeSlug = Splited(1).TrimEnd("@")
|
||||
Entry.ModrinthSlug = Entry.CurseForgeSlug
|
||||
ElseIf Splited(1).Contains("@") Then
|
||||
Entry.CurseForgeSlug = Splited(1).Split("@")(0)
|
||||
Entry.ModrinthSlug = Splited(1).Split("@")(1)
|
||||
Else
|
||||
Entry.CurseForgeSlug = Splited(1)
|
||||
Entry.ModrinthSlug = Nothing
|
||||
End If
|
||||
Entry.Id = i
|
||||
If Splited.Count >= 3 Then
|
||||
Entry.ChineseName = Splited.Last
|
||||
If Entry.ChineseName.Contains("*") Then '处理 *
|
||||
Entry.ChineseName = Entry.ChineseName.Replace("*",
|
||||
$" ({If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Replace("-", " ").Capitalize})")
|
||||
End If
|
||||
End If
|
||||
Cache.Add(Entry)
|
||||
Next
|
||||
Next
|
||||
Return Cache
|
||||
End Get
|
||||
End Property
|
||||
|
||||
End Class
|
||||
Reference in New Issue
Block a user