ModModpack.vb 51 KB

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