ModModpack.vb 54 KB

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