diff --git a/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb index 02594cf..0d1f03d 100644 --- a/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb @@ -337,7 +337,16 @@ Return _Checked End Get Set(value As Boolean) - SetChecked(value, False, True) + SetChecked(value, False, True, _Half) + End Set + End Property + Private _Half As Boolean = False + Public Property Half As Boolean + Get + Return _Half + End Get + Set(value As Boolean) + SetChecked(_Checked, False, True, value) End Set End Property ''' @@ -346,7 +355,8 @@ ''' 新的 Checked 属性。 ''' 是否由用户引发。 ''' 是否执行动画。 - Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean) + ''' 是否为部分选中。 + Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean, Optional half As Boolean = False) Try '自定义属性基础 @@ -364,8 +374,9 @@ End If _Checked = value Else - If value = _Checked Then Exit Sub + If value = _Checked AndAlso half = _Half Then Exit Sub _Checked = value + _Half = half If IsInitialized Then RaiseEvent Changed(Me, ChangedEventArgs) If ChangedEventArgs.Handled Then @@ -429,9 +440,9 @@ '由无变有 If Not IsNothing(RectCheck) Then Dim Delta = ActualHeight - RectCheck.ActualHeight - 12 - Anim.Add(AaHeight(RectCheck, Delta * 0.4, 200,, New AniEaseOutFluent(AniEasePower.Weak))) - Anim.Add(AaHeight(RectCheck, Delta * 0.6, 300,, New AniEaseOutBack(AniEasePower.Weak))) - Anim.Add(AaOpacity(RectCheck, 1 - RectCheck.Opacity, 30)) + Anim.Add(AaHeight(RectCheck, Delta * If(half, 0.2, 0.4), 200,, New AniEaseOutFluent(AniEasePower.Weak))) + Anim.Add(AaHeight(RectCheck, Delta * If(half, 0.3, 0.6), 300,, New AniEaseOutBack(AniEasePower.Weak))) + Anim.Add(AaOpacity(RectCheck, If(half, 0.5, 1) - RectCheck.Opacity, 30)) RectCheck.VerticalAlignment = VerticalAlignment.Center RectCheck.Margin = New Thickness(-1, 0, 0, 0) End If @@ -450,12 +461,17 @@ Else '不使用动画 AniStop("MyListItem Checked " & Uuid) - If Checked Then + + If Checked OrElse half Then If Not IsNothing(RectCheck) Then RectCheck.Height = Double.NaN RectCheck.Margin = New Thickness(-1, 6, 0, 6) RectCheck.Opacity = 1 RectCheck.VerticalAlignment = VerticalAlignment.Stretch + If half Then + RectCheck.Height = Height * 0.4 + RectCheck.Opacity = 0.5 + End If End If SetResourceReference(ForegroundProperty, If(Height < 40, "ColorBrush3", "ColorBrush2")) Else diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb index 69191e1..e9cf5c6 100644 --- a/Plain Craft Launcher 2/FormMain.xaml.vb +++ b/Plain Craft Launcher 2/FormMain.xaml.vb @@ -987,6 +987,7 @@ Public Class FormMain VersionSetup = 1 VersionMod = 2 VersionModDisabled = 3 + VersionExport = 4 End Enum ''' ''' 获取次级页面的名称。若并非次级页面则返回空字符串，故可以以此判断是否为次级页面。 diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb index 2f92233..dd6c80a 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb @@ -180,6 +180,10 @@ Public Module ModBase ''' Public Const IconButtonServer As String = "M224 160a64 64 0 0 0-64 64v576a64 64 0 0 0 64 64h576a64 64 0 0 0 64-64V224a64 64 0 0 0-64-64H224z m0 384h576v256H224v-256z m192 96v64h320v-64H416z m-128 0v64h64v-64H288zM224 224h576v256H224V224z m192 96v64h320v-64H416z m-128 0v64h64v-64H288z" ''' + ''' 图标，向右箭头，1x + ''' + Public Const IconButtonRight As String = "M757.792745 435.407215L419.597482 96.904967c-40.010393-40.010393-104.886579-40.010393-144.896972 0-40.010393 40.010393-40.010393 104.988908 0 144.9993L540.344959 507.855701 274.70051 773.807135c-40.010393 40.112721-40.010393 104.988908 0 144.9993 40.010393 40.010393 104.886579 40.010393 144.896972 0l338.092935-338.39992c40.112721-40.010393 40.112721-104.988908 0.102328-144.9993z" + ''' ''' 图标，音符，1x ''' Public Const IconMusic As String = "M348.293565 716.53287V254.797913c0-41.672348 28.004174-78.358261 68.919652-90.37913L815.994435 40.826435c62.775652-18.610087 125.907478 26.579478 125.907478 89.933913v539.158261c8.013913 42.25113-8.94887 89.177043-47.014956 127.109565a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c21.014261 1.024 40.514783 5.164522 57.878261 12.065391V233.338435c0-12.109913-10.551652-20.034783-20.569044-20.034783a24.620522 24.620522 0 0 0-5.787826 0.934957L439.785739 338.18713a19.545043 19.545043 0 0 0-14.825739 19.144348v438.984348H423.846957c11.53113 43.987478-5.164522 94.208-45.412174 134.322087a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c20.791652 1.024 40.069565 5.075478 57.299478 11.842783z" diff --git a/Plain Craft Launcher 2/Modules/Base/ModValidate.vb b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb index 0394060..fbbc2f8 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModValidate.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb @@ -262,6 +262,7 @@ Public Class ValidateFileName Public Property IgnoreCase As Boolean = True Public Property ParentFolder As String = Nothing Public Property RequireParentFolderExists = True + Public Property AllowNull As Boolean = False Public Sub New() End Sub Public Sub New(Name As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True) @@ -271,14 +272,16 @@ Public Class ValidateFileName End Sub Public Overrides Function Validate(Str As String) As String Try - '检查是否为空 - Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str) - If Not LengthCheck = "" Then Return LengthCheck + If Not AllowNull Then + '检查是否为空 + Dim NullCheck As String = New ValidateNullOrWhiteSpace().Validate(Str) + If Not NullCheck = "" Then Return NullCheck + End If '检查空格 If Str.StartsWithF(" ") Then Return "文件名不能以空格开头！" If Str.EndsWithF(" ") Then Return "文件名不能以空格结尾！" '检查长度 - LengthCheck = New ValidateLength(1, 253).Validate(Str & If(ParentFolder, "")) + Dim LengthCheck = New ValidateLength(If(AllowNull, 0, 1), 253).Validate(Str & If(ParentFolder, "")) If Not LengthCheck = "" Then Return LengthCheck '检查尾部小数点 If Str.EndsWithF(".") Then Return "文件名不能以小数点结尾！" @@ -315,6 +318,7 @@ End Class Public Class ValidateFolderPath Inherits Validate Public Property UseMinecraftCharCheck As Boolean = True + Public Property AllowNull As Boolean = False Public Sub New() End Sub Public Sub New(UseMinecraftCharCheck As Boolean) @@ -326,9 +330,9 @@ Public Class ValidateFolderPath If Not Str.TrimEnd("\").EndsWithF(":") Then Str = Str.TrimEnd("\") '检查是否为空 Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str) - If Not LengthCheck = "" Then Return LengthCheck + If Not AllowNull AndAlso Not LengthCheck = "" Then Return LengthCheck '检查长度 - LengthCheck = New ValidateLength(1, 254).Validate(Str) + LengthCheck = New ValidateLength(If(AllowNull, 0, 1), 254).Validate(Str) If Not LengthCheck = "" Then Return LengthCheck '检查开头 If Str.StartsWithF("\\Mac\") Then GoTo Fin diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb index f1cb169..44ab4fa 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb @@ -1137,7 +1137,7 @@ Finished: '刷新边栏 RunInUi(Sub() FrmVersionMod?.RefreshBars()) End Sub - Private Function GetTargetModLoaders() As List(Of CompModLoaderType) + Public Function GetTargetModLoaders() As List(Of CompModLoaderType) Dim ModLoaders As New List(Of CompModLoaderType) If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge) If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb index 112b65e..64cfcab 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb @@ -3,6 +3,7 @@ Imports System.Linq.Expressions Public Module ModModpack +#Region "安装" '触发整合包安装的外部接口 ''' ''' 弹窗要求选择一个整合包文件并进行安装。 @@ -905,6 +906,340 @@ Retry: Return Loader End Function +#End Region +#End Region + +#Region "导出" + Private ExpTempDir As String = PathTemp & "PackExport\" + ''' + ''' 整合包类型。 + ''' + Public Enum ModpackType + Modrinth + End Enum + ''' + ''' 导出整合包的选项。 + ''' + Public Class ExportOptions + ''' + ''' 要导出的版本。 + ''' + Public Version As McVersion + ''' + ''' 要保存整合包的位置。 + ''' + Public Dest As String + ''' + ''' 是否包括 PCL 文件。 + ''' + Public IncludePCL As Boolean + ''' + ''' 整合包类型。 + ''' + Public Type As ModpackType + ''' + ''' 要保留到整合包的文件。 + ''' + Public Additional As String() + ''' + ''' 是否需要保留 PCL 全局设置。仅在包括 PCL 时有效。 + ''' + Public PCLSetupGlobal As Boolean = True + ''' + ''' 整合包名称。 + ''' + Public Name As String = "" + ''' + ''' 整合包描述。 + ''' + Public Desc As String = "" + ''' + ''' 版本号。 + ''' + Public VerID As String = "" + Public Sub New(Version As McVersion, + Dest As String, + IncludePCL As Boolean, + Additional As String(), + Optional PCLSetupGlobal As Boolean = True, + Optional Name As String = "", + Optional Desc As String = "", + Optional VerID As String = "") + Me.Version = Version + Me.Dest = Dest + Me.IncludePCL = IncludePCL + Me.Additional = Additional + Me.PCLSetupGlobal = PCLSetupGlobal + Me.Name = Name + Me.Desc = Desc + Me.VerID = VerID + End Sub + End Class + ''' + ''' 导出整合包，返回是否成功。 + ''' + Public Function ModpackExport(Task As LoaderTask(Of ExportOptions, Boolean)) As Boolean + If Task.Input.IncludePCL Then Return ExportCompressed(Task) + Return ExportModrinth(Task) + End Function + +#Region "冗余" + Private VersionRedundant As String() = {"^screenshots", "^backups", "^command_history\.txt$", '个人文件 + "^.*-natives", "^server-resource-packs", "^user.*cache\.json$", "^\.optifine", "^\.fabric", "^\.mixin\.out", '缓存 + "^.*\.jar$", "^downloads", "^realms_persistence.json$", "^\$\{natives_directory\}", "^essential", '可联网更新 + "^logs", "^crash-reports", ".*\.log$", "^debug", '日志 + ".*\.dat_old$", ".*\.old$", '备份 + "^\$\{quickPlayPath\}", '服务器 + "^\.replay_cache", "^replay_recordings", "^replay_videos", 'ReplayMod + "^irisUpdateInfo\.json$", 'Iris + "^modernfix", 'ModernFix 模组 + "^modtranslations", 'Mod 翻译 + "^schematics", 'schematics 模组 + "^journeymap\\data", 'JourneyMap 模组 + "^mods\\\.connector", '信雅互联 + "^.*\.BakaCoreInfo$", 'BakaXL 配置 + "^hmclversion\.cfg$", "^log4j2\.xml$", 'HMCL 配置 + "^assets$", "^libraries$", "^\$natives$", "^launcher_profiles\.json$", "^versions$" '开启版本隔离时排除的文件 + } + Public Function IsVerRedundant(FilePath As String, PathIndie As String) As Boolean + FilePath = FilePath.Replace("/", "\") + For Each regex In VersionRedundant + If RegexCheck(FilePath.Replace(PathIndie, ""), regex, RegularExpressions.RegexOptions.IgnoreCase) Then Return True + Next + Return False + End Function + Private MustExport As String() = { + "mods", "PCL", ".*\.json" + } + Public Function IsMustExport(FilePath As String, PathIndie As String) As Boolean + For Each regex In MustExport + If RegexCheck(FilePath.Replace(PathIndie, ""), regex, RegularExpressions.RegexOptions.IgnoreCase) AndAlso Not (FilePath.EndsWithF(".zip") OrElse FilePath.EndsWithF("\")) Then Return True + Next + Return False + End Function + +#End Region + +#Region "不同类型整合包的导出方法" + Private Function ExportModrinth(Task As LoaderTask(Of ExportOptions, Boolean)) As Boolean + Try + Dim Version = Task.Input.Version + Dim DestPath = Task.Input.Dest + Dim Additional = Task.Input.Additional + Dim Name = Task.Input.Name + Dim Description = Task.Input.Desc + Dim VerID = Task.Input.VerID + Log($"[Export] 导出整合包（Modrinth）：{Version.Path} -> {DestPath}，额外版本文件 {Additional.Count} 个") + Dim tempDir As String = $"{ExpTempDir}{GetUuid()}\" + Log($"[Export] 缓存文件夹：{tempDir}") + DeleteDirectory(tempDir) + Directory.CreateDirectory(tempDir) + +#Region "0.04-0.40：从 Modrinth 获取 Mod 工程信息，得到 URL" + Dim Mods As New Dictionary(Of String, McMod) + If Directory.Exists(Version.Path & "mods\") Then + For Each m In Directory.EnumerateFiles(Version.Path & "mods\") + If m.EndsWithF(".jar") Then Mods.Add(GetFileNameFromPath(m), New McMod(m)) + Next + End If + + '从 Modrinth 获取信息 + Dim ModrinthMapping As New Dictionary(Of String, JObject) 'Modrinth 获取到的 Mod + Dim CurseForgeMapping As New Dictionary(Of String, JObject) 'CurseForge 获取到的 Mod + Dim Failed = Mods.ToArray().ToDictionary(Function(a) a.Key, Function(a) a.Value) '获取失败的 Mod + Dim ModrinthHashes = Mods.Select(Function(m) m.Value.ModrinthHash).ToList() + If Mods.Count = 0 Then GoTo JumpMod + Dim ModrinthRaw = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST", + $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject) + Log($"[Export] 从 Modrinth 获取到 {ModrinthRaw.Count} 个本地 Mod 的对应信息") + Task.Progress = 0.35 + + For Each Entry In Mods + If (Not ModrinthRaw.ContainsKey(Entry.Value.ModrinthHash)) OrElse + (ModrinthRaw(Entry.Value.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.Value.ModrinthHash) Then + Continue For + End If + Failed.Remove(Entry.Key) + ModrinthMapping.Add(Entry.Key, ModrinthRaw(Entry.Value.ModrinthHash)("files")(0)) + Next + Task.Progress = 0.4 +#End Region + +#Region "0.40-0.80：从 CurseForge 继续获取" + Dim CurseForgeHashes = Mods.Select(Function(m) m.Value.CurseForgeHash).ToList() + Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST", + $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer) + Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息") + Task.Progress = 0.7 + + For Each m In CurseForgeRaw + Dim hash As String = "" + For Each h In m("file")("hashes") '获取 Modrinth Hash + If h("algo").ToString = 1 Then + hash = h("value") + Exit For + End If + Next + If String.IsNullOrEmpty(hash) OrElse String.IsNullOrEmpty(m("file")("downloadUrl")) Then Continue For + + m("file")("ModrinthHash") = hash + Dim f = Mods.ToArray() + For Each file In f + If file.Value.ModrinthHash = hash Then + CurseForgeMapping.Add(file.Key, m("file")) + Failed.Remove(file.Key) + Exit For + End If + Next + Next + Task.Progress = 0.8 +#End Region + +JumpMod: +#Region "0.80-0.90：合并下载链接，复制 Logo，写入 Json 文件" + '获取作为检查目标的加载器和版本 + Dim ModLoaders = GetTargetModLoaders() + Dim McVersion = Version.Version.McName + Log($"[Export] 目标加载器：{ModLoaders.Join("/")}，版本：{McVersion}") + + '合并下载链接 + Dim BothUrls As New Dictionary(Of String, String()) '两个下载源都有 URL 的 Mod + For Each modrinth In ModrinthMapping + Dim curseforge As New JObject + If CurseForgeMapping.TryGetValue(modrinth.Key, curseforge) Then + BothUrls.Add(modrinth.Key, {modrinth.Value("url"), curseforge("downloadUrl")}) + End If + Next + Task.Progress = 0.83 + + Dim files As New JArray + For Each m In ModrinthMapping + files.Add(New JObject From { + {"path", $"mods/{m.Key}"}, + {"hashes", m.Value("hashes")}, + {"env", New JObject From {{"client", "required"}, {"server", "required"}}}, + {"downloads", If(BothUrls.ContainsKey(m.Key), JArray.FromObject(BothUrls(m.Key)), New JArray From {m.Value("url")})}, + {"fileSize", m.Value("size")} + }) + Next + For Each m In CurseForgeMapping + If Not BothUrls.ContainsKey(m.Key) Then + files.Add(New JObject From { + {"path", $"mods/{m.Key}"}, + {"hashes", New JObject From {{"sha1", m.Value("ModrinthHash").ToString}}}, + {"env", New JObject From {{"client", "required"}, {"server", "required"}}}, + {"downloads", New JArray From {m.Value("downloadUrl")}}, + {"fileSize", m.Value("fileLength")} + }) + End If + Next + Task.Progress = 0.86 + 'If Not String.IsNullOrEmpty(Logo) Then + ' Dim LogoObj As New MyBitmap(Logo) + ' LogoObj.Save(tempDir & "Logo.png") + 'End If + 'Task.Progress = 0.88 + + Dim depend As New JObject From {{"minecraft", McVersion}} + 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.HasNeoForge Then depend.Add("neoforge", Version.Version.NeoForgeVersion) + + Dim json As New JObject From { + {"game", "minecraft"}, + {"formatVersion", 1}, + {"versionId", VerID}, + {"name", If(String.IsNullOrEmpty(Name), Version.Name, Name)}, + {"summary", Description}, + {"files", files}, + {"dependencies", depend} + } + 'If Not String.IsNullOrEmpty(Logo) Then json.Add("logo", tempDir & "Logo.png") + + File.WriteAllText(tempDir & "modrinth.index.json", json.ToString) + Task.Progress = 0.9 +#End Region + +#Region "0.90-0.99：将其余文件保存到 overrides 目录" + For Each m In Failed + CopyFile(m.Value.Path, tempDir & "overrides\mods\" & m.Value.FileName) + Next + Task.Progress = 0.92 + + '额外文件 + For Each p In Additional + If String.IsNullOrWhiteSpace(p) Then Continue For '传空字串进去会直接把整个版本文件夹拷过去 + If Not p.StartsWithF(GetPathFromFullPath(GetPathFromFullPath(Version.Path)), IgnoreCase:=True) Then Continue For + Dim relative As String = p.Replace(Version.Path, "").Replace(GetPathFromFullPath(GetPathFromFullPath(Version.Path)), "") + If File.Exists(p) AndAlso Not IsVerRedundant(p, Version.PathIndie) Then + CopyFile(p, $"{tempDir}overrides\{relative}") + End If + Next + Task.Progress = 0.96 + + '如果 resourcepacks shaderpacks 文件夹中有文件夹格式的包，则先将文件夹压缩成 Zip 文件后再打包入对应位置 + '这可以避免安装时出现路径长度限制而出错 + If Directory.Exists($"{tempDir}overrides\resourcepacks\") Then + For Each d In Directory.EnumerateDirectories($"{tempDir}overrides\resourcepacks\") + If Not File.Exists(d + ".zip") Then ZipFile.CreateFromDirectory(d, d + ".zip") + DeleteDirectory(d) + Next + End If + If Directory.Exists($"{tempDir}overrides\shaderpacks\") Then + For Each d In Directory.EnumerateDirectories($"{tempDir}overrides\shaderpacks\") + If Not File.Exists(d + ".zip") Then ZipFile.CreateFromDirectory(d, d + ".zip") + DeleteDirectory(d) + Next + End If +#End Region + + If File.Exists(DestPath) Then File.Delete(DestPath) '选择文件的时候已经确认了要替换 + ZipFile.CreateFromDirectory(tempDir, DestPath) + DeleteDirectory(tempDir) + Return True + Catch ex As Exception + Log(ex, "导出整合包失败", LogLevel.Msgbox) + Return False + End Try + End Function + Private Function ExportCompressed(Task As LoaderTask(Of ExportOptions, Boolean)) As Boolean + Try + Dim Version = Task.Input.Version + Dim DestPath = Task.Input.Dest + Dim Additional = Task.Input.Additional + Dim Name = Task.Input.Name + Dim VerID = Task.Input.VerID + Dim PCLSetupGlobal = Task.Input.PCLSetupGlobal + Log($"[Export] 导出整合包（含启动器）：{Version.Path} -> {DestPath}，额外版本文件 {Additional.Count} 个，全局设置 {If(PCLSetupGlobal, "导出", "不导出")}") + Dim tempDir As String = $"{ExpTempDir}{GetUuid()}\" + Log($"[Export] 最终压缩包的缓存文件夹：{tempDir}") + Directory.CreateDirectory(tempDir) + + Task.Progress = 0.04 + + Log("[Export] 开始导出 Modrinth 整合包") + Task.Input.Dest = $"{tempDir}modpack.mrpack" + ExportModrinth(Task) + + Log($"[Export] 正在复制 PCL 本体") + CopyFile(PathWithName, tempDir & GetFileNameFromPath(PathWithName)) + + If PCLSetupGlobal Then + Log($"[Export] 正在复制 PCL 全局配置") + CopyFile(Path & "PCL\Setup.ini", tempDir & "PCL\Setup.ini") + End If + + If File.Exists(DestPath) Then File.Delete(DestPath) '选择文件的时候已经确认了要替换 + ZipFile.CreateFromDirectory(tempDir, DestPath) + DeleteDirectory(tempDir) + Return True + Catch ex As Exception + Log(ex, "导出整合包失败", LogLevel.Msgbox) + Return False + End Try + End Function +#End Region + #End Region End Module diff --git a/Plain Craft Launcher 2/Modules/ModMain.vb b/Plain Craft Launcher 2/Modules/ModMain.vb index e93cb74..3c877a1 100644 --- a/Plain Craft Launcher 2/Modules/ModMain.vb +++ b/Plain Craft Launcher 2/Modules/ModMain.vb @@ -434,6 +434,7 @@ EndHint: Public FrmVersionMod As PageVersionMod Public FrmVersionModDisabled As PageVersionModDisabled Public FrmVersionSetup As PageVersionSetup + Public FrmVersionExport As PageVersionExport '资源信息分页声明 Public FrmDownloadCompDetail As PageDownloadCompDetail diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml new file mode 100644 index 0000000..8e1a2ab --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml @@ -0,0 +1,121 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml.vb new file mode 100644 index 0000000..13b514e --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml.vb @@ -0,0 +1,346 @@ +Public Class PageVersionExport + Private CurrentVer As String = "" + Private Sub PageVersionExport_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + Reload() + End Sub + + Public ItemVersion As MyListItem + Public Sub Reload() + AniControlEnabled += 1 + + If CurrentVer <> PageVersionLeft.Version.Path Then + '说明切换到另一个版本了，所有的设置都要重置 + CurrentPath = "" + Selected = New List(Of String) + CurrentVer = PageVersionLeft.Version.Path + + TbExportName.Text = "" + TbExportVersion.Text = "" + 'ComboDisplayLogo.SelectedIndex = 0 + CustomLogoVal = Nothing + TbExportDesc.Text = "" + End If + + TbExportName.ShowValidateResult = True + TbExportName.ValidateRules = New ObjectModel.Collection(Of Validate) From {New ValidateFileName() With {.AllowNull = True}} + TbExportName.Validate() + + TbExportName.HintText = PageVersionLeft.Version.Name + TbExportDesc.HintText = PageVersionLeft.Version.Info + PanDisplayItem.Children.Clear() + ItemVersion = PageSelectRight.McVersionListItem(PageVersionLeft.Version.Load()) + ItemVersion.IsHitTestVisible = False + If Not String.IsNullOrEmpty(CustomLogo) Then ItemVersion.Logo = CustomLogo + PanDisplayItem.Children.Add(ItemVersion) + ItemVersion.Title = If(String.IsNullOrWhiteSpace(TbExportName.Text), PageVersionLeft.Version.Name, TbExportName.Text) + ItemVersion.Info = If(String.IsNullOrWhiteSpace(TbExportDesc.Text), PageVersionLeft.Version.Info, TbExportDesc.Text) +#If BETA Then + CheckIncludePCL.IsEnabled = True +#Else + CheckIncludePCL.IsEnabled = False + TbHint.Text = "你可以在此勾选需要包含进整合包的文件或文件夹，其他文件或文件夹在高级选项添加。" & vbCrLf & "你当前的 PCL 不是正式版，有二次分发的限制，因此整合包不能包含 PCL 程序。" +#End If + CheckIncludeSetup.IsEnabled = CheckIncludePCL.IsEnabled + ReloadFileList(CurrentPath) + + AniControlEnabled -= 1 + End Sub + +#Region "文件列表" + ''' + ''' 当前所在的文件夹。注意是绝对路径！以 \ 结尾。 + ''' + Private CurrentPath As String = "" + Private Sub ReloadFileList(Optional NewPath As String = "") + 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) + PanFileList.Children.Clear() + PanFileList.Children.Add(tb) + + If NewPath <> PageVersionLeft.Version.Path Then + Dim listItem As New MyListItem With {.Title = "返回上一级目录", .Tag = "..", .Height = 35, .Type = MyListItem.CheckType.Clickable} + AddHandler listItem.Click, AddressOf ListItem_Click + PanFileList.Children.Add(listItem) + End If + + 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 directories + If Directory.EnumerateFileSystemEntries(d).Count = 0 Then Continue For + If IsVerRedundant(d, PageVersionLeft.Version.PathIndie) OrElse IsMustExport(d, PageVersionLeft.Version.PathIndie) Then Continue For + Dim title As String = "" + Dim listItem As New MyListItem + If Titles.TryGetValue(GetFolderNameFromPath(d), title) Then 'title 作为引用类型传入 + listItem.Title = title + Else + listItem.Title = GetFolderNameFromPath(d) + End If + listItem.Info = d + '图标按钮 + Dim btnSwap As New MyIconButton + btnSwap.Logo = Logo.IconButtonRight + btnSwap.LogoScale = 1.0 + btnSwap.Tag = d & "\" + AddHandler btnSwap.Click, AddressOf BtnSwap_Click + listItem.Buttons = {btnSwap} + listItem.Type = MyListItem.CheckType.CheckBox + listItem.Height = 35 + listItem.Logo = Logo.IconButtonOpen + listItem.Tag = d & "\" + Select Case IsSelected(d & "\") + Case 1 + listItem.Half = True + Case 2 + listItem.Checked = True + End Select + AddHandler listItem.Click, AddressOf ListItem_Click + PanFileList.Children.Add(listItem) + fileCount += 1 + Next + + For Each f In files + If IsVerRedundant(f, PageVersionLeft.Version.PathIndie) OrElse IsMustExport(f, PageVersionLeft.Version.PathIndie) Then Continue For + Dim title As String = "" + Dim listItem As New MyListItem + If Titles.TryGetValue(f, title) Then 'title 作为引用类型传入 + listItem.Title = title + Else + listItem.Title = GetFileNameFromPath(f) + End If + listItem.Info = f + listItem.Type = MyListItem.CheckType.CheckBox + listItem.Height = 35 + listItem.Tag = f + listItem.Checked = (IsSelected(f) = 2) + AddHandler listItem.Click, AddressOf ListItem_Click + PanFileList.Children.Add(listItem) + fileCount += 1 + Next + + CurrentPath = NewPath + CardMore.Title = If(NewPath = PageVersionLeft.Version.Path, "高级选项", $"高级选项 ({NewPath.Replace(PageVersionLeft.Version.Path, "").TrimEnd("\")})") + End Sub + Private Titles As New Dictionary(Of String, String) From { + {"saves", "存档"}, + {"resourcepacks", "资源包"}, + {"config", "Mod 配置"}, + {"shaderpacks", "光影包"}, + {"options.txt", "游戏配置"}, + {"servers.dat", "服务器列表"} + } + Private Sub BtnSwap_Click(sender As MyIconButton, e As Object) + Dim actualPath As String = sender.Tag + 'Dim relative As String = actualPath.Replace(PageVersionLeft.Version.Path, "") + + If Not Directory.Exists(actualPath) Then + Hint($"找不到目录：{actualPath}", HintType.Critical) + Exit Sub + End If + ReloadFileList(actualPath) + End Sub + ''' + ''' 选中的文件列表，绝对路径。 + ''' + Private Selected As New List(Of String) + Private Sub SelectedChange(IsAdd As Boolean, TargetPath As String) + If File.Exists(TargetPath) Then + If IsAdd Then Selected.Add(TargetPath) Else Selected.Remove(TargetPath) + Exit Sub + End If + If Directory.Exists(TargetPath) Then + For Each d In Directory.EnumerateDirectories(TargetPath) + SelectedChange(IsAdd, d) + Next + For Each f In Directory.EnumerateFiles(TargetPath) + If IsAdd Then Selected.Add(f) Else Selected.Remove(f) + Next + End If + Selected = Selected.Distinct().ToList() + End Sub + ''' + ''' 获取 TargetPath 是否选中。 + ''' + ''' 全部未选中为 0，部分选中为 1，全部选中为 2。 + Private Function IsSelected(TargetPath As String, Optional AllowEmpty As Boolean = False) As Integer + If File.Exists(TargetPath) Then + Return If(Selected.Contains(TargetPath), 2, 0) + End If + If Directory.Exists(TargetPath) Then + Dim di As New DirectoryInfo(TargetPath) + If di.GetDirectories.Length + di.GetFiles.Length = 0 Then Return If(AllowEmpty, 2, 0) + '如果有一个文件不在列表，则 hasExclude = True + Dim hasExclude As Boolean = False + '如果有一个文件在列表，则 hasInclude = True + Dim hasInclude As Boolean = False + For Each d In Directory.EnumerateDirectories(TargetPath) + If Directory.EnumerateFileSystemEntries(d).Count = 0 Then Continue For + Select Case IsSelected(d, True) + Case 0 + hasExclude = True + Case 1 + Return 1 + Case 2 + hasInclude = True + End Select + If hasInclude AndAlso hasExclude Then Return 1 '如果有文件在、有文件不在列表中，可以断定部分选中 + Next + For Each f In Directory.EnumerateFiles(TargetPath) + If Selected.Contains(f) Then hasInclude = True Else hasExclude = True + If hasInclude AndAlso hasExclude Then Return 1 '如果有文件在、有文件不在列表中，可以断定部分选中 + Next + If hasExclude AndAlso Not hasInclude Then Return 0 + If hasInclude AndAlso Not hasExclude Then Return 2 + End If + Return 0 + End Function + Private Sub ListItem_Click(sender As MyListItem, e As Object) + If sender.Tag = ".." Then '回到上一级目录 + ReloadFileList(GetPathFromFullPath(CurrentPath)) + Exit Sub + End If + SelectedChange(Not sender.Checked, '非常难绷的逻辑，很难描述清楚，自己打断点看 Checked 属性值吧…… + sender.Tag) + End Sub + + 'Private ReadOnly Property Saves As List(Of String) + ' Get + ' If Directory.Exists(PageVersionLeft.Version.Path & "saves\") Then + ' Return Directory.EnumerateDirectories(PageVersionLeft.Version.Path & "saves\").ToList + ' End If + ' Return New List(Of String) + ' End Get + 'End Property + + '复选框与高级选项同步 + Private Sub PanCommonFiles_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles PanCommonFiles.MouseLeftButtonUp + For Each c In PanCommonFiles.Children + If String.IsNullOrEmpty(c.Tag) Then Continue For + For Each l In PanFileList.Children + If TypeOf l Is MyListItem Then + If If(l.Tag.EndsWith("\"), GetFolderNameFromPath(l.Tag), GetFileNameFromPath(l.Tag)) = c.Tag Then + l.Checked = c.Checked + SelectedChange(c.Checked, PageVersionLeft.Version.Path & c.Tag) + End If + End If + Next + Next + End Sub + '高级选项与复选框同步 + Private Sub PanFileList_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles PanFileList.MouseLeftButtonUp + For Each c In PanCommonFiles.Children + If TypeOf c Is MyCheckBox Then + c.Checked = IsSelected(PageVersionLeft.Version.Path & c.Tag) = 2 OrElse IsSelected(PathMcFolder & c.Tag) = 2 + End If + Next + End Sub +#End Region + +#Region "整合包信息 & 预览栏" + Private Sub TbExportName_TextChanged(sender As MyTextBox, e As TextChangedEventArgs) Handles TbExportName.TextChanged + If String.IsNullOrEmpty(TbExportName.ValidateResult) Then + ItemVersion.Title = If(String.IsNullOrWhiteSpace(sender.Text), PageVersionLeft.Version.Name, sender.Text) + End If + End Sub + + Private Sub TbExportDesc_TextChanged(sender As MyTextBox, e As TextChangedEventArgs) Handles TbExportDesc.TextChanged + ItemVersion.Info = If(String.IsNullOrWhiteSpace(sender.Text), PageVersionLeft.Version.Info, sender.Text) + End Sub + + Private CustomLogoVal As String + ''' + ''' 自定义 Logo 的路径。 + ''' + Public Property CustomLogo() As String + Get + Return CustomLogoVal + End Get + Set(value As String) + If AniControlEnabled <> 0 Then Exit Property + CustomLogoVal = value + ItemVersion.Logo = value + Reload() + End Set + End Property + + 'Private Sub ComboDisplayLogo_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboDisplayLogo.SelectionChanged + ' If Not AniControlEnabled = 0 Then Exit Sub + ' '选择 自定义 时修改图片 + ' If ComboDisplayLogo.SelectedItem Is ItemDisplayLogoCustom Then + ' Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif)|*.png;*.jpg;*.gif", "选择图片") + ' If String.IsNullOrWhiteSpace(FileName) Then Exit Sub + ' CustomLogo = FileName + ' Else + ' CustomLogo = sender.SelectedItem.Tag + ' End If + 'End Sub +#End Region + +#Region "基本信息" + Private Sub CheckIncludePCL_Change(sender As Object, user As Boolean) Handles CheckIncludePCL.Change + CheckIncludeSetup.IsEnabled = CheckIncludePCL.IsEnabled + End Sub +#End Region + +#Region "导出" + 'Private Sub ComboExportType_Change(sender As ComboBox, e As SelectionChangedEventArgs) Handles ComboExportType.SelectionChanged + ' If AniControlEnabled <> 0 Then Exit Sub + ' Type = sender.SelectedIndex + ' Select Case Type + ' Case ModpackType.Modrinth + ' If IncludePCL() Then 'TODO：修改这里的条件 + ' If GridCompressed IsNot Nothing Then GridCompressed.Visibility = Visibility.Visible + ' If GridModrinth IsNot Nothing Then GridModrinth.Visibility = Visibility.Collapsed + ' Else + ' If GridCompressed IsNot Nothing Then GridCompressed.Visibility = Visibility.Collapsed + ' If GridModrinth IsNot Nothing Then GridModrinth.Visibility = Visibility.Visible + ' End If + ' End Select + ' CardExport.TriggerForceResize() + 'End Sub + Private Sub BtnExportExport_Click() Handles BtnExportExport.Click + Dim savePath As String = SelectAs( + "选择导出位置", $"整合包 - {If(String.IsNullOrWhiteSpace(TbExportName.Text), PageVersionLeft.Version.Name, TbExportName.Text)}" & If(CheckIncludePCL.Checked, ".zip", ".mrpack"), + If(CheckIncludePCL.Checked, "整合包文件(*.zip)|*.zip", "Modrinth 整合包(*.mrpack)|*.mrpack")) + If String.IsNullOrEmpty(savePath) Then Exit Sub + + '获取需要包含的文件 + Dim contains As List(Of String) = Selected + For Each c In PanCommonFiles.Children + If TypeOf c IsNot MyCheckBox Then Continue For + If String.IsNullOrEmpty(c.Tag) Then Continue For + If c.Checked Then contains.Add(PageVersionLeft.Version.Path & c.Tag) + Next + '重复任务检查 + For Each OngoingLoader In LoaderTaskbar + If OngoingLoader.Name <> $"导出整合包 {PageVersionLeft.Version.Name}" Then Continue For + Hint("正在处理中，请稍候！", HintType.Critical) + Exit Sub + Next + '启动！ + Dim Loader As New LoaderTask(Of ExportOptions, Boolean)($"导出整合包 {PageVersionLeft.Version.Name}", + Sub(Task As LoaderTask(Of ExportOptions, Boolean)) + Task.Output = ModpackExport(Task) + Task.Progress = 1.0 + If Task.Output Then + Hint($"{Task.Name} 成功！", HintType.Finish) + OpenExplorer($"/select,""{Task.Input.Dest}""") + End If + End Sub) + Dim Combo = New LoaderCombo(Of ExportOptions)($"导出整合包 {PageVersionLeft.Version.Name}", {Loader}) + Combo.Start(New ExportOptions(PageVersionLeft.Version, savePath, CheckIncludePCL.Checked, contains.Distinct.ToArray, + PCLSetupGlobal:=CheckIncludeSetup.Checked, Name:=TbExportName.Text, Desc:=TbExportDesc.Text, + VerID:=TbExportVersion.Text)) + LoaderTaskbarAdd(Combo) + End Sub + +#End Region + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml index 32d8fde..45eb800 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml @@ -23,5 +23,8 @@ + + diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb index e44d3e3..30742bc 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb @@ -25,7 +25,7 @@ ''' ''' 勾选事件改变页面。 ''' - Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemOverall.Check, ItemMod.Check, ItemModDisabled.Check, ItemSetup.Check + Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemOverall.Check, ItemMod.Check, ItemModDisabled.Check, ItemSetup.Check, ItemExport.Check '尚未初始化控件属性时，sender.Tag 为 Nothing，会导致切换到页面 0 '若使用 IsLoaded，则会导致模拟点击不被执行（模拟点击切换页面时，控件的 IsLoaded 为 False） If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) @@ -46,6 +46,9 @@ Case FormMain.PageSubType.VersionSetup If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup Return FrmVersionSetup + Case FormMain.PageSubType.VersionExport + If FrmVersionExport Is Nothing Then FrmVersionExport = New PageVersionExport + Return FrmVersionExport Case Else Throw New Exception("未知的版本设置子页面种类：" & ID) End Select diff --git a/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj b/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj index 990f7a6..71699f6 100644 --- a/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj +++ b/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj @@ -290,6 +290,9 @@ PageLinkLeft.xaml + + PageVersionExport.xaml + PageVersionLeft.xaml @@ -476,10 +479,10 @@ MyRadioButton.xaml + FormMain.xaml Code - MSBuild:Compile Designer @@ -561,6 +564,10 @@ MSBuild:Compile Designer + + MSBuild:Compile + Designer + Designer MSBuild:Compile @@ -910,11 +917,11 @@ + -