1
0

PageVersionExport.xaml.vb 37 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724
  1. Imports System.IO.Compression
  2. Public Class ExportOption
  3. Public Property Title As String
  4. Public Property Description As String
  5. Public Property Rules As String
  6. ''' <summary>
  7. ''' 如果 Rules 为空,则根据 ShowRules 的内容判断是否应该显示这个复选框。
  8. ''' 如果 ShowRules 也为空,则始终显示。
  9. ''' </summary>
  10. Public Property ShowRules As String
  11. Public Property DefaultChecked As Boolean
  12. Public Property RequireModLoader As Boolean = False
  13. Public Property RequireOptiFine As Boolean = False
  14. Public Property RequireModLoaderOrOptiFine As Boolean = False
  15. End Class
  16. Public Class PageVersionExport
  17. Implements IRefreshable
  18. Private CurrentVersion As String = ""
  19. Private Sub PageVersionExport_Loaded() Handles Me.Loaded
  20. AniControlEnabled += 1
  21. If CurrentVersion <> PageVersionLeft.Version.Path Then RefreshAll() '切换到了另一个版本,重置页面
  22. BtnAdvancedHelp.EventData = If(VersionBranchName = "Release", "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json")
  23. AniControlEnabled -= 1
  24. End Sub
  25. Public Sub RefreshAll() Implements IRefreshable.Refresh
  26. Log($"[Export] 刷新导出页面")
  27. HintOptiFine.Visibility = If(PageVersionLeft.Version.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
  28. CurrentVersion = PageVersionLeft.Version.Path
  29. TextExportName.Text = ""
  30. TextExportName.HintText = PageVersionLeft.Version.Name
  31. TextExportVersion.Text = ""
  32. TextExportVersion.HintText = "1.0.0"
  33. CheckAdvancedInclude.Checked = False
  34. CheckAdvancedModrinth.Checked = False
  35. GetExportOption(CheckOptionsBasic).Description = PageVersionLeft.Version.GetDefaultDescription()
  36. ResetConfigOverrides()
  37. ReloadAllSubOptions()
  38. RefreshAllOptionsUI()
  39. PanBack.ScrollToHome()
  40. End Sub
  41. #Region "子选项"
  42. Private SubOptionBlackList As String() = {"Quark Programmer Art.zip", "+ EuphoriaPatches_"}
  43. ''' <summary>
  44. ''' 动态生成子文件夹下的选项,例如资源包、存档等。
  45. ''' </summary>
  46. Private Sub ReloadAllSubOptions()
  47. ReloadSubOptions(PanOptionsResourcePacks, True, True, "resourcepacks", "texturepacks")
  48. ReloadSubOptions(PanOptionsSaves, False, True, "saves")
  49. ReloadSubOptions(PanOptionsShaderPacks, True, True, "shaderpacks")
  50. End Sub
  51. Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String())
  52. Panel.Children.Clear()
  53. For Each Folder In Folders
  54. Dim TargetFolder As New DirectoryInfo(PageVersionLeft.Version.PathIndie & Folder)
  55. If Not TargetFolder.Exists() Then Continue For
  56. '查找文件夹下的对应项
  57. If AcceptCompressedFile Then
  58. For Each File In TargetFolder.EnumerateFiles("*.zip").Concat(TargetFolder.EnumerateFiles("*.rar"))
  59. If SubOptionBlackList.Any(Function(b) File.Name.ContainsF(b)) Then Continue For
  60. Panel.Children.Add(New MyCheckBox With {. _
  61. Tag = New ExportOption With {.Title = File.Name, .DefaultChecked = True, .Rules = EscapeLikePattern($"{Folder}/{File.Name}")}})
  62. Next
  63. End If
  64. If AcceptFolder Then
  65. For Each SubFolder In TargetFolder.EnumerateDirectories().OrderByDescending(Function(f) f.LastWriteTime)
  66. If SubOptionBlackList.Any(Function(b) SubFolder.Name.ContainsF(b)) Then Continue For
  67. If Not SubFolder.EnumerateFileSystemInfos().Any() Then Continue For
  68. Dim NewCheckBox As New MyCheckBox With {. _
  69. Tag = New ExportOption With {.Title = SubFolder.Name, .DefaultChecked = True, .Rules = EscapeLikePattern($"{Folder}/{SubFolder.Name}/")}}
  70. If Panel Is PanOptionsSaves Then GetExportOption(NewCheckBox).Description = SubFolder.LastWriteTime.ToString("yyyy'/'MM'/'dd HH':'mm")
  71. Panel.Children.Add(NewCheckBox)
  72. Next
  73. End If
  74. Next
  75. End Sub
  76. #End Region
  77. #Region "选项"
  78. ''' <summary>
  79. ''' 重新确认是否应该显示每个选项,并将 ExportOption 同步到 UI。
  80. ''' </summary>
  81. Private Sub RefreshAllOptionsUI()
  82. '预先归纳所有至多二级的文件/文件夹
  83. Dim AllEntries As New List(Of String)
  84. Dim IsValidDirectory = '检查文件夹不为空
  85. Function(Folder As DirectoryInfo) As Boolean
  86. Try
  87. Return Folder.Exists AndAlso
  88. Folder.EnumerateFileSystemInfos().Any(Function(i) Not SubOptionBlackList.Any(Function(b) i.Name.ContainsF(b)))
  89. Catch '一般是由于无法访问,或是一个指向已不存在的文件夹的链接(例如使用 mklink 创造的 resource 文件夹链接)
  90. Return False
  91. End Try
  92. End Function
  93. Dim PathInfo As New DirectoryInfo(PageVersionLeft.Version.PathIndie)
  94. AllEntries.AddRange(PathInfo.EnumerateFiles().Select(Function(f) f.Name))
  95. For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory)
  96. AllEntries.Add($"{SubFolder.Name}\")
  97. AllEntries.AddRange(SubFolder.EnumerateFiles().Select(Function(f) $"{SubFolder.Name}\{f.Name}"))
  98. AllEntries.AddRange(SubFolder.EnumerateDirectories().Where(IsValidDirectory).Select(Function(d) $"{SubFolder.Name}\{d.Name}\"))
  99. Next
  100. Log($"[Export] 共发现 {AllEntries.Count} 个可行的二级文件/文件夹")
  101. '确认选项是否应该被显示
  102. Dim IsVisible =
  103. Function(TargetOption As ExportOption) As Boolean
  104. '检查需要 OptiFine 或 Mod 加载器
  105. If TargetOption.RequireOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine Then Return False
  106. If TargetOption.RequireModLoader AndAlso Not PageVersionLeft.Version.Modable Then Return False
  107. If TargetOption.RequireModLoaderOrOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine AndAlso Not PageVersionLeft.Version.Modable Then Return False
  108. '粗略检查是否可能有符合规则的文件/文件夹
  109. Return StandardizeLines(If(TargetOption.Rules, TargetOption.ShowRules).Split("|"c), True).Any(
  110. Function(Rule As String)
  111. If Rule.StartsWithF("!") Then Return False '只看正向规则
  112. '检查前两级
  113. Try
  114. If AllEntries.Any(Function(Entry) Entry Like Rule) Then Return True
  115. Catch ex As Exception
  116. Log(ex, $"错误的规则:{Rule}", LogLevel.Hint)
  117. Return False
  118. End Try
  119. '粗略检查所有级
  120. Rule = Rule.Trim("*?".ToCharArray)
  121. If Rule.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries).Count >= 3 Then
  122. If Rule.EndsWithF("\") Then
  123. Return IsValidDirectory(New DirectoryInfo(PageVersionLeft.Version.PathIndie & Rule)) '文件夹有效
  124. Else
  125. Return File.Exists(PageVersionLeft.Version.PathIndie & Rule) '文件有效
  126. End If
  127. Else
  128. Return False
  129. End If
  130. End Function)
  131. End Function
  132. '逐个检查选项
  133. For Each CheckBox In GetAllOptions(True)
  134. Dim TargetOption = GetExportOption(CheckBox)
  135. '名称与简介
  136. CheckBox.Inlines.Clear()
  137. CheckBox.Inlines.Add(New Run(TargetOption.Title))
  138. If Not String.IsNullOrEmpty(TargetOption.Description) Then
  139. CheckBox.Inlines.Add(New Run(" " & TargetOption.Description) With {.Foreground = ColorGray5})
  140. End If
  141. '可见性、默认勾选
  142. If String.IsNullOrEmpty(TargetOption.Rules) AndAlso String.IsNullOrEmpty(TargetOption.ShowRules) Then
  143. CheckBox.Visibility = Visibility.Visible
  144. CheckBox.Checked = TargetOption.DefaultChecked
  145. Else
  146. Dim Pass As Boolean = IsVisible(TargetOption)
  147. CheckBox.Visibility = If(Pass, Visibility.Visible, Visibility.Collapsed)
  148. CheckBox.Checked = TargetOption.DefaultChecked AndAlso Pass
  149. End If
  150. Next
  151. End Sub
  152. ''' <summary>
  153. ''' 对文本行进行标准化处理,以便使用 Like 进行匹配。
  154. ''' </summary>
  155. Private Iterator Function StandardizeLines(Raw As IEnumerable(Of String), AddSuffixStarToFolderPath As Boolean) As IEnumerable(Of String)
  156. For Each IgnoreLine In Raw
  157. IgnoreLine = IgnoreLine.Trim
  158. If IgnoreLine = "" OrElse IgnoreLine.StartsWithF("#") OrElse IgnoreLine.StartsWithF("=") Then Continue For
  159. IgnoreLine = IgnoreLine.Replace("/", "\")
  160. Yield IgnoreLine & If(IgnoreLine.EndsWithF("\") AndAlso AddSuffixStarToFolderPath, "*", "")
  161. Next
  162. End Function
  163. ''' <summary>
  164. ''' 获取所有可作为选项的 CheckBox。
  165. ''' </summary>
  166. Private Iterator Function GetAllOptions(IncludeHidden As Boolean) As IEnumerable(Of MyCheckBox)
  167. For Each Element In PanOptions.Children
  168. If Not IncludeHidden AndAlso Element.Visibility <> Visibility.Visible Then Continue For
  169. If TypeOf Element Is MyCheckBox Then
  170. Yield Element
  171. ElseIf TypeOf Element Is StackPanel Then
  172. For Each SubElement In DirectCast(Element, StackPanel).Children
  173. If Not IncludeHidden AndAlso SubElement.Visibility <> Visibility.Visible Then Continue For
  174. If TypeOf SubElement Is MyCheckBox Then Yield SubElement
  175. Next
  176. End If
  177. Next
  178. End Function
  179. ''' <summary>
  180. ''' 获取该 CheckBox 对应的 ExportOption。
  181. ''' </summary>
  182. Private Function GetExportOption(CheckBox As MyCheckBox) As ExportOption
  183. Return CType(CheckBox.Tag, ExportOption)
  184. End Function
  185. #End Region
  186. #Region "配置文件"
  187. Private Const Sperator As String = "=============================================================="
  188. ' ================ 导出内容段 ================
  189. ''' <summary>
  190. ''' 从配置文件中读取的规则。
  191. ''' 如果不为 Nothing,则会覆写当前勾选的规则并禁用对应 UI。
  192. ''' </summary>
  193. Private Property RulesOverrides As List(Of String)
  194. Get
  195. Return _RulesOverrides
  196. End Get
  197. Set(value As List(Of String))
  198. _RulesOverrides = value
  199. If value Is Nothing Then
  200. BtnOverrideCancel.Visibility = Visibility.Collapsed
  201. PanOptions.Visibility = Visibility.Visible
  202. CardOptions.Inlines.Clear()
  203. CardOptions.Inlines.Add(New Run("导出内容列表") With {.FontWeight = FontWeights.Bold})
  204. Else
  205. BtnOverrideCancel.Visibility = Visibility.Visible
  206. PanOptions.Visibility = Visibility.Collapsed
  207. CardOptions.Inlines.Clear()
  208. CardOptions.Inlines.Add(New Run("导出内容列表:    ") With {.FontWeight = FontWeights.Bold})
  209. CardOptions.Inlines.Add(New Run("从配置文件中读取") With {.FontWeight = FontWeights.Normal})
  210. End If
  211. End Set
  212. End Property
  213. Private _RulesOverrides As List(Of String) = Nothing
  214. ''' <summary>
  215. ''' 获取当前实际生效的所有规则。
  216. ''' </summary>
  217. Private Iterator Function GetAllRules() As IEnumerable(Of String)
  218. If RulesOverrides IsNot Nothing Then
  219. '返回覆盖的列表
  220. For Each Rule In RulesOverrides
  221. Yield Rule
  222. Next
  223. Else
  224. '从当前勾选的所有选项中获取所有规则行
  225. Yield ""
  226. Yield "# 修改下方的规则以控制需要导出的内容。"
  227. Yield "# 以 ! 开头以反选。可以使用 *、?、[] 通配符。靠后的行覆盖靠前的。"
  228. Yield ""
  229. For Each CheckBox In GetAllOptions(False)
  230. If Not CheckBox.Checked Then Continue For
  231. Dim TargetOption = GetExportOption(CheckBox)
  232. If TargetOption.Rules Is Nothing Then Continue For
  233. Yield $"# {TargetOption.Title}"
  234. For Each Rule In TargetOption.Rules.Split("|"c)
  235. Yield Rule
  236. Next
  237. Yield ""
  238. Next
  239. Yield "# 排除的文件"
  240. Yield "!*.log"
  241. Yield "!*.dat_old"
  242. Yield "!*.BakaCoreInfo"
  243. Yield "!hmclversion.cfg"
  244. Yield "!log4j2.xml"
  245. Yield ""
  246. End If
  247. End Function
  248. ' ================ 追加内容段 ================
  249. Private ExtraFiles As List(Of String) = Nothing
  250. ''' <summary>
  251. ''' 获取当前实际生效的追加内容。
  252. ''' </summary>
  253. Private Iterator Function GetExtraFileLines() As IEnumerable(Of String)
  254. If ExtraFiles IsNot Nothing Then
  255. '返回覆盖的列表
  256. For Each File In ExtraFiles
  257. Yield File
  258. Next
  259. Else
  260. '从当前勾选的所有选项中获取所有规则行
  261. Yield ""
  262. Yield "# 如果想将额外的文件自动放到压缩包根目录中,可以将它们的路径写在下方。"
  263. Yield "# 必须是完整路径。每行中,若以 \ 结尾则代表是文件夹,不以 \ 结尾则代表是文件。"
  264. Yield ""
  265. End If
  266. End Function
  267. ' ================ 重置 ================
  268. ''' <summary>
  269. ''' 重置配置文件所带来的影响。
  270. ''' </summary>
  271. Private Sub ResetConfigOverrides()
  272. RulesOverrides = Nothing
  273. ConfigPackPath = Nothing
  274. ExtraFiles = Nothing
  275. PanBack.ScrollToHome()
  276. End Sub
  277. Private Sub CardOptions_MouseLeftButtonDown() Handles CardOptions.MouseLeftButtonDown
  278. If RulesOverrides Is Nothing Then Return
  279. ResetConfigOverrides()
  280. End Sub
  281. ' ================ 保存 / 读取 ================
  282. '保存配置文件
  283. Private Sub ExportConfig() Handles BtnAdvancedExport.Click
  284. Try
  285. Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Setup.Get("CacheExportConfig"))
  286. If String.IsNullOrEmpty(ConfigPath) Then Return
  287. Setup.Set("CacheExportConfig", ConfigPath)
  288. Dim ConfigLines As New List(Of String)
  289. 'ini 段
  290. ConfigLines.Add("Name:" & TextExportName.Text)
  291. ConfigLines.Add("Version:" & TextExportVersion.Text)
  292. ConfigLines.Add("")
  293. ConfigLines.Add("# 是否打包正式版 PCL,以便没有启动器的玩家安装整合包。")
  294. ConfigLines.Add("IncludeLauncher:" & CheckOptionsPcl.Checked)
  295. ConfigLines.Add("")
  296. ConfigLines.Add("# 是否打包 PCL 个性化内容,例如功能隐藏设置、主页、背景音乐和图片等。")
  297. ConfigLines.Add("IncludeLauncherCustom:" & CheckOptionsPclCustom.Checked)
  298. ConfigLines.Add("")
  299. ConfigLines.Add("# 是否将 Mod、资源包、光影包的文件直接放入整合包中,这样在导入时就无需联网下载它们。")
  300. ConfigLines.Add("# 建议仅在无法稳定连接 CurseForge 或 Modrinth 时才考虑启用。")
  301. ConfigLines.Add("# 二次分发可能违反使用协议,请尽量不要公开发布包含资源文件的整合包!")
  302. ConfigLines.Add("DontCheckHostedAssets:" & CheckAdvancedInclude.Checked)
  303. ConfigLines.Add("")
  304. ConfigLines.Add("# 如果你想要打包上传到 Modrinth,启用此项会生成完全符合 Modrinth 要求的整合包文件。")
  305. ConfigLines.Add("# 由于 Modrinth 要求,只能从 CurseForge 下载的资源将无法联网下载,会被直接放入整合包中。")
  306. ConfigLines.Add("# 此选项与 IncludeLauncher、IncludeLauncherCustom、DontCheckHostedAssets 冲突。")
  307. ConfigLines.Add("ModrinthUploadMode:" & CheckAdvancedModrinth.Checked)
  308. ConfigLines.Add("")
  309. ConfigLines.Add("# 导出的文件的存放位置。")
  310. ConfigLines.Add("# 若设置了此项,在导出时会直接将文件放到此路径,不会弹窗要求选择。")
  311. ConfigLines.Add("# 若 IncludeLauncher 为 True,应以 .zip 结尾;若为 False,应以 .mrpack 结尾。")
  312. ConfigLines.Add("PackPath:" & If(ConfigPackPath, ""))
  313. ConfigLines.Add("")
  314. '导出内容段
  315. ConfigLines.Add(Sperator)
  316. ConfigLines.AddRange(GetAllRules())
  317. '追加内容段
  318. ConfigLines.Add(Sperator)
  319. ConfigLines.AddRange(GetExtraFileLines())
  320. '结束
  321. WriteFile(ConfigPath, ConfigLines.Join(vbCrLf))
  322. Hint("已保存配置文件:" & ConfigPath, HintType.Finish)
  323. OpenExplorer(ConfigPath)
  324. Catch ex As Exception
  325. Log(ex, "保存配置失败", LogLevel.Msgbox)
  326. End Try
  327. End Sub
  328. '读取配置文件
  329. Private Sub ImportConfig() Handles BtnAdvancedImport.Click
  330. Try
  331. Dim ConfigPath As String = SelectFile("整合包导出配置(*.txt)|*.txt", "选择配置文件", Setup.Get("CacheExportConfig"))
  332. If String.IsNullOrEmpty(ConfigPath) Then Return
  333. Setup.Set("CacheExportConfig", ConfigPath)
  334. Dim Segments As String() = ReadFile(ConfigPath).Split(Sperator)
  335. 'ini 段
  336. Dim Ini As New Dictionary(Of String, String)
  337. For Each Line In Segments(0).Split(vbCrLf.ToCharArray())
  338. Line = Line.Trim
  339. If Line = "" OrElse Line.StartsWithF("#") OrElse Line.StartsWithF("=") Then Continue For
  340. Dim Index As Integer = Line.IndexOfF(":")
  341. If Index > 0 Then Ini(Line.Substring(0, Index)) = Line.Substring(Index + 1)
  342. Next
  343. TextExportName.Text = Ini.GetOrDefault("Name", "")
  344. TextExportVersion.Text = Ini.GetOrDefault("Version", "")
  345. CheckOptionsPcl.Checked = Ini.GetOrDefault("IncludeLauncher", True)
  346. CheckOptionsPclCustom.Checked = Ini.GetOrDefault("IncludeLauncherCustom", True)
  347. CheckAdvancedModrinth.Checked = Ini.GetOrDefault("ModrinthUploadMode", False)
  348. CheckAdvancedInclude.Checked = Ini.GetOrDefault("DontCheckHostedAssets", False)
  349. ConfigPackPath = Ini.GetOrDefault("PackPath", Nothing)
  350. '导出内容段
  351. RulesOverrides = Segments(1).Replace(vbCr, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ToList
  352. '追加内容段
  353. If Segments.Length > 2 Then
  354. ExtraFiles = Segments(2).Replace(vbCr, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ToList
  355. Else
  356. ExtraFiles = Nothing
  357. End If
  358. '结束
  359. Hint("已读取配置文件:" & ConfigPath, HintType.Finish)
  360. Catch ex As Exception
  361. Log(ex, "读取配置失败", LogLevel.Msgbox)
  362. End Try
  363. End Sub
  364. #End Region
  365. #Region "导出"
  366. ''' <summary>
  367. ''' 配置文件中指定的导出位置。
  368. ''' </summary>
  369. Private ConfigPackPath As String = Nothing
  370. ''' <summary>
  371. ''' 开始导出。
  372. ''' </summary>
  373. Private Sub StartExport() Handles BtnExport.Click
  374. Dim PackName As String = If(String.IsNullOrEmpty(TextExportName.Text), TextExportName.HintText, TextExportName.Text)
  375. Dim PackVersion As String = If(String.IsNullOrEmpty(TextExportVersion.Text), "1.0.0", TextExportVersion.Text)
  376. '重复任务检查
  377. Dim LoaderName As String = $"导出整合包:" & PackName
  378. For Each OngoingLoader In LoaderTaskbar
  379. If OngoingLoader.Name <> LoaderName Then Continue For
  380. FrmMain.PageChange(FormMain.PageType.DownloadManager)
  381. Return
  382. Next
  383. '确认导出位置
  384. Dim PackPath As String = Nothing
  385. If Not String.IsNullOrWhiteSpace(ConfigPackPath) AndAlso
  386. (Not ConfigPackPath.EndsWithF("\") AndAlso Not ConfigPackPath.EndsWithF("/")) Then
  387. Try
  388. Directory.CreateDirectory(GetPathFromFullPath(ConfigPackPath))
  389. PackPath = ConfigPackPath
  390. Log($"[Export] 使用配置文件中指定的导出路径:{ConfigPackPath}")
  391. Catch ex As Exception
  392. Log(ex, $"无法使用配置文件中指定的导出路径({ConfigPackPath})", LogLevel.Debug)
  393. If MyMsgBox($"指定的路径:{ConfigPackPath}{vbCrLf}{vbCrLf}{GetExceptionDetail(ex)}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
  394. End Try
  395. End If
  396. If PackPath Is Nothing Then
  397. Dim Extensions As New List(Of String)
  398. If Not CheckAdvancedModrinth.Checked Then Extensions.Add("压缩文件(*.zip)|*.zip")
  399. If Not CheckOptionsPcl.Checked Then Extensions.Add("Modrinth 整合包文件(*.mrpack)|*.mrpack")
  400. PackPath = SelectSaveFile("选择导出位置",
  401. PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), Extensions.Join("|"))
  402. Log($"[Export] 手动指定的导出路径:{PackPath}")
  403. End If
  404. If String.IsNullOrEmpty(PackPath) Then Return
  405. '缓存所需参数
  406. Dim CacheFolder = RequestTaskTempFolder()
  407. Dim OverridesFolder = CacheFolder & "modpack\overrides\"
  408. Dim McVersion = PageVersionLeft.Version
  409. Dim PathIndie As String = McVersion.PathIndie
  410. Dim CheckHostedAssets As Boolean = Not CheckAdvancedInclude.Checked
  411. Dim ModrinthUploadMode As Boolean = CheckAdvancedModrinth.Checked
  412. Dim IncludePCL As Boolean = CheckOptionsPcl.Checked
  413. Dim IncludePCLCustom As Boolean = IncludePCL AndAlso CheckOptionsPclCustom.Checked
  414. Dim AllRules = StandardizeLines(GetAllRules(), True).ToList()
  415. Dim AllExtraFiles = StandardizeLines(GetExtraFileLines(), False).ToList()
  416. Log($"[Export] 准备导出整合包,共有 {AllRules.Count} 条规则,{AllExtraFiles.Count} 条追加内容行")
  417. '构造步骤加载器
  418. Dim Loaders As New List(Of LoaderBase)
  419. #Region "准备 PCL 文件"
  420. #If Not BETA Then
  421. If IncludePCL Then
  422. Loaders.Add(New LoaderTask(Of Integer, Integer)("下载 PCL 正式版",
  423. Sub(Loader As LoaderTask(Of Integer, Integer))
  424. DownloadLatestPCL(Loader)
  425. CopyFile(PathTemp & "Latest.exe", CacheFolder & "Plain Craft Launcher.exe")
  426. End Sub) With {.ProgressWeight = 0.5, .Block = False})
  427. End If
  428. #End If
  429. #End Region
  430. #Region "复制文件"
  431. Loaders.Add(New LoaderTask(Of Integer, List(Of McMod))("复制导出内容",
  432. Sub(Loader As LoaderTask(Of Integer, List(Of McMod)))
  433. Loader.Output = New List(Of McMod)
  434. '复制版本文件
  435. Dim Progress As Integer = 0
  436. Dim SearchFolder As Action(Of DirectoryInfo)
  437. SearchFolder =
  438. Sub(Folder As DirectoryInfo)
  439. '文件夹:进一步搜索
  440. For Each SubFolder In Folder.EnumerateDirectories("*", SearchOption.TopDirectoryOnly)
  441. '跳过部分又没用文件又多的文件夹,加快搜索
  442. If Folder.FullName = PathIndie AndAlso {"assets", "versions", "libraries"}.Contains(SubFolder.Name) Then Continue For
  443. If {"structureCacheV1", ".fabric", ".git", "avatar-cache", "cosmetic-cache"}.Contains(SubFolder.Name) Then Continue For
  444. SearchFolder(SubFolder)
  445. Next
  446. '文件:检查规则并复制
  447. For Each Entry In Folder.EnumerateFiles("*", SearchOption.TopDirectoryOnly)
  448. Dim RelativePath As String = Entry.FullName.AfterFirst(PathIndie)
  449. '检查规则
  450. Dim ShouldKeep As Boolean = False
  451. For Each Rule In AllRules
  452. Dim Revert = Rule.StartsWith("!")
  453. If RelativePath Like Rule.TrimStart("!") Then ShouldKeep = Not Revert
  454. Next
  455. If Not ShouldKeep Then Continue For
  456. Dim TargetPath As String = OverridesFolder & RelativePath
  457. CopyFile(Entry.FullName, TargetPath)
  458. '若为压缩包,考虑联网获取路径
  459. If CheckHostedAssets AndAlso
  460. {".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.ToLower) AndAlso
  461. {"mods", "packs", "openloader", "resource"}.Any(Function(s) RelativePath.Contains(s)) Then
  462. Dim ModFile As New McMod(TargetPath)
  463. Dim Unused = ModFile.ModrinthHash '提前计算 Hash
  464. Unused = ModFile.CurseForgeHash
  465. Loader.Output.Add(ModFile)
  466. End If
  467. '更新进度(进度并不准确,主要突出一个我还没似)
  468. Progress += 1
  469. If Progress = 25 Then
  470. Loader.Progress += (0.94 - Loader.Progress) * 0.012
  471. Progress = 0
  472. End If
  473. Next
  474. End Sub
  475. SearchFolder(New DirectoryInfo(PathIndie))
  476. Log($"[Export] 复制 overrides 文件完成,有 {Loader.Output.Count} 个文件需要联网检查")
  477. Loader.Progress = 0.95
  478. '复制追加内容到根目录
  479. Dim BaseFolder As String = If(IncludePCL, CacheFolder, CacheFolder & "modpack\")
  480. For Each Line In AllExtraFiles
  481. If Line.EndsWithF("\") OrElse Line.EndsWithF("/") Then
  482. If Directory.Exists(Line) Then
  483. CopyDirectory(Line, BaseFolder & GetFolderNameFromPath(Line) & "\")
  484. Else
  485. Hint($"未找到配置文件中指定的文件夹:{Line}", HintType.Critical)
  486. End If
  487. Else
  488. If File.Exists(Line) Then
  489. CopyFile(Line, BaseFolder & GetFileNameFromPath(Line))
  490. Else
  491. Hint($"未找到配置文件中指定的单个文件:{Line}", HintType.Critical)
  492. End If
  493. End If
  494. Next
  495. Loader.Progress = 0.97
  496. '复制 PCL 版本设置
  497. CopyDirectory(McVersion.Path & "PCL\", OverridesFolder & "PCL\")
  498. #If BETA Then
  499. '复制 PCL 本体
  500. If IncludePCL Then CopyFile(PathWithName, CacheFolder & "Plain Craft Launcher.exe")
  501. #End If
  502. '复制 PCL 个性化内容
  503. If IncludePCLCustom Then
  504. If Directory.Exists(Path & "PCL\Pictures\") Then CopyDirectory(Path & "PCL\Pictures\", CacheFolder & "PCL\Pictures\")
  505. If Directory.Exists(Path & "PCL\Musics\") Then CopyDirectory(Path & "PCL\Musics\", CacheFolder & "PCL\Musics\")
  506. If Directory.Exists(Path & "PCL\Help\") Then CopyDirectory(Path & "PCL\Help\", CacheFolder & "PCL\Help\")
  507. If File.Exists(Path & "PCL\Custom.xaml") Then CopyFile(Path & "PCL\Custom.xaml", CacheFolder & "PCL\Custom.xaml")
  508. If File.Exists(Path & "PCL\Setup.ini") Then CopyFile(Path & "PCL\Setup.ini", CacheFolder & "PCL\Setup.ini")
  509. If File.Exists(Path & "PCL\hints.txt") Then CopyFile(Path & "PCL\hints.txt", CacheFolder & "PCL\hints.txt")
  510. If File.Exists(Path & "PCL\Logo.png") Then CopyFile(Path & "PCL\Logo.png", CacheFolder & "PCL\Logo.png")
  511. End If
  512. End Sub) With {.ProgressWeight = 5})
  513. #End Region
  514. #Region "联网检查"
  515. Loaders.Add(New LoaderTask(Of List(Of McMod), Dictionary(Of McMod, List(Of String)))("联网获取文件信息",
  516. Sub(Loader As LoaderTask(Of List(Of McMod), Dictionary(Of McMod, List(Of String))))
  517. Loader.Output = New Dictionary(Of McMod, List(Of String))
  518. If Not CheckHostedAssets Then Log($"[Export] 要求跳过联网获取步骤") : Return
  519. If Not Loader.Input.Any Then Log($"[Export] 没有需要联网检查的文件,跳过联网获取步骤") : Return
  520. '分平台获取下载地址
  521. Dim EndedThreadCount As Integer = 0, FailedExceptions As New List(Of Exception)
  522. '从 Modrinth 获取信息
  523. RunInNewThread(
  524. Sub()
  525. Try
  526. Dim ModrinthHashes = Loader.Input.Select(Function(m) m.ModrinthHash)
  527. Dim ModrinthRaw = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST",
  528. $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
  529. For Each ModFile In Loader.Input
  530. '查找对应的文件
  531. If Not ModrinthRaw.ContainsKey(ModFile.ModrinthHash) Then Continue For
  532. If ModrinthRaw(ModFile.ModrinthHash)?("files")?(0)("hashes")?("sha1") <> ModFile.ModrinthHash Then Continue For
  533. '写入下载地址
  534. Loader.Output.AddToList(ModFile, ModrinthRaw(ModFile.ModrinthHash)("files")(0)("url"))
  535. Next
  536. Log($"[Export] 从 Modrinth 获取到 {ModrinthRaw.Count} 个本地资源项的对应信息")
  537. Catch ex As Exception
  538. Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
  539. FailedExceptions.Add(ex)
  540. Finally
  541. EndedThreadCount += 1
  542. Loader.Progress += 0.45
  543. End Try
  544. End Sub, "Modrinth - " & LoaderName)
  545. '从 CurseForge 获取信息
  546. RunInNewThread(
  547. Sub()
  548. Try
  549. If ModrinthUploadMode Then Return 'Modrinth 上传模式下,不能从 CurseForge 获取信息
  550. Dim CurseForgeHashes = Loader.Input.Select(Function(m) m.CurseForgeHash)
  551. Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432/", "POST",
  552. $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
  553. For Each ResultJson As JObject In CurseForgeRaw
  554. If Not ResultJson.ContainsKey("file") Then Continue For
  555. Dim File As JObject = ResultJson("file")
  556. If String.IsNullOrEmpty(File("downloadUrl")) Then Continue For
  557. '查找对应的文件
  558. Dim ModFile As McMod = Loader.Input.FirstOrDefault(Function(m) m.CurseForgeHash = File("fileFingerprint").ToObject(Of UInteger))
  559. If ModFile Is Nothing Then Continue For
  560. '写入下载地址
  561. For Each Address In CompFile.HandleCurseForgeDownloadUrls(File("downloadUrl").ToString)
  562. Loader.Output.AddToList(ModFile, Address)
  563. Next
  564. Next
  565. Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地资源项的对应信息")
  566. Catch ex As Exception
  567. Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
  568. FailedExceptions.Add(ex)
  569. Finally
  570. EndedThreadCount += 1
  571. Loader.Progress += 0.45
  572. End Try
  573. End Sub, "CurseForge - " & LoaderName)
  574. '等待线程结束
  575. Do Until EndedThreadCount = 2
  576. If Loader.IsAborted Then Return
  577. Thread.Sleep(10)
  578. Loop
  579. '若失败,确认是否继续
  580. If FailedExceptions.Count = 1 Then
  581. If MyMsgBox("联网获取部分文件信息失败,是否继续导出?" & vbCrLf & vbCrLf &
  582. "若继续,无法获取信息的文件将被直接打包。" & vbCrLf &
  583. "由于二次分发可能违反使用协议,请尽量不要公开发布导出的整合包!",
  584. "部分文件信息获取失败", "继续", "取消") = 2 Then Throw FailedExceptions.First
  585. ElseIf FailedExceptions.Count > 1 Then
  586. If MyMsgBox("联网获取文件信息失败,是否继续导出?" & vbCrLf & vbCrLf &
  587. "若继续,所有文件都将被直接打包。" & vbCrLf &
  588. "由于二次分发可能违反使用协议,请尽量不要公开发布导出的整合包!",
  589. "文件信息获取失败", "继续", "取消") = 2 Then Throw FailedExceptions.First
  590. End If
  591. End Sub) With {.Show = CheckHostedAssets, .ProgressWeight = If(CheckHostedAssets, 2, 0.01)})
  592. #End Region
  593. #Region "生成压缩包"
  594. Loaders.Add(New LoaderTask(Of Dictionary(Of McMod, List(Of String)), Integer)("生成压缩包",
  595. Sub(Loader As LoaderTask(Of Dictionary(Of McMod, List(Of String)), Integer))
  596. '整理文件列表
  597. Dim Files As New JArray
  598. For Each Pair In Loader.Input
  599. Dim ModFile As McMod = Pair.Key
  600. Files.Add(New JObject From {
  601. {"path", ModFile.Path.AfterFirst(OverridesFolder).Replace("\", "/")},
  602. {"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.Path)}}},
  603. {"downloads", New JArray(Pair.Value.OrderByDescending(Function(u) u.Contains("modrinth.com")))},
  604. {"fileSize", New FileInfo(ModFile.Path).Length}
  605. })
  606. File.Delete(ModFile.Path)
  607. Next
  608. Loader.Progress = 0.2
  609. '导出最终 JSON 文件
  610. Dim Dependencies As New JObject From {{"minecraft", McVersion.Version.McName}}
  611. If McVersion.Version.HasForge Then Dependencies.Add("forge", McVersion.Version.ForgeVersion)
  612. If McVersion.Version.HasFabric Then Dependencies.Add("fabric-loader", McVersion.Version.FabricVersion)
  613. If McVersion.Version.HasNeoForge Then Dependencies.Add("neoforge", McVersion.Version.NeoForgeVersion)
  614. Dim ResultJson As New JObject From {
  615. {"game", "minecraft"},
  616. {"formatVersion", 1},
  617. {"versionId", PackVersion},
  618. {"name", PackName},
  619. {"summary", McVersion.Info},
  620. {"files", Files},
  621. {"dependencies", Dependencies}
  622. }
  623. File.WriteAllText(CacheFolder & "modpack\modrinth.index.json", ResultJson.ToString(Newtonsoft.Json.Formatting.Indented))
  624. '打包
  625. Directory.CreateDirectory(GetPathFromFullPath(PackPath))
  626. If File.Exists(PackPath) Then File.Delete(PackPath)
  627. If IncludePCL Then
  628. '首次压缩整合包
  629. ZipFile.CreateFromDirectory(CacheFolder & "modpack\", CacheFolder & "modpack.mrpack")
  630. Loader.Progress = 0.5
  631. Directory.Delete(CacheFolder & "modpack\", True)
  632. Loader.Progress = 0.6
  633. '二次压缩整合包
  634. ZipFile.CreateFromDirectory(CacheFolder, PackPath)
  635. Loader.Progress = 0.9
  636. Else
  637. '直接压缩整合包
  638. ZipFile.CreateFromDirectory(CacheFolder & "modpack\", PackPath)
  639. Loader.Progress = 0.8
  640. End If
  641. Directory.Delete(CacheFolder, True)
  642. OpenExplorer(PackPath)
  643. End Sub) With {.ProgressWeight = 6})
  644. #End Region
  645. '启动
  646. Dim MainLoader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
  647. MainLoader.Start()
  648. LoaderTaskbarAdd(MainLoader)
  649. FrmMain.BtnExtraDownload.ShowRefresh()
  650. FrmMain.BtnExtraDownload.Ribble()
  651. FrmMain.PageChange(FormMain.PageType.DownloadManager)
  652. End Sub
  653. #End Region
  654. '自动填写整合包名称
  655. Private Sub TextExportName_GotFocus() Handles TextExportName.GotFocus
  656. If TextExportName.Text = "" Then
  657. TextExportName.Text = TextExportName.HintText
  658. TextExportName.SelectionStart = TextExportName.Text.Length
  659. End If
  660. End Sub
  661. '勾选 Modrinth 上传模式时,禁止打包 PCL
  662. Private Sub CheckAdvancedModrinth_Change(sender As Object, user As Boolean) Handles CheckAdvancedModrinth.Change
  663. If CheckAdvancedModrinth.Checked Then CheckOptionsPcl.Checked = False
  664. CheckOptionsPcl.IsEnabled = Not CheckAdvancedModrinth.Checked
  665. End Sub
  666. '勾选打包资源文件时,禁止开启 Modrinth 上传模式
  667. Private Sub CheckAdvancedInclude_Change(sender As Object, user As Boolean) Handles CheckAdvancedInclude.Change
  668. If CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = False
  669. CheckAdvancedModrinth.IsEnabled = Not CheckAdvancedInclude.Checked
  670. End Sub
  671. End Class