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

This commit is contained in:
Pigeon0v0
2024-06-15 21:34:02 +08:00
parent f1fedfc785
commit 7ba79db82c
4 changed files with 1002 additions and 1 deletions
@@ -721,6 +721,232 @@
#End Region #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 版本列表" #Region "DlLiteLoaderList | LiteLoader 版本列表"
Public Structure DlLiteLoaderListResult Public Structure DlLiteLoaderListResult
@@ -1696,6 +1696,630 @@ Retry:
#End Region #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 下载" #Region "Fabric 下载"
Public Sub McDownloadFabricLoaderSave(DownloadInfo As JObject) Public Sub McDownloadFabricLoaderSave(DownloadInfo As JObject)
@@ -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" /> 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> </Grid>
</local:MyCard> </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"> <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" /> <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"> <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 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="LoadOptiFine" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadForge" 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="LoadLiteLoader" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadFabric" HasAnimation="False" /> <local:MyLoading Visibility="Collapsed" x:Name="LoadFabric" HasAnimation="False" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadFabricApi" HasAnimation="False" /> <local:MyLoading Visibility="Collapsed" x:Name="LoadFabricApi" HasAnimation="False" />
@@ -51,6 +51,7 @@
CardOptiFine.IsSwaped = True CardOptiFine.IsSwaped = True
CardLiteLoader.IsSwaped = True CardLiteLoader.IsSwaped = True
CardForge.IsSwaped = True CardForge.IsSwaped = True
CardNeoForge.IsSwaped = True
CardFabric.IsSwaped = True CardFabric.IsSwaped = True
CardFabricApi.IsSwaped = True CardFabricApi.IsSwaped = True
CardOptiFabric.IsSwaped = True CardOptiFabric.IsSwaped = True
@@ -73,6 +74,13 @@
ForgeLoader.Start(SelectedMinecraftId) ForgeLoader.Start(SelectedMinecraftId)
End If 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 加载 '启动 Fabric API、OptiFabric 加载
DlFabricApiLoader.Start() DlFabricApiLoader.Start()
DlOptiFabricLoader.Start() DlOptiFabricLoader.Start()
@@ -86,6 +94,7 @@
OptiFine_Loaded() OptiFine_Loaded()
LiteLoader_Loaded() LiteLoader_Loaded()
Forge_Loaded() Forge_Loaded()
NeoForge_Loaded()
Fabric_Loaded() Fabric_Loaded()
FabricApi_Loaded() FabricApi_Loaded()
OptiFabric_Loaded() OptiFabric_Loaded()
@@ -102,6 +111,7 @@
BtnOptiFineClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFine.MainTextBlock, .Mode = BindingMode.OneWay}) 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}) 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}) 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}) 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}) 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}) BtnOptiFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFabric.MainTextBlock, .Mode = BindingMode.OneWay})
@@ -213,6 +223,26 @@
End If End If
End Sub 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 'Fabric
Private SelectedFabric As String = Nothing Private SelectedFabric As String = Nothing
Private Sub SetFabricInfoShow(IsShow As String) Private Sub SetFabricInfoShow(IsShow As String)
@@ -277,7 +307,7 @@
''' <summary> ''' <summary>
''' 重载已选择的项目的显示。 ''' 重载已选择的项目的显示。
''' </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 If SelectedMinecraftId Is Nothing OrElse IsReloading Then Exit Sub
IsReloading = True IsReloading = True
'主预览 '主预览
@@ -341,6 +371,22 @@
LabForge.Text = SelectedForge.Version LabForge.Text = SelectedForge.Version
LabForge.Foreground = ColorGray1 LabForge.Foreground = ColorGray1
End If 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 'Fabric
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) <= 13 Then If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) <= 13 Then
CardFabric.Visibility = Visibility.Collapsed CardFabric.Visibility = Visibility.Collapsed
@@ -434,6 +480,7 @@
SelectedOptiFine = Nothing SelectedOptiFine = Nothing
SelectedLiteLoader = Nothing SelectedLiteLoader = Nothing
SelectedForge = Nothing SelectedForge = Nothing
SelectedNeoForge = Nothing
SelectedFabric = Nothing SelectedFabric = Nothing
SelectedFabricApi = Nothing SelectedFabricApi = Nothing
SelectedOptiFabric = Nothing SelectedOptiFabric = Nothing
@@ -451,6 +498,9 @@
If SelectedForge IsNot Nothing Then If SelectedForge IsNot Nothing Then
Name += "-Forge_" & SelectedForge.Version Name += "-Forge_" & SelectedForge.Version
End If End If
If SelectedNeoForge IsNot Nothing Then
Name += "-NeoForge_" & SelectedNeoForge.Version
End If
If SelectedLiteLoader IsNot Nothing Then If SelectedLiteLoader IsNot Nothing Then
Name += "-LiteLoader" Name += "-LiteLoader"
End If End If
@@ -470,6 +520,9 @@
If SelectedForge IsNot Nothing Then If SelectedForge IsNot Nothing Then
Info += ", Forge " & SelectedForge.Version Info += ", Forge " & SelectedForge.Version
End If End If
If SelectedNeoForge IsNot Nothing Then
Info += ", NeoForge " & SelectedNeoForge.Version
End If
If SelectedLiteLoader IsNot Nothing Then If SelectedLiteLoader IsNot Nothing Then
Info += ", LiteLoader" Info += ", LiteLoader"
End If End If
@@ -487,6 +540,8 @@
Return "pack://application:,,,/images/Blocks/Fabric.png" Return "pack://application:,,,/images/Blocks/Fabric.png"
ElseIf SelectedForge IsNot Nothing Then ElseIf SelectedForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Anvil.png" Return "pack://application:,,,/images/Blocks/Anvil.png"
ElseIf SelectedNeoForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Anvil.png"
ElseIf SelectedLiteLoader IsNot Nothing Then ElseIf SelectedLiteLoader IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Egg.png" Return "pack://application:,,,/images/Blocks/Egg.png"
ElseIf SelectedOptiFine IsNot Nothing Then ElseIf SelectedOptiFine IsNot Nothing Then
@@ -706,6 +761,7 @@
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, SelectedForge) Then SelectedForge = Nothing If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, SelectedForge) Then SelectedForge = Nothing
OptiFabric_Loaded() OptiFabric_Loaded()
Forge_Loaded() Forge_Loaded()
NeoForge_Loaded()
CardOptiFine.IsSwaped = True CardOptiFine.IsSwaped = True
SelectReload() SelectReload()
End Sub End Sub
@@ -715,6 +771,7 @@
CardOptiFine.IsSwaped = True CardOptiFine.IsSwaped = True
e.Handled = True e.Handled = True
Forge_Loaded() Forge_Loaded()
NeoForge_Loaded()
SelectReload() SelectReload()
End Sub End Sub
@@ -866,6 +923,81 @@
#End Region #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 列表" #Region "Fabric 列表"
''' <summary> ''' <summary>