1
0

ModModpack.vb 50 KB

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