This commit is contained in:
龙腾猫跃
2026-05-15 22:06:22 +08:00
parent 277c020186
commit 53fe8204cf
110 changed files with 30470 additions and 4729 deletions
@@ -29,7 +29,7 @@
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析原版支持库文件(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Thread.Sleep(50) '等待 JSON 文件实际写入硬盘(#3710)
Log("[Download] 开始分析原版支持库文件:" & VersionFolder)
Logger.Info($"开始分析原版支持库文件:{VersionFolder}")
Task.Output = McLibNetFilesFromInstance(New McInstance(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载原版支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False})
@@ -47,7 +47,7 @@
End Try
'顺手添加 Json 项目
Try
Dim InstanceJson As JObject = GetJson(ReadFile(VersionFolder & InstanceName & ".json"))
Dim InstanceJson As JObject = GetJson(FileUtils.ReadAsString(VersionFolder & InstanceName & ".json"))
InstanceJson.Add("clientVersion", Id)
FileUtils.Write($"{VersionFolder}{InstanceName}.json", InstanceJson.ToString)
Catch ex As Exception
@@ -158,8 +158,8 @@
Try
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Return
Dim VersionFolder As String = Dialogs.SelectFolder("选择目标文件夹", False).FirstOrDefault
If VersionFolder Is Nothing Then Return
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
@@ -180,8 +180,8 @@
'分析服务端 JAR 文件下载地址
Dim Instance As New McInstance(VersionFolder)
If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("server") Is Nothing OrElse Instance.JsonObject("downloads")("server")("url") Is Nothing Then
File.Delete(VersionFolder & Id & ".json")
If Not New DirectoryInfo(VersionFolder).GetFileSystemInfos.Any() Then DeleteDirectory(VersionFolder)
FileUtils.Delete(VersionFolder & Id & ".json")
If Not DirectoryUtils.GetInfo(VersionFolder).GetFileSystemInfos.Any() Then DirectoryUtils.Delete(VersionFolder)
Task.Output = New List(Of NetFile)
Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载,没法下,撤退!", HintType.Red)
Thread.Sleep(2000) '等玩家把上一个提示看完
@@ -207,7 +207,7 @@ pause"
FileUtils.Write(VersionFolder & "Launch Server.bat", Bat,
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
'删除版本 JSON
File.Delete(VersionFolder & Id & ".json")
FileUtils.Delete(VersionFolder & Id & ".json")
End Sub) With {.ProgressWeight = 0.5, .Show = False})
'下载服务端文件
Loaders.Add(New LoaderDownload("下载服务端文件", New List(Of NetFile)) With {.ProgressWeight = 5})
@@ -219,7 +219,7 @@ pause"
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 服务端下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 Minecraft 服务端下载失败")
End Try
End Sub
Public Sub McDownloadMenuSave(sender As Object, e As RoutedEventArgs)
@@ -234,8 +234,8 @@ pause"
Try
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Return
Dim VersionFolder As String = Dialogs.SelectFolder("选择目标文件夹", False).FirstOrDefault
If VersionFolder Is Nothing Then Return
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
@@ -264,7 +264,7 @@ pause"
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 Minecraft 下载失败")
End Try
End Sub
''' <summary>
@@ -323,7 +323,7 @@ pause"
ElseIf Id.StartsWithF("rd-") Then
WikiName = "Java版Pre-classic_" & Id
Else
Log("[Error] 未知的版本格式:" & Id & "。", NotifyLevel.MsgBoxAndFeedback)
Logger.Error($"未知的版本格式:{Id}。")
Return
End If
OpenWebsite("https://zh.minecraft.wiki/w/" & WikiName.Replace("_experimental-snapshot-", "-exp"))
@@ -336,8 +336,8 @@ pause"
Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry)
Try
Dim Id As String = DownloadInfo.InstanceName
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName, "OptiFine Jar (*.jar)|*.jar")
If Not Target.Contains("\") Then Return
Dim Target As String = Dialogs.SaveFile("选择保存位置", DownloadInfo.FileName, filter:={("jar", "OptiFine Jar")})
If Target Is Nothing Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -353,7 +353,7 @@ pause"
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 OptiFine 下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 OptiFine 下载失败")
End Try
End Sub
Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean), UseJavaWrapper As Boolean)
@@ -380,7 +380,7 @@ pause"
End SyncLock
'添加 Java Wrapper 作为主 Jar
Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get("LaunchAdvanceDisableJLW") Then
If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" -jar ""{ExtractPatch("JavaWrapper")}"" optifine.Installer"
Else
Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer"
@@ -395,14 +395,14 @@ pause"
.CreateNoWindow = True,
.RedirectStandardError = True,
.RedirectStandardOutput = True,
.WorkingDirectory = FileUtils.ShortenPath(BaseMcFolderHome)
.WorkingDirectory = PathUtils.ToShortPath(BaseMcFolderHome)
}
If Info.EnvironmentVariables.ContainsKey("appdata") Then
Info.EnvironmentVariables("appdata") = BaseMcFolderHome
Else
Info.EnvironmentVariables.Add("appdata", BaseMcFolderHome)
End If
Log("[Download] 开始安装 OptiFine:" & Target)
Logger.Info($"开始安装 OptiFine:{Target}")
Dim TotalLength As Integer = 0
Dim process As New Process With {.StartInfo = Info}
Dim LastResult As String = ""
@@ -415,17 +415,17 @@ pause"
outputWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
Logger.Trace(LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器信息失败")
Logger.Warn(ex, "读取 OptiFine 安装器信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
Logger.Info("由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
@@ -439,17 +439,17 @@ pause"
errorWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
Logger.Trace(LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器错误信息失败")
Logger.Warn(ex, "读取 OptiFine 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
Logger.Info("由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
@@ -507,10 +507,10 @@ pause"
PageData = NetRequestByClientRetry("https://optifine.net/adloadx?f=" & DownloadInfo.FileName,
Encoding:=New UTF8Encoding(False), Accept:="text/html", SimulateBrowserHeaders:=True)
Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.DisplayName & " 官方下载地址:" & Sources.Last)
Sources.Add("https://optifine.net/" & PageData.RegexSearch("downloadx\?f=[^""']+").First)
Logger.Info($"OptiFine {DownloadInfo.DisplayName} 官方下载地址:{Sources.Last}")
Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.DisplayName & " 官方下载地址失败")
Logger.Warn(ex, $"获取 OptiFine {DownloadInfo.DisplayName} 官方下载地址失败")
End Try
'构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))}
@@ -522,43 +522,43 @@ pause"
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] OptiFine 安装正在等待原版文件下载完成")
If TargetLoaders.Any Then Logger.Info("OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsInterrupted Then Return
'拷贝原版文件
'复制原版文件
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Dim ClientName As String = PathUtils.GetLastPart(ClientFolder)
DirectoryUtils.Create(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json")
If Not FileUtils.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
FileUtils.Copy($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json")
End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar")
If Not FileUtils.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
FileUtils.Copy($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar")
End If
End SyncLock
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'安装(新旧方式均需要原版 Jar 和 Json)
If IsNewerVersion Then
Log("[Download] 检测为新版 OptiFine:" & DownloadInfo.Inherit)
Logger.Info($"检测为新版 OptiFine:{DownloadInfo.Inherit}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine(方式 A)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim BaseMcFolderHome As String = RequestTaskTempFolder()
Dim BaseMcFolder As String = BaseMcFolderHome & ".minecraft\"
Try
'准备安装环境
If Directory.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then
DeleteDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit)
If DirectoryUtils.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then
DirectoryUtils.Delete(BaseMcFolder & "versions\" & DownloadInfo.Inherit)
End If
DirectoryUtils.Create(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\")
McFolderLauncherProfilesJsonCreate(BaseMcFolder)
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json",
FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar",
FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
Task.Progress = 0.06
'进行安装
@@ -568,7 +568,7 @@ Retry:
McDownloadOptiFineInstall(BaseMcFolderHome, Target, Task, UseJavaWrapper)
Catch ex As Exception
If UseJavaWrapper Then
Log(ex, "使用 JavaWrapper 安装 OptiFine 失败,将不使用 JavaWrapper 并重试")
Logger.Warn(ex, "使用 JavaWrapper 安装 OptiFine 失败,将不使用 JavaWrapper 并重试")
UseJavaWrapper = False
GoTo Retry
Else
@@ -577,27 +577,23 @@ Retry:
End Try
Task.Progress = 0.96
'复制文件
File.Delete(BaseMcFolder & "launcher_profiles.json")
CopyDirectory(BaseMcFolder, McFolder)
FileUtils.Delete(BaseMcFolder & "launcher_profiles.json")
DirectoryUtils.Copy(BaseMcFolder, McFolder)
Task.Progress = 0.98
'清理文件
File.Delete(Target)
DeleteDirectory(BaseMcFolderHome)
FileUtils.Delete(Target)
DirectoryUtils.Delete(BaseMcFolderHome)
Catch ex As Exception
Throw New Exception("安装 OptiFine(方式 A)失败", ex)
End Try
End Sub) With {.ProgressWeight = 8})
Else
Log("[Download] 检测为旧版 OptiFine:" & DownloadInfo.Inherit)
Logger.Info($"检测为旧版 OptiFine:{DownloadInfo.Inherit}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine(方式 B)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Try
'新建版本文件夹
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.1
'复制 Jar 文件
If File.Exists(VersionFolder & Id & ".jar") Then File.Delete(VersionFolder & Id & ".jar")
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar")
FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar")
Task.Progress = 0.7
'建立 Json 文件
Dim InheritInstance As New McInstance(McFolder & "versions\" & DownloadInfo.Inherit)
@@ -663,10 +659,10 @@ Retry:
PageData = NetRequestByClientRetry("https://optifine.net/adloadx?f=" & DownloadInfo.FileName,
Encoding:=New UTF8Encoding(False), Accept:="text/html", SimulateBrowserHeaders:=True)
Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.DisplayName & " 官方下载地址:" & Sources.Last)
Sources.Add("https://optifine.net/" & PageData.RegexSearch("downloadx\?f=[^""']+").First)
Logger.Info($"OptiFine {DownloadInfo.DisplayName} 官方下载地址:{Sources.Last}")
Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.DisplayName & " 官方下载地址失败")
Logger.Warn(ex, $"获取 OptiFine {DownloadInfo.DisplayName} 官方下载地址失败")
End Try
Task.Progress = 0.9
'构造文件请求
@@ -753,8 +749,8 @@ Retry:
Private Sub McDownloadLiteLoaderSave(DownloadInfo As DlLiteLoaderListEntry)
Try
Dim Id As String = DownloadInfo.Inherit
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), "LiteLoader 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Return
Dim Target As String = Dialogs.SaveFile("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), filter:={("jar", "LiteLoader 安装器")})
If Target Is Nothing Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -796,7 +792,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 LiteLoader 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 LiteLoader 安装器下载失败")
End Try
End Sub
@@ -920,10 +916,10 @@ Retry:
Public Sub McDownloadForgelikeSave(Info As DlForgelikeEntry)
Try
Dim Target As String = SelectSaveFile("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
$"{Info.LoaderName} 安装器 (*.{Info.FileExtension})|*.{Info.FileExtension}")
Dim Target As String = Dialogs.SaveFile("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
filter:={(Info.FileExtension, $"{Info.LoaderName} 安装器")})
If Target Is Nothing Then Return
Dim DisplayName As String = $"{Info.LoaderName} {Info.Inherit} - {Info.VersionName}"
If Not Target.Contains("\") Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -962,7 +958,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, $"开始 {Info.LoaderName} 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"开始 {Info.LoaderName} 安装器下载失败")
End Try
End Sub
@@ -990,7 +986,7 @@ Retry:
End SyncLock
'添加 Java Wrapper 作为主 Jar
Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get("LaunchAdvanceDisableJLW") Then
If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractPatch("JavaWrapper")}"" com.bangbang93.ForgeInstaller ""{McFolder}"
Else
Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}"
@@ -1007,7 +1003,7 @@ Retry:
.RedirectStandardOutput = True
}
Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge")
Log($"[Download] 开始安装 {LoaderName}:" & Arguments)
Logger.Info($"开始安装 {LoaderName}:{Arguments}")
Dim process As New Process With {.StartInfo = Info}
Dim LastResults As New Queue(Of String)
Using outputWaitHandle As New AutoResetEvent(False)
@@ -1024,11 +1020,11 @@ Retry:
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, $"读取 {LoaderName} 安装器信息失败")
Logger.Warn(ex, $"读取 {LoaderName} 安装器信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log($"[Installer] 由于任务取消,已中止 {LoaderName} 安装")
Logger.Info($"由于任务取消,已中止 {LoaderName} 安装")
process.Kill()
End If
Catch
@@ -1047,11 +1043,11 @@ Retry:
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, $"读取 {LoaderName} 安装器错误信息失败")
Logger.Warn(ex, $"读取 {LoaderName} 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log($"[Installer] 由于任务取消,已中止 {LoaderName} 安装")
Logger.Info($"由于任务取消,已中止 {LoaderName} 安装")
process.Kill()
End If
Catch
@@ -1071,7 +1067,7 @@ Retry:
process.Dispose()
'检查是否安装成功:最后 5 行中是否有 true(true 可能在倒数数行,见 #832)
If LastResults.Reverse().Take(5).Any(Function(l) l = "true") Then Return
Log(LastResults.Join(vbCrLf))
Logger.Warn(LastResults.Join(vbCrLf))
Dim LastLines As String = ""
For i As Integer = Math.Max(0, LastResults.Count - 5) To LastResults.Count - 1 '最后 5 行
LastLines &= vbCrLf & LastResults(i)
@@ -1084,13 +1080,10 @@ Retry:
Private Sub ForgelikeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean))
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.18
@@ -1117,10 +1110,10 @@ Retry:
Case "Injecting profile"
Task.Progress = 0.91
Case Else
If ModeDebug Then Log("[Installer] " & Content)
Logger.Trace(Content)
Return
End Select
Log("[Installer] " & Content)
Logger.Info(Content)
End Sub
''' <summary>
@@ -1197,18 +1190,18 @@ Retry:
'安装(仅在新版安装时需要原版 Jar)
If IsNeoForge OrElse LoaderVersion.BeforeFirst(".") >= 20 Then
Log($"[Download] 检测为{If(IsNeoForge, " Neo", "新版 ")}Forge:" & LoaderVersion)
Dim Libs As List(Of McLibToken) = Nothing
Logger.Info($"检测为{If(IsNeoForge, " Neo", "新版 ")}Forge:{LoaderVersion}")
Dim Libs As List(Of McLibEntry) = Nothing
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件",
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, FileAccess.Read, FileShare.Read))
Installer = FileUtils.OpenZip(InstallerAddress)
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))
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
Dim Json2 As JObject = GetJson(Installer.GetEntry("version.json").Open().ReadString)
Json.Merge(Json2)
'获取 Lib 下载信息
Libs = McLibListGetWithJson(Json, True)
@@ -1221,17 +1214,17 @@ Retry:
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).BeforeFirst("@")
Dim Address = McLibGet(OriginalName).Replace(".jar", "." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Dim ClientMappings As JToken = RawJson("downloads")("client_mappings")
Libs.Add(New McLibToken With {
Libs.Add(New McLibEntry With {
.IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.Url = ClientMappings("url"), .Size = ClientMappings("size"), .SHA1 = ClientMappings("sha1")})
Log($"[Download] 需要下载 Mappings:{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})")
Logger.Info($"需要下载 Mappings:{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})")
End If
Task.Progress = 0.8
'去除其中的原始 Forgelike 项
For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}.jar") OrElse
Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}-client.jar") Then
Log($"[Download] 已从待下载 {LoaderName} 支持库中移除:" & Libs(i).LocalPath, NotifyLevel.DebugModeOnly)
Logger.Warn($"已从待下载 {LoaderName} 支持库中移除:{Libs(i).LocalPath}")
Libs.RemoveAt(i)
Exit For
End If
@@ -1240,7 +1233,6 @@ Retry:
Catch ex As Exception
Throw New Exception($"获取{If(IsNeoForge, " Neo", "新版 ")}Forge 支持库列表失败", ex)
Finally
'释放文件
If Installer IsNot Nothing Then Installer.Dispose()
End Try
End Sub) With {.ProgressWeight = 1})
@@ -1249,13 +1241,10 @@ Retry:
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
#Region "Forgelike 文件"
If IsCustomFolder Then
For Each LibFile As McLibToken In Libs
For Each LibFile As McLibEntry In Libs
Dim RealPath As String = LibFile.LocalPath.Replace(McFolderSelected, McFolder)
If Not File.Exists(RealPath) Then
DirectoryUtils.Create(RealPath, isFilePath:=True)
CopyFile(LibFile.LocalPath, RealPath)
End If
If ModeDebug Then Log($"[Download] 复制的 {LoaderName} 支持库文件:" & LibFile.LocalPath)
If Not FileUtils.Exists(RealPath) Then FileUtils.Copy(LibFile.LocalPath, RealPath)
Logger.Trace($"复制的 {LoaderName} 支持库文件:{LibFile.LocalPath}")
Next
End If
#End Region
@@ -1264,22 +1253,22 @@ Retry:
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] {LoaderName} 安装正在等待原版文件下载完成")
If TargetLoaders.Any Then Logger.Info($"{LoaderName} 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsInterrupted Then Return
'拷贝原版文件
'复制原版文件
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Dim ClientName As String = PathUtils.GetLastPart(ClientFolder)
DirectoryUtils.Create(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
If Not FileUtils.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
FileUtils.Copy(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")
If Not FileUtils.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
FileUtils.Copy(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
End If
End SyncLock
#End Region
@@ -1288,12 +1277,12 @@ Retry:
Sub(Task As LoaderTask(Of Boolean, Boolean))
Dim Installer As ZipArchive = Nothing
Try
Log($"[Download] 开始进行 Forgelike 安装:" & InstallerAddress)
Logger.Info($"开始进行 Forgelike 安装:{InstallerAddress}")
'记录当前文件夹列表(在新建目标文件夹之前)
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(i) i.FullName).ToList()
Dim OldList = DirectoryUtils.GetDirectories(McFolder & "versions\", True).ToList()
'解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Installer = FileUtils.OpenZip(InstallerAddress)
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
'新建目标版本文件夹
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.04
@@ -1305,23 +1294,23 @@ Retry:
Retry:
Try
'释放 Forge 注入器
FileUtils.Write(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
ExtractResources(PathTemp & "Cache\forge_installer.jar", "ForgeInstaller")
Task.Progress = 0.06
'运行注入器
ForgelikeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper, IsNeoForge)
Task.Progress = 0.97
Catch ex As Exception
If UseJavaWrapper Then
Log(ex, $"使用 JavaWrapper 安装 {LoaderName} 失败,将不使用 JavaWrapper 并重试")
Logger.Warn(ex, $"使用 JavaWrapper 安装 {LoaderName} 失败,将不使用 JavaWrapper 并重试")
UseJavaWrapper = False
GoTo Retry
Else
Throw New Exception($"运行 {LoaderName} 安装器失败", ex)
End If
End Try
'拷贝新增的版本 Json
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
'复制新增的版本 Json
Dim DeltaList = DirectoryUtils.GetDirectories(McFolder & "versions\", True).
SkipWhile(Function(i) OldList.Contains(i)).Select(Function(f) DirectoryUtils.GetInfo(f)).ToList()
If DeltaList.Count > 1 Then
'它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
'也可能是因为 Forge 安装器的 Bug,生成了一个名字错误的文件夹,所以需要检查文件夹是否为空
@@ -1329,62 +1318,61 @@ Retry:
End If
If DeltaList.Count = 1 Then
'如果没有新增文件夹,那么预测的文件夹名就是正确的
'如果只新增 1 个文件夹,那么拷贝 json 文件
'如果只新增 1 个文件夹,那么复制 json 文件
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
FileUtils.Write(VersionFolder & NewInstanceName & ".json", ReadFile(JsonFile.FullName))
Log($"[Download] 已拷贝新增的版本 JSON 文件:{JsonFile.FullName} -> {VersionFolder}{NewInstanceName}.json")
FileUtils.Copy(JsonFile.FullName, VersionFolder & NewInstanceName & ".json")
Logger.Info($"已复制新增的版本 JSON 文件:{JsonFile.FullName} -> {VersionFolder}{NewInstanceName}.json")
ElseIf DeltaList.Count > 1 Then
'新增了多个文件夹
Log($"[Download] 有多个疑似的新增版本,无法确定:{DeltaList.Select(Function(d) d.Name).Join(";")}")
Logger.Info($"有多个疑似的新增版本,无法确定:{DeltaList.Select(Function(d) d.Name).Join(";")}")
Else
'没有新增文件夹
Log("[Download] 未找到新增的版本文件夹")
Logger.Info("未找到新增的版本文件夹")
End If
Catch ex As Exception
Throw New Exception($"安装新 {LoaderName} 版本失败", ex)
Finally
'清理文件
Try
If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
Installer?.Dispose()
FileUtils.Delete(InstallerAddress)
Catch ex As Exception
Log(ex, $"安装 {LoaderName} 清理文件时出错")
Logger.Warn(ex, $"安装 {LoaderName} 清理文件时出错")
End Try
End Try
End Sub) With {.ProgressWeight = 10})
Else
Log("[Download] 检测为非新版 Forge:" & LoaderVersion)
Logger.Info($"检测为非新版 Forge:{LoaderVersion}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"安装 {LoaderName}(方式 B)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim Installer As ZipArchive = Nothing
Try
'解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Installer = FileUtils.OpenZip(InstallerAddress)
Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
Task.Progress = 0.4
'新建版本文件夹
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.5
If Json("install") Is Nothing Then
'中版:Legacy 方式 1
Log("[Download] 开始进行 Forge 安装,Legacy 方式 1:" & InstallerAddress)
Logger.Info($"开始进行 Forge 安装,Legacy 方式 1:{InstallerAddress}")
'建立 Json 文件
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
Dim JsonVersion As JObject = GetJson(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open().ReadString)
JsonVersion("id") = NewInstanceName
FileUtils.Write(VersionFolder & NewInstanceName & ".json", JsonVersion.ToString)
Task.Progress = 0.6
'解压支持库文件
Installer.Dispose()
ExtractCompressedFile(InstallerAddress, InstallerAddress & "_unrar\")
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DeleteDirectory(InstallerAddress & "_unrar\")
FileUtils.ExtractToDirectory(InstallerAddress, InstallerAddress & "_unrar\")
If DirectoryUtils.Exists(InstallerAddress & "_unrar\maven\") Then DirectoryUtils.Copy(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DirectoryUtils.Delete(InstallerAddress & "_unrar\")
Else
'旧版:Legacy 方式 2
Log("[Download] 开始进行 Forge 安装,Legacy 方式 2:" & InstallerAddress)
Logger.Info($"开始进行 Forge 安装,Legacy 方式 2:{InstallerAddress}")
'解压 Jar 文件
Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
If File.Exists(JarAddress) Then File.Delete(JarAddress)
FileUtils.Write(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
Task.Progress = 0.9
'建立 Json 文件
@@ -1398,10 +1386,10 @@ Retry:
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\")
FileUtils.Delete(InstallerAddress)
DirectoryUtils.Delete(InstallerAddress & "_unrar\")
Catch ex As Exception
Log(ex, "非新版方式安装 Forge 清理文件时出错")
Logger.Warn(ex, "非新版方式安装 Forge 清理文件时出错")
End Try
End Try
End Sub) With {.ProgressWeight = 1})
@@ -1422,7 +1410,7 @@ Retry:
If Entries.Any Then
FreshVersion = Entries(0)
Else
Log("[System] 未找到可用的 Forge 版本")
Logger.Info("未找到可用的 Forge 版本")
End If
Dim RecommendedVersion As DlForgeVersionEntry = Nothing
For Each Entry In Entries
@@ -1522,7 +1510,7 @@ Retry:
RunInNewThread(
Sub()
Try
Log("[Download] 刷新 Forge 推荐版本缓存开始")
Logger.Info("刷新 Forge 推荐版本缓存开始")
Dim Result As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/promos", RequireJson:=True)
If Result.Length < 1000 Then Throw New Exception("获取的结果过短(" & Result & ")")
Dim ResultJson As JContainer = GetJson(Result)
@@ -1539,9 +1527,9 @@ Retry:
'保存
Dim CacheJson As String = "{" & RecommendedList.Join(",") & "}"
FileUtils.Write(PathTemp & "Cache\ForgeRecommendedList.json", CacheJson)
Log("[Download] 刷新 Forge 推荐版本缓存成功")
Logger.Info("刷新 Forge 推荐版本缓存成功")
Catch ex As Exception
Log(ex, "刷新 Forge 推荐版本缓存失败")
Logger.Warn(ex, "刷新 Forge 推荐版本缓存失败")
End Try
End Sub, "ForgeRecommendedRefresh")
End Sub
@@ -1553,16 +1541,16 @@ Retry:
Public Function McDownloadForgeRecommendedGet(McVersion As String) As String
Try
If McVersion Is Nothing Then Return Nothing
Dim List As String = ReadFile(PathTemp & "Cache\ForgeRecommendedList.json")
If List Is Nothing OrElse List = "" Then
Log("[Download] 没有 Forge 推荐版本缓存文件")
Dim List As String = FileUtils.TryReadAsString(PathTemp & "Cache\ForgeRecommendedList.json")
If String.IsNullOrEmpty(List) Then
Logger.Info("没有 Forge 推荐版本缓存文件")
Return Nothing
End If
Dim Json As JObject = GetJson(List)
If Json Is Nothing OrElse (Not If(McVersion, "").Contains(".")) OrElse Not Json.ContainsKey(McVersion) Then Return Nothing
Return If(Json(McVersion), "").ToString
Catch ex As Exception
Log(ex, "获取 Forge 推荐版本失败(" & If(McVersion, "null") & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"获取 Forge 推荐版本失败({If(McVersion, "null")})")
Return Nothing
End Try
End Function
@@ -1587,7 +1575,7 @@ Retry:
End If
Next
Else
Log("[System] 未找到可用的 NeoForge 版本", NotifyLevel.DebugModeOnly)
Logger.Warn("未找到可用的 NeoForge 版本")
End If
'显示各个版本
If FreshStableVersion IsNot Nothing Then
@@ -1674,10 +1662,10 @@ Retry:
Public Sub McDownloadFabricLoaderSave(DownloadInfo As JObject)
Try
Dim Url As String = DownloadInfo("url").ToString
Dim FileName As String = GetFileNameFromPath(Url)
Dim Version As String = GetFileNameFromPath(DownloadInfo("version").ToString)
Dim Target As String = SelectSaveFile("选择保存位置", FileName, "Fabric 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Return
Dim FileName As String = PathUtils.GetLastPart(Url)
Dim Version As String = PathUtils.GetLastPart(DownloadInfo("version").ToString)
Dim Target As String = Dialogs.SaveFile("选择保存位置", FileName, filter:={("jar", "Fabric 安装器")})
If Target Is Nothing Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -1701,7 +1689,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Fabric 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 Fabric 安装器下载失败")
End Try
End Sub
@@ -1860,7 +1848,7 @@ Retry:
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Green)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red)
Hint(Loader.Name & "失败:" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted
Hint(Loader.Name & "已取消!", HintType.Blue)
End Select
@@ -1875,7 +1863,7 @@ Retry:
Hint(Loader.Name & "成功!", HintType.Green)
'TODO: 自动选择安装成功的版本
Case LoadState.Failed
MyMsgBox(Loader.Error.GetDetail, Loader.Name & "失败", IsWarn:=True)
MyMsgBox(Loader.Error.GetDisplay(True), Loader.Name & "失败", IsWarn:=True)
Case LoadState.Interrupted
Hint(Loader.Name & "已取消!", HintType.Blue)
Case LoadState.Loading
@@ -1889,15 +1877,15 @@ Retry:
Thread.Sleep(1000) '防止存在尚未完全释放的文件,导致清理失败(例如整合包安装)
If Loader.State = LoadState.Failed OrElse Loader.State = LoadState.Interrupted Then
'删除版本文件夹
If Directory.Exists(Loader.Input & "saves\") OrElse Directory.Exists(Loader.Input & "versions\") Then
Log("[Download] 由于版本已被独立启动,不清理版本文件夹:" & Loader.Input, NotifyLevel.DevelopOnly)
If DirectoryUtils.Exists(Loader.Input & "saves\") OrElse DirectoryUtils.Exists(Loader.Input & "versions\") Then
Logger.Warn($"由于版本已被独立启动,不清理版本文件夹:{Loader.Input}")
Else
Log("[Download] 由于下载失败或取消,清理版本文件夹:" & Loader.Input, NotifyLevel.DevelopOnly)
DeleteDirectory(Loader.Input)
Logger.Warn($"由于下载失败或取消,清理版本文件夹:{Loader.Input}")
DirectoryUtils.Delete(Loader.Input)
End If
End If
Catch ex As Exception
Log(ex, "下载失败或取消后清理版本文件夹失败")
Logger.Warn(ex, "下载失败或取消后清理版本文件夹失败")
End Try
End Sub
@@ -1920,7 +1908,7 @@ Retry:
Catch ex As CancelledException
Return False
Catch ex As Exception
Log(ex, "开始合并安装失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始合并安装失败")
Return False
End Try
End Function
@@ -1934,7 +1922,7 @@ Retry:
'获取参数
Dim VersionFolder As String = McFolderSelected & "versions\" & Request.NewInstanceName & "\"
If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder)
If DirectoryUtils.Exists(TempMcFolder) Then DirectoryUtils.Delete(TempMcFolder)
Dim OptiFineFolder As String = Nothing
If Request.OptiFineVersion IsNot Nothing Then
If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.AfterLast("_HD_U_") '#735
@@ -1964,7 +1952,7 @@ Retry:
Dim ModsTempFolder As String = TempMcFolder & "mods\"
Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso Modable '选择了 OptiFine 与任意 Mod 加载器
If OptiFineAsMod Then
Log("[Download] OptiFine 将作为 Mod 进行下载")
Logger.Info("OptiFine 将作为 Mod 进行下载")
If Request.LiteLoaderEntry IsNot Nothing Then
OptiFineFolder = ModsTempFolder & Request.MinecraftName & "\" '#8147
Else
@@ -1973,15 +1961,15 @@ Retry:
End If
'记录日志
If OptiFineFolder IsNot Nothing Then Log("[Download] OptiFine 缓存:" & OptiFineFolder)
If ForgeFolder IsNot Nothing Then Log("[Download] Forge 缓存:" & ForgeFolder)
If NeoForgeFolder IsNot Nothing Then Log("[Download] NeoForge 缓存:" & NeoForgeFolder)
If FabricFolder IsNot Nothing Then Log("[Download] Fabric 缓存:" & FabricFolder)
If LiteLoaderFolder IsNot Nothing Then Log("[Download] LiteLoader 缓存:" & LiteLoaderFolder)
Log("[Download] 对应的原版版本:" & Request.MinecraftName)
If OptiFineFolder IsNot Nothing Then Logger.Info($"OptiFine 缓存:{OptiFineFolder}")
If ForgeFolder IsNot Nothing Then Logger.Info($"Forge 缓存:{ForgeFolder}")
If NeoForgeFolder IsNot Nothing Then Logger.Info($"NeoForge 缓存:{NeoForgeFolder}")
If FabricFolder IsNot Nothing Then Logger.Info($"Fabric 缓存:{FabricFolder}")
If LiteLoaderFolder IsNot Nothing Then Logger.Info($"LiteLoader 缓存:{LiteLoaderFolder}")
Logger.Info($"对应的原版版本:{Request.MinecraftName}")
'重复版本检查
If File.Exists($"{VersionFolder}{Request.NewInstanceName}.json") Then
If FileUtils.Exists($"{VersionFolder}{Request.NewInstanceName}.json") Then
Hint("版本 " & Request.NewInstanceName & " 已经存在!", HintType.Red)
Throw New CancelledException
End If
@@ -1991,11 +1979,11 @@ Retry:
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() FileUtils.Write(VersionFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
'Fabric API
If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsTempFolder, ResourceVersion.DownloadReason.Dependency, Request.MinecraftName, ModLoaders.Fabric)}) With {.ProgressWeight = 3, .Block = False})
End If
'OptiFabric
If Request.OptiFabric IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsTempFolder, ResourceVersion.DownloadReason.Dependency, Request.MinecraftName, ModLoaders.Fabric)}) With {.ProgressWeight = 3, .Block = False})
End If
'原版
Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.NewInstanceName)) With {.Show = False, .ProgressWeight = 39,
@@ -2038,19 +2026,19 @@ Retry:
MergeJson(VersionFolder, VersionFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.2
'迁移文件
If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", McFolderSelected & "libraries")
DirectoryUtils.Copy(TempMcFolder & "libraries", McFolderSelected & "libraries")
Task.Progress = 0.8
'创建 Mod 和资源包文件夹
Dim ModsFolder = New McInstance(VersionFolder).PathIndie & "mods\" '版本隔离信息在此时被决定
If Directory.Exists(ModsTempFolder) Then
CopyDirectory(ModsTempFolder, ModsFolder)
If DirectoryUtils.Exists(ModsTempFolder) Then
DirectoryUtils.Copy(ModsTempFolder, ModsFolder)
ElseIf Modable Then
DirectoryUtils.Create(ModsFolder)
Log("[Download] 自动创建 Mod 文件夹:" & ModsFolder)
Logger.Info($"自动创建 Mod 文件夹:{ModsFolder}")
End If
Dim ResourcepacksFolder = New McInstance(VersionFolder).PathIndie & "resourcepacks\"
DirectoryUtils.Create(ResourcepacksFolder)
Log("[Download] 自动创建资源包文件夹:" & ResourcepacksFolder)
Logger.Info($"自动创建资源包文件夹:{ResourcepacksFolder}")
End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件
If Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then
@@ -2060,7 +2048,7 @@ Retry:
LoaderList.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
End If
'删除忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() File.Delete(VersionFolder & ".pclignore")) With {.Show = False})
LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() FileUtils.Delete(VersionFolder & ".pclignore")) With {.Show = False})
'总加载器
Return LoaderList
End Function
@@ -2069,7 +2057,7 @@ Retry:
''' 将多个版本 JSON 进行合并,如果目标已存在则直接覆盖。失败会抛出异常。
''' </summary>
Private Sub MergeJson(OutputFolder As String, MinecraftFolder As String, Optional OptiFineFolder As String = Nothing, Optional OptiFineAsMod As Boolean = False, Optional ForgeFolder As String = Nothing, Optional ForgeVersion As String = Nothing, Optional NeoForgeFolder As String = Nothing, Optional NeoForgeVersion As String = Nothing, Optional FabricFolder As String = Nothing, Optional LiteLoaderFolder As String = Nothing)
Log("[Download] 开始进行版本合并,输出:" & OutputFolder & ",Minecraft:" & MinecraftFolder &
Logger.Info($"开始进行版本合并,输出:{OutputFolder},Minecraft:{MinecraftFolder}" &
If(OptiFineFolder IsNot Nothing, ",OptiFine:" & OptiFineFolder, "") &
If(ForgeFolder IsNot Nothing, ",Forge:" & ForgeFolder, "") &
If(NeoForgeFolder IsNot Nothing, ",NeoForge:" & NeoForgeFolder, "") &
@@ -2083,78 +2071,78 @@ Retry:
Dim OutputJar As String, MinecraftJar As String
#Region "初始化路径信息"
If Not OutputFolder.EndsWithF("\") Then OutputFolder += "\"
OutputName = GetFolderNameFromPath(OutputFolder)
OutputName = PathUtils.GetLastPart(OutputFolder)
OutputJsonPath = OutputFolder & OutputName & ".json"
OutputJar = OutputFolder & OutputName & ".jar"
If Not MinecraftFolder.EndsWithF("\") Then MinecraftFolder += "\"
MinecraftName = GetFolderNameFromPath(MinecraftFolder)
MinecraftName = PathUtils.GetLastPart(MinecraftFolder)
MinecraftJsonPath = MinecraftFolder & MinecraftName & ".json"
MinecraftJar = MinecraftFolder & MinecraftName & ".jar"
If HasOptiFine Then
If Not OptiFineFolder.EndsWithF("\") Then OptiFineFolder += "\"
OptiFineName = GetFolderNameFromPath(OptiFineFolder)
OptiFineName = PathUtils.GetLastPart(OptiFineFolder)
OptiFineJsonPath = OptiFineFolder & OptiFineName & ".json"
End If
If HasForge Then
If Not ForgeFolder.EndsWithF("\") Then ForgeFolder += "\"
ForgeName = GetFolderNameFromPath(ForgeFolder)
ForgeName = PathUtils.GetLastPart(ForgeFolder)
ForgeJsonPath = ForgeFolder & ForgeName & ".json"
End If
If HasNeoForge Then
If Not NeoForgeFolder.EndsWithF("\") Then NeoForgeFolder += "\"
NeoForgeName = GetFolderNameFromPath(NeoForgeFolder)
NeoForgeName = PathUtils.GetLastPart(NeoForgeFolder)
NeoForgeJsonPath = NeoForgeFolder & NeoForgeName & ".json"
End If
If HasLiteLoader Then
If Not LiteLoaderFolder.EndsWithF("\") Then LiteLoaderFolder += "\"
LiteLoaderName = GetFolderNameFromPath(LiteLoaderFolder)
LiteLoaderName = PathUtils.GetLastPart(LiteLoaderFolder)
LiteLoaderJsonPath = LiteLoaderFolder & LiteLoaderName & ".json"
End If
If HasFabric Then
If Not FabricFolder.EndsWithF("\") Then FabricFolder += "\"
FabricName = GetFolderNameFromPath(FabricFolder)
FabricName = PathUtils.GetLastPart(FabricFolder)
FabricJsonPath = FabricFolder & FabricName & ".json"
End If
#End Region
Dim OutputJson As JObject, MinecraftJson As JObject, OptiFineJson As JObject = Nothing, ForgeJson As JObject = Nothing, NeoForgeJson As JObject = Nothing, LiteLoaderJson As JObject = Nothing, FabricJson As JObject = Nothing
#Region "读取文件并检查文件是否合规"
Dim MinecraftJsonText As String = ReadFile(MinecraftJsonPath)
Dim MinecraftJsonText As String = If(FileUtils.TryReadAsString(MinecraftJsonPath), "")
If Not MinecraftJsonText.StartsWithF("{") Then Throw New Exception("Minecraft json 有误,地址:" & MinecraftJsonPath & ",前段内容:" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000)))
MinecraftJson = GetJson(MinecraftJsonText)
If HasOptiFine Then
Dim OptiFineJsonText As String = ReadFile(OptiFineJsonPath)
Dim OptiFineJsonText As String = If(FileUtils.TryReadAsString(OptiFineJsonPath), "")
If Not OptiFineJsonText.StartsWithF("{") Then Throw New Exception("OptiFine json 有误,地址:" & OptiFineJsonPath & ",前段内容:" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000)))
OptiFineJson = GetJson(OptiFineJsonText)
End If
If HasForge Then
Dim ForgeJsonText As String = ReadFile(ForgeJsonPath)
Dim ForgeJsonText As String = If(FileUtils.TryReadAsString(ForgeJsonPath), "")
If Not ForgeJsonText.StartsWithF("{") Then Throw New Exception("Forge json 有误,地址:" & ForgeJsonPath & ",前段内容:" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000)))
ForgeJson = GetJson(ForgeJsonText)
End If
If HasNeoForge Then
Dim NeoForgeJsonText As String = ReadFile(NeoForgeJsonPath)
Dim NeoForgeJsonText As String = If(FileUtils.TryReadAsString(NeoForgeJsonPath), "")
If Not NeoForgeJsonText.StartsWithF("{") Then Throw New Exception("NeoForge json 有误,地址:" & NeoForgeJsonPath & ",前段内容:" & NeoForgeJsonText.Substring(0, Math.Min(NeoForgeJsonText.Length, 1000)))
NeoForgeJson = GetJson(NeoForgeJsonText)
End If
If HasLiteLoader Then
Dim LiteLoaderJsonText As String = ReadFile(LiteLoaderJsonPath)
Dim LiteLoaderJsonText As String = If(FileUtils.TryReadAsString(LiteLoaderJsonPath), "")
If Not LiteLoaderJsonText.StartsWithF("{") Then Throw New Exception("LiteLoader json 有误,地址:" & LiteLoaderJsonPath & ",前段内容:" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000)))
LiteLoaderJson = GetJson(LiteLoaderJsonText)
End If
If HasFabric Then
Dim FabricJsonText As String = ReadFile(FabricJsonPath)
Dim FabricJsonText As String = If(FileUtils.TryReadAsString(FabricJsonPath), "")
If Not FabricJsonText.StartsWithF("{") Then Throw New Exception("Fabric json 有误,地址:" & FabricJsonPath & ",前段内容:" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000)))
FabricJson = GetJson(FabricJsonText)
End If
@@ -2169,7 +2157,7 @@ Retry:
If(NeoForgeJson IsNot Nothing, If(NeoForgeJson("minecraftArguments"), " ").ToString, " ") & " " &
If(LiteLoaderJson IsNot Nothing, If(LiteLoaderJson("minecraftArguments"), " ").ToString, " ")
'分割参数字符串
Dim RawArguments As List(Of String) = AllArguments.Split(" ").Where(Function(l) l <> "").Select(Function(l) l.Trim).ToList
Dim RawArguments As List(Of String) = AllArguments.Split(" ", True).Select(Function(l) l.Trim).ToList
Dim SplitArguments As New List(Of String)
For i = 0 To RawArguments.Count - 1
If RawArguments(i).StartsWithF("-") Then
@@ -2224,11 +2212,8 @@ Retry:
#Region "保存"
FileUtils.Write(OutputJsonPath, OutputJson.ToString)
If MinecraftJar <> OutputJar Then '可能是同一个文件
If File.Exists(OutputJar) Then File.Delete(OutputJar)
CopyFile(MinecraftJar, OutputJar)
End If
Log("[Download] 版本合并 " & OutputName & " 完成")
FileUtils.Copy(MinecraftJar, OutputJar)
Logger.Info($"版本合并 {OutputName} 完成")
#End Region
End Sub
@@ -2250,23 +2235,23 @@ Retry:
''' <param name="Patch">"LUA" 或 "JavaWrapper"。</param>
Public Function ExtractPatch(Patch As String) As String
Dim PatchPath As String = $"{PathPure}{Patch}.jar"
Log($"[Java] 选定的 {Patch} 路径:{PatchPath}")
Logger.Info($"选定的 {Patch} 路径:{PatchPath}")
Static Lock As New Object
SyncLock Lock '避免 OptiFine 和 Forge 安装时同时释放导致冲突
Try
FileUtils.Write(PatchPath, GetResources(Patch))
ExtractResources(PatchPath, Patch)
Catch ex As Exception
If File.Exists(PatchPath) Then
If FileUtils.Exists(PatchPath) Then
'因为未知原因可能变为只读文件(#4243)
Log(ex, $"{Patch} 文件释放失败,但文件已存在,将在删除后尝试重新生成", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"{Patch} 文件释放失败,但文件已存在,将在删除后尝试重新生成")
Try
File.Delete(PatchPath)
FileUtils.Write(PatchPath, GetResources(Patch))
FileUtils.Delete(PatchPath)
ExtractResources(PatchPath, Patch)
Catch ex2 As Exception
Log(ex2, $"{Patch} 文件重新释放失败,将尝试更换文件名重新生成", NotifyLevel.DevelopOnly)
Logger.Warn(ex2, $"{Patch} 文件重新释放失败,将尝试更换文件名重新生成")
PatchPath = $"{PathPure}{Patch}2.jar"
Try
FileUtils.Write(PatchPath, GetResources(Patch))
ExtractResources(PatchPath, Patch)
Catch ex3 As Exception
Throw New FileNotFoundException($"释放 {Patch} 最终尝试失败", ex3)
End Try
@@ -525,7 +525,7 @@
Next
'自动选择版本
If VersionWaitingSelect Is Nothing Then Exit Try
Log("[Download] 自动选择 MC 版本:" & VersionWaitingSelect)
Logger.Info($"自动选择 MC 版本:{VersionWaitingSelect}")
For Each Version As JObject In Versions
If Version("id").ToString <> VersionWaitingSelect Then Continue For
Dim Item = McDownloadListItem(Version, Sub()
@@ -535,7 +535,7 @@
Return
Next
Catch ex As Exception
Log(ex, "可视化安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化安装版本列表出错")
End Try
End Sub
''' <summary>
@@ -627,7 +627,7 @@
PanOptiFine.Children.Add(OptiFineDownloadListItem(Version, AddressOf OptiFine_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 OptiFine 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 OptiFine 安装版本列表出错")
End Try
End Sub
@@ -689,7 +689,7 @@
PanLiteLoader.Children.Add(LiteLoaderDownloadListItem(Version, AddressOf LiteLoader_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 LiteLoader 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 LiteLoader 安装版本列表出错")
End Try
End Sub
@@ -763,7 +763,7 @@
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 Forge 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 Forge 安装版本列表出错")
End Try
End Sub
@@ -821,7 +821,7 @@
PanNeoForge.Children.Add(NeoForgeDownloadListItem(Version, AddressOf NeoForge_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 NeoForge 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 NeoForge 安装版本列表出错")
End Try
End Sub
@@ -883,7 +883,7 @@
CardFabric.SwapControl = PanFabric
CardFabric.SwapType = 12
Catch ex As Exception
Log(ex, "可视化 Fabric 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 Fabric 安装版本列表出错")
End Try
End Sub
@@ -926,8 +926,8 @@
If Part = TargetName Then Return True
Next
'将版本名分割语素(例如 1.16.4/5)
Dim Lefts = RegexSearch(FabricApiName.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
Dim Rights = RegexSearch(TargetName.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
Dim Lefts = FabricApiName.BeforeFirst("]").RegexSearch("[a-z/]+|[0-9/]+").ToList
Dim Rights = TargetName.BeforeFirst("]").RegexSearch("[a-z/]+|[0-9/]+").ToList
'对每段进行判断
Dim i As Integer = 0
While True
@@ -946,7 +946,7 @@
End While
Return True
Catch ex As Exception
Log(ex, "判断 Fabric API 版本适配性出错(" & FabricApiName & ", " & VanillaName & ")")
Logger.Warn(ex, $"判断 Fabric API 版本适配性出错({FabricApiName}, {VanillaName})")
Return False
End Try
End Function
@@ -984,7 +984,7 @@
For Each Version In DlFabricApiLoader.Output
If IsFabricApiCompatible(Version) Then
If Not Version.Display.StartsWithF("[") Then
Log("[Download] 已特判修改 Fabric API 显示名:" & Version.Display, NotifyLevel.DebugModeOnly)
Logger.Warn($"已特判修改 Fabric API 显示名:{Version.Display}")
Version.Display = "[" & VanillaName & "] " & Version.Display
End If
Versions.Add(Version)
@@ -1002,11 +1002,11 @@
If Not AutoSelectedFabricApi Then
AutoSelectedFabricApi = True
Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanFabricApi.Children(0))
Log($"[Download] 已自动选择 Fabric API:{Item.Title}")
Logger.Info($"已自动选择 Fabric API:{Item.Title}")
FabricApi_Selected(Item, Nothing)
End If
Catch ex As Exception
Log(ex, "可视化 Fabric API 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 Fabric API 安装版本列表出错")
End Try
End Sub
@@ -1035,7 +1035,7 @@
If VanillaName Is Nothing Then Return False
Return ModFile.GameVersions.Contains(VanillaName)
Catch ex As Exception
Log(ex, "判断 OptiFabric 版本适配性出错(" & VanillaName & ")")
Logger.Warn(ex, $"判断 OptiFabric 版本适配性出错({VanillaName})")
Return False
End Try
End Function
@@ -1095,10 +1095,10 @@
If AutoSelectedOptiFabric OrElse VanillaDrop >= 140 AndAlso VanillaDrop <= 150 Then Return '1.14~15 不自动选择
AutoSelectedOptiFabric = True
Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanOptiFabric.Children(0))
Log($"[Download] 已自动选择 OptiFabric:{Item.Title}")
Logger.Info($"已自动选择 OptiFabric:{Item.Title}")
OptiFabric_Selected(Item, Nothing)
Catch ex As Exception
Log(ex, "可视化 OptiFabric 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 OptiFabric 安装版本列表出错")
End Try
End Sub
@@ -1125,7 +1125,7 @@
Private Sub BtnStart_Click() Handles BtnStart.Click
'确认版本隔离
If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
(Settings.Get("LaunchArgumentIndieV2") = 0 OrElse Settings.Get("LaunchArgumentIndieV2") = 2) Then
(Settings.Get(Of Integer)("LaunchArgumentIndieV2") = 0 OrElse Settings.Get(Of Integer)("LaunchArgumentIndieV2") = 2) Then
If MyMsgBox("你尚未开启版本隔离,多个 MC 版本会共用同一个 Mod 文件夹。" & vbCrLf &
"因此,游戏可能会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
"推荐先在 设置 → 启动选项 → 默认版本隔离 中开启版本隔离!", "版本隔离提示", "取消下载", "继续") = 1 Then
@@ -53,7 +53,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败(ID " & ID & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换分页面失败(ID {ID})")
Finally
AniControlEnabled -= 1
End Try
@@ -79,7 +79,7 @@
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Return
Log("[Control] 按下资源工程列表项:" & LabTitle.Text)
Logger.Info($"按下资源工程列表项:{LabTitle.Text}")
End If
End Sub
Private Sub MyResourceItem_Click(sender As MyResourceItem, e As EventArgs) Handles Me.Click
@@ -89,20 +89,20 @@
For Each Card As MyCard In FrmDownloadResourceDetail.PanResults.Children
If Card.Title <> "" AndAlso Not Card.IsSwapped Then Titles.Add(Card.Title)
Next
Log("[Resource] 记录当前已展开的卡片:" & String.Join("、", Titles))
Logger.Info($"记录当前已展开的卡片:{String.Join("、", Titles)}")
FrmMain.PageCurrent.Additional(1) = Titles
End If
'打开详情页
Dim TargetType As ResourceTypes
Dim TargetInstance As String = Nothing
Dim TargetLoader As ModLoaderTypes = ModLoaderTypes.Any
Dim TargetLoader As ModLoaders = ModLoaders.None
If FrmMain.PageCurrent.Page = FormMain.PageType.Download Then
'从下载页进入
Select Case FrmMain.PageCurrentSub
Case FormMain.PageSubType.DownloadMod
TargetType = ResourceTypes.Mod
TargetInstance = FrmDownloadMod.Content.Loader.Input.GameVersion
TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoader
TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoaders
Case FormMain.PageSubType.DownloadPack
TargetType = ResourceTypes.ModPack
TargetInstance = FrmDownloadPack.Content.Loader.Input.GameVersion
@@ -1,12 +1,28 @@
Public Class PageDownloadResourceDetail
Private ResourceItem As MyResourceItem = Nothing
''' <summary>
''' 当前页面应展示的内容类别。
''' 若当前页面是在查看前置时进入,则为 Any;这也能用于指示当前是否在查看前置。
''' </summary>
Private TargetResourceType As ResourceTypes
Private Project As ResourceProject
Private TargetVersion As String
Private TargetLoaders As ModLoaders
Public Sub LoadPageArguments() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoaders = CType(FrmMain.PageCurrent.Additional(3), ModLoaders)
If TargetLoaders <> ModLoaders.None AndAlso Not TargetLoaders.Flags.IsSingle Then TargetLoaders = TargetLoaders.Flags.First() '强制取第一个
TargetResourceType = FrmMain.PageCurrent.Additional(4)
End Sub
#Region "加载器"
Private ResourceFileLoader As New LoaderTask(Of Integer, List(Of ResourceVersion))(
"Resource File",
Sub(Task)
LoadTargetFromAdditional()
LoadPageArguments()
Dim Result = ResourceVersion.FromProjectId(Project.Id, Project.Platform)
If Task.IsInterrupted Then Return
Task.Output = Result
@@ -14,22 +30,9 @@
'初始化加载器信息
Private Sub PageDownloadResourceDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
LoadTargetFromAdditional()
LoadPageArguments()
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, ResourceFileLoader, AddressOf Load_OnFinish)
End Sub
Public Sub LoadTargetFromAdditional() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
TargetInstance = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
TargetType = FrmMain.PageCurrent.Additional(4)
End Sub
Private Project As ResourceProject
Private TargetInstance As String, TargetLoader As ModLoaderTypes
''' <summary>
''' 当前页面应展示的内容类别。
''' 若当前页面是在查看前置时进入,则也可能为 Any。
''' </summary>
Private TargetType As ResourceTypes
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case ResourceFileLoader.State
@@ -37,7 +40,7 @@
Dim ErrorMessage As String = ""
If ResourceFileLoader.Error IsNot Nothing Then ErrorMessage = ResourceFileLoader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Resource] 下载的文件 json 列表损坏,已自动重试", NotifyLevel.DebugModeOnly)
Logger.Warn("下载的文件 json 列表损坏,已自动重试")
PageLoaderRestart()
End If
End Select
@@ -75,13 +78,13 @@
'筛选类型相同的结果(Modrinth 会返回 Mod、服务端插件、数据包混合的列表)
Private Function GetResults() As List(Of ResourceVersion)
Dim Results As List(Of ResourceVersion) = ResourceFileLoader.Output
Select Case TargetType
Select Case TargetResourceType
Case ResourceTypes.Any
Results = Results.Where(Function(r) r.ResourceType <> ResourceTypes.Plugin).ToList
Case ResourceTypes.Shader, ResourceTypes.ResourcePack
'不筛选光影和资源包,否则原版光影会因为是资源包格式而被过滤(#6473)
Case Else
Results = Results.Where(Function(r) r.ResourceType = TargetType).ToList
Results = Results.Where(Function(r) r.ResourceType = TargetResourceType).ToList
End Select
Return Results
End Function
@@ -132,10 +135,10 @@ GroupDone:
Next
'自动选择
Dim ToCheck As MyRadioButton = Nothing
If TargetInstance <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetInstance))
If TargetVersion <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
If TargetFile IsNot Nothing Then
Dim TargetGroup = GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld)
Dim TargetGroup = GetGroupedVersionName(TargetVersion, GroupedDrop, GroupedOld)
For Each Button As MyRadioButton In PanFilter.Children
If Button.Text <> TargetGroup Then Continue For
ToCheck = Button
@@ -153,12 +156,11 @@ GroupDone:
Private Sub UpdateFilterResult()
Dim Results = GetResults()
Dim TargetCardName As String = If(TargetInstance <> "" OrElse TargetLoader <> ModLoaderTypes.Any,
$"{If(TargetLoader <> ModLoaderTypes.Any, TargetLoader.ToString & " ", "")}{TargetInstance}(所选版本)", "")
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoaders <> ModLoaders.None,
$"{If(TargetLoaders <> ModLoaders.None, TargetLoaders.ToString & " ", "")}{TargetVersion}(所选版本)", "")
'归类到卡片下
Dim Dict As New SortedDictionary(Of String, List(Of ResourceVersion))(New CardSorter(TargetCardName))
Dict.Add("其他", New List(Of ResourceVersion))
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(ModLoaderTypes)))
For Each Version As ResourceVersion In Results
For Each GameVersion In Version.GameVersions
'检查是否符合版本筛选器
@@ -168,12 +170,12 @@ GroupDone:
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
'遍历加入的加载器列表
Dim Loaders As New List(Of String)
If Project.Loaders.Count > 1 AndAlso '工程至少有两个加载器
If Project.ModLoaders.Flags.Count > 1 AndAlso '工程至少有两个加载器
Version.ResourceType = ResourceTypes.Mod AndAlso '是 Mod
McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的
For Each Loader In Version.Loaders
If Loader = ModLoaderTypes.Quilt AndAlso Settings.Get("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
For Each Loader In Version.ModLoaders.Flags
If Loader = ModLoaders.Quilt AndAlso Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt") Then Continue For
Loaders.Add(Loader.ToString & " ")
Next
End If
If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的,确保它在一张卡片里
@@ -186,11 +188,11 @@ GroupDone:
Next
Next
'添加筛选的版本的卡片
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetVersion, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then
Dict.Add(TargetCardName, New List(Of ResourceVersion))
For Each Version As ResourceVersion In Results
If Version.GameVersions.Contains(TargetInstance) AndAlso
(TargetLoader = ModLoaderTypes.Any OrElse Version.Loaders.Contains(TargetLoader)) Then
If Version.GameVersions.Contains(TargetVersion) AndAlso
(TargetLoaders = ModLoaders.None OrElse TargetLoaders.Flags.Intersect(Version.ModLoaders.Flags).Any) Then
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld) = VersionFilter) Then Continue For
@@ -205,16 +207,16 @@ GroupDone:
If Not Pair.Value.Any() Then Continue For
If Pair.Key = TargetCardName.Replace("(所选版本)", "") Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(TargetType = ResourceTypes.ModPack, 9, 8)} '9 是安装,8 是另存为
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(TargetResourceType = ResourceTypes.ModPack, 9, 8)} '9 是安装,8 是另存为
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
PanResults.Children.Add(NewCard)
'确定卡片是否展开
'确定卡片是否默认展开
If Pair.Key = TargetCardName OrElse
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
MyCard.StackInstall(NewStack, If(TargetType = ResourceTypes.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为
MyCard.StackInstall(NewStack, If(TargetResourceType = ResourceTypes.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为
Else
NewCard.IsSwapped = True
End If
@@ -228,15 +230,15 @@ GroupDone:
CType(PanResults.Children(0), MyCard).IsSwapped = False
End If
'替代提示
If Project.Types = ResourceTypes.ModOrDataPack AndAlso (TargetType = ResourceTypes.Mod OrElse TargetType = ResourceTypes.DataPack) Then
If Project.Types = ResourceTypes.ModOrDataPack AndAlso (TargetResourceType = ResourceTypes.Mod OrElse TargetResourceType = ResourceTypes.DataPack) Then
HintAlternative.Visibility = Visibility.Visible
HintAlternative.Text = If(TargetType = ResourceTypes.Mod,
HintAlternative.Text = If(TargetResourceType = ResourceTypes.Mod,
"以下是该项目的 Mod 版本。点击这里查看其数据包版本。", "以下是该项目的数据包版本。点击这里查看其 Mod 版本。")
Else
HintAlternative.Visibility = Visibility.Collapsed
End If
Catch ex As Exception
Log(ex, "可视化工程下载列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化工程下载列表出错")
End Try
End Sub
Private Function GetGroupedVersionName(Name As String, GroupedByDrop As Boolean, FoldOld As Boolean) As String
@@ -303,16 +305,18 @@ GroupDone:
Dim Loaders As New List(Of LoaderBase)
Dim Target As String = $"{McFolderSelected}versions\{InstanceName}\原始整合包.{If(Project.Platform = ResourcePlatforms.CurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = ResourceItem.PathLogo.ActualSource
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderDownload("下载整合包文件", {
File.ToNetFile(Target, ResourceVersion.DownloadReason.Standalone, File.GameVersions.FirstOrDefault, File.ModLoaders)
}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() ModpackInstall(Target, InstanceName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
Sub() ModpackInstall(Target, InstanceName, If(FileUtils.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
Sub(MyLoader)
Select Case MyLoader.State
Case LoadState.Failed
Hint(MyLoader.Name & "失败:" & MyLoader.Error.GetBrief(), HintType.Red)
Hint(MyLoader.Name & "失败:" & MyLoader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted
Hint(MyLoader.Name & "已取消!", HintType.Blue)
Case LoadState.Loading
@@ -326,7 +330,7 @@ GroupDone:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "下载资源整合包失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "下载资源整合包失败")
End Try
End Sub
'资源下载;整合包另存为
@@ -356,13 +360,13 @@ GroupDone:
End Select
Dim IsInstanceSuitable As Func(Of McInstance, Boolean) = Nothing
'获取资源所需的加载器
Dim AllowedLoaders As New List(Of ModLoaderTypes)
If File.Loaders.Any Then
AllowedLoaders = File.Loaders
ElseIf Project.Loaders.Any Then
AllowedLoaders = Project.Loaders
Dim AllowedLoaders As ModLoaders = ModLoaders.None
If File.ModLoaders <> ModLoaders.None Then
AllowedLoaders = File.ModLoaders
ElseIf Project.ModLoaders <> ModLoaders.None Then
AllowedLoaders = Project.ModLoaders
End If
Log($"[Resource] {Desc}要求的加载器种类:" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
Logger.Info($"{Desc}要求的加载器种类:{AllowedLoaders}")
'判断某个版本是否符合资源要求
IsInstanceSuitable =
Function(Instance As McInstance)
@@ -403,21 +407,16 @@ GroupDone:
End Function) Then Return False
End If
'加载器
If Not AllowedLoaders.Any() Then Return True '无要求
If AllowedLoaders.Contains(ModLoaderTypes.Forge) AndAlso Instance.Version.HasForge Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.Fabric) AndAlso Instance.Version.HasFabric Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.NeoForge) AndAlso Instance.Version.HasNeoForge Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.LiteLoader) AndAlso Instance.Version.HasLiteLoader Then Return True
Return False
Return AllowedLoaders = ModLoaders.None OrElse AllowedLoaders.Flags.Intersect(Instance.Version.ModLoaders.Flags).Any
End Function
'获取常规资源默认下载位置
If CachedFolder.ContainsKey(File.ResourceType) Then
DefaultFolder = CachedFolder(File.ResourceType)
Log($"[Resource] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
Logger.Info($"使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
ElseIf McInstanceSelected IsNot Nothing AndAlso IsInstanceSuitable(McInstanceSelected) Then
DefaultFolder = $"{McInstanceSelected.PathIndie}{SubFolder}"
DirectoryUtils.Create(DefaultFolder)
Log($"[Resource] 使用当前版本作为默认下载位置:{DefaultFolder}")
Logger.Info($"使用当前版本作为默认下载位置:{DefaultFolder}")
Else
'查找所有可能的版本
Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished
@@ -426,21 +425,21 @@ GroupDone:
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
End If
Dim SuitableInstanceList = McInstanceList.Values.SelectMany(Function(l) l).Where(Function(v) IsInstanceSuitable(v)).
Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}"))
Select(Function(v) DirectoryUtils.GetInfo($"{v.PathIndie}{SubFolder}"))
If SuitableInstanceList.Any Then
Dim SelectedInstance = SuitableInstanceList.
OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
First()
DefaultFolder = SelectedInstance.FullName
DefaultFolder = PathUtils.RemoveExtendedPrefix(SelectedInstance.FullName)
DirectoryUtils.Create(DefaultFolder)
Log($"[Resource] 使用适合的游戏版本作为默认下载位置:{DefaultFolder}")
Logger.Info($"使用适合的游戏版本作为默认下载位置:{DefaultFolder}")
Else
DefaultFolder = McFolderSelected
If NeedLoad Then
Hint($"当前 MC 文件夹中没有找到合适的版本!")
Else
Log("[Resource] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
Logger.Info("由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If
End If
End If
@@ -452,7 +451,7 @@ GroupDone:
Else
Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - ").
Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
Select Case Settings.Get("ToolDownloadTranslateV2")
Select Case Settings.Get(Of Integer)("ToolDownloadTranslateV2")
Case 0
FileName = $"【{ChineseName}】{File.FileName}"
Case 1
@@ -470,17 +469,18 @@ GroupDone:
Sub()
'弹窗要求选择保存位置
Dim Target As String
Target = SelectSaveFile("选择保存位置", FileName,
Desc & "文件|" &
If(File.ResourceType = ResourceTypes.Mod,
If(File.FileName.EndsWithF(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWithF(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Return
Dim Ext As String = If(File.ResourceType = ResourceTypes.Mod,
If(File.FileName.EndsWithF(".litemod"), "litemod", "jar"),
If(File.FileName.EndsWithF(".mrpack"), "mrpack", "zip"))
Target = Dialogs.SaveFile("选择保存位置", FileName, DefaultFolder, {(Ext, Desc & "文件")})
If Target Is Nothing Then Return
'构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & Path.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder Then CachedFolder(File.ResourceType) = GetPathFromFullPath(Target)
Dim LoaderName As String = Desc & "下载:" & PathUtils.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder Then CachedFolder(File.ResourceType) = PathUtils.RemoveLastPart(Target)
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
Loaders.Add(New LoaderDownload("下载文件", {
File.ToNetFile(Target, If(TargetResourceType = ResourceTypes.Any, ResourceVersion.DownloadReason.Dependency, ResourceVersion.DownloadReason.Standalone))
}) With {.ProgressWeight = 6, .Block = True})
'启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(1)
@@ -489,7 +489,7 @@ GroupDone:
FrmMain.BtnExtraDownload.Ribble()
End Sub)
Catch ex As Exception
Log(ex, "保存资源文件失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "保存资源文件失败")
End Try
End Sub, "Download Resource Detail Save")
End Sub
@@ -506,8 +506,8 @@ GroupDone:
'Mod / 数据包 互相跳转
Private Sub HintAlternative_Click() Handles HintAlternative.Click
TargetType = If(TargetType = ResourceTypes.Mod, ResourceTypes.DataPack, ResourceTypes.Mod)
FrmMain.PageCurrent.Additional(4) = TargetType '加载器会从这里重新拿数据
TargetResourceType = If(TargetResourceType = ResourceTypes.Mod, ResourceTypes.DataPack, ResourceTypes.Mod)
FrmMain.PageCurrent.Additional(4) = TargetResourceType '加载器会从这里重新拿数据
PageLoaderRestart(IsForceRestart:=True)
End Sub
@@ -522,7 +522,7 @@ GroupDone:
If Not Deps.Any() Then Return
Deps = Deps.Where(
Function(dep)
If Not ResourceProject.Cache.ContainsKey(dep) Then Log($"[Resource] 未找到 ID {dep} 的前置信息", NotifyLevel.DebugModeOnly)
If Not ResourceProject.Cache.ContainsKey(dep) Then Logger.Warn($"未找到 ID {dep} 的前置信息")
Return ResourceProject.Cache.ContainsKey(dep)
End Function).ToList
'添加开头间隔
@@ -49,9 +49,10 @@
<local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" Margin="10,0,0,0">
<local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="NeoForge" Tag="6" />
<local:MyComboBoxItem Content="NeoForge" Tag="16" />
<local:MyComboBoxItem Content="Fabric" Tag="4" />
<local:MyComboBoxItem Content="Quilt" Tag="5" />
<local:MyComboBoxItem Content="Quilt" Tag="8" />
<local:MyComboBoxItem Content="LiteLoader" Tag="2" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" />
@@ -74,7 +74,7 @@ Public Class PageResource
Public Shared TargetName As String = Nothing
'在点击 MyResourceItem 时会获取 Loader 的输入,以使资源详情页面可以应用相同的筛选项
Public Loader = ResourceSearcher.GetLoader(AddressOf LoaderInput)
Public Loader As LoaderTask(Of ResourceSearcher.SearchRequest, Integer) = ResourceSearcher.GetLoader(AddressOf LoaderInput)
Private Sub PageResource_Loaded(sender As Object, e As EventArgs) Handles Me.Loaded
Static IsFirstLoaded As Boolean = False
@@ -126,7 +126,7 @@ Public Class PageResource
.SearchText = TextSearchName.Text
.GameVersion = GameVersion
.Tag = ComboSearchTag.SelectedItem.Tag
.ModLoader = If(PageType = ResourceTypes.Mod, Val(ComboSearchLoader.SelectedItem.Tag), ModLoaderTypes.Any)
.ModLoaders = If(PageType = ResourceTypes.Mod, Val(ComboSearchLoader.SelectedItem.Tag), ModLoaders.None)
.Sources = CType(Val(ComboSearchSource.SelectedItem.Tag), ResourcePlatforms)
End With
Return Request
@@ -144,14 +144,14 @@ Public Class PageResource
'结果 UI 化
Private Sub Load_OnFinish()
Try
Log($"[Resource] 开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
Logger.Info($"开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
'列表项
PanProjects.Children.Clear()
Dim Index As Integer = Math.Min(Page * PAGE_SIZE, Storage.Results.Count - 1)
For Each Result In Storage.Results.GetRange(Index, Math.Min(Storage.Results.Count - Index, PAGE_SIZE))
PanProjects.Children.Add(Result.ToResourceItem(
ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing,
ShowLoaderDesc:=Loader.Input.ModLoader = ModLoaderTypes.Any AndAlso (PageType = ResourceTypes.Mod OrElse PageType = ResourceTypes.ModPack)))
ShowLoaderDesc:=Loader.Input.ModLoaders = ModLoaders.None AndAlso (PageType = ResourceTypes.Mod OrElse PageType = ResourceTypes.ModPack)))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
@@ -177,7 +177,7 @@ Public Class PageResource
'强制返回顶部
ScrollToTop()
Catch ex As Exception
Log(ex, $"可视化{TypeNameSpaced}列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"可视化{TypeNameSpaced}列表出错")
End Try
End Sub
@@ -188,7 +188,7 @@ Public Class PageResource
Dim ErrorMessage As String = ""
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log($"[Download] 下载的{TypeNameSpaced}列表 json 文件损坏,已自动重试", NotifyLevel.DebugModeOnly)
Logger.Warn($"下载的{TypeNameSpaced}列表 json 文件损坏,已自动重试")
CType(Parent, MyPageRight).PageLoaderRestart()
End If
End Select
@@ -208,7 +208,7 @@ Public Class PageResource
CardPages.IsEnabled = False
Page = NewPage
FrmMain.BackToTop()
Log($"[Download] {TypeName}:切换到第 {Page + 1} 页")
Logger.Info($"{TypeName}:切换到第 {Page + 1} 页")
RunInThread(
Sub()
Thread.Sleep(100) '等待向上滚的动画结束