diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
index 10cfdbb..9e9ea6a 100644
--- a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+++ b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
@@ -721,6 +721,232 @@
#End Region
+#Region "DlNeoForgeVersion | NeoForge 版本列表"
+
+ Public Class DlNeoForgeVersionEntry
+ '''
+ ''' 完整的版本名，如 “14.22.1.2478”。
+ '''
+ Public Version As String
+ '''
+ ''' 对应的 Minecraft 版本，如“1.12.2”。
+ '''
+ Public Inherit As String
+ '''
+ ''' 发布时间，格式为“yyyy/MM/dd HH:mm”。
+ '''
+ Public ReleaseTime As String
+ '''
+ ''' 文件的 MD5 或 SHA1（BMCLAPI 的老版本是 MD5，新版本是 SHA1；官方源总是 MD5）。
+ '''
+ Public Hash As String = Nothing
+ '''
+ ''' 安装类型。有 installer、client、universal 三种。
+ '''
+ Public Category As String
+ '''
+ ''' 版本分支。若无分支则为 Nothing。
+ '''
+ Public Branch As String = Nothing
+ Public Structure DlNeoForgeListResult
+ '''
+ ''' 数据来源名称，如“Official”，“BMCLAPI”。
+ '''
+ Public SourceName As String
+ '''
+ ''' 是否为官方的实时数据。
+ '''
+ Public IsOfficial As Boolean
+ '''
+ ''' 获取到的数据。
+ '''
+ Public Value As JObject
+ End Structure
+ '''
+ ''' 是否为新版 Forge。（即为 Minecraft 1.13+）
+ '''
+ Public ReadOnly Property IsNewType As Boolean
+ Get
+ Return Version.Split(".")(0) >= 20
+ End Get
+ End Property
+ '''
+ ''' 构建数。
+ '''
+ Public ReadOnly Property Build As Integer
+ Get
+ Dim Version = Me.Version.Split(".")
+ If Version(0) < 15 Then
+ Return Version(Version.Count - 1)
+ Else
+ Return Version(Version.Count - 1) + 10000
+ End If
+ End Get
+ End Property
+ '''
+ ''' 用于下载的文件版本名。可能在 Version 的基础上添加了分支。
+ '''
+ Public ReadOnly Property FileVersion As String
+ Get
+ Return Version & If(Branch Is Nothing, ""， "-" & Branch)
+ End Get
+ End Property
+ '''
+ ''' 即将下载的文件全名。
+ '''
+ Public ReadOnly Property FileName As String
+ Get
+ Return "forge-" & Inherit & "-" & FileVersion & "-" & Category & "." & FileSuffix
+ End Get
+ End Property
+ '''
+ ''' 文件扩展名。
+ '''
+ Public ReadOnly Property FileSuffix As String
+ Get
+ If Category = "installer" Then
+ Return "jar"
+ Else
+ Return "zip"
+ End If
+ End Get
+ End Property
+ End Class
+
+ '''
+ ''' NeoForge 版本列表，主加载器。
+ '''
+ Public Sub DlNeoForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)))
+ Dim DlNeoForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlNeoForgeVersionEntry))("DlNeoForgeVersion Official", AddressOf DlNeoForgeVersionOfficialMain)
+ Dim DlNeoForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlNeoForgeVersionEntry))("DlNeoForgeVersion Bmclapi", AddressOf DlNeoForgeVersionBmclapiMain)
+ Select Case Setup.Get("ToolDownloadVersion")
+ Case 0
+ DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)), Integer)) From {
+ New KeyValuePair(Of LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)), Integer)(DlNeoForgeVersionBmclapiLoader, 30),
+ New KeyValuePair(Of LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)), Integer)(DlNeoForgeVersionOfficialLoader, 60)
+ }, Loader.IsForceRestarting)
+ Case 1
+ DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)), Integer)) From {
+ New KeyValuePair(Of LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)), Integer)(DlNeoForgeVersionOfficialLoader, 5),
+ New KeyValuePair(Of LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)), Integer)(DlNeoForgeVersionBmclapiLoader, 35)
+ }, Loader.IsForceRestarting)
+ Case Else
+ DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)), Integer)) From {
+ New KeyValuePair(Of LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)), Integer)(DlNeoForgeVersionOfficialLoader, 60),
+ New KeyValuePair(Of LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)), Integer)(DlNeoForgeVersionBmclapiLoader, 60)
+ }, Loader.IsForceRestarting)
+ End Select
+ End Sub
+
+ '''
+ ''' NeoForge 版本列表，官方源。
+ '''
+ Public Sub DlNeoForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)))
+ Dim Result As String
+ Dim ResultJson As JObject
+ Try
+ Result = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True)
+ Catch ex As Exception
+ If GetExceptionSummary(ex).Contains("(404)") Then
+ Throw New Exception("没有可用版本")
+ Else
+ Throw
+ End If
+ End Try
+ If Result.Length < 50 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）")
+ ResultJson = GetJson(Result)
+ Dim Versions As New List(Of DlNeoForgeVersionEntry)
+ Dim VersionList As String = ResultJson("versions")
+ MyMsgBox(VersionList, "VersionList 获取测试")
+ 'Try
+ ' Try
+ ' '基础信息获取
+ ' Dim Name As String = RegexSeek(VersionCode, "(?<=[^(0-9)]+)[0-9\.]+")
+ ' Dim IsRecommended As Boolean = VersionCode.Contains("fa promo-recommended")
+ ' Dim Inherit As String = Loader.Input
+ ' '分支获取
+ ' Dim Branch As String = RegexSeek(VersionCode, $"(?<=-{Name}-)[^-""]+(?=-[a-z]+.[a-z]{{3}})")
+ ' If String.IsNullOrWhiteSpace(Branch) Then Branch = Nothing
+ ' '发布时间获取
+ ' Dim ReleaseTimeOriginal = RegexSeek(VersionCode, "(?<=""download-time"" title="")[^""]+")
+ ' Dim ReleaseTimeSplit = ReleaseTimeOriginal.Split(" -:".ToCharArray) '原格式："2021-02-15 03:24:02"
+ ' Dim ReleaseDate As New Date(ReleaseTimeSplit(0), ReleaseTimeSplit(1), ReleaseTimeSplit(2), '年月日
+ ' ReleaseTimeSplit(3), ReleaseTimeSplit(4), ReleaseTimeSplit(5), '时分秒
+ ' 0, DateTimeKind.Utc) '以 UTC 时间作为标准
+ ' Dim ReleaseTime As String = ReleaseDate.ToLocalTime.ToString("yyyy'/'MM'/'dd HH':'mm") '时区与格式转换
+ ' '添加进列表
+ ' Versions.Add(New DlNeoForgeVersionEntry With {.Category = Category, .Version = Name, .Hash = MD5.Trim(vbCr, vbLf), .Inherit = Inherit, .ReleaseTime = ReleaseTime, .Branch = Branch})
+ ' Catch ex As Exception
+ ' Throw New Exception("版本信息提取失败（" & VersionCode & "）", ex)
+ ' End Try
+ 'Catch ex As Exception
+ ' Throw New Exception("版本列表解析失败（" & Result & "）", ex)
+ 'End Try
+ If Not Versions.Any() Then Throw New Exception("没有可用版本")
+ Loader.Output = Versions
+ End Sub
+
+ '''
+ ''' NeoForge 版本列表，BMCLAPI。
+ '''
+ Public Sub DlNeoForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)))
+ Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/neoforge/list/" & Loader.Input, IsJson:=True)
+ Dim Versions As New List(Of DlNeoForgeVersionEntry)
+ Try
+ For Each Token As JObject In Json
+ Dim Name As String = Token("version")
+ Dim Inherit As String = Token("mcversion")
+ Dim Entry = New DlNeoForgeVersionEntry With {.Version = Name, .Inherit = Inherit}
+ Versions.Add(Entry)
+ Next
+ 'For Each Token As JObject In Json
+ ' '分类与 Hash 获取
+ ' Dim Hash As String = Nothing, Category As String = "unknown", Proi As Integer = -1
+ ' For Each File As JObject In Token("files")
+ ' Select Case File("category").ToString
+ ' Case "installer"
+ ' If File("format").ToString = "jar" Then
+ ' '类型为 installer.jar，支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部)
+ ' Hash = File("hash")
+ ' Category = "installer"
+ ' Proi = 2
+ ' End If
+ ' Case "universal"
+ ' If Proi <= 1 AndAlso File("format").ToString = "zip" Then
+ ' '类型为 universal.zip，支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分)
+ ' Hash = File("hash")
+ ' Category = "universal"
+ ' Proi = 1
+ ' End If
+ ' Case "client"
+ ' If Proi <= 0 AndAlso File("format").ToString = "zip" Then
+ ' '类型为 client.zip，支持范围 182~ (1.3.2 部分 ~)
+ ' Hash = File("hash")
+ ' Category = "client"
+ ' Proi = 0
+ ' End If
+ ' End Select
+ ' Next
+ ' '获取 Entry
+ ' Dim Inherit As String = Loader.Input
+ ' Dim Branch As String = Token("branch")
+ ' Dim Name As String = Token("version")
+ ' '基础信息获取
+ ' Dim Entry = New DlNeoForgeVersionEntry With {.Hash = Hash, .Category = Category, .Version = Name, .Branch = Branch, .Inherit = Inherit}
+ ' Dim TimeSplit = Token("modified").ToString.Split("-"c, "T"c, ":"c, "."c, " "c, "/"c)
+ ' Entry.ReleaseTime = Token("modified").ToObject(Of Date).ToLocalTime.ToString("yyyy'/'MM'/'dd HH':'mm")
+ ' '添加项
+ ' Versions.Add(Entry)
+ 'Next
+ Catch ex As Exception
+ Throw New Exception("版本列表解析失败（" & Json.ToString & "）", ex)
+ End Try
+ If Not Versions.Any() Then Throw New Exception("没有可用版本")
+ Loader.Output = Versions
+ End Sub
+
+#End Region
+
#Region "DlLiteLoaderList | LiteLoader 版本列表"
Public Structure DlLiteLoaderListResult
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
index 3b02dc6..6f6a331 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+++ b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
@@ -1696,6 +1696,630 @@ Retry:
#End Region
+#Region "NeoForge 下载"
+
+ Public Sub McDownloadNeoForge(DownloadInfo As DlNeoForgeVersionEntry)
+ '老版本提示
+ If DownloadInfo.Category = "client" Then
+ If MyMsgBox("该 Forge 版本过于古老，PCL 暂不支持该版本的自动安装。" & vbCrLf &
+ "若你仍然希望继续，PCL 将把安装程序下载到你指定的位置，但不会进行安装。",
+ "版本过老", "继续", "取消") = 1 Then
+ McDownloadNeoForgeSave(DownloadInfo)
+ End If
+ Exit Sub
+ End If
+ If DownloadInfo.Category = "universal" OrElse DownloadInfo.Inherit.StartsWithF("1.5") Then '对该版本自动安装的支持将在之后加入
+ If MyMsgBox("该 Forge 版本过于古老，PCL 暂不支持该版本的自动安装。" & vbCrLf &
+ "若你仍然希望继续，PCL 将把安装程序下载到你指定的位置，但不会进行安装。",
+ "版本过老", "继续", "取消") = 1 Then
+ McDownloadNeoForgeSave(DownloadInfo)
+ End If
+ Exit Sub
+ End If
+ '初始化参数
+ Dim Id As String = DownloadInfo.Inherit & "-neoforge-" & DownloadInfo.Version
+ Dim Target As String = PathTemp & "Cache\Code\NeoForgeInstall-" & DownloadInfo.Version & "_" & GetUuid() & "." & DownloadInfo.FileSuffix
+ Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\"
+ Dim DisplayName As String = "Forge " & DownloadInfo.Inherit & " - " & DownloadInfo.Version
+ Try
+
+ '重复任务检查
+ SyncLock LoaderTaskbarLock
+ For i = 0 To LoaderTaskbar.Count - 1
+ If LoaderTaskbar(i).Name = DisplayName & " 下载" Then
+ Hint("该版本正在下载中！", HintType.Critical)
+ Exit Sub
+ End If
+ Next
+ End SyncLock
+
+ '已有版本检查
+ If File.Exists(VersionFolder & Id & ".json") Then
+ If MyMsgBox("版本 " & Id & " 已存在，是否重新下载？" & vbCrLf & "这会覆盖版本的 json 和 jar 文件，但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
+ File.Delete(VersionFolder & Id & ".jar")
+ File.Delete(VersionFolder & Id & ".json")
+ Else
+ Exit Sub
+ End If
+ End If
+
+ '启动
+ Dim Loader As New LoaderCombo(Of String)(DisplayName & " 下载", McDownloadNeoForgeLoader(DownloadInfo.Version, DownloadInfo.Inherit, DownloadInfo)) With {.OnStateChanged = AddressOf McInstallState}
+ Loader.Start(VersionFolder)
+ LoaderTaskbarAdd(Loader)
+ FrmMain.BtnExtraDownload.ShowRefresh()
+ FrmMain.BtnExtraDownload.Ribble()
+
+ Catch ex As Exception
+ Log(ex, "开始 NeoForge 下载失败", LogLevel.Feedback)
+ Finally
+ '删除安装包
+ Try
+ If File.Exists(Target) Then File.Delete(Target)
+ Catch
+ End Try
+ End Try
+ End Sub
+ Public Sub McDownloadNeoForgeSave(DownloadInfo As DlNeoForgeVersionEntry)
+ Try
+ Dim Target As String = SelectAs("选择保存位置", DownloadInfo.FileName, "NeoForge 文件 (*." & DownloadInfo.FileSuffix & ")|*." & DownloadInfo.FileSuffix)
+ Dim DisplayName As String = "Forge " & DownloadInfo.Inherit & " - " & DownloadInfo.Version
+ If Not Target.Contains("\") Then Exit Sub
+
+ '重复任务检查
+ SyncLock LoaderTaskbarLock
+ For i = 0 To LoaderTaskbar.Count - 1
+ If LoaderTaskbar(i).Name = DisplayName & " 下载" Then
+ Hint("该版本正在下载中！", HintType.Critical)
+ Exit Sub
+ End If
+ Next
+ End SyncLock
+
+ '构造步骤加载器
+ Dim Loaders As New List(Of LoaderBase)
+ '获取下载地址
+ Loaders.Add(New LoaderTask(Of DlForgeVersionEntry, List(Of NetFile))("获取下载地址",
+ Sub(Task As LoaderTask(Of DlForgeVersionEntry, List(Of NetFile)))
+ Dim Files As New List(Of NetFile)
+ Files.Add(New NetFile({
+ "https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & DownloadInfo.Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName,
+ "https://files.minecraftforge.net/maven/net/minecraftforge/forge/" & DownloadInfo.Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName
+ }, Target, New FileChecker(MinSize:=64 * 1024, Hash:=DownloadInfo.Hash)))
+ Task.Output = Files
+ End Sub) With {.ProgressWeight = 0.1, .Show = False})
+ '下载
+ Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile)) With {.ProgressWeight = 6})
+
+ '启动
+ Dim Loader As New LoaderCombo(Of DlForgeVersionEntry)(DisplayName & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
+ Loader.Start(DownloadInfo)
+ LoaderTaskbarAdd(Loader)
+ FrmMain.BtnExtraDownload.ShowRefresh()
+ FrmMain.BtnExtraDownload.Ribble()
+
+ Catch ex As Exception
+ Log(ex, "开始 NeoForge 下载失败", LogLevel.Feedback)
+ End Try
+ End Sub
+
+ Private Sub NeoForgeInjector(Target As String, Task As LoaderTask(Of Boolean, Boolean), McFolder As String, UseJavaWrapper As Boolean)
+ '选择 Java
+ Dim Java As JavaEntry
+ SyncLock JavaLock
+ Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60))
+ If Java Is Nothing Then
+ If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java，已取消安装。")
+ '开始自动下载
+ Dim JavaLoader = JavaFixLoaders(17)
+ Try
+ JavaLoader.Start(17, IsForceRestart:=True)
+ Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted
+ Thread.Sleep(10)
+ Loop
+ Finally
+ JavaLoader.Abort() '确保取消时中止 Java 下载
+ End Try
+ '检查下载结果
+ Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60))
+ If Task.IsAborted Then Exit Sub
+ If Java Is Nothing Then Throw New Exception("由于未找到 Java，已取消安装。")
+ End If
+ End SyncLock
+ '添加 Java Wrapper 作为主 Jar
+ Dim Arguments As String
+ If UseJavaWrapper Then
+ Arguments = $"-Doolloo.jlw.tmpdir=""{GetJavaWrapperDir()}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractJavaWrapper()}"" com.bangbang93.ForgeInstaller ""{McFolder}"
+ Else
+ Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}"
+ End If
+ If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
+ '开始启动
+ SyncLock InstallSyncLock
+ Dim Info = New ProcessStartInfo With {
+ .FileName = Java.PathJavaw,
+ .Arguments = Arguments,
+ .UseShellExecute = False,
+ .CreateNoWindow = True,
+ .RedirectStandardError = True,
+ .RedirectStandardOutput = True
+ }
+ Log("[Download] 开始安装 NeoForge：" & Arguments)
+ Dim process As New Process With {.StartInfo = Info}
+ Dim LastResults As New Queue(Of String)
+ Using outputWaitHandle As New AutoResetEvent(False)
+ Using errorWaitHandle As New AutoResetEvent(False)
+ AddHandler process.OutputDataReceived,
+ Function(sender, e)
+ Try
+ If e.Data Is Nothing Then
+ outputWaitHandle.[Set]()
+ Else
+ LastResults.Enqueue(e.Data)
+ If LastResults.Count > 100 Then LastResults.Dequeue()
+ NeoForgeInjectorLine(e.Data, Task)
+ End If
+ Catch ex As ObjectDisposedException
+ Catch ex As Exception
+ Log(ex, "读取 NeoForge 安装器信息失败")
+ End Try
+ Try
+ If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then
+ Log("[Installer] 由于任务取消，已中止 NeoForge 安装")
+ process.Kill()
+ End If
+ Catch
+ End Try
+ Return Nothing
+ End Function
+ AddHandler process.ErrorDataReceived,
+ Function(sender, e)
+ Try
+ If e.Data Is Nothing Then
+ errorWaitHandle.[Set]()
+ Else
+ LastResults.Enqueue(e.Data)
+ If LastResults.Count > 100 Then LastResults.Dequeue()
+ ForgeInjectorLine(e.Data, Task)
+ End If
+ Catch ex As ObjectDisposedException
+ Catch ex As Exception
+ Log(ex, "读取 Forge 安装器错误信息失败")
+ End Try
+ Try
+ If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then
+ Log("[Installer] 由于任务取消，已中止 Forge 安装")
+ process.Kill()
+ End If
+ Catch
+ End Try
+ Return Nothing
+ End Function
+ process.Start()
+ process.BeginOutputReadLine()
+ process.BeginErrorReadLine()
+ '等待
+ Do Until process.HasExited
+ Thread.Sleep(10)
+ Loop
+ '输出
+ outputWaitHandle.WaitOne(10000)
+ errorWaitHandle.WaitOne(10000)
+ process.Dispose()
+ '检查是否安装成功：最后两行中是否有 true（true 可能在倒数第二行，见 #832）
+ If LastResults.Last = "true" OrElse (LastResults.Count >= 2 AndAlso LastResults(LastResults.Count - 2) = "true") Then Exit Sub
+ Log(Join(LastResults, vbCrLf))
+ Dim LastLines As String = ""
+ For i As Integer = Math.Max(0, LastResults.Count - 5) To LastResults.Count - 1 '最后 5 行
+ LastLines &= vbCrLf & LastResults(i)
+ Next
+ Throw New Exception("Forge 安装器出错，日志结束部分为：" & LastLines)
+ End Using
+ End Using
+ End SyncLock
+ End Sub
+ Private Sub NeoForgeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean))
+ If Content.StartsWithF(" Data") OrElse Content.StartsWithF(" Slim") Then
+ If ModeDebug Then Log("[Installer] " & Content)
+ ElseIf Content.StartsWithF(" Reading patch ") Then
+ If ModeDebug Then Log("[Installer] " & Content)
+ Task.Progress = 0.86
+ Else
+ Select Case Content
+ Case "Extracting json"
+ Log("[Installer] " & Content)
+ Task.Progress = 0.07
+ Case "Downloading libraries"
+ Log("[Installer] " & Content)
+ Task.Progress = 0.08
+ Case " File exists: Checksum validated."
+ If ModeDebug Then Log("[Installer] " & Content)
+ Task.Progress += 0.003
+ Case "Building Processors"
+ Task.Progress = 0.38
+ Case "Task: DOWNLOAD_MOJMAPS" 'B
+ Task.Progress = 0.4
+ Case "Task: MERGE_MAPPING" 'B
+ Task.Progress = 0.6
+ Case "Splitting: "
+ Task.Progress = 0.62
+ Case "Parameter Annotations" 'B
+ Task.Progress = 0.66
+ Case "Processing Complete" 'B
+ Task.Progress = 0.7
+ Case "Remapping final jar" 'A
+ Task.Progress = 0.72
+ Case "Remapping jar... 50%" 'A
+ Task.Progress = 0.76
+ Case "Remapping jar... 100%" 'A
+ Task.Progress = 0.81
+ Case "Injecting profile"
+ Task.Progress = 0.91
+ Case Else
+ If ModeDebug Then Log("[Installer] " & Content)
+ Exit Sub
+ End Select
+ Log("[Installer] " & Content)
+ End If
+ End Sub
+
+ '''
+ ''' 获取下载某个 NeoForge 版本的加载器列表。
+ '''
+ Private Function McDownloadNeoForgeLoader(Version As String, Inherit As String, Optional DownloadInfo As DlNeoForgeVersionEntry = Nothing, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional ClientFolder As String = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase)
+
+ '参数初始化
+ McFolder = If(McFolder, PathMcFolder)
+ If Version.StartsWithF("1.") AndAlso Version.Contains("-") Then
+ '类似 1.19.3-41.2.8 格式，优先使用 Version 中要求的版本而非 Inherit（例如 1.19.3 却使用了 1.19 的 Forge）
+ Inherit = Version.Before("-")
+ Version = Version.After("-")
+ End If
+ Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder
+ Dim Id As String = Inherit & "-forge-" & Version
+ Dim InstallerAddress As String = PathTemp & "Cache\Code\NeoForgeInstall-" & Version & "_" & RandomInteger(0, 100000)
+ Dim VersionFolder As String = McFolder & "versions\" & Id & "\"
+ Dim DisplayName As String = "Forge " & Inherit & " - " & Version
+ Dim Loaders As New List(Of LoaderBase)
+ Dim LibVersionFolder As String = PathMcFolder & "versions\" & Id & "\" '作为 Lib 文件目标的版本文件夹
+
+ '获取下载信息
+ If DownloadInfo Is Nothing Then
+ Loaders.Add(New LoaderTask(Of String, String)("获取 Mod 加载器详细信息",
+ Sub(Task As LoaderTask(Of String, String))
+ '获取 Forge 版本列表
+ Dim NeoForgeLoader = New LoaderTask(Of String, List(Of DlNeoForgeVersionEntry))("McDownloadNeoForgeLoader " & Inherit, AddressOf DlNeoForgeVersionMain)
+ NeoForgeLoader.WaitForExit(Inherit)
+ Task.Progress = 0.8
+ '查找对应版本
+ For Each NeoForgeVersion In NeoForgeLoader.Output
+ If NeoForgeVersion.Version = Version Then
+ DownloadInfo = NeoForgeVersion
+ Exit Sub
+ End If
+ Next
+ Throw New Exception("未能找到 NeoForge " & Inherit & "-" & Version & " 的详细信息！")
+ End Sub) With {.ProgressWeight = 3})
+ End If
+ '下载 Forge 主文件
+ Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("准备 Mod 加载器下载",
+ Sub(Task As LoaderTask(Of String, List(Of NetFile)))
+ '启动依赖版本的下载
+ If ClientDownloadLoader Is Nothing Then
+ If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器，则不能指定 MC 安装文件夹")
+ ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, Inherit)
+ End If
+ '添加主文件
+ Dim Files As New List(Of NetFile) From {New NetFile({
+ "https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName,
+ "https://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName
+ }, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=DownloadInfo.Hash))}
+ Task.Output = Files
+ End Sub) With {.ProgressWeight = 0.5, .Show = False})
+ Loaders.Add(New LoaderDownload("下载 Mod 加载器主文件", New List(Of NetFile)) With {.ProgressWeight = 9})
+
+ '安装（仅在新版安装时需要原版 Jar）
+ If Version.Before(".") >= 20 Then
+ Log("[Download] 检测为新版 NeoForge：" & Version)
+ Dim Libs As List(Of McLibToken) = Nothing
+ Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件",
+ Sub(Task As LoaderTask(Of String, List(Of NetFile)))
+ Task.Output = New List(Of NetFile)
+ Dim Installer As ZipArchive = Nothing
+ Try
+ '解压并获取、合并两个 Json 的信息
+ Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
+ Task.Progress = 0.2
+ Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
+ Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open))
+ Json.Merge(Json2)
+ '获取 Lib 下载信息
+ Libs = McLibListGetWithJson(Json, True)
+ '添加 Mappings 下载信息
+ If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
+ '下载原版 Json 文件
+ Task.Progress = 0.4
+ Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
+ '[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
+ Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Before("@")
+ Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
+ Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
+ .Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")})
+ Log("[Download] 需要下载 Mappings：" & Address)
+ End If
+ Task.Progress = 0.8
+ '去除其中的原始 Forge 项
+ For i = 0 To Libs.Count - 1
+ If Libs(i).LocalPath.EndsWithF("forge-" & Inherit & "-" & Version & ".jar") OrElse
+ Libs(i).LocalPath.EndsWithF("forge-" & Inherit & "-" & Version & "-client.jar") Then
+ Log("[Download] 已从待下载 Forge 支持库中移除：" & Libs(i).LocalPath, LogLevel.Debug)
+ Libs.RemoveAt(i)
+ Exit For
+ End If
+ Next
+ Task.Output = McLibFixFromLibToken(Libs, PathMcFolder)
+ Catch ex As Exception
+ Throw New Exception("获取新版 Forge 支持库列表失败", ex)
+ Finally
+ '释放文件
+ If Installer IsNot Nothing Then Installer.Dispose()
+ End Try
+ End Sub) With {.ProgressWeight = 2})
+ Loaders.Add(New LoaderDownload("下载 Mod 加载器支持库文件", New List(Of NetFile)) With {.ProgressWeight = 12})
+ Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("获取 Mod 下载器支持库文件",
+ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
+#Region "Forge 文件"
+ If IsCustomFolder Then
+ For Each LibFile As McLibToken In Libs
+ Dim RealPath As String = LibFile.LocalPath.Replace(PathMcFolder, McFolder)
+ If Not File.Exists(RealPath) Then
+ Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath))
+ CopyFile(LibFile.LocalPath, RealPath)
+ End If
+ If ModeDebug Then Log("[Download] 复制的 Forge 支持库文件：" & LibFile.LocalPath)
+ Next
+ End If
+#End Region
+#Region "原版文件"
+ '等待原版文件下载完成
+ If ClientDownloadLoader Is Nothing Then Exit Sub
+ Dim TargetLoaders As List(Of LoaderBase) =
+ ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
+ Where(Function(l) l.State <> LoadState.Finished).ToList
+ If TargetLoaders.Any Then Log("[Download] Forge 安装正在等待原版文件下载完成")
+ Do While TargetLoaders.Any AndAlso Not Task.IsAborted
+ TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
+ Thread.Sleep(50)
+ Loop
+ If Task.IsAborted Then Exit Sub
+ '拷贝原版文件
+ If Not IsCustomFolder Then Exit Sub
+ SyncLock VanillaSyncLock
+ Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
+ Directory.CreateDirectory(McFolder & "versions\" & Inherit)
+ If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
+ CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
+ End If
+ If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
+ CopyFile(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
+ End If
+ End SyncLock
+#End Region
+ End Sub) With {.ProgressWeight = 0.1, .Show = False})
+ Loaders.Add(New LoaderTask(Of Boolean, Boolean)("安装 Mod 加载器（方式 A）",
+ Sub(Task As LoaderTask(Of Boolean, Boolean))
+ Dim Installer As ZipArchive = Nothing
+ Try
+ Log("[Download] 开始进行新版方式 Forge 安装：" & InstallerAddress)
+ '记录当前文件夹列表（在新建目标文件夹之前）
+ Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
+ Select(Function(i) i.FullName).ToList()
+ '解压并获取信息
+ Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
+ Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
+ '新建目标版本文件夹
+ Directory.CreateDirectory(VersionFolder)
+ Task.Progress = 0.04
+ '释放 launcher_installer.json
+ McFolderLauncherProfilesJsonCreate(McFolder)
+ Task.Progress = 0.05
+ '运行 Forge 安装器
+ Dim UseJavaWrapper As Boolean = True
+Retry:
+ Try
+ '释放 Forge 注入器
+ WriteFile(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
+ Task.Progress = 0.06
+ '运行注入器
+ ForgeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper)
+ Task.Progress = 0.97
+ Catch ex As Exception
+ If UseJavaWrapper Then
+ Log(ex, "使用 JavaWrapper 安装 Forge 失败，将不使用 JavaWrapper 并重试")
+ UseJavaWrapper = False
+ GoTo Retry
+ Else
+ Throw New Exception("运行 Forge 安装器失败", ex)
+ End If
+ End Try
+ '拷贝新增的版本 Json
+ Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
+ SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
+ If DeltaList.Count > 1 Then
+ '它可能和 OptiFine 安装同时运行，导致增加的文件不止一个（这导致了 #151）
+ '也可能是因为 Forge 安装器的 Bug，生成了一个名字错误的文件夹，所以需要检查文件夹是否为空
+ DeltaList = DeltaList.Where(Function(l) l.Name.Contains("forge") AndAlso l.EnumerateFiles.Any).ToList
+ End If
+ If DeltaList.Count = 1 Then '如果没有新增文件夹，那么预测的文件夹名就是正确的
+ Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
+ WriteFile(VersionFolder & Id & ".json", ReadFile(JsonFile.FullName))
+ End If
+ '新建 mods 文件夹
+ Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
+ Catch ex As Exception
+ Throw New Exception("安装新 Forge 版本失败", ex)
+ Finally
+ '清理文件
+ Try
+ If Installer IsNot Nothing Then Installer.Dispose()
+ If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
+ Catch ex As Exception
+ Log(ex, "安装 Forge 清理文件时出错")
+ End Try
+ End Try
+ End Sub) With {.ProgressWeight = 10})
+ Else
+ Log("[Download] 检测为非新版 Forge：" & Version)
+ Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 Mod 加载器（方式 B）",
+ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
+ Dim Installer As ZipArchive = Nothing
+ Try
+ '解压并获取信息
+ Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
+ Task.Progress = 0.2
+ Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
+ Task.Progress = 0.4
+ '新建版本文件夹
+ Directory.CreateDirectory(VersionFolder)
+ Task.Progress = 0.5
+ If Json("install") Is Nothing Then
+ '中版格式
+ Log("[Download] 进行中版方式安装：" & InstallerAddress)
+ '建立 Json 文件
+ Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
+ JsonVersion("id") = Id
+ WriteFile(VersionFolder & Id & ".json", JsonVersion.ToString)
+ Task.Progress = 0.6
+ '解压支持库文件
+ Installer.Dispose()
+ ExtractFile(InstallerAddress, InstallerAddress & "_unrar\")
+ CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
+ DeleteDirectory(InstallerAddress & "_unrar\")
+ Else
+ '旧版格式
+ Log("[Download] 进行旧版方式安装：" & InstallerAddress)
+ '解压 Jar 文件
+ Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
+ If File.Exists(JarAddress) Then File.Delete(JarAddress)
+ WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
+ Task.Progress = 0.9
+ '建立 Json 文件
+ Json("versionInfo")("id") = Id
+ If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit)
+ WriteFile(VersionFolder & Id & ".json", Json("versionInfo").ToString)
+ End If
+ '新建 mods 文件夹
+ Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
+ Catch ex As Exception
+ Throw New Exception("非新版方式安装 Forge 失败", ex)
+ Finally
+ Try
+ '清理文件
+ If Installer IsNot Nothing Then Installer.Dispose()
+ If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
+ If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
+ Catch ex As Exception
+ Log(ex, "非新版方式安装 Forge 清理文件时出错")
+ End Try
+ End Try
+ End Sub) With {.ProgressWeight = 1})
+ If FixLibrary Then
+ If IsCustomFolder Then Throw New Exception("若需要补全支持库，就不能自定义 MC 文件夹")
+ Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
+ Loaders.Add(New LoaderDownload("下载 Mod 加载器支持库文件", New List(Of NetFile)) With {.ProgressWeight = 11})
+ End If
+ End If
+
+ Return Loaders
+ End Function
+
+#End Region
+
+#Region "NeoForge 下载菜单"
+
+ Public Sub NeoForgeDownloadListItemPreload(Stack As StackPanel, Entrys As List(Of DlNeoForgeVersionEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean)
+ '获取最新版本
+ Dim FreshVersion As DlNeoForgeVersionEntry = Nothing
+ If Entrys.Any Then
+ FreshVersion = Entrys(0)
+ Else
+ Log("[System] 未找到可用的 NeoForge 版本", LogLevel.Debug)
+ End If
+ Dim RecommendedVersion As DlNeoForgeVersionEntry = Nothing
+ '显示各个版本
+ If FreshVersion IsNot Nothing Then
+ Dim Fresh = NeoForgeDownloadListItem(FreshVersion, OnClick, IsSaveOnly)
+ Fresh.Info = "最新版" & If(Fresh.Info = "", "", "，" & Fresh.Info)
+ Stack.Children.Add(Fresh)
+ End If
+ '添加间隔
+ Stack.Children.Add(New TextBlock With {.Text = "全部版本 (" & Entrys.Count & ")", .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 13, 0, 4)})
+ End Sub
+ Public Function NeoForgeDownloadListItem(Entry As DlNeoForgeVersionEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem
+ '建立控件
+ Dim NewItem As New MyListItem With {
+ .Title = Entry.Version, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
+ .Info = If(Entry.ReleaseTime = "",
+ If(ModeDebug, "种类：" & Entry.Category & If(Entry.Branch Is Nothing, "", "，开发分支：" & Entry.Branch), ""),
+ "发布于 " & Entry.ReleaseTime & If(ModeDebug, "，种类：" & Entry.Category & If(Entry.Branch Is Nothing, "", "，开发分支：" & Entry.Branch), "")),
+ .Logo = PathImage & "Blocks/Anvil.png"
+ }
+ AddHandler NewItem.Click, OnClick
+ '建立菜单
+ If IsSaveOnly Then
+ NewItem.ContentHandler = AddressOf NeoForgeSaveContMenuBuild
+ Else
+ NewItem.ContentHandler = AddressOf NeoForgeContMenuBuild
+ End If
+ '结束
+ Return NewItem
+ End Function
+ Private Sub NeoForgeContMenuBuild(sender As MyListItem, e As EventArgs)
+ Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
+ ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
+ ToolTipService.SetVerticalOffset(BtnSave, 30)
+ ToolTipService.SetHorizontalOffset(BtnSave, 2)
+ AddHandler BtnSave.Click, AddressOf NeoForgeSave_Click
+ Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"}
+ ToolTipService.SetPlacement(BtnInfo, Primitives.PlacementMode.Center)
+ ToolTipService.SetVerticalOffset(BtnInfo, 30)
+ ToolTipService.SetHorizontalOffset(BtnInfo, 2)
+ AddHandler BtnInfo.Click, AddressOf NeoForgeLog_Click
+ sender.Buttons = {BtnSave, BtnInfo}
+ End Sub
+ Private Sub NeoForgeSaveContMenuBuild(sender As MyListItem, e As EventArgs)
+ Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"}
+ ToolTipService.SetPlacement(BtnInfo, Primitives.PlacementMode.Center)
+ ToolTipService.SetVerticalOffset(BtnInfo, 30)
+ ToolTipService.SetHorizontalOffset(BtnInfo, 2)
+ AddHandler BtnInfo.Click, AddressOf NeoForgeLog_Click
+ sender.Buttons = {BtnInfo}
+ End Sub
+ Private Sub NeoForgeLog_Click(sender As Object, e As RoutedEventArgs)
+ Dim Version As DlForgeVersionEntry
+ If sender.Tag IsNot Nothing Then
+ Version = sender.Tag
+ ElseIf sender.Parent.Tag IsNot Nothing Then
+ Version = sender.Parent.Tag
+ Else
+ Version = sender.Parent.Parent.Tag
+ End If
+ OpenWebsite("https://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Version.Inherit & "-" & Version.Version & "/forge-" & Version.Inherit & "-" & Version.Version & "-changelog.txt")
+ End Sub
+ Public Sub NeoForgeSave_Click(sender As Object, e As RoutedEventArgs)
+ Dim Version As DlForgeVersionEntry
+ If sender.Tag IsNot Nothing Then
+ Version = sender.Tag
+ ElseIf sender.Parent.Tag IsNot Nothing Then
+ Version = sender.Parent.Tag
+ Else
+ Version = sender.Parent.Parent.Tag
+ End If
+ McDownloadForgeSave(Version)
+ End Sub
+
+#End Region
+
#Region "Fabric 下载"
Public Sub McDownloadFabricLoaderSave(DownloadInfo As JObject)
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml
index b6b6dc5..69c47f3 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml
+++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml
@@ -79,6 +79,24 @@
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -178,6 +196,7 @@
+
diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
index d7ef0bc..f703ef4 100644
--- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
+++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
@@ -51,6 +51,7 @@
CardOptiFine.IsSwaped = True
CardLiteLoader.IsSwaped = True
CardForge.IsSwaped = True
+ CardNeoForge.IsSwaped = True
CardFabric.IsSwaped = True
CardFabricApi.IsSwaped = True
CardOptiFabric.IsSwaped = True
@@ -73,6 +74,13 @@
ForgeLoader.Start(SelectedMinecraftId)
End If
+ '启动 NeoForge 加载
+ If SelectedMinecraftId.StartsWith("1.") Then
+ Dim NeoForgeLoader = New LoaderTask(Of String, List(Of DlNeoForgeVersionEntry))("DlNeoForgeVersion " & SelectedMinecraftId, AddressOf DlNeoForgeVersionMain)
+ LoadNeoForge.State = NeoForgeLoader
+ NeoForgeLoader.Start(SelectedMinecraftId)
+ End If
+
'启动 Fabric API、OptiFabric 加载
DlFabricApiLoader.Start()
DlOptiFabricLoader.Start()
@@ -86,6 +94,7 @@
OptiFine_Loaded()
LiteLoader_Loaded()
Forge_Loaded()
+ NeoForge_Loaded()
Fabric_Loaded()
FabricApi_Loaded()
OptiFabric_Loaded()
@@ -102,6 +111,7 @@
BtnOptiFineClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFine.MainTextBlock, .Mode = BindingMode.OneWay})
BtnLiteLoaderClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardLiteLoader.MainTextBlock, .Mode = BindingMode.OneWay})
BtnForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardForge.MainTextBlock, .Mode = BindingMode.OneWay})
+ BtnNeoForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardNeoForge.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabric.MainTextBlock, .Mode = BindingMode.OneWay})
BtnFabricApiClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabricApi.MainTextBlock, .Mode = BindingMode.OneWay})
BtnOptiFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFabric.MainTextBlock, .Mode = BindingMode.OneWay})
@@ -213,6 +223,26 @@
End If
End Sub
+ 'NeoForge
+ Private SelectedNeoForge As DlNeoForgeVersionEntry = Nothing
+ Private Sub SetNeoForgeInfoShow(IsShow As String)
+ If PanNeoForgeInfo.Tag = IsShow Then Exit Sub
+ PanNeoForgeInfo.Tag = IsShow
+ If IsShow = "True" Then
+ '显示信息栏
+ AniStart({
+ AaTranslateY(PanNeoForgeInfo, -CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 270, 100, Ease:=New AniEaseOutBack),
+ AaOpacity(PanNeoForgeInfo, 1 - PanNeoForgeInfo.Opacity, 100, 90)
+ }, "SetNeoForgeInfoShow")
+ Else
+ '隐藏信息栏
+ AniStart({
+ AaTranslateY(PanNeoForgeInfo, 6 - CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 200),
+ AaOpacity(PanNeoForgeInfo, -PanNeoForgeInfo.Opacity, 100)
+ }, "SetNeoForgeInfoShow")
+ End If
+ End Sub
+
'Fabric
Private SelectedFabric As String = Nothing
Private Sub SetFabricInfoShow(IsShow As String)
@@ -277,7 +307,7 @@
'''
''' 重载已选择的项目的显示。
'''
- Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
+ Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardNeoForge.Swap, LoadNeoForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
If SelectedMinecraftId Is Nothing OrElse IsReloading Then Exit Sub
IsReloading = True
'主预览
@@ -341,6 +371,22 @@
LabForge.Text = SelectedForge.Version
LabForge.Foreground = ColorGray1
End If
+ 'NeoForge
+ Dim NeoForgeError As String = LoadNeoForgeGetError()
+ CardNeoForge.MainSwap.Visibility = If(NeoForgeError Is Nothing, Visibility.Visible, Visibility.Collapsed)
+ If NeoForgeError IsNot Nothing Then CardNeoForge.IsSwaped = True
+ SetNeoForgeInfoShow(CardNeoForge.IsSwaped)
+ If SelectedNeoForge Is Nothing Then
+ BtnNeoForgeClear.Visibility = Visibility.Collapsed
+ ImgNeoForge.Visibility = Visibility.Collapsed
+ LabNeoForge.Text = If(NeoForgeError, "点击选择")
+ LabNeoForge.Foreground = ColorGray4
+ Else
+ BtnNeoForgeClear.Visibility = Visibility.Visible
+ ImgNeoForge.Visibility = Visibility.Visible
+ LabNeoForge.Text = SelectedNeoForge.Version
+ LabNeoForge.Foreground = ColorGray1
+ End If
'Fabric
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) <= 13 Then
CardFabric.Visibility = Visibility.Collapsed
@@ -434,6 +480,7 @@
SelectedOptiFine = Nothing
SelectedLiteLoader = Nothing
SelectedForge = Nothing
+ SelectedNeoForge = Nothing
SelectedFabric = Nothing
SelectedFabricApi = Nothing
SelectedOptiFabric = Nothing
@@ -451,6 +498,9 @@
If SelectedForge IsNot Nothing Then
Name += "-Forge_" & SelectedForge.Version
End If
+ If SelectedNeoForge IsNot Nothing Then
+ Name += "-NeoForge_" & SelectedNeoForge.Version
+ End If
If SelectedLiteLoader IsNot Nothing Then
Name += "-LiteLoader"
End If
@@ -470,6 +520,9 @@
If SelectedForge IsNot Nothing Then
Info += ", Forge " & SelectedForge.Version
End If
+ If SelectedNeoForge IsNot Nothing Then
+ Info += ", NeoForge " & SelectedNeoForge.Version
+ End If
If SelectedLiteLoader IsNot Nothing Then
Info += ", LiteLoader"
End If
@@ -487,6 +540,8 @@
Return "pack://application:,,,/images/Blocks/Fabric.png"
ElseIf SelectedForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Anvil.png"
+ ElseIf SelectedNeoForge IsNot Nothing Then
+ Return "pack://application:,,,/images/Blocks/Anvil.png"
ElseIf SelectedLiteLoader IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Egg.png"
ElseIf SelectedOptiFine IsNot Nothing Then
@@ -706,6 +761,7 @@
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, SelectedForge) Then SelectedForge = Nothing
OptiFabric_Loaded()
Forge_Loaded()
+ NeoForge_Loaded()
CardOptiFine.IsSwaped = True
SelectReload()
End Sub
@@ -715,6 +771,7 @@
CardOptiFine.IsSwaped = True
e.Handled = True
Forge_Loaded()
+ NeoForge_Loaded()
SelectReload()
End Sub
@@ -866,6 +923,81 @@
#End Region
+#Region "NeoForge 列表"
+
+ '''
+ ''' 获取 NeoForge 的加载异常信息。若正常则返回 Nothing。
+ '''
+ Private Function LoadNeoForgeGetError() As String
+ If Not SelectedMinecraftId.StartsWith("1.") Then Return "没有可用版本"
+ If Not LoadNeoForge.State.IsLoader Then Return "正在获取版本列表……"
+ Dim Loader As LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)) = LoadNeoForge.State
+ If SelectedMinecraftId <> Loader.Input Then Return "正在获取版本列表……"
+ If Loader.State = LoadState.Loading Then Return "正在获取版本列表……"
+ If Loader.State = LoadState.Failed Then
+ Dim ErrorMessage As String = Loader.Error.Message
+ If ErrorMessage.Contains("没有可用版本") Then
+ Return "没有可用版本"
+ Else
+ Return "获取版本列表失败：" & ErrorMessage
+ End If
+ End If
+ If Loader.State <> LoadState.Finished Then Return "获取版本列表失败：未知错误，状态为 " & GetStringFromEnum(Loader.State)
+ For Each Version In Loader.Output
+ If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本
+ If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
+ Return Nothing
+ Next
+ Return False
+ End Function
+
+ '限制展开
+ Private Sub CardNeoForge_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardNeoForge.PreviewSwap
+ If LoadNeoForgeGetError() IsNot Nothing Then e.Handled = True
+ End Sub
+
+ '''
+ ''' 尝试重新可视化 NeoForge 版本列表。
+ '''
+ Private Sub NeoForge_Loaded() Handles LoadForge.StateChanged
+ Try
+ If Not LoadNeoForge.State.IsLoader Then Exit Sub
+ Dim Loader As LoaderTask(Of String, List(Of DlNeoForgeVersionEntry)) = LoadNeoForge.State
+ If SelectedMinecraftId <> Loader.Input Then Exit Sub
+ If Loader.State <> LoadState.Finished Then Exit Sub
+ '获取要显示的版本
+ Dim Versions As New List(Of DlNeoForgeVersionEntry)
+ Versions.AddRange(Loader.Output) '复制数组，以免 Output 在实例化后变空
+ If Not Loader.Output.Any() Then Exit Sub
+ PanNeoForge.Children.Clear()
+
+ 'Versions = Sort(Versions, Function(a, b) New Version(a.Version) > New Version(b.Version)).ToList
+ NeoForgeDownloadListItemPreload(PanNeoForge, Versions, AddressOf NeoForge_Selected, False)
+ For Each Version In Versions
+ PanNeoForge.Children.Add(NeoForgeDownloadListItem(Version, AddressOf NeoForge_Selected, False))
+ Next
+ Catch ex As Exception
+ Log(ex, "可视化 NeoForge 安装版本列表出错", LogLevel.Feedback)
+ End Try
+ End Sub
+
+ '选择与清除
+ Private Sub NeoForge_Selected(sender As MyListItem, e As EventArgs)
+ SelectedNeoForge = sender.Tag
+ CardNeoForge.IsSwaped = True
+ OptiFine_Loaded()
+ SelectReload()
+ End Sub
+ Private Sub NeoForge_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnNeoForgeClear.MouseLeftButtonUp
+ SelectedNeoForge = Nothing
+ CardNeoForge.IsSwaped = True
+ e.Handled = True
+ OptiFine_Loaded()
+ SelectReload()
+ End Sub
+
+#End Region
+
#Region "Fabric 列表"
'''