InfStarMC/PCL-ISE
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

2.13.0.0

Browse Source
This commit is contained in:
龙腾猫跃
2026-07-02 23:24:29 +08:00
parent 124e3be6bf
commit c6d0457946
193 changed files with 3112 additions and 3747 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.editorconfig
+11
View File
@@ -1,12 +1,23 @@
# 如果要从更高级别的目录继承 .editorconfig 设置，请删除以下行
root = true
[*]
charset = utf-8
[*.cs]
# IDE0320: 使匿名函数成为静态函数
csharp_prefer_static_anonymous_function = false
# CS8618: 在退出构造函数时，不可为 null 的字段必须包含非 null 值。请考虑添加 "required" 修饰符或声明为可为 null。
dotnet_diagnostic.CS8618.severity = suggestion
# IDE0305: 使用 [.. ] 简化集合初始化
dotnet_diagnostic.IDE0305.severity = none
# CS8524: switch 表达式不会处理其输入类型的某些值(它不是穷举)，这包括未命名的枚举值。
dotnet_diagnostic.CS8524.severity = suggestion
[*.{cs,vb}]
# IDE0028: 简化集合初始化
dotnet_style_collection_initializer = true:silent
# IDE0130: 命名空间与文件夹结构不匹配
dotnet_diagnostic.IDE0130.severity = silent
MeloongCore
+1 -1
Submodule MeloongCore updated: 4d389f4375...d3b9ccde9c
PCLCS/Configs.cs
+11
View File
@@ -0,0 +1,11 @@
namespace PCLCS;
public static class Configs {
/// <summary>当前 Java 相关配置的版本。0 代表尚未从老的 Settings 系统中迁移。</summary>
public static readonly ConfigEntry<int> JavaConfigVersion = new(nameof(JavaConfigVersion), 0);
public static readonly ConfigEntry<ConcurrentList<Java>> JavaList = new(nameof(JavaList), []);
public static readonly ConfigEntry<List<string>> JavaRemovedList = new(nameof(JavaRemovedList), []);
public static readonly ConfigEntry<bool> InstanceMigratedJava = new(nameof(InstanceMigratedJava), false);
public static readonly ConfigEntry<Java> InstanceForcedJava = new(nameof(InstanceForcedJava), null);
}
PCLCS/Constants.cs
+7 -3
View File
@@ -63,13 +63,17 @@ public static class Versions {
/// <summary>
/// 土豆码版本号。
/// </summary>
public const char POTATO_VERSION = '1';
public const char PotatoVersion = '1';
/// <summary>
/// 版本管理中 Mod 信息缓存的版本号。
/// </summary>
public const int LOCAL_MOD_CACHE_VERSION = 17;
public const int LocalModCacheVersion = 17;
/// <summary>
/// Minecraft 本地实例信息缓存的版本号。
/// </summary>
public const int MCINSTANCE_CACHE_VERSION = 38;
public const int McInstanceCacheVersion = 38;
/// <summary>
/// Java 相关配置的版本号。
/// </summary>
public const int JavaConfigVersion = 1;
}
PCLCS/Java.cs
+213
View File
@@ -0,0 +1,213 @@
namespace PCLCS;
/// <summary>
/// 单个 Java 的实例。
/// </summary>
[Serializable] public class Java(string folder, Version? version = null) {
/// <summary>
/// java.exe 文件所在的文件夹路径，这通常是 bin 文件夹。以 \ 结尾。
/// </summary>
public readonly string Folder = PathUtils.AddSlashSuffix(PathUtils.ForCompare(folder));
/// <summary>
/// java.exe 文件的完整路径。
/// </summary>
[JsonIgnore] public string JavaExePath => Path.Combine(Folder, "java.exe");
/// <summary>
/// Java 的版本号（例如 16.0.1），保证 <see cref="Version.Major"/> 为其主版本。
/// <para/> 若为 null，则还需要调用 <see cref="CheckAsync"/> 以获取版本号。
/// </summary>
public Version? Version = version;
/// <summary>
/// 检查该 Java 是否存在问题，并获取其版本号。
/// 返回其是否通过了检查。
/// </summary>
public async Task<bool> CheckAsync(CancellationToken cancellationToken = default) {
if (Interlocked.Exchange(ref isChecked, 1) == 1 && available != null) return available!.Value; // 已检查过
string? output = null;
try {
if (!FileUtils.Exists(JavaExePath)) throw new FileNotFoundException("未找到 java.exe 文件", JavaExePath);
// 运行 -version
output = (await TaskUtils.RunProgramAsync(JavaExePath, "-version", 15000, cancellationToken: cancellationToken).NoCapture()).Output.Lower();
if (output == "") throw new InvalidOperationException("尝试运行该 Java 失败");
Logger.Trace($"Java 检查输出：{JavaExePath}{Environment.NewLine}{output}");
if (output.Contains("/lib/ext exists")) throw new InvalidOperationException("无法运行该 Java，请在删除 Java 文件夹中的 /lib/ext 文件夹后再试");
if (output.Contains("a fatal error") || output.Contains("error: ")) throw new InvalidOperationException("无法运行该 Java，该 Java 或系统存在问题");
// 获取版本号
var versionString = (output.RegexSeek(@"(?<=version "")[^""]+") ?? output.RegexSeek("(?<=openjdk )[0-9]+"))?.Replace("_", ".").Replace("+", ".").BeforeFirst("-");
if (string.IsNullOrEmpty(versionString)) throw new InvalidOperationException($"未找到该 Java 的版本号{(output.Length < 500 ? $"\n原始输出为：\n{output}" : "")}");
if (versionString.StartsWithF("1.")) versionString = versionString!.AfterFirst("."); // 去除开头的 1.
var segments = versionString!.Split(".", true).ToList();
while (segments.Count < 4) segments.Add("0");
Version = new Version(segments.Take(4).Join("."));
if (Version.Major is <= 4 or >= 100) throw new InvalidOperationException($"分析详细信息失败，获取的版本为 {Version}{(output.Length < 500 ? $"\n原始输出为：\n{output}" : "")}");
if (!output.Contains("64-bit")) throw new InvalidOperationException("该 Java 为 32 位版本，请安装 64 位的 Java");
Logger.Info($"检查 Java 成功：{this}");
available = true;
} catch (Exception ex) {
if (ex.IsCanceled()) {
isChecked = 0;
throw;
}
Logger.Warn($"检查 Java 失败（{JavaExePath}），其输出为：\n{output ?? "无程序输出"}");
available = false;
}
return available!.Value;
}
[JsonIgnore] private int isChecked = 0;
/// <summary>若已进行过检查，表示该检查是否成功。若未检查，则为 null。</summary>
[JsonIgnore] internal bool? available = null;
/// <summary>用户友好的描述文本。</summary>
public override string ToString()
=> $"Java {Version?.Major.ToString() ?? "尚未检查"} ({Version})：{Folder}";
}
public static class JavaUtils {
/// <summary>
/// 检查所有指定的 Java 是否存在问题，并获取其版本号。
/// </summary>
/// <returns>所有通过检查的 Java。</returns>
public static async Task<List<Java>> CheckAllAsync(IEnumerable<Java> javas, CancellationToken cancellationToken = default, ProgressProvider? progress = null) {
await TaskUtils.WhenAll(javas.Where(j => j.available == null).Select(
async java => await java.CheckAsync(cancellationToken).NoCapture()
), progress).NoCapture();
return javas.Where(j => j.available == true).ToList();
}
/// <summary>
/// 将 Java 列表进行排序。
/// 这同时会检查所有未检查的 Java。
/// </summary>
public static async Task<List<Java>> SortAsync(List<Java> javas, CancellationToken cancellationToken = default, ProgressProvider? progress = null) {
javas = await JavaUtils.CheckAllAsync(javas, cancellationToken, progress).NoCapture();
javas.Sort((left, right) => {
// 优先使用带完整 Java 的文件夹列表中的 Java
var isLeftInCandidateFolder = JavaUtils.CandidateFolders.Any(folder => PathUtils.IsParentOf(folder, left.Folder));
var isRightInCandidateFolder = JavaUtils.CandidateFolders.Any(folder => PathUtils.IsParentOf(folder, right.Folder));
if (isLeftInCandidateFolder != isRightInCandidateFolder) return isLeftInCandidateFolder ? -1 : 1;
// 其次优先使用主版本号接近 25 的 Java
var leftDistance = left.Version is null ? int.MaxValue : Math.Abs(left.Version.Major - 25);
var rightDistance = right.Version is null ? int.MaxValue : Math.Abs(right.Version.Major - 25);
return leftDistance.CompareTo(rightDistance);
});
return javas;
}
#region 搜索
/// <summary>
/// 存在完整 Java 的文件夹列表。
/// </summary>
internal static readonly List<string> CandidateFolders = [
Paths.AppData + @".minecraft\runtime\", // 这也是 PCL 下载 Java 的路径
Paths.AppData + @".hmcl\java\",
Paths.AppData + @"ATLauncher\runtimes\minecraft\",
Paths.AppData + @"ModrinthApp\meta\java_versions\",
Paths.AppData + @"PrismLauncher\java\",
Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) + @"\curseforge\minecraft\Install\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) + @"\.jdks\",
Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) + @"\.sdkman\candidates\java\",
Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) + @"\.ftba\bin\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) + @"\Packages\Microsoft.4297127D64EC6_8wekyb3d8bbwe\LocalCache\Local\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFilesX86) + @"\Minecraft Launcher\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFilesX86) + @"\Minecraft\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) + @"\Curse\Minecraft\Install\runtime\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Java\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Eclipse Adoptium\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Amazon Corretto\",
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Zulu\",
..DirectoryUtils.EnumerateDirectories(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) + @"\Microsoft\", searchPattern: "jdk-*"),
// 环境变量
..(Environment.GetEnvironmentVariable("JDK_HOME") + ";" + Environment.GetEnvironmentVariable("JAVA_HOME")).
Split(";", true).Select(path => path.Trim(' ', '"'))
];
/// <summary>
/// 从常见文件夹和环境变量中搜索 Java，并将搜索结果写入设置。
/// </summary>
public static async Task RefreshListAsync(CancellationToken c = default, ProgressProvider? p = null) {
// 搜索
List<Java> javaList = await SearchFoldersAsync(true, CandidateFolders, c, p?.SplitTo(0.5)).NoCapture();
// 将新发现的 Java 排在最前，原有列表保留既有顺序排在后面
var oldJavaList = Configs.JavaList.Get()!;
oldJavaList = await JavaUtils.CheckAllAsync(oldJavaList, c, p?.SplitTo(0.9)).NoCapture(); // 检查原有列表中的 Java
HashSet<string> oldJavaFolders = new(oldJavaList.Select(j => j.Folder), StringComparer.OrdinalIgnoreCase);
javaList.RemoveIf(j => oldJavaFolders.Contains(j.Folder)); // 此时 javaList 中只剩下新发现的 Java
javaList = await JavaUtils.SortAsync(javaList, c).NoCapture(); // 将所有新发现的 Java 按优先级排序
javaList.AddRange(oldJavaList);
javaList = javaList.DistinctBy(j => j.Folder.Lower()).ToList();
// 删掉已被移除的 Java
javaList.RemoveIf(j => Configs.JavaRemovedList.Get()!.Contains(j.Folder, StringComparer.OrdinalIgnoreCase));
// 写入设置
Configs.JavaList.Set([..javaList]);
Logger.Info($"Java 搜索完成，发现 {javaList.Count} 个 Java");
}
/// <summary>
/// 并行搜索所有指定的文件夹及其子文件夹中的 Java，并检查其有效性。
/// </summary>
public static async Task<List<Java>> SearchFoldersAsync(bool includeSubDirectories, IEnumerable<string> folders, CancellationToken cancellationToken = default, ProgressProvider? progress = null) {
// 并行搜索
ConcurrentBag<(string Folder, bool HasReparsePoint, bool IsSpecialPath)> results = [];
await TaskUtils.ForEachAsync(folders.Distinct(StringComparer.OrdinalIgnoreCase), 4, async (folder, cp) => {
await Task.Run(() => {
try {
foreach (var file in DirectoryUtils.EnumerateFiles(folder, includeSubDirectories, "java.exe")) {
cancellationToken.ThrowIfCancellationRequested();
string targetFolder = PathUtils.AddSlashSuffix(PathUtils.ForCompare(PathUtils.RemoveLastPart(file)));
// 判断文件夹是否包含重解析点（例如符号链接）
static bool HasReparsePoint(FileSystemInfo info) {
do {
if (info.Attributes.HasFlag(FileAttributes.ReparsePoint)) return true;
info = info is FileInfo fileInfo ? fileInfo.Directory : ((DirectoryInfo) info).Parent;
} while (info is not null);
return false;
}
// 结果
var hasReparsePoint = HasReparsePoint(FileUtils.GetInfo(Path.Combine(targetFolder, "java.exe")));
var isSpecialPath = targetFolder.Contains("java8path_target_") || targetFolder.Contains("javapath_target_") || targetFolder.Contains("javatmp") || targetFolder.Contains("system32");
results.Add((targetFolder, hasReparsePoint, isSpecialPath));
}
} catch (UnauthorizedAccessException) {
Logger.Info($"快速查找 Java 时没有权限（{folder}）");
} catch (Exception ex) {
ex.ThrowIfCanceled();
Logger.Warn(ex, $"快速查找 Java 时出错（{folder}）");
}
}, cancellationToken).NoCapture();
}, cancellationToken, progress?.SplitTo(0.2)).NoCapture();
if (!results.Any()) return [];
// 筛除重解析点
if (results.All(r => r.HasReparsePoint)) {
Logger.Warn("找到的所有 Java 都包含重解析点，保留全部结果");
} else if (results.Any(r => r.HasReparsePoint)) {
Logger.Info($"找到以下的 Java 包含重解析点，将它们从列表中排除：{results.Where(r => r.HasReparsePoint).Select(r => r.Folder).Join('、')}");
results = [..results.Where(r => !r.HasReparsePoint)];
}
// 筛除特殊路径
if (results.All(r => r.IsSpecialPath)) {
Logger.Warn("找到的所有 Java 都包含特殊路径，保留全部结果");
} else if (results.Any(r => r.IsSpecialPath)) {
Logger.Info($"找到以下的 Java 包含特殊路径，将它们从列表中排除：{results.Where(r => r.IsSpecialPath).Select(r => r.Folder).Join('、')}");
results = [..results.Where(r => !r.IsSpecialPath)];
}
// 检查并返回
List<Java> javaList = results.Select(r => r.Folder).Distinct(StringComparer.OrdinalIgnoreCase).Select(folder => new Java(folder)).ToList();
javaList = (await JavaUtils.CheckAllAsync(javaList, cancellationToken, progress?.SplitTo(1)).NoCapture()).ToList();
javaList = await JavaUtils.SortAsync(javaList, cancellationToken).NoCapture();
Logger.Info($"快速查找 Java 完成，共有 {javaList.Count} 个候选：{javaList.Join('、')}");
return javaList;
}
#endregion
}
PCLCS/PCLCS.csproj
+16 -1
View File
@@ -1,4 +1,4 @@
<Project Sdk="Microsoft.NET.Sdk">
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net48</TargetFramework>
@@ -25,10 +25,13 @@
<Using Include="System.Diagnostics.CodeAnalysis" />
<Using Include="System.Collections" />
<Using Include="System.Collections.Generic" />
<Using Include="System.Collections.Concurrent" />
<Using Include="System.Text" />
<Using Include="System.Net" />
<Using Include="System.Runtime.CompilerServices" />
<Using Include="System.Runtime.InteropServices" />
<Using Include="Newtonsoft.Json" />
<Using Include="Newtonsoft.Json.Linq" />
<Using Include="MeloongCore" />
<Using Include="MeloongCore.Extensions" />
<Using Include="MeloongCore.Wpf" />
@@ -50,4 +53,16 @@
<Optimize>True</Optimize>
</PropertyGroup>
<!-- 内嵌的资源 -->
<ItemGroup>
<None Remove="Resource\WikiEntries.txt" />
<EmbeddedResource Include="Resource\WikiEntries.txt" LogicalName="Resource\WikiEntries.txt" />
</ItemGroup>
<ItemGroup>
<Reference Include="Microsoft.VisualBasic" />
<Reference Include="Newtonsoft.Json">
<HintPath>..\Plain Craft Launcher 2\Resources\Newtonsoft.Json.dll</HintPath>
</Reference>
</ItemGroup>
</Project>
PCLCS/Resource/Resource.cs
+1 -1
View File
@@ -1,4 +1,4 @@
namespace PCLCS;
namespace PCLCS;
public static class Resource {
/// <summary>
Plain Craft Launcher 2/Resources/moddata.txt → PCLCS/Resource/WikiEntries.txt
+1 -1
View File
File diff suppressed because one or more lines are too long
PCLCS/Resource/WikiEntry.cs
+83
View File
@@ -0,0 +1,83 @@
namespace PCLCS;
/// <summary>
/// MC 百科条目。
/// <para/>使用 <see cref="WikiEntry.All"/> 获取所有条目。
/// </summary>
public class WikiEntry {
/// <summary>
/// 在 MC 百科中的对应 ID。
/// </summary>
public int Id;
/// <summary>
/// 中文译名。
/// <c>null</c> 代表没有翻译。
/// </summary>
public string? ChineseName;
/// <summary>
/// 各个 Mod 平台的 Slug（例如 advanced-solar-panels）。
/// 若没有对应键则为不在该平台上。
/// </summary>
public Dictionary<ResourcePlatforms, string> Slugs = [];
/// <summary>
/// MC 百科的浏览量逆序排行，1 代表浏览量最低。
/// </summary>
public int Popularity;
/// <summary>
/// 内置数据库中的所有 MC 百科条目。
/// </summary>
public static readonly Lazy<List<WikiEntry>> All = new(() => {
var dataLines = FileUtils.ReadAsLines(@"Resource\WikiEntries.txt", type: typeof(WikiEntry)).ToList();
// 读取最后一行的浏览量
Queue<int> popularities = [];
for (int i = 0; i < dataLines[^1].Length; i += 3) { // 将每 3 个字符切割成一个元素
popularities.Enqueue(int.Parse(dataLines[^1].Substring(i, 3).ConvertRadix(86, 10)));
}
dataLines.RemoveAt(dataLines.Count - 1);
// 解析每一行
List<WikiEntry> results = [];
var lineNumber = 0;
foreach (var lineData in dataLines) {
lineNumber++;
if (lineData == "") continue;
var popularity = popularities.Dequeue();
foreach (var entryData in lineData.Split('¨')) {
var entry = new WikiEntry();
var parts = entryData.Split('|');
var slugs = parts[0];
if (slugs.StartsWithF("@")) {
entry.Slugs.Add(ResourcePlatforms.Modrinth, slugs.Replace("@", ""));
} else if (slugs.EndsWithF("@")) {
entry.Slugs.Add(ResourcePlatforms.CurseForge, slugs.TrimEnd('@'));
entry.Slugs.Add(ResourcePlatforms.Modrinth, entry.Slugs[ResourcePlatforms.CurseForge]);
} else if (slugs.Contains("@")) {
var splitSlugs = slugs.Split('@');
entry.Slugs.Add(ResourcePlatforms.CurseForge, splitSlugs[0]);
entry.Slugs.Add(ResourcePlatforms.Modrinth, splitSlugs[1]);
} else {
entry.Slugs.Add(ResourcePlatforms.CurseForge, slugs);
}
entry.Id = lineNumber;
entry.Popularity = popularity;
if (parts.Length >= 2) {
entry.ChineseName = parts[^1]; // 最后一项
if (entry.ChineseName.Contains("*")) { // 处理 *
var englishName = entry.Slugs.Values.First().Replace("-", " ").Capitalize();
entry.ChineseName = entry.ChineseName.Replace("*", $" ({englishName})");
}
}
results.Add(entry);
}
}
return results;
});
public override string ToString()
=> $"{Slugs.GetOrDefault(ResourcePlatforms.CurseForge)}&{Slugs.GetOrDefault(ResourcePlatforms.Modrinth)}|{Id}|{ChineseName}，浏览量 {Popularity}";
}
Plain Craft Launcher 2/Application.xaml
+2 -34
View File
@@ -1,4 +1,4 @@
<Application x:Class="Application"
<Application x:Class="Application"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:behaviors="clr-namespace:PCL.Controls.Behaviors"
@@ -132,33 +132,6 @@
<Setter Property="FontFamily" Value="Resources/#PCL English, Microsoft YaHei UI" />
</Style>
<!-- ToolTip -->
<Style TargetType="ToolTip">
<Setter Property="Template">
<Setter.Value>
<ControlTemplate>
<Border Loaded="TooltipLoaded" Unloaded="TooltipUnloaded" BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1.5" CornerRadius="4" MaxWidth="500" Background="#E5FFFFFF" Margin="0,0,4,4" SnapsToDevicePixels="True">
<Border.Effect>
<DropShadowEffect Opacity="0.3" BlurRadius="4" ShadowDepth="2" Color="{DynamicResource ColorObject1}" />
</Border.Effect>
<TextBlock Text="{TemplateBinding ContentControl.Content}" TextWrapping="Wrap" Foreground="{DynamicResource ColorBrush1}" Margin="7,5" FontSize="12"/>
</Border>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<Style x:Key="ExtendTextToolTip" TargetType="ToolTip">
<Setter Property="Template">
<Setter.Value>
<ControlTemplate>
<Border Loaded="TooltipLoaded" Unloaded="TooltipUnloaded" BorderBrush="{DynamicResource ColorBrush1}" BorderThickness="1" CornerRadius="3" Background="White" Margin="0,0,4,4" SnapsToDevicePixels="True">
<TextBlock Text="{TemplateBinding ContentControl.Content}" TextWrapping="Wrap" Foreground="{DynamicResource ColorBrush1}" Margin="7,5" FontSize="12"/>
</Border>
</ControlTemplate>
</Setter.Value>
</Setter>
</Style>
<!-- ScrollViewer -->
<Style x:Key="MyThumb" TargetType="Thumb">
<Setter Property="Stylus.IsPressAndHoldEnabled" Value="false"/>
@@ -287,7 +260,7 @@
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="local:MyTextBox">
<Grid SnapsToDevicePixels="True" ToolTip="{TemplateBinding ToolTip}">
<Grid SnapsToDevicePixels="True">
<Grid.RowDefinitions>
<RowDefinition MinHeight="28" />
<RowDefinition Height="Auto" />
@@ -473,11 +446,6 @@
</Style>
<Style TargetType="ComboBoxItem" x:Key="MyComboBoxItem">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="ToolTipService.Placement" Value="Relative" />
<Setter Property="ToolTipService.VerticalOffset" Value="-2" />
<Setter Property="ToolTipService.HorizontalOffset" Value="200" />
<Setter Property="ToolTipService.InitialShowDelay" Value="150" />
<Setter Property="ToolTipService.BetweenShowDelay" Value="150" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="Background" Value="{StaticResource ColorBrushTransparent}" />
<Setter Property="Template">
Plain Craft Launcher 2/Application.xaml.vb
+20 -21
View File
@@ -1,4 +1,4 @@
Imports System.Reflection
Imports System.Reflection
Imports System.Windows.Threading
Imports Microsoft.Win32
@@ -7,6 +7,10 @@ Public Class Application
'开始
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
Try
'核心初始化
MeloongCore.Main.Init("PCL")
MeloongCore.Wpf.Main.Init()
Logger.Instance = New PclLogger With {.logFolder = Paths.BaseThenName, .MinLevel = If(ModeDebug, LogLevel.Trace, LogLevel.Info)}
'提升主线程优先级
Thread.CurrentThread.Priority = ThreadPriority.Highest
'执行开发版测试
@@ -64,12 +68,12 @@ Public Class Application
End If
'初始化文件结构
Try
DirectoryUtils.Create(PathExeFolder & "PCL\Pictures\")
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\")
CheckPermissionWithException(PathExeFolder & "PCL\")
DirectoryUtils.Create(Paths.Base & "PCL\Pictures\")
DirectoryUtils.Create(Paths.Base & "PCL\Musics\")
CheckPermissionWithException(Paths.Base & "PCL\")
Catch ex As Exception
MsgBox($"PCL 没有对当前文件夹的权限（{PathExeFolder}PCL\），请尝试：" & vbCrLf &
"1. 将 PCL 移动到其他文件夹" & If(PathExeFolder.StartsWithF("C:", True), "，例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
MsgBox($"PCL 没有对当前文件夹的权限（{Paths.Base}PCL\），请尝试：" & vbCrLf &
"1. 将 PCL 移动到其他文件夹" & If(Paths.Base.StartsWithF("C:", True), "，例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
"2. 删除当前目录中的 PCL 文件夹，然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性，打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误")
@@ -90,16 +94,11 @@ RetryCacheCheck:
End If
End Try
DirectoryUtils.Create(PathTemp & "Cache\")
DirectoryUtils.Create(PathAppdata)
DirectoryUtils.Create(Paths.AppDataThenName)
'要求单例
WaitingMutex(e)
'设置 ToolTipService 默认值
ToolTipService.InitialShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(300))
ToolTipService.BetweenShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(400))
ToolTipService.ShowDurationProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(9999999))
ToolTipService.PlacementProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(Primitives.PlacementMode.Bottom))
ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0))
ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
ToolTipService.InitialShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(100))
'设置网络配置默认值
ServicePointManager.Expect100Continue = False
ServicePointManager.DefaultConnectionLimit = 10000
@@ -114,8 +113,7 @@ RetryCacheCheck:
FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True)
End If
'日志初始化
MeloongCore.Main.Init(New PclLogger With {.logFolder = PathUtils.CurrentFolder & "PCL", .MinLevel = If(ModeDebug, LogLevel.Trace, LogLevel.Info)})
'基础信息
Logger.Info($"程序版本：{VersionDisplay} ({VersionCode}{If(CommitHash = "", "", $"，#{CommitHash}")})")
If BuildType = BuildTypes.Snapshot Then
Logger.Info($"识别码：{Identify}{If(ThemeCheckOne(9), "，已解锁反馈主题", "，未解锁反馈主题")}")
@@ -124,14 +122,15 @@ RetryCacheCheck:
End If
Logger.Info($"程序路径：{PathExe}")
Logger.Info($"系统编码：{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Logger.Info($"管理员权限：{SystemUtils.HasAdminRole()}")
Logger.Info($"管理员权限：{WindowsUtils.HasAdminRole()}")
'检测异常环境
If PathExeFolder.Contains(Path.GetTempPath()) OrElse PathExeFolder.Contains("AppData\Local\Temp\") Then
If Paths.Base.Contains(Path.GetTempPath()) OrElse Paths.Base.Contains("AppData\Local\Temp\") Then
MyMsgBox("请将 PCL 从压缩包中解压后再使用！" & vbCrLf & "如果不会解压，可以在网上寻找教程。", "需要解压！", "我知道了", IsWarn:=True, ForceWait:=True)
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
End If
If Is32BitSystem Then
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统，部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏！", "环境警告", "我知道了", IsWarn:=True)
If Not Environment.Is64BitOperatingSystem Then
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统，请重装为 64 位系统后再进行游戏！", "环境警告", "我知道了", IsWarn:=True, ForceWait:=True)
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
End If
'计时
Logger.Info($"第一阶段加载用时：{GetTimeMs() - ApplicationStartTick} ms")
@@ -219,7 +218,7 @@ RetryCacheCheck:
'动态 DLL 加载
Private Sub New() '这里必须尽早调用，且不能使用任何库，否则加载 MeloongCore 就会导致崩溃
Static Prefixes As String() = {"NAudio", "Newtonsoft.Json", "Ookii.Dialogs.Wpf", "Imazen.WebP", "CacheCow.Common", "CacheCow.Client.FileStore", "CacheCow.Client", "System.Net.Http.Formatting", "PCLCS", "MeloongCore.Wpf", "MeloongCore"}
Static Prefixes As String() = {"NAudio", "Newtonsoft.Json", "Ookii.Dialogs.Wpf", "Imazen.WebP", "CacheCow.Common", "CacheCow.Client.FileStore", "CacheCow.Client", "ThrottleDebounce", "System.Net.Http.Formatting", "PCLCS", "MeloongCore.Wpf", "MeloongCore"}
Static LoadedAssemblies As New ConcurrentDictionary(Of String, Lazy(Of Assembly))(StringComparer.Ordinal) '缓存
AddHandler AppDomain.CurrentDomain.AssemblyResolve,
Function(sender As Object, Args As ResolveEventArgs) As Assembly
@@ -251,7 +250,7 @@ RetryCacheCheck:
Select Case Settings.Get(Of McLoginType)("LoginType")
Case McLoginType.Ms
'微软
Dim MsJson As JObject = GetJson(Settings.Get(Of String)("LoginMsJson"))
Dim MsJson As JObject = Settings.Get(Of String)("LoginMsJson").DeserializeJson()
MsJson.Remove(sender.Tag)
Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0
Plain Craft Launcher 2/Controls/Behaviors/ClipboardInterceptor.vb
+35 -28
View File
@@ -1,4 +1,4 @@
' Author: uye (owner of the MaaAssistantArknights team)
' Author: uye (owner of the MaaAssistantArknights team)
' Original Source: MaaAssistantArknights project - https://github.com/MaaAssistantArknights/MaaAssistantArknights
' License: Apache License 2.0 (this file only)
'
@@ -15,12 +15,6 @@
'
' Date: 2025-07-03
Imports System.Windows
Imports System.Windows.Controls
Imports System.Windows.Input
Imports System.Windows.Documents
Imports System.Linq
Namespace Controls.Behaviors
Public NotInheritable Class ClipboardInterceptor
Private Sub New()
@@ -71,7 +65,8 @@ Namespace Controls.Behaviors
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(tb.SelectedText, True)
Catch
Catch ex As Exception
Logger.Warn(ex, "复制失败，请稍后再试", LogBehavior.Toast)
End Try
e.Handled = True
@@ -84,7 +79,8 @@ Namespace Controls.Behaviors
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(tb.SelectedText, True)
Catch
Catch ex As Exception
Logger.Warn(ex, "剪切失败，请稍后再试", LogBehavior.Toast)
End Try
tb.SelectedText = String.Empty
@@ -95,18 +91,22 @@ Namespace Controls.Behaviors
Dim tb = TryCast(sender, TextBox)
If tb Is Nothing Then Return
If Forms.Clipboard.ContainsText() Then
Dim pasteText = Forms.Clipboard.GetText()
Try
If Forms.Clipboard.ContainsText() Then
Dim pasteText = Forms.Clipboard.GetText()
'将换行符替换为空格（#7825）
If Not tb.AcceptsReturn Then pasteText = pasteText.ReplaceLineEndings(" ", mergeMultiple:=True)
'将换行符替换为空格（#7825）
If Not tb.AcceptsReturn Then pasteText = pasteText.ReplaceLineEndings(" ", mergeMultiple:=True)
Dim start = tb.SelectionStart
Dim start = tb.SelectionStart
tb.SelectedText = pasteText
tb.CaretIndex = start + pasteText.Length
tb.SelectionLength = 0
End If
tb.SelectedText = pasteText
tb.CaretIndex = start + pasteText.Length
tb.SelectionLength = 0
End If
Catch ex As Exception
Logger.Warn(ex, "粘贴失败，请稍后再试", LogBehavior.Toast)
End Try
e.Handled = True
End Sub
@@ -121,7 +121,8 @@ Namespace Controls.Behaviors
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(textRange.Text, True)
Catch
Catch ex As Exception
Logger.Warn(ex, "复制失败，请稍后再试", LogBehavior.Toast)
End Try
e.Handled = True
@@ -137,7 +138,8 @@ Namespace Controls.Behaviors
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(selection.Text, True)
Catch
Catch ex As Exception
Logger.Warn(ex, "剪切失败，请稍后再试", LogBehavior.Toast)
End Try
selection.Text = String.Empty
@@ -148,16 +150,20 @@ Namespace Controls.Behaviors
Dim rtb = TryCast(sender, RichTextBox)
If rtb Is Nothing Then Return
If Not Forms.Clipboard.ContainsText() Then Return
Try
If Not Forms.Clipboard.ContainsText() Then Return
Dim pasteText = Forms.Clipboard.GetText()
Dim selection = rtb.Selection
Dim pasteText = Forms.Clipboard.GetText()
Dim selection = rtb.Selection
selection.Text = pasteText
selection.Text = pasteText
Dim caretPos = selection.End
rtb.CaretPosition = caretPos
rtb.Selection.Select(caretPos, caretPos)
Dim caretPos = selection.End
rtb.CaretPosition = caretPos
rtb.Selection.Select(caretPos, caretPos)
Catch ex As Exception
Logger.Warn(ex, "粘贴失败，请稍后再试", LogBehavior.Toast)
End Try
e.Handled = True
End Sub
@@ -183,7 +189,8 @@ Namespace Controls.Behaviors
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(sbStr, True)
Catch
Catch ex As Exception
Logger.Warn(ex, "复制失败，请稍后再试", LogBehavior.Toast)
End Try
e.Handled = True
Plain Craft Launcher 2/Controls/Behaviors/Interfaces.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Imports System.Windows.Threading
Imports System.Windows.Threading
''' <summary>
''' 指示页面可以通过按下 F5 或以其他方式刷新。
Plain Craft Launcher 2/Controls/Behaviors/LazyLoadBehavior.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class LazyLoadBehavior
Public Class LazyLoadBehavior
''' <summary>
''' 指定首次进入 ScrollViewer 的可视范围时执行的操作。
Plain Craft Launcher 2/Controls/MyButton.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Border x:Class="MyButton"
<Border x:Class="MyButton"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
FocusVisualStyle="{x:Null}" x:Name="PanBack"
Plain Craft Launcher 2/Controls/MyButton.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Imports System.Windows.Markup
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyButton
Plain Craft Launcher 2/Controls/MyCard.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyCard
Public Class MyCard
'控件
Inherits Grid
Plain Craft Launcher 2/Controls/MyCheckBox.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Grid
<Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d" x:Class="MyCheckBox"
Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Imports System.Windows.Markup
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyCheckBox
Plain Craft Launcher 2/Controls/MyComboBox.vb
+2 -1
View File
@@ -1,4 +1,4 @@
Public Class MyComboBox
Public Class MyComboBox
Inherits ComboBox
Implements ISettingControl
Public Event TextChanged(sender As Object, e As TextChangedEventArgs)
@@ -104,6 +104,7 @@
Private Sub MyComboBox_DropDownOpened(sender As Object, e As EventArgs) Handles Me.DropDownOpened
RealWidth = Width
Width = ActualWidth
'将下拉菜单透明度与主窗口同步
Try
CType(Template.FindName("PanPopup", Me), Grid).Opacity = FrmMain.Opacity
Catch ex As Exception
Plain Craft Launcher 2/Controls/MyComboBoxItem.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyComboBoxItem
Public Class MyComboBoxItem
Inherits ComboBoxItem
'基础
Plain Craft Launcher 2/Controls/MyDropShadow.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyDropShadow
Public Class MyDropShadow
Inherits Decorator
''' <summary>
Plain Craft Launcher 2/Controls/MyExtraButton.xaml
+2 -2
View File
@@ -1,8 +1,8 @@
<Grid
<Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" x:Name="PanBack" mc:Ignorable="d" x:Class="MyExtraButton"
Width="40" RenderTransformOrigin="0.5,0.5" ToolTipService.Placement="Left" ToolTipService.VerticalOffset="16" ToolTipService.HorizontalOffset="-8" Height="0">
Width="40" RenderTransformOrigin="0.5,0.5" Height="0">
<Grid.RenderTransform>
<ScaleTransform ScaleX="0" ScaleY="0" />
</Grid.RenderTransform>
Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyExtraButton
Public Class MyExtraButton
'声明
Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml
+2 -2
View File
@@ -1,10 +1,10 @@
<Grid
<Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
x:Name="PanBack" mc:Ignorable="d" x:Class="MyExtraTextButton"
RenderTransformOrigin="0.5,0.5" ToolTipService.Placement="Left" Height="52" Margin="20" Cursor="Hand">
RenderTransformOrigin="0.5,0.5" Height="52" Margin="20" Cursor="Hand">
<Grid.RenderTransform>
<ScaleTransform ScaleX="0" ScaleY="0" />
</Grid.RenderTransform>
Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Imports System.Windows.Markup
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyExtraTextButton
Plain Craft Launcher 2/Controls/MyHint.xaml
+2 -2
View File
@@ -1,4 +1,4 @@
<Border x:Class="MyHint" x:Name="PanBack"
<Border x:Class="MyHint" x:Name="PanBack"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
@@ -11,6 +11,6 @@
</Grid.ColumnDefinitions>
<TextBlock IsHitTestVisible="False" x:Name="LabText" LineHeight="16" Margin="0,0,0,-1" Padding="12,9" VerticalAlignment="Center" TextWrapping="Wrap" />
<local:MyIconButton x:Name="BtnClose" Visibility="Collapsed" Theme="Custom" Margin="0,0,8,0" Grid.Column="1" Height="20" Width="20" VerticalAlignment="Center" Logo="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"
ToolTip="不再提示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" />
ToolTip="不再提示" />
</Grid>
</Border>
Plain Craft Launcher 2/Controls/MyHint.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Imports System.Windows.Markup
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyHint
Plain Craft Launcher 2/Controls/MyIconButton.xaml
+2 -2
View File
@@ -1,7 +1,7 @@
<Border x:Class="MyIconButton"
<Border x:Class="MyIconButton"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
CornerRadius="1000" Background="{StaticResource ColorBrushSemiTransparent}" BorderThickness="0.001" Cursor="Hand">
CornerRadius="1000" Background="{StaticResource ColorBrushSemiTransparent}" BorderThickness="0.001">
<Border x:Name="PanBack" CornerRadius="1000" RenderTransformOrigin="0.5,0.5" BorderThickness="0.001" IsHitTestVisible="False">
<Path x:Name="Path" Stretch="Uniform" Margin="5" RenderTransformOrigin="0.5,0.5">
<Path.RenderTransform>
Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb
+29 -26
View File
@@ -1,4 +1,4 @@
Imports System.Windows.Shapes
Imports System.Windows.Shapes
Public Class MyIconButton
@@ -52,7 +52,9 @@ Public Class MyIconButton
'鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行）
Private IsMouseDown As Boolean = False
Public Property CanClick As Boolean = True
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not CanClick Then Return
If Not IsMouseDown Then Return
Logger.Info($"按下图标按钮{If(String.IsNullOrEmpty(Name), "", "：" & Name)}")
RaiseEvent Click(sender, e)
@@ -61,12 +63,14 @@ Public Class MyIconButton
RaiseCustomEvent() '自定义事件
End Sub
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
If Not CanClick Then Return
IsMouseDown = True
Focus()
'指向
AniStart(AaScaleTransform(PanBack, 0.8 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 400,, New AniEaseOutFluent(AniEasePower.Strong)), "MyIconButton Scale " & Uuid)
End Sub
Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp
If Not CanClick Then Return
If IsMouseDown Then
IsMouseDown = False
AniStart({
@@ -77,6 +81,7 @@ Public Class MyIconButton
RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_MouseLeave() Handles Me.MouseLeave
If Not CanClick Then Return
IsMouseDown = False
AniStart({
AaScaleTransform(PanBack, 1 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 250,, New AniEaseOutFluent)
@@ -87,10 +92,9 @@ Public Class MyIconButton
'务必放在 IsMouseDown 更新之后
Private Const AnimationColorIn As Integer = 120
Private Const AnimationColorOut As Integer = 150
Public Sub RefreshAnim() Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded
Public Sub RefreshAnim() Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded, Me.IsEnabledChanged
Try
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255)
If Path.Fill Is Nothing Then
Select Case Theme
@@ -102,9 +106,10 @@ Public Class MyIconButton
Path.Fill = New MyColor(160, Foreground)
End Select
End If
If IsMouseOver Then
'指向
Dim AnimList As New List(Of AniData)
Dim AnimList As New List(Of AniData)
If Not IsEnabled Then
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrushGray5", AnimationColorIn))
ElseIf IsMouseOver Then '指向
Select Case Theme
Case Themes.Color
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush2", AnimationColorIn))
@@ -117,10 +122,7 @@ Public Class MyIconButton
Case Themes.Custom
AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(255, Foreground) - Path.Fill, AnimationColorIn))
End Select
AniStart(AnimList, "MyIconButton Color " & Uuid)
Else
'普通
Dim AnimList As New List(Of AniData)
Else '普通
Select Case Theme
Case Themes.Color
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush4", AnimationColorOut))
@@ -138,26 +140,27 @@ Public Class MyIconButton
AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(160, Foreground) - Path.Fill, AnimationColorOut))
PanBack.Background = New MyColor(0, 255, 255, 255)
End Select
AniStart(AnimList, "MyIconButton Color " & Uuid)
End If
AniStart(AnimList, "MyIconButton Color " & Uuid)
Else
AniStop("MyIconButton Color " & Uuid)
Select Case Theme
Case Themes.Color
Path.SetResourceReference(Shape.FillProperty, "ColorBrush5")
Case Themes.White
Path.SetResourceReference(Shape.FillProperty, "ColorBrush8")
Case Themes.Red
Path.Fill = New MyColor(160, 255, 76, 76)
Case Themes.Black
Path.Fill = New MyColor(160, 0, 0, 0)
Case Themes.Custom
Path.Fill = New MyColor(160, Foreground)
End Select
If IsEnabled Then
Select Case Theme
Case Themes.Color
Path.SetResourceReference(Shape.FillProperty, "ColorBrush5")
Case Themes.White
Path.SetResourceReference(Shape.FillProperty, "ColorBrush8")
Case Themes.Red
Path.Fill = New MyColor(160, 255, 76, 76)
Case Themes.Black
Path.Fill = New MyColor(160, 0, 0, 0)
Case Themes.Custom
Path.Fill = New MyColor(160, Foreground)
End Select
Else
Path.SetResourceReference(Shape.FillProperty, "ColorBrushGray5")
End If
PanBack.Background = New MyColor(0, 255, 255, 255)
End If
Catch ex As Exception
Logger.Warn(ex, "刷新图标按钮动画状态出错")
Plain Craft Launcher 2/Controls/MyIconTextButton.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Border x:Name="PanBack" x:Class="MyIconTextButton"
<Border x:Name="PanBack" x:Class="MyIconTextButton"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">
Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Imports System.Windows.Markup
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyIconTextButton
Plain Craft Launcher 2/Controls/MyImage.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyImage
Public Class MyImage
Inherits Image
#Region "公开属性"
Plain Craft Launcher 2/Controls/MyListItem.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Grid x:Class="MyListItem"
<Grid x:Class="MyListItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
x:Name="PanBack"
Plain Craft Launcher 2/Controls/MyListItem.xaml.vb
+4 -3
View File
@@ -1,4 +1,4 @@
Imports System.Windows.Markup
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyListItem
@@ -312,7 +312,8 @@ Public Class MyListItem
Else
'添加竖条控件
If IsNothing(RectCheck) Then
RectCheck = New Border With {.Width = 5, .Height = If(Checked, Double.NaN, 0), .CornerRadius = New CornerRadius(2, 2, 2, 2),
RectCheck = New Border With {
.Width = 5, .Height = If(Checked, Double.NaN, 0), .CornerRadius = New CornerRadius(2, 2, 2, 2),
.VerticalAlignment = If(Checked, VerticalAlignment.Stretch, VerticalAlignment.Center),
.HorizontalAlignment = HorizontalAlignment.Left, .UseLayoutRounding = False, .SnapsToDevicePixels = False,
.Margin = If(Checked, New Thickness(-1, 6, 0, 6), New Thickness(-1, 0, 0, 0))}
@@ -542,7 +543,7 @@ Public Class MyListItem
Private StateLast As String
Public IsMouseOverAnimationEnabled As Boolean = True
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.PreviewMouseLeftButtonDown, Me.PreviewMouseLeftButtonUp
'菜单虚拟化检测
If ContentHandler IsNot Nothing Then
ContentHandler(Me, e)
Plain Craft Launcher 2/Controls/MyLoading.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Grid
<Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" x:Name="PanBack" mc:Ignorable="d" x:Class="MyLoading"
MinWidth="50" MinHeight="50" Background="{StaticResource ColorBrushSemiTransparent}">
Plain Craft Launcher 2/Controls/MyLoading.xaml.vb
+3 -2
View File
@@ -1,4 +1,4 @@
Imports PCL.MyLoading
Imports PCL.MyLoading
Public Class MyLoading
@@ -76,7 +76,8 @@ Public Class MyLoading
If Ex Is Nothing Then
LabText.Text = "未知错误"
Else
LabText.Text = If(Ex.IsBadNetwork(), "网络环境不佳，请稍后再试，或使用 VPN 改善网络环境", Ex.GetDisplay(False))
Ex = Ex.RootException()
LabText.Text = If(Ex.IsBadNetwork(), "网络环境不佳，请稍后再试，或使用 VPN 改善网络环境", Ex.Message)
End If
Else
LabText.Text = TextError
Plain Craft Launcher 2/Controls/MyMenuItem.vb
+4 -2
View File
@@ -1,4 +1,4 @@
Public Class MyMenuItem
Public Class MyMenuItem
Inherits MenuItem
Private Sub MyMenuItem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
@@ -7,7 +7,9 @@
If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon)
End If
'对父级设置透明度
CType(Parent, ContextMenu).Opacity = Settings.Get(Of Integer)("UiLauncherTransparent") / 1000 + 0.4
If TypeOf Parent Is ContextMenu Then
CType(Parent, ContextMenu).Opacity = Settings.Get(Of Integer)("UiLauncherTransparent") / 1000 + 0.4
End If
End Sub
'基础
Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Grid x:Class="MyMsgInput"
<Grid x:Class="MyMsgInput"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL"
Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyMsgInput
Public Class MyMsgInput
Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid()
Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Grid x:Class="MyMsgSelect"
<Grid x:Class="MyMsgSelect"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL"
Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyMsgSelect
Public Class MyMsgSelect
Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid()
Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Grid x:Class="MyMsgText"
<Grid x:Class="MyMsgText"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL"
Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyMsgText
Public Class MyMsgText
Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid()
Plain Craft Launcher 2/Controls/MyPageLeft.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyPageLeft
Public Class MyPageLeft
Inherits Grid
Private Uuid As Integer = GetUuid()
Plain Craft Launcher 2/Controls/MyPageRight.vb
+6 -6
View File
@@ -1,4 +1,4 @@
Public Class MyPageRight
Public Class MyPageRight
Inherits AdornerDecorator
Public PageUuid As Integer = GetUuid()
@@ -153,7 +153,7 @@
'重试
Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
If Not PageLoaderAutoRun Then Return
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
If GeneralUtils.IsGenericInstanceOf(PageLoader, GetType(LoaderTask(Of ,))) OrElse TypeOf PageLoader Is LoaderWorker Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
Else
If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
@@ -175,7 +175,7 @@
RaiseEvent PageEnter()
Select Case PageState
Case PageStates.Empty
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Interrupted Then
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Canceled Then
'如果加载器在进入页面时不启动（例如联机），那么在此时就会有 State = Waiting
PageState = PageStates.ContentEnter
TriggerEnterAnimation(PanAlways, If(PanContent, Child))
@@ -188,7 +188,7 @@
End If
Case PageStates.ContentExit
'和上面的一样，但是不管 PanAlways
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Interrupted Then
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Canceled Then
PageState = PageStates.ContentEnter
TriggerEnterAnimation(If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then
@@ -364,9 +364,9 @@
Case PageStates.LoaderExit
PageState = PageStates.ContentExit
End Select
Case LoadState.Finished, LoadState.Interrupted, LoadState.Waiting
Case LoadState.Finished, LoadState.Canceled, LoadState.Waiting
If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return
Logger.Trace("已触发 PageLoaderState (Stop/Interrupt)")
Logger.Trace("已触发 PageLoaderState (Stop/Canceled)")
'运行结束
'需要从 LoaderWait 切换到 ContentEnter，或从 LoaderStay 切换到 LoaderExit
Select Case PageState
Plain Craft Launcher 2/Controls/MyRadioBox.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Grid x:Class="MyRadioBox"
<Grid x:Class="MyRadioBox"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
FocusVisualStyle="{x:Null}"
Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Imports System.Windows.Markup
Imports System.Windows.Markup
Imports System.Windows.Shapes
<ContentProperty("Inlines")>
Plain Craft Launcher 2/Controls/MyRadioButton.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Border x:Name="PanBack" x:Class="MyRadioButton"
<Border x:Name="PanBack" x:Class="MyRadioButton"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">
Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Imports System.Windows.Markup
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyRadioButton
Plain Craft Launcher 2/Controls/MyResizer.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Imports System.Runtime.InteropServices
Imports System.Runtime.InteropServices
Imports System.Windows.Interop
Imports System.Windows.Threading
Plain Craft Launcher 2/Controls/MyScrollBar.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyScrollBar
Public Class MyScrollBar
Inherits Primitives.ScrollBar
'基础
Plain Craft Launcher 2/Controls/MyScrollViewer.vb
+2 -3
View File
@@ -1,9 +1,8 @@
Public Class MyScrollViewer
Public Class MyScrollViewer
Inherits ScrollViewer
Public Property DeltaMult As Double = 1
Private RealOffset As Double
Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Return
@@ -12,7 +11,7 @@
(GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse
TypeOf e.Source Is CheckBox) Then
PresentationSource.FromVisual(e.Source)?.RootVisual?.GetType().FullName = "System.Windows.Controls.Primitives.PopupRoot") Then
'如果当前是在对有滚动条的下拉框或文本框执行，则不接管操作
Return
End If
Plain Craft Launcher 2/Controls/MySearchBox.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<local:MyCard x:Class="MySearchBox"
<local:MyCard x:Class="MySearchBox"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
Plain Craft Launcher 2/Controls/MySearchBox.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Class MySearchBox
Class MySearchBox
Inherits MyCard
Public Event TextChanged(sender As Object, e As EventArgs)
Plain Craft Launcher 2/Controls/MySlider.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Border x:Class="MySlider"
<Border x:Class="MySlider"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
Plain Craft Launcher 2/Controls/MySlider.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Imports System.Windows.Shapes
Imports System.Windows.Shapes
Public Class MySlider
Implements ISettingControl
Plain Craft Launcher 2/Controls/MySliderDot.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Border x:Class="MySliderDot"
<Border x:Class="MySliderDot"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
Plain Craft Launcher 2/Controls/MySliderDot.xaml.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MySliderDot
Public Class MySliderDot
'基础
Plain Craft Launcher 2/Controls/MyTextBox.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyTextBox
Public Class MyTextBox
Inherits TextBox
Implements ISettingControl
Plain Craft Launcher 2/Controls/MyTextButton.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyTextButton
Public Class MyTextButton
Inherits Label
Public Event Click(sender As Object, e As EventArgs)
Plain Craft Launcher 2/Controls/MyVirtualizingElement.vb
+2 -2
View File
@@ -1,4 +1,4 @@
Public Class MyVirtualizingElement(Of T As FrameworkElement)
Public Class MyVirtualizingElement(Of T As FrameworkElement)
Inherits FrameworkElement
Private Initializer As Func(Of T)
@@ -58,7 +58,7 @@ Public Class MyVirtualizingElement
''' 如果类型错误，则返回原值。
''' </summary>
Public Shared Function TryInit(Element As FrameworkElement) As FrameworkElement
If GetType(MyVirtualizingElement(Of )).IsInstanceOfGenericType(Element) Then
If GeneralUtils.IsGenericInstanceOf(Element, GetType(MyVirtualizingElement(Of ))) Then
Return CType(Element, Object).Init()
ElseIf TypeOf Element Is MyVirtualizingElement Then
Return CType(Element, MyVirtualizingElement).Init()
Plain Craft Launcher 2/FormMain.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<Window
<Window
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
Plain Craft Launcher 2/FormMain.xaml.vb
+46 -26
View File
@@ -1,4 +1,4 @@
Imports System.ComponentModel
Imports System.ComponentModel
Imports System.Windows.Interop
Public Class FormMain
@@ -11,6 +11,14 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
If BuildType = BuildTypes.Release Then
If LastVersion < 406 Then 'Release 2.13.0.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增：重做 Java 管理与相关设置，允许调整 Java 优先级、指定 Java 版本范围等"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：导出整合包时允许自动导出版本文件夹中的 Java"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：重做弹出提示的样式以及动画，以更符合现代 UI 审美"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：可能无法安装 OptiFine 26.1.2"))
FeatureCount += 35
BugCount += 17
End If
If LastVersion < 404 Then 'Release 2.12.8.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：Windows 7 无法正常联网"))
FeatureCount += 1
@@ -79,6 +87,14 @@ Public Class FormMain
'3：BUG+ IMP* FEAT-
'2：BUG* IMP-
'1：BUG-
If LastVersion < 405 Then 'Snapshot 2.13.0.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增：重做 Java 管理与相关设置，允许调整 Java 优先级、指定 Java 版本范围等"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：导出整合包时允许自动导出版本文件夹中的 Java"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：重做弹出提示的样式以及动画，以更符合现代 UI 审美"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：可能无法安装 OptiFine 26.1.2"))
FeatureCount += 35
BugCount += 17
End If
If LastVersion < 403 Then 'Snapshot 2.12.8.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：Windows 7 无法正常联网"))
FeatureCount += 1
@@ -256,7 +272,7 @@ Public Class FormMain
InitializeComponent()
Opacity = 0
'开启管理员权限下的文件拖拽
If SystemUtils.HasAdminRole() Then
If WindowsUtils.HasAdminRole() Then
Static Helper As New DragHelper
AddHandler SourceInitialized,
Sub()
@@ -367,7 +383,7 @@ Public Class FormMain
End If
'启动加载器池
Try
JavaListInit() '延后到同意协议后再执行，避免在初次启动时进行进程操作
JavaInit() '延后到同意协议后再执行，避免在初次启动时进行进程操作
Thread.Sleep(100)
DlClientListMojangLoader.Start(1) 'PCL 会同时根据这里的加载结果决定是否使用官方源进行下载
RunCountSub()
@@ -378,7 +394,7 @@ Public Class FormMain
End Try
'清理自动更新文件
Try
FileUtils.Delete(PathExeFolder & "PCL\Plain Craft Launcher 2.exe")
FileUtils.Delete(Paths.Base & "PCL\Plain Craft Launcher 2.exe")
Catch ex As Exception
Logger.Warn(ex, "清理自动更新文件失败")
End Try
@@ -415,17 +431,17 @@ Public Class FormMain
Logger.Info($"版本号从 {LastVersionCode} 升高到 {VersionCode}")
Settings.Set("SystemLastVersionReg", VersionCode)
'检查有记录的最高版本号
Dim LowerVersionCode As Integer
Dim HighestVersionCode As Integer
Const SettingKey = If(BuildType = BuildTypes.Snapshot, "SystemHighestAlphaVersionReg", "SystemHighestBetaVersionReg")
LowerVersionCode = Settings.Get(Of Integer)("SystemHighestAlphaVersionReg")
If LowerVersionCode < VersionCode Then
HighestVersionCode = Settings.Get(Of Integer)(SettingKey)
If HighestVersionCode < VersionCode Then
Settings.Set(SettingKey, VersionCode)
Logger.Info($"最高版本号从 {LowerVersionCode} 升高到 {VersionCode}")
Logger.Info($"最高版本号从 {HighestVersionCode} 升高到 {VersionCode}")
End If
'被移除的窗口设置选项
If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 5 Then Settings.Set("LaunchArgumentWindowType", 1)
'修改主题设置项名称
If LowerVersionCode <= 207 Then
If HighestVersionCode <= 207 Then
Dim UnlockedTheme As New List(Of String) From {"2"}
UnlockedTheme.AddRange(New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide").ToString.Split("|")))
UnlockedTheme.AddRange(New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|")))
@@ -448,12 +464,12 @@ Public Class FormMain
"多谢各位的理解啦！", "重新解锁提醒")
End If
'移动自定义皮肤
If LastVersionCode <= 161 AndAlso FileUtils.Exists(PathExeFolder & "PCL\CustomSkin.png") AndAlso Not FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
FileUtils.Copy(PathExeFolder & "PCL\CustomSkin.png", PathAppdata & "CustomSkin.png")
If LastVersionCode <= 161 AndAlso FileUtils.Exists(Paths.Base & "PCL\CustomSkin.png") AndAlso Not FileUtils.Exists(Paths.AppDataThenName & "CustomSkin.png") Then
FileUtils.Copy(Paths.Base & "PCL\CustomSkin.png", Paths.AppDataThenName & "CustomSkin.png")
Logger.Info("已移动离线自定义皮肤 (162)")
End If
If LastVersionCode <= 263 AndAlso FileUtils.Exists(PathTemp & "CustomSkin.png") AndAlso Not FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
FileUtils.Copy(PathTemp & "CustomSkin.png", PathAppdata & "CustomSkin.png")
If LastVersionCode <= 263 AndAlso FileUtils.Exists(PathTemp & "CustomSkin.png") AndAlso Not FileUtils.Exists(Paths.AppDataThenName & "CustomSkin.png") Then
FileUtils.Copy(PathTemp & "CustomSkin.png", Paths.AppDataThenName & "CustomSkin.png")
Logger.Info("已移动离线自定义皮肤 (264)")
End If
'解除帮助页面的隐藏
@@ -484,8 +500,8 @@ Public Class FormMain
End If
'输出更新日志
If LastVersionCode <= 0 Then Return
If LowerVersionCode >= VersionCode Then Return
ShowUpdateLog(LowerVersionCode)
If HighestVersionCode >= VersionCode Then Return
ShowUpdateLog(HighestVersionCode)
End Sub
Private Sub DowngradeSub(LastVersionCode As Integer)
Logger.Info($"版本号从 {LastVersionCode} 降低到 {VersionCode}")
@@ -513,7 +529,7 @@ Public Class FormMain
Sub()
Logger.Info("正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Interrupt()
Task.Cancel()
Next
End Sub, "强行停止下载任务")
End If
@@ -562,11 +578,12 @@ Public Class FormMain
FeedbackInfo()
Logger.Info("请在 https://github.com/Meloong-Git/PCL/issues 提交错误报告，以便于作者解决此问题！")
IsLogShown = True
StartProcess(PathExeFolder & "PCL\Log1.txt")
StartProcess(Paths.Base & "PCL\Log1.txt")
End If
Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉
End If
Logger.Info($"程序已退出，返回值：{ReturnCode}")
ConfigUtils.SaveAll()
Logger.Instance.Flush()
If ReturnCode <> ProcessReturnValues.Success Then Environment.Exit(ReturnCode)
Process.GetCurrentProcess.Kill()
@@ -716,7 +733,7 @@ Public Class FormMain
FrmSetupUI.PanLogoChange.Visibility = Visibility.Visible
End If
Try
ImageTitleLogo.Source = PathExeFolder & "PCL\Logo.png"
ImageTitleLogo.Source = Paths.Base & "PCL\Logo.png"
Catch ex As Exception
ImageTitleLogo.Source = Nothing
Logger.Error(ex, "显示标题栏图片失败", LogBehavior.Alert)
@@ -808,12 +825,16 @@ Public Class FormMain
'切回窗口
Private Sub FormMain_Activated() Handles Me.Activated
'切回窗口时自动刷新
Try
If PageCurrent = PageType.InstanceSetup AndAlso PageCurrentSub = PageSubType.InstanceMod Then
'Mod 管理自动刷新
'Mod 管理
FrmInstanceMod.ReloadModList()
ElseIf PageCurrent = PageType.InstanceSetup AndAlso (PageCurrentSub = PageSubType.InstanceSetup OrElse PageCurrentSub = PageSubType.InstanceExport) Then
'更新当前选用的 Java
PageInstanceLeft.ReloadCurrentJava()
ElseIf PageCurrent = PageType.InstanceSelect Then
'版本选择自动刷新
'版本选择
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
End If
Catch ex As Exception
@@ -883,7 +904,7 @@ Public Class FormMain
'Authlib 拖拽
e.Handled = True
e.Effects = DragDropEffects.Copy
Dim AuthlibServer As String = EscapeUtils.FormUrlUnescape(Str.Substring("authlib-injector:yggdrasil-server:".Length))
Dim AuthlibServer As String = StringUtils.FormUrlUnescape(Str.Substring("authlib-injector:yggdrasil-server:".Length))
Logger.Info($"Authlib 拖拽：{AuthlibServer}")
If Not String.IsNullOrEmpty(New ValidateHttp().Validate(AuthlibServer)) Then
Hint($"输入的 Authlib 验证服务器不符合网址格式（{AuthlibServer}）！", HintType.Red)
@@ -977,12 +998,12 @@ Public Class FormMain
Dim Extension As String = FilePath.AfterLast(".").Lower
If Extension = "xaml" Then
Logger.Info("文件后缀为 XAML，作为主页加载")
If FileUtils.Exists(PathExeFolder & "PCL\Custom.xaml") Then
If FileUtils.Exists(Paths.Base & "PCL\Custom.xaml") Then
If MyMsgBox("已存在一个主页文件，是否要将它覆盖？", "覆盖确认", "覆盖", "取消") = 2 Then
Return
End If
End If
FileUtils.Copy(FilePath, PathExeFolder & "PCL\Custom.xaml")
FileUtils.Copy(FilePath, Paths.Base & "PCL\Custom.xaml")
RunInUi(
Sub()
Settings.Set("UiCustomType", 1)
@@ -999,9 +1020,8 @@ Public Class FormMain
Try
ModpackInstall(FilePath)
Return
Catch ex As CancelledException
Return '用户主动取消
Catch ex As Exception
If ex.IsCanceled Then Return
'安装失败，继续往后尝试
End Try
End If
@@ -1598,7 +1618,7 @@ Public Class FormMain
'关闭 Minecraft
Public Sub BtnExtraShutdown_Click() Handles BtnExtraShutdown.Click
Try
If McLaunchLoaderReal IsNot Nothing Then McLaunchLoaderReal.Interrupt()
If McLaunchLoaderReal IsNot Nothing Then McLaunchLoaderReal.Cancel()
For Each Watcher In McWatcherList
Watcher.Kill()
Next
Plain Craft Launcher 2/GlobalSuppressions.vb
+1 -1
View File
@@ -1,4 +1,4 @@
' This file is used by Code Analysis to maintain SuppressMessage
' This file is used by Code Analysis to maintain SuppressMessage
' attributes that are applied to this project.
' Project-level suppressions either have no target or are given
' a specific target and scoped to a namespace, type, member, etc.
Plain Craft Launcher 2/Images/Heads/ChongQing.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 8.4 KiB

Plain Craft Launcher 2/Modules/Base/ModAnimation.vb
+8 -3
View File
@@ -1,4 +1,4 @@
'动画引擎模块
'动画引擎模块
'使用 Ani 作为方法或属性的开头，使用 Aa 作为单个动画对象的开头（便于自动补全）
Imports System.Windows.Media.Effects
@@ -832,7 +832,12 @@ Public Module ModAnimation
AniCount = 0
AniTimer(DeltaTime * AniSpeed)
If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
Logger.Info($"FPS {AniFPS}, 动画 {AniCount}, 下载中 {NetManager.FileRemain}（{FormatFileSize(NetManager.Speed)}/s）")
Logger.Info($"FPS {AniFPS}, 动画 {AniCount}, 下载中 {NetManager.FileRemain}（{StringUtils.FormatByteSize(NetManager.Speed)}/s）")
If NetManager.FileRemain < 5 Then
For Each File In NetManager.AllFiles.Values
If File.State < NetState.Finished Then Logger.Trace($"- {File.State} {StringUtils.FormatByteSize(File.Speed)}/s {File.LocalPath}")
Next
End If
End If
End Sub)
Sleeper:
@@ -1018,7 +1023,7 @@ NextAni:
If Convert.ToInt32(Convert.ToChar(NextText)) >= Convert.ToInt32(Convert.ToChar(128)) Then
NewText &= Encoding.GetEncoding("GB18030").GetString({RandomInteger(16 + 160, 87 + 160), RandomInteger(1 + 160, 89 + 160)})
Else
NewText &= RandomOne("0123456789./*-+\[]{};':/?,!@#$%^&*()_+-=qwwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM".ToCharArray)
NewText &= RandomInteger(0, 85).ConvertRadix(86)
End If
End If
'设置文本
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+30 -307
View File
@@ -1,21 +1,17 @@
Imports System.Globalization
Imports System.Runtime.CompilerServices
Imports System.Security.Cryptography
Imports System.Threading.Tasks
Imports System.Xaml
Imports Newtonsoft.Json
Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.12.8.2" '显示用版本名
Public Const VersionBaseName As String = "2.13.0.0" '显示用版本名
Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
#If RELEASE Then
Public Const VersionCode As Integer = 404 '正式版
Public Const VersionCode As Integer = 406 '正式版
#Else
Public Const VersionCode As Integer = 403 '快照版
Public Const VersionCode As Integer = 405 '快照版
#End If
'版本信息
@@ -41,13 +37,9 @@ Public Module ModBase
''' </summary>
Public Handle As IntPtr
''' <summary>
''' 程序的启动路径，以 \ 结尾。
''' </summary>
Public PathExeFolder As String = AppDomain.CurrentDomain.SetupInformation.ApplicationBase
''' <summary>
''' 包含程序名的完整路径。
''' </summary>
Public PathExe As String = PathExeFolder & AppDomain.CurrentDomain.SetupInformation.ApplicationName
Public PathExe As String = Paths.Base & AppDomain.CurrentDomain.SetupInformation.ApplicationName
''' <summary>
''' 程序内嵌图片文件夹路径，以 / 结尾。
''' </summary>
@@ -57,10 +49,6 @@ Public Module ModBase
''' </summary>
Public PathTemp As String = If(Settings.Get(Of String)("SystemSystemCache") = "", Path.GetTempPath() & "PCL\", Settings.Get(Of String)("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\"
''' <summary>
''' AppData 中的 PCL 文件夹路径，以 \ 结尾。
''' </summary>
Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\PCL\"
''' <summary>
''' 当前程序的语言。
''' </summary>
Public Lang As String = "zh_CN"
@@ -81,10 +69,6 @@ Public Module ModBase
''' </summary>
Public IsProgramEnding As Boolean = False
''' <summary>
''' 是否为 32 位系统。
''' </summary>
Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem
''' <summary>
''' 是否使用 GBK 编码。
''' </summary>
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
@@ -139,7 +123,7 @@ Public Module ModBase
''' <summary>
''' 图标按钮，刷新，0.85x
''' </summary>
Public Const IconButtonRefresh As String = "M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"
Public Const IconButtonRefresh As String = "M512.0 838.3c-80.2 0-153.4-29.3-210.2-77.4l75.5-75.5c11.5-11.5 25.8-22.0 25.8-37.0a27.2 27.2 0 0 0-27.1-27.1H104.0c-27.1 0-27.1 23.9-27.1 27.1v271.9a27.1 27.1 0 0 0 27.1 27.1c15.0 0 27.8-16.6 42.5-31.2l77.9-77.9c76.6 67.7 177.1 108.9 287.4 108.9 221.7 0 404.5-166.0 431.2-380.6h-109.8c-25.9 154.2-159.7 271.9-321.3 271.9zM919.9 76.6c-15.0 0-27.8 16.6-42.5 31.3L799.5 185.8c-76.5-67.7-177.1-108.9-287.4-108.9-221.8 0-404.5 166.1-431.3 380.6H190.6c25.9-154.2 159.7-271.9 321.4-271.9 80.2 0 153.4 29.3 210.1 77.4l-75.5 75.5c-11.6 11.5-25.8 22.0-25.8 37.1a27.2 27.2 0 0 0 27.1 27.1h271.9c27.1 0 27.1-23.9 27.1-27.1V103.8a27.1 27.1 0 0 0-27.1-27.1z"
''' <summary>
''' 图标按钮，软盘，1x
''' </summary>
@@ -153,10 +137,18 @@ Public Module ModBase
''' </summary>
Public Const IconButtonList As String = "M384 128h640v128H384zM160 192m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 448h640v128H384zM160 512m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 768h640v128H384zM160 832m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0Z"
''' <summary>
''' 图标按钮，文件夹，1.15x
''' 图标按钮，文件夹，1.1x
''' </summary>
Public Const IconButtonOpen As String = "M889.018182 418.909091H884.363636V316.509091a93.090909 93.090909 0 0 0-99.607272-89.832727h-302.545455l-93.090909-76.334546A46.545455 46.545455 0 0 0 358.865455 139.636364H146.152727A93.090909 93.090909 0 0 0 46.545455 229.469091V837.818182a46.545455 46.545455 0 0 0 46.545454 46.545454 46.545455 46.545455 0 0 0 16.756364-3.258181 109.381818 109.381818 0 0 0 25.134545 3.258181h586.472727a85.178182 85.178182 0 0 0 87.04-63.301818l163.374546-302.545454a46.545455 46.545455 0 0 0 5.585454-21.876364A82.385455 82.385455 0 0 0 889.018182 418.909091z m-744.727273-186.181818h198.283636l93.09091 76.334545a46.545455 46.545455 0 0 0 29.323636 10.705455h319.301818a12.101818 12.101818 0 0 1 6.516364 0V418.909091H302.545455a85.178182 85.178182 0 0 0-87.04 63.301818L139.636364 622.778182V232.727273a19.549091 19.549091 0 0 1 6.516363 0z m578.094546 552.029091a27.461818 27.461818 0 0 0-2.792728 6.516363H154.530909l147.083636-272.290909a27.461818 27.461818 0 0 0 2.792728-6.981818h565.061818z"
''' <summary>
''' 图标按钮，上箭头，0.95x
''' </summary>
Public Const IconButtonArrowUp As String = "M554 333V853h-85V333l-228 228-60-60L512 170l331 331-60 60L554 333z"
''' <summary>
''' 图标按钮，下箭头，0.95x
''' </summary>
Public Const IconButtonArrowDown As String = "M554 691V171h-85V691L241 463l-60 60L512 854l331-331-60-60L554 691z"
''' <summary>
''' 图标按钮，名片，1.1x
''' </summary>
Public Const IconButtonCard As String = "M834.5 684.1c-31.2-70.4-98.9-120.9-179.1-127.3 63.5-8.5 112.6-63 112.6-128.8 0-71.8-58.2-130-130-130s-130 58.2-130 130c0 65.9 49 120.3 112.6 128.8-80.2 6.4-148 57-179.1 127.3-8.7 19.7 6 42 27.6 42 12.1 0 22.7-7.5 27.7-18.5 24.3-53.9 78.5-91.5 141.3-91.5s117 37.6 141.3 91.5c5 11.1 15.6 18.5 27.7 18.5 21.4 0 36.1-22.3 27.4-42zM567.9 427.9c0-38.6 31.4-70 70-70s70 31.4 70 70-31.4 70-70 70-70-31.4-70-70zM460.3 347.9H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h243.3c16.6 0 30-13.4 30-30 0.1-16.5-13.4-30-29.9-30zM367.4 459.6H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h150.4c16.6 0 30-13.4 30-30 0.1-16.6-13.4-30-29.9-30zM297.4 571.2H217c-16.6 0-30 13.4-30 30s13.4 30 30 30h80.4c16.6 0 30-13.4 30-30 0-16.5-13.5-30-30-30zM900 236v552H124V236h776m0-60H124c-33.1 0-60 26.9-60 60v552c0 33.1 26.9 60 60 60h776c33.1 0 60-26.9 60-60V236c0-33.1-26.9-60-60-60z"
@@ -436,7 +428,7 @@ Public Module ModBase
Loading
Finished
Failed
Interrupted
Canceled
End Enum
''' <summary>
@@ -531,7 +523,7 @@ Public Module ModBase
''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
Public Sub IniClearCache(FileName As String)
If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
If Not FileName.Contains(":\") Then FileName = $"{Paths.Base}PCL\{FileName}.ini"
IniCache.Remove(FileName)
End Sub
''' <summary>
@@ -542,7 +534,7 @@ Public Module ModBase
Private Function IniGetContent(FileName As String) As ConcurrentDictionary(Of String, String)
Try
'还原文件路径
If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
If Not FileName.Contains(":\") Then FileName = $"{Paths.Base}PCL\{FileName}.ini"
'检索缓存
Dim Cache As ConcurrentDictionary(Of String, String) = Nothing
If IniCache.TryGetValue(FileName, Cache) Then Return Cache
@@ -616,9 +608,9 @@ Public Module ModBase
FileContent.Append(Pair.Value)
FileContent.Append(vbCrLf)
Next
If Not FileName.Contains(":\") Then FileName = $"{PathExeFolder}PCL\{FileName}.ini"
If Not FileName.Contains(":\") Then FileName = $"{Paths.Base}PCL\{FileName}.ini"
'处理相对路径
FileName = If(FileName.Contains(":\"), FileName, PathExeFolder & FileName)
FileName = If(FileName.Contains(":\"), FileName, Paths.Base & FileName)
FileUtils.Write(FileName, FileContent.ToString)
Catch ex As Exception
Logger.Error(ex, $"写入文件失败（{FileName} → {Key}:{Value}）", LogBehavior.Toast)
@@ -657,142 +649,12 @@ Public Module ModBase
FileUtils.Delete(TestFilePath)
End Sub
''' <summary>
''' 文件的校验规则。
''' </summary>
Public Class FileChecker
''' <summary>
''' 文件的准确大小。
''' 不检查则为 -1。
''' </summary>
Public ActualSize As Long = -1
''' <summary>
''' 文件的最小大小。
''' 不检查则为 -1。
''' </summary>
Public MinSize As Long = -1
''' <summary>
''' 文件的 MD5、SHA1 或 SHA256。会根据输入字符串的长度自动判断种类。
''' 不检查则为 Nothing。
''' </summary>
Public Hash As String = Nothing
''' <summary>
''' 是否可以使用已经存在的文件。
''' </summary>
Public CanUseExistsFile As Boolean = True
''' <summary>
''' 是否要求为 JSON 文件。
''' 即，开头结尾必须为 {} 或 []。
''' </summary>
Public IsJson As Boolean = False
Public Sub New(Optional MinSize As Long = -1, Optional ActualSize As Long = -1, Optional Hash As String = Nothing, Optional CanUseExistsFile As Boolean = True, Optional IsJson As Boolean = False)
Me.ActualSize = ActualSize
Me.MinSize = MinSize
Me.Hash = Hash
Me.CanUseExistsFile = CanUseExistsFile
Me.IsJson = IsJson
End Sub
''' <summary>
''' 检查文件。若成功则返回 Nothing，失败则返回错误的描述文本，描述文本不以句号结尾。不会抛出错误。
''' </summary>
Public Function Check(LocalPath As String) As String
Try
Dim Info = FileUtils.GetInfo(LocalPath)
If Not Info.Exists Then Return "文件不存在：" & LocalPath
Dim FileSize As Long = Info.Length
If ActualSize >= 0 AndAlso ActualSize <> FileSize Then
Return $"文件大小应为 {ActualSize} B，实际为 {FileSize} B" &
If(FileSize < 2000, "，内容为：" & FileUtils.ReadAsString(LocalPath), "")
End If
If MinSize >= 0 AndAlso MinSize > FileSize Then
Return $"文件大小应大于 {MinSize} B，实际为 {FileSize} B" &
If(FileSize < 2000, "，内容为：" & FileUtils.ReadAsString(LocalPath), "")
End If
If Not String.IsNullOrEmpty(Hash) Then
If Hash.Length < 35 Then 'MD5
Dim md5 As String = CryptographyUtils.ComputeFileHash(LocalPath, CryptographyUtils.HashMethod.Md5)
If Hash.Lower <> md5 Then Return "文件 MD5 应为 " & Hash & "，实际为 " & md5
ElseIf Hash.Length = 64 Then 'SHA256
Dim sha256 As String = CryptographyUtils.ComputeFileHash(LocalPath, CryptographyUtils.HashMethod.Sha256)
If Hash.Lower <> sha256 Then Return "文件 SHA256 应为 " & Hash & "，实际为 " & sha256
Else 'SHA1 (40)
Dim sha1 As String = CryptographyUtils.ComputeFileHash(LocalPath, CryptographyUtils.HashMethod.Sha1)
If Hash.Lower <> sha1 Then Return "文件 SHA1 应为 " & Hash & "，实际为 " & sha1
End If
End If
If IsJson Then
Dim Content As String = FileUtils.ReadAsString(LocalPath)
If Content = "" Then Throw New Exception("读取到的文件为空")
Try
GetJson(Content)
Catch ex As Exception
Throw New Exception("不是有效的 json 文件", ex)
End Try
End If
Return Nothing
Catch ex As Exception
Logger.Warn(ex, "检查文件出错")
Return ex.GetDisplay(False)
End Try
End Function
End Class
#End Region
#Region "文本"
Public vbLQ As Char = Convert.ToChar(8220)
Public vbRQ As Char = Convert.ToChar(8221)
''' <summary>
''' 将对象转换为枚举类型，支持数字或原文两种格式，若为空字符串或 Nothing 则返回 0。
''' 若转换失败会抛出异常。
''' </summary>
<Extension> Public Function ToEnum(Of T As Structure)(Value As Object) As T
If IsNumeric(Value) Then
Return CType(CInt(Value), Object)
ElseIf String.IsNullOrEmpty(Value?.ToString) Then
Return CType(0, Object)
Else
Return [Enum].Parse(GetType(T), Value.ToString(), True)
End If
End Function
''' <summary>
''' 将文件大小转化为适合的文本形式，如“1.28 M”。
''' </summary>
''' <param name="FileSize">以字节为单位的大小表示。</param>
Public Function FormatFileSize(FileSize As Long) As String
Dim IsNegative = FileSize < 0
If IsNegative Then FileSize *= -1
If FileSize < 1000 Then
'B 级
Return If(IsNegative, "-", "") & FileSize & " B"
ElseIf FileSize < 1024 * 1000 Then
'K 级
Dim RoundResult As String = Math.Round(FileSize / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " K"
ElseIf FileSize < 1024 * 1024 * 1000 Then
'M 级
Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " M"
Else
'G 级
Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024 / 1024)
Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt((3 - RoundResult.Length).Clamp(0, 2))) & " G"
End If
End Function
''' <summary>
''' 获取 JSON 对象。
''' </summary>
Public Function GetJson(Data As String) As JToken
Try
Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
Catch ex As Exception
Dim Length As Integer = If(Data, "").Length
Throw New Exception("格式化 JSON 失败：" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data), ex)
End Try
End Function
''' <summary>
''' 不会报错的 Val。
''' 如果输入有误，返回 0。
@@ -958,7 +820,7 @@ Public Module ModBase
TokenSource.Cancel()
Throw New TimeoutException($"任务超时（{TimeoutMs} ms）")
End If
Return TargetTask.GetAwaiter().GetResult()
Return TargetTask.Run()
End Function
''' <summary>
''' 为 Task 设置超时，在超时时抛出 TimeoutException。
@@ -969,7 +831,7 @@ Public Module ModBase
TokenSource.Cancel()
Throw New TimeoutException($"任务超时（{TimeoutMs} ms）")
End If
TargetTask.GetAwaiter().GetResult()
TargetTask.Run()
End Sub
''' <summary>
@@ -977,10 +839,10 @@ Public Module ModBase
''' </summary>
Public PathPure As String = GetPureASCIIDir()
Private Function GetPureASCIIDir() As String
If (PathExeFolder & "PCL").IsAsciiOnly() Then
Return PathExeFolder & "PCL\"
ElseIf PathAppdata.IsAsciiOnly() Then
Return PathAppdata
If Paths.Base.IsAsciiOnly() Then
Return Paths.Base & "PCL\"
ElseIf Paths.AppDataThenName.IsAsciiOnly() Then
Return Paths.AppDataThenName
ElseIf PathTemp.IsAsciiOnly() Then
Return PathTemp
Else
@@ -994,12 +856,6 @@ Public Module ModBase
Public Class RestartException
Inherits Exception
End Class
''' <summary>
''' 指示用户手动取消了操作，或用户已知晓操作被取消的原因。
''' </summary>
Public Class CancelledException
Inherits Exception
End Class
''' <summary>
''' 以管理员权限运行当前程序，并等待程序运行结束。
@@ -1011,19 +867,6 @@ Public Module ModBase
Return NewProcess.ExitCode
End Function
''' <summary>
''' 判断对象是否为某个泛型类型的实例。
''' </summary>
<Extension> Public Function IsInstanceOfGenericType(genericType As Type, obj As Object) As Boolean
If obj Is Nothing Then Return False
Dim t = obj.GetType()
While t IsNot Nothing
If t.IsGenericType AndAlso t.GetGenericTypeDefinition() Is genericType Then Return True
t = t.BaseType
End While
Return False
End Function
Private Uuid As Integer = 1
Private UuidLock As Object
''' <summary>
@@ -1045,79 +888,6 @@ Public Module ModBase
Return Stopwatch.GetTimestamp() \ (Stopwatch.Frequency \ 1000L)
End Function
''' <summary>
''' 将时间间隔转换为类似“5 分 10 秒前”的易于阅读的形式。
''' </summary>
Public Function GetTimeSpanString(Span As TimeSpan, IsShortForm As Boolean) As String
Dim EndFix = If(Span.TotalMilliseconds > 0, "后", "前")
If Span.TotalMilliseconds < 0 Then Span = -Span
Dim TotalMonthes = Math.Floor(Span.Days / 30)
Dim Result As String
If IsShortForm Then
If TotalMonthes >= 12 Then
'1+ 年，“3 年”
Result = Math.Floor(TotalMonthes / 12) & " 年"
ElseIf TotalMonthes >= 2 Then
'2~11 月，“5 个月”
Result = TotalMonthes & " 个月"
ElseIf Span.TotalDays >= 2 Then
'2 天 ~ 2 月，“23 天”
Result = Span.Days & " 天"
ElseIf Span.TotalHours >= 1 Then
'1 小时 ~ 2 天，“15 小时”
Result = Span.Hours & " 小时"
ElseIf Span.TotalMinutes >= 1 Then
'1 分钟 ~ 1 小时，“49 分钟”
Result = Span.Minutes & " 分钟"
ElseIf Span.TotalSeconds >= 1 Then
'1 秒 ~ 1 分钟，“23 秒”
Result = Span.Seconds & " 秒"
Else
'不到 1 秒
Result = "1 秒"
End If
Else
If TotalMonthes >= 61 Then
'5+ 年，“5 年”
Result = Math.Floor(TotalMonthes / 12) & " 年"
ElseIf TotalMonthes >= 12 Then
'12~60 月，“1 年 2 个月”
Result = Math.Floor(TotalMonthes / 12) & " 年" & If((TotalMonthes Mod 12) > 0, " " & (TotalMonthes Mod 12) & " 个月", "")
ElseIf TotalMonthes >= 4 Then
'4~11 月，“5 个月”
Result = TotalMonthes & " 个月"
ElseIf TotalMonthes >= 1 Then
'1~4 月，“2 个月 13 天”
Result = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
ElseIf Span.TotalDays >= 4 Then
'4~30 天，“23 天”
Result = Span.Days & " 天"
ElseIf Span.TotalDays >= 1 Then
'1~3 天，“2 天 20 小时”
Result = Span.Days & " 天" & If(Span.Hours > 0, " " & Span.Hours & " 小时", "")
ElseIf Span.TotalHours >= 10 Then
'10 小时 ~ 1 天，“15 小时”
Result = Span.Hours & " 小时"
ElseIf Span.TotalHours >= 1 Then
'1~10 小时，“1 小时 20 分钟”
Result = Span.Hours & " 小时" & If(Span.Minutes > 0, " " & Span.Minutes & " 分钟", "")
ElseIf Span.TotalMinutes >= 10 Then
'10 分钟 ~ 1 小时，“49 分钟”
Result = Span.Minutes & " 分钟"
ElseIf Span.TotalMinutes >= 1 Then
'1~10 分钟，“9 分 23 秒”
Result = Span.Minutes & " 分" & If(Span.Seconds > 0, " " & Span.Seconds & " 秒", "")
ElseIf Span.TotalSeconds >= 1 Then
'1 秒 ~ 1 分钟，“23 秒”
Result = Span.Seconds & " 秒"
Else
'不到 1 秒
Result = "1 秒"
End If
End If
Result += EndFix
Return Result
End Function
''' <summary>
''' 获取十进制 Unix 时间戳。
''' </summary>
Public Function GetUnixTimestampUtc() As Long
@@ -1165,41 +935,6 @@ Public Module ModBase
Logger.Info($"启动进程：{StartInfo.FileName} {StartInfo.Arguments}")
Return Process.Start(StartInfo)
End Function
''' <summary>
''' 静默运行文件并返回输出流字符串。执行失败会抛出异常。
''' </summary>
''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
''' <param name="Arguments">运行参数。</param>
''' <param name="Timeout">等待该程序结束的最长时间（毫秒）。超时会抛出错误。</param>
Public Function StartProcessAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000,
Optional WorkingDirectory As String = Nothing, Optional Encoding As Encoding = Nothing, Optional PrintLog As Boolean = True) As String
Dim Info = New ProcessStartInfo With {
.Arguments = Arguments,
.FileName = PathUtils.ToShortPath(FileName),
.UseShellExecute = False,
.CreateNoWindow = True,
.RedirectStandardError = True,
.RedirectStandardOutput = True,
.WorkingDirectory = PathUtils.ToShortPath(If(WorkingDirectory, PathExeFolder.TrimEnd("\"c))),
.StandardErrorEncoding = Encoding,
.StandardOutputEncoding = Encoding
}
If WorkingDirectory IsNot Nothing Then
If Info.EnvironmentVariables.ContainsKey("appdata") Then
Info.EnvironmentVariables("appdata") = WorkingDirectory
Else
Info.EnvironmentVariables.Add("appdata", WorkingDirectory)
End If
End If
If PrintLog Then Logger.Info($"执行命令并等待返回结果：{FileName} {Arguments}")
Using Program As New Process With {.StartInfo = Info}
Program.Start()
Dim Result As String = Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd
Program.WaitForExit(Timeout)
If Not Program.HasExited Then Program.Kill()
Return Result
End Using
End Function
''' <summary>
''' 在新的工作线程中执行代码。
@@ -1209,8 +944,6 @@ Public Module ModBase
Sub()
Try
Action()
Catch ex As ThreadInterruptedException
Logger.Info($"{Name}：线程已中止")
Catch ex As Exception
Logger.Error(ex, $"{Name}：线程执行失败")
End Try
@@ -1341,7 +1074,7 @@ Public Module ModBase
RunInThread(
Sub()
Try
ResilientUtils.Retry(
Retrier.Attempt(delay:=Function(Attempt) TimeSpan.FromMilliseconds(200), maxAttempts:=4, isRetryAllowed:=Function(ex) True, action:=
Sub()
RunInUi(
Sub()
@@ -1476,20 +1209,10 @@ Public Module ModBase
''' <summary>
''' 控件是否受到 TextTrimming 属性影响，导致内容被截取。
''' </summary>
<Extension> Public Function IsTextTrimmed(Control As TextBlock) As Boolean
Control.Measure(New Size(Double.MaxValue, Double.MaxValue))
Return Control.DesiredSize.Width > Control.ActualWidth
End Function
''' <summary>
''' 获取文本在被渲染后的宽度。
''' </summary>
Public Function MeasureStringWidth(text As String, Optional fontSize As Double = 14, Optional fontFamily As FontFamily = Nothing) As Double
If fontFamily Is Nothing Then fontFamily = New FontFamily("微软雅黑")
Dim formattedText = New FormattedText(
text, CultureInfo.CurrentCulture, FlowDirection.LeftToRight, New Typeface(fontFamily, FontStyles.Normal, FontWeights.Normal, FontStretches.Normal),
fontSize, Brushes.Black, New NumberSubstitution(), TextFormattingMode.Display, New DpiScale(1, 1).PixelsPerDip)
Return formattedText.Width
<Extension> Public Function IsTextTrimmed(TextBlock As TextBlock) As Boolean
Dim typeface As New Typeface(TextBlock.FontFamily, TextBlock.FontStyle, TextBlock.FontWeight, TextBlock.FontStretch)
Dim formattedText As New FormattedText(TextBlock.Text, Thread.CurrentThread.CurrentCulture, TextBlock.FlowDirection, typeface, TextBlock.FontSize, TextBlock.Foreground, DPI)
Return formattedText.Width > TextBlock.ActualWidth
End Function
''' <summary>
Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+127 -48
View File
@@ -1,4 +1,4 @@
Public Module ModLoader
Public Module ModLoader
'各类加载器
''' <summary>
@@ -89,7 +89,8 @@
Dim OldState = _State
If value = LoadState.Finished AndAlso Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
_State = value
Logger.Log($"加载器 {Name} 状态改变：{value}", If(value = LoadState.Failed, LogLevel.Error, LogLevel.Info))
If value = LoadState.Canceled Then CancellationTokenSource?.Cancel()
Logger.Log($"加载器 {[GetType].Name} {Name} 状态改变：{value}", If(value = LoadState.Failed, LogLevel.Error, LogLevel.Info))
'实现 ILoadingTrigger 接口与 OnStateChanged 回调
RunInUi(
Sub()
@@ -163,14 +164,42 @@
Private _Progress As Double = -1
Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged
''' <summary>
''' 创建一个 ProgressProvider，在其进度改变时，并将其进度单向映射到此加载器上。
''' 这是 Loader 对新框架的兼容层。
''' </summary>
Public Function CreateSyncProgressProvider(Optional FromPercentage As Double = 0, Optional ToPercentage As Double = 1) As ProgressProvider
Dim Provider As New ProgressProvider
AddHandler Provider.ProgressChanged,
Sub(ChangedProgress)
Dim RawProgress = Provider.GetRaw()
Progress = FromPercentage + (RawProgress.actual + RawProgress.skiped) * (ToPercentage - FromPercentage)
End Sub
Return Provider
End Function
''' <summary>
''' 计算总进度时的权重。它应该为预计时间（秒）。
''' </summary>
Public Property ProgressWeight As Double = 1
'状态变化
Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
Public MustOverride Sub Interrupt()
Public MustOverride Sub Cancel()
Public MustOverride Sub Failed(Ex As Exception)
Private CancellationTokenSource As CancellationTokenSource
''' <summary>
''' 创建一个随此加载器取消的取消令牌；令牌取消时也会调用此加载器的 Cancel。
''' 这是 Loader 对新框架的兼容层。
''' </summary>
Public Function CreateCancellationToken() As CancellationToken
SyncLock LockState
If CancellationTokenSource Is Nothing OrElse CancellationTokenSource.IsCancellationRequested Then
CancellationTokenSource = New CancellationTokenSource
CancellationTokenSource.Token.Register(AddressOf Cancel)
End If
If State = LoadState.Canceled Then CancellationTokenSource.Cancel()
Return CancellationTokenSource.Token
End SyncLock
End Function
'等待结束
Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。"
@@ -178,16 +207,19 @@
''' <summary>
''' 无限期地等待加载器完成，直到结束或抛出异常。若加载器尚未开始，则会开始执行。
''' </summary>
Public Sub WaitForExit(Optional Input As Object = Nothing, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional IsForceRestart As Boolean = False)
Public Sub WaitForExit(Optional Input As Object = Nothing, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional IsForceRestart As Boolean = False,
Optional c As CancellationToken = Nothing, Optional p As ProgressProvider = Nothing)
Start(Input, IsForceRestart)
Do While State = LoadState.Loading
If LoaderToSyncProgress IsNot Nothing Then LoaderToSyncProgress.Progress = Progress
p?.Set(Progress)
c.ThrowIfCancellationRequested()
Thread.Sleep(10)
Loop
If State = LoadState.Finished Then
Return
ElseIf State = LoadState.Interrupted Then
Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf State = LoadState.Canceled Then
Throw New OperationCanceledException("加载器执行已中断")
ElseIf IsNothing([Error]) Then
Throw New Exception("未知错误！")
Else
@@ -209,8 +241,8 @@
Loop
If State = LoadState.Finished Then
Return
ElseIf State = LoadState.Interrupted Then
Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf State = LoadState.Canceled Then
Throw New OperationCanceledException("加载器执行已中断")
ElseIf IsNothing([Error]) Then
Throw New Exception("未知错误！")
Else
@@ -240,16 +272,16 @@
''' <summary>
''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断，不可跨线程调用。
''' </summary>
Public ReadOnly Property IsInterrupted As Boolean
Public ReadOnly Property IsCanceled As Boolean
Get
Return IsInterruptedWithThread(Thread.CurrentThread)
Return IsCanceledWithThread(Thread.CurrentThread)
End Get
End Property
''' <summary>
''' 当前执行线程是否应当中断。需要手动提供加载器线程，用于需要跨线程检查的情况。
''' </summary>
Public Function IsInterruptedWithThread(Thread As Thread) As Boolean
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Interrupted
Public Function IsCanceledWithThread(Thread As Thread) As Boolean
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Canceled
End Function
''' <summary>
''' 在输入相同时使用原有结果的超时，单位为毫秒。
@@ -318,30 +350,29 @@
Sub()
Try
IsForceRestarting = IsForceRestart
Logger.Trace(Function() $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
Logger.Trace(Function() $"加载线程 {Name} 已{If(IsForceRestarting, "强制", "")}启动")
LoadDelegate(Me)
If IsInterrupted Then
Logger.Warn($"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束，输出被弃用（最新线程：{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)}）")
If IsCanceled Then
Logger.Warn($"加载线程 {Name} 已中断但线程正常运行至结束，输出被弃用（最新线程：{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)}）")
Return
End If
Logger.Trace(Function() $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
Logger.Trace(Function() $"加载线程 {Name} 已完成")
RaisePreviewFinish()
State = LoadState.Finished
LastFinishedTime = GetTimeMs() '未中断，本次输出有效
Catch ex As CancelledException
Logger.Trace(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断，已完成 {Math.Round(Progress * 100)}%")
If Not IsInterrupted Then State = LoadState.Interrupted
Catch ex As ThreadInterruptedException
Logger.Trace(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断，已完成 {Math.Round(Progress * 100)}%")
'如果线程是因为判断到 IsInterrupted 而提前中止，则代表已有新线程被重启，此时不应当改为 Interrupted
'如果线程是在没有 IsInterrupted 时手动引发了 ThreadInterruptedException，则代表没有重启线程，这通常代表用户手动取消，应当改为 Interrupted
If Not IsInterrupted Then State = LoadState.Interrupted
Catch ex As Exception
Failed(ex)
If ex.IsCanceled Then
'如果线程是因为判断到 IsCanceled 而提前中止，则代表已有新线程被重启，此时不应当改为 Canceled
'如果线程是在没有 IsCanceled 时手动引发了取消异常，则代表没有重启线程，这通常代表用户手动取消，应当改为 Canceled
Logger.Trace(ex, $"加载线程 {Name} 已取消，当前已完成 {Math.Round(Progress * 100)}%")
If Not IsCanceled Then State = LoadState.Canceled
Else
Failed(ex)
End If
End Try
End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
Try
LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsInterrupted
LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsCanceled
Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”，则等待后重试
Thread.Sleep(500)
LastRunningThread.Start()
@@ -350,16 +381,16 @@
Public Overrides Sub Failed(ex As Exception)
[Error] = ex
SyncLock LockState
If IsInterrupted OrElse State >= LoadState.Finished Then Return
If IsCanceled OrElse State >= LoadState.Finished Then Return
State = LoadState.Failed
End SyncLock
Logger.Warn(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错，已完成 {Math.Round(Progress * 100)}%")
Logger.Warn(ex, $"加载线程 {Name} 出错，已完成 {Math.Round(Progress * 100)}%")
TriggerThreadInterrupt()
End Sub
Public Overrides Sub Interrupt()
Public Overrides Sub Cancel()
SyncLock LockState
If State <> LoadState.Loading Then Return
State = LoadState.Interrupted
State = LoadState.Canceled
End SyncLock
TriggerThreadInterrupt()
End Sub
@@ -367,7 +398,7 @@
If LastRunningThread Is Nothing Then Return
If LastRunningThread.IsAlive Then
LastRunningThread.Interrupt()
Logger.Trace(Function() $"加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
Logger.Trace(Function() $"加载线程 {Name} 已中断")
End If
LastRunningThread = Nothing
End Sub
@@ -383,6 +414,53 @@
End Sub
End Class
''' <summary>
''' 新 Worker 对老 Loader 的兼容包装类。
''' </summary>
Public Class LoaderWorker
Inherits LoaderBase
Public WithEvents Worker As IWorker
Public Sub New(Name As String, Worker As IWorker)
Me.Name = Name
Me.Worker = Worker
AddHandler Worker.Progress.ProgressChanged, Sub(Raw) Progress = Raw.actual + Raw.skiped
End Sub
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
SyncLock LockState
State = LoadState.Loading
End SyncLock
Logger.Trace(Function() $"Worker {Name} 已启动")
IsForceRestarting = IsForceRestart
Worker.Start()
End Sub
Private Sub Worker_Succeeded() Handles Worker.Succeeded
Logger.Trace(Function() $"Worker {Name} 已完成")
RaisePreviewFinish()
SyncLock LockState
State = LoadState.Finished
End SyncLock
End Sub
Public Overrides Sub Cancel() Handles Worker.Canceled
SyncLock LockState
If State <> LoadState.Loading Then Return
State = LoadState.Canceled
End SyncLock
Logger.Trace(Function() $"Worker {Name} 已取消，当前已完成 {Math.Round(Progress * 100)}%")
Worker.Cancel()
End Sub
Public Overrides Sub Failed(Ex As Exception) Handles Worker.Failed
SyncLock LockState
If State >= LoadState.Finished Then Return
State = LoadState.Failed
End SyncLock
Logger.Warn(Ex, $"Worker {Name} 出错，已完成 {Math.Round(Progress * 100)}%")
[Error] = Ex
Worker.Cancel()
End Sub
End Class
''' <summary>
''' 支持多个加载器连续运作的复合加载器。
''' </summary>
@@ -450,11 +528,11 @@
End If
RunInThread(AddressOf Update)
End Sub
Public Overrides Sub Interrupt()
Public Overrides Sub Cancel()
'改变状态
SyncLock LockState
If State = LoadState.Loading OrElse State = LoadState.Waiting Then
State = LoadState.Interrupted
State = LoadState.Canceled
Else
Return
End If
@@ -463,7 +541,7 @@
Sub()
'中断加载器
For Each Loader In Loaders
Loader.Interrupt()
Loader.Cancel()
Next
End Sub)
End Sub
@@ -474,7 +552,7 @@
State = LoadState.Failed
End SyncLock
For Each Loader In Loaders
Loader.Interrupt()
Loader.Cancel()
Next
FrmMain.BtnExtraDownload.ShowRefresh()
End Sub
@@ -492,9 +570,9 @@
Case LoadState.Finished
'正常结束，触发刷新
Update()
Case LoadState.Interrupted
Case LoadState.Canceled
'被中断，这个任务也中断
Interrupt()
Cancel()
Case LoadState.Failed
'完蛋，出错了
Failed(New Exception(Loader.Name & "失败", Loader.Error))
@@ -504,15 +582,15 @@
''' 触发一次更新，以启动新加载器或完成。
''' </summary>
Private Sub Update()
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Interrupted Then Return
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Canceled Then Return
Dim IsFinished As Boolean = True
Dim Blocked As Boolean = False
Dim Input As Object = Me.Input
For Each Loader In Loaders
Select Case Loader.State
Case LoadState.Finished
'检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型，必须用 StartsWith
'检查 LoaderTask 是否需要重启
If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) Then
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
Logger.Info($"由于输入条件变更，重启已完成的加载器 {Loader.Name}")
GoTo Restart
@@ -523,8 +601,8 @@
'如果不让继续启动，且已有加载器正在加载中，就不继续启动
If Loader.Block AndAlso Not IsFinished Then Blocked = True
Case LoadState.Loading
'检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then
'检查 LoaderTask 是否需要重启
If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) Then
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
Logger.Warn($"由于输入条件变更，重启进行中的加载器 {Loader.Name}")
GoTo Restart
@@ -540,13 +618,14 @@ Restart:
If Blocked Then Continue For
If Input IsNot Nothing Then
'若输入类型与下一个加载器相同才继续
Dim LoaderType As String = Loader.GetType.Name
If LoaderType.StartsWithF("LoaderTask") OrElse LoaderType.StartsWithF("LoaderCombo") Then
If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) OrElse GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderCombo(Of ))) Then
Loader.Start(If(Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IsForceRestarting)
ElseIf LoaderType.StartsWithF("LoaderDownload") Then
ElseIf TypeOf Loader Is LoaderWorker Then
Loader.Start(IsForceRestart:=IsForceRestarting)
ElseIf TypeOf Loader Is LoaderDownload Then
Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting)
Else
Throw New Exception("未知的加载器类型（" & LoaderType & "）")
Throw New Exception("未知的加载器类型（" & Loader.GetType.Name & "）")
End If
Else
Loader.Start(IsForceRestart:=IsForceRestarting)
@@ -569,7 +648,7 @@ Restart:
Public Shared Sub GetLoaderList(Loader As Object, ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True)
For Each SubLoader In Loader.Loaders
If SubLoader.Show OrElse Not RequireShow Then List.Add(SubLoader)
If SubLoader.GetType.Name.StartsWithF("LoaderCombo") Then GetLoaderList(SubLoader, List)
If GeneralUtils.IsGenericInstanceOf(SubLoader, GetType(LoaderCombo(Of ))) Then GetLoaderList(SubLoader, List)
Next
End Sub
''' <summary>
@@ -606,7 +685,7 @@ Restart:
'若单个任务已中止，或全部任务已完成，则刷新并移除
For Each Task In LoaderTaskbar
If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Interrupted) Then
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Canceled) Then
FrmSpeedLeft?.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Logger.Info($"{Task.Name} 已移出任务列表")
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+95 -96
View File
@@ -1,5 +1,4 @@
Imports System.Net.Sockets
Imports System.Threading.Tasks
Imports System.Net.Sockets
Public Module ModNet
@@ -32,10 +31,8 @@ Public Module ModNet
Return Result
Catch ex As FormatException
Throw
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If MakeLog Then Logger.Warn(ex, "网络请求失败")
If MakeLog Then Logger.Warn(ex, $"网络请求失败（{Method.Method}，{Url}）")
Throw
End Try
End Function
@@ -68,9 +65,8 @@ Retry:
Throw RetryException
End If
End Select
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
ex.ThrowIfCanceled()
If TypeOf ex Is HttpRequestCodeException Then
If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.Forbidden Then Throw
If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.NotFound Then Throw
@@ -161,7 +157,7 @@ RequestFinished:
FileUtils.Delete(Temp)
Return Result
Finally
NewTask.Interrupt()
NewTask.Cancel()
End Try
End Function
@@ -179,11 +175,9 @@ RequestFinished:
Retry:
Try
FileUtils.Write(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders))
Catch ex As ThreadInterruptedException
FileUtils.Delete(LocalPath)
Throw
Catch ex As Exception
FileUtils.Delete(LocalPath)
ex.ThrowIfCanceled()
If RetryCount < 2 Then
RetryCount += 1
GoTo Retry
@@ -210,7 +204,7 @@ Retry:
Catch ex As Exception
Throw New WebException($"多线程直接下载文件失败（第一下载源：" & Urls.First() & "）", ex)
Finally
NewTask.Interrupt()
NewTask.Cancel()
End Try
End Sub
@@ -226,32 +220,7 @@ Retry:
Dim Request As HttpRequestMessage = Nothing, CancelToken As CancellationTokenSource = Nothing,
Response As HttpResponseMessage = Nothing, HostIp As String = Nothing
Try
Url = SecretCdnSign(Url)
Request = New HttpRequestMessage(Method, Url)
'写入 Content
If Content IsNot Nothing AndAlso Request.Method <> HttpMethod.Get AndAlso Request.Method <> HttpMethod.Head Then
If TypeOf Content Is HttpContent Then
Request.Content = DirectCast(Content, HttpContent)
ElseIf TypeOf Content Is Byte() Then
Request.Content = New ByteArrayContent(DirectCast(Content, Byte()))
ElseIf Content IsNot Nothing Then
Request.Content = New ByteArrayContent(If(Encoding, Encoding.UTF8).GetBytes(Content.ToString()))
End If
End If
'写入 Headers
For Each Header In If(Headers, New Dictionary(Of String, String))
If Header.Key.Lower = "content-type" Then
Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
Else
Request.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
End If
Next
SecretHeadersSign(Url, Request, SimulateBrowserHeaders)
'DNS 解析
CancelToken = New CancellationTokenSource(Timeout)
HostIp = DNSLookup(Request, CancelToken.Token)
If HostIp IsNot Nothing Then IPReliability.GetOrAdd(HostIp, -0.01) '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率
'发送请求
'构建 RequestClient
Directory.CreateDirectory(PathTemp & "Cache\Http\")
SyncLock RequestClientLock
If RequestClient Is Nothing Then '延迟初始化，以避免在程序启动前加载 CacheCow 导致 DLL 加载失败
@@ -261,11 +230,41 @@ Retry:
})
End If
End SyncLock
ResilientUtils.RetryOn(Of FileNotFoundException, IOException)( 'CacheCow 读取缓存时若文件被占用，会调用不存在的 System.Net.Http.Formatting.resources，抛出此异常（#8150）
Sub()
CancelToken.Dispose() : CancelToken = New CancellationTokenSource(Timeout)
Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
'构建请求
Url = SecretCdnSign(Url)
Request = New HttpRequestMessage(Method, Url)
If Content IsNot Nothing AndAlso Request.Method <> HttpMethod.Get AndAlso Request.Method <> HttpMethod.Head Then '写入 Content
If TypeOf Content Is HttpContent Then
Request.Content = DirectCast(Content, HttpContent).Clone()
ElseIf TypeOf Content Is Byte() Then
Request.Content = New ByteArrayContent(DirectCast(Content, Byte()))
ElseIf Content IsNot Nothing Then
Request.Content = New ByteArrayContent(If(Encoding, Encoding.UTF8).GetBytes(Content.ToString()))
End If
End If
For Each Header In If(Headers, New Dictionary(Of String, String)) '写入 Headers
If Header.Key.Lower = "content-type" Then
Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
Else
Request.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
End If
Next
SecretHeadersSign(Url, Request, SimulateBrowserHeaders)
'发送请求
'CacheCow 读取缓存时若文件被占用，会调用不存在的 System.Net.Http.Formatting.resources，抛出异常（#8150）
Retrier.Attempt(delay:=Function() TimeSpan.FromMilliseconds(200), isRetryAllowed:=Function(ex) TypeOf ex Is FileNotFoundException OrElse TypeOf ex Is IOException, action:=
Sub(Attempt)
CancelToken?.Dispose() : CancelToken = New CancellationTokenSource(Timeout)
HostIp = DNSLookup(Request, CancelToken.Token)
If HostIp IsNot Nothing Then IPReliability.GetOrAdd(HostIp, -0.01) '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率
Dim ClonedRequest As HttpRequestMessage = Request.Clone() 'HttpRequestMessage 只能发送一次，重试时需要克隆一个新的
Try
Response = RequestClient.SendAsync(ClonedRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
Finally
ClonedRequest.Dispose()
End Try
End Sub)
'读取响应
Dim ResponseBytes As Byte()
CancelToken.Dispose() : CancelToken = New CancellationTokenSource(Timeout)
Using ResponseStream = Response.Content.ReadAsStreamAsync().GetResultWithTimeout(CancelToken, Timeout)
@@ -274,26 +273,24 @@ Retry:
ResponseBytes = Stream.ToArray()
End Using
End Using
'输出
If Response.IsSuccessStatusCode Then
RecordIPReliability(HostIp, 0.5)
Return ResponseBytes
Else
If Not Response.IsSuccessStatusCode Then
RecordIPReliability(HostIp, -0.7)
Dim ResponseMessage = ResponseBytes.GetString(Encoding)
Throw New HttpRequestCodeException(
$"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Method}，{Url}，{HostIp}" &
If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), Response.StatusCode, ResponseMessage)
End If
Catch ex As ThreadInterruptedException
Throw
'输出
RecordIPReliability(HostIp, 0.5)
Return ResponseBytes
Catch ex As HttpRequestException
Throw
Catch ex As TimeoutException
Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
Catch ex As Exception
ex.ThrowIfCanceled()
RecordIPReliability(HostIp, -1)
If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then 'CancellationToken 超时
Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
ElseIf ex.IsBadNetwork Then
If ex.IsBadNetwork Then
Throw New WebException($"网络请求失败，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
Else
Throw New Exception($"网络请求出现意外异常（{Method}, {Url}，{HostIp}）", ex)
@@ -478,7 +475,7 @@ Retry:
''' <summary>
''' 已失败或中断。
''' </summary>
Interrupted = 6
Canceled = 6
End Enum
''' <summary>
''' 预下载检查行为。
@@ -626,7 +623,7 @@ Retry:
''' </summary>
Public ReadOnly Property IsEnded As Boolean
Get
Return State = NetState.Finished OrElse State = NetState.Interrupted
Return State = NetState.Finished OrElse State = NetState.Canceled
End Get
End Property
@@ -663,7 +660,7 @@ Retry:
''' <summary>
''' 所有下载源。
''' </summary>
Public Sources As ConcurrentList(Of NetSource)
Public Sources As List(Of NetSource)
''' <summary>
''' 用于在第一个线程出错时切换下载源。
''' </summary>
@@ -819,7 +816,7 @@ Retry:
Return OriginalProgress * 0.93 + 0.05
Case NetState.Merging
Return 0.99
Case NetState.Finished, NetState.Interrupted
Case NetState.Finished, NetState.Canceled
Return 1
Case Else
Throw New ArgumentOutOfRangeException("文件状态未知：" & State)
@@ -889,7 +886,7 @@ Retry:
'条件检测
SyncLock LockSource
If NetTaskThreadCount >= NetTaskThreadLimit OrElse Not HasAvailableSource() OrElse
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Interrupted) Then Return Nothing
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Canceled) Then Return Nothing
If State >= NetState.Merging OrElse State = NetState.WaitingToCheck Then Return Nothing
SyncLock LockState
If State < NetState.Connecting Then State = NetState.Connecting
@@ -900,7 +897,7 @@ Retry:
If IsNoSplit Then GoTo StartSingleThreadDownload
'只剩下单线程可用点
If Not HasAvailableSource(False) Then
If SourcesOnce.First.SingleThread IsNot Nothing AndAlso SourcesOnce.First.SingleThread.State <> NetState.Interrupted Then Return Nothing
If SourcesOnce.First.SingleThread IsNot Nothing AndAlso SourcesOnce.First.SingleThread.State <> NetState.Canceled Then Return Nothing
StartSingleThreadDownload:
Reset()
State = NetState.Reading
@@ -916,7 +913,7 @@ StartSingleThreadDownload:
End If
'寻找失败点
For Each Thread As NetThread In Threads
If Thread.State = NetState.Interrupted AndAlso Thread.DownloadUndone > 0 Then
If Thread.State = NetState.Canceled AndAlso Thread.DownloadUndone > 0 Then
StartPosition = Thread.DownloadStart + Thread.DownloadDone
StartSource = GetSource(Thread.Source.Id + 1)
GoTo StartThread
@@ -997,7 +994,7 @@ StartThread:
If Not Response.IsSuccessStatusCode Then '状态码检查
Throw New HttpRequestCodeException($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Th.Source.Url}", Response.StatusCode, Nothing)
End If
If State = NetState.Interrupted Then GoTo SourceBreak '快速中断
If State = NetState.Canceled Then GoTo SourceBreak '快速中断
If Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Logger.Trace(Function() $"{LocalName}：重定向至 {Response.RequestMessage.RequestUri}")
'文件大小校验
ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1)
@@ -1023,7 +1020,7 @@ StartThread:
End If
End If
FileSize = ContentLength : IsUnknownSize = False
Logger.Info($"{LocalName}：文件大小 {ContentLength}（{FormatFileSize(ContentLength)}）")
Logger.Info($"{LocalName}：文件大小 {ContentLength}（{StringUtils.FormatByteSize(ContentLength)}）")
'若文件大小大于 50 M，进行剩余磁盘空间校验
If ContentLength > 50 * 1024 * 1024 Then
For Each Drive As DriveInfo In DriveInfo.GetDrives
@@ -1031,7 +1028,7 @@ StartThread:
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) +
If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0)
If RequiredSpace > 0 AndAlso Drive.TotalFreeSpace < RequiredSpace Then
Throw New Exception(DriveName & " 盘空间不足，无法进行下载。" & vbCrLf & "需要至少 " & FormatFileSize(RequiredSpace) & " 空间，但当前仅剩余 " & FormatFileSize(Drive.TotalFreeSpace) & "。" &
Throw New Exception(DriveName & " 盘空间不足，无法进行下载。" & vbCrLf & "需要至少 " & StringUtils.FormatByteSize(RequiredSpace) & " 空间，但当前仅剩余 " & StringUtils.FormatByteSize(Drive.TotalFreeSpace) & "。" &
If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存，你可以在设置中调整缓存文件夹的位置。", ""))
End If
Next
@@ -1111,9 +1108,9 @@ NotSupportRange:
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
End While
SourceBreak:
If State = NetState.Interrupted OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
If State = NetState.Canceled OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
'被外部中断
Th.State = NetState.Interrupted
Th.State = NetState.Canceled
Logger.Info($"{LocalName}：中断")
ElseIf HttpDataCount = 0 AndAlso Th.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
'服务器无返回数据
@@ -1143,7 +1140,7 @@ SourceBreak:
Interlocked.Decrement(NetTaskThreadCount)
'合并
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso
State < NetState.Merging AndAlso Th.State <> NetState.Interrupted Then Merge(Th)
State < NetState.Merging AndAlso Th.State <> NetState.Canceled Then Merge(Th)
End Try
End Sub
Private Sub SourceFail(Th As NetThread, ex As Exception, IsMergeFailure As Boolean)
@@ -1152,7 +1149,7 @@ SourceBreak:
For Each Task In Tasks
Interlocked.Increment(Task.FailCount)
Next
Th.State = NetState.Interrupted
Th.State = NetState.Canceled
Th.Source.Ex = ex
'根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传）
Dim IsRangeNotSupported As Boolean = TypeOf ex Is RangeNotSupportedException OrElse ex.Message.Contains("(416)")
@@ -1333,29 +1330,29 @@ Retry:
If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
'凉凉
Logger.Info($"{LocalName}：已失败，当前状态 {State}")
State = NetState.Interrupted
State = NetState.Canceled
End SyncLock
InterruptInternal()
CancelInternal()
For Each Task In Tasks
Task.OnFileFail(Me)
Next
End Sub
''' <summary>
''' 下载中断。
''' 取消下载。
''' </summary>
Public Sub Interrupt(InterruptedTask As LoaderDownload)
Public Sub Cancel(CanceledTask As LoaderDownload)
'从特定任务中移除，如果它还属于其他任务，则继续下载
Tasks.Remove(InterruptedTask)
Tasks.Remove(CanceledTask)
If Tasks.Any Then Return
'确认中断
SyncLock LockState
If State >= NetState.Finished Then Return
Logger.Info($"{LocalName}：已中断，当前状态 {State}")
State = NetState.Interrupted
State = NetState.Canceled
End SyncLock
InterruptInternal()
CancelInternal()
End Sub
Private Sub InterruptInternal()
Private Sub CancelInternal()
On Error Resume Next
Reset()
Interlocked.Decrement(NetManager.FileRemain)
@@ -1395,7 +1392,7 @@ Retry:
''' <summary>
''' 需要下载的文件。
''' </summary>
Public Files As ConcurrentList(Of NetFile)
Public Files As ConcurrentQueue(Of NetFile)
''' <summary>
''' 剩余未完成的文件数。（用于减轻 FilesLock 的占用）
''' </summary>
@@ -1470,12 +1467,12 @@ FinishExCatch:
Public Sub New(Name As String, FileTasks As IEnumerable(Of NetFile))
Me.Name = Name
Files = New ConcurrentList(Of NetFile)(FileTasks)
Files = New ConcurrentQueue(Of NetFile)(FileTasks)
End Sub
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
If Input IsNot Nothing Then Files = New ConcurrentList(Of NetFile)(Input)
If Input IsNot Nothing Then Files = New ConcurrentQueue(Of NetFile)(CType(Input, IEnumerable(Of NetFile)))
'去重
Files = New ConcurrentList(Of NetFile)(Files.DistinctBy(Function(a) a.LocalPath))
Files = New ConcurrentQueue(Of NetFile)(Files.DistinctBy(Function(a) a.LocalPath))
'设置剩余文件数
SyncLock FileRemainLock
FileRemain += Files.Where(Function(f) f.State <> NetState.Finished).Count
@@ -1507,6 +1504,7 @@ FinishExCatch:
'接入下载管理器，获取新开始下载的文件列表
Dim NewFiles = NetManager.Start(Me)
'====================================
' 已存在文件查找
'====================================
@@ -1514,9 +1512,9 @@ FinishExCatch:
'整理允许进行查找的文件
Dim FilesToCheck As New List(Of NetFile)
For Each File In NewFiles
If File.Check?.CanUseExistsFile Then
If File.Check IsNot Nothing Then
FilesToCheck.Add(File)
Else '不允许，直接开始下载
Else '没有校验信息，直接开始下载
SyncLock LockState
File.State = NetState.WaitingToDownload
File.IsCopy = False
@@ -1526,7 +1524,7 @@ FinishExCatch:
If Not FilesToCheck.Any Then Return
'获取 MC 文件夹列表
Dim Folders As New List(Of String)
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里
Folders.Add(Paths.AppData & ".minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里
Folders.AddRange(McFolderList.Select(Function(f) f.Location))
Folders = Folders.Distinct.Where(Function(f) DirectoryUtils.Exists(f)).ToList
'平均分配到多个检查线程
@@ -1555,7 +1553,7 @@ FinishExCatch:
'列出 MC 文件夹中的各个版本文件夹
Dim VersionFolders As New List(Of String)
For Each McFolder In FolderList
For Each VersionFolder In DirectoryUtils.GetDirectories(McFolder & "versions\", True)
For Each VersionFolder In DirectoryUtils.EnumerateDirectories(McFolder & "versions\")
VersionFolders.Add(PathUtils.AddSlashSuffix(VersionFolder))
Next
Next
@@ -1625,7 +1623,7 @@ FinishExCatch:
Case "versions\"
'版本 jar 或 json：查找 MC 文件夹下的各个版本文件夹
For Each VersionFolder In VersionFolders
For Each Candidate In DirectoryUtils.GetFiles(VersionFolder, True, "*." & PathUtils.GetLastPart(File.LocalPath).AfterLast(".").Lower)
For Each Candidate In DirectoryUtils.EnumerateFiles(VersionFolder, searchPattern:="*." & PathUtils.GetLastPart(File.LocalPath).AfterLast(".").Lower)
If CheckCandidate(Candidate, File.Check) Then Return Candidate
Next
Next
@@ -1633,7 +1631,7 @@ FinishExCatch:
'社区资源
If File.Check.ActualSize < 0 OrElse File.Check.Hash Is Nothing Then Return Nothing '必须要求指定了文件大小和 Hash
For Each Folder In FolderList.Concat(VersionFolders)
For Each Candidate In DirectoryUtils.GetFiles(Folder & Type, True)
For Each Candidate In DirectoryUtils.EnumerateFiles(Folder & Type)
If CheckCandidate(Candidate, File.Check) Then Return Candidate
Next
Next
@@ -1671,12 +1669,12 @@ FinishExCatch:
If State >= LoadState.Finished Then Return
If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误！")}
'寻找有效的错误信息
Dim UsefulExs = ExList.Where(Function(e) TypeOf e IsNot OperationCanceledException AndAlso TypeOf e IsNot TimeoutException AndAlso TypeOf e IsNot ThreadInterruptedException).ToList
Dim UsefulExs = ExList.Where(Function(e) Not e.IsCanceled AndAlso TypeOf e IsNot TimeoutException).ToList
[Error] = If(UsefulExs.FirstOrDefault, ExList.FirstOrDefault)
'获取实际失败的文件
For Each File In Files
If File.State <> NetState.Interrupted Then Continue For
If File.Sources.All(Function(s) TypeOf s.Ex Is OperationCanceledException OrElse TypeOf s.Ex Is TimeoutException OrElse TypeOf s.Ex Is ThreadInterruptedException) Then Continue For
If File.State <> NetState.Canceled Then Continue For
If File.Sources.All(Function(s) s.Ex.IsCanceled OrElse TypeOf s.Ex Is TimeoutException) Then Continue For
Dim Detail As String = File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetDisplay(False))}（{s.Url}）").Join(vbCrLf)
[Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf &
"各下载源的错误如下：" & vbCrLf & Detail, [Error])
@@ -1691,20 +1689,20 @@ FinishExCatch:
End SyncLock
'中断所有文件
For Each TaskFile In Files
TaskFile.Interrupt(Me)
TaskFile.Cancel(Me)
Next
'在退出同步锁后再进行日志输出
Logger.Error(New AggregateException(ExList), "下载加载器失败", LogBehavior.None)
End Sub
Public Overrides Sub Interrupt()
Public Overrides Sub Cancel()
SyncLock LockState
If State >= LoadState.Finished Then Return
State = LoadState.Interrupted
State = LoadState.Canceled
End SyncLock
Logger.Info($"{Name} 已取消！")
'中断所有文件
For Each TaskFile In Files
TaskFile.Interrupt(Me)
TaskFile.Cancel(Me)
Next
End Sub
@@ -1726,7 +1724,7 @@ FinishExCatch:
''' <summary>
''' 当前的所有下载任务。
''' </summary>
Public Tasks As New ConcurrentList(Of LoaderDownload)
Public Tasks As New ConcurrentBag(Of LoaderDownload)
''' <summary>
''' 已下载完成的大小。
@@ -1777,7 +1775,7 @@ FinishExCatch:
If SpeedLast.Count >= 10 Then Limit = SpeedLast.Take(10).Average * 0.85 '取近 1 秒的平均速度的 85%
If Limit > NetTaskSpeedLimitLow Then
NetTaskSpeedLimitLow = Limit
Logger.Info($"速度下限已提升到 {FormatFileSize(Limit)}")
Logger.Info($"速度下限已提升到 {StringUtils.FormatByteSize(Limit)}")
End If
#End Region
#Region "刷新下载任务属性"
@@ -1894,14 +1892,13 @@ FinishExCatch:
End SyncLock
'添加每个文件
Dim NewFiles As New List(Of NetFile)
For i = 0 To Task.Files.Count - 1
Dim File As NetFile = Task.Files(i)
Dim NewFilesList As New List(Of NetFile)
For Each File In Task.Files
Dim OngoingFile As NetFile = Nothing
If AllFiles.TryGetValue(File.LocalPath, OngoingFile) AndAlso OngoingFile.State < NetState.Finished Then
'该文件正在被另一个任务下载
Logger.Trace(Function() $"{File.LocalName}：无需开始，该文件已在下载中，目标 {File.LocalPath}")
File = OngoingFile '将列表中的文件替换成下载中的文件，即两个任务指向同一个文件；抛弃现在的 File 对象
Task.Files(i) = File
Else
'常规情况（该文件可能已在其他任务中下载完成，但这并不影响）
Logger.Trace(Function() $"{File.LocalName}：开始，目标 {File.LocalPath}")
@@ -1909,8 +1906,10 @@ FinishExCatch:
NewFiles.Add(File)
Interlocked.Increment(FileRemain)
End If
NewFilesList.Add(File)
File.Tasks.Add(Task)
Next
Task.Files = New ConcurrentQueue(Of NetFile)(NewFilesList)
Tasks.Add(Task)
Return NewFiles
End Function
Plain Craft Launcher 2/Modules/Base/ModValidate.vb
+16 -2
View File
@@ -1,4 +1,4 @@
'提供不同的输入验证方法，名称以 Validate 开头
'提供不同的输入验证方法，名称以 Validate 开头
Public Module ModValidate
''' <summary>
@@ -66,6 +66,20 @@ Public Class ValidateNullOrWhiteSpace
End Function
End Class
''' <summary>
''' 自定义的 Validate。
''' </summary>
Public Class ValidateFunc
Inherits Validate
Private ReadOnly _func As Func(Of String, String)
Public Sub New(F As Func(Of String, String))
_func = F
End Sub
Public Overrides Function Validate(Str As String) As String
Return _func(Str)
End Function
End Class
''' <summary>
''' 必须满足正则表达式。
''' </summary>
@@ -255,7 +269,7 @@ Public Class ValidateFolderName
Me.IgnoreCase = IgnoreCase
Me.UseMinecraftCharCheck = UseMinecraftCharCheck
On Error Resume Next
PathIgnore = DirectoryUtils.GetDirectories(Folder, True)
PathIgnore = DirectoryUtils.EnumerateDirectories(Folder)
End Sub
Public Overrides Function Validate(Str As String) As String
Try
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
+2 -4
View File
@@ -1,4 +1,4 @@
'一个万能的自动图片类型转换工具类
'一个万能的自动图片类型转换工具类
Imports System.Drawing.Imaging
@@ -126,9 +126,7 @@ Public Class MyBitmap
End Sub
Private Class WebPDecoder '将代码隔离在另外一个类中，这样只要不调用这个方法就不会加载 Imazen.WebP.dll
Public Shared Function DecodeFromBytes(Bytes As Byte()) As System.Drawing.Bitmap
If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
Dim Decoder As New Imazen.WebP.SimpleDecoder()
Return Decoder.DecodeFromBytes(Bytes, Bytes.Length)
Return New Imazen.WebP.SimpleDecoder().DecodeFromBytes(Bytes, Bytes.Length)
End Function
End Class
Plain Craft Launcher 2/Modules/Base/PclLogger.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class PclLogger
Public Class PclLogger
Inherits FileLogger
''' <inheritdoc/>
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+2 -2
View File
@@ -1,4 +1,4 @@
Public Class CrashAnalyzer
Public Class CrashAnalyzer
'构造函数
Private TempFolder As String
@@ -24,7 +24,7 @@
'简单收集可能的日志文件路径
Dim PossibleLogs As New List(Of String)
Try
PossibleLogs.AddRange(DirectoryUtils.GetFiles(VersionPathIndie & "crash-reports\"))
PossibleLogs.AddRange(DirectoryUtils.EnumerateFiles(VersionPathIndie & "crash-reports\", True))
Catch ex As Exception
Logger.Warn(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败")
End Try
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+61 -62
View File
@@ -1,4 +1,4 @@
Public Module ModDownload
Public Module ModDownload
#Region "DlClient* | Minecraft 客户端"
@@ -20,7 +20,7 @@
Throw New Exception("底层版本 " & Instance.Name & " 中无 jar 文件下载信息")
End If
'检查文件
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Instance.JsonObject("downloads")("client")("size"), -1), Hash:=Instance.JsonObject("downloads")("client")("sha1"))
Dim Checker As New FileChecker With {.MinSize = 1024, .ActualSize = If(Instance.JsonObject("downloads")("client")("size"), -1), .Hash = Instance.JsonObject("downloads")("client")("sha1")}
If ReturnNothingOnFileUseable AndAlso Checker.Check(Instance.PathVersion & Instance.Name & ".jar") Is Nothing Then Return Nothing '通过校验
'返回下载信息
Dim JarUrl As String = Instance.JsonObject("downloads")("client")("url")
@@ -44,14 +44,14 @@
If IndexUrl = "" Then
Return Nothing
Else
Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl), IndexAddress, New FileChecker(CanUseExistsFile:=False, IsJson:=True))
Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl), IndexAddress, New FileChecker With {.IsJson = True})
End If
End Function
''' <summary>
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
''' </summary>
Public Function DlClientFix(Instance As McInstance, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
Public Function DlClientFix(Instance As McInstance, CheckAssetsHash As Boolean, DownloadAssetIndexInBackground As Boolean) As List(Of LoaderBase)
Dim Loaders As New List(Of LoaderBase)
#Region "下载支持库文件"
@@ -69,6 +69,8 @@
Else
Dim LoadersAssets As New List(Of LoaderBase)
'获取资源文件索引地址
Dim TempAddressMain As String = Nothing
Dim RealAddressMain As String = Nothing
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
@@ -76,9 +78,16 @@
If IndexFile Is Nothing Then
Task.Output = New List(Of NetFile)
Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
ElseIf DownloadAssetIndexInBackground Then
If IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
Task.Output = New List(Of NetFile) From {IndexFile}
End If
Else '强制要求重新下载
RealAddressMain = IndexFile.LocalPath
TempAddressMain = PathTemp & "Cache\" & IndexFile.LocalName
IndexFile.LocalPath = TempAddressMain
Task.Output = New List(Of NetFile) From {IndexFile}
End If
Catch ex As Exception
@@ -87,65 +96,55 @@
End Sub) With {.ProgressWeight = 0.5, .Show = False})
'下载资源文件索引
LoadersAssets.Add(New LoaderDownload("下载资源文件索引", New List(Of NetFile)) With {.ProgressWeight = 2})
'要求独立更新索引
If AssetsIndexBehaviour = AssetsIndexExistsBehaviour.DownloadInBackground Then
'获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("获取资源文件列表",
Sub(Task)
If TempAddressMain IsNot Nothing Then FileUtils.Move(TempAddressMain, RealAddressMain)
Task.Output = McAssetsFixList(Instance, CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 0.01})
'下载资源文件
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
'构造加载器
Loaders.Add(New LoaderCombo(Of String)("下载资源文件（主加载器）", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 27})
'后台独立更新索引
If DownloadAssetIndexInBackground Then
Dim RealAddressBg As String = Nothing
Dim TempAddressBg As String = Nothing
Dim LoadersAssetsUpdate As New List(Of LoaderBase)
Dim TempAddress As String = Nothing
Dim RealAddress As String = Nothing
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
If BackAssetsFile Is Nothing Then
Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
Task.Interrupt()
Throw New ThreadInterruptedException
Task.Cancel()
Throw New OperationCanceledException
End If
RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
BackAssetsFile.LocalPath = TempAddress
RealAddressBg = BackAssetsFile.LocalPath
TempAddressBg = PathTemp & "Cache\" & BackAssetsFile.LocalName & "_background"
BackAssetsFile.LocalPath = TempAddressBg
Task.Output = New List(Of NetFile) From {BackAssetsFile}
'检查是否需要更新：每天只更新一次
If FileUtils.Exists(RealAddress) AndAlso Math.Abs((FileUtils.GetInfo(RealAddress).LastWriteTime.Date - Now.Date).TotalDays) < 1 Then
If FileUtils.Exists(RealAddressBg) AndAlso Math.Abs((FileUtils.GetInfo(RealAddressBg).LastWriteTime.Date - Now.Date).TotalDays) < 1 Then
Logger.Info("无需更新资源文件索引，取消")
Task.Interrupt()
Task.Cancel()
End If
End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
Sub(Task As LoaderTask(Of List(Of NetFile), String))
FileUtils.Copy(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功：" & TempAddress)
FileUtils.Move(TempAddressBg, RealAddressBg)
McLaunchLog("后台更新资源文件索引成功：" & TempAddressBg)
End Sub))
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
Logger.Info("开始后台检查资源文件索引")
Updater.Start()
End If
'获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("获取资源文件列表",
Sub(Task) Task.Output = McAssetsFixList(Instance, CheckAssetsHash, Task)) With {.ProgressWeight = 0.01})
'下载资源文件
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
'构造加载器
Loaders.Add(New LoaderCombo(Of String)("下载资源文件（主加载器）", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 27})
End If
#End Region
Return Loaders
End Function
Public Enum AssetsIndexExistsBehaviour
''' <summary>
''' 如果文件存在，则不进行下载。
''' </summary>
DontDownload
''' <summary>
''' 如果文件存在，则启动新的下载加载器进行独立的更新。
''' </summary>
DownloadInBackground
''' <summary>
''' 如果文件存在，也同样进行下载。
''' </summary>
AlwaysDownload
End Enum
#End Region
@@ -227,7 +226,7 @@
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim StartTime As Long = GetTimeMs()
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
Dim Json As JObject = NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True).DeserializeJson()
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
@@ -238,7 +237,7 @@
Logger.Info($"Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
End If
'添加 PCL 特供项
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(FileUtils.ReadAsString(PathTemp & "Cache\download.json")))
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(FileUtils.ReadAsJson(PathTemp & "Cache\download.json"))
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
'MC 更新提示
@@ -269,12 +268,12 @@
''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True))
Dim Json As JObject = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True).DeserializeJson()
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
'添加 PCL 特供项
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(FileUtils.ReadAsString(PathTemp & "Cache\download.json")))
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(FileUtils.ReadAsJson(PathTemp & "Cache\download.json"))
'检查是否有要求的版本（#5195）
If Not String.IsNullOrEmpty(Loader.Input) Then
Dim Id = Loader.Input
@@ -308,7 +307,7 @@
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
Case LoadState.Loading
DlClientListLoader.WaitForExit(Id)
Case LoadState.Failed, LoadState.Interrupted, LoadState.Waiting
Case LoadState.Failed, LoadState.Canceled, LoadState.Waiting
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
End Select
'重新查找版本
@@ -447,7 +446,7 @@
''' </summary>
Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True))
Dim Json As JArray = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True).DeserializeJson()
Try
Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json
@@ -531,8 +530,8 @@
''' </summary>
Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
Encoding:=Encoding.Default, RequireJson:=True))
Dim Result As JArray = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
Encoding:=Encoding.Default, RequireJson:=True).DeserializeJson()
Dim Names As List(Of String) = Result.Select(Function(v) v.ToString).ToList
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足")
Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names}
@@ -738,8 +737,8 @@
''' Forge 版本列表，BMCLAPI。
''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4，#4057
Dim Json As JArray = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), RequireJson:=True).DeserializeJson() '兼容 Forge 1.7.10-pre4，#4057
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -1026,7 +1025,7 @@
''' </summary>
Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True))
Dim Result As JObject = NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True).DeserializeJson()
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -1054,7 +1053,7 @@
''' </summary>
Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True))
Dim Result As JObject = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True).DeserializeJson()
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -1125,7 +1124,7 @@
''' </summary>
Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain)
Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True))
Dim Result As JObject = NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True).DeserializeJson()
Try
Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1140,7 +1139,7 @@
''' </summary>
Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True))
Dim Result As JObject = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True).DeserializeJson()
Try
Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1197,7 +1196,7 @@
Dim Exs As String = ""
For Each Source In Urls
Try
Return GetJson(NetRequestByClient(Source.Url, Method, Content, ContentType, Timeout:=Source.Timeout * 1000, Encoding:=Encoding.UTF8, RequireJson:=True))
Return NetRequestByClient(Source.Url, Method, Content, ContentType, Timeout:=Source.Timeout * 1000, Encoding:=Encoding.UTF8, RequireJson:=True).DeserializeJson()
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
@@ -1328,7 +1327,7 @@
If SubLoader.Key.State = LoadState.Finished Then
'检查加载器成功
MainLoader.Output = SubLoader.Key.Output
DlSourceLoaderInterrupt(LoaderList)
DlSourceLoaderCancel(LoaderList)
Return
ElseIf BeforeLoadersAllFailed Then
'此前的加载器全部失败，直接启动后续加载器
@@ -1360,7 +1359,7 @@
End If
Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderInterrupt(LoaderList)
DlSourceLoaderCancel(LoaderList)
Throw ErrorInfo
End If
Exit For
@@ -1369,15 +1368,15 @@
Thread.Sleep(10)
WaitCycle += 1
'检查父加载器中断
If MainLoader.IsInterrupted Then
DlSourceLoaderInterrupt(LoaderList)
If MainLoader.IsCanceled Then
DlSourceLoaderCancel(LoaderList)
Return
End If
Loop
End Sub
Private Sub DlSourceLoaderInterrupt(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
Private Sub DlSourceLoaderCancel(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
For Each Loader In LoaderList
If Loader.Key.State = LoadState.Loading Then Loader.Key.Interrupt()
If Loader.Key.State = LoadState.Loading Then Loader.Key.Cancel()
Next
End Sub
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+553 -727
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+121 -284
View File
@@ -1,4 +1,4 @@
Public Module ModLaunch
Public Module ModLaunch
#Region "开始"
@@ -81,7 +81,7 @@
Public McLaunchWatcher As Watcher
Private Sub McLaunchState(Loader As LoaderTask(Of McLaunchOptions, Object))
Select Case McLaunchLoader.State
Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Interrupted
Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Canceled
FrmLaunchLeft.PageChangeToLogin()
Case LoadState.Loading
'在预检测结束后再触发动画
@@ -91,7 +91,7 @@
''' <summary>
''' 指定启动中断时的提示文本。若不为 Nothing 则会显示为绿色。
''' </summary>
Private InterruptHint As String = Nothing
Private CanceledHint As String = Nothing
'实际的启动方法
Private Sub McLaunchStart(Loader As LoaderTask(Of McLaunchOptions, Object))
@@ -102,7 +102,7 @@
McLaunchPrecheck()
McLaunchLog("预检测已通过")
Catch ex As Exception
If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Red)
If Not ex.IsCanceled Then Hint(ex.Message, HintType.Red)
Throw
End Try
Dim IsSavingBatch As Boolean = CurrentLaunchOptions?.SaveBatch IsNot Nothing
@@ -113,7 +113,7 @@
Dim Loaders As New List(Of LoaderBase) From {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
McLoginLoader, '.ProgressWeight = 15, .Block = False
New LoaderCombo(Of String)("补全文件", DlClientFix(McInstanceSelected, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
New LoaderCombo(Of String)("补全文件", DlClientFix(McInstanceSelected, False, True)) With {.ProgressWeight = 15, .Show = False},
New LoaderTask(Of String, Integer)("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
@@ -138,7 +138,7 @@
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器，它会自行决定是否启动副加载器
'等待加载器执行并更新 UI
McLaunchLoaderReal = LaunchLoader
InterruptHint = Nothing
CanceledHint = Nothing
LaunchLoader.Start()
'任务栏进度条
LoaderTaskbarAdd(LaunchLoader)
@@ -157,11 +157,11 @@
"Version", McInstanceSelected.VersionDisplayName,
"LoginType", Settings.Get(Of McLoginType)("LoginType").ToString)
End If
Case LoadState.Interrupted
If InterruptHint Is Nothing Then
Case LoadState.Canceled
If CanceledHint Is Nothing Then
Hint(If(IsSavingBatch, "已取消导出启动脚本！", "已取消启动！"), HintType.Blue)
Else
Hint(InterruptHint, HintType.Green)
Hint(CanceledHint, HintType.Green)
End If
Case LoadState.Failed
Throw LaunchLoader.Error
@@ -169,12 +169,12 @@
Throw New Exception("错误的状态改变：" & LaunchLoader.State.ToString())
End Select
Catch ex As Exception
ex.ThrowIfCanceled()
Dim CurrentEx = ex
NextInner:
If CurrentEx.Message.StartsWithF("$") Then
'若有以 $ 开头的错误信息，则以此为准显示提示
'若错误信息为 $$，则不提示
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
MyMsgBox(CurrentEx.Message.TrimStart("$"), If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
Throw
ElseIf CurrentEx.InnerException IsNot Nothing Then
'检查下一级错误
@@ -208,7 +208,7 @@ NextInner:
PageOtherTest.MemoryOptimize(False)
Finished = True
End Sub, "Launch Memory Optimize")
Do While Not Finished AndAlso Not Loader.IsInterrupted
Do While Not Finished AndAlso Not Loader.IsCanceled
If Loader.Progress < 0.7 Then
Loader.Progress += 0.007 '10s
Else
@@ -273,7 +273,7 @@ NextInner:
Hint("游戏将以试玩模式启动！", HintType.Red)
CurrentLaunchOptions.ExtraGameArgs.Add("--demo")
Case 3
Throw New Exception("$$")
Throw New OperationCanceledException
End Select
End If
End If
@@ -353,7 +353,8 @@ NextInner:
Type = McLoginType.Ms
End Sub
Public Overrides Function GetHashCode() As Integer
Return (OAuthRefreshToken & AccessToken & Uuid & UserName & ProfileJson).GetStableHashCode() Mod Integer.MaxValue
'不能使用全部信息，这俩就足以在登录输入时确保是同一个用户了
Return (OAuthRefreshToken & UserName).GetStableHashCode() Mod Integer.MaxValue
End Function
End Class
Public Class McLoginLegacy
@@ -465,7 +466,7 @@ NextInner:
Public McLoginLoader As New LoaderTask(Of McLoginData, McLoginResult)("登录", AddressOf McLoginStart, AddressOf McLoginInput, ThreadPriority.BelowNormal) With {.ReloadTimeout = 1, .ProgressWeight = 15, .Block = False}
Public Function McLoginInput() As McLoginData
Dim LoginData As McLoginData = Nothing
Dim LoginType As McLoginType = Settings.Get(Of McLoginType)("LoginType")
Dim LoginType = Settings.Get(Of McLoginType)("LoginType")
Try
Select Case LoginType
Case McLoginType.Legacy
@@ -489,10 +490,10 @@ NextInner:
LoginData = PageLoginAuthSkin.GetLoginData()
End If
End Select
Return LoginData
Catch ex As Exception
Logger.Error(ex, $"获取登录输入信息失败（{LoginType}）")
Throw New Exception($"获取登录输入信息失败（{LoginType}）", ex)
End Try
Return LoginData
End Function
Private Sub McLoginStart(Data As LoaderTask(Of McLoginData, McLoginResult))
McLaunchLog("登录加载已开始")
@@ -559,24 +560,24 @@ Relogin:
OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken)
If OAuthTokens.OAuthAccessToken = "Relogin" Then GoTo Relogin '要求重新打开登录网页认证
End If
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
Data.Progress = 0.25
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
Dim OAuthAccessToken As String = OAuthTokens.OAuthAccessToken
Dim OAuthRefreshToken As String = OAuthTokens.OAuthRefreshToken
Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
Data.Progress = 0.4
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
Dim Tokens = MsLoginStep3(XBLToken)
Data.Progress = 0.55
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
Dim LoginResult = MsLoginStep4(Tokens)
ExpiresAt = LoginResult.ExpiresAt
Data.Progress = 0.7
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
MsLoginStep5(LoginResult.AccessToken)
Data.Progress = 0.85
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
Dim Result = MsLoginStep6(LoginResult.AccessToken)
Data.Progress = 0.98
'输出登录结果
@@ -586,14 +587,14 @@ Relogin:
Settings.Set("CacheMsV2Name", Result.UserName)
Settings.Set("CacheMsV2ProfileJson", Result.ProfileJson)
Settings.Set("CacheMsV2Expires", LoginResult.ExpiresAt)
Dim MsJson As JObject = GetJson(Settings.Get(Of String)("LoginMsJson"))
Dim MsJson As JObject = Settings.Get(Of String)("LoginMsJson").DeserializeJson()
MsJson.Remove(Input.UserName) '如果更改了玩家名……
MsJson(Result.UserName) = OAuthRefreshToken
Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
Data.Output = New McLoginResult With {.AccessToken = LoginResult.AccessToken, .Name = Result.UserName, .Uuid = Result.UUID, .Type = "Microsoft", .ClientToken = Result.UUID, .ProfileJson = Result.ProfileJson}
'结束
SkipLogin:
McLaunchLog($"微软登录结束，AccessToken 将在 {DateTimeOffset.FromUnixTimeSeconds(ExpiresAt).Date.ToLocalTime} 过期")
McLaunchLog($"微软登录结束，AccessToken 将在 {DateTimeOffset.FromUnixTimeSeconds(ExpiresAt).LocalDateTime} 过期")
Settings.Set("HintBuy", True) '关闭正版购买提示
If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持！" & vbCrLf & "隐藏主题 跳票红 已解锁！", "提示")
End Sub
@@ -612,7 +613,7 @@ SkipLogin:
Settings.Get(Of String)("Cache" & Input.Token & "Name") <> "" Then
'尝试验证登录
Try
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
McLoginRequestValidate(Data)
GoTo LoginFinish
Catch ex As Exception
@@ -623,7 +624,7 @@ SkipLogin:
'尝试刷新登录
Refresh:
Try
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
McLoginRequestRefresh(Data, NeedRefresh)
GoTo LoginFinish
Catch ex As Exception
@@ -634,7 +635,7 @@ Refresh:
End If
'尝试普通登录
Try
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
NeedRefresh = McLoginRequestLogin(Data)
Catch ex As Exception
McLaunchLog("登录失败：" & ex.GetDisplay(True))
@@ -718,7 +719,7 @@ LoginFinish:
End Sub
Private Sub McLoginRequestRefresh(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult), RequestUser As Boolean)
McLaunchLog("刷新登录开始（Refresh, " & Data.Input.Token & "）")
Dim LoginJson As JObject = GetJson(NetRequestByClientRetry(
Dim LoginJson As JObject = NetRequestByClientRetry(
Data.Input.BaseUrl & "/refresh", HttpMethod.Post,
Content:=New JObject(
New JProperty("selectedProfile", New JObject(
@@ -729,7 +730,7 @@ LoginFinish:
New JProperty("requestUser", True)
).ToString(Newtonsoft.Json.Formatting.None),
Headers:={{"Accept-Language", "zh-CN"}},
ContentType:="application/json; charset=utf-8", RequireJson:=True))
ContentType:="application/json; charset=utf-8", RequireJson:=True).DeserializeJson()
'将登录结果输出
If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Settings.Get(Of String)("Cache" & Data.Input.Token & "Name") & " 无效！")
Data.Output.AccessToken = LoginJson("accessToken").ToString
@@ -755,11 +756,11 @@ LoginFinish:
New JProperty("username", Data.Input.UserName),
New JProperty("password", Data.Input.Password),
New JProperty("requestUser", True))
Dim LoginJson As JObject = GetJson(NetRequestByClientRetry(
Dim LoginJson As JObject = NetRequestByClientRetry(
Data.Input.BaseUrl & "/authenticate", HttpMethod.Post,
Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
Headers:={{"Accept-Language", "zh-CN"}},
ContentType:="application/json; charset=utf-8", RequireJson:=True))
ContentType:="application/json; charset=utf-8", RequireJson:=True).DeserializeJson()
'检查登录结果
If LoginJson("availableProfiles").Count = 0 Then
If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色，无法更换！", HintType.Red)
@@ -824,7 +825,7 @@ LoginFinish:
Dim ErrorMessage As String = Nothing
Try
Dim Response = DirectCast(ex, HttpRequestCodeException).Response
If Response.ContainsIgnoreCase("errorMessage") Then ErrorMessage = GetJson(Response)("errorMessage").ToString()
If Response.ContainsIgnoreCase("errorMessage") Then ErrorMessage = Response.DeserializeJson()("errorMessage").ToString()
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
@@ -874,14 +875,14 @@ LoginFinish:
'初始请求
Retry:
McLaunchLog("开始微软登录步骤 1/6（原始登录）")
Dim PrepareJson As JObject = GetJson(NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post,
Dim PrepareJson As JObject = NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post,
Content:=$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access",
ContentType:="application/x-www-form-urlencoded", RequireJson:=True))
ContentType:="application/x-www-form-urlencoded", RequireJson:=True).DeserializeJson()
McLaunchLog("网页登录地址：" & PrepareJson("verification_uri").ToString)
'弹窗
Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
WaitingMyMsgBox.Add(Converter)
WaitingMyMsgBox.Enqueue(Converter)
While Converter.Result Is Nothing
Thread.Sleep(100)
End While
@@ -891,7 +892,7 @@ Retry:
Button2Action:=Sub() OpenWebsite("https://account.live.com/password/Change")) = 1 Then
GoTo Retry
Else
Throw New Exception("$$")
Throw New OperationCanceledException
End If
ElseIf TypeOf Converter.Result Is Exception Then
Throw CType(Converter.Result, Exception)
@@ -906,7 +907,7 @@ Retry:
Dim Result As String
Try
Result = NetRequestByClientMultiple("https://login.live.com/oauth20_token.srf", HttpMethod.Post,
Content:=$"client_id={OAuthClientId}&refresh_token={EscapeUtils.FormUrlEscape(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
Content:=$"client_id={OAuthClientId}&refresh_token={StringUtils.FormUrlEscape(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
ContentType:="application/x-www-form-urlencoded",
Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}},
ThreadCount:=2)
@@ -919,16 +920,16 @@ Retry:
Return ("Relogin", "")
ElseIf Response.Contains("Account security interrupt") Then
MyMsgBox("该账号由于安全问题无法登陆，请前往微软账户页获取更多信息。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
Throw New OperationCanceledException
ElseIf Response.Contains("service abuse") Then
MyMsgBox("非常抱歉，该账号已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
Throw New OperationCanceledException
Else
Throw
End If
End Try
Dim ResultJson As JObject = GetJson(Result)
Dim ResultJson As JObject = Result.DeserializeJson()
Dim AccessToken As String = ResultJson("access_token").ToString
Dim RefreshToken As String = ResultJson("refresh_token").ToString
Return (AccessToken, RefreshToken)
@@ -946,9 +947,8 @@ Retry:
""RelyingParty"": ""http://auth.xboxlive.com"",
""TokenType"": ""JWT""
}"
Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
Content:=Request, ContentType:="application/json", RequireJson:=True)
Return GetJson(Result)("Token").ToString
Return NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
Content:=Request, ContentType:="application/json", RequireJson:=True).DeserializeJson()("Token").ToString
End Function
'微软登录步骤 3：从 XBLToken 获取 {XSTSToken, UHS}
Private Function MsLoginStep3(XBLToken As String) As (XSTSToken As String, UHS As String)
@@ -970,15 +970,15 @@ Retry:
'参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
If ex.Response.Contains("2148916227") Then
MyMsgBox("该账号似乎已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
Throw New OperationCanceledException
ElseIf ex.Response.Contains("2148916233") Then
If MyMsgBox("你尚未注册 Xbox 账户，请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then
OpenWebsite("https://signup.live.com/signup")
End If
Throw New Exception("$$")
Throw New OperationCanceledException
ElseIf ex.Response.Contains("2148916235") Then
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN，然后再试。", "登录失败", "我知道了")
Throw New Exception("$$")
Throw New OperationCanceledException
ElseIf ex.Response.Contains("2148916238") Then
If MyMsgBox("该账号年龄不足，你需要先修改出生日期，然后才能登录。" & vbCrLf &
"该账号目前填写的年龄是否在 13 岁以上？", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
@@ -990,13 +990,13 @@ Retry:
MyMsgBox("请根据打开的网页的说明，修改账号的出生日期（至少改为 18 岁以上）。" & vbCrLf &
"在修改成功后等待一分钟，然后再回到 PCL，就可以正常登录了！", "登录提示")
End If
Throw New Exception("$$")
Throw New OperationCanceledException
Else
Throw
End If
End Try
Dim ResultJson As JObject = GetJson(Result)
Dim ResultJson As JObject = Result.DeserializeJson()
Return (
ResultJson("Token").ToString(), 'XSTSToken
ResultJson("DisplayClaims")("xui")(0)("uhs").ToString() 'UHS
@@ -1018,15 +1018,18 @@ Retry:
ElseIf ex.StatusCode = HttpStatusCode.Forbidden Then
Logger.Warn(ex, "微软登录第 4 步汇报 403")
Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器，请把它们关掉或更换节点后再试！")
ElseIf ex.StatusCode = HttpStatusCode.ServiceUnavailable Then
Logger.Warn(ex, "微软登录第 4 步汇报 503")
Throw New Exception("$Mojang 服务器出现问题，请稍后再试。" & vbCrLf & "你的网络是正常的，PCL 也是正常的，是 Mojang 出问题了……")
ElseIf ex.Response?.Contains("ACCOUNT_SUSPENDED") Then '#8655
MyMsgBox("该账号似乎已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
Throw New OperationCanceledException
Else
Throw
End If
End Try
Dim ResultJson As JObject = GetJson(Result)
Dim ResultJson As JObject = Result.DeserializeJson()
Return (
ResultJson("access_token").ToString,
ResultJson("expires_in").ToObject(Of Integer) + GetUnixTimestampUtc() - 1200) '提前 20 分钟视作过期
@@ -1038,13 +1041,13 @@ Retry:
Dim Result As String = NetRequestByClientMultiple("https://api.minecraftservices.com/entitlements/mcstore",
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
Try
Dim ResultJson As JObject = GetJson(Result)
Dim ResultJson As JObject = Result.DeserializeJson()
If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
Select Case MyMsgBox("你尚未购买正版 Minecraft，或者 Xbox Game Pass 已到期。", "登录失败", "购买 Minecraft", "取消")
Case 1
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End Select
Throw New Exception("$$")
Throw New OperationCanceledException
End If
Catch ex As Exception
Logger.Warn(ex, $"微软登录第 5 步异常：{Result}")
@@ -1073,12 +1076,12 @@ Retry:
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
End Select
End Sub, "Login Failed: Create Profile")
Throw New Exception("$$")
Throw New OperationCanceledException
Case Else
Throw
End Select
End Try
Dim ResultJson As JObject = GetJson(Result)
Dim ResultJson As JObject = Result.DeserializeJson()
Dim UUID As String = ResultJson("id").ToString
Dim UserName As String = ResultJson("name").ToString
Return (UUID, UserName, Result)
@@ -1131,7 +1134,7 @@ Retry:
If Len(Uuid) = 32 Then Return Uuid
'从官网获取
Try
Dim GotJson As JObject = GetJson(NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, RequireJson:=True))
Dim GotJson As JObject = NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, RequireJson:=True).DeserializeJson()
If GotJson Is Nothing Then Throw New FileNotFoundException("正版玩家档案不存在（" & Name & "）")
Uuid = If(GotJson("id"), "")
Catch ex As Exception
@@ -1156,183 +1159,16 @@ Retry:
#Region "Java 处理"
Public McLaunchJavaSelected As JavaEntry = Nothing
Public McLaunchJavaSelected As Java = Nothing
Private Sub McLaunchJava(Task As LoaderTask(Of Integer, Integer))
Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
'原版 26-：通过版本号判断
If (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2024, 4, 2)) OrElse
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla >= New Version(20, 0, 5)) Then
'1.20.5+（24w14a+）：至少 Java 21
MinVer = New Version(1, 21, 0, 0)
ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 11, 16)) OrElse
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 18) Then
'1.18 pre2+：至少 Java 17
MinVer = New Version(1, 17, 0, 0)
ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 5, 11)) OrElse
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 17) Then
'1.17+ (21w19a+)：至少 Java 16
MinVer = New Version(1, 16, 0, 0)
ElseIf McInstanceSelected.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年，太棒了
'1.12+：至少 Java 8
MinVer = New Version(1, 8, 0, 0)
ElseIf McInstanceSelected.ReleaseTime <= New Date(2013, 5, 1) AndAlso McInstanceSelected.ReleaseTime.Year >= 2001 Then '避免某些版本写个 1960 年
'1.5.2-：最高 Java 8
MaxVer = New Version(1, 8, 999, 999)
McLaunchJavaSelected = SelectOrDownloadJava(McInstanceSelected, True, Task.CreateCancellationToken, Task.CreateSyncProgressProvider)
If Task.IsCanceled Then Return
If McLaunchJavaSelected Is Nothing Then Throw New OperationCanceledException 'SelectOrDownloadJava 已经会给予适当的提示
If ModeDebug Then
McLaunchLog($"预期 Java 版本范围：{GetJavaRequirement(McInstanceSelected).Range}")
McLaunchLog($"Java 版本设置类别：{Settings.Get(Of Integer)("VersionArgumentJavaV2", McInstanceSelected)}")
End If
'原版 26+：获取 Mojang 要求的 Java 版本
Dim RecommendedComponent As String = Nothing
Dim RecommendedCode As Integer =
If(McInstanceSelected.JsonObject?("javaVersion")?("majorVersion")?.ToObject(Of Integer),
If(McInstanceSelected.JsonVersion?("java_version")?.ToObject(Of Integer), 0))
If RecommendedCode >= 22 Then
McLaunchLog("Mojang 要求至少使用 Java " & RecommendedCode)
MinVer = New Version(1, RecommendedCode, 0, 0)
RecommendedComponent =
If(McInstanceSelected.JsonObject?("javaVersion")?("component")?.ToString,
McInstanceSelected.JsonVersion?("java_component")?.ToString)
If RecommendedComponent = "" Then RecommendedComponent = Nothing
End If
'OptiFine 检测
If McInstanceSelected.Version.HasOptiFine AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
If McInstanceSelected.Version.Vanilla.Major < 7 Then
'<1.7：至多 Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McInstanceSelected.Version.Vanilla.Major >= 8 AndAlso McInstanceSelected.Version.Vanilla.Major < 12 Then
'1.8 - 1.11：必须恰好 Java 8
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999)
ElseIf McInstanceSelected.Version.Vanilla.Major = 12 Then
'1.12：最高 Java 8
MaxVer = New Version(1, 8, 999, 999)
End If
End If
'Forge 检测（部分测试结果见 #8432）
If McInstanceSelected.Version.HasForge Then
If McInstanceSelected.Version.Vanilla >= New Version(6, 0, 1) AndAlso McInstanceSelected.Version.Vanilla <= New Version(7, 0, 2) Then
'1.6.1 - 1.7.2：必须 Java 7
MinVer = If(New Version(1, 7, 0, 0) > MinVer, New Version(1, 7, 0, 0), MinVer)
MaxVer = If(New Version(1, 7, 999, 999) < MaxVer, New Version(1, 7, 999, 999), MaxVer)
ElseIf McInstanceSelected.Version.Vanilla.Major <= 12 OrElse Not McInstanceSelected.Version.Vaild Then '非标准版本
'<=1.12：Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McInstanceSelected.Version.Vanilla.Major <= 14 Then
'1.13 - 1.14：Java 8 - 10
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
MaxVer = If(New Version(1, 10, 999, 999) < MaxVer, New Version(1, 10, 999, 999), MaxVer)
ElseIf McInstanceSelected.Version.Vanilla.Major = 15 Then
'1.15：Java 8 - 15
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
MaxVer = If(New Version(1, 15, 999, 999) < MaxVer, New Version(1, 15, 999, 999), MaxVer)
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "34.0.0") AndAlso CompareVersionGE("36.2.25", McInstanceSelected.Version.Forge) Then
'1.16.3~5，Forge 34.0.0 ~ 36.2.25：最高 Java 8u320
MaxVer = If(New Version(1, 8, 0, 320) < MaxVer, New Version(1, 8, 0, 320), MaxVer)
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "36.2.26") AndAlso CompareVersionGE("36.999.999", McInstanceSelected.Version.Forge) Then
'1.16.5，Forge 36.2.26+，<37.0.0：最高 Java 23
MaxVer = If(New Version(1, 23, 999, 999) < MaxVer, New Version(1, 23, 999, 999), MaxVer)
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "37.0.0") AndAlso CompareVersionGE("37.0.79", McInstanceSelected.Version.Forge) Then
'1.17.1，Forge 37.0.0 ~ 37.0.79：最高 Java 16
MaxVer = If(New Version(1, 16, 999, 999) < MaxVer, New Version(1, 16, 999, 999), MaxVer)
ElseIf McInstanceSelected.Version.Vanilla.Major = 18 AndAlso McInstanceSelected.Version.HasOptiFine Then '#305
'1.18：若安装了 OptiFine，最高 Java 18
MaxVer = If(New Version(1, 18, 999, 999) < MaxVer, New Version(1, 18, 999, 999), MaxVer)
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "45.0.21") AndAlso CompareVersionGE("45.0.65", McInstanceSelected.Version.Forge) Then
'1.19.4，Forge 45.0.21 ~ 45.0.65：最高 Java 19
MaxVer = If(New Version(1, 19, 999, 999) < MaxVer, New Version(1, 19, 999, 999), MaxVer)
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "45.0.66") AndAlso CompareVersionGE("47.4.8", McInstanceSelected.Version.Forge) Then
'1.19.4~1.20.1，Forge 45.0.66 ~ 47.4.8：最高 Java 21
MaxVer = If(New Version(1, 21, 999, 999) < MaxVer, New Version(1, 21, 999, 999), MaxVer)
End If
End If
'NeoForge 检测
If McInstanceSelected.Version.HasNeoForge Then
If McInstanceSelected.Version.Vanilla = New Version(20, 0, 1) OrElse
(CompareVersionGE("20.2.62-beta", McInstanceSelected.Version.NeoForge) AndAlso Not McInstanceSelected.Version.NeoForge.Contains("25w14craftmine")) Then
'1.20.1，以及 1.20.2 的 20.2.62-beta 之前：最高 Java 21
MaxVer = If(New Version(1, 21, 999, 999) < MaxVer, New Version(1, 21, 999, 999), MaxVer)
End If
End If
'Fabric 检测
If McInstanceSelected.Version.HasFabric AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
If McInstanceSelected.Version.Vanilla.Major >= 15 AndAlso McInstanceSelected.Version.Vanilla.Major <= 16 Then
'1.15 - 1.16：Java 8+
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
ElseIf McInstanceSelected.Version.Vanilla.Major >= 18 Then
'1.18+：Java 17+
MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer)
End If
End If
'LiteLoader 检测
If McInstanceSelected.Version.HasLiteLoader AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
'最高 Java 8
MaxVer = If(New Version(1, 8, 999, 999) < MaxVer, New Version(1, 8, 999, 999), MaxVer)
End If
'统一通行证检测
If Settings.Get(Of McLoginType)("LoginType") = McLoginType.Nide Then
'至少 Java 8u101
MinVer = If(New Version(1, 8, 0, 141) > MinVer, New Version(1, 8, 0, 141), MinVer)
End If
SyncLock JavaLock
'选择 Java
McLaunchLog("Java 版本需求：最低 " & MinVer.ToString & "，最高 " & MaxVer.ToString)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
If Task.IsInterrupted Then Return
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
Return
End If
'无合适的 Java
If Task.IsInterrupted Then Return '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java
McLaunchLog("无合适的 Java，准备自动下载")
Dim JavaCode As String
If MinVer >= New Version(1, 9) Then
JavaCode = MinVer.Minor
ElseIf MaxVer < New Version(1, 8) Then
MyMsgBox($"你需要安装 Java 7 才能启动该版本。{vbCrLf}请自行搜索并安装 Java 7，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
MyMsgBox($"你需要安装 Java 8u141 ~ 8u320 才能启动该版本。{vbCrLf}请自行搜索并安装，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) Then
MyMsgBox($"你需要安装 Java 8u141 或更高版本的 Java 8 才能启动该版本。{vbCrLf}请自行搜索并安装，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
Throw New Exception("$$")
Else
JavaCode = 8
End If
'开始自动下载
Dim JavaLoader = GetJavaDownloadLoader()
Try
JavaLoader.Start(If(RecommendedComponent, JavaCode), IsForceRestart:=True) '在 Java 22+ 时优先使用 Mojang 提供的 Component 字段
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsInterrupted
Task.Progress = JavaLoader.Progress
Thread.Sleep(10)
Loop
Finally
JavaLoader.Interrupt() '确保取消时中止 Java 下载
End Try
'检查下载结果
If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872#
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
If Task.IsInterrupted Then Return
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
Else
Hint("没有可用的 Java，已取消启动！", HintType.Red)
Throw New Exception("$$")
End If
End SyncLock
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
End Sub
#End Region
@@ -1427,7 +1263,7 @@ NextInstance:
End If
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
If McLaunchJavaSelected.MajorVersion >= 6 Then Args.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
If McLaunchJavaSelected.Version.Major >= 6 Then Args.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = Settings.Get(Of String)("VersionServerAuthServer", Instance:=McInstanceSelected)
Try
McLaunchLog($"开始 Authlib Injector Prefetch")
@@ -1444,13 +1280,13 @@ NextInstance:
'非 GBK 编码下命令行参数乱码的问题（JDK-8272352）
Dim UseJLW As Boolean =
Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableJLW", McInstanceSelected) AndAlso
Not IsGBKEncoding AndAlso Not McFolderSelected.IsAsciiOnly() '仅在该环境下才会触发该 Bug
Not IsGBKEncoding '即使游戏文件夹名称不含非 ASCII 字符，但玩家名等也可能出现中文，因此依然需要 JLW（#8739）
If UseJLW AndAlso CustomArg.Contains("-javaagent") Then
UseJLW = False
McLaunchLog("由于使用了自定义 javaagent，已禁用 JLW，这可能导致游戏崩溃！", LogLevel.Warn)
End If
If UseJLW Then
If McLaunchJavaSelected.MajorVersion >= 9 Then
If McLaunchJavaSelected.Version.Major >= 9 Then
Args.Add("--add-exports") : Args.Add("cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
End If
Args.Add("-Doolloo.jlw.tmpdir=${pure_directory}") '这里需要不以 \ 结尾
@@ -1467,7 +1303,7 @@ NextInstance:
#Region "内存管理"
McLaunchLog("当前剩余内存：" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
Dim TargetRam As Integer = Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024)
Dim TargetRam As Integer = Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected) * 1024)
Args.Add("-Xmx" & TargetRam & "m")
'获取设置的管理方式
@@ -1480,17 +1316,17 @@ NextInstance:
If SetupType <> 3 Then
'确定是使用 G1GC 还是 ZGC
Dim UseG1GC As Boolean = False
If (SetupType = 0 AndAlso McLaunchJavaSelected.MajorVersion < 15) OrElse
(SetupType = 1 AndAlso McLaunchJavaSelected.MajorVersion < 21) OrElse
If (SetupType = 0 AndAlso McLaunchJavaSelected.Version.Major < 15) OrElse
(SetupType = 1 AndAlso McLaunchJavaSelected.Version.Major < 21) OrElse
(SetupType = 2 OrElse SetupType = 4) Then UseG1GC = True '检查 Java 版本，ZGC 在 Java 15+ 可用，分代 ZGC 在 Java 21+ 可用
If Is32BitSystem OrElse Environment.OSVersion.Version.Major < 10 OrElse Environment.OSVersion.Version.Build < 17763 Then UseG1GC = True '检查系统兼容性，ZGC 需要 Windows 10 1809+
McLaunchLog($"GC 设置：{SetupType}，选取 {If(UseG1GC, "G1GC", "ZGC")}，Java 版本：{McLaunchJavaSelected.MajorVersion}")
If Environment.OSVersion.Version.Major < 10 OrElse Environment.OSVersion.Version.Build < 17763 Then UseG1GC = True '检查系统兼容性，ZGC 需要 Windows 10 1809+
McLaunchLog($"GC 设置：{SetupType}，选取 {If(UseG1GC, "G1GC", "ZGC")}，Java 版本：{McLaunchJavaSelected.Version.Major}")
'移除已有的 GC 参数
Args = Args.Where(Function(a) Not a.RegexCheck(
"( )*-XX:[+-]?(Use\w+GC|ZGenerational|UseCompactObjectHeaders|G1\w+Percent|G1\w+Size|(Max|Min)(GCPauseMillis|HeapFreeRatio))")).ToList
'添加 GC 参数
Args.Add("-XX:+UnlockExperimentalVMOptions")
If McLaunchJavaSelected.MajorVersion >= 24 AndAlso McLaunchJavaSelected.Is64Bit Then Args.Add("-XX:+UseCompactObjectHeaders")
If McLaunchJavaSelected.Version.Major >= 24 Then Args.Add("-XX:+UseCompactObjectHeaders")
If UseG1GC AndAlso SetupType = 4 Then
'优化的 G1GC
Args.Add("-XX:+UseG1GC")
@@ -1499,10 +1335,10 @@ NextInstance:
Args.Add("-XX:G1HeapRegionSize=32M")
Args.Add("-XX:MaxGCPauseMillis=50")
If Not ModeDebug Then Args.Add("-XX:+PerfDisableSharedMem")
If McLaunchJavaSelected.MajorVersion <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
If McLaunchJavaSelected.MajorVersion = 8 Then Args.Add("-XX:+ParallelRefProcEnabled")
If McLaunchJavaSelected.MajorVersion >= 12 Then Args.Add("-XX:MinHeapFreeRatio=25") '需要比 G1NewSizePercent 大一点
If McLaunchJavaSelected.MajorVersion >= 12 Then Args.Add("-XX:MaxHeapFreeRatio=40") '需要比 MinHeapFreeRatio 大一些
If McLaunchJavaSelected.Version.Major <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
If McLaunchJavaSelected.Version.Major = 8 Then Args.Add("-XX:+ParallelRefProcEnabled")
If McLaunchJavaSelected.Version.Major >= 12 Then Args.Add("-XX:MinHeapFreeRatio=25") '需要比 G1NewSizePercent 大一点
If McLaunchJavaSelected.Version.Major >= 12 Then Args.Add("-XX:MaxHeapFreeRatio=40") '需要比 MinHeapFreeRatio 大一些
ElseIf UseG1GC Then
'Mojang G1GC
Args.Add("-XX:+UseG1GC")
@@ -1510,11 +1346,11 @@ NextInstance:
Args.Add("-XX:G1ReservePercent=20")
Args.Add("-XX:G1HeapRegionSize=32M")
Args.Add("-XX:MaxGCPauseMillis=50")
If McLaunchJavaSelected.MajorVersion <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
If McLaunchJavaSelected.Version.Major <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
Else
'ZGC
Args.Add("-XX:+UseZGC")
If McLaunchJavaSelected.MajorVersion = 21 OrElse McLaunchJavaSelected.MajorVersion = 22 Then Args.Add("-XX:+ZGenerational") 'Java 23 起默认启用分代 ZGC，不需要再添加参数
If McLaunchJavaSelected.Version.Major = 21 OrElse McLaunchJavaSelected.Version.Major = 22 Then Args.Add("-XX:+ZGenerational") 'Java 23 起默认启用分代 ZGC，不需要再添加参数
End If
End If
@@ -1526,9 +1362,9 @@ NextInstance:
Args.Add("-Dlog4j2.formatMsgNoLookups=true")
'编码（#4700、#5892、#5909）
If McLaunchJavaSelected.MajorVersion > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstdout.encoding=")) Then Args.Add("-Dstdout.encoding=UTF-8")
If McLaunchJavaSelected.MajorVersion > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstderr.encoding=")) Then Args.Add("-Dstderr.encoding=UTF-8")
If McLaunchJavaSelected.MajorVersion >= 18 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dfile.encoding=")) Then Args.Add("-Dfile.encoding=COMPAT") 'Dfile.encoding 需要放在 Dstdout.encoding 后面（#6934）
If McLaunchJavaSelected.Version.Major > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstdout.encoding=")) Then Args.Add("-Dstdout.encoding=UTF-8")
If McLaunchJavaSelected.Version.Major > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstderr.encoding=")) Then Args.Add("-Dstderr.encoding=UTF-8")
If McLaunchJavaSelected.Version.Major >= 18 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dfile.encoding=")) Then Args.Add("-Dfile.encoding=COMPAT") 'Dfile.encoding 需要放在 Dstdout.encoding 后面（#6934）
'为 JLW 添加 -jar，它必须放在最后
If UseJLW Then
@@ -1597,7 +1433,9 @@ NextInstance:
McLaunchLog("发现错误的 OptiFineForge TweakClass，目前的游戏参数：" & Arg)
Arg = Arg.Replace(" --tweakClass optifine.OptiFineTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try
FileUtils.Write(McInstanceSelected.GetJsonPath(), FileUtils.ReadAsString(McInstanceSelected.GetJsonPath()).Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
FileUtils.Write(
McInstanceSelected.GetJsonPath(),
FileUtils.ReadAsString(McInstanceSelected.GetJsonPath()).Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
Catch ex As Exception
Logger.Warn(ex, "替换 OptiFineForge TweakClass 失败")
End Try
@@ -1690,9 +1528,9 @@ NextInstance:
TargetSize = New Size(854, 480)
End Select
If McInstanceSelected.Version.Vanilla.Major <= 12 AndAlso
McLaunchJavaSelected.MajorVersion <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
McLaunchJavaSelected.Version >= New Version(8, 0, 200) AndAlso McLaunchJavaSelected.Version <= New Version(8, 0, 321) AndAlso
Not McInstanceSelected.Version.HasOptiFine AndAlso Not McInstanceSelected.Version.HasForge Then '修复 1.12.2- 下 JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍（#3463）
McLaunchLog($"已应用窗口大小过大修复（{McLaunchJavaSelected.Version.Revision}）")
McLaunchLog($"已应用窗口大小过大修复（Java 版本：{McLaunchJavaSelected.Version}）")
TargetSize.Width /= DPI / 96
TargetSize.Height /= DPI / 96
End If
@@ -1843,7 +1681,7 @@ NextInstance:
Next
'删除多余文件
For Each FileName As String In DirectoryUtils.GetFiles(Target, True)
For Each FileName As String In DirectoryUtils.EnumerateFiles(Target)
If ExistFiles.Contains(FileName) Then Continue For
Try
McLaunchLog("删除：" & FileName)
@@ -1862,7 +1700,7 @@ NextInstance:
Private Function GetNativesFolder() As String
Dim Result As String = PathUtils.AddSlashSuffix(PathUtils.ToShortPath(McInstanceSelected.PathVersion)) & McInstanceSelected.Name & "-natives\"
If Not (IsGBKEncoding OrElse Result.IsAsciiOnly()) Then
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives\"
Result = Paths.AppData & ".minecraft\bin\natives\"
If Not Result.IsAsciiOnly() Then
Result = OsDrive & "ProgramData\PCL\natives\"
End If
@@ -1880,15 +1718,15 @@ NextInstance:
'使用高性能显卡
If Settings.Get(Of Boolean)("LaunchAdvanceGraphicCard") Then
Try
SetGPUPreference(McLaunchJavaSelected.PathJava)
SetGPUPreference(McLaunchJavaSelected.JavaExePath)
SetGPUPreference(PathExe)
Catch ex As Exception
If SystemUtils.HasAdminRole() Then
If WindowsUtils.HasAdminRole() Then
Logger.Warn(ex, "直接调整显卡设置失败")
Else
Logger.Warn(ex, "直接调整显卡设置失败，将以管理员权限重启 PCL 再次尝试")
Try
If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJava}""") = ProcessReturnValues.TaskDone Then
If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.JavaExePath}""") = ProcessReturnValues.TaskDone Then
McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功")
Else
Throw New Exception("调整过程中出现异常")
@@ -1924,9 +1762,9 @@ NextInstance:
""profile"": ""66666555554444433333222221111100""
}
}"
Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
Dim ReplaceJson As JObject = (ReplaceJsonString).DeserializeJson()
'更新文件
Dim Profiles As JObject = GetJson(FileUtils.ReadAsString(McFolderSelected & "launcher_profiles.json"))
Dim Profiles As JObject = FileUtils.ReadAsJson(McFolderSelected & "launcher_profiles.json")
Profiles.Merge(ReplaceJson)
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已更新 launcher_profiles.json")
@@ -1954,9 +1792,9 @@ NextInstance:
""profile"": ""66666555554444433333222221111100""
}
}"
Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
Dim ReplaceJson As JObject = ReplaceJsonString.DeserializeJson()
'更新文件
Dim Profiles As JObject = GetJson(FileUtils.ReadAsString(McFolderSelected & "launcher_profiles.json"))
Dim Profiles As JObject = FileUtils.ReadAsJson(McFolderSelected & "launcher_profiles.json")
Profiles.Merge(ReplaceJson)
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已在删除后更新 launcher_profiles.json")
@@ -2026,7 +1864,7 @@ NextInstance:
Try
Dim ZipFileAddress As String = McInstanceSelected.PathIndie & "resourcepacks\PCL2 Skin.zip"
Dim NewTypeSetup As Boolean = McInstanceSelected.Version.Vanilla.Major >= 13 OrElse McInstanceSelected.Version.Vanilla.Major < 6
If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Settings.Get(Of Integer)("LaunchSkinType") = 4 AndAlso FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Settings.Get(Of Integer)("LaunchSkinType") = 4 AndAlso FileUtils.Exists(Paths.AppDataThenName & "CustomSkin.png") Then
Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
Dim PackPicAddress As String = PathTemp & "pack.png"
Dim PackFormat As Integer
@@ -2076,12 +1914,12 @@ NextInstance:
Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png")
Bit.Save(PackPicAddress)
FileUtils.Write(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png")
Dim Skin As New MyBitmap(Paths.AppDataThenName & "CustomSkin.png")
If (McInstanceSelected.Version.Vanilla.Major = 6 OrElse McInstanceSelected.Version.Vanilla.Major = 7) AndAlso Skin.Pic.Height = 64 Then
McLaunchLog("该 Minecraft 版本不支持双层皮肤，已进行裁剪")
Skin = Skin.Clip(0, 0, 64, 32)
End If
Skin.Save(PathExeFolder & "PCL\CustomSkin_Cliped.png")
Skin.Save(Paths.Base & "PCL\CustomSkin_Cliped.png")
'构建压缩文件
Dim FilesToCompress As New Dictionary(Of String, String) From {
{"pack.mcmeta", MetaFileAddress}, {"pack.png", PackPicAddress}}
@@ -2090,15 +1928,15 @@ NextInstance:
For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
FilesToCompress.Add(
$"assets/minecraft/textures/entity/player/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png",
PathExeFolder & "PCL\CustomSkin_Cliped.png")
Paths.Base & "PCL\CustomSkin_Cliped.png")
Next
Else
FilesToCompress.Add(
$"assets/minecraft/textures/entity/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "alex.png", "steve.png")}",
PathExeFolder & "PCL\CustomSkin_Cliped.png")
Paths.Base & "PCL\CustomSkin_Cliped.png")
End If
FileUtils.CreateZipFromFiles(ZipFileAddress, FilesToCompress)
FileUtils.Delete(PathExeFolder & "PCL\CustomSkin_Cliped.png")
FileUtils.Delete(Paths.Base & "PCL\CustomSkin_Cliped.png")
'更改设置文件
IniClearCache(SetupFileAddress)
Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
@@ -2159,25 +1997,25 @@ IgnoreCustomSkin:
'输出 bat
Try
Dim CmdString As String =
$"{If(McLaunchJavaSelected.MajorVersion > 8, "chcp 65001>nul" & vbCrLf, "")}" &
$"{If(McLaunchJavaSelected.Version.Major > 8, "chcp 65001>nul" & vbCrLf, "")}" &
"@echo off" & vbCrLf &
$"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
"echo 游戏正在启动，请稍候。" & vbCrLf &
$"cd /D ""{PathUtils.ToShortPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
CustomCommandGlobal & vbCrLf &
CustomCommandVersion & vbCrLf &
$"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf &
$"""{McLaunchJavaSelected.JavaExePath}"" {McLaunchArgument}" & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
FileUtils.Write(
filePath:=If(CurrentLaunchOptions.SaveBatch, PathExeFolder & "PCL\LatestLaunch.bat"),
filePath:=If(CurrentLaunchOptions.SaveBatch, Paths.Base & "PCL\LatestLaunch.bat"),
text:=FilterAccessToken(CmdString, "F").Replace("%", "%%"),
encoding:=If(McLaunchJavaSelected.MajorVersion > 8, Encoding.UTF8, Encoding.Default))
encoding:=If(McLaunchJavaSelected.Version.Major > 8, Encoding.UTF8, Encoding.Default))
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成，强制结束启动过程")
InterruptHint = "导出启动脚本成功！"
CanceledHint = "导出启动脚本成功！"
OpenExplorer(CurrentLaunchOptions.SaveBatch)
Loader.Parent.Interrupt()
Loader.Parent.Cancel()
Return '导出脚本完成
End If
Catch ex As Exception
@@ -2198,14 +2036,14 @@ IgnoreCustomSkin:
.CreateNoWindow = True
})
If Settings.Get(Of Boolean)("LaunchAdvanceRunWait") Then
Do Until CustomProcess.HasExited OrElse Loader.IsInterrupted
Do Until CustomProcess.HasExited OrElse Loader.IsCanceled
Thread.Sleep(10)
Loop
End If
Catch ex As Exception
Logger.Error(ex, "执行全局自定义命令失败", LogBehavior.Toast)
Finally
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsCanceled Then
McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
CustomProcess.Kill()
End If
@@ -2223,14 +2061,14 @@ IgnoreCustomSkin:
.CreateNoWindow = True
})
If Settings.Get(Of Boolean)("VersionAdvanceRunWait", Instance:=McInstanceSelected) Then
Do Until CustomProcess.HasExited OrElse Loader.IsInterrupted
Do Until CustomProcess.HasExited OrElse Loader.IsCanceled
Thread.Sleep(10)
Loop
End If
Catch ex As Exception
Logger.Error(ex, "执行版本自定义命令失败", LogBehavior.Toast)
Finally
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsCanceled Then
McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
CustomProcess.Kill()
End If
@@ -2241,13 +2079,13 @@ IgnoreCustomSkin:
Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process))
'启动信息
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJava) '使用 javaw.exe 会导致 #6263
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.JavaExePath) '使用 javaw.exe 会导致 #6263
'设置环境变量
Dim PathEnv As String = StartInfo.EnvironmentVariables("Path")
Dim Paths As New List(Of String)
If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
Paths.Add(PathUtils.ToShortPath(McLaunchJavaSelected.PathFolder))
Paths.Add(PathUtils.ToShortPath(McLaunchJavaSelected.Folder))
StartInfo.EnvironmentVariables("Path") = Paths.Distinct.Join(";"c)
StartInfo.EnvironmentVariables("appdata") = PathUtils.ToShortPath(McFolderSelected)
@@ -2261,8 +2099,8 @@ IgnoreCustomSkin:
'开始进程
Dim GameProcess = StartProcess(StartInfo)
McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.PathJava)
If Loader.IsInterrupted Then
McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.JavaExePath)
If Loader.IsCanceled Then
McLaunchLog("由于取消启动，已强制结束游戏进程") '#1631
GameProcess.Kill()
Return
@@ -2294,13 +2132,12 @@ IgnoreCustomSkin:
McLaunchLog($"游戏版本：{McInstanceSelected.VersionDisplayName}（{McInstanceSelected.Version.Vanilla}，Drop {McInstanceSelected.Version.Drop}{If(McInstanceSelected.Version.Reliable, "", "，无法完全确定")}）")
McLaunchLog("资源版本：" & McAssetsGetIndexName(McInstanceSelected))
McLaunchLog("版本继承：" & If(McInstanceSelected.InheritName = "", "无", McInstanceSelected.InheritName))
McLaunchLog("分配的内存：" & PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) & " GB（" & Math.Round(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB）")
McLaunchLog("分配的内存：" & PageInstanceSetup.GetRam(McInstanceSelected) & " GB（" & Math.Round(PageInstanceSetup.GetRam(McInstanceSelected) * 1024) & " MB）")
McLaunchLog("MC 文件夹：" & McFolderSelected)
McLaunchLog("版本文件夹：" & McInstanceSelected.PathVersion)
McLaunchLog("版本隔离：" & (McInstanceSelected.PathIndie = McInstanceSelected.PathVersion))
McLaunchLog("HMCL 格式：" & McInstanceSelected.IsHmclFormatJson)
McLaunchLog("Java 信息：" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
McLaunchLog("环境变量：" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置"))
McLaunchLog("Natives 文件夹：" & GetNativesFolder())
McLaunchLog("")
McLaunchLog("~ 登录参数 ~")
@@ -2325,7 +2162,7 @@ IgnoreCustomSkin:
Thread.Sleep(100)
Loop
If Watcher.State = Watcher.MinecraftState.Crashed Then
Throw New Exception("$$")
Throw New OperationCanceledException
End If
End Sub
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+43 -45
View File
@@ -1,4 +1,4 @@
Public Module ModMinecraft
Public Module ModMinecraft
#Region "文件夹"
@@ -16,9 +16,9 @@
End Property
Private Sub SetMcFolder(Value As String) '等同 McFolderSelected.Set
If _McFolderSelected = Value Then Return
_McFolderSelected = Value.Replace("$", PathExeFolder)
_McFolderSelected = Value.Replace("$", Paths.Base)
_McFolderSelected = PathUtils.AddSlashSuffix(PathUtils.ForCompare(_McFolderSelected))
Settings.Set("LaunchFolderSelect", Value.Replace(PathExeFolder, "$"))
Settings.Set("LaunchFolderSelect", Value.Replace(Paths.Base, "$"))
Logger.Info($"当前选择的 Minecraft 文件夹：{_McFolderSelected}")
End Sub
Private _McFolderSelected As String
@@ -64,8 +64,8 @@
'扫描当前文件夹
Try
If DirectoryUtils.Exists(PathExeFolder & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder, .Type = McFolder.Types.Vanilla})
For Each Folder As DirectoryInfo In DirectoryUtils.GetInfo(PathExeFolder).GetDirectories
If DirectoryUtils.Exists(Paths.Base & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Paths.Base, .Type = McFolder.Types.Vanilla})
For Each Folder As DirectoryInfo In DirectoryUtils.GetInfo(Paths.Base).GetDirectories
If DirectoryUtils.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathUtils.AddSlashSuffix(PathUtils.ForCompare(Folder.FullName)), .Type = McFolder.Types.Vanilla})
End If
@@ -75,7 +75,7 @@
End Try
'扫描官启文件夹
Dim MojangPath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\"
Dim MojangPath As String = Paths.AppData & ".minecraft\"
If (Not CacheMcFolderList.Any OrElse MojangPath <> CacheMcFolderList(0).Location) AndAlso '当前文件夹不是官启文件夹
DirectoryUtils.Exists(MojangPath & "versions\") Then '具有权限且存在 versions 文件夹
CacheMcFolderList.Add(New McFolder With {.Name = "官方启动器文件夹", .Location = MojangPath, .Type = McFolder.Types.Vanilla})
@@ -123,8 +123,8 @@
'若没有可用文件夹，则创建 .minecraft
If Not CacheMcFolderList.Any() Then
DirectoryUtils.Create(PathExeFolder & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder & ".minecraft\", .Type = McFolder.Types.Vanilla})
DirectoryUtils.Create(Paths.Base & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Paths.Base & ".minecraft\", .Type = McFolder.Types.Vanilla})
End If
For Each Folder As McFolder In CacheMcFolderList
@@ -463,9 +463,9 @@ VersionSearchFinish:
If Not FileUtils.Exists(JsonPath) Then
'尝试寻找 JSON 文件
JsonPath = Nothing
For Each JsonCandidatePath In DirectoryUtils.GetFiles(PathVersion, True, "*.json")
For Each JsonCandidatePath In DirectoryUtils.EnumerateFiles(PathVersion, searchPattern:="*.json")
Try
Dim JsonCandidate As JObject = GetJson(FileUtils.ReadAsString(JsonCandidatePath))
Dim JsonCandidate As JObject = FileUtils.ReadAsJson(JsonCandidatePath)
If Not JsonCandidate.ContainsKey("mainClass") Then Continue For
If Not JsonCandidate.ContainsKey("type") Then Continue For
If Not JsonCandidate.ContainsKey("id") Then Continue For
@@ -501,12 +501,12 @@ VersionSearchFinish:
If Not FastJsonCheck(_JsonText) Then
If RunInUi() Then
Logger.Warn("版本 JSON 文件为空或有误，由于代码在主线程运行，将不再进行重试")
GetJson(_JsonText) '触发异常
_JsonText.DeserializeJson() '触发异常
Else
Logger.Warn($"版本 JSON 文件为空或有误，将在 2s 后重试读取（{JsonPath}）")
Thread.Sleep(2000)
_JsonText = FileUtils.ReadAsString(JsonPath)
If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
If Not FastJsonCheck(_JsonText) Then _JsonText.DeserializeJson() '触发异常
End If
End If
End If
@@ -526,7 +526,7 @@ VersionSearchFinish:
If _JsonObject Is Nothing Then
Dim Text As String = JsonText '触发 JsonText 的 Get 事件
Try
_JsonObject = GetJson(Text)
_JsonObject = Text.DeserializeJson()
'转换 HMCL 关键项
If _JsonObject.ContainsKey("patches") AndAlso Not _JsonObject.ContainsKey("time") Then
IsHmclFormatJson = True
@@ -626,7 +626,7 @@ Recheck:
Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json")
If VersionJson Is Nothing Then Exit Try
Using VersionJsonStream As New StreamReader(VersionJson.Open)
_JsonVersion = GetJson(VersionJsonStream.ReadToEnd)
_JsonVersion = VersionJsonStream.ReadToEnd().DeserializeJson()
End Using
End Using
Catch ex As Exception
@@ -659,22 +659,23 @@ Recheck:
End Property
Private _InheritName As String = Nothing
Public Sub ResetIniCache()
Public Config As JsonConfigProvider
Public Sub ResetSettingsCache()
IniClearCache(PathIndie & "options.txt")
IniClearCache(PathVersion & "PCL\Setup.ini")
Config.DiscardCache()
For Each Entry In Settings.Entries.Values
If Entry.Source = Settings.Sources.Instance Then Entry.ValueCache.Remove(PathVersion)
Next
End Sub
''' <summary>
''' 从版本名，或版本文件夹的完整路径初始化（不规定是否以 \ 结尾）。
''' 从版本名，或版本文件夹的完整路径初始化。
''' </summary>
Public Sub New(Name As String)
Name = PathUtils.RemoveExtendedPrefix(Name)
PathVersion = If(Name.Contains(":"), "", McFolderSelected & "versions\") & '补全完整路径
Name &
If(Name.EndsWithF("\"), "", "\") '补全右划线
Public Sub New(NameOrFullPath As String)
NameOrFullPath = PathUtils.RemoveExtendedPrefix(NameOrFullPath)
PathVersion = PathUtils.AddSlashSuffix(If(NameOrFullPath.Contains(":"), "", McFolderSelected & "versions\") & NameOrFullPath)
Config = New JsonConfigProvider(Path.Combine(PathVersion, "PCL\config.json"))
End Sub
''' <summary>
@@ -1286,7 +1287,7 @@ ExitDataLoad:
GoTo OnLoaded
End If
'有可用版本
Dim FolderListCheck As Integer = (Versions.MCINSTANCE_CACHE_VERSION & "#" & FolderList.Join("#"c)).GetStableHashCode() Mod (Integer.MaxValue - 1) '根据文件夹名列表生成辨识码
Dim FolderListCheck As Integer = (Versions.McInstanceCacheVersion & "#" & FolderList.Join("#"c)).GetStableHashCode() Mod (Integer.MaxValue - 1) '根据文件夹名列表生成辨识码
If Not McInstanceListForceRefresh AndAlso Val(ReadIni(PathMc & "PCL.ini", "InstanceCache")) = FolderListCheck Then
'可以使用缓存
Dim Result = InitMcInstanceListWithCache(PathMc)
@@ -1307,7 +1308,7 @@ Reload:
'改变当前选择的版本
OnLoaded:
If Loader.IsInterrupted Then Return
If Loader.IsCanceled Then Return
If McInstanceList.Any(Function(v) v.Key <> McInstanceCardType.Error) Then
'尝试读取已储存的选择
Dim SavedSelection As String = ReadIni(PathMc & "PCL.ini", "Version")
@@ -1333,9 +1334,8 @@ OnLoaded:
Logger.Info("未找到可用 Minecraft 版本")
End If
If Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000))
Catch ex As ThreadInterruptedException
Catch ex As Exception
If Loader.IsInterrupted Then Return '#5617
If Loader.IsCanceled OrElse ex.IsCanceled Then Return '#5617
WriteIni(PathMc & "PCL.ini", "InstanceCache", "") '要求下次重新加载
Logger.Error(ex, "加载 .minecraft 版本列表失败")
End Try
@@ -1716,7 +1716,7 @@ OnLoaded:
'处理皮肤地址
Dim SkinValue As String
Try
For Each SkinProperty In GetJson(SkinString)("properties")
For Each SkinProperty In SkinString.DeserializeJson()("properties")
If SkinProperty("name") = "textures" Then
SkinValue = SkinProperty("value")
Exit Try
@@ -1728,7 +1728,7 @@ OnLoaded:
Throw New Exception("皮肤返回值中不包含皮肤数据项，可能是未设置自定义皮肤的用户", ex)
End Try
SkinString = Encoding.UTF8.GetString(Convert.FromBase64String(SkinValue))
Dim SkinJson As JObject = GetJson(SkinString.Lower)
Dim SkinJson As JObject = SkinString.Lower.DeserializeJson()
If SkinJson("textures") Is Nothing OrElse SkinJson("textures")("skin") Is Nothing OrElse SkinJson("textures")("skin")("url") Is Nothing Then
Throw New Exception("用户未设置自定义皮肤")
Else
@@ -1751,7 +1751,6 @@ OnLoaded:
SyncLock McSkinDownloadLock
If Not FileUtils.Exists(FileAddress) Then
NetDownloadByClient(Address, FileAddress & ".PCLDownloading")
FileUtils.Delete(FileAddress)
FileUtils.Move(FileAddress & ".PCLDownloading", FileAddress)
Logger.Info($"皮肤下载成功：{FileAddress}")
End If
@@ -1835,7 +1834,7 @@ OnLoaded:
Public OriginalName As String
Public Overrides Function ToString() As String
Return If(IsNatives, "[Native] ", "") & FormatFileSize(Size) & " | " & LocalPath
Return If(IsNatives, "[Native] ", "") & StringUtils.FormatByteSize(Size) & " | " & LocalPath
End Function
End Class
@@ -1865,7 +1864,7 @@ OnLoaded:
End If
End If
If Rule("os")("arch") IsNot Nothing Then '操作系统架构
IsRightRule = IsRightRule AndAlso ((Rule("os")("arch").ToString = "x86") = Is32BitSystem)
IsRightRule = IsRightRule AndAlso Rule("os")("arch").ToString <> "x86" AndAlso Not Rule("os")("arch").Contains("arm")
End If
End If
If Not IsNothing(Rule("features")) Then '标签
@@ -2078,11 +2077,11 @@ OnLoaded:
Try
'测试链接：https://auth.mc-user.com:233/00000000000000000000000000000000/
Logger.Info("开始获取统一通行证下载信息")
Dim DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Settings.Get(Of String)("VersionServerNide", Instance:=Instance), RequireJson:=True))
Dim DownloadInfo As JObject = NetRequestByClientRetry("https://auth.mc-user.com:233/" & Settings.Get(Of String)("VersionServerNide", Instance:=Instance), RequireJson:=True).DeserializeJson()
Result.Add(New NetFile(
Urls:={"https://login.mc-user.com:233/index/jar"},
LocalPath:=TargetFile,
Checker:=New FileChecker(Hash:=DownloadInfo("jarHash").ToString)))
Checker:=New FileChecker With {.Hash = DownloadInfo("jarHash").ToString}))
Catch ex As Exception
If FileUtils.Exists(TargetFile) Then
Logger.Warn(ex, "获取统一通行证下载信息失败")
@@ -2097,15 +2096,15 @@ OnLoaded:
Dim TargetFile = PathPure & "authlib-injector.jar"
Try
Logger.Info("开始获取 Authlib-Injector 下载信息")
Dim DownloadInfo = GetJson(NetRequestByClientRetry(
Dim DownloadInfo As JObject = NetRequestByClientRetry(
"https://authlib-injector.yushi.moe/artifact/latest.json",
BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json", RequireJson:=True))
BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json", RequireJson:=True).DeserializeJson()
Dim DownloadAddress As String = DownloadInfo("download_url").ToString.
Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe")
Result.Add(New NetFile({
DownloadAddress,
DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector")
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
}, TargetFile, New FileChecker With {.Hash = DownloadInfo("checksums")("sha256").ToString}))
Catch ex As Exception
If FileUtils.Exists(TargetFile) Then
Logger.Warn(ex, "获取 Authlib-Injector 下载信息失败")
@@ -2144,7 +2143,7 @@ OnLoaded:
If Token.Name.ContainsIgnoreCase("labymod") Then
Checker = New FileChecker '不检查 LabyMod 的文件，它们提供的文件校验信息是错的（#3225）
Else
Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
Checker = New FileChecker With {.ActualSize = If(Token.Size = 0, -1, Token.Size), .Hash = Token.SHA1}
End If
'URL
Dim Urls As New List(Of String)
@@ -2238,16 +2237,16 @@ OnLoaded:
'返回 assets 文件名会由于没有下载地址导致全局失败
'If AssetsName IsNot Nothing AndAlso AssetsName <> "legacy" Then
' Log("[Minecraft] 无法获取资源文件索引下载地址，使用 assets 项提供的资源文件名：" & AssetsName)
' Return GetJson("{""id"": """ & AssetsName & """}")
' Return ("{""id"": """ & AssetsName & """}").DeserializeJson()
'Else
Logger.Info("无法获取资源文件索引下载地址，使用默认的 legacy 下载地址")
Return GetJson("{
Return "{
""id"": ""legacy"",
""sha1"": ""c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729"",
""size"": 134284,
""url"": ""https://launchermeta.mojang.com/mc-staging/assets/legacy/c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729/legacy.json"",
""totalSize"": 111220701
}")
}".DeserializeJson()
'End If
Else
Throw New Exception("该版本不存在资源文件索引信息")
@@ -2294,7 +2293,7 @@ OnLoaded:
Public Hash As String
Public Overrides Function ToString() As String
Return FormatFileSize(Size) & " | " & LocalPath
Return StringUtils.FormatByteSize(Size) & " | " & LocalPath
End Function
End Structure
''' <summary>
@@ -2307,7 +2306,7 @@ OnLoaded:
'初始化
If Not FileUtils.Exists($"{McFolderSelected}assets\indexes\{IndexName}.json") Then Throw New FileNotFoundException("未找到 Asset Index", McFolderSelected & "assets\indexes\" & IndexName & ".json")
Dim Result As New List(Of McAssetsToken)
Dim Json As JObject = GetJson(FileUtils.ReadAsString($"{McFolderSelected}assets\indexes\{IndexName}.json"))
Dim Json As JObject = FileUtils.ReadAsJson($"{McFolderSelected}assets\indexes\{IndexName}.json")
'读取列表
For Each File As JProperty In Json("objects").Children
@@ -2347,8 +2346,7 @@ OnLoaded:
Select(Function(Token As McAssetsToken) New NetFile(
DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"),
LocalPath:=Token.LocalPath,
Checker:=New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size),
Hash:=Token.Hash))).ToList
Checker:=New FileChecker With {.ActualSize = If(Token.Size = 0, -1, Token.Size), .Hash = Token.Hash})).ToList
End If
'如果不检查 Hash，则立即处理
Dim Result As New List(Of NetFile)
@@ -2365,7 +2363,7 @@ OnLoaded:
Dim File = FileUtils.GetInfo(Token.LocalPath)
If File.Exists AndAlso (Token.Size = 0 OrElse Token.Size = File.Length) Then Continue For
'文件不存在，添加下载
Result.Add(New NetFile(DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"), Token.LocalPath, New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.Hash)))
Result.Add(New NetFile(DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"), Token.LocalPath, New FileChecker With {.ActualSize = If(Token.Size = 0, -1, Token.Size), .Hash = Token.Hash}))
Next
Catch ex As Exception
Logger.Warn(ex, "获取版本缺失的资源文件下载列表失败")
@@ -2394,7 +2392,7 @@ OnLoaded:
If Version Is Nothing Then Return
Dim Time As Date = Version("releaseTime")
Dim MsgBoxText As String = $"新版本：{VersionName}{vbCrLf}" &
If((Date.Now - Time).TotalDays > 1, "更新时间：" & Time.ToString, "更新于：" & GetTimeSpanString(Time - Date.Now, False))
If((Date.Now - Time).TotalDays > 1, "更新时间：" & Time.ToString, "更新于：" & StringUtils.FormatTimeSpan(Time - Date.Now, False))
Dim MsgResult = MyMsgBox(MsgBoxText, "Minecraft 更新提示", "确定", "下载", If((Date.Now - Time).TotalHours > 3, "更新日志", ""),
Button3Action:=Sub() McUpdateLogShow(Version))
'弹窗结果
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+51 -54
View File
@@ -1,4 +1,7 @@
Public Module ModModpack
Imports System.Collections.ObjectModel
Imports System.Text.RegularExpressions
Public Module ModModpack
'触发整合包安装的外部接口
''' <summary>
@@ -11,8 +14,8 @@
Sub()
Try
ModpackInstall(File)
Catch ex As CancelledException
Catch ex As Exception
ex.ThrowIfCanceled()
Logger.Error(ex, "手动安装整合包失败", LogBehavior.Alert)
End Try
End Sub)
@@ -21,7 +24,6 @@
''' 构建并启动安装给定的整合包文件的加载器，并返回该加载器。若失败则抛出异常。
''' 必须在工作线程执行。
''' </summary>
''' <exception cref="CancelledException" />
Public Function ModpackInstall(File As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Logger.Info($"整合包安装请求：{If(File, "null")}")
Dim Archive As ZipArchive = Nothing
@@ -29,7 +31,7 @@
Try
'字符校验
Dim TargetFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Red) : Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Red) : Throw New OperationCanceledException
'获取整合包种类与关键 Json
Dim PackType As Integer = -1
Try
@@ -39,7 +41,7 @@
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
If Archive.GetEntry("manifest.json") IsNot Nothing Then
Dim Json As JObject = GetJson(Archive.GetEntry("manifest.json").Open().ReadString(Encoding.UTF8))
Dim Json As JObject = Archive.GetEntry("manifest.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
If Json("addons") Is Nothing Then
PackType = 0 : Exit Try 'CurseForge 整合包
Else
@@ -59,7 +61,7 @@
If PathSplits(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
If PathSplits(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If PathSplits(1) = "manifest.json" Then
Dim Json As JObject = GetJson(Entry.Open().ReadString(Encoding.UTF8))
Dim Json As JObject = Entry.Open().ReadString(Encoding.UTF8).DeserializeJson()
If Json("addons") Is Nothing Then
PackType = 0 : Exit Try 'CurseForge 整合包
Else
@@ -163,22 +165,21 @@ Retry:
''' 弹窗提示整合包中存在不兼容的加载器。
''' 如果取消，则抛出 CancelledException。
''' </summary>
''' <exception cref="CancelledException" />
Private Sub NotifyIncompatibleLoader(LoaderName As String)
If MyMsgBox($"整合包中存在不兼容的加载器：{LoaderName}{vbCrLf}如果你知道如何手动安装它，可以先选择跳过，然后在整合包下载结束后手动安装。",
"不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New CancelledException
"不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New OperationCanceledException
End Sub
#Region "不同类型整合包的安装方法"
'CurseForge
Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Private Function InstallPackCurseForge(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String,
Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString)
Json = Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString().DeserializeJson()
Catch ex As Exception
Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
End Try
@@ -189,8 +190,8 @@ Retry:
InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If
'获取 Mod API 版本信息
@@ -272,9 +273,9 @@ Retry:
MissingDesc.Add($"{Project.TranslatedName} (文件 ID {Missing.FileId})")
End If
Next
If MyMsgBox($"未找到该整合包所需的以下内容，它们可能已被原作者删除：{vbCrLf}- {MissingDesc.Join(vbCrLf & "- ")}{vbCrLf}{vbCrLf}是否继续安装？缺失这些内容可能导致整合包出现异常！",
If MyMsgBox($"未找到该整合包所需的以下内容，它们可能已被原作者删除：{vbCrLf}- {MissingDesc.Join(vbCrLf + "- ")}{vbCrLf}{vbCrLf}是否继续安装？缺失这些内容可能导致整合包出现异常！",
"整合包内容缺失", "继续", "取消", IsWarn:=True) = 2 Then
Task.Interrupt()
Task.Cancel()
End If
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
'构造 NetFile
@@ -364,7 +365,7 @@ Retry:
Dim LoaderName As String = "CurseForge 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
'启动
@@ -377,12 +378,12 @@ Retry:
End Function
'Modrinth
Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Private Function InstallPackModrinth(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open().ReadString)
Json = Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open().ReadString().DeserializeJson()
Catch ex As Exception
Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
End Try
@@ -412,8 +413,8 @@ Retry:
InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
@@ -452,10 +453,10 @@ Retry:
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not Path.GetFullPath(TargetPath).StartsWithF(Path.GetFullPath($"{McFolderSelected}versions\{InstanceName}\")) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！{vbCrLf}目标：{Path.GetFullPath(TargetPath)}{vbCrLf}错误的文件：{TargetPath}", "文件路径校验失败", IsWarn:=True)
Throw New CancelledException
Throw New OperationCanceledException
End If
FileList.Add(New NetFile(Urls, TargetPath,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
New FileChecker With {.ActualSize = File("fileSize").ToObject(Of Long), .Hash = File("hashes")("sha1").ToString}, True))
Next
If FileList.Any Then
InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
@@ -502,7 +503,7 @@ Retry:
Dim LoaderName As String = $"Modrinth 整合包安装：{InstanceName} "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
'启动
@@ -515,11 +516,11 @@ Retry:
End Function
'HMCL
Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
Private Function InstallPackHMCL(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open().ReadString(Encoding.UTF8))
Json = Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
Catch ex As Exception
Throw New Exception("HMCL 整合包安装信息存在问题", ex)
End Try
@@ -527,8 +528,8 @@ Retry:
Dim InstanceName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
@@ -556,7 +557,7 @@ Retry:
Dim LoaderName As String = "HMCL 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -568,11 +569,11 @@ Retry:
End Function
'MMC
Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
Private Function InstallPackMMC(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件
Dim PackJson As JObject, PackInstance As String
Try
PackJson = GetJson(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open().ReadString(Encoding.UTF8))
PackJson = Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
PackInstance = Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open().ReadString(Encoding.UTF8)
Catch ex As Exception
Throw New Exception("MMC 整合包安装信息存在问题", ex)
@@ -581,8 +582,8 @@ Retry:
Dim InstanceName As String = If(PackInstance.RegexSeek("(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
@@ -609,7 +610,7 @@ Retry:
Dim PreLaunchCommand As String = ReadIni(MmcSetupFile, "PreLaunchCommand")
If PreLaunchCommand <> "" Then
PreLaunchCommand = PreLaunchCommand.Replace("\""", """").
Replace("$INST_JAVA", "{java}javaw.exe").
Replace("$INST_JAVA", "{java}java.exe").
Replace("$INST_MC_DIR\", "{minecraft}").Replace("$INST_MC_DIR", "{minecraft}").
Replace("$INST_DIR\", "{verpath}").Replace("$INST_DIR", "{verpath}").
Replace("$INST_ID", "{name}").Replace("$INST_NAME", "{name}")
@@ -622,10 +623,6 @@ Retry:
WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
Logger.Info($"迁移 MultiMC 版本独立设置：自动进入服务器：{ServerAddress}")
End If
If ReadIni(MmcSetupFile, "IgnoreJavaCompatibility", False) Then
WriteIni(SetupFile, "VersionAdvanceJava", True)
Logger.Info("迁移 MultiMC 版本独立设置：忽略 Java 兼容性警告")
End If
Dim Logo As String = ReadIni(MmcSetupFile, "iconKey", "")
If Logo <> "" AndAlso FileUtils.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True)
@@ -685,7 +682,7 @@ Retry:
Dim LoaderName As String = "MMC 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
'启动
@@ -698,13 +695,13 @@ Retry:
End Function
'MCBBS
Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Private Function InstallPackMCBBS(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String,
Optional InstanceName As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
Json = GetJson(Entry.Open().ReadString(Encoding.UTF8))
Json = Entry.Open().ReadString(Encoding.UTF8).DeserializeJson()
Catch ex As Exception
Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
End Try
@@ -713,8 +710,8 @@ Retry:
InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
@@ -742,7 +739,7 @@ Retry:
If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息，无法安装！")
If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName,
@@ -763,7 +760,7 @@ Retry:
Dim LoaderName As String = "MCBBS 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
'启动
@@ -777,12 +774,12 @@ Retry:
End Function
'带启动器的压缩包
Private Function InstallPackLauncherPack(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
Private Function InstallPackLauncherPack(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'获取解压路径
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
If TargetFolder Is Nothing Then Throw New CancelledException
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
If TargetFolder Is Nothing Then Throw New OperationCanceledException
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New OperationCanceledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
@@ -792,7 +789,7 @@ Retry:
Thread.Sleep(400) '避免文件争用
'查找解压后的 exe 文件
Dim Launcher As String = Nothing
For Each ExeFile In DirectoryUtils.GetFiles(TargetFolder, True, "*.exe")
For Each ExeFile In DirectoryUtils.EnumerateFiles(TargetFolder, searchPattern:="*.exe")
Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
Logger.Info($"文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
If Info.ProductName = "Plain Craft Launcher" Then
@@ -826,7 +823,7 @@ Retry:
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
InstanceName, False)
'调用 modpack 文件进行安装
Dim ModpackFile = DirectoryUtils.GetFiles(TargetFolder, "modpack.*").First
Dim ModpackFile = DirectoryUtils.EnumerateFiles(TargetFolder, True, "modpack.*").First
Logger.Info($"调用 modpack 文件继续安装：{ModpackFile}")
ModpackInstall(ModpackFile)
End Sub)
@@ -839,10 +836,10 @@ Retry:
End Function
'普通压缩包
Private Function InstallPackCompress(FileAddress As String, Archive As Compression.ZipArchive) As LoaderCombo(Of String)
Private Function InstallPackCompress(FileAddress As String, Archive As ZipArchive) As LoaderCombo(Of String)
'尝试定位 .minecraft 文件夹：寻找形如 “/versions/XXX/XXX.json” 的路径
Dim Match As RegularExpressions.Match = Nothing
Dim Regex As New RegularExpressions.Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegularExpressions.RegexOptions.IgnoreCase)
Dim Match As Match = Nothing
Dim Regex As New Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegexOptions.IgnoreCase)
For Each Entry In Archive.Entries
Dim EntryMatch = Regex.Match("/" & Entry.FullName)
If EntryMatch.Success Then
@@ -856,9 +853,9 @@ Retry:
'获取解压路径
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
If TargetFolder Is Nothing Then Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Throw New CancelledException
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
If TargetFolder Is Nothing Then Throw New OperationCanceledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Throw New OperationCanceledException
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New OperationCanceledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+5 -5
View File
@@ -1,4 +1,4 @@
Public Module ModWatcher
Public Module ModWatcher
'对全体的监视
Public McWatcherList As New List(Of Watcher)
@@ -91,7 +91,7 @@
RunInNewThread(
Sub()
Try
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Interrupted
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Canceled
TimerWindow()
TimerLog()
'设置窗口标题
@@ -177,7 +177,7 @@
Logger.Error(ex, "输出 Minecraft 日志失败")
End Try
End Sub
Public LatestLog As New Queue(Of String)
Public LatestLog As New ConcurrentQueue(Of String)
Private Sub GameLog(Text As String)
'预处理
If Text Is Nothing Then Return
@@ -185,7 +185,7 @@
'If Text.Contains("�����") Then Hint("检测到错误的日志编码：" & Text)
'加入预存储
LatestLog.Enqueue(Text)
If LatestLog.Count >= 501 Then LatestLog.Dequeue()
If LatestLog.Count >= 501 Then LatestLog.TryDequeue(Nothing)
Logger.Trace(Text)
'进度处理
If LogProgress < 1 Then
@@ -362,7 +362,7 @@
Analyzer.Prepare()
Analyzer.Analyze()
Analyzer.Output(False, New List(Of String) From
{Instance.PathVersion & Instance.Name & ".json", PathExeFolder & "PCL\Log1.txt", PathExeFolder & "PCL\LatestLaunch.bat"})
{Instance.PathVersion & Instance.Name & ".json", Paths.Base & "PCL\Log1.txt", Paths.Base & "PCL\LatestLaunch.bat"})
Catch ex As Exception
Logger.Error(ex, "崩溃分析失败")
End Try
Plain Craft Launcher 2/Modules/ModDevelop.vb
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class ModDevelop
Public Class ModDevelop
Public Shared Sub Start()
End Sub
Plain Craft Launcher 2/Modules/ModEvent.vb
+10 -10
View File
@@ -1,4 +1,4 @@

#Region "附加属性"
''' <summary>
@@ -267,12 +267,12 @@ Public Class CustomEvent
MyMsgBox(Args(1).Replace("\n", vbCrLf), Args(0).Replace("\n", vbCrLf), If(Args.Length > 2, Args(2), "确定"))
Case EventType.弹出提示
Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, Args(1).ToEnum(Of HintType)))
Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, EnumUtils.FromString(Of HintType)(Args(1))))
Case EventType.切换页面
RunInUi(Sub() FrmMain.PageChange(
Args(0).ToEnum(Of FormMain.PageType),
If(Args.Length = 1, FormMain.PageSubType.Default, Args(1).ToEnum(Of FormMain.PageSubType))))
EnumUtils.FromString(Of FormMain.PageType)(Args(0)),
If(Args.Length = 1, FormMain.PageSubType.Default, EnumUtils.FromString(Of FormMain.PageSubType)(Args(1)))))
Case EventType.导入整合包, EventType.安装整合包
RunInUi(Sub() ModpackInstall())
@@ -372,20 +372,20 @@ Public Class CustomEvent
RelativeUrl = RelativeUrl.Replace("/", "\").Lower.TrimStart("\")
'确认实际路径
Dim Location As String, WorkingDir As String = PathExeFolder & "PCL"
Dim Location As String, WorkingDir As String = Paths.Base & "PCL"
HelpTryExtract()
If RelativeUrl.Contains(":\") Then
'绝对路径
Location = RelativeUrl
Logger.Info($"自定义事件中由绝对路径{Type}：{Location}")
ElseIf FileUtils.Exists(PathExeFolder & "PCL\" & RelativeUrl) Then
ElseIf FileUtils.Exists(Paths.Base & "PCL\" & RelativeUrl) Then
'相对 PCL 文件夹的路径
Location = PathExeFolder & "PCL\" & RelativeUrl
Location = Paths.Base & "PCL\" & RelativeUrl
Logger.Info($"自定义事件中由相对 PCL 文件夹的路径{Type}：{Location}")
ElseIf FileUtils.Exists(PathExeFolder & "PCL\Help\" & RelativeUrl) Then
ElseIf FileUtils.Exists(Paths.Base & "PCL\Help\" & RelativeUrl) Then
'相对 PCL 本地帮助文件夹的路径
Location = PathExeFolder & "PCL\Help\" & RelativeUrl
WorkingDir = PathExeFolder & "PCL\Help\"
Location = Paths.Base & "PCL\Help\" & RelativeUrl
WorkingDir = Paths.Base & "PCL\Help\"
Logger.Info($"自定义事件中由相对 PCL 本地帮助文件夹的路径{Type}：{Location}")
ElseIf Type = EventType.打开帮助 AndAlso FileUtils.Exists(PathTemp & "Help\" & RelativeUrl) Then
'相对 PCL 自带帮助文件夹的路径
Plain Craft Launcher 2/Modules/ModMain.vb
+40 -42
View File
@@ -1,4 +1,5 @@
Imports System.Windows.Interop
Imports System.Collections.ObjectModel
Imports System.Windows.Interop
Imports System.Windows.Threading
Public Module ModMain
@@ -23,27 +24,24 @@ Public Module ModMain
''' <summary>
''' 等待弹出的提示列表。以 {String, HintType, Log As Boolean} 形式存储为数组。
''' </summary>
Private HintWaiting As ConcurrentList(Of HintMessage) = If(HintWaiting, New ConcurrentList(Of HintMessage))
Private HintWaiting As New ConcurrentQueue(Of HintMessage)
''' <summary>
''' 在窗口左下角弹出提示文本。
''' </summary>
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Blue, Optional Log As Boolean = True)
If HintWaiting Is Nothing Then HintWaiting = New ConcurrentList(Of HintMessage)
HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
HintWaiting.Enqueue(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
End Sub
Private Sub HintTick()
Try
'Tag 存储了：{ 是否可以重用, Uuid }
If Not HintWaiting.Any() Then Return
Do While HintWaiting.Any
Dim CurrentHint As HintMessage = Nothing
Do While HintWaiting.TryDequeue(CurrentHint)
''清除空提示
'If IsNothing(HintWaiting(0)) OrElse IsNothing(HintWaiting(0)(0)) Then
' HintWaiting.RemoveAt(0)
' Continue Do
'End If
Dim CurrentHint = HintWaiting(0)
'去回车
CurrentHint.Text = CurrentHint.Text.ReplaceLineEndings(" ", mergeMultiple:=True)
'超量提示直接忽略
@@ -134,7 +132,6 @@ Public Module ModMain
'结束处理
EndHint:
If CurrentHint.Log Then Logger.Info($"弹出提示：{CurrentHint.Text}")
HintWaiting.RemoveAt(0)
Loop
Catch ex As Exception
Logger.Info(ex, "显示弹出提示失败")
@@ -173,7 +170,7 @@ EndHint:
''' <summary>
''' 输入模式：输入验证规则。
''' </summary>
Public ValidateRules As ObjectModel.Collection(Of Validate)
Public ValidateRules As Collection(Of Validate)
''' <summary>
''' 输入模式：提示文本。
''' </summary>
@@ -236,14 +233,13 @@ EndHint:
Optional Button1Action As Action = Nothing, Optional Button2Action As Action = Nothing, Optional Button3Action As Action = Nothing) As Integer
'将弹窗列入队列
Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Text, .Button1 = Button1, .Button2 = Button2, .Button3 = Button3, .Text = Caption, .IsWarn = IsWarn, .Title = Title, .HighLight = HighLight, .ForceWait = True, .Button1Action = Button1Action, .Button2Action = Button2Action, .Button3Action = Button3Action}
WaitingMyMsgBox.Add(Converter)
If Button2.Length > 0 OrElse ForceWait Then
'若有多个按钮则开始等待
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then
'主窗体尚未加载，用老土的弹窗来替代
WaitingMyMsgBox.Remove(Converter)
If Button2.Length > 0 Then
Dim RawResult As MsgBoxResult = MsgBox(Caption, If(Button3.Length > 0, MsgBoxStyle.YesNoCancel, MsgBoxStyle.YesNo) + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
Dim RawResult As MsgBoxResult =
MsgBox(Caption, If(Button3.Length > 0, MsgBoxStyle.YesNoCancel, MsgBoxStyle.YesNo) + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
Select Case RawResult
Case MsgBoxResult.Yes
Converter.Result = 1
@@ -258,6 +254,7 @@ EndHint:
End If
Logger.Warn($"主窗体加载完成前出现意料外的等待弹窗：{Button1},{Button2},{Button3}")
Else
WaitingMyMsgBox.Enqueue(Converter)
Try
FrmMain.DragStop()
If RunInUi() Then MyMsgBoxTick()
@@ -271,6 +268,7 @@ EndHint:
Return Converter.Result
Else
'不进行等待，直接返回
WaitingMyMsgBox.Enqueue(Converter)
Return 1
End If
End Function
@@ -285,10 +283,10 @@ EndHint:
''' <param name="Button1">显示的第一个按钮，默认为“确定”。</param>
''' <param name="Button2">显示的第二个按钮，默认为“取消”。</param>
''' <param name="IsWarn">是否为警告弹窗，若为 True，弹窗配色和背景会变为红色。</param>
Public Function MyMsgBoxInput(Title As String, Optional Text As String = Nothing, Optional DefaultInput As String = Nothing, Optional ValidateRules As ObjectModel.Collection(Of Validate) = Nothing, Optional HintText As String = "", Optional Button1 As String = "确定", Optional Button2 As String = "取消", Optional IsWarn As Boolean = False) As String
Public Function MyMsgBoxInput(Title As String, Optional Text As String = Nothing, Optional DefaultInput As String = Nothing, Optional ValidateRules As Collection(Of Validate) = Nothing, Optional HintText As String = "", Optional Button1 As String = "确定", Optional Button2 As String = "取消", Optional IsWarn As Boolean = False) As String
'将弹窗列入队列
Dim Converter As New MyMsgBoxConverter With {.Text = If(Text, ""), .HintText = If(HintText, ""), .Type = MyMsgBoxType.Input, .ValidateRules = If(ValidateRules, New ObjectModel.Collection(Of Validate)), .Button1 = Button1, .Button2 = Button2, .Content = DefaultInput, .IsWarn = IsWarn, .Title = Title}
WaitingMyMsgBox.Add(Converter)
Dim Converter As New MyMsgBoxConverter With {.Text = If(Text, ""), .HintText = If(HintText, ""), .Type = MyMsgBoxType.Input, .ValidateRules = If(ValidateRules, New Collection(Of Validate)), .Button1 = Button1, .Button2 = Button2, .Content = DefaultInput, .IsWarn = IsWarn, .Title = Title}
WaitingMyMsgBox.Enqueue(Converter)
'虽然我也不知道这是啥但是能用就成了 :)
Try
If FrmMain IsNot Nothing Then FrmMain.DragStop()
@@ -311,7 +309,7 @@ EndHint:
Public Function MyMsgBoxSelect(Selections As IEnumerable(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
'将弹窗列入队列
Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Select, .Button1 = Button1, .Button2 = Button2, .Content = Selections, .IsWarn = IsWarn, .Title = Title}
WaitingMyMsgBox.Add(Converter)
WaitingMyMsgBox.Enqueue(Converter)
'虽然我也不知道这是啥但是能用就成了 :)
Try
If FrmMain IsNot Nothing Then FrmMain.DragStop()
@@ -328,27 +326,27 @@ EndHint:
''' <summary>
''' 等待显示的弹窗。
''' </summary>
Public WaitingMyMsgBox As List(Of MyMsgBoxConverter) = If(WaitingMyMsgBox, New List(Of MyMsgBoxConverter))
Public WaitingMyMsgBox As New ConcurrentQueue(Of MyMsgBoxConverter)
Public Sub MyMsgBoxTick()
Try
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Return
If FrmMain?.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Return
Dim TargetMsgBox As MyMsgBoxConverter = Nothing
If FrmMain.PanMsg.Children.Count > 0 Then
'弹窗中
FrmMain.PanMsg.Visibility = Visibility.Visible
ElseIf WaitingMyMsgBox.Any Then
ElseIf WaitingMyMsgBox.TryDequeue(TargetMsgBox) Then
'没有弹窗，显示一个等待的弹窗
FrmMain.PanMsg.Visibility = Visibility.Visible
Select Case WaitingMyMsgBox(0).Type
Select Case TargetMsgBox.Type
Case MyMsgBoxType.Input
FrmMain.PanMsg.Children.Add(New MyMsgInput(WaitingMyMsgBox(0)))
FrmMain.PanMsg.Children.Add(New MyMsgInput(TargetMsgBox))
Case MyMsgBoxType.Select
FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0)))
FrmMain.PanMsg.Children.Add(New MyMsgSelect(TargetMsgBox))
Case MyMsgBoxType.Text
FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0)))
FrmMain.PanMsg.Children.Add(New MyMsgText(TargetMsgBox))
Case MyMsgBoxType.Login
FrmMain.PanMsg.Children.Add(New MyMsgLogin(WaitingMyMsgBox(0)))
FrmMain.PanMsg.Children.Add(New MyMsgLogin(TargetMsgBox))
End Select
WaitingMyMsgBox.RemoveAt(0)
Else
'没有弹窗，没有等待的弹窗
If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
@@ -489,7 +487,7 @@ EndHint:
Public Sub New(FilePath As String)
RawPath = FilePath
If Not FileUtils.Exists(FilePath) Then Throw New FileNotFoundException("未找到帮助文件：" & FilePath, FilePath)
Dim JsonData As JObject = GetJson(ArgumentReplace(FileUtils.ReadAsString(FilePath), AddressOf EscapeUtils.XmlEscape))
Dim JsonData As JObject = ArgumentReplace(FileUtils.ReadAsString(FilePath), AddressOf StringUtils.XmlEscape).DeserializeJson()
'加载常规信息
If JsonData("Title") IsNot Nothing Then
Title = JsonData("Title")
@@ -503,7 +501,7 @@ EndHint:
ShowInPublic = If(JsonData("ShowInPublic"), ShowInPublic)
ShowInSnapshot = If(JsonData("ShowInSnapshot"), ShowInSnapshot)
Types = New List(Of String)
For Each NameOfType In If(JsonData("Types"), GetJson("[]"))
For Each NameOfType In If(JsonData("Types"), New JArray)
Types.Add(NameOfType)
Next
'加载事件信息
@@ -577,8 +575,8 @@ EndHint:
Try
Dim IgnoreList As New List(Of String)
'读取自定义文件
If DirectoryUtils.Exists(PathExeFolder & "PCL\Help\") Then
For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Help\")
If DirectoryUtils.Exists(Paths.Base & "PCL\Help\") Then
For Each File In DirectoryUtils.EnumerateFiles(Paths.Base & "PCL\Help\", True)
Select Case PathUtils.GetExtension(File)
Case "helpignore"
'加载忽略列表
@@ -596,7 +594,7 @@ EndHint:
End If
Logger.Info($"已扫描 PCL 文件夹下的帮助文件，目前总计 {FileList.Count} 条")
'读取自带文件
For Each File In DirectoryUtils.GetFiles(PathTemp & "Help")
For Each File In DirectoryUtils.EnumerateFiles(PathTemp & "Help", True)
'跳过非 json 文件与以 . 开头的文件夹
If PathUtils.RemoveLastPart(File).Replace(PathTemp & "Help", "").Contains("\.") OrElse PathUtils.GetExtension(File) <> "json" Then Continue For
'检查忽略列表
@@ -614,7 +612,7 @@ NextFile:
Catch ex As Exception
Logger.Error(ex, "检查帮助文件夹失败", LogBehavior.Alert)
End Try
If Loader.IsInterrupted Then Return
If Loader.IsCanceled Then Return
'将文件实例化
Dim Dict As New List(Of HelpEntry)
@@ -630,7 +628,7 @@ NextFile:
'回设
If Not Dict.Any() Then Throw New Exception("未找到可用的帮助；若不需要帮助页面，可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
If Loader.IsInterrupted Then Return
If Loader.IsCanceled Then Return
Loader.Output = Dict
Catch ex As Exception
@@ -648,7 +646,7 @@ NextFile:
ExtractResources(PathTemp & "Cache\Help.zip", "Help")
FileUtils.ExtractToDirectory(PathTemp & "Cache\Help.zip", PathTemp & "Help")
Settings.Set("SystemHelpVersion", VersionCode)
Logger.Warn($"已解压内置帮助文件，目前状态：{FileUtils.Exists(PathTemp & "Help\启动器\备份设置.xaml")}")
Logger.Info($"已解压内置帮助文件，目前状态：{FileUtils.Exists(PathTemp + "Help\启动器\备份设置.xaml")}")
End If
End Sub
@@ -662,7 +660,7 @@ NextFile:
If _IsAprilEnabled Is Nothing Then
_IsAprilEnabled =
Date.Now.Month = 4 AndAlso Date.Now.Day = 1 AndAlso
Settings.Get(Of Integer)("AprilDoneYear") <> Date.Now.Year '成功后同年内则不再触发
Settings.Get(Of Integer)("AprilYear") <> Date.Now.Year '成功后同年内则不再触发
End If
Return _IsAprilEnabled.Value
End Get
@@ -847,7 +845,7 @@ NextFile:
Text = Text.Replace("{pcl_build_type}", Replacer(BuildType.ToString))
Text = Text.Replace("{pcl_branch}", Replacer(VersionBranchMain))
Text = Text.Replace("{identify}", Replacer(Identify))
Text = Text.Replace("{path}", Replacer(PathUtils.CurrentFolder))
Text = Text.Replace("{path}", Replacer(Paths.Base))
Text = Text.Replace("{path_with_name}", Replacer(PathExe))
Text = Text.Replace("{path_temp}", Replacer(PathTemp))
Text = Text.Replace("{pcl_md5}", Function() Replacer(CryptographyUtils.ComputeFileHash(PathExe, CryptographyUtils.HashMethod.Md5)))
@@ -858,7 +856,7 @@ NextFile:
Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH':'mm':'ss")))
End If
'Minecraft
Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.PathFolder))
Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.Folder))
Text = Text.Replace("{minecraft}", Replacer(McFolderSelected))
If McInstanceSelected?.IsLoaded Then
Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion))
@@ -968,7 +966,7 @@ NextFile:
On Error Resume Next
FeedbackInfo()
If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug，请点击 打开文件夹 按钮，并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关，请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
OpenExplorer(PathExeFolder & "PCL\Log1.txt")
OpenExplorer(Paths.Base & "PCL\Log1.txt")
End If
OpenWebsite("https://github.com/Meloong-Git/PCL/issues/")
End Sub
@@ -978,11 +976,11 @@ NextFile:
Public Sub FeedbackInfo()
On Error Resume Next
Logger.Warn($"诊断信息：{vbCrLf}" &
"操作系统：" & My.Computer.Info.OSFullName & "（32 位：" & Is32BitSystem & "）" & vbCrLf &
"操作系统：" & My.Computer.Info.OSFullName & vbCrLf &
"剩余内存：" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
"DPI：" & DPI & "（" & Math.Round(DPI / 96, 2) * 100 & "%）" & vbCrLf &
"MC 文件夹：" & If(McFolderSelected, "Nothing") & vbCrLf &
"文件位置：" & PathExeFolder)
"文件位置：" & Paths.Base)
End Sub
'遥测
@@ -994,9 +992,9 @@ NextFile:
Sub()
Try
Logger.Info($"匿名数据上报：{[Event]}")
Dim Url As String = $"{ClsBaseUrl}&Event={EscapeUtils.UrlEscape([Event])}"
Dim Url As String = $"{ClsBaseUrl}&Event={StringUtils.UrlEscape([Event])}"
For i = 0 To Datas.Length - 1 Step 2
Url &= "&" & EscapeUtils.UrlEscape(Datas(i)) & "=" & EscapeUtils.UrlEscape(Datas(i + 1).ReplaceLineEndings(vbLf, mergeMultiple:=True))
Url &= "&" & StringUtils.UrlEscape(Datas(i)) & "=" & StringUtils.UrlEscape(Datas(i + 1).ReplaceLineEndings(vbLf, mergeMultiple:=True))
Next
NetRequestByClient(Url, MakeLog:=False)
Catch ex As Exception
Plain Craft Launcher 2/Modules/ModMusic.vb
+3 -4
View File
@@ -1,4 +1,4 @@
Imports NAudio.Wave
Imports NAudio.Wave
Public Module ModMusic
@@ -23,8 +23,8 @@ Public Module ModMusic
'初始化全部可用音乐列表
If MusicAllList Is Nothing Then
MusicAllList = New List(Of String)
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\")
For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Musics\")
DirectoryUtils.Create(Paths.Base & "PCL\Musics\")
For Each File In DirectoryUtils.EnumerateFiles(Paths.Base & "PCL\Musics\", True)
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
If {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(PathUtils.GetExtension(File)) Then Continue For
MusicAllList.Add(File)
@@ -99,7 +99,6 @@ Public Module ModMusic
End If
End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
End If
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
Plain Craft Launcher 2/Modules/ModSecret.vb
+2 -2
View File
@@ -1,4 +1,4 @@
'由于包含加解密等安全信息，本文件中的部分代码已被删除
'由于包含加解密等安全信息，本文件中的部分代码已被删除
Friend Module ModSecret
@@ -33,7 +33,7 @@ Friend Module ModSecret
End If
End If
If Not SimulateBrowserHeaders Then Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
If Url.Contains("api.curseforge.com") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey)
If Url.Contains("api.curseforge.com") OrElse Url.Contains("forgecdn.net") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey)
End Sub
#End Region
Plain Craft Launcher 2/Modules/Resource/LocalResourceFile.vb
+1 -230
View File
@@ -1,4 +1,4 @@
''' <summary>
''' <summary>
''' 本地的社区资源文件。
''' </summary>
Public Class LocalResourceFile
@@ -106,235 +106,6 @@ Public Class LocalResourceFile
#End Region
#Region "从 JAR 获取信息"
''' <summary>
''' 从 JAR 文件中获取 Mod 信息。
''' </summary>
Public Sub LoadMetadataFromJar()
Static IsLoaded As Boolean = False
If IsLoaded Then Return
IsLoaded = True
Dim Jar As ZipArchive = Nothing
Try
'基础可用性检查
If Not FileUtils.Exists(File.FullName) Then Throw New FileNotFoundException("未找到 Mod 文件（" & File.FullName & "）")
'打开 Jar 文件
Jar = FileUtils.OpenZip(File.FullName)
'信息获取
LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException
Logger.Warn(ex, $"Mod 文件由于无权限无法打开（{File.FullName}）")
Catch ex As Exception
Logger.Warn(ex, $"Mod 文件无法打开（{File.FullName}）")
Finally
If Jar IsNot Nothing Then Jar.Dispose()
End Try
End Sub
Private Sub LoadMetadataFromJar(Jar As ZipArchive)
#Region "尝试使用 mcmod.info"
Try
'获取信息文件
Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info")
Dim InfoString As String = Nothing
If InfoEntry IsNot Nothing Then
InfoString = InfoEntry.Open().ReadString()
If InfoString.Length < 15 Then InfoString = Nothing
End If
If InfoString Is Nothing Then Exit Try
'获取可用 Json 项
Dim InfoObject As JObject
Dim JsonObject = GetJson(InfoString)
If JsonObject.Type = JTokenType.Array Then
InfoObject = JsonObject(0)
Else
InfoObject = JsonObject("modList")(0)
End If
'从文件中获取 Mod 信息项
Display = InfoObject("name")
Description = InfoObject("description")
Version = InfoObject("version")
Catch ex As Exception
Logger.Warn(ex, $"读取 mcmod.info 时出现未知错误（{File.FullName}）")
End Try
#End Region
#Region "尝试使用 fabric.mod.json"
Try
'获取 fabric.mod.json 文件
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
Dim FabricText As String = Nothing
If FabricEntry IsNot Nothing Then
FabricText = FabricEntry.Open().ReadString(Encoding.UTF8)
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
End If
If FabricText Is Nothing Then Exit Try
Dim FabricObject As JObject = GetJson(FabricText)
GotFabric:
'从文件中获取 Mod 信息项
If FabricObject.ContainsKey("name") Then Display = FabricObject("name")
If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
'加载成功
GoTo Finished
Catch ex As Exception
Logger.Warn(ex, $"读取 fabric.mod.json 时出现未知错误（{File.FullName}）")
End Try
#End Region
#Region "尝试使用 mods.toml"
Try
'获取 mods.toml 文件
Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml")
Dim TomlText As String = Nothing
If TomlEntry IsNot Nothing Then
TomlText = TomlEntry.Open().ReadString()
If TomlText.Length < 15 Then TomlText = Nothing
End If
If TomlText Is Nothing Then Exit Try
'文件标准化：统一换行符为 vbLf，去除注释、头尾的空格、空行
Dim Lines As New List(Of String)
For Each Line In TomlText.SplitLines(True)
If Line.StartsWithF("#") Then '去除注释
Continue For
ElseIf Line.Contains("#") Then
Line = Line.Substring(0, Line.IndexOfF("#"))
End If
Line = Line.Trim(New Char() {" "c, " "c, "　"c}) '去除头尾的空格
If Line.Any Then Lines.Add(Line) '去除空行
Next
'读取文件数据
Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))}
For i = 0 To Lines.Count - 1
Dim Line As String = Lines(i)
If Line.StartsWithF("[") AndAlso Line.EndsWithF("]") Then
'段落标记
Dim Header = Line.Trim("[]".ToCharArray)
TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object)))
ElseIf Line.Contains("=") Then
'字段标记
Dim Key As String = Line.Substring(0, Line.IndexOfF("=")).TrimEnd(New Char() {" "c, " "c, "　"c})
Dim RawValue As String = Line.Substring(Line.IndexOfF("=") + 1).TrimStart(New Char() {" "c, " "c, "　"c})
Dim Value As Object
If RawValue.StartsWithF("""") AndAlso RawValue.EndsWithF("""") Then
'单行字符串
Value = RawValue.Trim("""")
ElseIf RawValue.StartsWithF("'''") Then
'多行字符串
Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")}
If ValueLines(0).EndsWithF("'''") Then '把多行字符串按单行写法写的错误处理（#2732）
ValueLines(0) = ValueLines(0).TrimEnd("'")
Else
Do Until i >= Lines.Count - 1
i += 1
Dim ValueLine As String = Lines(i)
If ValueLine.EndsWithF("'''") Then
ValueLines.Add(ValueLine.TrimEnd("'"))
Exit Do
Else
ValueLines.Add(ValueLine)
End If
Loop
End If
Value = ValueLines.Join(vbLf).Trim(vbLf).ReplaceLineEndings(vbCrLf)
ElseIf RawValue.Lower = "true" OrElse RawValue.Lower = "false" Then
'布尔型
Value = (RawValue.Lower = "true")
ElseIf Val(RawValue).ToString = RawValue Then
'数字型
Value = Val(RawValue)
Else
'不知道是个啥玩意儿，直接存储
Value = RawValue
End If
TomlData.Last.Value(Key) = Value
Else
'不知道是个啥玩意儿
Exit Try
End If
Next
'从文件数据中获取信息
Dim ModEntry As Dictionary(Of String, Object) = Nothing
For Each TomlSubData In TomlData
If TomlSubData.Key = "mods" Then
ModEntry = TomlSubData.Value
Exit For
End If
Next
If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try
If ModEntry.ContainsKey("displayName") Then Display = ModEntry("displayName")
If ModEntry.ContainsKey("description") Then Description = ModEntry("description")
If ModEntry.ContainsKey("version") Then Version = ModEntry("version")
'加载成功
GoTo Finished
Catch ex As Exception
Logger.Warn(ex, $"读取 mods.toml 时出现未知错误（{File.FullName}）")
End Try
#End Region
#Region "尝试使用 fml_cache_annotation.json"
Try
'获取 fml_cache_annotation.json 文件
Dim FmlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/fml_cache_annotation.json")
Dim FmlText As String = Nothing
If FmlEntry IsNot Nothing Then
FmlText = FmlEntry.Open().ReadString(Encoding.UTF8)
If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing
End If
If FmlText Is Nothing Then Exit Try
Dim FmlJson As JObject = GetJson(FmlText)
'获取可用 Json 项
Dim FmlObject As JObject = Nothing
For Each ModFilePair In FmlJson
Dim ModFileAnnos As JArray = ModFilePair.Value("annotations")
If ModFileAnnos IsNot Nothing Then
'先获取 Mod
For Each ModFileAnno In ModFileAnnos
Dim Name As String = If(ModFileAnno("name"), "")
If Name = "Lnet/minecraftforge/fml/common/Mod;" Then
FmlObject = ModFileAnno("values")
GoTo Got
End If
Next
End If
Next
Exit Try
Got:
'从文件中获取 Mod 信息项
If FmlObject.ContainsKey("name") Then Display = FmlObject("name")("value")
If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value")
'加载成功
GoTo Finished
Catch ex As Exception
Logger.Warn(ex, $"读取 fml_cache_annotation.json 时出现未知错误（{File.FullName}）")
End Try
#End Region
Return '没能成功获取任何信息
Finished:
#Region "将 Version 代号转换为 META-INF 中的版本"
If _Version = "version" Then
Try
Dim MetaEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/MANIFEST.MF")
If MetaEntry IsNot Nothing Then
Dim MetaString As String = MetaEntry.Open().ReadString().Replace(" :", ":").Replace(": ", ":")
If MetaString.Contains("Implementation-Version:") Then
MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
Version = MetaString
End If
End If
Catch ex As Exception
Logger.Warn($"获取 META-INF 中的版本信息失败（{File.FullName}）")
Version = Nothing
End Try
End If
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
#End Region
RaiseEvent OnUpdate(Me)
End Sub
#End Region
#Region "网络信息"
''' <summary>
Plain Craft Launcher 2/Modules/Resource/LocalResourceLoaders.vb
+16 -21
View File
@@ -1,4 +1,4 @@
Public Module LocalResourceLoaders
Public Module LocalResourceLoaders
'加载 Mod 列表
Public LocalResourceLoader As New LoaderTask(Of String, List(Of LocalResourceFile))("LocalResourceLoader", AddressOf LocalResourceFileLoad)
@@ -12,7 +12,7 @@
Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
If Loader.IsInterrupted Then Return
If Loader.IsCanceled Then Return
Thread.Sleep(100)
Loop
Finally
@@ -25,7 +25,7 @@
Dim ModFileList As New List(Of String)
If DirectoryUtils.Exists(Loader.Input) Then
Dim RawName As String = Loader.Input.Lower
For Each File In DirectoryUtils.GetFiles(Loader.Input)
For Each File In DirectoryUtils.EnumerateFiles(Loader.Input, True)
If File.BeforeLast("\").Lower & "\" <> RawName Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时，才加载该子文件夹下的 Mod
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
@@ -53,8 +53,8 @@
Try
Dim CacheContent As String = FileUtils.TryReadAsString(CachePath)
If Not String.IsNullOrWhiteSpace(CacheContent) Then
Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> Versions.LOCAL_MOD_CACHE_VERSION Then
Cache = CacheContent.DeserializeJson()
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> Versions.LocalModCacheVersion Then
Logger.Warn($"本地 Mod 信息缓存版本已过期，将弃用这些缓存信息")
Cache = New JObject
End If
@@ -63,12 +63,12 @@
Logger.Warn(ex, "读取本地 Mod 信息缓存失败，已重置")
Cache = New JObject
End Try
Cache("version") = Versions.LOCAL_MOD_CACHE_VERSION
Cache("version") = Versions.LocalModCacheVersion
'加载 Mod 列表
Dim ModList As New List(Of LocalResourceFile)
For Each ModFile In ModFileList
If Loader.IsInterrupted Then Return
If Loader.IsCanceled Then Return
Dim ModEntry As New LocalResourceFile(ModFile)
Dim DumpMod As LocalResourceFile = ModList.FirstOrDefault(Function(m) m.EnabledName = ModEntry.EnabledName) '存在两个文件，名称相同，但一个启用一个禁用
If DumpMod IsNot Nothing Then
@@ -88,7 +88,7 @@
ModList = ModList.OrderBy(Function(m) m.File.Name).ToList
'回设
If Loader.IsInterrupted Then Return
If Loader.IsCanceled Then Return
Loader.Output = ModList
'开始联网加载
@@ -109,7 +109,7 @@
Dim ModLoaders = Loader.Input.Target.ModLoaders
'读取缓存，获取需要更新的 Mod 列表
For Each ModEntry As LocalResourceFile In Loader.Input.ModList
If Loader.IsInterrupted Then Return
If Loader.IsCanceled Then Return
Dim CacheKey = ModEntry.ModrinthHash & Loader.Input.Target.VanillaName & ModLoaders
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
@@ -119,10 +119,7 @@
Mods.Add(ModEntry)
Next
Logger.Info($"有 {Mods.Where(Function(m) m.Project Is Nothing).Count} 个 Mod 需要联网获取信息，{Mods.Where(Function(m) m.Project IsNot Nothing).Count} 个 Mod 需要更新信息")
If Not Mods.Any Then
Loader.Input.ModList.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar()) '从 JAR 中获取缺失的版本信息（下面有另一个分支）
Return
End If
If Not Mods.Any Then Return
'获取作为检查目标的加载器和版本
'此处不应向下扩展检查的 MC 小版本，例如 Mod 在更新 1.16.5 后，对早期的 1.16.2 版本发布了修补补丁，这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
Dim TargetMcVersion As McVersion = Loader.Input.Target
@@ -158,7 +155,7 @@
Entry.ProjectVersion.Version = File.Version '使用来自 Modrinth 的版本号
End If
Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
Logger.Info($"需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3：获取工程信息
If Not ModrinthMapping.Any() Then Return
@@ -211,7 +208,7 @@
Dim Hashes As New List(Of UInteger)
For Each Entry In Mods
Hashes.Add(Entry.CurseForgeHash)
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
Next
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
$"{{""fingerprints"": [{Hashes.Join(",")}]}}", "application/json")("data")("exactMatches")
@@ -232,7 +229,7 @@
If Entry.ProjectVersion Is Nothing OrElse Entry.ProjectVersion.ReleaseDate < File.ReleaseDate Then Entry.ProjectVersion = File
Next
Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
Logger.Info($"需要从 CurseForge 获取 {ProjectIdToLocalFiles.Count} 个本地 Mod 的工程信息")
If Not ProjectIdToLocalFiles.Any() Then Return
@@ -313,25 +310,23 @@
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader CurseForge")
'从 JAR 中获取缺失的版本信息（上面有另一个分支）
Loader.Input.ModList.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar())
'等待线程结束
Do Until EndedThreadCount = 2
Thread.Sleep(10)
If Loader.IsInterrupted Then Return
If Loader.IsCanceled Then Return
Loop
'保存缓存
Mods = Mods.Where(Function(m) m.Project IsNot Nothing).ToList()
Logger.Info($"联网获取本地 Mod 信息完成，为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Return
If Loader.IsInterrupted Then Return
If Loader.IsCanceled Then Return
For Each Entry In Mods
Entry.OnlineDataLoaded = Not IsFailed
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders) = Entry.ToJson()
Next
FileUtils.Write(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
If Loader.IsInterrupted Then Return
If Loader.IsCanceled Then Return
If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else
Plain Craft Launcher 2/Modules/Resource/ResourceProject.vb
+5 -5
View File
@@ -1,4 +1,4 @@
''' <summary>
''' <summary>
''' 社区资源的项目信息。
''' </summary>
Public Class ResourceProject
@@ -88,7 +88,7 @@ Public Class ResourceProject
If Not LoadedDatabase Then
LoadedDatabase = True
If Types.HasFlag(ResourceTypes.Mod) OrElse Types.HasFlag(ResourceTypes.DataPack) Then
_WikiEntry = WikiEntry.All.FirstOrDefault(Function(c) If(Platform = ResourcePlatforms.CurseForge, c.CurseForgeSlug, c.ModrinthSlug) = Slug)
_WikiEntry = WikiEntry.All.Value.FirstOrDefault(Function(c) c.Slugs.GetOrDefault(Platform) = Slug)
End If
End If
Return _WikiEntry
@@ -111,7 +111,7 @@ Public Class ResourceProject
''' </summary>
Public ReadOnly Property TranslatedName As String
Get
Return If(WikiEntry Is Nothing OrElse WikiEntry.ChineseName = "", RawName, WikiEntry.ChineseName)
Return If(WikiEntry?.ChineseName, RawName)
End Get
End Property
@@ -441,7 +441,7 @@ Public Class ResourceProject
Json("Website") = Website
Json("LastUpdate") = LastUpdate
Json("DownloadCount") = DownloadCount
If ModLoaders <> ModLoaders.None Then Json("ModLoaders") = ModLoaders
If ModLoaders <> ModLoaders.None Then Json("ModLoaders") = CInt(ModLoaders)
Json("Tags") = New JArray(Tags)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If Drops.Any Then Json("Drops") = New JArray(Drops)
@@ -561,7 +561,7 @@ Public Class ResourceProject
NewItem.LabVersion.Text = ModLoaderDescriptionFull
End If
NewItem.LabSource.Text = Platform.ToString
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
NewItem.LabTime.Text = StringUtils.FormatTimeSpan(LastUpdate - Date.Now, True)
NewItem.LabDownload.Text =
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
Plain Craft Launcher 2/Modules/Resource/ResourceSearcher.vb
+39 -34
View File
@@ -1,4 +1,4 @@
Public Class ResourceSearcher
Public Class ResourceSearcher
Private Const RESULT_PAGE_SIZE = 40
Private Const MSG_NO_CHINESE_RESULT As String = "无搜索结果，请尝试搜索其英文名称"
@@ -86,7 +86,7 @@
If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/")
If ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then Address += "&modLoaderType=" & Resource.ToCurseForgeModLoaderType(ModLoaders.Flags.First)
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & EscapeUtils.UrlEscape(SearchText)
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & StringUtils.UrlEscape(SearchText)
If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
Return Address
End Function
@@ -97,7 +97,7 @@
If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
'应用筛选参数
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={RESULT_PAGE_SIZE}&index=relevance"
If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & EscapeUtils.UrlEscape(SearchText)
If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & StringUtils.UrlEscape(SearchText)
If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
'facets=[["categories:'game-mechanics'"],["categories:'forge',categories:'fabric'"],["versions:1.19.3"],["project_type:mod"]]
Dim Facets As New List(Of String)
@@ -189,9 +189,9 @@
#Region "中文搜索"
Dim RawSearchText As String = If(Request.SearchText, "").Trim
RawSearchText = StrConv(RawSearchText, VbStrConv.SimplifiedChinese) '繁体转简体
RawSearchText = RawSearchText.Lower
Logger.Info($"工程列表搜索原始文本：{RawSearchText}")
RawSearchText = StrConv(RawSearchText, VbStrConv.SimplifiedChinese) '繁体转简体
Dim IsChineseSearch As Boolean =
RawSearchText.RegexCheck("[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawSearchText) AndAlso
@@ -203,14 +203,14 @@
Function(Result As SearchEntry(Of WikiEntry), Source As ResourcePlatforms) As IEnumerable(Of String)
'从各个可能的来源提取候选
Dim Candidates As New List(Of String)
If Result.Item.CurseForgeSlug IsNot Nothing AndAlso Source = ResourcePlatforms.CurseForge Then
Candidates.Add(Result.Item.CurseForgeSlug.Replace("-", " ").Replace("/", " "))
If Result.Item.Slugs.ContainsKey(Source) Then
Candidates.Add(Result.Item.Slugs(Source).
Replace("-", " ").Replace("/", " "))
End If
If Result.Item.ModrinthSlug IsNot Nothing AndAlso Source = ResourcePlatforms.Modrinth Then
Candidates.Add(Result.Item.ModrinthSlug.Replace("-", " ").Replace("/", " "))
If Result.Item.ChineseName IsNot Nothing Then
Candidates.Add(Result.Item.ChineseName.
AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").Replace("-", " ").Replace("/", " ").Replace(":", " ").Replace("(", " ").Replace(")", ""))
End If
Candidates.Add(Result.Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
Replace("-", " ").Replace("/", " ").Replace(":", " ").Replace("(", " ").Replace(")", ""))
'分词、清洗、去重
Candidates = Candidates.
SelectMany(Function(c) c.Split(" ")).
@@ -220,6 +220,7 @@
If w.Length <= 1 Then Return False '单字或空白
If {"the", "of", "mod", "and", "forge", "fabric", "for", "quilt", "neoforge"}.Contains(w) Then Return False '常见词
If Val(w) > 0 Then Return False '数字
If Not w.IsAsciiOnly Then Return False '非纯英文
Return True
End Function).Distinct.ToList
'如果一个词可以由其他词拼成，则去掉这个词（例如将 ender io enderio 的 enderio 剔除，只保留 ender io）
@@ -228,17 +229,26 @@
Candidates = Candidates.Where(Function(w) Not Candidates.Any(Function(c) c.Length < w.Length AndAlso w.StartsWith(c) AndAlso CanForm(w.Substring(c.Length)))).ToList()
Return Candidates
End Function
Dim GetSearchEntries =
Iterator Function(Source As ResourcePlatforms)
For Each Entry In WikiEntry.All.Value
If Not Entry.Slugs.ContainsKey(Source) Then Continue For
If Entry.ChineseName IsNot Nothing Then
Yield New SearchEntry(Of WikiEntry) With {.Item = Entry, .SearchSource = New List(Of SearchSource) From {
New SearchSource(StrConv(Entry.ChineseName.BeforeFirst(" ("), VbStrConv.SimplifiedChinese).Split("/"c, True), 1), '部分 Mod 有别名
New SearchSource(StrConv(Entry.ChineseName.AfterFirst(" ("), VbStrConv.SimplifiedChinese) & Entry.Slugs(Source), 0.5)
}}
Else
Yield New SearchEntry(Of WikiEntry) With {.Item = Entry, .SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.Slugs(Source), 0.5)
}}
End If
Next
End Function
'CurseForge
If Request.Sources.HasFlag(ResourcePlatforms.CurseForge) Then
'数据库搜索
Static CurseForgeSearchEntries As List(Of SearchEntry(Of WikiEntry)) =
WikiEntry.All.Where(Function(Entry) Entry.CurseForgeSlug IsNot Nothing).Select(
Function(Entry) New SearchEntry(Of WikiEntry) With {
.Item = Entry,
.SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split("/"c, True), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.CurseForgeSlug, 0.5)}
}).ToList
Static CurseForgeSearchEntries As List(Of SearchEntry(Of WikiEntry)) = GetSearchEntries(ResourcePlatforms.CurseForge).ToList()
Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25)
If CurseForgeSearchResults.Any Then
'选取目标（CurseForge 要求每个词都必须匹配上，所以只能选择一个 Mod 进行搜索）
@@ -255,14 +265,7 @@
'Modrinth
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) Then
'数据库搜索
Static ModrinthSearchEntries As List(Of SearchEntry(Of WikiEntry)) =
WikiEntry.All.Where(Function(Entry) Entry.ModrinthSlug IsNot Nothing).Select(
Function(Entry) New SearchEntry(Of WikiEntry) With {
.Item = Entry,
.SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split("/"c, True), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.ModrinthSlug, 0.5)}
}).ToList
Static ModrinthSearchEntries As List(Of SearchEntry(Of WikiEntry)) = GetSearchEntries(ResourcePlatforms.Modrinth).ToList()
Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25)
If ModrinthSearchResults.Any Then
'分词
@@ -277,7 +280,7 @@
ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key
Logger.Warn($"中文搜索关键词（Modrinth）：{ModrinthAltSearchText}")
'直接请求工程
ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.ModrinthSlug).ToList
ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.Slugs(ResourcePlatforms.Modrinth)).ToList
End If
End If
'结束
@@ -291,16 +294,17 @@
Dim RealResults As New List(Of ResourceProject)
NextPage:
Dim RawResults As New ConcurrentList(Of ResourceProject)
Dim RawResults As New List(Of ResourceProject)
#Region "从 CurseForge 和 Modrinth 获取结果列表，存储于 RawResults"
Dim WorkThreads As New List(Of Thread)
Dim Errors As New ConcurrentList(Of (Ex As Exception, Source As ResourcePlatforms))
Dim Errors As New ConcurrentBag(Of (Ex As Exception, Source As ResourcePlatforms))
'在 1.14-，部分老 Mod 没有设置支持的加载器，因此添加 Forge 筛选就会出现遗漏
'所以，在发起请求时不筛选加载器，然后在返回的结果中自行筛除不是 Forge 的 Mod
Dim IgnoreModLoaderFilter = Request.ModLoaders = ModLoaders.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140
Dim SearchResults As New ConcurrentBag(Of ResourceProject)
Try
'CurseForge 搜索
@@ -322,7 +326,7 @@ NextPage:
ProjectList.Add(Project)
Next
'更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p))
ProjectList.ForEach(Sub(p) SearchResults.Add(p))
Storage.CurseForgeOffset += RequestResult("data").Count
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
Logger.Info($"从 CurseForge 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）")
@@ -350,7 +354,7 @@ NextPage:
ProjectList.Add(New ResourceProject(JsonEntry))
Next
'更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p))
ProjectList.ForEach(Sub(p) SearchResults.Add(p))
Storage.ModrinthOffset += RequestResult("hits").Count
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
Logger.Info($"从 Modrinth 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）")
@@ -386,7 +390,7 @@ NextPage:
ProjectList.Add(Project)
Next
'更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p))
ProjectList.ForEach(Sub(p) SearchResults.Add(p))
Logger.Info($"从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
Catch ex As Exception
@@ -400,8 +404,9 @@ NextPage:
'等待线程结束
For Each Thread In WorkThreads
Thread.Join()
If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程
If Task.IsCanceled Then Return '会自动触发 Finally 以清理线程
Next
RawResults = New List(Of ResourceProject)(SearchResults)
'仅保留兼容 Forge 的 Mod，或老版本中没有标注任何 Mod Loader 的 Mod
If IgnoreModLoaderFilter Then
@@ -510,7 +515,7 @@ NextPage:
Next
End If
'根据排序分得出结果并添加
If Task.IsInterrupted Then Throw New ThreadInterruptedException '#8246
If Task.IsCanceled Then Throw New OperationCanceledException '#8246
Storage.Results.AddRange(
Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
Plain Craft Launcher 2/Modules/Resource/ResourceVersion.vb
+19 -22
View File
@@ -1,4 +1,4 @@
''' <summary>
''' <summary>
''' 社区资源的单个可下载版本。
''' </summary>
Public Class ResourceVersion
@@ -132,7 +132,7 @@ Public Class ResourceVersion
'DownloadAddress
Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = $"https://edge.forgecdn.net/files/{CInt(.Id.ToString.Substring(0, 4))}/{CInt(.Id.ToString.Substring(4))}/{ .FileName}"
.DownloadUrls = ParseCurseForgeDownloadUrls(Url.Replace(.FileName, EscapeUtils.UrlEscape(.FileName))) '对脑残 CurseForge 的下载地址进行多种修正
.DownloadUrls = ParseCurseForgeDownloadUrls(Url.Replace(.FileName, StringUtils.UrlEscape(.FileName))) '对脑残 CurseForge 的下载地址进行多种修正
.DownloadUrls.Add(DlSourceModGet(Url)) '添加镜像源；注意 MCIM 源不支持 URL 编码后的文件名，必须传入 URL 编码前的文件名
.DownloadUrls = .DownloadUrls.Distinct.ToList '最终去重
'Dependencies
@@ -178,21 +178,20 @@ Public Class ResourceVersion
.Size = File("size")
.Hash = File("hashes")("sha1")
End If
'类别
'类别与 Loaders
'结果可能混杂着 Mod、数据包和服务端插件
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
.ModLoaders = ModLoaders.None
If .ResourceType.HasFlag(ResourceTypes.Mod) OrElse .ResourceType.HasFlag(ResourceTypes.DataPack) Then
If RawLoaders.Intersect({"bukkit", "folia", "paper", "purpur", "spigot"}).Any() Then .ResourceType = ResourceTypes.Plugin 'Veinminer Enchantment 同时支持服务端与 Fabric
If RawLoaders.Contains("datapack") Then .ResourceType = ResourceTypes.DataPack
If EnumUtils.GetAllFlags(Of ModLoaders)().Any() Then .ResourceType = ResourceTypes.Mod
Else
'使用传入的类别，不作修改（#8377）
End If
'Loaders
For Each Loader As ModLoaders In EnumUtils.GetAllFlags(Of ModLoaders)()
If RawLoaders.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader
Next
If .ResourceType.HasFlag(ResourceTypes.Mod) OrElse .ResourceType.HasFlag(ResourceTypes.DataPack) Then
If RawLoaders.Intersect({"bukkit", "folia", "paper", "purpur", "spigot"}).Any() Then .ResourceType = ResourceTypes.Plugin 'Veinminer Enchantment 同时支持服务端与 Fabric
If RawLoaders.Contains("datapack") Then .ResourceType = ResourceTypes.DataPack
If .ModLoaders.Flags().Any() Then .ResourceType = ResourceTypes.Mod
Else
'使用传入的类别，不作修改（#8377）
End If
'Dependencies
If Data.ContainsKey("dependencies") Then
.RawDependencies = Data("dependencies").
@@ -256,7 +255,7 @@ Public Class ResourceVersion
Else 'Modrinth
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version?include_changelog=false")
End If
ProjectFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) ResourceVersion.FromPlatformJson(a, TargetProject.Types)).
ProjectFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) FromPlatformJson(a, TargetProject.Types)).
Where(Function(a) a.DownloadAvailable).
DistinctBy(Function(a) a.Id).ToList 'CurseForge 可能会重复返回相同项（#1330）
End If
@@ -313,13 +312,13 @@ Public Class ResourceVersion
Public Function ToCacheJson() As JObject
Dim Result As New JObject
With Result
.Add("ResourceType", ResourceType)
.Add("ResourceType", CInt(ResourceType))
.Add("Id", Id)
If Version IsNot Nothing Then .Add("Version", Version)
.Add("DisplayName", Display)
.Add("ReleaseDate", ReleaseDate)
.Add("DownloadCount", DownloadCount)
.Add("ModLoaders", ModLoaders)
.Add("ModLoaders", CInt(ModLoaders))
.Add("GameVersions", New JArray(GameVersions))
.Add("ReleaseType", CInt(ReleaseType))
If FileName IsNot Nothing Then .Add("FileName", FileName)
@@ -359,17 +358,14 @@ Public Class ResourceVersion
If .Title <> FileName.BeforeLast(".") Then Yield FileName.BeforeLast(".")
If Dependencies.Any Then Yield $"{Dependencies.Count} 项前置"
If GameVersions.All(Function(v) Not v.Contains(".") OrElse {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) v.ContainsIgnoreCase(s))) Then Yield $"游戏版本 {GameVersions.Join("、"c)}"
If DownloadCount > 0 Then Yield $"下载 {If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万", DownloadCount & " ")}次" 'CurseForge 的下载次数经常错误地返回 0
Yield $"更新于 {GetTimeSpanString(ReleaseDate - Date.Now, False)}"
If DownloadCount > 0 Then Yield $"下载 {If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万", DownloadCount.ToString() + " ")}次" 'CurseForge 的下载次数经常错误地返回 0
Yield $"更新于 {StringUtils.FormatTimeSpan(ReleaseDate - Date.Now, False)}"
If ReleaseType <> ReleaseTypes.Release Then Yield ReleaseTypeDisplay
End Function().Join("，"c)
'另存为按钮
If SaveAsButtonHandler IsNot Nothing Then
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, SaveAsButtonHandler
.Buttons = {BtnSave}
End If
@@ -383,17 +379,18 @@ Public Class ResourceVersion
''' </summary>
''' <param name="LocalFileOrFolder">目标本地文件夹，或完整的文件路径。会自动判断类型。</param>
Public Function ToNetFile(LocalFileOrFolder As String,
Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As NetFile
Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As NetFile
Return New NetFile(
ParseModrinthTrackArguments(DownloadUrls, TrackDownloadReason, TrackGameVersion, TrackLoader),
LocalFileOrFolder & If(LocalFileOrFolder.EndsWithF("\"), FileName, ""),
New FileChecker(Hash:=Hash, ActualSize:=Size),
New FileChecker With {.Hash = Hash, .ActualSize = Size},
SimulateBrowserHeaders:=True)
End Function
''' <summary>
''' 添加 Modrinth 追踪参数。
''' </summary>
Public Shared Iterator Function ParseModrinthTrackArguments(Urls As List(Of String), Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As IEnumerable(Of String)
Public Shared Iterator Function ParseModrinthTrackArguments(Urls As List(Of String),
Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As IEnumerable(Of String)
Dim Arguments As New Dictionary(Of String, String)
If TrackDownloadReason IsNot Nothing Then Arguments.Add("mr_download_reason", TrackDownloadReason.ToString.Lower)
If TrackGameVersion IsNot Nothing Then Arguments.Add("mr_game_version", TrackGameVersion)
Plain Craft Launcher 2/Modules/Resource/WikiEntry.vb
-84
View File
@@ -1,84 +0,0 @@
'获取所有条目：WikiEntry.All
''' <summary>
''' MC 百科条目。
''' </summary>
Public Class WikiEntry
'属性
''' <summary>
''' 在 MC 百科中的对应 ID。
''' </summary>
Public Id As Integer
''' <summary>
''' 中文译名。空字符串代表没有翻译。
''' </summary>
Public ChineseName As String = ""
''' <summary>
''' CurseForge Slug（例如 advanced-solar-panels）。
''' </summary>
Public CurseForgeSlug As String = Nothing
''' <summary>
''' Modrinth Slug（例如 advanced-solar-panels）。
''' </summary>
Public ModrinthSlug As String = Nothing
''' <summary>
''' MC 百科的浏览量逆序排行，1 代表浏览量最低。
''' </summary>
Public Popularity As Integer
Public Overrides Function ToString() As String
Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & Id & "|" & ChineseName & ", Rank " & Popularity
End Function
'读取
''' <summary>
''' 内置数据库中的所有 MC 百科条目。
''' </summary>
Public Shared ReadOnly Property All As List(Of WikiEntry)
Get
Static Cache As List(Of WikiEntry) = Nothing
If Cache IsNot Nothing Then Return Cache
'实际加载
Cache = New List(Of WikiEntry)
Dim i As Integer = 0
Dim DataLines As List(Of String) = DirectCast(My.Resources.ResourceManager.GetObject("ModData"), String).SplitLines().ToList()
Dim Ranks = DataLines.Last.Split("|")
DataLines.RemoveAt(DataLines.Count - 1)
For Each Line In DataLines
i += 1
If Line = "" Then Continue For
For Each EntryData As String In Line.Split("¨")
Dim Entry = New WikiEntry
Dim Splited = EntryData.Split("|")
If Splited(0).StartsWithF("@") Then
Entry.CurseForgeSlug = Nothing
Entry.ModrinthSlug = Splited(0).Replace("@", "")
ElseIf Splited(0).EndsWithF("@") Then
Entry.CurseForgeSlug = Splited(0).TrimEnd("@")
Entry.ModrinthSlug = Entry.CurseForgeSlug
ElseIf Splited(0).Contains("@") Then
Entry.CurseForgeSlug = Splited(0).Split("@")(0)
Entry.ModrinthSlug = Splited(0).Split("@")(1)
Else
Entry.CurseForgeSlug = Splited(0)
Entry.ModrinthSlug = Nothing
End If
Entry.Id = i
Entry.Popularity = Val(Ranks(i - 1))
If Splited.Count >= 2 Then
Entry.ChineseName = Splited.Last
If Entry.ChineseName.Contains("*") Then '处理 *
Entry.ChineseName = Entry.ChineseName.Replace("*",
$" ({If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Replace("-", " ").Capitalize})")
End If
End If
Cache.Add(Entry)
Next
Next
Return Cache
End Get
End Property
End Class
Plain Craft Launcher 2/Modules/ThirdParty/DragHelper.vb
Vendored
+1 -1
View File
@@ -1,4 +1,4 @@
'来源：https://blog.csdn.net/simpleman2000/article/details/140952294
'来源：https://blog.csdn.net/simpleman2000/article/details/140952294
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+4 -4
View File
@@ -9,10 +9,10 @@ Imports System.Runtime.InteropServices
'查看程序集特性的值
<Assembly: AssemblyTitle("Plain Craft Launcher 启动器")>
<Assembly: AssemblyDescription("Minecraft 启动器 (制作：龙腾猫跃)")>
<Assembly: AssemblyDescription("Minecraft 启动器")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("Plain Craft Launcher")>
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016. All Rights Reserved.")>
<Assembly: AssemblyCopyright("Copyright © 成都瓜皮龙科技有限公司")>
<Assembly: AssemblyConfiguration("PCL2 Config Mark")>
<Assembly: ComVisible(False)>
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.12.8.2")>
<Assembly: AssemblyFileVersion("2.12.8.2")>
<Assembly: AssemblyVersion("2.13.0.0")>
<Assembly: AssemblyFileVersion("2.13.0.0")>
<Assembly: NeutralResourcesLanguage("")>
Plain Craft Launcher 2/My Project/MyExtensions/MyWpfExtension.vb
+1 -1
View File
@@ -1,4 +1,4 @@
#If _MyType <> "Empty" Then
#If _MyType <> "Empty" Then
Namespace My
''' <summary>
Plain Craft Launcher 2/My Project/Resources.Designer.vb
Generated
+11 -24
View File
@@ -1,4 +1,4 @@
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' <auto-generated>
' 此代码由工具生成。
' 运行时版本:4.0.30319.42000
@@ -90,6 +90,16 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property ThrottleDebounce() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("ThrottleDebounce", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
@@ -180,29 +190,6 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' 查找类似
'''22107|industrial-craft@|工业时代2 (Industrial Craft 2)
'''21532|@redpower2-core|红石力量2 (RedPower2)
'''22036|buildcraft@|建筑 (BuildCraft)
'''22074|forestry@|林业*
'''21995|railcraft@railcraft-reborn|铁路*¨21996|railcraft-reborn|铁路 (Railcraft)
'''
'''
'''22054|@ee2|等价交换2 (Equivalent Exchange 2)
'''
'''21655|touhou-item-mod|辉夜姬的五难题 (五つの難題MOD+ ~ Touhou Items)
'''20236|secretroomsmod|密室 (SecretRoomsMod)
'''20521|the-camping-mod|野营*
'''20056|usefulfood|有用的食物 (UsefulFood)
'''20021|powerconverters-portablejims-fork|能源转换 (PowerConverters)¨20022|powerconverters|能源 [字符串的其余部分被截断]&quot;; 的本地化字符串。
'''</summary>
Friend ReadOnly Property ModData() As String
Get
Return ResourceManager.GetString("ModData", resourceCulture)
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Plain Craft Launcher 2/My Project/Resources.resx
+4 -4
View File
@@ -1,4 +1,4 @@
<?xml version="1.0" encoding="utf-8"?>
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
@@ -127,6 +127,9 @@
<data name="CacheCow.Common" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\CacheCow.Common.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="ThrottleDebounce" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\ThrottleDebounce.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Custom" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\resources\custom.xaml;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
@@ -154,9 +157,6 @@
<data name="MeloongCore.Wpf" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\..\PCLCS\bin\MeloongCore.Wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\moddata.txt;System.String, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089;utf-8</value>
</data>
<data name="NAudio" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\NAudio.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
Plain Craft Launcher 2/My Project/Settings.Designer.vb
Generated
+1 -1
View File
@@ -1,4 +1,4 @@
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' <auto-generated>
' 此代码由工具生成。
' 运行时版本:4.0.30319.42000
Plain Craft Launcher 2/My Project/Settings.settings
+1 -1
View File
@@ -1,4 +1,4 @@
<?xml version='1.0' encoding='utf-8'?>
<?xml version='1.0' encoding='utf-8'?>
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles>
<Profile Name="(Default)" />
Plain Craft Launcher 2/My Project/app.manifest
+1 -1
View File
@@ -1,4 +1,4 @@
<?xml version="1.0" encoding="utf-8"?>
<?xml version="1.0" encoding="utf-8"?>
<assembly manifestVersion="1.0" xmlns="urn:schemas-microsoft-com:asm.v1">
<assemblyIdentity version="1.0.0.0" name="MyApplication.app" />
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+94 -163
View File
@@ -1,4 +1,4 @@
Public Module ModDownloadLib
Public Module ModDownloadLib
#Region "Minecraft 下载"
@@ -21,7 +21,7 @@
End Sub) With {.ProgressWeight = 2, .Show = False})
End If
Loaders.Add(New LoaderDownload(McDownloadClientJsonName, New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(If(JsonUrl, "")), VersionFolder & InstanceName & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
New NetFile(DlSourceLauncherOrMetaGet(If(JsonUrl, "")), VersionFolder & InstanceName & ".json", New FileChecker With {.IsJson = True})
}) With {.ProgressWeight = 3})
'下载支持库文件
@@ -47,7 +47,7 @@
End Try
'顺手添加 Json 项目
Try
Dim InstanceJson As JObject = GetJson(FileUtils.ReadAsString(VersionFolder & InstanceName & ".json"))
Dim InstanceJson As JObject = FileUtils.ReadAsJson(VersionFolder & InstanceName & ".json")
InstanceJson.Add("clientVersion", Id)
FileUtils.Write($"{VersionFolder}{InstanceName}.json", InstanceJson.ToString)
Catch ex As Exception
@@ -106,32 +106,17 @@
End Function
Private Sub McDownloadSaveMenuBuild(sender As Object, 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 McDownloadMenuLog
Dim BtnServer As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonServer, .ToolTip = "下载服务端"}
ToolTipService.SetPlacement(BtnServer, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnServer, 30)
ToolTipService.SetHorizontalOffset(BtnServer, 2)
AddHandler BtnServer.Click, AddressOf McDownloadMenuSaveServer
sender.Buttons = {BtnServer, BtnInfo}
End Sub
Private Sub McDownloadMenuBuild(sender As Object, 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 McDownloadMenuSave
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 McDownloadMenuLog
Dim BtnServer As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonServer, .ToolTip = "下载服务端"}
ToolTipService.SetPlacement(BtnServer, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnServer, 30)
ToolTipService.SetHorizontalOffset(BtnServer, 2)
AddHandler BtnServer.Click, AddressOf McDownloadMenuSaveServer
sender.Buttons = {BtnSave, BtnInfo, BtnServer}
End Sub
@@ -172,7 +157,7 @@
Dim Loaders As New List(Of LoaderBase)
'下载版本 JSON 文件
Loaders.Add(New LoaderDownload("下载版本 JSON 文件", New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker With {.IsJson = True})
}) With {.ProgressWeight = 2})
'构建服务端
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("构建服务端",
@@ -185,11 +170,11 @@
Task.Output = New List(Of NetFile)
Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载，没法下，撤退！", HintType.Red)
Thread.Sleep(2000) '等玩家把上一个提示看完
Task.Interrupt()
Task.Cancel()
Return
End If
Dim JarUrl As String = Instance.JsonObject("downloads")("server")("url")
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Instance.JsonObject("downloads")("server")("size"), -1), Hash:=Instance.JsonObject("downloads")("server")("sha1"))
Dim Checker As New FileChecker With {.MinSize = 1024, .ActualSize = If(Instance.JsonObject("downloads")("server")("size"), -1), .Hash = Instance.JsonObject("downloads")("server")("sha1")}
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JarUrl), VersionFolder & Id & "-server.jar", Checker)}
'添加启动脚本
Dim Bat As String =
@@ -205,7 +190,7 @@ echo ----------------------
echo 服务端已停止。
pause"
FileUtils.Write(VersionFolder & "Launch Server.bat", Bat,
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
'删除版本 JSON
FileUtils.Delete(VersionFolder & Id & ".json")
End Sub) With {.ProgressWeight = 0.5, .Show = False})
@@ -248,7 +233,7 @@ pause"
Dim Loaders As New List(Of LoaderBase)
'下载版本 JSON 文件
Loaders.Add(New LoaderDownload("下载版本 JSON 文件", New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker With {.IsJson = True})
}) With {.ProgressWeight = 2})
'获取支持库文件地址
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 JAR 文件下载地址",
@@ -357,27 +342,29 @@ pause"
End Try
End Sub
Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean), UseJavaWrapper As Boolean)
Dim JavaRange = ValueRange(Of Version).AtLeast(New Version(21, 0)) '默认值
Try
Using Installer = FileUtils.OpenZip(Target)
Dim InstallerClass = Installer.GetEntry("optifine/Installer.class")
If InstallerClass Is Nothing Then Throw New FileNotFoundException("未找到 optifine/Installer.class")
Using Stream = InstallerClass.Open(), Reader As New BinaryReader(Stream)
Dim Header = Reader.ReadBytes(8)
If Header.Length < 8 Then Throw New IOException("Installer.class 长度不足")
If Header(0) <> &HCA OrElse Header(1) <> &HFE OrElse Header(2) <> &HBA OrElse Header(3) <> &HBE Then Throw New InvalidDataException("Installer.class 文件头无效")
Dim ClassVersion = Header(6) * &H100 + Header(7)
If ClassVersion < 49 Then Throw New InvalidDataException("Installer.class 版本过低")
If ClassVersion > 100 Then Throw New InvalidDataException("Installer.class 版本过高")
JavaRange = ValueRange(Of Version).AtLeast(New Version(ClassVersion - 44, 0))
Logger.Info($"OptiFine 安装器 class 版本：{ClassVersion}，需要 Java {JavaRange}")
End Using
End Using
Catch ex As Exception
Logger.Warn(ex, "读取 OptiFine 安装器 Java 版本失败")
End Try
'选择 Java
Dim Java As JavaEntry
SyncLock JavaLock
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
If Java Is Nothing Then
'开始自动下载
Dim JavaLoader = GetJavaDownloadLoader()
Try
JavaLoader.Start(17, IsForceRestart:=True)
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsInterrupted
Thread.Sleep(10)
Loop
Finally
JavaLoader.Interrupt() '确保取消时中止 Java 下载
End Try
'检查下载结果
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
If Task.IsInterrupted Then Return
If Java Is Nothing Then Throw New Exception("由于未找到 Java，已取消安装。")
End If
End SyncLock
Dim Java As Java = SelectOrDownloadJava(JavaRange, True, Task.CreateCancellationToken, Task.CreateSyncProgressProvider(0, 0.2))
If Task.IsCanceled Then Return
If Java Is Nothing Then Throw New OperationCanceledException
'添加 Java Wrapper 作为主 Jar
Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
@@ -385,11 +372,11 @@ pause"
Else
Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer"
End If
If Java.MajorVersion >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
If Java.Version.Major >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动
SyncLock InstallSyncLock
Dim Info = New ProcessStartInfo With {
.FileName = Java.PathJava,
.FileName = Java.JavaExePath,
.Arguments = Arguments,
.UseShellExecute = False,
.CreateNoWindow = True,
@@ -417,14 +404,14 @@ pause"
LastResult = e.Data
Logger.Trace(LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
Task.Progress += 0.7 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Logger.Warn(ex, "读取 OptiFine 安装器信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
If Task.State = LoadState.Canceled AndAlso Not process.HasExited Then
Logger.Info("由于任务取消，已中止 OptiFine 安装")
process.Kill()
End If
@@ -441,14 +428,14 @@ pause"
LastResult = e.Data
Logger.Trace(LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
Task.Progress += 0.7 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Logger.Warn(ex, "读取 OptiFine 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
If Task.State = LoadState.Canceled AndAlso Not process.HasExited Then
Logger.Info("由于任务取消，已中止 OptiFine 安装")
process.Kill()
End If
@@ -513,7 +500,7 @@ pause"
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))}
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker With {.MinSize = 300 * 1024})}
End Sub) With {.ProgressWeight = 8})
Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载",
@@ -523,11 +510,11 @@ pause"
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Any Then Logger.Info("OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
Do While TargetLoaders.Any AndAlso Not Task.IsCanceled
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsInterrupted Then Return
If Task.IsCanceled Then Return
'复制原版文件
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
@@ -666,7 +653,7 @@ Retry:
End Try
Task.Progress = 0.9
'构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, TargetFolder, New FileChecker(MinSize:=64 * 1024))}
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, TargetFolder, New FileChecker With {.MinSize = 64 * 1024})}
End Sub) With {.ProgressWeight = 6})
'下载
Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 10, .Block = True})
@@ -700,22 +687,13 @@ Retry:
End Function
Private Sub OptiFineSaveContMenuBuild(sender As Object, 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 OptiFineLog_Click
sender.Buttons = {BtnInfo}
End Sub
Private Sub OptiFineContMenuBuild(sender As Object, 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 OptiFineSave_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 OptiFineLog_Click
sender.Buttons = {BtnSave, BtnInfo}
End Sub
@@ -783,7 +761,7 @@ Retry:
'官方源
Address.Add("http://jenkins.liteloader.com/job/LiteLoaderInstaller%20" & DownloadInfo.Inherit & "/lastSuccessfulBuild/artifact/" & If(DownloadInfo.Inherit = "1.8", "ant/dist/", "build/libs/") & DownloadInfo.FileName)
End If
Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker(MinSize:=1024 * 1024))}) With {.ProgressWeight = 15})
Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker With {.MinSize = 1024 * 1024})}) With {.ProgressWeight = 15})
'启动
Dim Loader As New LoaderCombo(Of DlLiteLoaderListEntry)("LiteLoader " & Id & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(DownloadInfo)
@@ -820,9 +798,9 @@ Retry:
VersionJson.Add("time", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.InvariantCulture))
VersionJson.Add("releaseTime", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.InvariantCulture))
VersionJson.Add("type", "release")
VersionJson.Add("arguments", GetJson("{""game"":[""--tweakClass"",""" & DownloadInfo.JsonToken("tweakClass").ToString & """]}"))
VersionJson.Add("arguments", ("{""game"":[""--tweakClass"",""" & DownloadInfo.JsonToken("tweakClass").ToString & """]}").DeserializeJson())
VersionJson.Add("libraries", DownloadInfo.JsonToken("libraries"))
CType(VersionJson("libraries"), JContainer).Add(GetJson("{""name"": ""com.mumfrey:liteloader:" & DownloadInfo.JsonToken("version").ToString & """,""url"": ""https://dl.liteloader.com/versions/""}"))
CType(VersionJson("libraries"), JContainer).Add(("{""name"": ""com.mumfrey:liteloader:" & DownloadInfo.JsonToken("version").ToString & """,""url"": ""https://dl.liteloader.com/versions/""}").DeserializeJson())
VersionJson.Add("mainClass", "net.minecraft.launchwrapper.Launch")
VersionJson.Add("minimumLauncherVersion", 18)
VersionJson.Add("inheritsFrom", DownloadInfo.Inherit)
@@ -866,26 +844,17 @@ Retry:
sender.Buttons = {}
Else
Dim BtnList As New MyIconButton With {.Logo = Logo.IconButtonList, .ToolTip = "查看全部版本", .Tag = sender}
ToolTipService.SetPlacement(BtnList, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnList, 30)
ToolTipService.SetHorizontalOffset(BtnList, 2)
AddHandler BtnList.Click, AddressOf LiteLoaderAll_Click
sender.Buttons = {BtnList}
End If
End Sub
Private Sub LiteLoaderContMenuBuild(sender As MyListItem, e As EventArgs)
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "保存安装器", .Tag = sender}
ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnSave, 30)
ToolTipService.SetHorizontalOffset(BtnSave, 2)
AddHandler BtnSave.Click, AddressOf LiteLoaderSave_Click
If sender.Tag.IsLegacy Then
sender.Buttons = {BtnSave}
Else
Dim BtnList As New MyIconButton With {.Logo = Logo.IconButtonList, .ToolTip = "查看全部版本", .Tag = sender}
ToolTipService.SetPlacement(BtnList, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnList, 30)
ToolTipService.SetHorizontalOffset(BtnList, 2)
AddHandler BtnList.Click, AddressOf LiteLoaderAll_Click
sender.Buttons = {BtnSave, BtnList}
End If
@@ -936,14 +905,14 @@ Retry:
Dim Url As String = NeoForge.UrlBase & "-installer.jar"
Files.Add(New NetFile({
Url.Replace("maven.neoforged.net/releases", "bmclapi2.bangbang93.com/maven"), Url
}, Target, New FileChecker(MinSize:=64 * 1024)))
}, Target, New FileChecker With {.MinSize = 64 * 1024}))
Else
'Forge
Dim Forge As DlForgeVersionEntry = Info
Files.Add(New NetFile({
$"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/{Forge.Inherit}-{Forge.FileVersion}/forge-{Forge.Inherit}-{Forge.FileVersion}-{Forge.Category}.{Forge.FileExtension}",
$"https://files.minecraftforge.net/maven/net/minecraftforge/forge/{Forge.Inherit}-{Forge.FileVersion}/forge-{Forge.Inherit}-{Forge.FileVersion}-{Forge.Category}.{Forge.FileExtension}"
}, Target, New FileChecker(MinSize:=64 * 1024, Hash:=Forge.Hash)))
}, Target, New FileChecker With {.MinSize = 64 * 1024, .Hash = Forge.Hash}))
End If
'构造加载器
@@ -964,26 +933,9 @@ Retry:
Private Sub ForgelikeInjector(Target As String, Task As LoaderTask(Of Boolean, Boolean), McFolder As String, UseJavaWrapper As Boolean, IsNeoForge As Boolean)
'选择 Java
Dim Java As JavaEntry
SyncLock JavaLock
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60))
If Java Is Nothing Then
'开始自动下载
Dim JavaLoader = GetJavaDownloadLoader()
Try
JavaLoader.Start(17, IsForceRestart:=True)
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsInterrupted
Thread.Sleep(10)
Loop
Finally
JavaLoader.Interrupt() '确保取消时中止 Java 下载
End Try
'检查下载结果
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60))
If Task.IsInterrupted Then Return
If Java Is Nothing Then Throw New Exception("由于未找到 Java，已取消安装。")
End If
End SyncLock
Dim Java As Java = SelectOrDownloadJava(ValueRange(Of Version).AtLeast(New Version(8, 0, 60)), True, Task.CreateCancellationToken, Task.CreateSyncProgressProvider(0, 0.2))
If Task.IsCanceled Then Return
If Java Is Nothing Then Throw New OperationCanceledException
'添加 Java Wrapper 作为主 Jar
Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
@@ -991,11 +943,11 @@ Retry:
Else
Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}"
End If
If Java.MajorVersion >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
If Java.Version.Major >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动
SyncLock InstallSyncLock
Dim Info = New ProcessStartInfo With {
.FileName = Java.PathJava,
.FileName = Java.JavaExePath,
.Arguments = Arguments,
.UseShellExecute = False,
.CreateNoWindow = True,
@@ -1023,7 +975,7 @@ Retry:
Logger.Warn(ex, $"读取 {LoaderName} 安装器信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
If Task.State = LoadState.Canceled AndAlso Not process.HasExited Then
Logger.Info($"由于任务取消，已中止 {LoaderName} 安装")
process.Kill()
End If
@@ -1046,7 +998,7 @@ Retry:
Logger.Warn(ex, $"读取 {LoaderName} 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
If Task.State = LoadState.Canceled AndAlso Not process.HasExited Then
Logger.Info($"由于任务取消，已中止 {LoaderName} 安装")
process.Kill()
End If
@@ -1080,35 +1032,35 @@ Retry:
Private Sub ForgelikeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean))
Select Case Content
Case "Extracting json"
Task.Progress = 0.07
Task.Progress = 0.27
Case "Downloading libraries"
Task.Progress = 0.08
Task.Progress = 0.28
Case " File exists: Checksum validated."
Task.Progress += 0.003
Case "Building Processors"
Task.Progress = 0.18
Task.Progress = 0.38
Case "Task: DOWNLOAD_MOJMAPS" 'B
Task.Progress = 0.2
Case "Task: MERGE_MAPPING" 'B
Task.Progress = 0.3
Case "Splitting: "
Task.Progress = 0.35
Case "Parameter Annotations" 'B
Task.Progress = 0.4
Case "Task: MERGE_MAPPING" 'B
Task.Progress = 0.5
Case "Splitting: "
Task.Progress = 0.55
Case "Parameter Annotations" 'B
Task.Progress = 0.6
Case "Processing Complete" 'B
Task.Progress = 0.5
Task.Progress = 0.67
Case "log: null" 'new
Task.Progress = 0.5
Task.Progress = 0.67
Case "Sorting" 'new
Task.Progress = 0.65
Task.Progress = 0.8
Case "Remapping final jar" 'A
Task.Progress = 0.72
Task.Progress = 0.85
Case "Remapping jar... 50%" 'A
Task.Progress = 0.76
Task.Progress = 0.9
Case "Remapping jar... 100%" 'A
Task.Progress = 0.81
Task.Progress = 0.95
Case "Injecting profile"
Task.Progress = 0.91
Task.Progress = 0.98
Case Else
Logger.Trace(Content)
Return
@@ -1173,7 +1125,7 @@ Retry:
Dim Url As String = Neo.UrlBase & "-installer.jar"
Files.Add(New NetFile({
Url.Replace("maven.neoforged.net/releases", "bmclapi2.bangbang93.com/maven"), Url
}, InstallerAddress, New FileChecker(MinSize:=64 * 1024)))
}, InstallerAddress, New FileChecker With {.MinSize = 64 * 1024}))
Else
'Forge
Dim Forge As DlForgeVersionEntry = Info
@@ -1182,7 +1134,7 @@ Retry:
Files.Add(New NetFile({
$"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/{FileName}",
$"https://files.minecraftforge.net/maven/net/minecraftforge/forge/{FileName}"
}, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=Forge.Hash)))
}, InstallerAddress, New FileChecker With {.MinSize = 64 * 1024, .Hash = Forge.Hash}))
End If
Task.Output = Files
End Sub) With {.ProgressWeight = 0.5, .Show = False})
@@ -1200,8 +1152,8 @@ Retry:
'解压并获取、合并两个 Json 的信息
Installer = FileUtils.OpenZip(InstallerAddress)
Task.Progress = 0.2
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
Dim Json2 As JObject = GetJson(Installer.GetEntry("version.json").Open().ReadString)
Dim Json As JObject = Installer.GetEntry("install_profile.json").Open().ReadString().DeserializeJson()
Dim Json2 As JObject = Installer.GetEntry("version.json").Open().ReadString().DeserializeJson()
Json.Merge(Json2)
'获取 Lib 下载信息
Libs = McLibListGetWithJson(Json, True)
@@ -1209,7 +1161,7 @@ Retry:
If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
'下载原版 Json 文件
Task.Progress = 0.4
Dim RawJson As JObject = GetJson(NetRequestByLoader(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
Dim RawJson As JObject = NetRequestByLoader(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True).DeserializeJson()
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
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))
@@ -1254,11 +1206,11 @@ Retry:
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList()
If TargetLoaders.Any Then Logger.Info($"{LoaderName} 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
Do While TargetLoaders.Any AndAlso Not Task.IsCanceled
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsInterrupted Then Return
If Task.IsCanceled Then Return
'复制原版文件
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
@@ -1279,10 +1231,10 @@ Retry:
Try
Logger.Info($"开始进行 Forgelike 安装：{InstallerAddress}")
'记录当前文件夹列表（在新建目标文件夹之前）
Dim OldList = DirectoryUtils.GetDirectories(McFolder & "versions\", True).ToList()
Dim OldList = DirectoryUtils.EnumerateDirectories(McFolder & "versions\").ToList()
'解压并获取信息
Installer = FileUtils.OpenZip(InstallerAddress)
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
Dim Json As JObject = Installer.GetEntry("install_profile.json").Open().ReadString().DeserializeJson()
'新建目标版本文件夹
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.04
@@ -1309,7 +1261,7 @@ Retry:
End If
End Try
'复制新增的版本 Json
Dim DeltaList = DirectoryUtils.GetDirectories(McFolder & "versions\", True).
Dim DeltaList = DirectoryUtils.EnumerateDirectories(McFolder & "versions\").
SkipWhile(Function(i) OldList.Contains(i)).Select(Function(f) DirectoryUtils.GetInfo(f)).ToList()
If DeltaList.Count > 1 Then
'它可能和 OptiFine 安装同时运行，导致增加的文件不止一个（这导致了 #151）
@@ -1350,7 +1302,7 @@ Retry:
'解压并获取信息
Installer = FileUtils.OpenZip(InstallerAddress)
Task.Progress = 0.2
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
Dim Json As JObject = Installer.GetEntry("install_profile.json").Open().ReadString().DeserializeJson()
Task.Progress = 0.4
'新建版本文件夹
DirectoryUtils.Create(VersionFolder)
@@ -1359,7 +1311,7 @@ Retry:
'中版：Legacy 方式 1
Logger.Info($"开始进行 Forge 安装，Legacy 方式 1：{InstallerAddress}")
'建立 Json 文件
Dim JsonVersion As JObject = GetJson(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open().ReadString)
Dim JsonVersion As JObject = Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open().ReadString().DeserializeJson()
JsonVersion("id") = NewInstanceName
FileUtils.Write(VersionFolder & NewInstanceName & ".json", JsonVersion.ToString)
Task.Progress = 0.6
@@ -1455,22 +1407,13 @@ Retry:
End Function
Private Sub ForgeContMenuBuild(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 ForgeSave_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 ForgeLog_Click
sender.Buttons = {BtnSave, BtnInfo}
End Sub
Private Sub ForgeSaveContMenuBuild(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 ForgeLog_Click
sender.Buttons = {BtnInfo}
End Sub
@@ -1513,7 +1456,7 @@ Retry:
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)
Dim ResultJson As JContainer = Result.DeserializeJson()
'获取所有推荐版本列表
Dim RecommendedList As New List(Of String)
For Each Version As JObject In ResultJson
@@ -1546,7 +1489,7 @@ Retry:
Logger.Info("没有 Forge 推荐版本缓存文件")
Return Nothing
End If
Dim Json As JObject = GetJson(List)
Dim Json As JObject = List.DeserializeJson()
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
@@ -1613,22 +1556,13 @@ Retry:
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
@@ -1680,7 +1614,7 @@ Retry:
'BMCLAPI 不支持 Fabric Installer 下载
Dim Address As New List(Of String)
Address.Add(Url)
Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker(MinSize:=1024 * 64))}) With {.ProgressWeight = 15})
Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker With {.MinSize = 1024 * 64})}) With {.ProgressWeight = 15})
'启动
Dim Loader As New LoaderCombo(Of JObject)("Fabric " & Version & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(DownloadInfo)
@@ -1712,7 +1646,7 @@ Retry:
Task.Output = New List(Of NetFile) From {New NetFile({
"https://bmclapi2.bangbang93.com/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json",
"https://meta.fabricmc.net/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json"
}, VersionFolder & Id & ".json", New FileChecker(IsJson:=True))} '构造文件请求
}, VersionFolder & Id & ".json", New FileChecker With {.IsJson = True})} '构造文件请求
End Sub) With {.ProgressWeight = 0.5})
Loaders.Add(New LoaderDownload("下载 Fabric 主文件", New List(Of NetFile)) With {.ProgressWeight = 2.5})
@@ -1849,7 +1783,7 @@ Retry:
Hint(Loader.Name & "成功！", HintType.Green)
Case LoadState.Failed
Hint(Loader.Name & "失败：" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted
Case LoadState.Canceled
Hint(Loader.Name & "已取消！", HintType.Blue)
End Select
End Sub
@@ -1864,7 +1798,7 @@ Retry:
'TODO: 自动选择安装成功的版本
Case LoadState.Failed
MyMsgBox(Loader.Error.GetDisplay(True), Loader.Name & "失败", IsWarn:=True)
Case LoadState.Interrupted
Case LoadState.Canceled
Hint(Loader.Name & "已取消！", HintType.Blue)
Case LoadState.Loading
Return '不重新加载版本列表
@@ -1875,7 +1809,7 @@ Retry:
Public Sub McInstallFailedClearFolder(Loader)
Try
Thread.Sleep(1000) '防止存在尚未完全释放的文件，导致清理失败（例如整合包安装）
If Loader.State = LoadState.Failed OrElse Loader.State = LoadState.Interrupted Then
If Loader.State = LoadState.Failed OrElse Loader.State = LoadState.Canceled Then
'删除版本文件夹
If DirectoryUtils.Exists(Loader.Input & "saves\") OrElse DirectoryUtils.Exists(Loader.Input & "versions\") Then
Logger.Warn($"由于版本已被独立启动，不清理版本文件夹：{Loader.Input}")
@@ -1905,8 +1839,6 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Return True
Catch ex As CancelledException
Return False
Catch ex As Exception
Logger.Error(ex, "开始合并安装失败")
Return False
@@ -1915,7 +1847,6 @@ Retry:
''' <summary>
''' 获取合并安装加载器列表，并进行前期的缓存清理与 Java 检查工作。
''' </summary>
''' <exception cref="CancelledException" />
Public Function McInstallLoader(Request As McInstallRequest) As List(Of LoaderBase)
'获取缓存目录（安装 Mod 加载器的文件夹不能包含空格）
Dim TempMcFolder As String = RequestTaskTempFolder(Request.OptiFineEntry IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing)
@@ -1971,7 +1902,7 @@ Retry:
'重复版本检查
If FileUtils.Exists($"{VersionFolder}{Request.NewInstanceName}.json") Then
Hint("版本 " & Request.NewInstanceName & " 已经存在！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
Dim LoaderList As New List(Of LoaderBase)
@@ -2115,36 +2046,36 @@ Retry:
#Region "读取文件并检查文件是否合规"
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)
MinecraftJson = MinecraftJsonText.DeserializeJson()
If HasOptiFine Then
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)
OptiFineJson = OptiFineJsonText.DeserializeJson()
End If
If HasForge Then
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)
ForgeJson = ForgeJsonText.DeserializeJson()
End If
If HasNeoForge Then
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)
NeoForgeJson = NeoForgeJsonText.DeserializeJson()
End If
If HasLiteLoader Then
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)
LiteLoaderJson = LiteLoaderJsonText.DeserializeJson()
End If
If HasFabric Then
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)
FabricJson = FabricJsonText.DeserializeJson()
End If
#End Region

Some files were not shown because too many files have changed in this diff Show More