PCL/Plain Craft Launcher 2/Modules/Resource/LocalResourceFile.vb

''' <summary>
''' 本地的社区资源文件。
''' </summary>
Public Class LocalResourceFile

#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(FileUtils.GetInfo(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 LocalResourceFile)

    ''' <summary>
    ''' 可读名称。
    ''' 可能为无扩展的文件名，但不会是 Nothing。
    ''' </summary>
    Public Property Display As String
        Get
            If _Display Is Nothing Then _Display = ProjectVersion?.Display
            If _Display Is Nothing Then _Display = PathUtils.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 _Version.RegexCheck("[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 Not FileUtils.Exists(File.FullName) Then Throw New FileNotFoundException("未找到 Mod 文件（" & File.FullName & "）")
            '打开 Jar 文件
            Jar = FileUtils.OpenZip(File.FullName)
            '信息获取
            LoadMetadataFromJar(Jar)
        Catch ex As UnauthorizedAccessException
            Logger.Warn(ex, $"Mod 文件由于无权限无法打开（{File.FullName}）")
        Catch ex As Exception
            Logger.Warn(ex, $"Mod 文件无法打开（{File.FullName}）")
        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 = InfoEntry.Open().ReadString()
                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
            Logger.Warn(ex, $"读取 mcmod.info 时出现未知错误（{File.FullName}）")
        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 = FabricEntry.Open().ReadString(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
            Logger.Warn(ex, $"读取 fabric.mod.json 时出现未知错误（{File.FullName}）")
        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 = TomlEntry.Open().ReadString()
                If TomlText.Length < 15 Then TomlText = Nothing
            End If
            If TomlText Is Nothing Then Exit Try
            '文件标准化：统一换行符为 vbLf，去除注释、头尾的空格、空行
            Dim Lines As New List(Of String)
            For Each Line In TomlText.SplitLines(True)
                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
            Logger.Warn(ex, $"读取 mods.toml 时出现未知错误（{File.FullName}）")
        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 = FmlEntry.Open().ReadString(Encoding.UTF8)
                If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing
            End If
            If FmlText Is Nothing Then Exit Try
            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
            Logger.Warn(ex, $"读取 fml_cache_annotation.json 时出现未知错误（{File.FullName}）")
        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 = MetaEntry.Open().ReadString().Replace(" :", ":").Replace(": ", ":")
                    If MetaString.Contains("Implementation-Version:") Then
                        MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
                        MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
                        Version = MetaString
                    End If
                End If
            Catch ex As Exception
                Logger.Warn($"获取 META-INF 中的版本信息失败（{File.FullName}）")
                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(Of Boolean)("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get(Of Boolean)("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 Cached.RegexCheck("^\d+$") Then '#5062
                    _CurseForgeHash = Cached
                    Return _CurseForgeHash
                End If
                '读取文件
                Dim data As New List(Of Byte)
                For Each b As Byte In FileUtils.ReadAsBytes(File.FullName)
                    If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
                    data.Add(b)
                Next
                '计算 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 = HashUtils.ComputeFromFile(File.FullName, HashUtils.HashMethod.Sha1)
                '写入缓存
                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, LocalResourceFile)
        Return Target IsNot Nothing AndAlso File.FullName = Target.File.FullName
    End Function

#End Region

End Class