861 lines
52 KiB
VB.net
861 lines
52 KiB
VB.net
Imports System.Collections.ObjectModel
|
||
Imports System.Text.RegularExpressions
|
||
|
||
Public Module ModModpack
|
||
|
||
'触发整合包安装的外部接口
|
||
''' <summary>
|
||
''' 弹窗要求选择一个整合包文件并进行安装。
|
||
''' </summary>
|
||
Public Sub ModpackInstall()
|
||
Dim File As String = Dialogs.SelectFile("选择整合包压缩文件", False, filter:={({"rar", "zip", "mrpack"}, "整合包文件")}).FirstOrDefault() '选择整合包文件
|
||
If String.IsNullOrEmpty(File) Then Return
|
||
RunInThread(
|
||
Sub()
|
||
Try
|
||
ModpackInstall(File)
|
||
Catch ex As Exception
|
||
ex.ThrowIfCanceled()
|
||
Logger.Error(ex, "手动安装整合包失败", LogBehavior.Alert)
|
||
End Try
|
||
End Sub)
|
||
End Sub
|
||
''' <summary>
|
||
''' 构建并启动安装给定的整合包文件的加载器，并返回该加载器。若失败则抛出异常。
|
||
''' 必须在工作线程执行。
|
||
''' </summary>
|
||
Public Function ModpackInstall(File As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
|
||
Logger.Info($"整合包安装请求：{If(File, "null")}")
|
||
Dim Archive As ZipArchive = Nothing
|
||
Dim ArchiveBaseFolder As String = ""
|
||
Try
|
||
'字符校验
|
||
Dim TargetFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
|
||
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Red) : Throw New OperationCanceledException
|
||
'获取整合包种类与关键 Json
|
||
Dim PackType As Integer = -1
|
||
Try
|
||
Archive = FileUtils.OpenZip(File)
|
||
'从根目录判断整合包类型
|
||
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
|
||
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
|
||
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
|
||
If Archive.GetEntry("manifest.json") IsNot Nothing Then
|
||
Dim Json As JObject = Archive.GetEntry("manifest.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
|
||
If Json("addons") Is Nothing Then
|
||
PackType = 0 : Exit Try 'CurseForge 整合包
|
||
Else
|
||
PackType = 3 : Exit Try 'MCBBS 整合包
|
||
End If
|
||
End If
|
||
If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
|
||
If Archive.GetEntry("modpack.zip") IsNot Nothing OrElse Archive.GetEntry("modpack.mrpack") IsNot Nothing Then PackType = 9 : Exit Try '带启动器的压缩包
|
||
'从一级目录判断整合包类型
|
||
For Each Entry In Archive.Entries
|
||
Dim PathSplits As String() = Entry.FullName.Split("/")
|
||
ArchiveBaseFolder = PathSplits(0) & "/"
|
||
'确定为一级目录下
|
||
If PathSplits.Count <> 2 Then Continue For
|
||
'判断是否为关键文件
|
||
If PathSplits(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
|
||
If PathSplits(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
|
||
If PathSplits(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
|
||
If PathSplits(1) = "manifest.json" Then
|
||
Dim Json As JObject = Entry.Open().ReadString(Encoding.UTF8).DeserializeJson()
|
||
If Json("addons") Is Nothing Then
|
||
PackType = 0 : Exit Try 'CurseForge 整合包
|
||
Else
|
||
PackType = 3 : ArchiveBaseFolder = "overrides/" : Exit Try 'MCBBS 整合包
|
||
End If
|
||
End If
|
||
If PathSplits(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
|
||
If PathSplits(1) = "modpack.zip" OrElse PathSplits(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
|
||
Next
|
||
Catch ex As Exception
|
||
If ex.GetDisplay(True).Contains("Error.WinIOError") Then
|
||
Throw New Exception("打开整合包文件失败", ex)
|
||
ElseIf File.EndsWithF(".rar", True) Then
|
||
Throw New Exception("PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", ex)
|
||
Else
|
||
Throw New Exception("打开整合包文件失败，文件可能损坏或为不支持的压缩包格式", ex)
|
||
End If
|
||
End Try
|
||
'执行对应的安装方法
|
||
Select Case PackType
|
||
Case 0
|
||
Logger.Info("整合包种类：CurseForge")
|
||
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
|
||
Case 1
|
||
Logger.Info("整合包种类：HMCL")
|
||
Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
|
||
Case 2
|
||
Logger.Info("整合包种类：MMC")
|
||
Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
|
||
Case 3
|
||
Logger.Info("整合包种类：MCBBS")
|
||
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, InstanceName)
|
||
Case 4
|
||
Logger.Info("整合包种类：Modrinth")
|
||
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
|
||
Case 9
|
||
Logger.Info("整合包种类：带启动器的压缩包")
|
||
Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
|
||
Case Else
|
||
Logger.Info("整合包种类：未能识别，假定为压缩包")
|
||
Return InstallPackCompress(File, Archive)
|
||
End Select
|
||
Finally
|
||
If Archive IsNot Nothing Then Archive.Dispose()
|
||
End Try
|
||
End Function
|
||
|
||
Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Optional c As CancellationToken = Nothing, Optional p As ProgressProvider = Nothing)
|
||
DirectoryUtils.Delete(InstallTemp)
|
||
c.ThrowIfCancellationRequested()
|
||
FileUtils.ExtractToDirectory(FileAddress, InstallTemp, c, p)
|
||
End Sub
|
||
''' <summary>
|
||
''' 从整合包的 override 目录复制文件，同时设置 PCL 的配置文件与版本隔离。
|
||
''' 对路径末尾是否为 \ 没有要求。
|
||
''' </summary>
|
||
Private Sub CopyOverrideDirectory(OverridesFolder As String, VersionFolder As String, Loader As LoaderBase)
|
||
If Not OverridesFolder.EndsWithF("\") Then OverridesFolder += "\"
|
||
If Not VersionFolder.EndsWithF("\") Then VersionFolder += "\"
|
||
'复制文件
|
||
If DirectoryUtils.Exists(OverridesFolder) Then
|
||
Logger.Info($"处理整合包覆写文件夹：{OverridesFolder} → {VersionFolder}")
|
||
DirectoryUtils.Copy(OverridesFolder, VersionFolder)
|
||
Else
|
||
Logger.Info($"整合包中没有覆写文件夹：{OverridesFolder}")
|
||
End If
|
||
'设置 ini
|
||
Dim OverridesIni As String = $"{OverridesFolder}PCL\Setup.ini"
|
||
Dim VersionIni As String = $"{VersionFolder}PCL\Setup.ini"
|
||
If FileUtils.Exists(OverridesIni) Then
|
||
WriteIni(OverridesIni, "VersionArgumentIndie", 1) '开启版本隔离
|
||
WriteIni(OverridesIni, "VersionArgumentIndieV2", True)
|
||
WriteIni(OverridesIni, "IsStar", False)
|
||
FileUtils.Copy(OverridesIni, VersionIni) '覆写已有的 ini
|
||
Else
|
||
WriteIni(VersionIni, "VersionArgumentIndie", 1) '开启版本隔离
|
||
WriteIni(VersionIni, "VersionArgumentIndieV2", True)
|
||
End If
|
||
IniClearCache(VersionIni) '重置缓存，避免被安装过程中写入的 ini 覆盖
|
||
End Sub
|
||
''' <summary>
|
||
''' 弹窗提示整合包中存在不兼容的加载器。
|
||
''' 如果取消，则抛出 CancelledException。
|
||
''' </summary>
|
||
Private Sub NotifyIncompatibleLoader(LoaderName As String)
|
||
If MyMsgBox($"整合包中存在不兼容的加载器：{LoaderName}{vbCrLf}如果你知道如何手动安装它，可以先选择跳过，然后在整合包下载结束后手动安装。",
|
||
"不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New OperationCanceledException
|
||
End Sub
|
||
|
||
#Region "不同类型整合包的安装方法"
|
||
|
||
'CurseForge
|
||
Private Function InstallPackCurseForge(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String,
|
||
Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
|
||
|
||
'读取 Json 文件
|
||
Dim Json As JObject
|
||
Try
|
||
Json = Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString().DeserializeJson()
|
||
Catch ex As Exception
|
||
Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
|
||
End Try
|
||
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息")
|
||
|
||
'获取版本名
|
||
If InstanceName Is Nothing Then
|
||
InstanceName = If(Json("name"), "")
|
||
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
|
||
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
|
||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
|
||
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
|
||
End If
|
||
|
||
'获取 Mod API 版本信息
|
||
Dim TargetVersion As New McVersion
|
||
TargetVersion.VanillaName = Json("minecraft")("version").ToString
|
||
For Each Entry In If(Json("minecraft")("modLoaders"), {})
|
||
Dim Id As String = If(Entry("id"), "").ToString.Lower
|
||
If Id.StartsWithF("forge-") Then
|
||
'Forge 指定
|
||
If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老，已不支持进行安装！")
|
||
Logger.Info($"整合包 Forge 版本：{Id}")
|
||
TargetVersion.Forge = Id.Replace("forge-", "")
|
||
ElseIf Id.StartsWithF("neoforge-") Then
|
||
'NeoForge 指定
|
||
Logger.Info($"整合包 NeoForge 版本：{Id}")
|
||
TargetVersion.NeoForge = Id.Replace("neoforge-", "")
|
||
ElseIf Id.StartsWithF("fabric-") Then
|
||
'Fabric 指定
|
||
Logger.Info($"整合包 Fabric 版本：{Id}")
|
||
TargetVersion.Fabric = Id.Replace("fabric-", "")
|
||
Else
|
||
NotifyIncompatibleLoader(Id)
|
||
End If
|
||
Next
|
||
'解压
|
||
Dim InstallTemp As String = RequestTaskTempFolder()
|
||
Dim InstallLoaders As New List(Of LoaderBase)
|
||
Dim OverrideHome As String = If(Json("overrides"), "")
|
||
If OverrideHome <> "" Then
|
||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||
Sub(Task As LoaderTask(Of String, Integer))
|
||
ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.6))
|
||
CopyOverrideDirectory(
|
||
InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
|
||
$"{McFolderSelected}versions\{InstanceName}", Task)
|
||
End Sub) With {
|
||
.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||
End If
|
||
'获取 Mod 列表
|
||
Dim ModList As New List(Of Integer)
|
||
Dim ModOptionalList As New List(Of Integer)
|
||
For Each ModEntry In If(Json("files"), {})
|
||
If ModEntry("projectID") Is Nothing OrElse ModEntry("fileID") Is Nothing Then
|
||
Hint("某项 Mod 缺少必要信息，已跳过：" & ModEntry.ToString)
|
||
Continue For
|
||
End If
|
||
ModList.Add(ModEntry("fileID"))
|
||
If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then ModOptionalList.Add(ModEntry("fileID"))
|
||
Next
|
||
If ModList.Any Then
|
||
Dim ModDownloadLoaders As New List(Of LoaderBase)
|
||
'获取 Mod 下载信息
|
||
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
|
||
Sub(Task As LoaderTask(Of Integer, JArray))
|
||
Task.Output = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & ModList.Join(",") & "]}", "application/json")("data")
|
||
If ModList.Count = Task.Output.Count Then Return
|
||
'如果文件已被删除，则 API 会跳过那一项，导致返回的列表数量小于请求的数量。后面的都是对此的错误处理。
|
||
'获取缺失的 fileId 列表
|
||
Dim MissingIds = ModList.Except(Task.Output.Select(Function(j) j("id").ToObject(Of Integer))).ToList
|
||
Logger.Info($"缺失的 fileIds：{MissingIds.Join("、")}")
|
||
'将 fileId 映射到 projectId
|
||
Dim Missings = MissingIds.Select(Of (ProjectId As Integer, FileId As Integer))(
|
||
Function(id) (CType(Json("files").AsEnumerable.First(Function(f) f("fileID").ToObject(Of Integer) = id), JObject)("projectID").ToObject(Of Integer), id)).ToList
|
||
Logger.Info($"缺失项：{Missings.Join("、")}")
|
||
'尝试获取对应的工程信息
|
||
Dim Projects As New List(Of ResourceProject)
|
||
Try
|
||
Projects = ResourceProject.FromProjectIds(Missings.Select(Function(e) e.ProjectId.ToString), ResourcePlatforms.CurseForge).ToList
|
||
Catch ex As Exception
|
||
Logger.Warn(ex, "获取缺失的工程信息失败")
|
||
End Try
|
||
Dim MissingDesc As New List(Of String)
|
||
For Each Missing In Missings
|
||
Dim Project = Projects.FirstOrDefault(Function(p) p.Id = Missing.ProjectId)
|
||
If Project Is Nothing Then
|
||
MissingDesc.Add($"未知 CurseForge 项目 (项目 ID {Missing.ProjectId}，文件 ID {Missing.FileId})")
|
||
Else
|
||
MissingDesc.Add($"{Project.TranslatedName} (文件 ID {Missing.FileId})")
|
||
End If
|
||
Next
|
||
If MyMsgBox($"未找到该整合包所需的以下内容，它们可能已被原作者删除：{vbCrLf}- {MissingDesc.Join(vbCrLf + "- ")}{vbCrLf}{vbCrLf}是否继续安装？缺失这些内容可能导致整合包出现异常！",
|
||
"整合包内容缺失", "继续", "取消", IsWarn:=True) = 2 Then
|
||
Task.Cancel()
|
||
End If
|
||
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
|
||
'构造 NetFile
|
||
ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
|
||
Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
|
||
Dim FileList As New Dictionary(Of Integer, NetFile)
|
||
For Each ModJson In Task.Input
|
||
Dim Id As Integer = ModJson("id").ToObject(Of Integer)
|
||
'跳过重复的 Mod（疑似 CurseForge Bug）
|
||
If FileList.ContainsKey(Id) Then Continue For
|
||
'可选 Mod 提示
|
||
If ModOptionalList.Contains(Id) Then
|
||
If MyMsgBox("是否要下载整合包中的可选文件 " & ModJson("displayName").ToString & "？", "下载可选文件", "是", "否") = 2 Then
|
||
Continue For
|
||
End If
|
||
End If
|
||
'根据 modules 和文件名后缀判断资源类型
|
||
Dim TargetFolder As String, Type As ResourceTypes
|
||
If ModJson("modules").Any Then 'modules 可能返回 null（#1006）
|
||
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
|
||
If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse ModuleNames.Contains("fabric.mod.json") OrElse
|
||
ModJson?("FileName")?.ToString.EndsWithF(".jar", True) Then
|
||
TargetFolder = "mods" : Type = ResourceTypes.Mod
|
||
ElseIf ModuleNames.Contains("pack.mcmeta") Then
|
||
TargetFolder = "resourcepacks" : Type = ResourceTypes.ResourcePack
|
||
ElseIf ModuleNames.Contains("shaders") Then
|
||
TargetFolder = "shaderpacks" : Type = ResourceTypes.Shader
|
||
Else
|
||
TargetFolder = "saves" : Type = ResourceTypes.Map
|
||
End If
|
||
Else
|
||
TargetFolder = "mods" : Type = ResourceTypes.Mod
|
||
End If
|
||
'建立 CompFile
|
||
Dim File = ResourceVersion.FromPlatformJson(ModJson, Type)
|
||
If Not File.DownloadAvailable Then Continue For
|
||
'实际的添加
|
||
FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\",
|
||
ResourceVersion.DownloadReason.ModPack, TargetVersion.VanillaName, TargetVersion.ModLoaders))
|
||
Task.Progress += 1 / (1 + ModList.Count)
|
||
Next
|
||
Task.Output = FileList.Values.ToList
|
||
End Sub) With {.ProgressWeight = ModList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
|
||
'下载 Mod 文件
|
||
ModDownloadLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
|
||
'构造加载器
|
||
InstallLoaders.Add(New LoaderCombo(Of Integer)("下载 Mod（主加载器）", ModDownloadLoaders) With
|
||
{.Show = False, .ProgressWeight = ModDownloadLoaders.Sum(Function(l) l.ProgressWeight)})
|
||
End If
|
||
|
||
'构造加载器
|
||
Dim Request As New McInstallRequest With {
|
||
.NewInstanceName = InstanceName,
|
||
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
|
||
.MinecraftName = TargetVersion.VanillaName,
|
||
.ForgeVersion = TargetVersion.Forge,
|
||
.NeoForgeVersion = TargetVersion.NeoForge,
|
||
.FabricVersion = TargetVersion.Fabric
|
||
}
|
||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
|
||
'构造总加载器
|
||
Dim Loaders As New List(Of LoaderBase)
|
||
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
|
||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
|
||
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
|
||
Sub(Task As LoaderTask(Of String, String))
|
||
'设置图标
|
||
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
|
||
If Logo IsNot Nothing AndAlso FileUtils.Exists(Logo) Then
|
||
FileUtils.Copy(Logo, VersionFolder & "PCL\Logo.png")
|
||
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
|
||
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
|
||
Logger.Info($"已设置整合包 Logo：{Logo}")
|
||
End If
|
||
'解压地图文件
|
||
Dim SaveFolder As String = $"{VersionFolder}saves\"
|
||
For Each MapFile In DirectoryUtils.EnumerateFiles(SaveFolder, searchPattern:="*.zip")
|
||
FileUtils.ExtractToDirectory(MapFile, SaveFolder, Task.CreateCancellationToken())
|
||
FileUtils.Delete(MapFile)
|
||
Next
|
||
'删除原始整合包文件
|
||
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
|
||
If FileUtils.Exists(Target) Then
|
||
Logger.Info($"删除原始整合包文件：{Target}")
|
||
FileUtils.Delete(Target)
|
||
End If
|
||
Next
|
||
If FileUtils.Exists(FileAddress) AndAlso PathUtils.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
|
||
Logger.Info($"删除安装整合包文件：{FileAddress}")
|
||
FileUtils.Delete(FileAddress)
|
||
End If
|
||
End Sub) With {.ProgressWeight = 0.1, .Show = False})
|
||
|
||
'重复任务检查
|
||
Dim LoaderName As String = "CurseForge 整合包安装：" & InstanceName & " "
|
||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||
Hint("该整合包正在安装中！", HintType.Red)
|
||
Throw New OperationCanceledException
|
||
End If
|
||
|
||
'启动
|
||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||
Loader.Start(Request.VersionFolder)
|
||
LoaderTaskbarAdd(Loader)
|
||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||
Return Loader
|
||
End Function
|
||
|
||
'Modrinth
|
||
Private Function InstallPackModrinth(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
|
||
|
||
'读取 Json 文件
|
||
Dim Json As JObject
|
||
Try
|
||
Json = Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open().ReadString().DeserializeJson()
|
||
Catch ex As Exception
|
||
Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
|
||
End Try
|
||
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息")
|
||
'获取 Mod API 版本信息
|
||
Dim TargetVersion As New McVersion
|
||
For Each Entry As JProperty In If(Json("dependencies"), {})
|
||
Select Case Entry.Name.Lower
|
||
Case "minecraft"
|
||
TargetVersion.VanillaName = Entry.Value.ToString
|
||
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
|
||
TargetVersion.Forge = Entry.Value.ToString
|
||
Logger.Info($"整合包 Forge 版本：{TargetVersion.Forge}")
|
||
Case "neoforge", "neo-forge" 'eg. 20.6.98-beta
|
||
TargetVersion.NeoForge = Entry.Value.ToString
|
||
Logger.Info($"整合包 NeoForge 版本：{TargetVersion.NeoForge}")
|
||
Case "fabric-loader" 'eg. 0.14.14
|
||
TargetVersion.Fabric = Entry.Value.ToString
|
||
Logger.Info($"整合包 Fabric 版本：{TargetVersion.Fabric}")
|
||
Case Else
|
||
NotifyIncompatibleLoader(Entry.Name)
|
||
End Select
|
||
Next
|
||
'获取版本名
|
||
If InstanceName Is Nothing Then
|
||
InstanceName = If(Json("name"), "")
|
||
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
|
||
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
|
||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
|
||
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
|
||
End If
|
||
'解压
|
||
Dim InstallTemp As String = RequestTaskTempFolder()
|
||
Dim InstallLoaders As New List(Of LoaderBase)
|
||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||
Sub(Task As LoaderTask(Of String, Integer))
|
||
ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.5))
|
||
CopyOverrideDirectory(
|
||
InstallTemp & ArchiveBaseFolder & "overrides",
|
||
McFolderSelected & "versions\" & InstanceName, Task)
|
||
CopyOverrideDirectory(
|
||
InstallTemp & ArchiveBaseFolder & "client-overrides",
|
||
McFolderSelected & "versions\" & InstanceName, Task)
|
||
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||
'获取下载文件列表
|
||
Dim FileList As New List(Of NetFile)
|
||
For Each File In If(Json("files"), {})
|
||
'检查是否需要该文件
|
||
If File("env") IsNot Nothing Then
|
||
Select Case File("env")("client").ToString
|
||
Case "optional"
|
||
If MyMsgBox("是否要下载可选文件 " & PathUtils.GetLastPart(File("path").ToString) & "？",
|
||
"下载可选文件", "是", "否") = 2 Then
|
||
Continue For
|
||
End If
|
||
Case "unsupported"
|
||
Continue For
|
||
End Select
|
||
End If
|
||
'添加下载文件
|
||
Dim Urls = File("downloads").SelectMany(Function(t) ResourceVersion.ParseCurseForgeDownloadUrls(t.ToString)).ToList
|
||
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
|
||
Urls = ResourceVersion.ParseModrinthTrackArguments(Urls,
|
||
ResourceVersion.DownloadReason.ModPack, TargetVersion.VanillaName, TargetVersion.ModLoaders).ToList 'Modrinth 来源追踪信息
|
||
Urls = Urls.Distinct.ToList()
|
||
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
|
||
If Not Path.GetFullPath(TargetPath).StartsWithF(Path.GetFullPath($"{McFolderSelected}versions\{InstanceName}\")) Then
|
||
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！{vbCrLf}目标：{Path.GetFullPath(TargetPath)}{vbCrLf}错误的文件：{TargetPath}", "文件路径校验失败", IsWarn:=True)
|
||
Throw New OperationCanceledException
|
||
End If
|
||
FileList.Add(New NetFile(Urls, TargetPath,
|
||
New FileChecker With {.Hash = File("hashes")("sha1").ToString}, True)) 'Modrinth 整合包不应校验文件大小（他们官方自己说的）
|
||
Next
|
||
If FileList.Any Then
|
||
InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
|
||
End If
|
||
|
||
'构造加载器
|
||
Dim Request As New McInstallRequest With {
|
||
.NewInstanceName = InstanceName,
|
||
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
|
||
.MinecraftName = TargetVersion.VanillaName,
|
||
.ForgeVersion = TargetVersion.Forge,
|
||
.NeoForgeVersion = TargetVersion.NeoForge,
|
||
.FabricVersion = TargetVersion.Fabric
|
||
}
|
||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
|
||
'构造总加载器
|
||
Dim Loaders As New List(Of LoaderBase)
|
||
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
|
||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
|
||
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
|
||
Sub(Task As LoaderTask(Of String, String))
|
||
'设置图标
|
||
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
|
||
If Logo IsNot Nothing AndAlso FileUtils.Exists(Logo) Then
|
||
FileUtils.Copy(Logo, VersionFolder & "PCL\Logo.png")
|
||
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
|
||
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
|
||
Logger.Info($"已设置整合包 Logo：{Logo}")
|
||
End If
|
||
'删除原始整合包文件
|
||
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
|
||
If FileUtils.Exists(Target) Then
|
||
Logger.Info($"删除原始整合包文件：{Target}")
|
||
FileUtils.Delete(Target)
|
||
End If
|
||
Next
|
||
If FileUtils.Exists(FileAddress) AndAlso PathUtils.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
|
||
Logger.Info($"删除安装整合包文件：{FileAddress}")
|
||
FileUtils.Delete(FileAddress)
|
||
End If
|
||
End Sub) With {.ProgressWeight = 0.1, .Show = False})
|
||
|
||
'重复任务检查
|
||
Dim LoaderName As String = $"Modrinth 整合包安装：{InstanceName} "
|
||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||
Hint("该整合包正在安装中！", HintType.Red)
|
||
Throw New OperationCanceledException
|
||
End If
|
||
|
||
'启动
|
||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||
Loader.Start(Request.VersionFolder)
|
||
LoaderTaskbarAdd(Loader)
|
||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||
Return Loader
|
||
End Function
|
||
|
||
'HMCL
|
||
Private Function InstallPackHMCL(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||
'读取 Json 文件
|
||
Dim Json As JObject
|
||
Try
|
||
Json = Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
|
||
Catch ex As Exception
|
||
Throw New Exception("HMCL 整合包安装信息存在问题", ex)
|
||
End Try
|
||
'获取版本名
|
||
Dim InstanceName As String = If(Json("name"), "")
|
||
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
|
||
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
|
||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
|
||
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
|
||
'解压
|
||
Dim InstallTemp As String = RequestTaskTempFolder()
|
||
Dim InstallLoaders As New List(Of LoaderBase)
|
||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||
Sub(Task As LoaderTask(Of String, Integer))
|
||
ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.6))
|
||
CopyOverrideDirectory(
|
||
InstallTemp & ArchiveBaseFolder & "minecraft",
|
||
McFolderSelected & "versions\" & InstanceName, Task)
|
||
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||
'构造游戏本体安装加载器
|
||
If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！")
|
||
Dim Request As New McInstallRequest With {
|
||
.NewInstanceName = InstanceName,
|
||
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
|
||
.MinecraftName = Json("gameVersion").ToString
|
||
}
|
||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
|
||
'构造总加载器
|
||
Dim Loaders As New List(Of LoaderBase) From {
|
||
New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)},
|
||
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}
|
||
}
|
||
'重复任务检查
|
||
Dim LoaderName As String = "HMCL 整合包安装：" & InstanceName & " "
|
||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||
Hint("该整合包正在安装中！", HintType.Red)
|
||
Throw New OperationCanceledException
|
||
End If
|
||
'启动
|
||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||
Loader.Start(Request.VersionFolder)
|
||
LoaderTaskbarAdd(Loader)
|
||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||
Return Loader
|
||
End Function
|
||
|
||
'MMC
|
||
Private Function InstallPackMMC(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||
'读取 Json 文件
|
||
Dim PackJson As JObject, PackInstance As String
|
||
Try
|
||
PackJson = Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
|
||
PackInstance = Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open().ReadString(Encoding.UTF8)
|
||
Catch ex As Exception
|
||
Throw New Exception("MMC 整合包安装信息存在问题", ex)
|
||
End Try
|
||
'获取版本名
|
||
Dim InstanceName As String = If(PackInstance.RegexSeek("(?<=\nname\=)[^\n]+"), "")
|
||
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
|
||
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
|
||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
|
||
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
|
||
'解压
|
||
Dim InstallTemp As String = RequestTaskTempFolder()
|
||
Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
|
||
Dim InstallLoaders As New List(Of LoaderBase)
|
||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||
Sub(Task As LoaderTask(Of String, Integer))
|
||
ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.55))
|
||
CopyOverrideDirectory(
|
||
InstallTemp & ArchiveBaseFolder & ".minecraft",
|
||
McFolderSelected & "versions\" & InstanceName, Task)
|
||
'读取 MMC 设置文件（#2655）
|
||
Try
|
||
Dim MmcSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
|
||
If FileUtils.Exists(MmcSetupFile) Then
|
||
'将其中的等号替换为冒号，以符合 ini 文件格式
|
||
Dim Lines As New List(Of String)
|
||
For Each Line In FileUtils.ReadAsLines(MmcSetupFile, True)
|
||
If Not Line.Contains("=") Then Continue For
|
||
Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
|
||
Next
|
||
FileUtils.Write(MmcSetupFile, Lines.Join(vbCrLf))
|
||
'读取文件
|
||
If ReadIni(MmcSetupFile, "OverrideCommands", False) Then
|
||
Dim PreLaunchCommand As String = ReadIni(MmcSetupFile, "PreLaunchCommand")
|
||
If PreLaunchCommand <> "" Then
|
||
PreLaunchCommand = PreLaunchCommand.Replace("\""", """").
|
||
Replace("$INST_JAVA", "{java}java.exe").
|
||
Replace("$INST_MC_DIR\", "{minecraft}").Replace("$INST_MC_DIR", "{minecraft}").
|
||
Replace("$INST_DIR\", "{verpath}").Replace("$INST_DIR", "{verpath}").
|
||
Replace("$INST_ID", "{name}").Replace("$INST_NAME", "{name}")
|
||
WriteIni(SetupFile, "VersionAdvanceRun", PreLaunchCommand)
|
||
Logger.Info($"迁移 MultiMC 版本独立设置：启动前执行命令：{PreLaunchCommand}")
|
||
End If
|
||
End If
|
||
If ReadIni(MmcSetupFile, "JoinServerOnLaunch", False) Then
|
||
Dim ServerAddress As String = ReadIni(MmcSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """")
|
||
WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
|
||
Logger.Info($"迁移 MultiMC 版本独立设置：自动进入服务器：{ServerAddress}")
|
||
End If
|
||
Dim Logo As String = ReadIni(MmcSetupFile, "iconKey", "")
|
||
If Logo <> "" AndAlso FileUtils.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
|
||
WriteIni(SetupFile, "LogoCustom", True)
|
||
WriteIni(SetupFile, "Logo", "PCL\Logo.png")
|
||
FileUtils.Copy($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png")
|
||
Logger.Info($"迁移 MultiMC 版本独立设置：版本图标（{Logo}.png）")
|
||
End If
|
||
'JVM 参数
|
||
Dim JvmArgs As String = ReadIni(MmcSetupFile, "JvmArgs", "")
|
||
If JvmArgs <> "" Then
|
||
If ReadIni(MmcSetupFile, "OverrideJavaArgs", False) Then
|
||
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
|
||
Logger.Info($"迁移 MultiMC 版本独立设置：JVM 参数（覆盖）：{JvmArgs}")
|
||
Else
|
||
JvmArgs += " " & Settings.Get(Of String)("LaunchAdvanceJvm")
|
||
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
|
||
Logger.Info($"迁移 MultiMC 版本独立设置：JVM 参数（追加）：{JvmArgs}")
|
||
End If
|
||
End If
|
||
End If
|
||
Catch ex As Exception
|
||
Logger.Warn(ex, $"读取 MMC 配置文件失败（{InstallTemp}{ArchiveBaseFolder}instance.cfg）")
|
||
End Try
|
||
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||
'构造版本安装请求
|
||
If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息，无法安装！")
|
||
Dim Request As New McInstallRequest With {.NewInstanceName = InstanceName, .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\"}
|
||
For Each Component As JObject In PackJson("components")
|
||
If Not Component.ContainsKey("uid") Then Continue For
|
||
Dim UID As String = Component("uid").ToString
|
||
Select Case UID
|
||
Case "net.minecraft"
|
||
Request.MinecraftName = Component("version")
|
||
Case "net.minecraftforge"
|
||
Request.ForgeVersion = Component("version")
|
||
Case "net.neoforged"
|
||
Request.NeoForgeVersion = Component("version")
|
||
Case "net.fabricmc.fabric-loader"
|
||
Request.FabricVersion = Component("version")
|
||
Case Else
|
||
If UID.StartsWithF("org.lwjgl") Then '#8210
|
||
Logger.Info($"已跳过 LWJGL 项：{UID}")
|
||
Else
|
||
NotifyIncompatibleLoader(UID)
|
||
End If
|
||
End Select
|
||
Next
|
||
'构造加载器
|
||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
|
||
'构造总加载器
|
||
Dim Loaders As New List(Of LoaderBase)
|
||
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
|
||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
|
||
|
||
'重复任务检查
|
||
Dim LoaderName As String = "MMC 整合包安装：" & InstanceName & " "
|
||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||
Hint("该整合包正在安装中！", HintType.Red)
|
||
Throw New OperationCanceledException
|
||
End If
|
||
|
||
'启动
|
||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||
Loader.Start(Request.VersionFolder)
|
||
LoaderTaskbarAdd(Loader)
|
||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||
Return Loader
|
||
End Function
|
||
|
||
'MCBBS
|
||
Private Function InstallPackMCBBS(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String,
|
||
Optional InstanceName As String = Nothing) As LoaderCombo(Of String)
|
||
'读取 Json 文件
|
||
Dim Json As JObject
|
||
Try
|
||
Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
|
||
Json = Entry.Open().ReadString(Encoding.UTF8).DeserializeJson()
|
||
Catch ex As Exception
|
||
Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
|
||
End Try
|
||
'获取版本名
|
||
If InstanceName Is Nothing Then
|
||
InstanceName = If(Json("name"), "")
|
||
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
|
||
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
|
||
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
|
||
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
|
||
End If
|
||
'解压
|
||
Dim InstallTemp As String = RequestTaskTempFolder()
|
||
Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
|
||
Dim InstallLoaders As New List(Of LoaderBase)
|
||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||
Sub(Task As LoaderTask(Of String, Integer))
|
||
ExtractModpackFiles(InstallTemp, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.6))
|
||
CopyOverrideDirectory(
|
||
InstallTemp & ArchiveBaseFolder & "overrides",
|
||
McFolderSelected & "versions\" & InstanceName, Task)
|
||
'JVM 参数
|
||
If Json("launchInfo") IsNot Nothing Then
|
||
Dim LaunchInfo As JObject = Json("launchInfo")
|
||
If LaunchInfo.ContainsKey("javaArgument") Then WriteIni(SetupFile, "VersionAdvanceJvm", String.Join(" ", LaunchInfo("javaArgument")))
|
||
If LaunchInfo.ContainsKey("launchArgument") Then WriteIni(SetupFile, "VersionAdvanceGame", String.Join(" ", LaunchInfo("launchArgument")))
|
||
End If
|
||
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||
'构造加载器
|
||
If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息，无法安装！")
|
||
Dim Addons As New Dictionary(Of String, String)
|
||
For Each Entry In Json("addons")
|
||
Addons.Add(Entry("id"), Entry("version"))
|
||
Next
|
||
If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息，无法安装！")
|
||
If Addons.ContainsKey("quilt") Then
|
||
Hint("PCL 不支持安装 Quilt 整合包！", HintType.Red)
|
||
Throw New OperationCanceledException
|
||
End If
|
||
Dim Request As New McInstallRequest With {
|
||
.NewInstanceName = InstanceName,
|
||
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
|
||
.MinecraftName = Addons("game"),
|
||
.OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
|
||
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
|
||
.NeoForgeVersion = If(Addons.ContainsKey("neoforge"), Addons("neoforge"), Nothing),
|
||
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
|
||
}
|
||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
|
||
'构造总加载器
|
||
Dim Loaders As New List(Of LoaderBase)
|
||
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
|
||
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
|
||
|
||
'重复任务检查
|
||
Dim LoaderName As String = "MCBBS 整合包安装：" & InstanceName & " "
|
||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||
Hint("该整合包正在安装中！", HintType.Red)
|
||
Throw New OperationCanceledException
|
||
End If
|
||
|
||
'启动
|
||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||
'If Archive IsNot Nothing Then Archive.Dispose() '解除占用，以免在加载器中触发 “正由另一进程使用，因此该进程无法访问此文件”
|
||
Loader.Start(Request.VersionFolder)
|
||
LoaderTaskbarAdd(Loader)
|
||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||
Return Loader
|
||
End Function
|
||
|
||
'带启动器的压缩包
|
||
Private Function InstallPackLauncherPack(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||
'获取解压路径
|
||
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
|
||
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
|
||
If TargetFolder Is Nothing Then Throw New OperationCanceledException
|
||
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New OperationCanceledException
|
||
'解压
|
||
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
|
||
New LoaderTask(Of String, Integer)("解压压缩包",
|
||
Sub(Task As LoaderTask(Of String, Integer))
|
||
ExtractModpackFiles(TargetFolder, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.9))
|
||
OpenExplorer(TargetFolder)
|
||
Thread.Sleep(400) '避免文件争用
|
||
'查找解压后的 exe 文件
|
||
Dim Launcher As String = Nothing
|
||
For Each ExeFile In DirectoryUtils.EnumerateFiles(TargetFolder, searchPattern:="*.exe")
|
||
Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
|
||
Logger.Info($"文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
|
||
If Info.ProductName = "Plain Craft Launcher" Then
|
||
Launcher = ExeFile
|
||
Logger.Info($"发现整合包附带的 PCL 启动器：{ExeFile}")
|
||
ElseIf (Info.ProductName.ContainsIgnoreCase("Launcher") OrElse Info.ProductName.Contains("启动")) AndAlso
|
||
Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then
|
||
If Launcher Is Nothing Then
|
||
Launcher = ExeFile
|
||
Logger.Info($"发现整合包附带的疑似第三方启动器：{ExeFile}")
|
||
End If
|
||
End If
|
||
Next
|
||
Task.Progress = 0.95
|
||
'尝试使用附带的启动器打开
|
||
If Launcher IsNot Nothing Then
|
||
Logger.Info($"找到压缩包中附带的启动器：{Launcher}")
|
||
If MyMsgBox($"整合包里似乎自带了启动器，是否换用它继续安装？{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "换用", "不换用") = 1 Then
|
||
StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出
|
||
Logger.Info("为换用整合包中的启动器启动，强制结束程序")
|
||
FrmMain.EndProgram(False)
|
||
Return
|
||
End If
|
||
Else
|
||
Logger.Info("未找到压缩包中附带的启动器")
|
||
End If
|
||
'加入文件夹列表
|
||
Dim InstanceName As String = PathUtils.GetLastPart(TargetFolder)
|
||
DirectoryUtils.Create(TargetFolder & ".minecraft\")
|
||
PageSelectLeft.AddFolder(
|
||
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
|
||
InstanceName, False)
|
||
'调用 modpack 文件进行安装
|
||
Dim ModpackFile = DirectoryUtils.EnumerateFiles(TargetFolder, True, "modpack.*").First
|
||
Logger.Info($"调用 modpack 文件继续安装：{ModpackFile}")
|
||
ModpackInstall(ModpackFile)
|
||
End Sub)
|
||
})
|
||
Loader.Start(TargetFolder)
|
||
LoaderTaskbarAdd(Loader)
|
||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||
FrmMain.BtnExtraDownload.Ribble()
|
||
Return Loader
|
||
End Function
|
||
|
||
'普通压缩包
|
||
Private Function InstallPackCompress(FileAddress As String, Archive As ZipArchive) As LoaderCombo(Of String)
|
||
'尝试定位 .minecraft 文件夹：寻找形如 “/versions/XXX/XXX.json” 的路径
|
||
Dim Match As Match = Nothing
|
||
Dim Regex As New Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegexOptions.IgnoreCase)
|
||
For Each Entry In Archive.Entries
|
||
Dim EntryMatch = Regex.Match("/" & Entry.FullName)
|
||
If EntryMatch.Success Then
|
||
Match = EntryMatch
|
||
Exit For
|
||
End If
|
||
Next
|
||
If Match Is Nothing Then Throw New Exception("文件结构不匹配，这可能不是 Minecraft 客户端压缩包？") '没有匹配
|
||
Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
|
||
Logger.Info($"检测到压缩包的 .minecraft 根目录：{ArchiveBaseFolder}，命中的版本名：{Match.Groups(1).Value}")
|
||
'获取解压路径
|
||
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
|
||
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
|
||
If TargetFolder Is Nothing Then Throw New OperationCanceledException
|
||
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Throw New OperationCanceledException
|
||
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New OperationCanceledException
|
||
'解压
|
||
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
|
||
New LoaderTask(Of String, Integer)("解压压缩包",
|
||
Sub(Task As LoaderTask(Of String, Integer))
|
||
ExtractModpackFiles(TargetFolder, FileAddress, Task.CreateCancellationToken(), Task.CreateSyncProgressProvider(ToPercentage:=0.95))
|
||
'加入文件夹列表
|
||
PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, PathUtils.GetLastPart(TargetFolder), False)
|
||
Thread.Sleep(400) '避免文件争用
|
||
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.InstanceSelect))
|
||
End Sub)
|
||
}) With {.OnStateChanged = AddressOf McInstallState}
|
||
Loader.Start(TargetFolder)
|
||
LoaderTaskbarAdd(Loader)
|
||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||
FrmMain.BtnExtraDownload.Ribble()
|
||
Return Loader
|
||
End Function
|
||
|
||
#End Region
|
||
|
||
End Module
|