♻️ 🐛 修复关闭版本隔离时的问题

This commit is contained in:
youzi-3222
2025-01-14 16:47:28 +08:00
parent 1dd235d313
commit f6cbb0f986
2 changed files with 118 additions and 111 deletions
@@ -982,7 +982,8 @@ Retry:
"modtranslations", 'Mod 翻译 "modtranslations", 'Mod 翻译
"schematics", 'schematics 模组 "schematics", 'schematics 模组
".*\.BakaCoreInfo", 'BakaXL 配置 ".*\.BakaCoreInfo", 'BakaXL 配置
"hmclversion\.cfg", "log4j2\.xml" 'HMCL 配置 "hmclversion\.cfg", "log4j2\.xml", 'HMCL 配置
"assets", "libraries", "\$natives", "launcher_profiles\.json", "versions" '开启版本隔离时排除的文件
} }
Public Function IsVerRedundant(FilePath As String) As Boolean Public Function IsVerRedundant(FilePath As String) As Boolean
FilePath = FilePath.Replace("/", "\") FilePath = FilePath.Replace("/", "\")
@@ -999,9 +1000,9 @@ Retry:
Private MustExport As String() = { Private MustExport As String() = {
"mods", "PCL", ".*\.json" "mods", "PCL", ".*\.json"
} }
Public Function IsMustExport(FileName As String) As Boolean Public Function IsMustExport(FilePath As String) As Boolean
For Each regex In MustExport For Each regex In MustExport
If RegexCheck(FileName, regex, RegularExpressions.RegexOptions.IgnoreCase) Then Return True If RegexCheck(GetFileNameFromPath(FilePath), regex, RegularExpressions.RegexOptions.IgnoreCase) Then Return True
Next Next
Return False Return False
End Function End Function
@@ -1015,112 +1016,112 @@ Retry:
Log($"[Export] 缓存文件夹:{tempDir}") Log($"[Export] 缓存文件夹:{tempDir}")
Directory.CreateDirectory(tempDir) Directory.CreateDirectory(tempDir)
'步骤 1:从 Modrinth 获取 Mod 工程信息,得到 URL ' '步骤 1:从 Modrinth 获取 Mod 工程信息,得到 URL
Dim Mods As New List(Of McMod) ' Dim Mods As New List(Of McMod)
If Directory.Exists(Version.Path & "mods\") Then ' If Directory.Exists(Version.Path & "mods\") Then
For Each m In Directory.EnumerateFiles(Version.Path & "mods\") ' For Each m In Directory.EnumerateFiles(Version.Path & "mods\")
If m.EndsWithF(".jar") Then Mods.Add(New McMod(m)) ' If m.EndsWithF(".jar") Then Mods.Add(New McMod(m))
Next ' Next
End If ' End If
'从 Modrinth 获取信息 ' '从 Modrinth 获取信息
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList() ' Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST", ' Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject) '$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
Log($"[Export] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息") ' Log($"[Export] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
Dim ModrinthMapping As New Dictionary(Of String, JObject) 'Modrinth 获取到的 Mod ' Dim ModrinthMapping As New Dictionary(Of String, JObject) 'Modrinth 获取到的 Mod
Dim ModrinthFailed As New List(Of McMod) 'Modrinth 获取失败的 Mod ' Dim ModrinthFailed As New List(Of McMod) 'Modrinth 获取失败的 Mod
For Each Entry In Mods ' For Each Entry In Mods
If (Not ModrinthVersion.ContainsKey(Entry.ModrinthHash)) OrElse ' If (Not ModrinthVersion.ContainsKey(Entry.ModrinthHash)) OrElse
(ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash) Then ' (ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash) Then
ModrinthFailed.Add(Entry) ' ModrinthFailed.Add(Entry)
Continue For ' Continue For
End If ' End If
ModrinthMapping.Add(Entry.FileName, ModrinthVersion(Entry.ModrinthHash)("files")(0)) ' ModrinthMapping.Add(Entry.FileName, ModrinthVersion(Entry.ModrinthHash)("files")(0))
Next ' Next
'步骤 2:把获取失败的 Mod 从 CurseForge 继续获取 ' '步骤 2:把获取失败的 Mod 从 CurseForge 继续获取
Dim CurseForgeHashes = ModrinthFailed.Select(Function(m) m.CurseForgeHash).ToList() ' Dim CurseForgeHashes = ModrinthFailed.Select(Function(m) m.CurseForgeHash).ToList()
Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST", ' Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer) ' $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息") ' Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
Dim CurseForgeMapping As New Dictionary(Of String, JObject) 'CurseForge 获取到的 Mod ' Dim CurseForgeMapping As New Dictionary(Of String, JObject) 'CurseForge 获取到的 Mod
For Each m In CurseForgeRaw ' For Each m In CurseForgeRaw
Dim hash As String = "" ' Dim hash As String = ""
For Each h In m("file")("hashes") '获取 Modrinth Hash ' For Each h In m("file")("hashes") '获取 Modrinth Hash
If h("algo").ToString = 1 Then ' If h("algo").ToString = 1 Then
hash = h("value") ' hash = h("value")
Exit For ' Exit For
End If ' End If
Next ' Next
If String.IsNullOrEmpty(hash) OrElse String.IsNullOrEmpty(m("file")("downloadUrl")) Then Continue For ' If String.IsNullOrEmpty(hash) OrElse String.IsNullOrEmpty(m("file")("downloadUrl")) Then Continue For
m("file")("ModrinthHash") = hash ' m("file")("ModrinthHash") = hash
CurseForgeMapping.Add(m("file")("fileName"), m("file")) ' CurseForgeMapping.Add(m("file")("fileName"), m("file"))
For Each file In ModrinthFailed ' For Each file In ModrinthFailed
If file.ModrinthHash = hash Then ' If file.ModrinthHash = hash Then
ModrinthFailed.Remove(file) ' ModrinthFailed.Remove(file)
Exit For ' Exit For
End If ' End If
Next ' Next
Next ' Next
'步骤 3:写入 Json 文件 ' '步骤 3:写入 Json 文件
'获取作为检查目标的加载器和版本 ' '获取作为检查目标的加载器和版本
Dim ModLoaders = GetTargetModLoaders() ' Dim ModLoaders = GetTargetModLoaders()
Dim McVersion = Version.Version.McName ' Dim McVersion = Version.Version.McName
Log($"[Export] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}") ' Log($"[Export] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}")
Dim files As New JArray ' Dim files As New JArray
For Each m In ModrinthMapping ' For Each m In ModrinthMapping
files.Add(New JObject From { ' files.Add(New JObject From {
{"path", $"mods/{m.Key}"}, ' {"path", $"mods/{m.Key}"},
{"hashes", m.Value("hashes")}, ' {"hashes", m.Value("hashes")},
{"env", New JObject From {{"client", "required"}, {"server", "required"}}}, ' {"env", New JObject From {{"client", "required"}, {"server", "required"}}},
{"downloads", New JArray From {m.Value("url")}}, ' {"downloads", New JArray From {m.Value("url")}},
{"fileSize", m.Value("size")} ' {"fileSize", m.Value("size")}
}) ' })
Next ' Next
For Each m In CurseForgeMapping ' For Each m In CurseForgeMapping
files.Add(New JObject From { ' files.Add(New JObject From {
{"path", $"mods/{m.Key}"}, ' {"path", $"mods/{m.Key}"},
{"hashes", New JObject From {{"sha1", m.Value("ModrinthHash").ToString}}}, ' {"hashes", New JObject From {{"sha1", m.Value("ModrinthHash").ToString}}},
{"env", New JObject From {{"client", "required"}, {"server", "required"}}}, ' {"env", New JObject From {{"client", "required"}, {"server", "required"}}},
{"downloads", New JArray From {m.Value("downloadUrl")}}, ' {"downloads", New JArray From {m.Value("downloadUrl")}},
{"fileSize", m.Value("fileLength")} ' {"fileSize", m.Value("fileLength")}
}) ' })
Next ' Next
Dim depend As New JObject From {{"minecraft", McVersion}} ' Dim depend As New JObject From {{"minecraft", McVersion}}
If Version.Version.HasForge Then depend.Add("forge", Version.Version.ForgeVersion) ' If Version.Version.HasForge Then depend.Add("forge", Version.Version.ForgeVersion)
If Version.Version.HasFabric Then depend.Add("fabric-loader", Version.Version.FabricVersion) ' If Version.Version.HasFabric Then depend.Add("fabric-loader", Version.Version.FabricVersion)
If Version.Version.HasNeoForge Then depend.Add("neoforge", Version.Version.NeoForgeVersion) ' If Version.Version.HasNeoForge Then depend.Add("neoforge", Version.Version.NeoForgeVersion)
Dim json As New JObject From { ' Dim json As New JObject From {
{"game", "minecraft"}, ' {"game", "minecraft"},
{"formatVersion", 1}, ' {"formatVersion", 1},
{"versionId", VerID}, ' {"versionId", VerID},
{"name", If(String.IsNullOrEmpty(Name), Version.Name, Name)}, ' {"name", If(String.IsNullOrEmpty(Name), Version.Name, Name)},
{"summary", Version.Info}, ' {"summary", Version.Info},
{"files", files}, ' {"files", files},
{"dependencies", depend} ' {"dependencies", depend}
} ' }
File.WriteAllText(tempDir & "modrinth.index.json", json.ToString) ' File.WriteAllText(tempDir & "modrinth.index.json", json.ToString)
'步骤 4:将获取不到的保存到 overrides 目录 ' '步骤 4:将获取不到的保存到 overrides 目录
For Each m In ModrinthFailed ' For Each m In ModrinthFailed
CopyFile(m.Path, tempDir & "overrides\mods\" & m.FileName) ' CopyFile(m.Path, tempDir & "overrides\mods\" & m.FileName)
Next ' Next
'额外文件 '额外文件
For Each p In Additional For Each p In Additional
If String.IsNullOrWhiteSpace(p) Then Continue For '传空字串进去会直接把整个版本文件夹拷过去 If String.IsNullOrWhiteSpace(p) Then Continue For '传空字串进去会直接把整个版本文件夹拷过去
If Not p.StartsWithF(Version.Path, IgnoreCase:=True) Then Continue For If Not p.StartsWithF(GetPathFromFullPath(GetPathFromFullPath(Version.Path)), IgnoreCase:=True) Then Continue For
Dim relative As String = p.Replace(Version.Path, "") Dim relative As String = p.Replace(Version.Path, "").Replace(GetPathFromFullPath(GetPathFromFullPath(Version.Path)), "")
If File.Exists(p) AndAlso Not IsVerRedundant(p) Then If File.Exists(p) AndAlso Not IsVerRedundant(p) Then
CopyFile(p, $"{tempDir}overrides\{relative}") CopyFile(p, $"{tempDir}overrides\{relative}")
End If End If
@@ -46,7 +46,8 @@
''' </summary> ''' </summary>
Private CurrentPath As String = "" Private CurrentPath As String = ""
Private Sub ReloadFileList(Optional NewPath As String = "") Private Sub ReloadFileList(Optional NewPath As String = "")
If String.IsNullOrWhiteSpace(NewPath) Then NewPath = PageVersionLeft.Version.Path If String.IsNullOrWhiteSpace(NewPath) OrElse NewPath = PathMcFolder Then NewPath = PageVersionLeft.Version.Path
If Not NewPath.EndsWithF("\") Then NewPath &= "\"
Dim tb As TextBlock = PanFileList.Children(0) Dim tb As TextBlock = PanFileList.Children(0)
PanFileList.Children.Clear() PanFileList.Children.Clear()
PanFileList.Children.Add(tb) PanFileList.Children.Add(tb)
@@ -58,31 +59,37 @@
End If End If
Dim fileCount As Integer = 0 Dim fileCount As Integer = 0
Dim directories = Directory.EnumerateDirectories(NewPath)
Dim files = Directory.EnumerateFiles(NewPath)
If (NewPath = PageVersionLeft.Version.Path) AndAlso PageVersionLeft.Version.PathIndie = PathMcFolder Then
'未开启版本隔离时 .minecraft 下的文件
directories = directories.Concat(Directory.EnumerateDirectories(PathMcFolder))
files = files.Concat(Directory.EnumerateFiles(PathMcFolder))
End If
For Each d In Directory.EnumerateDirectories(NewPath) For Each d In directories
If Directory.EnumerateFileSystemEntries(d).Count = 0 Then Continue For If Directory.EnumerateFileSystemEntries(d).Count = 0 Then Continue For
d = GetFolderNameFromPath(d) If IsVerRedundant(d) OrElse IsMustExport(d) Then Continue For
If IsVerRedundant(NewPath & d) OrElse IsMustExport(d) Then Continue For
Dim title As String = "" Dim title As String = ""
Dim listItem As New MyListItem Dim listItem As New MyListItem
If Titles.TryGetValue(d, title) Then 'title 作为引用类型传入 If Titles.TryGetValue(GetFolderNameFromPath(d), title) Then 'title 作为引用类型传入
listItem.Title = title listItem.Title = title
listItem.Info = d
Else Else
listItem.Title = d listItem.Title = GetFolderNameFromPath(d)
End If End If
listItem.Info = d
'图标按钮 '图标按钮
Dim btnSwap As New MyIconButton Dim btnSwap As New MyIconButton
btnSwap.Logo = Logo.IconButtonRight btnSwap.Logo = Logo.IconButtonRight
btnSwap.LogoScale = 1.0 btnSwap.LogoScale = 1.0
btnSwap.Tag = d btnSwap.Tag = d & "\"
AddHandler btnSwap.Click, AddressOf BtnSwap_Click AddHandler btnSwap.Click, AddressOf BtnSwap_Click
listItem.Buttons = {btnSwap} listItem.Buttons = {btnSwap}
listItem.Type = MyListItem.CheckType.CheckBox listItem.Type = MyListItem.CheckType.CheckBox
listItem.Height = 35 listItem.Height = 35
listItem.Logo = Logo.IconButtonOpen listItem.Logo = Logo.IconButtonOpen
listItem.Tag = d & "\" listItem.Tag = d & "\"
Select Case IsSelected(NewPath & d & "\") Select Case IsSelected(d & "\")
Case 1 Case 1
listItem.Half = True listItem.Half = True
Case 2 Case 2
@@ -93,21 +100,20 @@
fileCount += 1 fileCount += 1
Next Next
For Each f In Directory.EnumerateFiles(NewPath) For Each f In files
f = GetFileNameFromPath(f) If IsVerRedundant(f) OrElse IsMustExport(f) Then Continue For
If IsVerRedundant(NewPath & f) OrElse IsMustExport(f) Then Continue For
Dim title As String = "" Dim title As String = ""
Dim listItem As New MyListItem Dim listItem As New MyListItem
If Titles.TryGetValue(f, title) Then 'title 作为引用类型传入 If Titles.TryGetValue(f, title) Then 'title 作为引用类型传入
listItem.Title = title listItem.Title = title
listItem.Info = f
Else Else
listItem.Title = f listItem.Title = GetFileNameFromPath(f)
End If End If
listItem.Info = f
listItem.Type = MyListItem.CheckType.CheckBox listItem.Type = MyListItem.CheckType.CheckBox
listItem.Height = 35 listItem.Height = 35
listItem.Tag = f listItem.Tag = f
listItem.Checked = (IsSelected(NewPath & f) = 2) listItem.Checked = (IsSelected(f) = 2)
AddHandler listItem.Click, AddressOf ListItem_Click AddHandler listItem.Click, AddressOf ListItem_Click
PanFileList.Children.Add(listItem) PanFileList.Children.Add(listItem)
fileCount += 1 fileCount += 1
@@ -125,7 +131,7 @@
{"servers.dat", "服务器列表"} {"servers.dat", "服务器列表"}
} }
Private Sub BtnSwap_Click(sender As MyIconButton, e As Object) Private Sub BtnSwap_Click(sender As MyIconButton, e As Object)
Dim actualPath As String = CurrentPath & sender.Tag & "\" Dim actualPath As String = sender.Tag
'Dim relative As String = actualPath.Replace(PageVersionLeft.Version.Path, "") 'Dim relative As String = actualPath.Replace(PageVersionLeft.Version.Path, "")
If Not Directory.Exists(actualPath) Then If Not Directory.Exists(actualPath) Then
@@ -195,7 +201,7 @@
Exit Sub Exit Sub
End If End If
SelectedChange(Not sender.Checked, '非常难绷的逻辑,很难描述清楚,自己打断点看 Checked 属性值吧…… SelectedChange(Not sender.Checked, '非常难绷的逻辑,很难描述清楚,自己打断点看 Checked 属性值吧……
CurrentPath & sender.Tag) sender.Tag)
End Sub End Sub
'Private ReadOnly Property Saves As List(Of String) 'Private ReadOnly Property Saves As List(Of String)
@@ -226,7 +232,7 @@
Private Sub PanFileList_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles PanFileList.MouseLeftButtonUp Private Sub PanFileList_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles PanFileList.MouseLeftButtonUp
For Each c In PanCommonFiles.Children For Each c In PanCommonFiles.Children
If TypeOf c Is MyCheckBox Then If TypeOf c Is MyCheckBox Then
c.Checked = (IsSelected(PageVersionLeft.Version.Path & c.Tag) = 2) c.Checked = IsSelected(PageVersionLeft.Version.Path & c.Tag) = 2 OrElse IsSelected(PathMcFolder & c.Tag) = 2
End If End If
Next Next
End Sub End Sub