This commit is contained in:
龙腾猫跃
2026-01-15 03:20:43 +08:00
parent 87f5cc2ea9
commit 52b4c87fbc
24 changed files with 530 additions and 2212 deletions
@@ -1329,7 +1329,7 @@ Retry:
Dim Installer As ZipArchive = Nothing
Try
'解压并获取、合并两个 Json 的信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open))
@@ -1417,7 +1417,7 @@ Retry:
'记录当前文件夹列表(在新建目标文件夹之前)
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(i) i.FullName).ToList()
'解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
'新建目标版本文件夹
Directory.CreateDirectory(VersionFolder)
@@ -1484,7 +1484,7 @@ Retry:
Dim Installer As ZipArchive = Nothing
Try
'解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Task.Progress = 0.4
@@ -1501,7 +1501,7 @@ Retry:
Task.Progress = 0.6
'解压支持库文件
Installer.Dispose()
ExtractFile(InstallerAddress, InstallerAddress & "_unrar\")
ExtractCompressedFile(InstallerAddress, InstallerAddress & "_unrar\")
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DeleteDirectory(InstallerAddress & "_unrar\")
Else
@@ -94,7 +94,7 @@
<local:ExportOption
Title="整合包重要数据"
Description="脚本文件、内置资源包、数据包等"
Rules="addons/|multiblocked/|modpack-update-checker/|global_packs/|global_resource_packs/|global_data_packs/|optional_data_packs/|maps/|icon.png|mods-resourcepacks/|matmos/|resource_assorts/|resource_assorts.json|patchouli_books/|datapacks/|kubejs*/|!kubejs*/probe/|!kubejs*/exported/|!kubejs*/jsconfig.json|!kubejs*/README.txt|openloader/|worldshape/|resources/|scripts/|structures/|fontfiles/|oresources/|packmenu/|craftpresence/|pointblanks/|template*/|!template*/playerdata/|!template*/stats/"
Rules="addons/|multiblocked/|modpack-update-checker/|global_packs/|global_resource_packs/|global_data_packs/|optional_data_packs/|moonlight-global-datapacks/|maps/|icon.png|mods-resourcepacks/|matmos/|resource_assorts/|resource_assorts.json|patchouli_books/|datapacks/|kubejs*/|!kubejs*/probe/|!kubejs*/exported/|!kubejs*/jsconfig.json|!kubejs*/README.txt|openloader/|worldshape/|resources/|scripts/|structures/|fontfiles/|oresources/|packmenu/|craftpresence/|pointblanks/|template*/|!template*/playerdata/|!template*/stats/"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
@@ -114,6 +114,14 @@
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="已上传的沉浸画"
Rules="immersive_paintings/"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
@@ -424,7 +424,7 @@ Public Class PageInstanceExport
End If
If PackPath Is Nothing Then
Dim Extensions As New List(Of String)
If Not CheckAdvancedModrinth.Checked Then Extensions.Add("压缩文件(*.zip)|*.zip")
Extensions.Add("压缩文件(*.zip)|*.zip")
If Not CheckOptionsPcl.Checked Then Extensions.Add("Modrinth 整合包文件(*.mrpack)|*.mrpack")
PackPath = SelectSaveFile("选择导出位置",
PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), Extensions.Join("|"))
@@ -71,7 +71,7 @@
''' <summary>
''' 已加载的 Mod UI 缓存,不确保按显示顺序排列。Key 为 Mod 的 RawFileName。
''' </summary>
Public ModItems As New Dictionary(Of String, MyLocalModItem)
Public ModItems As New SafeDictionary(Of String, MyLocalModItem)
''' <summary>
''' 将加载器结果的 Mod 列表加载为 UI。
''' </summary>
@@ -87,10 +87,12 @@
Return
End If
'修改缓存
ModItems.Clear()
For Each ModEntity As McMod In McModLoader.Output
ModItems(ModEntity.RawFileName) = McModListItem(ModEntity)
Next
SyncLock ModItems.SyncRoot
ModItems.Clear()
For Each ModEntity As McMod In McModLoader.Output
ModItems(ModEntity.RawFileName) = McModListItem(ModEntity)
Next
End SyncLock
'显示结果
Filter = FilterType.All
SearchBox.Text = "" '这会触发结果刷新,所以需要在 ModItems 更新之后,详见 #3124 的视频
@@ -151,11 +153,13 @@
If ShowingMods.Any() Then
PanList.Visibility = Visibility.Visible
PanList.Children.Clear()
For Each TargetMod In ShowingMods
Dim Item As MyLocalModItem = ModItems(TargetMod.RawFileName)
Item.Checked = SelectedMods.Contains(TargetMod.RawFileName) '更新选中状态
PanList.Children.Add(Item)
Next
SyncLock ModItems.SyncRoot
For Each TargetMod In ShowingMods
Dim Item As MyLocalModItem = ModItems(TargetMod.RawFileName)
Item.Checked = SelectedMods.Contains(TargetMod.RawFileName) '更新选中状态
PanList.Children.Add(Item)
Next
End SyncLock
Else
PanList.Visibility = Visibility.Collapsed
End If
@@ -528,6 +532,7 @@ Install:
If IndexOfUi = -1 Then Continue For '因为未知原因 Mod 的状态已经切换完了
PanList.Children.RemoveAt(IndexOfUi)
PanList.Children.Insert(IndexOfUi, NewItem)
NewItem.UpdateLayout() '#7861
Next
If IsSuccessful Then
RefreshBars()
@@ -591,7 +596,7 @@ Install:
NewestReplaceName = Join(NewestSegs, "-")
End If
'添加到下载列表
Dim TempAddress As String = PathTemp & "DownloadedMods\" & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName)
Dim TempAddress As String = PathTemp & "mods\" & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName) '需要下载到 mods 文件夹,以便重复文件检查时识别
Dim RealAddress As String = GetPathFromFullPath(Entry.Path) & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName)
FileList.Add(File.ToNetFile(TempAddress))
FileCopyList(TempAddress) = RealAddress
@@ -232,9 +232,7 @@ Retry:
Dim Uuid As String = McLoginMsLoader.Output.Uuid
Dim SkinData As JObject = GetJson(McLoginMsLoader.Output.ProfileJson)
'获取玩家的所有披风
Dim SelId As Integer? = Nothing
'获取玩家当前的披风
Dim CurId As Integer? = Nothing
Dim SelectedIndex As Integer? = Nothing
RunInUiWait(
Sub()
Try
@@ -248,25 +246,23 @@ Retry:
{"Mojang Office", "Mojang 办公室披风"}, {"Home", "家园披风"}, {"Menace", "入侵披风"}, {"Yearn", "渴望披风"},
{"Common", "普通披风"}, {"Pan", "薄煎饼披风"}, {"Founder's", "创始人披风"}, {"Copper", "铜披风"}, {"Zombie Horse", "僵尸马披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
Dim Id As Integer = 0
Dim SelectionControl As New List(Of IMyRadio) From {
New MyRadioBox With {.Text = "无披风", .Checked = Not SkinData("capes").Any(Function(c) c("state")?.ToString = "ACTIVE")}}
For Each Cape In SkinData("capes")
Id += 1
Dim CapeName As String = Cape("alias").ToString
If CapeNames.ContainsKey(CapeName) Then CapeName = CapeNames(CapeName)
If Cape("state")?.ToString = "ACTIVE" Then CurId = Id
SelectionControl.Add(New MyRadioBox With {.Text = CapeName, .Checked = Cape("state")?.ToString = "ACTIVE"})
Next
SelId = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
SelectedIndex = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception
Log(ex, "获取玩家皮肤列表失败", LogLevel.Feedback)
End Try
End Sub)
If SelId Is Nothing Then Return
If SelectedIndex Is Nothing Then Return
'发送请求
Dim Result As String = NetRequestByClientRetry("https://api.minecraftservices.com/minecraft/profile/capes/active",
If(SelId = 0, HttpMethod.Delete, HttpMethod.Put),
Content:=If(SelId = 0, "", New JObject(New JProperty("capeId", SkinData("capes")(SelId - 1)("id"))).ToString(0)),
If(SelectedIndex = 0, HttpMethod.Delete, HttpMethod.Put),
Content:=If(SelectedIndex = 0, "", New JObject(New JProperty("capeId", SkinData("capes")(SelectedIndex - 1)("id"))).ToString(0)),
ContentType:="application/json",
Headers:={{"Authorization", "Bearer " & AccessToken}})
If Result.Contains("""errorMessage""") Then
@@ -274,11 +270,11 @@ Retry:
Return
Else
Hint("更改披风成功!", HintType.Green)
'#7894,更换披风后需更新当前选择的披风
SkinData("capes")(SelId - 1)("state") = "ACTIVE"
If CurId IsNot Nothing Then
SkinData("capes")(CurId - 1)("state") = "INACTIVE"
End If
'更新当前选择的披风
For Each Cape In SkinData("capes")
Cape("state") = "INACTIVE"
Next
If SelectedIndex > 0 Then SkinData("capes")(SelectedIndex - 1)("state") = "ACTIVE"
McLoginMsLoader.Output.ProfileJson = SkinData.ToString()
End If
Catch ex As Exception
@@ -484,7 +484,7 @@ Public Class PageLinkMain
If File.Exists(PathEasyTier & "EasyTier.zip") Then
'解压
Dim ExtractPath As String = RequestTaskTempFolder()
ExtractFile(PathEasyTier & "EasyTier.zip", ExtractPath,
ExtractCompressedFile(PathEasyTier & "EasyTier.zip", ExtractPath,
ProgressIncrementHandler:=Sub(Progress) Task.Progress += Progress * 0.05)
Dim ExtractedPath As String = New DirectoryInfo(ExtractPath).EnumerateDirectories.FirstOrDefault?.FullName
Log("[Link] 联机模块解压时的临时路径:" & ExtractedPath)
File diff suppressed because it is too large Load Diff