ModModpack.vb 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629
  1. Public Module ModModpack
  2. '触发整合包安装的外部接口
  3. ''' <summary>
  4. ''' 弹窗要求选择一个整合包文件并进行安装。
  5. ''' </summary>
  6. Public Sub ModpackInstall()
  7. Dim File As String = SelectFile("压缩包文件(*.rar;*.zip)|*.rar;*.zip", "选择整合包压缩文件") '选择整合包文件
  8. If String.IsNullOrEmpty(File) Then Exit Sub
  9. RunInThread(Sub() ModpackInstall(File))
  10. End Sub
  11. ''' <summary>
  12. ''' 安装一个给定的整合包文件,返回是否安装成功。必须在工作线程执行。
  13. ''' </summary>
  14. Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True) As Boolean
  15. Log("[ModPack] 整合包安装请求:" & If(File, "null"))
  16. Dim Archive As Compression.ZipArchive = Nothing
  17. Dim ArchiveBaseFolder As String = ""
  18. Try
  19. '获取整合包种类与关键 Json
  20. Dim PackType As Integer = -1
  21. Try
  22. Archive = New Compression.ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
  23. '从根目录判断整合包类型
  24. If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
  25. If Archive.GetEntry("manifest.json") IsNot Nothing Then
  26. Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
  27. If Json("addons") Is Nothing Then
  28. PackType = 0 : Exit Try 'CurseForge 整合包
  29. Else
  30. PackType = 3 : Exit Try 'MCBBS 整合包
  31. End If
  32. End If
  33. If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
  34. If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包
  35. '从一级目录判断整合包类型
  36. For Each Entry In Archive.Entries
  37. Dim FullNames As String() = Entry.FullName.Split("/")
  38. ArchiveBaseFolder = FullNames(0) & "/"
  39. If Entry.FullName.EndsWith("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包
  40. '确定为一级目录下
  41. If FullNames.Count <> 2 Then Continue For
  42. '判断是否为关键文件
  43. If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
  44. If FullNames(1) = "manifest.json" Then
  45. Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
  46. If Json("addons") Is Nothing Then
  47. PackType = 0 : Exit Try 'CurseForge 整合包
  48. Else
  49. PackType = 3 : ArchiveBaseFolder = "overrides/" : Exit Try 'MCBBS 整合包
  50. End If
  51. End If
  52. If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
  53. If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
  54. Next
  55. Catch ex As Exception
  56. If GetString(ex, False, True).Contains("Error.WinIOError") Then
  57. Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
  58. Return False
  59. ElseIf File.ToLower.EndsWith(".rar") Then
  60. Log(ex, "PCL2 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
  61. Return False
  62. Else
  63. Log(ex, "打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
  64. Return False
  65. End If
  66. End Try
  67. '执行对应的安装方法
  68. Select Case PackType
  69. Case 0
  70. Log("[ModPack] 整合包种类:CurseForge")
  71. InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName)
  72. Case 1
  73. Log("[ModPack] 整合包种类:HMCL")
  74. InstallPackHMCL(File, Archive, ArchiveBaseFolder)
  75. Case 2
  76. Log("[ModPack] 整合包种类:MMC")
  77. InstallPackMMC(File, Archive, ArchiveBaseFolder)
  78. Case 3
  79. Log("[ModPack] 整合包种类:MCBBS")
  80. InstallPackMCBBS(File, Archive, ArchiveBaseFolder)
  81. Case 9
  82. Log("[ModPack] 整合包种类:压缩包")
  83. Archive.Dispose()
  84. Archive = Nothing
  85. InstallPackCompress(File, ArchiveBaseFolder)
  86. Case Else
  87. If ShowHint Then
  88. Hint("未能识别该整合包的种类,无法安装!", HintType.Critical)
  89. Else
  90. Log("[ModPack] 未能识别该整合包的种类,无法安装!")
  91. End If
  92. Return False
  93. End Select
  94. Return True
  95. Catch ex As Exception
  96. Log(ex, "准备安装整合包失败", LogLevel.Feedback)
  97. Return False
  98. Finally
  99. If Archive IsNot Nothing Then Archive.Dispose()
  100. End Try
  101. End Function
  102. '整合包缓存清理
  103. Private IsInstallCacheCleared As Boolean = False
  104. Private IsInstallCacheClearing As Boolean = False
  105. Private Sub UnpackFiles(InstallTemp As String, FileAddress As String)
  106. '清理缓存文件夹
  107. If Not IsInstallCacheCleared Then
  108. IsInstallCacheCleared = True
  109. IsInstallCacheClearing = True
  110. Try
  111. Log("[ModPack] 开始清理整合包安装缓存")
  112. DeleteDirectory(PathTemp & "PackInstall\")
  113. Log("[ModPack] 已清理整合包安装缓存")
  114. Catch ex As Exception
  115. Log(ex, "清理整合包安装缓存失败")
  116. Finally
  117. IsInstallCacheClearing = False
  118. End Try
  119. ElseIf IsInstallCacheClearing Then
  120. '等待另一个整合包安装的清理步骤完成
  121. Do While IsInstallCacheClearing
  122. Thread.Sleep(1)
  123. Loop
  124. End If
  125. '解压文件
  126. Dim RetryCount As Integer = 1
  127. Dim Encode = Encoding.GetEncoding("GB18030")
  128. Try
  129. Retry:
  130. '完全不知道为啥会出现文件正在被另一进程使用的问题,总之多试试
  131. Directory.CreateDirectory(InstallTemp)
  132. DeleteDirectory(InstallTemp)
  133. Compression.ZipFile.ExtractToDirectory(FileAddress, InstallTemp, Encode)
  134. Catch ex As Exception
  135. Log(ex, "第 " & RetryCount & " 次解压尝试失败")
  136. If TypeOf ex Is ArgumentException Then
  137. Encode = Encoding.UTF8
  138. Log("[ModPack] 已切换压缩包解压编码为 UTF8")
  139. End If
  140. If RetryCount < 5 Then
  141. Thread.Sleep(RetryCount * 2000)
  142. RetryCount += 1
  143. GoTo Retry
  144. Else
  145. Throw
  146. End If
  147. End Try
  148. End Sub
  149. #Region "不同类型整合包的安装方法"
  150. 'CurseForge
  151. ''' <summary>
  152. ''' 获取安装 CurseForge 整合包的加载器,若失败或跳过则返回 Nothing。
  153. ''' 加载器以安装目标版本文件夹为输入。
  154. ''' </summary>
  155. Private Function InstallPackCurseForgeLoader(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, VersionName As String) As LoaderCombo(Of String)
  156. '读取 Json 文件
  157. Dim Json As JObject
  158. Try
  159. Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
  160. If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
  161. Catch ex As Exception
  162. Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
  163. Return Nothing
  164. End Try
  165. '获取 Mod API 版本信息
  166. Dim ForgeVersion As String = Nothing
  167. Dim FabricVersion As String = Nothing
  168. For Each Entry In If(Json("minecraft")("modLoaders"), {})
  169. Dim Id As String = If(Entry("id"), "").ToString.ToLower
  170. If Id.StartsWith("forge-") Then
  171. 'Forge 指定
  172. If Id.Contains("recommended") Then
  173. Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint)
  174. Return Nothing
  175. End If
  176. Try
  177. Log("[ModPack] 整合包 Forge 版本:" & Id)
  178. ForgeVersion = Id.Split("-")(1)
  179. Exit For
  180. Catch ex As Exception
  181. Log(ex, "读取整合包 Forge 版本失败:" & Id)
  182. End Try
  183. ElseIf Id.StartsWith("fabric-") Then
  184. 'Fabric 指定
  185. Try
  186. Log("[ModPack] 整合包 Fabric 版本:" & Id)
  187. FabricVersion = Id.Split("-")(1)
  188. Exit For
  189. Catch ex As Exception
  190. Log(ex, "读取整合包 Fabric 版本失败:" & Id)
  191. End Try
  192. End If
  193. Next
  194. '解压与配置文件
  195. Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
  196. Dim InstallLoaders As New List(Of LoaderBase)
  197. Dim OverrideHome As String = If(Json("overrides"), "")
  198. If OverrideHome <> "" Then
  199. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  200. Sub(Task As LoaderTask(Of String, Integer))
  201. UnpackFiles(InstallTemp, FileAddress)
  202. Task.Progress = 0.5
  203. '复制结果
  204. If Directory.Exists(InstallTemp & ArchiveBaseFolder & OverrideHome) Then
  205. My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & OverrideHome, PathMcFolder & "versions\" & VersionName)
  206. Else
  207. Log("[ModPack] 整合包中未找到 override 目录,已跳过")
  208. End If
  209. Task.Progress = 0.9
  210. '开启版本隔离
  211. WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
  212. End Sub) With {
  213. .ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  214. End If
  215. '获取 Mod 列表
  216. Dim ModFileList As New List(Of Integer)
  217. For Each ModEntry In If(Json("files"), {})
  218. If ModEntry("projectID") Is Nothing OrElse ModEntry("fileID") Is Nothing Then
  219. Hint("某项 Mod 缺少必要信息,已跳过:" & ModEntry.ToString)
  220. Continue For
  221. End If
  222. If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then Continue For
  223. ModFileList.Add(ModEntry("fileID"))
  224. Next
  225. If ModFileList.Count > 0 Then
  226. '获取 Mod 下载信息
  227. InstallLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
  228. Sub(Task As LoaderTask(Of Integer, JArray))
  229. Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModFileList, ",") & "]}", "application/json"))("data")
  230. '如果文件已被删除,则 API 会跳过那一项
  231. If ModFileList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除,因此无法完成整合包安装,请联系整合包作者更新整合包中的 Mod 版本")
  232. End Sub) With {.ProgressWeight = ModFileList.Count / 10}) '每 10 Mod 需要 1s
  233. '构造 NetFile
  234. InstallLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
  235. Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
  236. Dim FileList As New Dictionary(Of Integer, NetFile)
  237. For Each ModJson In Task.Input
  238. '跳过重复的 Mod(疑似 CurseForge Bug)
  239. If FileList.ContainsKey(ModJson("id").ToObject(Of Integer)) Then Continue For
  240. '实际的添加
  241. FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(PathMcFolder & "versions\" & VersionName & "\mods\", False))
  242. Task.Progress += 1 / (1 + ModFileList.Count)
  243. Next
  244. Task.Output = FileList.Values.ToList
  245. End Sub) With {.ProgressWeight = ModFileList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
  246. '下载 Mod 文件
  247. InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModFileList.Count * 1.5}) '每个 Mod 需要 1.5s
  248. End If
  249. '构造加载器
  250. Dim Request As New McInstallRequest With {
  251. .TargetVersionName = VersionName,
  252. .MinecraftName = Json("minecraft")("version").ToString,
  253. .ForgeVersion = ForgeVersion,
  254. .FabricVersion = FabricVersion
  255. }
  256. Dim InstallExpectTime As Double = 0
  257. For Each InstallLoader In InstallLoaders
  258. InstallExpectTime += InstallLoader.ProgressWeight
  259. Next
  260. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  261. If MergeLoaders Is Nothing Then Return Nothing
  262. Dim MergeExpectTime As Double = 0
  263. For Each MergeLoader In MergeLoaders
  264. MergeExpectTime += MergeLoader.ProgressWeight
  265. Next
  266. '构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
  267. Dim LoadersLib As New List(Of LoaderBase)
  268. 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})
  269. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  270. '构造总加载器
  271. Dim Loaders As New List(Of LoaderBase)
  272. Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime})
  273. Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime})
  274. Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
  275. Loaders.Add(New LoaderTask(Of String, String)("清理安装文件",
  276. Sub(Task As LoaderTask(Of String, String))
  277. Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip"
  278. If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
  279. Log("[Download] 根据设置要求删除原始整合包文件:" & Target)
  280. File.Delete(Target)
  281. End If
  282. End Sub) With {.ProgressWeight = 0.1, .Show = False})
  283. '重复任务检查
  284. Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
  285. SyncLock LoaderTaskbarLock
  286. For i = 0 To LoaderTaskbar.Count - 1
  287. If LoaderTaskbar(i).Name = LoaderName Then
  288. Hint("该整合包正在安装中!", HintType.Critical)
  289. Return Nothing
  290. End If
  291. Next
  292. End SyncLock
  293. '启动
  294. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  295. Return Loader
  296. End Function
  297. Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing)
  298. '获取版本名
  299. Dim ShowRibble As Boolean = VersionName Is Nothing
  300. If VersionName Is Nothing Then
  301. Dim Json As JObject
  302. Try
  303. Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
  304. If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
  305. Catch ex As Exception
  306. Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
  307. Exit Sub
  308. End Try
  309. Dim PackName As String = If(Json("name"), "")
  310. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  311. If Validate.Validate(PackName) <> "" Then PackName = ""
  312. VersionName = MyMsgBoxInput(PackName, New ObjectModel.Collection(Of Validate) From {Validate},
  313. Title:="输入版本名", Button2:="取消")
  314. If String.IsNullOrEmpty(VersionName) Then Exit Sub
  315. End If
  316. '启动加载器
  317. Dim Loader = InstallPackCurseForgeLoader(FileAddress, Archive, ArchiveBaseFolder, VersionName)
  318. If Loader Is Nothing Then Exit Sub
  319. Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
  320. LoaderTaskbarAdd(Loader)
  321. FrmMain.BtnExtraDownload.ShowRefresh()
  322. If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
  323. End Sub
  324. 'HMCL
  325. Private Sub InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
  326. '读取 Json 文件
  327. Dim Json As JObject
  328. Try
  329. Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
  330. Catch ex As Exception
  331. Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
  332. Exit Sub
  333. End Try
  334. '获取版本名
  335. Dim PackName As String = If(Json("name"), "")
  336. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  337. If Validate.Validate(PackName) <> "" Then PackName = ""
  338. Dim VersionName As String = MyMsgBoxInput(PackName, New ObjectModel.Collection(Of Validate) From {Validate},
  339. Title:="输入版本名", Button2:="取消")
  340. If VersionName Is Nothing Then Exit Sub
  341. '解压与配置文件
  342. Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
  343. Dim InstallLoaders As New List(Of LoaderBase)
  344. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  345. Sub(Task As LoaderTask(Of String, Integer))
  346. UnpackFiles(InstallTemp, FileAddress)
  347. Task.Progress = 0.5
  348. '复制结果
  349. If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
  350. My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName)
  351. Else
  352. Log("[ModPack] 整合包中未找到 minecraft override 目录,已跳过")
  353. End If
  354. Task.Progress = 0.9
  355. '开启版本隔离
  356. WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
  357. End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  358. '构造加载器
  359. If Json("gameVersion") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
  360. Dim Request As New McInstallRequest With {
  361. .TargetVersionName = VersionName,
  362. .MinecraftName = Json("gameVersion").ToString
  363. }
  364. Dim InstallExpectTime As Double = 0
  365. For Each InstallLoader In InstallLoaders
  366. InstallExpectTime += InstallLoader.ProgressWeight
  367. Next
  368. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  369. If MergeLoaders Is Nothing Then Exit Sub
  370. Dim MergeExpectTime As Double = 0
  371. For Each MergeLoader In MergeLoaders
  372. MergeExpectTime += MergeLoader.ProgressWeight
  373. Next
  374. '构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
  375. Dim LoadersLib As New List(Of LoaderBase)
  376. LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)",
  377. Sub()
  378. Dim RealFileName As String = PathMcFolder & "versions\" & VersionName & "\" & VersionName & ".json"
  379. Dim OldFileName As String = PathMcFolder & "versions\" & VersionName & "\pack.json"
  380. If File.Exists(OldFileName) Then
  381. '修改 id
  382. Dim FileJson = GetJson(ReadFile(OldFileName))
  383. FileJson("id") = VersionName
  384. '替换文件
  385. File.Delete(OldFileName)
  386. WriteFile(RealFileName, FileJson.ToString)
  387. Log("[ModPack] 已重命名版本 Json:" & RealFileName)
  388. End If
  389. End Sub) With {.ProgressWeight = 0.1, .Show = False})
  390. 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})
  391. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  392. '构造总加载器
  393. Dim Loaders As New List(Of LoaderBase) From {
  394. New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime},
  395. New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime},
  396. New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}
  397. }
  398. '重复任务检查
  399. Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " "
  400. SyncLock LoaderTaskbarLock
  401. For i = 0 To LoaderTaskbar.Count - 1
  402. If LoaderTaskbar(i).Name = LoaderName Then
  403. Hint("该整合包正在安装中!", HintType.Critical)
  404. Exit Sub
  405. End If
  406. Next
  407. End SyncLock
  408. '启动
  409. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  410. 'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
  411. Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
  412. LoaderTaskbarAdd(Loader)
  413. FrmMain.BtnExtraDownload.ShowRefresh()
  414. FrmMain.BtnExtraDownload.Ribble()
  415. End Sub
  416. 'MMC
  417. Private Sub InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
  418. '读取 Json 文件
  419. Dim PackJson As JObject, PackInstance As String
  420. Try
  421. PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8))
  422. PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
  423. Catch ex As Exception
  424. Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
  425. Exit Sub
  426. End Try
  427. '获取版本名
  428. Dim PackName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
  429. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  430. If Validate.Validate(PackName) <> "" Then PackName = ""
  431. Dim VersionName As String = MyMsgBoxInput(PackName, New ObjectModel.Collection(Of Validate) From {Validate},
  432. Title:="输入版本名", Button2:="取消")
  433. If VersionName Is Nothing Then Exit Sub
  434. '解压与配置文件
  435. Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
  436. Dim InstallLoaders As New List(Of LoaderBase)
  437. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  438. Sub(Task As LoaderTask(Of String, Integer))
  439. UnpackFiles(InstallTemp, FileAddress)
  440. Task.Progress = 0.5
  441. '复制结果
  442. If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
  443. My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName)
  444. Else
  445. Log("[ModPack] 整合包中未找到 override .minecraft 目录,已跳过")
  446. End If
  447. Task.Progress = 0.9
  448. '开启版本隔离
  449. WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
  450. End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  451. '构造版本安装请求
  452. If PackJson("components") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
  453. Dim Request As New McInstallRequest With {.TargetVersionName = VersionName}
  454. For Each Component In PackJson("components")
  455. Select Case If(Component("uid"), "").ToString
  456. Case "org.lwjgl"
  457. Log("[ModPack] 已跳过 LWJGL 项")
  458. Case "net.minecraft"
  459. Request.MinecraftName = Component("version")
  460. Case "net.minecraftforge"
  461. Request.ForgeVersion = Component("version")
  462. End Select
  463. Next
  464. '构造加载器
  465. Dim InstallExpectTime As Double = 0
  466. For Each InstallLoader In InstallLoaders
  467. InstallExpectTime += InstallLoader.ProgressWeight
  468. Next
  469. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  470. If MergeLoaders Is Nothing Then Exit Sub
  471. Dim MergeExpectTime As Double = 0
  472. For Each MergeLoader In MergeLoaders
  473. MergeExpectTime += MergeLoader.ProgressWeight
  474. Next
  475. '构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
  476. Dim LoadersLib As New List(Of LoaderBase)
  477. 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})
  478. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  479. '构造总加载器
  480. Dim Loaders As New List(Of LoaderBase)
  481. Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime})
  482. Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime})
  483. Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
  484. '重复任务检查
  485. Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " "
  486. SyncLock LoaderTaskbarLock
  487. For i = 0 To LoaderTaskbar.Count - 1
  488. If LoaderTaskbar(i).Name = LoaderName Then
  489. Hint("该整合包正在安装中!", HintType.Critical)
  490. Exit Sub
  491. End If
  492. Next
  493. End SyncLock
  494. '启动
  495. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  496. Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
  497. LoaderTaskbarAdd(Loader)
  498. FrmMain.BtnExtraDownload.ShowRefresh()
  499. FrmMain.BtnExtraDownload.Ribble()
  500. End Sub
  501. 'MCBBS
  502. Private Sub InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
  503. '读取 Json 文件
  504. Dim Json As JObject
  505. Try
  506. Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
  507. Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
  508. Catch ex As Exception
  509. Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
  510. Exit Sub
  511. End Try
  512. '获取版本名
  513. Dim PackName As String = If(Json("name"), "")
  514. Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
  515. If Validate.Validate(PackName) <> "" Then PackName = ""
  516. Dim VersionName As String = MyMsgBoxInput(PackName, New ObjectModel.Collection(Of Validate) From {Validate},
  517. Title:="输入版本名", Button2:="取消")
  518. If VersionName Is Nothing Then Exit Sub
  519. '解压与配置文件
  520. Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
  521. Dim InstallLoaders As New List(Of LoaderBase)
  522. InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
  523. Sub(Task As LoaderTask(Of String, Integer))
  524. UnpackFiles(InstallTemp, FileAddress)
  525. Task.Progress = 0.5
  526. '复制结果
  527. If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
  528. My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
  529. Else
  530. Log("[ModPack] 整合包中未找到 overrides 目录,已跳过")
  531. End If
  532. Task.Progress = 0.9
  533. '开启版本隔离
  534. WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
  535. End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
  536. '构造加载器
  537. If Json("addons") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息")
  538. Dim Addons As New Dictionary(Of String, String)
  539. For Each Entry In Json("addons")
  540. Addons.Add(Entry("id"), Entry("version"))
  541. Next
  542. If Not Addons.ContainsKey("game") Then Throw New Exception("整合包未提供游戏版本信息")
  543. Dim Request As New McInstallRequest With {
  544. .TargetVersionName = VersionName,
  545. .MinecraftName = Addons("game"),
  546. .OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
  547. .ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
  548. .FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
  549. }
  550. Dim InstallExpectTime As Double = 0
  551. For Each InstallLoader In InstallLoaders
  552. InstallExpectTime += InstallLoader.ProgressWeight
  553. Next
  554. Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
  555. If MergeLoaders Is Nothing Then Exit Sub
  556. Dim MergeExpectTime As Double = 0
  557. For Each MergeLoader In MergeLoaders
  558. MergeExpectTime += MergeLoader.ProgressWeight
  559. Next
  560. '构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
  561. Dim LoadersLib As New List(Of LoaderBase)
  562. 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})
  563. LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
  564. '构造总加载器
  565. Dim Loaders As New List(Of LoaderBase)
  566. Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime})
  567. Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime})
  568. Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
  569. '重复任务检查
  570. Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " "
  571. SyncLock LoaderTaskbarLock
  572. For i = 0 To LoaderTaskbar.Count - 1
  573. If LoaderTaskbar(i).Name = LoaderName Then
  574. Hint("该整合包正在安装中!", HintType.Critical)
  575. Exit Sub
  576. End If
  577. Next
  578. End SyncLock
  579. '启动
  580. Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
  581. 'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
  582. Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
  583. LoaderTaskbarAdd(Loader)
  584. FrmMain.BtnExtraDownload.ShowRefresh()
  585. FrmMain.BtnExtraDownload.Ribble()
  586. End Sub
  587. '普通压缩包
  588. Private Sub InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String)
  589. MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹,它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True)
  590. '获取解压路径
  591. Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
  592. If String.IsNullOrEmpty(TargetFolder) Then Exit Sub
  593. If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Exit Sub
  594. If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Exit Sub
  595. '要求显示名称
  596. Dim NewName As String = MyMsgBoxInput(GetFolderNameFromPath(TargetFolder), New ObjectModel.Collection(Of Validate) From {
  597. New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})
  598. },, "输入它在列表中的显示名称",, "取消")
  599. If String.IsNullOrWhiteSpace(NewName) Then Exit Sub
  600. '解压
  601. Hint("正在解压压缩包……")
  602. UnpackFiles(TargetFolder, FileAddress)
  603. '加入文件夹列表
  604. PageSelectLeft.AddFolder(TargetFolder, NewName, False)
  605. Hint("已加入游戏文件夹列表:" & NewName, HintType.Finish)
  606. End Sub
  607. #End Region
  608. End Module