Просмотр исходного кода

feat(neoforge): 添加了 NeoForge 的安装选项,并支持获取版本列表

Pigeon0v0 2 лет назад
Родитель
Сommit
7ba79db82c

+ 226 - 0
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb

@@ -721,6 +721,232 @@
 
 #End Region
 
+#Region "DlNeoForgeVersion | NeoForge 版本列表"
+
+    Public Class DlNeoForgeVersionEntry
+        ''' <summary>
+        ''' 完整的版本名,如 “14.22.1.2478”。
+        ''' </summary>
+        Public Version As String
+        ''' <summary>
+        ''' 对应的 Minecraft 版本,如“1.12.2”。
+        ''' </summary>
+        Public Inherit As String
+        ''' <summary>
+        ''' 发布时间,格式为“yyyy/MM/dd HH:mm”。
+        ''' </summary>
+        Public ReleaseTime As String
+        ''' <summary>
+        ''' 文件的 MD5 或 SHA1(BMCLAPI 的老版本是 MD5,新版本是 SHA1;官方源总是 MD5)。
+        ''' </summary>
+        Public Hash As String = Nothing
+        ''' <summary>
+        ''' 安装类型。有 installer、client、universal 三种。
+        ''' </summary>
+        Public Category As String
+        ''' <summary>
+        ''' 版本分支。若无分支则为 Nothing。
+        ''' </summary>
+        Public Branch As String = Nothing
+        Public Structure DlNeoForgeListResult
+            ''' <summary>
+            ''' 数据来源名称,如“Official”,“BMCLAPI”。
+            ''' </summary>
+            Public SourceName As String
+            ''' <summary>
+            ''' 是否为官方的实时数据。
+            ''' </summary>
+            Public IsOfficial As Boolean
+            ''' <summary>
+            ''' 获取到的数据。
+            ''' </summary>
+            Public Value As JObject
+        End Structure
+        ''' <summary>
+        ''' 是否为新版 Forge。(即为 Minecraft 1.13+)
+        ''' </summary>
+        Public ReadOnly Property IsNewType As Boolean
+            Get
+                Return Version.Split(".")(0) >= 20
+            End Get
+        End Property
+        ''' <summary>
+        ''' 构建数。
+        ''' </summary>
+        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
+        ''' <summary>
+        ''' 用于下载的文件版本名。可能在 Version 的基础上添加了分支。
+        ''' </summary>
+        Public ReadOnly Property FileVersion As String
+            Get
+                Return Version & If(Branch Is Nothing, "", "-" & Branch)
+            End Get
+        End Property
+        ''' <summary>
+        ''' 即将下载的文件全名。
+        ''' </summary>
+        Public ReadOnly Property FileName As String
+            Get
+                Return "forge-" & Inherit & "-" & FileVersion & "-" & Category & "." & FileSuffix
+            End Get
+        End Property
+        ''' <summary>
+        ''' 文件扩展名。
+        ''' </summary>
+        Public ReadOnly Property FileSuffix As String
+            Get
+                If Category = "installer" Then
+                    Return "jar"
+                Else
+                    Return "zip"
+                End If
+            End Get
+        End Property
+    End Class
+
+    ''' <summary>
+    ''' NeoForge 版本列表,主加载器。
+    ''' </summary>
+    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
+
+    ''' <summary>
+    ''' NeoForge 版本列表,官方源。
+    ''' </summary>
+    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
+
+    ''' <summary>
+    ''' NeoForge 版本列表,BMCLAPI。
+    ''' </summary>
+    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

+ 624 - 0
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
+
+    ''' <summary>
+    ''' 获取下载某个 NeoForge 版本的加载器列表。
+    ''' </summary>
+    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)

+ 19 - 0
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" />
                         </Grid>
                     </local:MyCard>
+                    <local:MyCard Title="NeoForge" Height="40" Margin="0,15,0,0" x:Name="CardNeoForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
+                        <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanNeoForge" />
+                        <Grid x:Name="PanNeoForgeInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
+                            <Grid.RenderTransform>
+                                <TranslateTransform />
+                            </Grid.RenderTransform>
+                            <Grid.ColumnDefinitions>
+                                <ColumnDefinition Width="Auto" />
+                                <ColumnDefinition Width="1*" />
+                            </Grid.ColumnDefinitions>
+                            <Image x:Name="ImgNeoForge" Margin="0,0,7,0" SnapsToDevicePixels="True" Height="18" RenderOptions.BitmapScalingMode="Linear" Source="pack://application:,,,/images/Blocks/Anvil.png" />
+                            <TextBlock x:Name="LabNeoForge" VerticalAlignment="Center" TextTrimming="CharacterEllipsis" Grid.Column="1" />
+                        </Grid>
+                        <Grid x:Name="BtnNeoForgeClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
+                            <Path x:Name="BtnNeoForgeClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
+                    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" />
+                        </Grid>
+                    </local:MyCard>
                     <local:MyCard Title="Fabric" Height="40" Margin="0,15,0,0" x:Name="CardFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
                         <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanFabric" />
                         <Grid x:Name="PanFabricInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
@@ -178,6 +196,7 @@
             <local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="LoadMinecraft" HorizontalAlignment="Center" VerticalAlignment="Center" />
             <local:MyLoading Visibility="Collapsed" x:Name="LoadOptiFine" HasAnimation="False" />
             <local:MyLoading Visibility="Collapsed" x:Name="LoadForge" HasAnimation="False" />
+            <local:MyLoading Visibility="Collapsed" x:Name="LoadNeoForge" HasAnimation="False" />
             <local:MyLoading Visibility="Collapsed" x:Name="LoadLiteLoader" HasAnimation="False" />
             <local:MyLoading Visibility="Collapsed" x:Name="LoadFabric" HasAnimation="False" />
             <local:MyLoading Visibility="Collapsed" x:Name="LoadFabricApi" HasAnimation="False" />

+ 133 - 1
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 @@
     ''' <summary>
     ''' 重载已选择的项目的显示。
     ''' </summary>
-    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 列表"
+
+    ''' <summary>
+    ''' 获取 NeoForge 的加载异常信息。若正常则返回 Nothing。
+    ''' </summary>
+    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
+
+    ''' <summary>
+    ''' 尝试重新可视化 NeoForge 版本列表。
+    ''' </summary>
+    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 列表"
 
     ''' <summary>