| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720 |
- Imports System.IO.Compression
- Public Class ExportOption
- Public Property Title As String
- Public Property Description As String
- Public Property Rules As String
- ''' <summary>
- ''' 如果 Rules 为空,则根据 ShowRules 的内容判断是否应该显示这个复选框。
- ''' 如果 ShowRules 也为空,则始终显示。
- ''' </summary>
- Public Property ShowRules As String
- Public Property DefaultChecked As Boolean
- Public Property RequireModLoader As Boolean = False
- Public Property RequireOptiFine As Boolean = False
- Public Property RequireModLoaderOrOptiFine As Boolean = False
- End Class
- Public Class PageInstanceExport
- Implements IRefreshable
- Private CurrentInstance As String = ""
- Private Sub PageInstanceExport_Loaded() Handles Me.Loaded
- AniControlEnabled += 1
- If CurrentInstance <> PageInstanceLeft.Instance.PathVersion Then RefreshAll() '切换到了另一个版本,重置页面
- CustomEventService.SetEventData(BtnAdvancedHelp,
- If(VersionBranchCode = 50, "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json"))
- AniControlEnabled -= 1
- End Sub
- Public Sub RefreshAll() Implements IRefreshable.Refresh
- Log($"[Export] 刷新导出页面")
- HintOptiFine.Visibility = If(PageInstanceLeft.Instance.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
- CurrentInstance = PageInstanceLeft.Instance.PathVersion
- TextExportName.Text = ""
- TextExportName.HintText = PageInstanceLeft.Instance.Name
- TextExportVersion.Text = ""
- TextExportVersion.HintText = "1.0.0"
- CheckAdvancedInclude.Checked = False
- CheckAdvancedModrinth.Checked = False
- GetExportOption(CheckOptionsBasic).Description = PageInstanceLeft.Instance.VersionDisplayName()
- ResetConfigOverrides()
- ReloadAllSubOptions()
- RefreshAllOptionsUI()
- PanBack.ScrollToHome()
- End Sub
- #Region "子选项"
- Private SubOptionBlackList As String() = {"Quark Programmer Art.zip", "+ EuphoriaPatches_"}
- ''' <summary>
- ''' 动态生成子文件夹下的选项,例如资源包、存档等。
- ''' </summary>
- Private Sub ReloadAllSubOptions()
- ReloadSubOptions(PanOptionsResourcePacks, True, True, "resourcepacks", "texturepacks")
- ReloadSubOptions(PanOptionsSaves, False, True, "saves")
- ReloadSubOptions(PanOptionsShaderPacks, True, True, "shaderpacks")
- End Sub
- Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String())
- Panel.Children.Clear()
- For Each Folder In Folders
- Dim TargetFolder As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Folder)
- If Not TargetFolder.Exists() Then Continue For
- '查找文件夹下的对应项
- If AcceptCompressedFile Then
- For Each File In TargetFolder.EnumerateFiles("*.zip").Concat(TargetFolder.EnumerateFiles("*.rar"))
- If SubOptionBlackList.Any(Function(b) File.Name.ContainsF(b)) Then Continue For
- Panel.Children.Add(New MyCheckBox With {. _
- Tag = New ExportOption With {.Title = File.Name, .DefaultChecked = True, .Rules = EscapeLikePattern($"{Folder}/{File.Name}")}})
- Next
- End If
- If AcceptFolder Then
- For Each SubFolder In TargetFolder.EnumerateDirectories().OrderByDescending(Function(f) f.LastWriteTime)
- If SubOptionBlackList.Any(Function(b) SubFolder.Name.ContainsF(b)) Then Continue For
- If Not SubFolder.EnumerateFileSystemInfos().Any() Then Continue For
- Dim NewCheckBox As New MyCheckBox With {. _
- Tag = New ExportOption With {.Title = SubFolder.Name, .DefaultChecked = True, .Rules = EscapeLikePattern($"{Folder}/{SubFolder.Name}/")}}
- If Panel Is PanOptionsSaves Then GetExportOption(NewCheckBox).Description = SubFolder.LastWriteTime.ToString("yyyy'/'MM'/'dd HH':'mm")
- Panel.Children.Add(NewCheckBox)
- Next
- End If
- Next
- End Sub
- #End Region
- #Region "选项"
- ''' <summary>
- ''' 重新确认是否应该显示每个选项,并将 ExportOption 同步到 UI。
- ''' </summary>
- Private Sub RefreshAllOptionsUI()
- '预先归纳所有至多二级的文件/文件夹
- Dim AllEntries As New List(Of String)
- Dim IsValidDirectory = '检查文件夹不为空
- Function(Folder As DirectoryInfo) As Boolean
- Try
- Return Folder.Exists AndAlso
- Folder.EnumerateFileSystemInfos().Any(Function(i) Not SubOptionBlackList.Any(Function(b) i.Name.ContainsF(b)))
- Catch '一般是由于无法访问,或是一个指向已不存在的文件夹的链接(例如使用 mklink 创造的 resource 文件夹链接)
- Return False
- End Try
- End Function
- Dim PathInfo As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie)
- AllEntries.AddRange(PathInfo.EnumerateFiles().Select(Function(f) f.Name))
- For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory)
- AllEntries.Add($"{SubFolder.Name}\")
- AllEntries.AddRange(SubFolder.EnumerateFiles().Select(Function(f) $"{SubFolder.Name}\{f.Name}"))
- AllEntries.AddRange(SubFolder.EnumerateDirectories().Where(IsValidDirectory).Select(Function(d) $"{SubFolder.Name}\{d.Name}\"))
- Next
- Log($"[Export] 共发现 {AllEntries.Count} 个可行的二级文件/文件夹")
- '确认选项是否应该被显示
- Dim IsVisible =
- Function(TargetOption As ExportOption) As Boolean
- '检查需要 OptiFine 或 Mod 加载器
- If TargetOption.RequireOptiFine AndAlso Not PageInstanceLeft.Instance.Version.HasOptiFine Then Return False
- If TargetOption.RequireModLoader AndAlso Not PageInstanceLeft.Instance.Modable Then Return False
- If TargetOption.RequireModLoaderOrOptiFine AndAlso Not PageInstanceLeft.Instance.Version.HasOptiFine AndAlso Not PageInstanceLeft.Instance.Modable Then Return False
- '粗略检查是否可能有符合规则的文件/文件夹
- Return StandardizeLines(If(TargetOption.Rules, TargetOption.ShowRules).Split("|"c), True).Any(
- Function(Rule As String)
- If Rule.StartsWithF("!") Then Return False '只看正向规则
- '检查前两级
- Try
- If AllEntries.Any(Function(Entry) Entry Like Rule) Then Return True
- Catch ex As Exception
- Log(ex, $"错误的规则:{Rule}", LogLevel.Hint)
- Return False
- End Try
- '粗略检查所有级
- Rule = Rule.Trim("*?".ToCharArray)
- If Rule.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries).Count >= 3 Then
- If Rule.EndsWithF("\") Then
- Return IsValidDirectory(New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Rule)) '文件夹有效
- Else
- Return File.Exists(PageInstanceLeft.Instance.PathIndie & Rule) '文件有效
- End If
- Else
- Return False
- End If
- End Function)
- End Function
- '逐个检查选项
- For Each CheckBox In GetAllOptions(True)
- Dim TargetOption = GetExportOption(CheckBox)
- '名称与简介
- CheckBox.Inlines.Clear()
- CheckBox.Inlines.Add(New Run(TargetOption.Title))
- If Not String.IsNullOrEmpty(TargetOption.Description) Then
- CheckBox.Inlines.Add(New Run(" " & TargetOption.Description) With {.Foreground = ColorGray5})
- End If
- '可见性、默认勾选
- If String.IsNullOrEmpty(TargetOption.Rules) AndAlso String.IsNullOrEmpty(TargetOption.ShowRules) Then
- CheckBox.Visibility = Visibility.Visible
- CheckBox.Checked = TargetOption.DefaultChecked
- Else
- Dim Pass As Boolean = IsVisible(TargetOption)
- CheckBox.Visibility = If(Pass, Visibility.Visible, Visibility.Collapsed)
- CheckBox.Checked = TargetOption.DefaultChecked AndAlso Pass
- End If
- Next
- End Sub
- ''' <summary>
- ''' 对文本行进行标准化处理,以便使用 Like 进行匹配。
- ''' </summary>
- Private Iterator Function StandardizeLines(Raw As IEnumerable(Of String), AddSuffixStarToFolderPath As Boolean) As IEnumerable(Of String)
- For Each IgnoreLine In Raw
- IgnoreLine = IgnoreLine.Trim
- If IgnoreLine = "" OrElse IgnoreLine.StartsWithF("#") OrElse IgnoreLine.StartsWithF("=") Then Continue For
- IgnoreLine = IgnoreLine.Replace("/", "\")
- Yield IgnoreLine & If(IgnoreLine.EndsWithF("\") AndAlso AddSuffixStarToFolderPath, "*", "")
- Next
- End Function
- ''' <summary>
- ''' 获取所有可作为选项的 CheckBox。
- ''' </summary>
- Private Iterator Function GetAllOptions(IncludeHidden As Boolean) As IEnumerable(Of MyCheckBox)
- For Each Element In PanOptions.Children
- If Not IncludeHidden AndAlso Element.Visibility <> Visibility.Visible Then Continue For
- If TypeOf Element Is MyCheckBox Then
- Yield Element
- ElseIf TypeOf Element Is StackPanel Then
- For Each SubElement In DirectCast(Element, StackPanel).Children
- If Not IncludeHidden AndAlso SubElement.Visibility <> Visibility.Visible Then Continue For
- If TypeOf SubElement Is MyCheckBox Then Yield SubElement
- Next
- End If
- Next
- End Function
- ''' <summary>
- ''' 获取该 CheckBox 对应的 ExportOption。
- ''' </summary>
- Private Function GetExportOption(CheckBox As MyCheckBox) As ExportOption
- Return CType(CheckBox.Tag, ExportOption)
- End Function
- #End Region
- #Region "配置文件"
- Private Const Sperator As String = "=============================================================="
- ' ================ 导出内容段 ================
- ''' <summary>
- ''' 从配置文件中读取的规则。
- ''' 如果不为 Nothing,则会覆写当前勾选的规则并禁用对应 UI。
- ''' </summary>
- Private Property RulesOverrides As List(Of String)
- Get
- Return _RulesOverrides
- End Get
- Set(value As List(Of String))
- _RulesOverrides = value
- If value Is Nothing Then
- BtnOverrideCancel.Visibility = Visibility.Collapsed
- PanOptions.Visibility = Visibility.Visible
- CardOptions.Inlines.Clear()
- CardOptions.Inlines.Add(New Run("导出内容列表") With {.FontWeight = FontWeights.Bold})
- Else
- BtnOverrideCancel.Visibility = Visibility.Visible
- PanOptions.Visibility = Visibility.Collapsed
- CardOptions.Inlines.Clear()
- CardOptions.Inlines.Add(New Run("导出内容列表: ") With {.FontWeight = FontWeights.Bold})
- CardOptions.Inlines.Add(New Run("从配置文件中读取") With {.FontWeight = FontWeights.Normal})
- End If
- End Set
- End Property
- Private _RulesOverrides As List(Of String) = Nothing
- ''' <summary>
- ''' 获取当前实际生效的所有规则。
- ''' </summary>
- Private Iterator Function GetAllRules() As IEnumerable(Of String)
- If RulesOverrides IsNot Nothing Then
- '返回覆盖的列表
- For Each Rule In RulesOverrides
- Yield Rule
- Next
- Else
- '从当前勾选的所有选项中获取所有规则行
- Yield ""
- Yield "# 修改下方的规则以控制需要导出的内容。"
- Yield "# 以 ! 开头以反选。可以使用 *、?、[] 通配符。靠后的行覆盖靠前的。"
- Yield ""
- For Each CheckBox In GetAllOptions(False)
- If Not CheckBox.Checked Then Continue For
- Dim TargetOption = GetExportOption(CheckBox)
- If TargetOption.Rules Is Nothing Then Continue For
- Yield $"# {TargetOption.Title}"
- For Each Rule In TargetOption.Rules.Split("|"c)
- Yield Rule
- Next
- Yield ""
- Next
- Yield "# 排除的文件"
- Yield "!*.log"
- Yield "!*.dat_old"
- Yield "!*.BakaCoreInfo"
- Yield "!hmclversion.cfg"
- Yield "!log4j2.xml"
- Yield ""
- End If
- End Function
- ' ================ 追加内容段 ================
- Private ExtraFiles As List(Of String) = Nothing
- ''' <summary>
- ''' 获取当前实际生效的追加内容。
- ''' </summary>
- Private Iterator Function GetExtraFileLines() As IEnumerable(Of String)
- If ExtraFiles IsNot Nothing Then
- '返回覆盖的列表
- For Each File In ExtraFiles
- Yield File
- Next
- Else
- '从当前勾选的所有选项中获取所有规则行
- Yield ""
- Yield "# 如果想将额外的文件自动放到压缩包根目录中,可以将它们的路径写在下方。"
- Yield "# 必须是完整路径。每行中,若以 \ 结尾则代表是文件夹,不以 \ 结尾则代表是文件。"
- Yield ""
- End If
- End Function
- ' ================ 重置 ================
- ''' <summary>
- ''' 重置配置文件所带来的影响。
- ''' </summary>
- Private Sub ResetConfigOverrides()
- RulesOverrides = Nothing
- ConfigPackPath = Nothing
- ExtraFiles = Nothing
- PanBack.ScrollToHome()
- End Sub
- Private Sub CardOptions_MouseLeftButtonDown() Handles CardOptions.MouseLeftButtonDown
- If RulesOverrides Is Nothing Then Return
- ResetConfigOverrides()
- End Sub
- ' ================ 保存 / 读取 ================
- '保存配置文件
- Private Sub ExportConfig() Handles BtnAdvancedExport.Click
- Try
- Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Settings.Get("CacheExportConfig"))
- If String.IsNullOrEmpty(ConfigPath) Then Return
- Settings.Set("CacheExportConfig", ConfigPath)
- Dim ConfigLines As New List(Of String)
- 'ini 段
- ConfigLines.Add("Name:" & TextExportName.Text)
- ConfigLines.Add("Version:" & TextExportVersion.Text)
- ConfigLines.Add("")
- ConfigLines.Add("# 是否打包正式版 PCL,以便没有启动器的玩家安装整合包。")
- ConfigLines.Add("IncludeLauncher:" & CheckOptionsPcl.Checked)
- ConfigLines.Add("")
- ConfigLines.Add("# 是否打包 PCL 个性化内容,例如功能隐藏设置、主页、背景音乐和图片等。")
- ConfigLines.Add("IncludeLauncherCustom:" & CheckOptionsPclCustom.Checked)
- ConfigLines.Add("")
- ConfigLines.Add("# 是否将 Mod、资源包、光影包的文件直接放入整合包中,这样在导入时就无需联网下载它们。")
- ConfigLines.Add("# 建议仅在无法稳定连接 CurseForge 或 Modrinth 时才考虑启用。")
- ConfigLines.Add("# 二次分发可能违反使用协议,请尽量不要公开发布包含资源文件的整合包!")
- ConfigLines.Add("DontCheckHostedAssets:" & CheckAdvancedInclude.Checked)
- ConfigLines.Add("")
- ConfigLines.Add("# 若资源未在 Modrinth 上托管,则将其原始文件直接放入整合包中。")
- ConfigLines.Add("# 如果你想将整合包上传到 Modrinth,这能帮助你分辨哪些文件未在 Modrinth 上托管。")
- ConfigLines.Add("# 此选项与 DontCheckHostedAssets 冲突。")
- ConfigLines.Add("ModrinthUploadMode:" & CheckAdvancedModrinth.Checked)
- ConfigLines.Add("")
- ConfigLines.Add("# 导出的文件的存放位置。")
- ConfigLines.Add("# 若设置了此项,在导出时会直接将文件放到此路径,不会弹窗要求选择。")
- ConfigLines.Add("# 若 IncludeLauncher 为 True,应以 .zip 结尾;若为 False,应以 .mrpack 结尾。")
- ConfigLines.Add("PackPath:" & If(ConfigPackPath, ""))
- ConfigLines.Add("")
- '导出内容段
- ConfigLines.Add(Sperator)
- ConfigLines.AddRange(GetAllRules())
- '追加内容段
- ConfigLines.Add(Sperator)
- ConfigLines.AddRange(GetExtraFileLines())
- '结束
- WriteFile(ConfigPath, ConfigLines.Join(vbCrLf))
- Hint("已保存配置文件:" & ConfigPath, HintType.Green)
- OpenExplorer(ConfigPath)
- Catch ex As Exception
- Log(ex, "保存配置失败", LogLevel.Msgbox)
- End Try
- End Sub
- '读取配置文件
- Private Sub ImportConfig() Handles BtnAdvancedImport.Click
- Try
- Dim ConfigPath As String = SelectFile("整合包导出配置(*.txt)|*.txt", "选择配置文件", Settings.Get("CacheExportConfig"))
- If String.IsNullOrEmpty(ConfigPath) Then Return
- Settings.Set("CacheExportConfig", ConfigPath)
- Dim Segments As String() = ReadFile(ConfigPath).Split(Sperator)
- 'ini 段
- Dim Ini As New Dictionary(Of String, String)
- For Each Line In Segments(0).Split(vbCrLf.ToCharArray())
- Line = Line.Trim
- If Line = "" OrElse Line.StartsWithF("#") OrElse Line.StartsWithF("=") Then Continue For
- Dim Index As Integer = Line.IndexOfF(":")
- If Index > 0 Then Ini(Line.Substring(0, Index)) = Line.Substring(Index + 1)
- Next
- TextExportName.Text = Ini.GetOrDefault("Name", "")
- TextExportVersion.Text = Ini.GetOrDefault("Version", "")
- CheckOptionsPcl.Checked = Ini.GetOrDefault("IncludeLauncher", True)
- CheckOptionsPclCustom.Checked = Ini.GetOrDefault("IncludeLauncherCustom", True)
- CheckAdvancedInclude.Checked = Ini.GetOrDefault("DontCheckHostedAssets", False)
- If Not CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = Ini.GetOrDefault("ModrinthUploadMode", False) '#7979,加个特判
- ConfigPackPath = Ini.GetOrDefault("PackPath", Nothing)
- '导出内容段
- RulesOverrides = Segments(1).Replace(vbCr, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ToList
- '追加内容段
- If Segments.Length > 2 Then
- ExtraFiles = Segments(2).Replace(vbCr, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ToList
- Else
- ExtraFiles = Nothing
- End If
- '结束
- Hint("已读取配置文件:" & ConfigPath, HintType.Green)
- Catch ex As Exception
- Log(ex, "读取配置失败", LogLevel.Msgbox)
- End Try
- End Sub
- #End Region
- #Region "导出"
- ''' <summary>
- ''' 配置文件中指定的导出位置。
- ''' </summary>
- Private ConfigPackPath As String = Nothing
- ''' <summary>
- ''' 开始导出。
- ''' </summary>
- Private Sub StartExport() Handles BtnExport.Click
- Dim PackName As String = If(String.IsNullOrEmpty(TextExportName.Text), TextExportName.HintText, TextExportName.Text)
- Dim PackVersion As String = If(String.IsNullOrEmpty(TextExportVersion.Text), "1.0.0", TextExportVersion.Text)
- '重复任务检查
- Dim LoaderName As String = $"导出整合包:" & PackName
- For Each OngoingLoader In LoaderTaskbar
- If OngoingLoader.Name <> LoaderName Then Continue For
- FrmMain.PageChange(FormMain.PageType.DownloadManager)
- Return
- Next
- '确认导出位置
- Dim PackPath As String = Nothing
- If Not String.IsNullOrWhiteSpace(ConfigPackPath) AndAlso
- (Not ConfigPackPath.EndsWithF("\") AndAlso Not ConfigPackPath.EndsWithF("/")) Then
- Try
- Directory.CreateDirectory(GetPathFromFullPath(ConfigPackPath))
- PackPath = ConfigPackPath
- Log($"[Export] 使用配置文件中指定的导出路径:{ConfigPackPath}")
- Catch ex As Exception
- Log(ex, $"无法使用配置文件中指定的导出路径({ConfigPackPath})", LogLevel.Debug)
- If MyMsgBox($"指定的路径:{ConfigPackPath}{vbCrLf}{vbCrLf}{ex.GetDetail}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
- End Try
- End If
- If PackPath Is Nothing Then
- Dim Extensions As New List(Of String)
- 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("|"))
- Log($"[Export] 手动指定的导出路径:{PackPath}")
- End If
- If String.IsNullOrEmpty(PackPath) Then Return
- '缓存所需参数
- Dim CacheFolder = RequestTaskTempFolder()
- Dim OverridesFolder = CacheFolder & "modpack\overrides\"
- Dim McVersion = PageInstanceLeft.Instance
- Dim PathIndie As String = McVersion.PathIndie
- Dim CheckHostedAssets As Boolean = Not CheckAdvancedInclude.Checked
- Dim ModrinthUploadMode As Boolean = CheckAdvancedModrinth.Checked
- Dim IncludePCL As Boolean = CheckOptionsPcl.Checked
- Dim IncludePCLCustom As Boolean = IncludePCL AndAlso CheckOptionsPclCustom.Checked
- Dim AllRules = StandardizeLines(GetAllRules(), True).ToList()
- Dim AllExtraFiles = StandardizeLines(GetExtraFileLines(), False).ToList()
- Log($"[Export] 准备导出整合包,共有 {AllRules.Count} 条规则,{AllExtraFiles.Count} 条追加内容行")
- '构造步骤加载器
- Dim Loaders As New List(Of LoaderBase)
- #Region "准备 PCL 文件"
- #If Not BETA Then
- If IncludePCL Then
- Loaders.Add(New LoaderTask(Of Integer, Integer)("下载 PCL 正式版",
- Sub(Loader As LoaderTask(Of Integer, Integer))
- DownloadLatestPCL(Loader)
- CopyFile(PathTemp & "Latest.exe", CacheFolder & "Plain Craft Launcher.exe")
- End Sub) With {.ProgressWeight = 0.5, .Block = False})
- End If
- #End If
- #End Region
- #Region "复制文件"
- Loaders.Add(New LoaderTask(Of Integer, List(Of McMod))("复制导出内容",
- Sub(Loader As LoaderTask(Of Integer, List(Of McMod)))
- Loader.Output = New List(Of McMod)
- '复制版本文件
- Dim Progress As Integer = 0
- Dim SearchFolder As Action(Of DirectoryInfo)
- SearchFolder =
- Sub(Folder As DirectoryInfo)
- '文件夹:进一步搜索
- For Each SubFolder In Folder.EnumerateDirectories("*", SearchOption.TopDirectoryOnly)
- '跳过部分又没用文件又多的文件夹,加快搜索
- If Folder.FullName = PathIndie AndAlso {"assets", "versions", "libraries"}.Contains(SubFolder.Name) Then Continue For
- If {"structureCacheV1", ".fabric", ".git", "avatar-cache", "cosmetic-cache"}.Contains(SubFolder.Name) Then Continue For
- SearchFolder(SubFolder)
- Next
- '文件:检查规则并复制
- For Each Entry In Folder.EnumerateFiles("*", SearchOption.TopDirectoryOnly)
- Dim RelativePath As String = Entry.FullName.AfterFirst(PathIndie)
- '检查规则
- Dim ShouldKeep As Boolean = False
- For Each Rule In AllRules
- Dim Revert = Rule.StartsWithF("!")
- If RelativePath Like Rule.TrimStart("!") Then ShouldKeep = Not Revert
- Next
- If Not ShouldKeep Then Continue For
- Dim TargetPath As String = OverridesFolder & RelativePath
- CopyFile(Entry.FullName, TargetPath)
- '若为压缩包,考虑联网获取路径
- If CheckHostedAssets AndAlso
- {".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.Lower) AndAlso
- {"mods", "packs", "openloader", "resource"}.Any(Function(s) RelativePath.Contains(s)) Then
- Dim ModFile As New McMod(TargetPath)
- Dim Unused = ModFile.ModrinthHash '提前计算 Hash
- Unused = ModFile.CurseForgeHash
- Loader.Output.Add(ModFile)
- End If
- '更新进度(进度并不准确,主要突出一个我还没似)
- Progress += 1
- If Progress = 25 Then
- Loader.Progress += (0.94 - Loader.Progress) * 0.012
- Progress = 0
- End If
- Next
- End Sub
- SearchFolder(New DirectoryInfo(PathIndie))
- Log($"[Export] 复制 overrides 文件完成,有 {Loader.Output.Count} 个文件需要联网检查")
- Loader.Progress = 0.95
- '复制追加内容到根目录
- Dim BaseFolder As String = If(IncludePCL, CacheFolder, CacheFolder & "modpack\")
- For Each Line In AllExtraFiles
- If Line.EndsWithF("\") OrElse Line.EndsWithF("/") Then
- If Directory.Exists(Line) Then
- CopyDirectory(Line, BaseFolder & GetFolderNameFromPath(Line) & "\")
- Else
- Hint($"未找到配置文件中指定的文件夹:{Line}", HintType.Red)
- End If
- Else
- If File.Exists(Line) Then
- CopyFile(Line, BaseFolder & GetFileNameFromPath(Line))
- Else
- Hint($"未找到配置文件中指定的单个文件:{Line}", HintType.Red)
- End If
- End If
- Next
- Loader.Progress = 0.97
- '复制 PCL 版本设置
- CopyDirectory(McVersion.PathVersion & "PCL\", OverridesFolder & "PCL\")
- WriteIni(OverridesFolder & "PCL\Setup.ini", "IsStar", False)
- #If BETA Then
- '复制 PCL 本体
- If IncludePCL Then CopyFile(PathWithName, CacheFolder & "Plain Craft Launcher.exe")
- #End If
- '复制 PCL 个性化内容
- If IncludePCLCustom Then
- If Directory.Exists(Path & "PCL\Pictures\") Then CopyDirectory(Path & "PCL\Pictures\", CacheFolder & "PCL\Pictures\")
- If Directory.Exists(Path & "PCL\Musics\") Then CopyDirectory(Path & "PCL\Musics\", CacheFolder & "PCL\Musics\")
- If Directory.Exists(Path & "PCL\Help\") Then CopyDirectory(Path & "PCL\Help\", CacheFolder & "PCL\Help\")
- If File.Exists(Path & "PCL\Custom.xaml") Then CopyFile(Path & "PCL\Custom.xaml", CacheFolder & "PCL\Custom.xaml")
- If File.Exists(Path & "PCL\Setup.ini") Then CopyFile(Path & "PCL\Setup.ini", CacheFolder & "PCL\Setup.ini")
- If File.Exists(Path & "PCL\hints.txt") Then CopyFile(Path & "PCL\hints.txt", CacheFolder & "PCL\hints.txt")
- If File.Exists(Path & "PCL\Logo.png") Then CopyFile(Path & "PCL\Logo.png", CacheFolder & "PCL\Logo.png")
- End If
- End Sub) With {.ProgressWeight = 5})
- #End Region
- #Region "联网检查"
- Loaders.Add(New LoaderTask(Of List(Of McMod), Dictionary(Of McMod, List(Of String)))("联网获取文件信息",
- Sub(Loader As LoaderTask(Of List(Of McMod), Dictionary(Of McMod, List(Of String))))
- Loader.Output = New Dictionary(Of McMod, List(Of String))
- If Not CheckHostedAssets Then Log($"[Export] 要求跳过联网获取步骤") : Return
- If Not Loader.Input.Any Then Log($"[Export] 没有需要联网检查的文件,跳过联网获取步骤") : Return
- '分平台获取下载地址
- Dim EndedThreadCount As Integer = 0, FailedExceptions As New List(Of Exception)
- '从 Modrinth 获取信息
- RunInNewThread(
- Sub()
- Try
- Dim ModrinthHashes = Loader.Input.Select(Function(m) m.ModrinthHash)
- Dim ModrinthRaw As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post,
- $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")
- For Each ModFile In Loader.Input
- '查找对应的文件
- If Not ModrinthRaw.ContainsKey(ModFile.ModrinthHash) Then Continue For
- If ModrinthRaw(ModFile.ModrinthHash)?("files")?(0)("hashes")?("sha1") <> ModFile.ModrinthHash Then Continue For
- '写入下载地址
- Loader.Output.AddToList(ModFile, ModrinthRaw(ModFile.ModrinthHash)("files")(0)("url"))
- Next
- Log($"[Export] 从 Modrinth 获取到 {ModrinthRaw.Count} 个本地资源项的对应信息")
- Catch ex As Exception
- Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
- FailedExceptions.Add(ex)
- Finally
- EndedThreadCount += 1
- Loader.Progress += 0.45
- End Try
- End Sub, "Modrinth - " & LoaderName)
- '从 CurseForge 获取信息
- RunInNewThread(
- Sub()
- Try
- If ModrinthUploadMode Then Return 'Modrinth 上传模式下,不从 CurseForge 获取信息
- Dim CurseForgeHashes = Loader.Input.Select(Function(m) m.CurseForgeHash)
- Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432/", HttpMethod.Post,
- $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
- For Each ResultJson As JObject In CurseForgeRaw
- If Not ResultJson.ContainsKey("file") Then Continue For
- Dim File As JObject = ResultJson("file")
- If String.IsNullOrEmpty(File("downloadUrl")) Then Continue For
- '查找对应的文件
- Dim ModFile As McMod = Loader.Input.FirstOrDefault(Function(m) m.CurseForgeHash = File("fileFingerprint").ToObject(Of UInteger))
- If ModFile Is Nothing Then Continue For
- '写入下载地址
- For Each Address In CompFile.HandleCurseForgeDownloadUrls(File("downloadUrl").ToString)
- Loader.Output.AddToList(ModFile, Address)
- Next
- Next
- Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地资源项的对应信息")
- Catch ex As Exception
- Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
- FailedExceptions.Add(ex)
- Finally
- EndedThreadCount += 1
- Loader.Progress += 0.45
- End Try
- End Sub, "CurseForge - " & LoaderName)
- '等待线程结束
- Do Until EndedThreadCount = 2
- If Loader.IsInterrupted Then Return
- Thread.Sleep(10)
- Loop
- '若失败,确认是否继续
- If FailedExceptions.Count = 1 Then
- If MyMsgBox("联网获取部分文件信息失败,是否继续导出?" & vbCrLf & vbCrLf &
- "若继续,无法获取信息的文件将被直接打包。" & vbCrLf &
- "由于二次分发可能违反使用协议,请尽量不要公开发布导出的整合包!",
- "部分文件信息获取失败", "继续", "取消") = 2 Then Throw FailedExceptions.First
- ElseIf FailedExceptions.Count > 1 Then
- If MyMsgBox("联网获取文件信息失败,是否继续导出?" & vbCrLf & vbCrLf &
- "若继续,所有文件都将被直接打包。" & vbCrLf &
- "由于二次分发可能违反使用协议,请尽量不要公开发布导出的整合包!",
- "文件信息获取失败", "继续", "取消") = 2 Then Throw FailedExceptions.First
- End If
- End Sub) With {.Show = CheckHostedAssets, .ProgressWeight = If(CheckHostedAssets, 2, 0.01)})
- #End Region
- #Region "生成压缩包"
- Loaders.Add(New LoaderTask(Of Dictionary(Of McMod, List(Of String)), Integer)("生成压缩包",
- Sub(Loader As LoaderTask(Of Dictionary(Of McMod, List(Of String)), Integer))
- '整理文件列表
- Dim Files As New JArray
- For Each Pair In Loader.Input
- Dim ModFile As McMod = Pair.Key
- Files.Add(New JObject From {
- {"path", ModFile.Path.AfterFirst(OverridesFolder).Replace("\", "/")},
- {"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.Path)}}},
- {"downloads", New JArray(Pair.Value.OrderBy(Function(u) u.Contains("modrinth.com")))}, '不优先选择 Modrinth
- {"fileSize", New FileInfo(ModFile.Path).Length}
- })
- File.Delete(ModFile.Path)
- Next
- Loader.Progress = 0.2
- '导出最终 JSON 文件
- Dim Dependencies As New JObject From {{"minecraft", McVersion.Version.VanillaName}}
- If McVersion.Version.HasForge Then Dependencies.Add("forge", McVersion.Version.Forge)
- If McVersion.Version.HasFabric Then Dependencies.Add("fabric-loader", McVersion.Version.Fabric)
- If McVersion.Version.HasNeoForge Then Dependencies.Add("neoforge", McVersion.Version.NeoForge)
- Dim ResultJson As New JObject From {
- {"game", "minecraft"},
- {"formatVersion", 1},
- {"versionId", PackVersion},
- {"name", PackName},
- {"summary", McVersion.Info},
- {"files", Files},
- {"dependencies", Dependencies}
- }
- File.WriteAllText(CacheFolder & "modpack\modrinth.index.json", ResultJson.ToString(Newtonsoft.Json.Formatting.Indented))
- '打包
- Directory.CreateDirectory(GetPathFromFullPath(PackPath))
- If File.Exists(PackPath) Then File.Delete(PackPath)
- If IncludePCL Then
- '首次压缩整合包
- ZipFile.CreateFromDirectory(CacheFolder & "modpack\", CacheFolder & "modpack.mrpack")
- Loader.Progress = 0.5
- DeleteDirectory(CacheFolder & "modpack\")
- Loader.Progress = 0.6
- '二次压缩整合包
- ZipFile.CreateFromDirectory(CacheFolder, PackPath)
- Loader.Progress = 0.9
- Else
- '直接压缩整合包
- ZipFile.CreateFromDirectory(CacheFolder & "modpack\", PackPath)
- Loader.Progress = 0.8
- End If
- DeleteDirectory(CacheFolder, True)
- OpenExplorer(PackPath)
- End Sub) With {.ProgressWeight = 6})
- #End Region
- '启动
- Dim MainLoader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
- MainLoader.Start()
- LoaderTaskbarAdd(MainLoader)
- FrmMain.BtnExtraDownload.ShowRefresh()
- FrmMain.BtnExtraDownload.Ribble()
- FrmMain.PageChange(FormMain.PageType.DownloadManager)
- End Sub
- #End Region
- '自动填写整合包名称
- Private Sub TextExportName_GotFocus() Handles TextExportName.GotFocus
- If TextExportName.Text = "" Then
- TextExportName.Text = TextExportName.HintText
- TextExportName.SelectionStart = TextExportName.Text.Length
- End If
- End Sub
- '勾选打包资源文件时,禁止开启 Modrinth 上传模式
- Private Sub CheckAdvancedInclude_Change(sender As Object, user As Boolean) Handles CheckAdvancedInclude.Change
- If CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = False
- CheckAdvancedModrinth.IsEnabled = Not CheckAdvancedInclude.Checked
- End Sub
- End Class
|