ModModpack.vb 53 KB

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