ModModpack.vb 70 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245
  1. Imports System.IO.Compression
  2. Imports System.Linq.Expressions
  3. Public Module ModModpack
  4. #Region "安装"
  5. '触发整合包安装的外部接口
  6. ''' <summary>
  7. ''' 弹窗要求选择一个整合包文件并进行安装。
  8. ''' </summary>
  9. Public Sub ModpackInstall()
  10. Dim File As String = SelectFile("整合包文件(*.rar;*.zip;*.mrpack)|*.rar;*.zip;*.mrpack", "选择整合包压缩文件") '选择整合包文件
  11. If String.IsNullOrEmpty(File) Then Exit Sub
  12. RunInThread(
  13. Sub()
  14. Try
  15. ModpackInstall(File)
  16. Catch ex As CancelledException
  17. Catch ex As Exception
  18. Log(ex, "手动安装整合包失败", LogLevel.Msgbox)
  19. End Try
  20. End Sub)
  21. End Sub
  22. ''' <summary>
  23. ''' 构建并启动安装给定的整合包文件的加载器,并返回该加载器。若失败则抛出异常。
  24. ''' 必须在工作线程执行。
  25. ''' </summary>
  26. ''' <exception cref="CancelledException" />
  27. Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
  28. Log("[ModPack] 整合包安装请求:" & If(File, "null"))
  29. Dim Archive As ZipArchive = Nothing
  30. Dim ArchiveBaseFolder As String = ""
  31. Try
  32. '获取整合包种类与关键 Json
  33. Dim PackType As Integer = -1
  34. Try
  35. Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.Read))
  36. '从根目录判断整合包类型
  37. If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
  38. If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
  39. If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
  40. If Archive.GetEntry("manifest.json") IsNot Nothing Then
  41. Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
  42. If Json("addons") Is Nothing Then
  43. PackType = 0 : Exit Try 'CurseForge 整合包
  44. Else
  45. PackType = 3 : Exit Try 'MCBBS 整合包
  46. End If
  47. End If
  48. If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
  49. If Archive.GetEntry("modpack.zip") IsNot Nothing OrElse Archive.GetEntry("modpack.mrpack") IsNot Nothing Then PackType = 9 : Exit Try '带启动器的压缩包
  50. '从一级目录判断整合包类型
  51. For Each Entry In Archive.Entries
  52. Dim FullNames As String() = Entry.FullName.Split("/")
  53. ArchiveBaseFolder = FullNames(0) & "/"
  54. '确定为一级目录下
  55. If FullNames.Count <> 2 Then Continue For
  56. '判断是否为关键文件
  57. If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
  58. If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
  59. If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
  60. If FullNames(1) = "manifest.json" Then
  61. Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
  62. If Json("addons") Is Nothing Then
  63. PackType = 0 : Exit Try 'CurseForge 整合包
  64. Else
  65. PackType = 3 : ArchiveBaseFolder = "overrides/" : Exit Try 'MCBBS 整合包
  66. End If
  67. End If
  68. If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
  69. If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
  70. Next
  71. Catch ex As Exception
  72. If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
  73. Throw New Exception("打开整合包文件失败", ex)
  74. ElseIf File.EndsWithF(".rar", True) Then
  75. Throw New Exception("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", ex)
  76. Else
  77. Throw New Exception("打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", ex)
  78. End If
  79. End Try
  80. '执行对应的安装方法
  81. Select Case PackType
  82. Case 0
  83. Log("[ModPack] 整合包种类:CurseForge")
  84. Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
  85. Case 1
  86. Log("[ModPack] 整合包种类:HMCL")
  87. Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
  88. Case 2
  89. Log("[ModPack] 整合包种类:MMC")
  90. Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
  91. Case 3
  92. Log("[ModPack] 整合包种类:MCBBS")
  93. Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName)
  94. Case 4
  95. Log("[ModPack] 整合包种类:Modrinth")
  96. Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
  97. Case 9
  98. Log("[ModPack] 整合包种类:带启动器的压缩包")
  99. Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
  100. Case Else
  101. Log("[ModPack] 整合包种类:未能识别,假定为压缩包")
  102. Return InstallPackCompress(File, Archive)
  103. End Select
  104. Finally
  105. If Archive IsNot Nothing Then Archive.Dispose()
  106. End Try
  107. End Function
  108. '整合包缓存清理
  109. Private IsInstallCacheCleared As Boolean = False
  110. Private IsInstallCacheClearing As Boolean = False
  111. Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, LoaderProgressDelta As Double)
  112. '清理缓存文件夹
  113. If Not IsInstallCacheCleared Then
  114. IsInstallCacheCleared = True
  115. IsInstallCacheClearing = True
  116. Try
  117. Log("[ModPack] 开始清理整合包安装缓存")
  118. DeleteDirectory(PathTemp & "PackInstall\")
  119. Log("[ModPack] 已清理整合包安装缓存")
  120. Catch ex As Exception
  121. Log(ex, "清理整合包安装缓存失败")
  122. Finally
  123. IsInstallCacheClearing = False
  124. End Try
  125. ElseIf IsInstallCacheClearing Then
  126. '等待另一个整合包安装的清理步骤完成
  127. Do While IsInstallCacheClearing
  128. Thread.Sleep(1)
  129. Loop
  130. End If
  131. '解压文件
  132. Dim RetryCount As Integer = 1
  133. Dim Encode = Encoding.GetEncoding("GB18030")
  134. Try
  135. Retry:
  136. '完全不知道为啥会出现文件正在被另一进程使用的问题,总之多试试
  137. DeleteDirectory(InstallTemp)
  138. ExtractFile(FileAddress, InstallTemp, Encode, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * LoaderProgressDelta)
  139. Catch ex As Exception
  140. Log(ex, "第 " & RetryCount & " 次解压尝试失败")
  141. If TypeOf ex Is ArgumentException Then
  142. Encode = Encoding.UTF8
  143. Log("[ModPack] 已切换压缩包解压编码为 UTF8")
  144. End If
  145. If RetryCount < 5 Then
  146. Thread.Sleep(RetryCount * 2000)
  147. If Loader IsNot Nothing AndAlso Loader.LoadingState <> MyLoading.MyLoadingState.Run Then Exit Sub
  148. RetryCount += 1
  149. GoTo Retry
  150. Else
  151. Throw New Exception("解压整合包文件失败", ex)
  152. End If
  153. End Try
  154. End Sub
  155. #Region "不同类型整合包的安装方法"
  156. 'CurseForge
  157. Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
  158. Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
  159. '读取 Json 文件
  160. Dim Json As JObject
  161. Try
  162. Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
  163. Catch ex As Exception
  164. Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
  165. End Try
  166. If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息")
  167. '获取版本名
  168. If VersionName Is Nothing Then
  169. VersionName = If(Json("name"), "")
  170. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  171. If Validate.Validate(VersionName) <> "" Then VersionName = ""
  172. If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
  173. If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
  174. End If
  175. '获取 Mod API 版本信息
  176. Dim ForgeVersion As String = Nothing
  177. Dim NeoForgeVersion As String = Nothing
  178. Dim FabricVersion As String = Nothing
  179. For Each Entry In If(Json("minecraft")("modLoaders"), {})
  180. Dim Id As String = If(Entry("id"), "").ToString.ToLower
  181. If Id.StartsWithF("forge-") Then
  182. 'Forge 指定
  183. If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老,已不支持进行安装!")
  184. Log("[ModPack] 整合包 Forge 版本:" & Id)
  185. ForgeVersion = Id.Replace("forge-", "")
  186. ElseIf Id.StartsWithF("neoforge-") Then
  187. 'NeoForge 指定
  188. Log("[ModPack] 整合包 NeoForge 版本:" & Id)
  189. NeoForgeVersion = Id.Replace("neoforge-", "")
  190. ElseIf Id.StartsWithF("fabric-") Then
  191. 'Fabric 指定
  192. Log("[ModPack] 整合包 Fabric 版本:" & Id)
  193. FabricVersion = Id.Replace("fabric-", "")
  194. Else
  195. Log("[ModPack] 未知 Mod 加载器:" & Id)
  196. End If
  197. Next
  198. '解压与配置文件
  199. Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
  200. Dim InstallLoaders As New List(Of LoaderBase)
  201. Dim OverrideHome As String = If(Json("overrides"), "")
  202. If OverrideHome <> "" Then
  203. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  204. Sub(Task As LoaderTask(Of String, Integer))
  205. ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
  206. Task.Progress = 0.6
  207. Dim OverridePath As String = InstallTemp & ArchiveBaseFolder & OverrideHome
  208. '复制结果
  209. If Directory.Exists(OverridePath) Then
  210. CopyDirectory(OverridePath, PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
  211. Log($"[ModPack] 整合包 override 复制:{OverridePath} -> {PathMcFolder & "versions\" & VersionName}")
  212. Else
  213. Log($"[ModPack] 整合包中未找到 override 文件夹:{OverridePath}")
  214. End If
  215. Task.Progress = 0.95
  216. '开启版本隔离
  217. WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
  218. End Sub) With {
  219. .ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  220. End If
  221. '获取 Mod 列表
  222. Dim ModList As New List(Of Integer)
  223. Dim ModOptionalList As New List(Of Integer)
  224. For Each ModEntry In If(Json("files"), {})
  225. If ModEntry("projectID") Is Nothing OrElse ModEntry("fileID") Is Nothing Then
  226. Hint("某项 Mod 缺少必要信息,已跳过:" & ModEntry.ToString)
  227. Continue For
  228. End If
  229. ModList.Add(ModEntry("fileID"))
  230. If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then ModOptionalList.Add(ModEntry("fileID"))
  231. Next
  232. If ModList.Any Then
  233. Dim ModDownloadLoaders As New List(Of LoaderBase)
  234. '获取 Mod 下载信息
  235. ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
  236. Sub(Task As LoaderTask(Of Integer, JArray))
  237. Task.Output = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
  238. '如果文件已被删除,则 API 会跳过那一项
  239. If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除,所以没法继续安装了,请向整合包作者反馈该问题")
  240. End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
  241. '构造 NetFile
  242. ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
  243. Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
  244. Dim FileList As New Dictionary(Of Integer, NetFile)
  245. For Each ModJson In Task.Input
  246. Dim Id As Integer = ModJson("id").ToObject(Of Integer)
  247. '跳过重复的 Mod(疑似 CurseForge Bug)
  248. If FileList.ContainsKey(Id) Then Continue For
  249. '可选 Mod 提示
  250. If ModOptionalList.Contains(Id) Then
  251. If MyMsgBox("是否要下载整合包中的可选文件 " & ModJson("displayName").ToString & "?",
  252. "下载可选文件", "是", "否") = 2 Then
  253. Continue For
  254. End If
  255. End If
  256. '建立 CompFile
  257. Dim File As New CompFile(ModJson, CompType.Mod)
  258. If Not File.Available Then Continue For
  259. '根据 modules 和文件名后缀判断资源类型
  260. Dim TargetFolder As String
  261. If ModJson("modules").Any Then 'modules 可能返回 null(#1006)
  262. Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
  263. If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
  264. File.FileName.EndsWithF(".jar", True) Then
  265. TargetFolder = "mods"
  266. ElseIf ModuleNames.Contains("pack.mcmeta") Then
  267. TargetFolder = "resourcepacks"
  268. Else
  269. TargetFolder = "shaderpacks"
  270. End If
  271. Else
  272. TargetFolder = "mods"
  273. End If
  274. '实际的添加
  275. FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{TargetFolder}\"))
  276. Task.Progress += 1 / (1 + ModList.Count)
  277. Next
  278. Task.Output = FileList.Values.ToList
  279. End Sub) With {.ProgressWeight = ModList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
  280. '下载 Mod 文件
  281. ModDownloadLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
  282. '构造加载器
  283. InstallLoaders.Add(New LoaderCombo(Of Integer)("下载 Mod(主加载器)", ModDownloadLoaders) With
  284. {.Show = False, .ProgressWeight = ModDownloadLoaders.Sum(Function(l) l.ProgressWeight)})
  285. End If
  286. '构造加载器
  287. Dim Request As New McInstallRequest With {
  288. .TargetVersionName = VersionName,
  289. .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
  290. .MinecraftName = Json("minecraft")("version").ToString,
  291. .ForgeVersion = ForgeVersion,
  292. .NeoForgeVersion = NeoForgeVersion,
  293. .FabricVersion = FabricVersion
  294. }
  295. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  296. '构造 Libraries 加载器
  297. Dim LoadersLib As New List(Of LoaderBase)
  298. LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
  299. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  300. '构造总加载器
  301. Dim Loaders As New List(Of LoaderBase)
  302. Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
  303. Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
  304. Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
  305. Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
  306. Sub(Task As LoaderTask(Of String, String))
  307. '设置图标
  308. Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
  309. If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
  310. File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
  311. WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
  312. WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
  313. Log("[ModPack] 已设置整合包 Logo:" & Logo)
  314. End If
  315. '删除原始整合包文件
  316. For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
  317. If File.Exists(Target) Then
  318. Log("[ModPack] 删除原始整合包文件:" & Target)
  319. File.Delete(Target)
  320. End If
  321. Next
  322. End Sub) With {.ProgressWeight = 0.1, .Show = False})
  323. '重复任务检查
  324. Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
  325. If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
  326. Hint("该整合包正在安装中!", HintType.Critical)
  327. Throw New CancelledException
  328. End If
  329. '启动
  330. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  331. Loader.Start(Request.TargetVersionFolder)
  332. LoaderTaskbarAdd(Loader)
  333. FrmMain.BtnExtraDownload.ShowRefresh()
  334. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
  335. Return Loader
  336. End Function
  337. 'Modrinth
  338. Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
  339. '读取 Json 文件
  340. Dim Json As JObject
  341. Try
  342. Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open))
  343. Catch ex As Exception
  344. Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
  345. End Try
  346. If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息")
  347. '获取 Mod API 版本信息
  348. Dim MinecraftVersion As String = Nothing
  349. Dim ForgeVersion As String = Nothing
  350. Dim NeoForgeVersion As String = Nothing
  351. Dim FabricVersion As String = Nothing
  352. For Each Entry As JProperty In If(Json("dependencies"), {})
  353. Select Case Entry.Name.ToLower
  354. Case "minecraft"
  355. MinecraftVersion = Entry.Value.ToString
  356. Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
  357. ForgeVersion = Entry.Value.ToString
  358. Log("[ModPack] 整合包 Forge 版本:" & ForgeVersion)
  359. Case "neoforge", "neo-forge" 'eg. 20.6.98-beta
  360. NeoForgeVersion = Entry.Value.ToString
  361. Log("[ModPack] 整合包 NeoForge 版本:" & NeoForgeVersion)
  362. Case "fabric-loader" 'eg. 0.14.14
  363. FabricVersion = Entry.Value.ToString
  364. Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
  365. Case "quilt-loader" 'eg. 1.0.0
  366. Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
  367. Throw New CancelledException
  368. Case Else
  369. Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical)
  370. Throw New CancelledException
  371. End Select
  372. Next
  373. '获取版本名
  374. If VersionName Is Nothing Then
  375. VersionName = If(Json("name"), "")
  376. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  377. If Validate.Validate(VersionName) <> "" Then VersionName = ""
  378. If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
  379. If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
  380. End If
  381. '解压和配置文件
  382. Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
  383. Dim InstallLoaders As New List(Of LoaderBase)
  384. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  385. Sub(Task As LoaderTask(Of String, Integer))
  386. ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
  387. Task.Progress = 0.6
  388. '复制 overrides 文件夹和 client-overrides 文件夹
  389. If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
  390. CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
  391. Sub(Delta) Task.Progress += Delta * 0.25)
  392. Else
  393. Log("[ModPack] 整合包中未找到 override 目录,已跳过")
  394. End If
  395. Task.Progress = 0.85
  396. If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
  397. CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName,
  398. Sub(Delta) Task.Progress += Delta * 0.1)
  399. End If
  400. Task.Progress = 0.95
  401. '开启版本隔离
  402. WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
  403. End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  404. '获取下载文件列表
  405. Dim FileList As New List(Of NetFile)
  406. For Each File In If(Json("files"), {})
  407. '检查是否需要该文件
  408. If File("env") IsNot Nothing Then
  409. Select Case File("env")("client").ToString
  410. Case "optional"
  411. If MyMsgBox("是否要下载整合包中的可选文件 " & GetFileNameFromPath(File("path").ToString) & "?",
  412. "下载可选文件", "是", "否") = 2 Then
  413. Continue For
  414. End If
  415. Case "unsupported"
  416. Continue For
  417. End Select
  418. End If
  419. '添加下载文件
  420. Dim Urls = File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToList
  421. Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
  422. Urls = Urls.Distinct.ToList()
  423. FileList.Add(New NetFile(Urls, PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
  424. New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
  425. Next
  426. If FileList.Any Then
  427. InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
  428. End If
  429. '构造加载器
  430. Dim Request As New McInstallRequest With {
  431. .TargetVersionName = VersionName,
  432. .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
  433. .MinecraftName = MinecraftVersion,
  434. .ForgeVersion = ForgeVersion,
  435. .NeoForgeVersion = NeoForgeVersion,
  436. .FabricVersion = FabricVersion
  437. }
  438. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  439. '构造 Libraries 加载器
  440. Dim LoadersLib As New List(Of LoaderBase)
  441. LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
  442. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  443. '构造总加载器
  444. Dim Loaders As New List(Of LoaderBase)
  445. Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
  446. Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
  447. Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
  448. Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
  449. Sub(Task As LoaderTask(Of String, String))
  450. '设置图标
  451. Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
  452. If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
  453. File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
  454. WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
  455. WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
  456. Log("[ModPack] 已设置整合包 Logo:" & Logo)
  457. End If
  458. '删除原始整合包文件
  459. For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
  460. If File.Exists(Target) Then
  461. Log("[ModPack] 删除原始整合包文件:" & Target)
  462. File.Delete(Target)
  463. End If
  464. Next
  465. End Sub) With {.ProgressWeight = 0.1, .Show = False})
  466. '重复任务检查
  467. Dim LoaderName As String = "Modrinth 整合包安装:" & VersionName & " "
  468. If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
  469. Hint("该整合包正在安装中!", HintType.Critical)
  470. Throw New CancelledException
  471. End If
  472. '启动
  473. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  474. Loader.Start(Request.TargetVersionFolder)
  475. LoaderTaskbarAdd(Loader)
  476. FrmMain.BtnExtraDownload.ShowRefresh()
  477. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
  478. Return Loader
  479. End Function
  480. 'HMCL
  481. Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
  482. '读取 Json 文件
  483. Dim Json As JObject
  484. Try
  485. Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
  486. Catch ex As Exception
  487. Throw New Exception("HMCL 整合包安装信息存在问题", ex)
  488. End Try
  489. '获取版本名
  490. Dim VersionName As String = If(Json("name"), "")
  491. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  492. If Validate.Validate(VersionName) <> "" Then VersionName = ""
  493. If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
  494. If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
  495. '解压与配置文件
  496. Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
  497. Dim InstallLoaders As New List(Of LoaderBase)
  498. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  499. Sub(Task As LoaderTask(Of String, Integer))
  500. ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
  501. Task.Progress = 0.6
  502. '复制结果
  503. If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
  504. CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
  505. Else
  506. Log("[ModPack] 整合包中未找到 minecraft override 目录,已跳过")
  507. End If
  508. Task.Progress = 0.95
  509. '开启版本隔离
  510. WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
  511. End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  512. '构造加载器
  513. If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息,无法安装!")
  514. Dim Request As New McInstallRequest With {
  515. .TargetVersionName = VersionName,
  516. .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
  517. .MinecraftName = Json("gameVersion").ToString
  518. }
  519. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  520. '构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
  521. Dim LoadersLib As New List(Of LoaderBase)
  522. LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)",
  523. Sub()
  524. Dim RealFileName As String = PathMcFolder & "versions\" & VersionName & "\" & VersionName & ".json"
  525. Dim OldFileName As String = PathMcFolder & "versions\" & VersionName & "\pack.json"
  526. If File.Exists(OldFileName) Then
  527. '修改 id
  528. Dim FileJson = GetJson(ReadFile(OldFileName))
  529. FileJson("id") = VersionName
  530. '替换文件
  531. File.Delete(OldFileName)
  532. WriteFile(RealFileName, FileJson.ToString)
  533. Log("[ModPack] 已重命名版本 Json:" & RealFileName)
  534. End If
  535. End Sub) With {.ProgressWeight = 0.1, .Show = False})
  536. LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
  537. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  538. '构造总加载器
  539. Dim Loaders As New List(Of LoaderBase) From {
  540. New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)},
  541. New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)},
  542. New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}
  543. }
  544. '重复任务检查
  545. Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " "
  546. If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
  547. Hint("该整合包正在安装中!", HintType.Critical)
  548. Throw New CancelledException
  549. End If
  550. '启动
  551. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  552. 'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
  553. Loader.Start(Request.TargetVersionFolder)
  554. LoaderTaskbarAdd(Loader)
  555. FrmMain.BtnExtraDownload.ShowRefresh()
  556. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
  557. Return Loader
  558. End Function
  559. 'MMC
  560. Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
  561. '读取 Json 文件
  562. Dim PackJson As JObject, PackInstance As String
  563. Try
  564. PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8))
  565. PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
  566. Catch ex As Exception
  567. Throw New Exception("MMC 整合包安装信息存在问题", ex)
  568. End Try
  569. '获取版本名
  570. Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
  571. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  572. If Validate.Validate(VersionName) <> "" Then VersionName = ""
  573. If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
  574. If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
  575. '解压、配置设置文件
  576. Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\"
  577. Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
  578. Dim InstallLoaders As New List(Of LoaderBase)
  579. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  580. Sub(Task As LoaderTask(Of String, Integer))
  581. ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
  582. Task.Progress = 0.6
  583. '复制结果
  584. If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
  585. CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
  586. Else
  587. Log("[ModPack] 整合包中未找到 override .minecraft 目录,已跳过")
  588. End If
  589. Task.Progress = 0.95
  590. '开启版本隔离
  591. WriteIni(SetupFile, "VersionArgumentIndie", 1)
  592. '读取 MMC 设置文件(#2655)
  593. Try
  594. Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
  595. If File.Exists(MMCSetupFile) Then
  596. '部分等号替换为冒号,以符合 ini 文件格式
  597. '为JvmArgs添加排除项,防止参数中的等号被错误的替换
  598. Dim MMCSetupFileLines() As String = File.ReadAllLines(MMCSetupFile)
  599. For i As Integer = 0 To MMCSetupFileLines.Length - 1
  600. '按行读取,检查开头是否为"JvmArgs="
  601. If MMCSetupFileLines(i).StartsWith("JvmArgs=") Then
  602. '有则只替换这个等号,忽略参数部分
  603. MMCSetupFileLines(i) = "JvmArgs:" & MMCSetupFileLines(i).Substring("JvmArgs=".Length)
  604. Else
  605. '无则全部替换
  606. MMCSetupFileLines(i) = MMCSetupFileLines(i).Replace("=", ":")
  607. End If
  608. Next
  609. '修改后写回文件
  610. File.WriteAllLines(MMCSetupFile, MMCSetupFileLines)
  611. If ReadIni(MMCSetupFile, "OverrideCommands", False) Then
  612. Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand")
  613. If PreLaunchCommand <> "" Then
  614. PreLaunchCommand = PreLaunchCommand.Replace("\""", """").
  615. Replace("$INST_JAVA", "{java}javaw.exe").
  616. Replace("$INST_MC_DIR\", "{minecraft}").Replace("$INST_MC_DIR", "{minecraft}").
  617. Replace("$INST_DIR\", "{verpath}").Replace("$INST_DIR", "{verpath}").
  618. Replace("$INST_ID", "{name}").Replace("$INST_NAME", "{name}")
  619. WriteIni(SetupFile, "VersionAdvanceRun", PreLaunchCommand)
  620. Log("[ModPack] 迁移 MultiMC 版本独立设置:启动前执行命令:" & PreLaunchCommand)
  621. End If
  622. End If
  623. If ReadIni(MMCSetupFile, "JoinServerOnLaunch", False) Then
  624. Dim ServerAddress As String = ReadIni(MMCSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """")
  625. WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
  626. Log("[ModPack] 迁移 MultiMC 版本独立设置:自动进入服务器:" & ServerAddress)
  627. End If
  628. If ReadIni(MMCSetupFile, "IgnoreJavaCompatibility", False) Then
  629. WriteIni(SetupFile, "VersionAdvanceJava", True)
  630. Log("[ModPack] 迁移 MultiMC 版本独立设置:忽略 Java 兼容性警告")
  631. End If
  632. Dim Logo As String = ReadIni(MMCSetupFile, "iconKey", "")
  633. If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
  634. WriteIni(SetupFile, "LogoCustom", True)
  635. WriteIni(SetupFile, "Logo", "PCL\Logo.png")
  636. CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{PathMcFolder}versions\{VersionName}\PCL\Logo.png")
  637. Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)")
  638. End If
  639. 'JvmArgs参数
  640. Dim JvmArgs As String = ReadIni(MMCSetupFile, "JvmArgs", "")
  641. If JvmArgs <> "" Then
  642. WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
  643. Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数:" & JvmArgs)
  644. End If
  645. '这段我看参数有就给加上了...
  646. If ReadIni(MMCSetupFile, "OverrideJavaArgs", False) Then
  647. WriteIni(SetupFile, "VersionAdvanceJavaArgs", True)
  648. Log("[ModPack] 迁移 MultiMC 版本独立设置:覆盖 JavaArgs")
  649. End If
  650. End If
  651. Catch ex As Exception
  652. Log(ex, $"读取 MMC 配置文件失败({InstallTemp}{ArchiveBaseFolder}instance.cfg)")
  653. End Try
  654. End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  655. '构造版本安装请求
  656. If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息,无法安装!")
  657. Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
  658. For Each Component In PackJson("components")
  659. Select Case If(Component("uid"), "").ToString
  660. Case "org.lwjgl"
  661. Log("[ModPack] 已跳过 LWJGL 项")
  662. Case "net.minecraft"
  663. Request.MinecraftName = Component("version")
  664. Case "net.minecraftforge"
  665. Request.ForgeVersion = Component("version")
  666. Case "net.neoforged"
  667. Request.NeoForgeVersion = Component("version")
  668. Case "net.fabricmc.fabric-loader"
  669. Request.FabricVersion = Component("version")
  670. Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
  671. Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
  672. Throw New CancelledException
  673. End Select
  674. Next
  675. '构造加载器
  676. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  677. '构造 Libraries 加载器
  678. Dim LoadersLib As New List(Of LoaderBase)
  679. LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
  680. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  681. '构造总加载器
  682. Dim Loaders As New List(Of LoaderBase)
  683. Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
  684. Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
  685. Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
  686. '重复任务检查
  687. Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " "
  688. If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
  689. Hint("该整合包正在安装中!", HintType.Critical)
  690. Throw New CancelledException
  691. End If
  692. '启动
  693. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  694. Loader.Start(Request.TargetVersionFolder)
  695. LoaderTaskbarAdd(Loader)
  696. FrmMain.BtnExtraDownload.ShowRefresh()
  697. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
  698. Return Loader
  699. End Function
  700. 'MCBBS
  701. Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
  702. Optional VersionName As String = Nothing) As LoaderCombo(Of String)
  703. '读取 Json 文件
  704. Dim Json As JObject
  705. Try
  706. Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
  707. Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
  708. Catch ex As Exception
  709. Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
  710. End Try
  711. '获取版本名
  712. If VersionName Is Nothing Then
  713. VersionName = If(Json("name"), "")
  714. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  715. If Validate.Validate(VersionName) <> "" Then VersionName = ""
  716. If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
  717. If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
  718. End If
  719. '解压与配置文件
  720. Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
  721. Dim InstallLoaders As New List(Of LoaderBase)
  722. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  723. Sub(Task As LoaderTask(Of String, Integer))
  724. ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
  725. Task.Progress = 0.6
  726. '复制结果
  727. If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
  728. CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
  729. Sub(Delta) Task.Progress += 0.35 * Delta)
  730. Else
  731. Log("[ModPack] 整合包中未找到 overrides 目录,已跳过")
  732. End If
  733. Task.Progress = 0.95
  734. '开启版本隔离
  735. WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
  736. End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  737. '构造加载器
  738. If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息,无法安装!")
  739. Dim Addons As New Dictionary(Of String, String)
  740. For Each Entry In Json("addons")
  741. Addons.Add(Entry("id"), Entry("version"))
  742. Next
  743. If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息,无法安装!")
  744. If Addons.ContainsKey("quilt") Then
  745. Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
  746. Throw New CancelledException
  747. End If
  748. Dim Request As New McInstallRequest With {
  749. .TargetVersionName = VersionName,
  750. .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
  751. .MinecraftName = Addons("game"),
  752. .OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
  753. .ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
  754. .NeoForgeVersion = If(Addons.ContainsKey("neoforge"), Addons("neoforge"), Nothing),
  755. .FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
  756. }
  757. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  758. '构造 Libraries 加载器
  759. Dim LoadersLib As New List(Of LoaderBase)
  760. LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
  761. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  762. '构造总加载器
  763. Dim Loaders As New List(Of LoaderBase)
  764. Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
  765. Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
  766. Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
  767. '重复任务检查
  768. Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " "
  769. If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
  770. Hint("该整合包正在安装中!", HintType.Critical)
  771. Throw New CancelledException
  772. End If
  773. '启动
  774. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  775. 'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
  776. Loader.Start(Request.TargetVersionFolder)
  777. LoaderTaskbarAdd(Loader)
  778. FrmMain.BtnExtraDownload.ShowRefresh()
  779. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
  780. Return Loader
  781. End Function
  782. '带启动器的压缩包
  783. Private Function InstallPackLauncherPack(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
  784. '获取解压路径
  785. MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
  786. Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
  787. If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
  788. If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Throw New CancelledException
  789. If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
  790. '解压
  791. Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
  792. New LoaderTask(Of String, Integer)("解压压缩包",
  793. Sub(Task As LoaderTask(Of String, Integer))
  794. ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.9)
  795. Thread.Sleep(400) '避免文件争用
  796. '查找解压后的 exe 文件
  797. Dim Launcher As String = Nothing
  798. For Each ExeFile In Directory.GetFiles(TargetFolder, "*.exe", SearchOption.TopDirectoryOnly)
  799. Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
  800. Log($"[Modpack] 文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
  801. If Info.ProductName = "Plain Craft Launcher" Then
  802. Launcher = ExeFile
  803. Log($"[Modpack] 发现整合包附带的 PCL 启动器:{ExeFile}")
  804. ElseIf (Info.ProductName.ContainsF("Launcher", True) OrElse Info.ProductName.ContainsF("启动", True)) AndAlso
  805. Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then
  806. If Launcher Is Nothing Then
  807. Launcher = ExeFile
  808. Log($"[Modpack] 发现整合包附带的疑似第三方启动器:{ExeFile}")
  809. End If
  810. End If
  811. Next
  812. Task.Progress = 0.95
  813. '尝试使用附带的启动器打开
  814. If Launcher IsNot Nothing Then
  815. Log("[Modpack] 找到压缩包中附带的启动器:" & Launcher)
  816. If MyMsgBox($"整合包中似乎自带了启动器,是否换用它继续安装?{vbCrLf}通常推荐这样做,以获得最佳体验。{vbCrLf}即将打开:{Launcher}", "换用整合包启动器?", "继续", "取消") = 1 Then
  817. ShellOnly(Launcher, "--wait")
  818. Log("[Modpack] 为换用整合包中的启动器启动,强制结束程序")
  819. FrmMain.EndProgram(False)
  820. Return
  821. End If
  822. Else
  823. Log("[Modpack] 未找到压缩包中附带的启动器")
  824. End If
  825. '加入文件夹列表
  826. Dim VersionName As String = GetFolderNameFromPath(TargetFolder)
  827. PageSelectLeft.AddFolder(
  828. TargetFolder & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
  829. VersionName, False)
  830. '调用 modpack 文件进行安装
  831. Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
  832. Log("[Modpack] 调用 modpack 文件继续安装:" & ModpackFile)
  833. ModpackInstall(ModpackFile, VersionName)
  834. End Sub)
  835. })
  836. Loader.Start(TargetFolder)
  837. LoaderTaskbarAdd(Loader)
  838. FrmMain.BtnExtraDownload.ShowRefresh()
  839. FrmMain.BtnExtraDownload.Ribble()
  840. Return Loader
  841. End Function
  842. '普通压缩包
  843. Private Function InstallPackCompress(FileAddress As String, Archive As Compression.ZipArchive) As LoaderCombo(Of String)
  844. '尝试定位 .minecraft 文件夹:寻找形如 “/versions/XXX/XXX.json” 的路径
  845. Dim Match As RegularExpressions.Match = Nothing
  846. Dim Regex As New RegularExpressions.Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegularExpressions.RegexOptions.IgnoreCase)
  847. For Each Entry In Archive.Entries
  848. Dim EntryMatch = Regex.Match("/" & Entry.FullName)
  849. If EntryMatch.Success Then
  850. Match = EntryMatch
  851. Exit For
  852. End If
  853. Next
  854. If Match Is Nothing Then Throw New Exception("未能找到适合的文件结构,这可能不是一个 MC 压缩包") '没有匹配
  855. Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
  856. Dim VersionName As String = Match.Groups(1).Value
  857. Log("[ModPack] 检测到压缩包的 .minecraft 根目录:" & ArchiveBaseFolder & ",命中的版本名:" & VersionName)
  858. '获取解压路径
  859. MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
  860. Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
  861. If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
  862. If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Throw New CancelledException
  863. If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
  864. '解压
  865. Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
  866. New LoaderTask(Of String, Integer)("解压压缩包",
  867. Sub(Task As LoaderTask(Of String, Integer))
  868. ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.95)
  869. '加入文件夹列表
  870. PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
  871. Thread.Sleep(400) '避免文件争用
  872. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.VersionSelect))
  873. End Sub)
  874. }) With {.OnStateChanged = AddressOf McInstallState}
  875. Loader.Start(TargetFolder)
  876. LoaderTaskbarAdd(Loader)
  877. FrmMain.BtnExtraDownload.ShowRefresh()
  878. FrmMain.BtnExtraDownload.Ribble()
  879. Return Loader
  880. End Function
  881. #End Region
  882. #End Region
  883. #Region "导出"
  884. Private ExpTempDir As String = PathTemp & "PackExport\"
  885. ''' <summary>
  886. ''' 整合包类型。
  887. ''' </summary>
  888. Public Enum ModpackType
  889. Modrinth
  890. End Enum
  891. ''' <summary>
  892. ''' 导出整合包的选项。
  893. ''' </summary>
  894. Public Class ExportOptions
  895. ''' <summary>
  896. ''' 要导出的版本。
  897. ''' </summary>
  898. Public Version As McVersion
  899. ''' <summary>
  900. ''' 要保存整合包的位置。
  901. ''' </summary>
  902. Public Dest As String
  903. ''' <summary>
  904. ''' 是否包括 PCL 文件。
  905. ''' </summary>
  906. Public IncludePCL As Boolean
  907. ''' <summary>
  908. ''' 整合包类型。
  909. ''' </summary>
  910. Public Type As ModpackType
  911. ''' <summary>
  912. ''' 要保留到整合包的文件。
  913. ''' </summary>
  914. Public Additional As String()
  915. ''' <summary>
  916. ''' 是否需要保留 PCL 全局设置。仅在包括 PCL 时有效。
  917. ''' </summary>
  918. Public PCLSetupGlobal As Boolean = True
  919. ''' <summary>
  920. ''' 整合包名称。
  921. ''' </summary>
  922. Public Name As String = ""
  923. ''' <summary>
  924. ''' 整合包描述。
  925. ''' </summary>
  926. Public Desc As String = ""
  927. ''' <summary>
  928. ''' 版本号。
  929. ''' </summary>
  930. Public VerID As String = ""
  931. Public Sub New(Version As McVersion,
  932. Dest As String,
  933. IncludePCL As Boolean,
  934. Additional As String(),
  935. Optional PCLSetupGlobal As Boolean = True,
  936. Optional Name As String = "",
  937. Optional Desc As String = "",
  938. Optional VerID As String = "")
  939. Me.Version = Version
  940. Me.Dest = Dest
  941. Me.IncludePCL = IncludePCL
  942. Me.Additional = Additional
  943. Me.PCLSetupGlobal = PCLSetupGlobal
  944. Me.Name = Name
  945. Me.Desc = Desc
  946. Me.VerID = VerID
  947. End Sub
  948. End Class
  949. ''' <summary>
  950. ''' 导出整合包,返回是否成功。
  951. ''' </summary>
  952. Public Function ModpackExport(Task As LoaderTask(Of ExportOptions, Boolean)) As Boolean
  953. If Task.Input.IncludePCL Then Return ExportCompressed(Task)
  954. Return ExportModrinth(Task)
  955. End Function
  956. #Region "冗余"
  957. Private VersionRedundant As String() = {"^screenshots", "^backups", "^command_history\.txt$", '个人文件
  958. "^.*-natives", "^server-resource-packs", "^user.*cache\.json$", "^\.optifine", "^\.fabric", "^\.mixin\.out", '缓存
  959. "^.*\.jar$", "^downloads", "^realms_persistence.json$", "^\$\{natives_directory\}", "^essential", '可联网更新
  960. "^logs", "^crash-reports", ".*\.log$", "^debug", '日志
  961. ".*\.dat_old$", ".*\.old$", '备份
  962. "^\$\{quickPlayPath\}", '服务器
  963. "^\.replay_cache", "^replay_recordings", "^replay_videos", 'ReplayMod
  964. "^irisUpdateInfo\.json$", 'Iris
  965. "^modernfix", 'ModernFix 模组
  966. "^modtranslations", 'Mod 翻译
  967. "^schematics", 'schematics 模组
  968. "^journeymap\\data", 'JourneyMap 模组
  969. "^mods\\\.connector", '信雅互联
  970. "^.*\.BakaCoreInfo$", 'BakaXL 配置
  971. "^hmclversion\.cfg$", "^log4j2\.xml$", 'HMCL 配置
  972. "^assets$", "^libraries$", "^\$natives$", "^launcher_profiles\.json$", "^versions$" '开启版本隔离时排除的文件
  973. }
  974. Public Function IsVerRedundant(FilePath As String, PathIndie As String) As Boolean
  975. FilePath = FilePath.Replace("/", "\")
  976. For Each regex In VersionRedundant
  977. If RegexCheck(FilePath.Replace(PathIndie, ""), regex, RegularExpressions.RegexOptions.IgnoreCase) Then Return True
  978. Next
  979. Return False
  980. End Function
  981. Private MustExport As String() = {
  982. "mods", "PCL", ".*\.json"
  983. }
  984. Public Function IsMustExport(FilePath As String, PathIndie As String) As Boolean
  985. For Each regex In MustExport
  986. If RegexCheck(FilePath.Replace(PathIndie, ""), regex, RegularExpressions.RegexOptions.IgnoreCase) AndAlso Not (FilePath.EndsWithF(".zip") OrElse FilePath.EndsWithF("\")) Then Return True
  987. Next
  988. Return False
  989. End Function
  990. #End Region
  991. #Region "不同类型整合包的导出方法"
  992. Private Function ExportModrinth(Task As LoaderTask(Of ExportOptions, Boolean)) As Boolean
  993. Try
  994. Dim Version = Task.Input.Version
  995. Dim DestPath = Task.Input.Dest
  996. Dim Additional = Task.Input.Additional
  997. Dim Name = Task.Input.Name
  998. Dim Description = Task.Input.Desc
  999. Dim VerID = Task.Input.VerID
  1000. Log($"[Export] 导出整合包(Modrinth):{Version.Path} -> {DestPath},额外版本文件 {Additional.Count} 个")
  1001. Dim tempDir As String = $"{ExpTempDir}{GetUuid()}\"
  1002. Log($"[Export] 缓存文件夹:{tempDir}")
  1003. DeleteDirectory(tempDir)
  1004. Directory.CreateDirectory(tempDir)
  1005. #Region "0.04-0.40:从 Modrinth 获取 Mod 工程信息,得到 URL"
  1006. Dim Mods As New Dictionary(Of String, McMod)
  1007. If Directory.Exists(Version.Path & "mods\") Then
  1008. For Each m In Directory.EnumerateFiles(Version.Path & "mods\")
  1009. If m.EndsWithF(".jar") Then Mods.Add(GetFileNameFromPath(m), New McMod(m))
  1010. Next
  1011. End If
  1012. '从 Modrinth 获取信息
  1013. Dim ModrinthMapping As New Dictionary(Of String, JObject) 'Modrinth 获取到的 Mod
  1014. Dim CurseForgeMapping As New Dictionary(Of String, JObject) 'CurseForge 获取到的 Mod
  1015. Dim Failed = Mods.ToArray().ToDictionary(Function(a) a.Key, Function(a) a.Value) '获取失败的 Mod
  1016. Dim ModrinthHashes = Mods.Select(Function(m) m.Value.ModrinthHash).ToList()
  1017. If Mods.Count = 0 Then GoTo JumpMod
  1018. Dim ModrinthRaw = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST",
  1019. $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
  1020. Log($"[Export] 从 Modrinth 获取到 {ModrinthRaw.Count} 个本地 Mod 的对应信息")
  1021. Task.Progress = 0.35
  1022. For Each Entry In Mods
  1023. If (Not ModrinthRaw.ContainsKey(Entry.Value.ModrinthHash)) OrElse
  1024. (ModrinthRaw(Entry.Value.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.Value.ModrinthHash) Then
  1025. Continue For
  1026. End If
  1027. Failed.Remove(Entry.Key)
  1028. ModrinthMapping.Add(Entry.Key, ModrinthRaw(Entry.Value.ModrinthHash)("files")(0))
  1029. Next
  1030. Task.Progress = 0.4
  1031. #End Region
  1032. #Region "0.40-0.80:从 CurseForge 继续获取"
  1033. Dim CurseForgeHashes = Mods.Select(Function(m) m.Value.CurseForgeHash).ToList()
  1034. Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST",
  1035. $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
  1036. Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
  1037. Task.Progress = 0.7
  1038. For Each m In CurseForgeRaw
  1039. Dim hash As String = ""
  1040. For Each h In m("file")("hashes") '获取 Modrinth Hash
  1041. If h("algo").ToString = 1 Then
  1042. hash = h("value")
  1043. Exit For
  1044. End If
  1045. Next
  1046. If String.IsNullOrEmpty(hash) OrElse String.IsNullOrEmpty(m("file")("downloadUrl")) Then Continue For
  1047. m("file")("ModrinthHash") = hash
  1048. Dim f = Mods.ToArray()
  1049. For Each file In f
  1050. If file.Value.ModrinthHash = hash Then
  1051. CurseForgeMapping.Add(file.Key, m("file"))
  1052. Failed.Remove(file.Key)
  1053. Exit For
  1054. End If
  1055. Next
  1056. Next
  1057. Task.Progress = 0.8
  1058. #End Region
  1059. JumpMod:
  1060. #Region "0.80-0.90:合并下载链接,复制 Logo,写入 Json 文件"
  1061. '获取作为检查目标的加载器和版本
  1062. Dim ModLoaders = GetTargetModLoaders()
  1063. Dim McVersion = Version.Version.McName
  1064. Log($"[Export] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}")
  1065. '合并下载链接
  1066. Dim BothUrls As New Dictionary(Of String, String()) '两个下载源都有 URL 的 Mod
  1067. For Each modrinth In ModrinthMapping
  1068. Dim curseforge As New JObject
  1069. If CurseForgeMapping.TryGetValue(modrinth.Key, curseforge) Then
  1070. BothUrls.Add(modrinth.Key, {modrinth.Value("url"), curseforge("downloadUrl")})
  1071. End If
  1072. Next
  1073. Task.Progress = 0.83
  1074. Dim files As New JArray
  1075. For Each m In ModrinthMapping
  1076. files.Add(New JObject From {
  1077. {"path", $"mods/{m.Key}"},
  1078. {"hashes", m.Value("hashes")},
  1079. {"env", New JObject From {{"client", "required"}, {"server", "required"}}},
  1080. {"downloads", If(BothUrls.ContainsKey(m.Key), JArray.FromObject(BothUrls(m.Key)), New JArray From {m.Value("url")})},
  1081. {"fileSize", m.Value("size")}
  1082. })
  1083. Next
  1084. For Each m In CurseForgeMapping
  1085. If Not BothUrls.ContainsKey(m.Key) Then
  1086. files.Add(New JObject From {
  1087. {"path", $"mods/{m.Key}"},
  1088. {"hashes", New JObject From {{"sha1", m.Value("ModrinthHash").ToString}}},
  1089. {"env", New JObject From {{"client", "required"}, {"server", "required"}}},
  1090. {"downloads", New JArray From {m.Value("downloadUrl")}},
  1091. {"fileSize", m.Value("fileLength")}
  1092. })
  1093. End If
  1094. Next
  1095. Task.Progress = 0.86
  1096. 'If Not String.IsNullOrEmpty(Logo) Then
  1097. ' Dim LogoObj As New MyBitmap(Logo)
  1098. ' LogoObj.Save(tempDir & "Logo.png")
  1099. 'End If
  1100. 'Task.Progress = 0.88
  1101. Dim depend As New JObject From {{"minecraft", McVersion}}
  1102. If Version.Version.HasForge Then depend.Add("forge", Version.Version.ForgeVersion)
  1103. If Version.Version.HasFabric Then depend.Add("fabric-loader", Version.Version.FabricVersion)
  1104. If Version.Version.HasNeoForge Then depend.Add("neoforge", Version.Version.NeoForgeVersion)
  1105. Dim json As New JObject From {
  1106. {"game", "minecraft"},
  1107. {"formatVersion", 1},
  1108. {"versionId", VerID},
  1109. {"name", If(String.IsNullOrEmpty(Name), Version.Name, Name)},
  1110. {"summary", Description},
  1111. {"files", files},
  1112. {"dependencies", depend}
  1113. }
  1114. 'If Not String.IsNullOrEmpty(Logo) Then json.Add("logo", tempDir & "Logo.png")
  1115. File.WriteAllText(tempDir & "modrinth.index.json", json.ToString)
  1116. Task.Progress = 0.9
  1117. #End Region
  1118. #Region "0.90-0.99:将其余文件保存到 overrides 目录"
  1119. For Each m In Failed
  1120. CopyFile(m.Value.Path, tempDir & "overrides\mods\" & m.Value.FileName)
  1121. Next
  1122. Task.Progress = 0.92
  1123. '额外文件
  1124. For Each p In Additional
  1125. If String.IsNullOrWhiteSpace(p) Then Continue For '传空字串进去会直接把整个版本文件夹拷过去
  1126. If Not p.StartsWithF(GetPathFromFullPath(GetPathFromFullPath(Version.Path)), IgnoreCase:=True) Then Continue For
  1127. Dim relative As String = p.Replace(Version.Path, "").Replace(GetPathFromFullPath(GetPathFromFullPath(Version.Path)), "")
  1128. If File.Exists(p) AndAlso Not IsVerRedundant(p, Version.PathIndie) Then
  1129. CopyFile(p, $"{tempDir}overrides\{relative}")
  1130. End If
  1131. Next
  1132. Task.Progress = 0.96
  1133. '如果 resourcepacks shaderpacks 文件夹中有文件夹格式的包,则先将文件夹压缩成 Zip 文件后再打包入对应位置
  1134. '这可以避免安装时出现路径长度限制而出错
  1135. If Directory.Exists($"{tempDir}overrides\resourcepacks\") Then
  1136. For Each d In Directory.EnumerateDirectories($"{tempDir}overrides\resourcepacks\")
  1137. If Not File.Exists(d + ".zip") Then ZipFile.CreateFromDirectory(d, d + ".zip")
  1138. DeleteDirectory(d)
  1139. Next
  1140. End If
  1141. If Directory.Exists($"{tempDir}overrides\shaderpacks\") Then
  1142. For Each d In Directory.EnumerateDirectories($"{tempDir}overrides\shaderpacks\")
  1143. If Not File.Exists(d + ".zip") Then ZipFile.CreateFromDirectory(d, d + ".zip")
  1144. DeleteDirectory(d)
  1145. Next
  1146. End If
  1147. #End Region
  1148. If File.Exists(DestPath) Then File.Delete(DestPath) '选择文件的时候已经确认了要替换
  1149. ZipFile.CreateFromDirectory(tempDir, DestPath)
  1150. DeleteDirectory(tempDir)
  1151. Return True
  1152. Catch ex As Exception
  1153. Log(ex, "导出整合包失败", LogLevel.Msgbox)
  1154. Return False
  1155. End Try
  1156. End Function
  1157. Private Function ExportCompressed(Task As LoaderTask(Of ExportOptions, Boolean)) As Boolean
  1158. Try
  1159. Dim Version = Task.Input.Version
  1160. Dim DestPath = Task.Input.Dest
  1161. Dim Additional = Task.Input.Additional
  1162. Dim Name = Task.Input.Name
  1163. Dim VerID = Task.Input.VerID
  1164. Dim PCLSetupGlobal = Task.Input.PCLSetupGlobal
  1165. Log($"[Export] 导出整合包(含启动器):{Version.Path} -> {DestPath},额外版本文件 {Additional.Count} 个,全局设置 {If(PCLSetupGlobal, "导出", "不导出")}")
  1166. Dim tempDir As String = $"{ExpTempDir}{GetUuid()}\"
  1167. Log($"[Export] 最终压缩包的缓存文件夹:{tempDir}")
  1168. Directory.CreateDirectory(tempDir)
  1169. Task.Progress = 0.04
  1170. Log("[Export] 开始导出 Modrinth 整合包")
  1171. Task.Input.Dest = $"{tempDir}modpack.mrpack"
  1172. ExportModrinth(Task)
  1173. Log($"[Export] 正在复制 PCL 本体")
  1174. CopyFile(PathWithName, tempDir & GetFileNameFromPath(PathWithName))
  1175. If PCLSetupGlobal Then
  1176. Log($"[Export] 正在复制 PCL 全局配置")
  1177. CopyFile(Path & "PCL\Setup.ini", tempDir & "PCL\Setup.ini")
  1178. End If
  1179. If File.Exists(DestPath) Then File.Delete(DestPath) '选择文件的时候已经确认了要替换
  1180. ZipFile.CreateFromDirectory(tempDir, DestPath)
  1181. DeleteDirectory(tempDir)
  1182. Return True
  1183. Catch ex As Exception
  1184. Log(ex, "导出整合包失败", LogLevel.Msgbox)
  1185. Return False
  1186. End Try
  1187. End Function
  1188. #End Region
  1189. #End Region
  1190. End Module