1
0

ModModpack.vb 55 KB

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