ModModpack.vb 55 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902
  1. Imports System.IO.Compression
  2. Public Module ModModpack
  3. '触发整合包安装的外部接口
  4. ''' <summary>
  5. ''' 弹窗要求选择一个整合包文件并进行安装。
  6. ''' </summary>
  7. Public Sub ModpackInstall()
  8. Dim File As String = SelectFile("整合包文件(*.rar;*.zip;*.mrpack)|*.rar;*.zip;*.mrpack", "选择整合包压缩文件") '选择整合包文件
  9. If String.IsNullOrEmpty(File) Then Exit Sub
  10. RunInThread(
  11. Sub()
  12. Try
  13. ModpackInstall(File)
  14. Catch ex As CancelledException
  15. Catch ex As Exception
  16. Log(ex, "手动安装整合包失败", LogLevel.Msgbox)
  17. End Try
  18. End Sub)
  19. End Sub
  20. ''' <summary>
  21. ''' 构建并启动安装给定的整合包文件的加载器,并返回该加载器。若失败则抛出异常。
  22. ''' 必须在工作线程执行。
  23. ''' </summary>
  24. ''' <exception cref="CancelledException" />
  25. Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
  26. Log("[ModPack] 整合包安装请求:" & If(File, "null"))
  27. Dim Archive As ZipArchive = Nothing
  28. Dim ArchiveBaseFolder As String = ""
  29. Try
  30. '字符校验
  31. Dim TargetFolder As String = $"{PathMcFolder}versions\{VersionName}\"
  32. If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号:" & TargetFolder, HintType.Critical) : Throw New CancelledException
  33. '获取整合包种类与关键 Json
  34. Dim PackType As Integer = -1
  35. Try
  36. Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.Read))
  37. '从根目录判断整合包类型
  38. If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
  39. If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
  40. If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
  41. If Archive.GetEntry("manifest.json") IsNot Nothing Then
  42. Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
  43. If Json("addons") Is Nothing Then
  44. PackType = 0 : Exit Try 'CurseForge 整合包
  45. Else
  46. PackType = 3 : Exit Try 'MCBBS 整合包
  47. End If
  48. End If
  49. If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
  50. If Archive.GetEntry("modpack.zip") IsNot Nothing OrElse Archive.GetEntry("modpack.mrpack") IsNot Nothing Then PackType = 9 : Exit Try '带启动器的压缩包
  51. '从一级目录判断整合包类型
  52. For Each Entry In Archive.Entries
  53. Dim FullNames As String() = Entry.FullName.Split("/")
  54. ArchiveBaseFolder = FullNames(0) & "/"
  55. '确定为一级目录下
  56. If FullNames.Count <> 2 Then Continue For
  57. '判断是否为关键文件
  58. If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
  59. If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
  60. If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
  61. If FullNames(1) = "manifest.json" Then
  62. Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
  63. If Json("addons") Is Nothing Then
  64. PackType = 0 : Exit Try 'CurseForge 整合包
  65. Else
  66. PackType = 3 : ArchiveBaseFolder = "overrides/" : Exit Try 'MCBBS 整合包
  67. End If
  68. End If
  69. If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
  70. If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
  71. Next
  72. Catch ex As Exception
  73. If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
  74. Throw New Exception("打开整合包文件失败", ex)
  75. ElseIf File.EndsWithF(".rar", True) Then
  76. Throw New Exception("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", ex)
  77. Else
  78. Throw New Exception("打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", ex)
  79. End If
  80. End Try
  81. '执行对应的安装方法
  82. Select Case PackType
  83. Case 0
  84. Log("[ModPack] 整合包种类:CurseForge")
  85. Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
  86. Case 1
  87. Log("[ModPack] 整合包种类:HMCL")
  88. Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
  89. Case 2
  90. Log("[ModPack] 整合包种类:MMC")
  91. Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
  92. Case 3
  93. Log("[ModPack] 整合包种类:MCBBS")
  94. Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName)
  95. Case 4
  96. Log("[ModPack] 整合包种类:Modrinth")
  97. Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
  98. Case 9
  99. Log("[ModPack] 整合包种类:带启动器的压缩包")
  100. Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
  101. Case Else
  102. Log("[ModPack] 整合包种类:未能识别,假定为压缩包")
  103. Return InstallPackCompress(File, Archive)
  104. End Select
  105. Finally
  106. If Archive IsNot Nothing Then Archive.Dispose()
  107. End Try
  108. End Function
  109. Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, LoaderProgressDelta As Double)
  110. '解压文件
  111. Dim RetryCount As Integer = 1
  112. Dim Encode = Encoding.GetEncoding("GB18030")
  113. Try
  114. Retry:
  115. Loader.Progress = 0
  116. '完全不知道为啥会出现文件正在被另一进程使用的问题,总之多试试
  117. DeleteDirectory(InstallTemp)
  118. ExtractFile(FileAddress, InstallTemp, Encode, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * LoaderProgressDelta)
  119. Catch ex As Exception
  120. Log(ex, "第 " & RetryCount & " 次解压尝试失败")
  121. If TypeOf ex Is ArgumentException Then
  122. Encode = Encoding.UTF8
  123. Log("[ModPack] 已切换压缩包解压编码为 UTF8")
  124. End If
  125. If RetryCount < 5 Then
  126. Thread.Sleep(RetryCount * 2000)
  127. If Loader IsNot Nothing AndAlso Loader.LoadingState <> MyLoading.MyLoadingState.Run Then Exit Sub
  128. RetryCount += 1
  129. GoTo Retry
  130. Else
  131. Throw New Exception("解压整合包文件失败", ex)
  132. End If
  133. End Try
  134. End Sub
  135. #Region "不同类型整合包的安装方法"
  136. 'CurseForge
  137. Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
  138. Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
  139. '读取 Json 文件
  140. Dim Json As JObject
  141. Try
  142. Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
  143. Catch ex As Exception
  144. Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
  145. End Try
  146. If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息")
  147. '获取版本名
  148. If VersionName Is Nothing Then
  149. VersionName = If(Json("name"), "")
  150. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  151. If Validate.Validate(VersionName) <> "" Then VersionName = ""
  152. If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
  153. If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
  154. End If
  155. '获取 Mod API 版本信息
  156. Dim ForgeVersion As String = Nothing
  157. Dim NeoForgeVersion As String = Nothing
  158. Dim FabricVersion As String = Nothing
  159. For Each Entry In If(Json("minecraft")("modLoaders"), {})
  160. Dim Id As String = If(Entry("id"), "").ToString.ToLower
  161. If Id.StartsWithF("forge-") Then
  162. 'Forge 指定
  163. If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老,已不支持进行安装!")
  164. Log("[ModPack] 整合包 Forge 版本:" & Id)
  165. ForgeVersion = Id.Replace("forge-", "")
  166. ElseIf Id.StartsWithF("neoforge-") Then
  167. 'NeoForge 指定
  168. Log("[ModPack] 整合包 NeoForge 版本:" & Id)
  169. NeoForgeVersion = Id.Replace("neoforge-", "")
  170. ElseIf Id.StartsWithF("fabric-") Then
  171. 'Fabric 指定
  172. Log("[ModPack] 整合包 Fabric 版本:" & Id)
  173. FabricVersion = Id.Replace("fabric-", "")
  174. Else
  175. Log("[ModPack] 未知 Mod 加载器:" & Id)
  176. End If
  177. Next
  178. '解压与配置文件
  179. Dim InstallTemp As String = RequestTaskTempFolder()
  180. Dim InstallLoaders As New List(Of LoaderBase)
  181. Dim OverrideHome As String = If(Json("overrides"), "")
  182. If OverrideHome <> "" Then
  183. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  184. Sub(Task As LoaderTask(Of String, Integer))
  185. ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
  186. Task.Progress = 0.6
  187. '复制结果
  188. Log("[ModPack] 整合包 override 目标:" & OverrideHome)
  189. Dim OverrideRoot = InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome) '#5613
  190. If Directory.Exists(OverrideRoot) Then
  191. Dim CopyTarget = $"{PathMcFolder}versions\{VersionName}"
  192. CopyDirectory(OverrideRoot, CopyTarget, Sub(Delta) Task.Progress += Delta * 0.35)
  193. Log($"[ModPack] 整合包 override 复制:{OverrideRoot} -> {CopyTarget}")
  194. Else
  195. Log($"[ModPack] 整合包中未找到 override 文件夹:{OverrideRoot}")
  196. End If
  197. Task.Progress = 0.95
  198. '开启版本隔离
  199. WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
  200. WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
  201. End Sub) With {
  202. .ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  203. End If
  204. '获取 Mod 列表
  205. Dim ModList As New List(Of Integer)
  206. Dim ModOptionalList As New List(Of Integer)
  207. For Each ModEntry In If(Json("files"), {})
  208. If ModEntry("projectID") Is Nothing OrElse ModEntry("fileID") Is Nothing Then
  209. Hint("某项 Mod 缺少必要信息,已跳过:" & ModEntry.ToString)
  210. Continue For
  211. End If
  212. ModList.Add(ModEntry("fileID"))
  213. If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then ModOptionalList.Add(ModEntry("fileID"))
  214. Next
  215. If ModList.Any Then
  216. Dim ModDownloadLoaders As New List(Of LoaderBase)
  217. '获取 Mod 下载信息
  218. ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
  219. Sub(Task As LoaderTask(Of Integer, JArray))
  220. Task.Output = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
  221. '如果文件已被删除,则 API 会跳过那一项
  222. If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除,所以没法继续安装了,请向整合包作者反馈该问题")
  223. End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
  224. '构造 NetFile
  225. ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
  226. Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
  227. Dim FileList As New Dictionary(Of Integer, NetFile)
  228. For Each ModJson In Task.Input
  229. Dim Id As Integer = ModJson("id").ToObject(Of Integer)
  230. '跳过重复的 Mod(疑似 CurseForge Bug)
  231. If FileList.ContainsKey(Id) Then Continue For
  232. '可选 Mod 提示
  233. If ModOptionalList.Contains(Id) Then
  234. If MyMsgBox("是否要下载整合包中的可选文件 " & ModJson("displayName").ToString & "?",
  235. "下载可选文件", "是", "否") = 2 Then
  236. Continue For
  237. End If
  238. End If
  239. '建立 CompFile
  240. Dim File As New CompFile(ModJson, CompType.Mod)
  241. If Not File.Available Then Continue For
  242. '根据 modules 和文件名后缀判断资源类型
  243. Dim TargetFolder As String
  244. If ModJson("modules").Any Then 'modules 可能返回 null(#1006)
  245. Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
  246. If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
  247. File.FileName.EndsWithF(".jar", True) Then
  248. TargetFolder = "mods"
  249. ElseIf ModuleNames.Contains("pack.mcmeta") Then
  250. TargetFolder = "resourcepacks"
  251. Else
  252. TargetFolder = "shaderpacks"
  253. End If
  254. Else
  255. TargetFolder = "mods"
  256. End If
  257. '实际的添加
  258. FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{TargetFolder}\"))
  259. Task.Progress += 1 / (1 + ModList.Count)
  260. Next
  261. Task.Output = FileList.Values.ToList
  262. End Sub) With {.ProgressWeight = ModList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
  263. '下载 Mod 文件
  264. ModDownloadLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
  265. '构造加载器
  266. InstallLoaders.Add(New LoaderCombo(Of Integer)("下载 Mod(主加载器)", ModDownloadLoaders) With
  267. {.Show = False, .ProgressWeight = ModDownloadLoaders.Sum(Function(l) l.ProgressWeight)})
  268. End If
  269. '构造加载器
  270. Dim Request As New McInstallRequest With {
  271. .TargetVersionName = VersionName,
  272. .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
  273. .MinecraftName = Json("minecraft")("version").ToString,
  274. .ForgeVersion = ForgeVersion,
  275. .NeoForgeVersion = NeoForgeVersion,
  276. .FabricVersion = FabricVersion
  277. }
  278. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  279. '构造 Libraries 加载器
  280. Dim LoadersLib As New List(Of LoaderBase)
  281. 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})
  282. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  283. '构造总加载器
  284. Dim Loaders As New List(Of LoaderBase)
  285. Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
  286. Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
  287. Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
  288. Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
  289. Sub(Task As LoaderTask(Of String, String))
  290. '设置图标
  291. Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\"
  292. If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
  293. File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
  294. WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
  295. WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
  296. Log("[ModPack] 已设置整合包 Logo:" & Logo)
  297. End If
  298. '删除原始整合包文件
  299. For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
  300. If File.Exists(Target) Then
  301. Log("[ModPack] 删除原始整合包文件:" & Target)
  302. File.Delete(Target)
  303. End If
  304. Next
  305. If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
  306. Log("[ModPack] 删除安装整合包文件:" & FileAddress)
  307. File.Delete(FileAddress)
  308. End If
  309. End Sub) With {.ProgressWeight = 0.1, .Show = False})
  310. '重复任务检查
  311. Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
  312. If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
  313. Hint("该整合包正在安装中!", HintType.Critical)
  314. Throw New CancelledException
  315. End If
  316. '启动
  317. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  318. Loader.Start(Request.TargetVersionFolder)
  319. LoaderTaskbarAdd(Loader)
  320. FrmMain.BtnExtraDownload.ShowRefresh()
  321. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
  322. Return Loader
  323. End Function
  324. 'Modrinth
  325. 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)
  326. '读取 Json 文件
  327. Dim Json As JObject
  328. Try
  329. Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open))
  330. Catch ex As Exception
  331. Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
  332. End Try
  333. If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息")
  334. '获取 Mod API 版本信息
  335. Dim MinecraftVersion As String = Nothing
  336. Dim ForgeVersion As String = Nothing
  337. Dim NeoForgeVersion As String = Nothing
  338. Dim FabricVersion As String = Nothing
  339. For Each Entry As JProperty In If(Json("dependencies"), {})
  340. Select Case Entry.Name.ToLower
  341. Case "minecraft"
  342. MinecraftVersion = Entry.Value.ToString
  343. Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
  344. ForgeVersion = Entry.Value.ToString
  345. Log("[ModPack] 整合包 Forge 版本:" & ForgeVersion)
  346. Case "neoforge", "neo-forge" 'eg. 20.6.98-beta
  347. NeoForgeVersion = Entry.Value.ToString
  348. Log("[ModPack] 整合包 NeoForge 版本:" & NeoForgeVersion)
  349. Case "fabric-loader" 'eg. 0.14.14
  350. FabricVersion = Entry.Value.ToString
  351. Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
  352. Case "quilt-loader" 'eg. 1.0.0
  353. Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
  354. Throw New CancelledException
  355. Case Else
  356. Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical)
  357. Throw New CancelledException
  358. End Select
  359. Next
  360. '获取版本名
  361. If VersionName Is Nothing Then
  362. VersionName = If(Json("name"), "")
  363. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  364. If Validate.Validate(VersionName) <> "" Then VersionName = ""
  365. If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
  366. If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
  367. End If
  368. '解压和配置文件
  369. Dim InstallTemp As String = RequestTaskTempFolder()
  370. Dim InstallLoaders As New List(Of LoaderBase)
  371. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  372. Sub(Task As LoaderTask(Of String, Integer))
  373. ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
  374. Task.Progress = 0.6
  375. '复制 overrides 文件夹和 client-overrides 文件夹
  376. If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
  377. CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
  378. Sub(Delta) Task.Progress += Delta * 0.25)
  379. Else
  380. Log("[ModPack] 整合包中未找到 override 目录,已跳过")
  381. End If
  382. Task.Progress = 0.85
  383. If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
  384. CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName,
  385. Sub(Delta) Task.Progress += Delta * 0.1)
  386. End If
  387. Task.Progress = 0.95
  388. '开启版本隔离
  389. WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
  390. WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
  391. End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  392. '获取下载文件列表
  393. Dim FileList As New List(Of NetFile)
  394. For Each File In If(Json("files"), {})
  395. '检查是否需要该文件
  396. If File("env") IsNot Nothing Then
  397. Select Case File("env")("client").ToString
  398. Case "optional"
  399. If MyMsgBox("是否要下载可选文件 " & GetFileNameFromPath(File("path").ToString) & "?",
  400. "下载可选文件", "是", "否") = 2 Then
  401. Continue For
  402. End If
  403. Case "unsupported"
  404. Continue For
  405. End Select
  406. End If
  407. '添加下载文件
  408. Dim Urls = File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToList
  409. Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
  410. Urls = Urls.Distinct.ToList()
  411. FileList.Add(New NetFile(Urls, PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
  412. New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
  413. Next
  414. If FileList.Any Then
  415. InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
  416. End If
  417. '构造加载器
  418. Dim Request As New McInstallRequest With {
  419. .TargetVersionName = VersionName,
  420. .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
  421. .MinecraftName = MinecraftVersion,
  422. .ForgeVersion = ForgeVersion,
  423. .NeoForgeVersion = NeoForgeVersion,
  424. .FabricVersion = FabricVersion
  425. }
  426. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  427. '构造 Libraries 加载器
  428. Dim LoadersLib As New List(Of LoaderBase)
  429. 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})
  430. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  431. '构造总加载器
  432. Dim Loaders As New List(Of LoaderBase)
  433. Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
  434. Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
  435. Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
  436. Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
  437. Sub(Task As LoaderTask(Of String, String))
  438. '设置图标
  439. Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
  440. If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
  441. File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
  442. WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
  443. WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
  444. Log("[ModPack] 已设置整合包 Logo:" & Logo)
  445. End If
  446. '删除原始整合包文件
  447. For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
  448. If File.Exists(Target) Then
  449. Log("[ModPack] 删除原始整合包文件:" & Target)
  450. File.Delete(Target)
  451. End If
  452. Next
  453. If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
  454. Log("[ModPack] 删除安装整合包文件:" & FileAddress)
  455. File.Delete(FileAddress)
  456. End If
  457. End Sub) With {.ProgressWeight = 0.1, .Show = False})
  458. '重复任务检查
  459. Dim LoaderName As String = $"Modrinth 整合包安装:{VersionName} "
  460. If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
  461. Hint("该整合包正在安装中!", HintType.Critical)
  462. Throw New CancelledException
  463. End If
  464. '启动
  465. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  466. Loader.Start(Request.TargetVersionFolder)
  467. LoaderTaskbarAdd(Loader)
  468. FrmMain.BtnExtraDownload.ShowRefresh()
  469. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
  470. Return Loader
  471. End Function
  472. 'HMCL
  473. Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
  474. '读取 Json 文件
  475. Dim Json As JObject
  476. Try
  477. Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
  478. Catch ex As Exception
  479. Throw New Exception("HMCL 整合包安装信息存在问题", ex)
  480. End Try
  481. '获取版本名
  482. Dim VersionName As String = If(Json("name"), "")
  483. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  484. If Validate.Validate(VersionName) <> "" Then VersionName = ""
  485. If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
  486. If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
  487. '解压与配置文件
  488. Dim InstallTemp As String = RequestTaskTempFolder()
  489. Dim InstallLoaders As New List(Of LoaderBase)
  490. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  491. Sub(Task As LoaderTask(Of String, Integer))
  492. ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
  493. Task.Progress = 0.6
  494. '复制结果
  495. If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
  496. CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
  497. Else
  498. Log("[ModPack] 整合包中未找到 minecraft override 目录,已跳过")
  499. End If
  500. Task.Progress = 0.95
  501. '开启版本隔离
  502. WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
  503. WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
  504. End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  505. '构造加载器
  506. If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息,无法安装!")
  507. Dim Request As New McInstallRequest With {
  508. .TargetVersionName = VersionName,
  509. .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
  510. .MinecraftName = Json("gameVersion").ToString
  511. }
  512. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  513. '构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
  514. Dim LoadersLib As New List(Of LoaderBase)
  515. LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)",
  516. Sub()
  517. Dim RealFileName As String = PathMcFolder & "versions\" & VersionName & "\" & VersionName & ".json"
  518. Dim OldFileName As String = PathMcFolder & "versions\" & VersionName & "\pack.json"
  519. If File.Exists(OldFileName) Then
  520. '修改 id
  521. Dim FileJson = GetJson(ReadFile(OldFileName))
  522. FileJson("id") = VersionName
  523. '替换文件
  524. File.Delete(OldFileName)
  525. WriteFile(RealFileName, FileJson.ToString)
  526. Log("[ModPack] 已重命名版本 Json:" & RealFileName)
  527. End If
  528. End Sub) With {.ProgressWeight = 0.1, .Show = False})
  529. 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})
  530. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  531. '构造总加载器
  532. Dim Loaders As New List(Of LoaderBase) From {
  533. New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)},
  534. New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)},
  535. New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}
  536. }
  537. '重复任务检查
  538. Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " "
  539. If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
  540. Hint("该整合包正在安装中!", HintType.Critical)
  541. Throw New CancelledException
  542. End If
  543. '启动
  544. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  545. 'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
  546. Loader.Start(Request.TargetVersionFolder)
  547. LoaderTaskbarAdd(Loader)
  548. FrmMain.BtnExtraDownload.ShowRefresh()
  549. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
  550. Return Loader
  551. End Function
  552. 'MMC
  553. Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
  554. '读取 Json 文件
  555. Dim PackJson As JObject, PackInstance As String
  556. Try
  557. PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8))
  558. PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
  559. Catch ex As Exception
  560. Throw New Exception("MMC 整合包安装信息存在问题", ex)
  561. End Try
  562. '获取版本名
  563. Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
  564. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  565. If Validate.Validate(VersionName) <> "" Then VersionName = ""
  566. If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
  567. If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
  568. '解压、配置设置文件
  569. Dim InstallTemp As String = RequestTaskTempFolder()
  570. Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
  571. Dim InstallLoaders As New List(Of LoaderBase)
  572. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  573. Sub(Task As LoaderTask(Of String, Integer))
  574. ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
  575. Task.Progress = 0.6
  576. '复制结果
  577. If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
  578. CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
  579. Else
  580. Log("[ModPack] 整合包中未找到 override .minecraft 目录,已跳过")
  581. End If
  582. Task.Progress = 0.95
  583. '开启版本隔离
  584. WriteIni(SetupFile, "VersionArgumentIndie", 1)
  585. WriteIni(SetupFile, "VersionArgumentIndieV2", True)
  586. '读取 MMC 设置文件(#2655)
  587. Try
  588. Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
  589. If File.Exists(MMCSetupFile) Then
  590. '将其中的等号替换为冒号,以符合 ini 文件格式
  591. Dim Lines As New List(Of String)
  592. For Each Line In ReadFile(MMCSetupFile).Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
  593. If Not Line.Contains("=") Then Continue For
  594. Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
  595. Next
  596. WriteFile(MMCSetupFile, Join(Lines, vbCrLf))
  597. '读取文件
  598. If ReadIni(MMCSetupFile, "OverrideCommands", False) Then
  599. Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand")
  600. If PreLaunchCommand <> "" Then
  601. PreLaunchCommand = PreLaunchCommand.Replace("\""", """").
  602. Replace("$INST_JAVA", "{java}javaw.exe").
  603. Replace("$INST_MC_DIR\", "{minecraft}").Replace("$INST_MC_DIR", "{minecraft}").
  604. Replace("$INST_DIR\", "{verpath}").Replace("$INST_DIR", "{verpath}").
  605. Replace("$INST_ID", "{name}").Replace("$INST_NAME", "{name}")
  606. WriteIni(SetupFile, "VersionAdvanceRun", PreLaunchCommand)
  607. Log("[ModPack] 迁移 MultiMC 版本独立设置:启动前执行命令:" & PreLaunchCommand)
  608. End If
  609. End If
  610. If ReadIni(MMCSetupFile, "JoinServerOnLaunch", False) Then
  611. Dim ServerAddress As String = ReadIni(MMCSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """")
  612. WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
  613. Log("[ModPack] 迁移 MultiMC 版本独立设置:自动进入服务器:" & ServerAddress)
  614. End If
  615. If ReadIni(MMCSetupFile, "IgnoreJavaCompatibility", False) Then
  616. WriteIni(SetupFile, "VersionAdvanceJava", True)
  617. Log("[ModPack] 迁移 MultiMC 版本独立设置:忽略 Java 兼容性警告")
  618. End If
  619. Dim Logo As String = ReadIni(MMCSetupFile, "iconKey", "")
  620. If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
  621. WriteIni(SetupFile, "LogoCustom", True)
  622. WriteIni(SetupFile, "Logo", "PCL\Logo.png")
  623. CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{PathMcFolder}versions\{VersionName}\PCL\Logo.png")
  624. Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)")
  625. End If
  626. 'JVM 参数
  627. Dim JvmArgs As String = ReadIni(MMCSetupFile, "JvmArgs", "")
  628. If JvmArgs <> "" Then
  629. If ReadIni(MMCSetupFile, "OverrideJavaArgs", False) Then
  630. WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
  631. Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(覆盖):" & JvmArgs)
  632. Else
  633. JvmArgs += " " & Setup.Get("LaunchAdvanceJvm")
  634. WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
  635. Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(追加):" & JvmArgs)
  636. End If
  637. End If
  638. End If
  639. Catch ex As Exception
  640. Log(ex, $"读取 MMC 配置文件失败({InstallTemp}{ArchiveBaseFolder}instance.cfg)")
  641. End Try
  642. End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  643. '构造版本安装请求
  644. If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息,无法安装!")
  645. Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
  646. For Each Component In PackJson("components")
  647. Select Case If(Component("uid"), "").ToString
  648. Case "org.lwjgl"
  649. Log("[ModPack] 已跳过 LWJGL 项")
  650. Case "net.minecraft"
  651. Request.MinecraftName = Component("version")
  652. Case "net.minecraftforge"
  653. Request.ForgeVersion = Component("version")
  654. Case "net.neoforged"
  655. Request.NeoForgeVersion = Component("version")
  656. Case "net.fabricmc.fabric-loader"
  657. Request.FabricVersion = Component("version")
  658. Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
  659. Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
  660. Throw New CancelledException
  661. End Select
  662. Next
  663. '构造加载器
  664. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  665. '构造 Libraries 加载器
  666. Dim LoadersLib As New List(Of LoaderBase)
  667. 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})
  668. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  669. '构造总加载器
  670. Dim Loaders As New List(Of LoaderBase)
  671. Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
  672. Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
  673. Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
  674. '重复任务检查
  675. Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " "
  676. If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
  677. Hint("该整合包正在安装中!", HintType.Critical)
  678. Throw New CancelledException
  679. End If
  680. '启动
  681. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  682. Loader.Start(Request.TargetVersionFolder)
  683. LoaderTaskbarAdd(Loader)
  684. FrmMain.BtnExtraDownload.ShowRefresh()
  685. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
  686. Return Loader
  687. End Function
  688. 'MCBBS
  689. Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
  690. Optional VersionName As String = Nothing) As LoaderCombo(Of String)
  691. '读取 Json 文件
  692. Dim Json As JObject
  693. Try
  694. Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
  695. Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
  696. Catch ex As Exception
  697. Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
  698. End Try
  699. '获取版本名
  700. If VersionName Is Nothing Then
  701. VersionName = If(Json("name"), "")
  702. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  703. If Validate.Validate(VersionName) <> "" Then VersionName = ""
  704. If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
  705. If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
  706. End If
  707. '解压与配置文件
  708. Dim InstallTemp As String = RequestTaskTempFolder()
  709. Dim InstallLoaders As New List(Of LoaderBase)
  710. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  711. Sub(Task As LoaderTask(Of String, Integer))
  712. ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
  713. Task.Progress = 0.6
  714. '复制结果
  715. If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
  716. CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
  717. Sub(Delta) Task.Progress += 0.35 * Delta)
  718. Else
  719. Log("[ModPack] 整合包中未找到 overrides 目录,已跳过")
  720. End If
  721. Task.Progress = 0.95
  722. '开启版本隔离
  723. WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
  724. WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
  725. End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  726. '构造加载器
  727. If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息,无法安装!")
  728. Dim Addons As New Dictionary(Of String, String)
  729. For Each Entry In Json("addons")
  730. Addons.Add(Entry("id"), Entry("version"))
  731. Next
  732. If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息,无法安装!")
  733. If Addons.ContainsKey("quilt") Then
  734. Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
  735. Throw New CancelledException
  736. End If
  737. Dim Request As New McInstallRequest With {
  738. .TargetVersionName = VersionName,
  739. .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
  740. .MinecraftName = Addons("game"),
  741. .OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
  742. .ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
  743. .NeoForgeVersion = If(Addons.ContainsKey("neoforge"), Addons("neoforge"), Nothing),
  744. .FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
  745. }
  746. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  747. '构造 Libraries 加载器
  748. Dim LoadersLib As New List(Of LoaderBase)
  749. 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})
  750. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  751. '构造总加载器
  752. Dim Loaders As New List(Of LoaderBase)
  753. Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
  754. Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
  755. Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
  756. '重复任务检查
  757. Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " "
  758. If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
  759. Hint("该整合包正在安装中!", HintType.Critical)
  760. Throw New CancelledException
  761. End If
  762. '启动
  763. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  764. 'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
  765. Loader.Start(Request.TargetVersionFolder)
  766. LoaderTaskbarAdd(Loader)
  767. FrmMain.BtnExtraDownload.ShowRefresh()
  768. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
  769. Return Loader
  770. End Function
  771. '带启动器的压缩包
  772. Private Function InstallPackLauncherPack(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
  773. '获取解压路径
  774. MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
  775. Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
  776. If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
  777. If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
  778. '解压
  779. Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
  780. New LoaderTask(Of String, Integer)("解压压缩包",
  781. Sub(Task As LoaderTask(Of String, Integer))
  782. ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.9)
  783. Thread.Sleep(400) '避免文件争用
  784. '查找解压后的 exe 文件
  785. Dim Launcher As String = Nothing
  786. For Each ExeFile In Directory.GetFiles(TargetFolder, "*.exe", SearchOption.TopDirectoryOnly)
  787. Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
  788. Log($"[Modpack] 文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
  789. If Info.ProductName = "Plain Craft Launcher" Then
  790. Launcher = ExeFile
  791. Log($"[Modpack] 发现整合包附带的 PCL 启动器:{ExeFile}")
  792. ElseIf (Info.ProductName.ContainsF("Launcher", True) OrElse Info.ProductName.ContainsF("启动", True)) AndAlso
  793. Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then
  794. If Launcher Is Nothing Then
  795. Launcher = ExeFile
  796. Log($"[Modpack] 发现整合包附带的疑似第三方启动器:{ExeFile}")
  797. End If
  798. End If
  799. Next
  800. Task.Progress = 0.95
  801. '尝试使用附带的启动器打开
  802. If Launcher IsNot Nothing Then
  803. Log("[Modpack] 找到压缩包中附带的启动器:" & Launcher)
  804. If MyMsgBox($"整合包里似乎自带了启动器,是否换用它继续安装?{vbCrLf}即将打开:{Launcher}", "换用整合包启动器?", "换用", "不换用") = 1 Then
  805. OpenExplorer(TargetFolder)
  806. ShellOnly(Launcher, "--wait") '要求等待已有的 PCL 退出
  807. Log("[Modpack] 为换用整合包中的启动器启动,强制结束程序")
  808. FrmMain.EndProgram(False)
  809. Return
  810. End If
  811. Else
  812. Log("[Modpack] 未找到压缩包中附带的启动器")
  813. End If
  814. OpenExplorer(TargetFolder)
  815. '加入文件夹列表
  816. Dim VersionName As String = GetFolderNameFromPath(TargetFolder)
  817. Directory.CreateDirectory(TargetFolder & ".minecraft\")
  818. PageSelectLeft.AddFolder(
  819. TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
  820. VersionName, False)
  821. '调用 modpack 文件进行安装
  822. Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
  823. Log("[Modpack] 调用 modpack 文件继续安装:" & ModpackFile)
  824. ModpackInstall(ModpackFile)
  825. End Sub)
  826. })
  827. Loader.Start(TargetFolder)
  828. LoaderTaskbarAdd(Loader)
  829. FrmMain.BtnExtraDownload.ShowRefresh()
  830. FrmMain.BtnExtraDownload.Ribble()
  831. Return Loader
  832. End Function
  833. '普通压缩包
  834. Private Function InstallPackCompress(FileAddress As String, Archive As Compression.ZipArchive) As LoaderCombo(Of String)
  835. '尝试定位 .minecraft 文件夹:寻找形如 “/versions/XXX/XXX.json” 的路径
  836. Dim Match As RegularExpressions.Match = Nothing
  837. Dim Regex As New RegularExpressions.Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegularExpressions.RegexOptions.IgnoreCase)
  838. For Each Entry In Archive.Entries
  839. Dim EntryMatch = Regex.Match("/" & Entry.FullName)
  840. If EntryMatch.Success Then
  841. Match = EntryMatch
  842. Exit For
  843. End If
  844. Next
  845. If Match Is Nothing Then Throw New Exception("未能找到适合的文件结构,这可能不是一个 MC 压缩包") '没有匹配
  846. Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
  847. Dim VersionName As String = Match.Groups(1).Value
  848. Log("[ModPack] 检测到压缩包的 .minecraft 根目录:" & ArchiveBaseFolder & ",命中的版本名:" & VersionName)
  849. '获取解压路径
  850. MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
  851. Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
  852. If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
  853. If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Throw New CancelledException
  854. If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
  855. '解压
  856. Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
  857. New LoaderTask(Of String, Integer)("解压压缩包",
  858. Sub(Task As LoaderTask(Of String, Integer))
  859. ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.95)
  860. '加入文件夹列表
  861. PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
  862. Thread.Sleep(400) '避免文件争用
  863. RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.VersionSelect))
  864. End Sub)
  865. }) With {.OnStateChanged = AddressOf McInstallState}
  866. Loader.Start(TargetFolder)
  867. LoaderTaskbarAdd(Loader)
  868. FrmMain.BtnExtraDownload.ShowRefresh()
  869. FrmMain.BtnExtraDownload.Ribble()
  870. Return Loader
  871. End Function
  872. #End Region
  873. End Module