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
+11
View File
@@ -1,12 +1,23 @@
# 如果要从更高级别的目录继承 .editorconfig 设置,请删除以下行 # 如果要从更高级别的目录继承 .editorconfig 设置,请删除以下行
root = true root = true
[*]
charset = utf-8
[*.cs] [*.cs]
# IDE0320: 使匿名函数成为静态函数 # IDE0320: 使匿名函数成为静态函数
csharp_prefer_static_anonymous_function = false 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}] [*.{cs,vb}]
# IDE0028: 简化集合初始化 # IDE0028: 简化集合初始化
dotnet_style_collection_initializer = true:silent dotnet_style_collection_initializer = true:silent
# IDE0130: 命名空间与文件夹结构不匹配
dotnet_diagnostic.IDE0130.severity = silent
+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);
}
+7 -3
View File
@@ -63,13 +63,17 @@ public static class Versions {
/// <summary> /// <summary>
/// 土豆码版本号。 /// 土豆码版本号。
/// </summary> /// </summary>
public const char POTATO_VERSION = '1'; public const char PotatoVersion = '1';
/// <summary> /// <summary>
/// 版本管理中 Mod 信息缓存的版本号。 /// 版本管理中 Mod 信息缓存的版本号。
/// </summary> /// </summary>
public const int LOCAL_MOD_CACHE_VERSION = 17; public const int LocalModCacheVersion = 17;
/// <summary> /// <summary>
/// Minecraft 本地实例信息缓存的版本号。 /// Minecraft 本地实例信息缓存的版本号。
/// </summary> /// </summary>
public const int MCINSTANCE_CACHE_VERSION = 38; public const int McInstanceCacheVersion = 38;
/// <summary>
/// Java 相关配置的版本号。
/// </summary>
public const int JavaConfigVersion = 1;
} }
+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
}
+16 -1
View File
@@ -1,4 +1,4 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net48</TargetFramework> <TargetFramework>net48</TargetFramework>
@@ -25,10 +25,13 @@
<Using Include="System.Diagnostics.CodeAnalysis" /> <Using Include="System.Diagnostics.CodeAnalysis" />
<Using Include="System.Collections" /> <Using Include="System.Collections" />
<Using Include="System.Collections.Generic" /> <Using Include="System.Collections.Generic" />
<Using Include="System.Collections.Concurrent" />
<Using Include="System.Text" /> <Using Include="System.Text" />
<Using Include="System.Net" /> <Using Include="System.Net" />
<Using Include="System.Runtime.CompilerServices" /> <Using Include="System.Runtime.CompilerServices" />
<Using Include="System.Runtime.InteropServices" /> <Using Include="System.Runtime.InteropServices" />
<Using Include="Newtonsoft.Json" />
<Using Include="Newtonsoft.Json.Linq" />
<Using Include="MeloongCore" /> <Using Include="MeloongCore" />
<Using Include="MeloongCore.Extensions" /> <Using Include="MeloongCore.Extensions" />
<Using Include="MeloongCore.Wpf" /> <Using Include="MeloongCore.Wpf" />
@@ -50,4 +53,16 @@
<Optimize>True</Optimize> <Optimize>True</Optimize>
</PropertyGroup> </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> </Project>
+1 -1
View File
@@ -1,4 +1,4 @@
namespace PCLCS; namespace PCLCS;
public static class Resource { public static class Resource {
/// <summary> /// <summary>
File diff suppressed because one or more lines are too long
+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}";
}
+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="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:behaviors="clr-namespace:PCL.Controls.Behaviors" xmlns:behaviors="clr-namespace:PCL.Controls.Behaviors"
@@ -132,33 +132,6 @@
<Setter Property="FontFamily" Value="Resources/#PCL English, Microsoft YaHei UI" /> <Setter Property="FontFamily" Value="Resources/#PCL English, Microsoft YaHei UI" />
</Style> </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 --> <!-- ScrollViewer -->
<Style x:Key="MyThumb" TargetType="Thumb"> <Style x:Key="MyThumb" TargetType="Thumb">
<Setter Property="Stylus.IsPressAndHoldEnabled" Value="false"/> <Setter Property="Stylus.IsPressAndHoldEnabled" Value="false"/>
@@ -287,7 +260,7 @@
<Setter Property="Template"> <Setter Property="Template">
<Setter.Value> <Setter.Value>
<ControlTemplate TargetType="local:MyTextBox"> <ControlTemplate TargetType="local:MyTextBox">
<Grid SnapsToDevicePixels="True" ToolTip="{TemplateBinding ToolTip}"> <Grid SnapsToDevicePixels="True">
<Grid.RowDefinitions> <Grid.RowDefinitions>
<RowDefinition MinHeight="28" /> <RowDefinition MinHeight="28" />
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
@@ -473,11 +446,6 @@
</Style> </Style>
<Style TargetType="ComboBoxItem" x:Key="MyComboBoxItem"> <Style TargetType="ComboBoxItem" x:Key="MyComboBoxItem">
<Setter Property="OverridesDefaultStyle" Value="True" /> <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="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="Background" Value="{StaticResource ColorBrushTransparent}" /> <Setter Property="Background" Value="{StaticResource ColorBrushTransparent}" />
<Setter Property="Template"> <Setter Property="Template">
+20 -21
View File
@@ -1,4 +1,4 @@
Imports System.Reflection Imports System.Reflection
Imports System.Windows.Threading Imports System.Windows.Threading
Imports Microsoft.Win32 Imports Microsoft.Win32
@@ -7,6 +7,10 @@ Public Class Application
'开始 '开始
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
Try 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 Thread.CurrentThread.Priority = ThreadPriority.Highest
'执行开发版测试 '执行开发版测试
@@ -64,12 +68,12 @@ Public Class Application
End If End If
'初始化文件结构 '初始化文件结构
Try Try
DirectoryUtils.Create(PathExeFolder & "PCL\Pictures\") DirectoryUtils.Create(Paths.Base & "PCL\Pictures\")
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\") DirectoryUtils.Create(Paths.Base & "PCL\Musics\")
CheckPermissionWithException(PathExeFolder & "PCL\") CheckPermissionWithException(Paths.Base & "PCL\")
Catch ex As Exception Catch ex As Exception
MsgBox($"PCL 没有对当前文件夹的权限({PathExeFolder}PCL\),请尝试:" & vbCrLf & MsgBox($"PCL 没有对当前文件夹的权限({Paths.Base}PCL\),请尝试:" & vbCrLf &
"1. 将 PCL 移动到其他文件夹" & If(PathExeFolder.StartsWithF("C:", True), ",例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf & "1. 将 PCL 移动到其他文件夹" & If(Paths.Base.StartsWithF("C:", True), ",例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
"2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf & "2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。", "3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误") MsgBoxStyle.Critical, "运行环境错误")
@@ -90,16 +94,11 @@ RetryCacheCheck:
End If End If
End Try End Try
DirectoryUtils.Create(PathTemp & "Cache\") DirectoryUtils.Create(PathTemp & "Cache\")
DirectoryUtils.Create(PathAppdata) DirectoryUtils.Create(Paths.AppDataThenName)
'要求单例 '要求单例
WaitingMutex(e) WaitingMutex(e)
'设置 ToolTipService 默认值 '设置 ToolTipService 默认值
ToolTipService.InitialShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(300)) ToolTipService.InitialShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(100))
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))
'设置网络配置默认值 '设置网络配置默认值
ServicePointManager.Expect100Continue = False ServicePointManager.Expect100Continue = False
ServicePointManager.DefaultConnectionLimit = 10000 ServicePointManager.DefaultConnectionLimit = 10000
@@ -114,8 +113,7 @@ RetryCacheCheck:
FrmStart = New SplashScreen("Images\icon.ico") FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True) FrmStart.Show(False, True)
End If 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}")})") Logger.Info($"程序版本:{VersionDisplay} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
If BuildType = BuildTypes.Snapshot Then If BuildType = BuildTypes.Snapshot Then
Logger.Info($"识别码:{Identify}{If(ThemeCheckOne(9), ",已解锁反馈主题", ",未解锁反馈主题")}") Logger.Info($"识别码:{Identify}{If(ThemeCheckOne(9), ",已解锁反馈主题", ",未解锁反馈主题")}")
@@ -124,14 +122,15 @@ RetryCacheCheck:
End If End If
Logger.Info($"程序路径:{PathExe}") Logger.Info($"程序路径:{PathExe}")
Logger.Info($"系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})") 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) MyMsgBox("请将 PCL 从压缩包中解压后再使用!" & vbCrLf & "如果不会解压,可以在网上寻找教程。", "需要解压!", "我知道了", IsWarn:=True, ForceWait:=True)
FormMain.EndProgramForce(ProcessReturnValues.Cancel) FormMain.EndProgramForce(ProcessReturnValues.Cancel)
End If End If
If Is32BitSystem Then If Not Environment.Is64BitOperatingSystem Then
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True) MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,请重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True, ForceWait:=True)
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
End If End If
'计时 '计时
Logger.Info($"第一阶段加载用时:{GetTimeMs() - ApplicationStartTick} ms") Logger.Info($"第一阶段加载用时:{GetTimeMs() - ApplicationStartTick} ms")
@@ -219,7 +218,7 @@ RetryCacheCheck:
'动态 DLL 加载 '动态 DLL 加载
Private Sub New() '这里必须尽早调用,且不能使用任何库,否则加载 MeloongCore 就会导致崩溃 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) '缓存 Static LoadedAssemblies As New ConcurrentDictionary(Of String, Lazy(Of Assembly))(StringComparer.Ordinal) '缓存
AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddHandler AppDomain.CurrentDomain.AssemblyResolve,
Function(sender As Object, Args As ResolveEventArgs) As Assembly Function(sender As Object, Args As ResolveEventArgs) As Assembly
@@ -251,7 +250,7 @@ RetryCacheCheck:
Select Case Settings.Get(Of McLoginType)("LoginType") Select Case Settings.Get(Of McLoginType)("LoginType")
Case McLoginType.Ms 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) MsJson.Remove(sender.Tag)
Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None)) Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0 If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0
@@ -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 ' Original Source: MaaAssistantArknights project - https://github.com/MaaAssistantArknights/MaaAssistantArknights
' License: Apache License 2.0 (this file only) ' License: Apache License 2.0 (this file only)
' '
@@ -15,12 +15,6 @@
' '
' Date: 2025-07-03 ' 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 Namespace Controls.Behaviors
Public NotInheritable Class ClipboardInterceptor Public NotInheritable Class ClipboardInterceptor
Private Sub New() Private Sub New()
@@ -71,7 +65,8 @@ Namespace Controls.Behaviors
Try Try
Forms.Clipboard.Clear() Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(tb.SelectedText, True) Forms.Clipboard.SetDataObject(tb.SelectedText, True)
Catch Catch ex As Exception
Logger.Warn(ex, "复制失败,请稍后再试", LogBehavior.Toast)
End Try End Try
e.Handled = True e.Handled = True
@@ -84,7 +79,8 @@ Namespace Controls.Behaviors
Try Try
Forms.Clipboard.Clear() Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(tb.SelectedText, True) Forms.Clipboard.SetDataObject(tb.SelectedText, True)
Catch Catch ex As Exception
Logger.Warn(ex, "剪切失败,请稍后再试", LogBehavior.Toast)
End Try End Try
tb.SelectedText = String.Empty tb.SelectedText = String.Empty
@@ -95,6 +91,7 @@ Namespace Controls.Behaviors
Dim tb = TryCast(sender, TextBox) Dim tb = TryCast(sender, TextBox)
If tb Is Nothing Then Return If tb Is Nothing Then Return
Try
If Forms.Clipboard.ContainsText() Then If Forms.Clipboard.ContainsText() Then
Dim pasteText = Forms.Clipboard.GetText() Dim pasteText = Forms.Clipboard.GetText()
@@ -107,6 +104,9 @@ Namespace Controls.Behaviors
tb.CaretIndex = start + pasteText.Length tb.CaretIndex = start + pasteText.Length
tb.SelectionLength = 0 tb.SelectionLength = 0
End If End If
Catch ex As Exception
Logger.Warn(ex, "粘贴失败,请稍后再试", LogBehavior.Toast)
End Try
e.Handled = True e.Handled = True
End Sub End Sub
@@ -121,7 +121,8 @@ Namespace Controls.Behaviors
Try Try
Forms.Clipboard.Clear() Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(textRange.Text, True) Forms.Clipboard.SetDataObject(textRange.Text, True)
Catch Catch ex As Exception
Logger.Warn(ex, "复制失败,请稍后再试", LogBehavior.Toast)
End Try End Try
e.Handled = True e.Handled = True
@@ -137,7 +138,8 @@ Namespace Controls.Behaviors
Try Try
Forms.Clipboard.Clear() Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(selection.Text, True) Forms.Clipboard.SetDataObject(selection.Text, True)
Catch Catch ex As Exception
Logger.Warn(ex, "剪切失败,请稍后再试", LogBehavior.Toast)
End Try End Try
selection.Text = String.Empty selection.Text = String.Empty
@@ -148,6 +150,7 @@ Namespace Controls.Behaviors
Dim rtb = TryCast(sender, RichTextBox) Dim rtb = TryCast(sender, RichTextBox)
If rtb Is Nothing Then Return If rtb Is Nothing Then Return
Try
If Not Forms.Clipboard.ContainsText() Then Return If Not Forms.Clipboard.ContainsText() Then Return
Dim pasteText = Forms.Clipboard.GetText() Dim pasteText = Forms.Clipboard.GetText()
@@ -158,6 +161,9 @@ Namespace Controls.Behaviors
Dim caretPos = selection.End Dim caretPos = selection.End
rtb.CaretPosition = caretPos rtb.CaretPosition = caretPos
rtb.Selection.Select(caretPos, caretPos) rtb.Selection.Select(caretPos, caretPos)
Catch ex As Exception
Logger.Warn(ex, "粘贴失败,请稍后再试", LogBehavior.Toast)
End Try
e.Handled = True e.Handled = True
End Sub End Sub
@@ -183,7 +189,8 @@ Namespace Controls.Behaviors
Try Try
Forms.Clipboard.Clear() Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(sbStr, True) Forms.Clipboard.SetDataObject(sbStr, True)
Catch Catch ex As Exception
Logger.Warn(ex, "复制失败,请稍后再试", LogBehavior.Toast)
End Try End Try
e.Handled = True e.Handled = True
@@ -1,4 +1,4 @@
Imports System.Windows.Threading Imports System.Windows.Threading
''' <summary> ''' <summary>
''' 指示页面可以通过按下 F5 或以其他方式刷新。 ''' 指示页面可以通过按下 F5 或以其他方式刷新。
@@ -1,4 +1,4 @@
Public Class LazyLoadBehavior Public Class LazyLoadBehavior
''' <summary> ''' <summary>
''' 指定首次进入 ScrollViewer 的可视范围时执行的操作。 ''' 指定首次进入 ScrollViewer 的可视范围时执行的操作。
@@ -1,4 +1,4 @@
<Border x:Class="MyButton" <Border x:Class="MyButton"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
FocusVisualStyle="{x:Null}" x:Name="PanBack" FocusVisualStyle="{x:Null}" x:Name="PanBack"
@@ -1,4 +1,4 @@
Imports System.Windows.Markup Imports System.Windows.Markup
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
Public Class MyButton Public Class MyButton
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyCard Public Class MyCard
'控件 '控件
Inherits Grid Inherits Grid
@@ -1,4 +1,4 @@
<Grid <Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" 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" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d" x:Class="MyCheckBox"
@@ -1,4 +1,4 @@
Imports System.Windows.Markup Imports System.Windows.Markup
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
Public Class MyCheckBox Public Class MyCheckBox
@@ -1,4 +1,4 @@
Public Class MyComboBox Public Class MyComboBox
Inherits ComboBox Inherits ComboBox
Implements ISettingControl Implements ISettingControl
Public Event TextChanged(sender As Object, e As TextChangedEventArgs) 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 Private Sub MyComboBox_DropDownOpened(sender As Object, e As EventArgs) Handles Me.DropDownOpened
RealWidth = Width RealWidth = Width
Width = ActualWidth Width = ActualWidth
'将下拉菜单透明度与主窗口同步
Try Try
CType(Template.FindName("PanPopup", Me), Grid).Opacity = FrmMain.Opacity CType(Template.FindName("PanPopup", Me), Grid).Opacity = FrmMain.Opacity
Catch ex As Exception Catch ex As Exception
@@ -1,4 +1,4 @@
Public Class MyComboBoxItem Public Class MyComboBoxItem
Inherits ComboBoxItem Inherits ComboBoxItem
'基础 '基础
@@ -1,4 +1,4 @@
Public Class MyDropShadow Public Class MyDropShadow
Inherits Decorator Inherits Decorator
''' <summary> ''' <summary>
@@ -1,8 +1,8 @@
<Grid <Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" 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" 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> <Grid.RenderTransform>
<ScaleTransform ScaleX="0" ScaleY="0" /> <ScaleTransform ScaleX="0" ScaleY="0" />
</Grid.RenderTransform> </Grid.RenderTransform>
@@ -1,4 +1,4 @@
Public Class MyExtraButton Public Class MyExtraButton
'声明 '声明
Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件 Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
@@ -1,10 +1,10 @@
<Grid <Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:local="clr-namespace:PCL"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 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" 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> <Grid.RenderTransform>
<ScaleTransform ScaleX="0" ScaleY="0" /> <ScaleTransform ScaleX="0" ScaleY="0" />
</Grid.RenderTransform> </Grid.RenderTransform>
@@ -1,4 +1,4 @@
Imports System.Windows.Markup Imports System.Windows.Markup
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
Public Class MyExtraTextButton Public Class MyExtraTextButton
+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="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:local="clr-namespace:PCL"
@@ -11,6 +11,6 @@
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<TextBlock IsHitTestVisible="False" x:Name="LabText" LineHeight="16" Margin="0,0,0,-1" Padding="12,9" VerticalAlignment="Center" TextWrapping="Wrap" /> <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" <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> </Grid>
</Border> </Border>
@@ -1,4 +1,4 @@
Imports System.Windows.Markup Imports System.Windows.Markup
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
Public Class MyHint Public Class MyHint
@@ -1,7 +1,7 @@
<Border x:Class="MyIconButton" <Border x:Class="MyIconButton"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" 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"> <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 x:Name="Path" Stretch="Uniform" Margin="5" RenderTransformOrigin="0.5,0.5">
<Path.RenderTransform> <Path.RenderTransform>
@@ -1,4 +1,4 @@
Imports System.Windows.Shapes Imports System.Windows.Shapes
Public Class MyIconButton Public Class MyIconButton
@@ -52,7 +52,9 @@ Public Class MyIconButton
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行) '鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsMouseDown As Boolean = False Private IsMouseDown As Boolean = False
Public Property CanClick As Boolean = True
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not CanClick Then Return
If Not IsMouseDown Then Return If Not IsMouseDown Then Return
Logger.Info($"按下图标按钮{If(String.IsNullOrEmpty(Name), "", ":" & Name)}") Logger.Info($"按下图标按钮{If(String.IsNullOrEmpty(Name), "", ":" & Name)}")
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
@@ -61,12 +63,14 @@ Public Class MyIconButton
RaiseCustomEvent() '自定义事件 RaiseCustomEvent() '自定义事件
End Sub End Sub
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
If Not CanClick Then Return
IsMouseDown = True IsMouseDown = True
Focus() Focus()
'指向 '指向
AniStart(AaScaleTransform(PanBack, 0.8 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 400,, New AniEaseOutFluent(AniEasePower.Strong)), "MyIconButton Scale " & Uuid) AniStart(AaScaleTransform(PanBack, 0.8 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 400,, New AniEaseOutFluent(AniEasePower.Strong)), "MyIconButton Scale " & Uuid)
End Sub End Sub
Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp
If Not CanClick Then Return
If IsMouseDown Then If IsMouseDown Then
IsMouseDown = False IsMouseDown = False
AniStart({ AniStart({
@@ -77,6 +81,7 @@ Public Class MyIconButton
RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub End Sub
Private Sub Button_MouseLeave() Handles Me.MouseLeave Private Sub Button_MouseLeave() Handles Me.MouseLeave
If Not CanClick Then Return
IsMouseDown = False IsMouseDown = False
AniStart({ AniStart({
AaScaleTransform(PanBack, 1 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 250,, New AniEaseOutFluent) AaScaleTransform(PanBack, 1 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 250,, New AniEaseOutFluent)
@@ -87,10 +92,9 @@ Public Class MyIconButton
'务必放在 IsMouseDown 更新之后 '务必放在 IsMouseDown 更新之后
Private Const AnimationColorIn As Integer = 120 Private Const AnimationColorIn As Integer = 120
Private Const AnimationColorOut As Integer = 150 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 Try
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255) If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255)
If Path.Fill Is Nothing Then If Path.Fill Is Nothing Then
Select Case Theme Select Case Theme
@@ -102,9 +106,10 @@ Public Class MyIconButton
Path.Fill = New MyColor(160, Foreground) Path.Fill = New MyColor(160, Foreground)
End Select End Select
End If 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 Select Case Theme
Case Themes.Color Case Themes.Color
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush2", AnimationColorIn)) AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush2", AnimationColorIn))
@@ -117,10 +122,7 @@ Public Class MyIconButton
Case Themes.Custom Case Themes.Custom
AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(255, Foreground) - Path.Fill, AnimationColorIn)) AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(255, Foreground) - Path.Fill, AnimationColorIn))
End Select End Select
AniStart(AnimList, "MyIconButton Color " & Uuid) Else '普通
Else
'普通
Dim AnimList As New List(Of AniData)
Select Case Theme Select Case Theme
Case Themes.Color Case Themes.Color
AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush4", AnimationColorOut)) AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush4", AnimationColorOut))
@@ -138,12 +140,11 @@ Public Class MyIconButton
AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(160, Foreground) - Path.Fill, AnimationColorOut)) AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(160, Foreground) - Path.Fill, AnimationColorOut))
PanBack.Background = New MyColor(0, 255, 255, 255) PanBack.Background = New MyColor(0, 255, 255, 255)
End Select End Select
AniStart(AnimList, "MyIconButton Color " & Uuid)
End If End If
AniStart(AnimList, "MyIconButton Color " & Uuid)
Else Else
AniStop("MyIconButton Color " & Uuid) AniStop("MyIconButton Color " & Uuid)
If IsEnabled Then
Select Case Theme Select Case Theme
Case Themes.Color Case Themes.Color
Path.SetResourceReference(Shape.FillProperty, "ColorBrush5") Path.SetResourceReference(Shape.FillProperty, "ColorBrush5")
@@ -156,8 +157,10 @@ Public Class MyIconButton
Case Themes.Custom Case Themes.Custom
Path.Fill = New MyColor(160, Foreground) Path.Fill = New MyColor(160, Foreground)
End Select End Select
Else
Path.SetResourceReference(Shape.FillProperty, "ColorBrushGray5")
End If
PanBack.Background = New MyColor(0, 255, 255, 255) PanBack.Background = New MyColor(0, 255, 255, 255)
End If End If
Catch ex As Exception Catch ex As Exception
Logger.Warn(ex, "刷新图标按钮动画状态出错") Logger.Warn(ex, "刷新图标按钮动画状态出错")
@@ -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="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27"> HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">
@@ -1,4 +1,4 @@
Imports System.Windows.Markup Imports System.Windows.Markup
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
Public Class MyIconTextButton Public Class MyIconTextButton
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyImage Public Class MyImage
Inherits Image Inherits Image
#Region "公开属性" #Region "公开属性"
@@ -1,4 +1,4 @@
<Grid x:Class="MyListItem" <Grid x:Class="MyListItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
x:Name="PanBack" x:Name="PanBack"
@@ -1,4 +1,4 @@
Imports System.Windows.Markup Imports System.Windows.Markup
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
Public Class MyListItem Public Class MyListItem
@@ -312,7 +312,8 @@ Public Class MyListItem
Else Else
'添加竖条控件 '添加竖条控件
If IsNothing(RectCheck) Then 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), .VerticalAlignment = If(Checked, VerticalAlignment.Stretch, VerticalAlignment.Center),
.HorizontalAlignment = HorizontalAlignment.Left, .UseLayoutRounding = False, .SnapsToDevicePixels = False, .HorizontalAlignment = HorizontalAlignment.Left, .UseLayoutRounding = False, .SnapsToDevicePixels = False,
.Margin = If(Checked, New Thickness(-1, 6, 0, 6), New Thickness(-1, 0, 0, 0))} .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 Private StateLast As String
Public IsMouseOverAnimationEnabled As Boolean = True 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 If ContentHandler IsNot Nothing Then
ContentHandler(Me, e) ContentHandler(Me, e)
@@ -1,4 +1,4 @@
<Grid <Grid
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" 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" 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}"> MinWidth="50" MinHeight="50" Background="{StaticResource ColorBrushSemiTransparent}">
@@ -1,4 +1,4 @@
Imports PCL.MyLoading Imports PCL.MyLoading
Public Class MyLoading Public Class MyLoading
@@ -76,7 +76,8 @@ Public Class MyLoading
If Ex Is Nothing Then If Ex Is Nothing Then
LabText.Text = "未知错误" LabText.Text = "未知错误"
Else Else
LabText.Text = If(Ex.IsBadNetwork(), "网络环境不佳,请稍后再试,或使用 VPN 改善网络环境", Ex.GetDisplay(False)) Ex = Ex.RootException()
LabText.Text = If(Ex.IsBadNetwork(), "网络环境不佳,请稍后再试,或使用 VPN 改善网络环境", Ex.Message)
End If End If
Else Else
LabText.Text = TextError LabText.Text = TextError
@@ -1,4 +1,4 @@
Public Class MyMenuItem Public Class MyMenuItem
Inherits MenuItem Inherits MenuItem
Private Sub MyMenuItem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded 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) If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon)
End If End If
'对父级设置透明度 '对父级设置透明度
If TypeOf Parent Is ContextMenu Then
CType(Parent, ContextMenu).Opacity = Settings.Get(Of Integer)("UiLauncherTransparent") / 1000 + 0.4 CType(Parent, ContextMenu).Opacity = Settings.Get(Of Integer)("UiLauncherTransparent") / 1000 + 0.4
End If
End Sub End Sub
'基础 '基础
@@ -1,4 +1,4 @@
<Grid x:Class="MyMsgInput" <Grid x:Class="MyMsgInput"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL" xmlns:my="clr-namespace:PCL"
@@ -1,4 +1,4 @@
Public Class MyMsgInput Public Class MyMsgInput
Private ReadOnly MyConverter As MyMsgBoxConverter Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid() Private ReadOnly Uuid As Integer = GetUuid()
@@ -1,4 +1,4 @@
<Grid x:Class="MyMsgSelect" <Grid x:Class="MyMsgSelect"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL" xmlns:my="clr-namespace:PCL"
@@ -1,4 +1,4 @@
Public Class MyMsgSelect Public Class MyMsgSelect
Private ReadOnly MyConverter As MyMsgBoxConverter Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid() Private ReadOnly Uuid As Integer = GetUuid()
@@ -1,4 +1,4 @@
<Grid x:Class="MyMsgText" <Grid x:Class="MyMsgText"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL" xmlns:my="clr-namespace:PCL"
@@ -1,4 +1,4 @@
Public Class MyMsgText Public Class MyMsgText
Private ReadOnly MyConverter As MyMsgBoxConverter Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid() Private ReadOnly Uuid As Integer = GetUuid()
@@ -1,4 +1,4 @@
Public Class MyPageLeft Public Class MyPageLeft
Inherits Grid Inherits Grid
Private Uuid As Integer = GetUuid() Private Uuid As Integer = GetUuid()
@@ -1,4 +1,4 @@
Public Class MyPageRight Public Class MyPageRight
Inherits AdornerDecorator Inherits AdornerDecorator
Public PageUuid As Integer = GetUuid() Public PageUuid As Integer = GetUuid()
@@ -153,7 +153,7 @@
'重试 '重试
Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试 Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
If Not PageLoaderAutoRun Then Return 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) PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
Else Else
If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke() If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
@@ -175,7 +175,7 @@
RaiseEvent PageEnter() RaiseEvent PageEnter()
Select Case PageState Select Case PageState
Case PageStates.Empty 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 '如果加载器在进入页面时不启动(例如联机),那么在此时就会有 State = Waiting
PageState = PageStates.ContentEnter PageState = PageStates.ContentEnter
TriggerEnterAnimation(PanAlways, If(PanContent, Child)) TriggerEnterAnimation(PanAlways, If(PanContent, Child))
@@ -188,7 +188,7 @@
End If End If
Case PageStates.ContentExit Case PageStates.ContentExit
'和上面的一样,但是不管 PanAlways '和上面的一样,但是不管 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 PageState = PageStates.ContentEnter
TriggerEnterAnimation(If(PanContent, Child)) TriggerEnterAnimation(If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then ElseIf PageLoader.State = LoadState.Loading Then
@@ -364,9 +364,9 @@
Case PageStates.LoaderExit Case PageStates.LoaderExit
PageState = PageStates.ContentExit PageState = PageStates.ContentExit
End Select 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 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 '需要从 LoaderWait 切换到 ContentEnter,或从 LoaderStay 切换到 LoaderExit
Select Case PageState Select Case PageState
@@ -1,4 +1,4 @@
<Grid x:Class="MyRadioBox" <Grid x:Class="MyRadioBox"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
FocusVisualStyle="{x:Null}" FocusVisualStyle="{x:Null}"
@@ -1,4 +1,4 @@
Imports System.Windows.Markup Imports System.Windows.Markup
Imports System.Windows.Shapes Imports System.Windows.Shapes
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
@@ -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="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27"> HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">
@@ -1,4 +1,4 @@
Imports System.Windows.Markup Imports System.Windows.Markup
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
Public Class MyRadioButton Public Class MyRadioButton
+1 -1
View File
@@ -1,4 +1,4 @@
Imports System.Runtime.InteropServices Imports System.Runtime.InteropServices
Imports System.Windows.Interop Imports System.Windows.Interop
Imports System.Windows.Threading Imports System.Windows.Threading
@@ -1,4 +1,4 @@
Public Class MyScrollBar Public Class MyScrollBar
Inherits Primitives.ScrollBar Inherits Primitives.ScrollBar
'基础 '基础
@@ -1,9 +1,8 @@
Public Class MyScrollViewer Public Class MyScrollViewer
Inherits ScrollViewer Inherits ScrollViewer
Public Property DeltaMult As Double = 1 Public Property DeltaMult As Double = 1
Private RealOffset As Double Private RealOffset As Double
Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel 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 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(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse (GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType) 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 Return
End If End If
@@ -1,4 +1,4 @@
<local:MyCard x:Class="MySearchBox" <local:MyCard x:Class="MySearchBox"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
@@ -1,4 +1,4 @@
Class MySearchBox Class MySearchBox
Inherits MyCard Inherits MyCard
Public Event TextChanged(sender As Object, e As EventArgs) Public Event TextChanged(sender As Object, e As EventArgs)
@@ -1,4 +1,4 @@
<Border x:Class="MySlider" <Border x:Class="MySlider"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
@@ -1,4 +1,4 @@
Imports System.Windows.Shapes Imports System.Windows.Shapes
Public Class MySlider Public Class MySlider
Implements ISettingControl Implements ISettingControl
@@ -1,4 +1,4 @@
<Border x:Class="MySliderDot" <Border x:Class="MySliderDot"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
@@ -1,4 +1,4 @@
Public Class MySliderDot Public Class MySliderDot
'基础 '基础
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class MyTextBox Public Class MyTextBox
Inherits TextBox Inherits TextBox
Implements ISettingControl Implements ISettingControl
@@ -1,4 +1,4 @@
Public Class MyTextButton Public Class MyTextButton
Inherits Label Inherits Label
Public Event Click(sender As Object, e As EventArgs) Public Event Click(sender As Object, e As EventArgs)
@@ -1,4 +1,4 @@
Public Class MyVirtualizingElement(Of T As FrameworkElement) Public Class MyVirtualizingElement(Of T As FrameworkElement)
Inherits FrameworkElement Inherits FrameworkElement
Private Initializer As Func(Of T) Private Initializer As Func(Of T)
@@ -58,7 +58,7 @@ Public Class MyVirtualizingElement
''' 如果类型错误,则返回原值。 ''' 如果类型错误,则返回原值。
''' </summary> ''' </summary>
Public Shared Function TryInit(Element As FrameworkElement) As FrameworkElement 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() Return CType(Element, Object).Init()
ElseIf TypeOf Element Is MyVirtualizingElement Then ElseIf TypeOf Element Is MyVirtualizingElement Then
Return CType(Element, MyVirtualizingElement).Init() Return CType(Element, MyVirtualizingElement).Init()
+1 -1
View File
@@ -1,4 +1,4 @@
<Window <Window
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:local="clr-namespace:PCL"
+46 -26
View File
@@ -1,4 +1,4 @@
Imports System.ComponentModel Imports System.ComponentModel
Imports System.Windows.Interop Imports System.Windows.Interop
Public Class FormMain Public Class FormMain
@@ -11,6 +11,14 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目 '统计更新日志条目
If BuildType = BuildTypes.Release Then 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 If LastVersion < 404 Then 'Release 2.12.8.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:Windows 7 无法正常联网")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:Windows 7 无法正常联网"))
FeatureCount += 1 FeatureCount += 1
@@ -79,6 +87,14 @@ Public Class FormMain
'3:BUG+ IMP* FEAT- '3:BUG+ IMP* FEAT-
'2:BUG* IMP- '2:BUG* IMP-
'1:BUG- '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 If LastVersion < 403 Then 'Snapshot 2.12.8.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:Windows 7 无法正常联网")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:Windows 7 无法正常联网"))
FeatureCount += 1 FeatureCount += 1
@@ -256,7 +272,7 @@ Public Class FormMain
InitializeComponent() InitializeComponent()
Opacity = 0 Opacity = 0
'开启管理员权限下的文件拖拽 '开启管理员权限下的文件拖拽
If SystemUtils.HasAdminRole() Then If WindowsUtils.HasAdminRole() Then
Static Helper As New DragHelper Static Helper As New DragHelper
AddHandler SourceInitialized, AddHandler SourceInitialized,
Sub() Sub()
@@ -367,7 +383,7 @@ Public Class FormMain
End If End If
'启动加载器池 '启动加载器池
Try Try
JavaListInit() '延后到同意协议后再执行,避免在初次启动时进行进程操作 JavaInit() '延后到同意协议后再执行,避免在初次启动时进行进程操作
Thread.Sleep(100) Thread.Sleep(100)
DlClientListMojangLoader.Start(1) 'PCL 会同时根据这里的加载结果决定是否使用官方源进行下载 DlClientListMojangLoader.Start(1) 'PCL 会同时根据这里的加载结果决定是否使用官方源进行下载
RunCountSub() RunCountSub()
@@ -378,7 +394,7 @@ Public Class FormMain
End Try End Try
'清理自动更新文件 '清理自动更新文件
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 Catch ex As Exception
Logger.Warn(ex, "清理自动更新文件失败") Logger.Warn(ex, "清理自动更新文件失败")
End Try End Try
@@ -415,17 +431,17 @@ Public Class FormMain
Logger.Info($"版本号从 {LastVersionCode} 升高到 {VersionCode}") Logger.Info($"版本号从 {LastVersionCode} 升高到 {VersionCode}")
Settings.Set("SystemLastVersionReg", VersionCode) Settings.Set("SystemLastVersionReg", VersionCode)
'检查有记录的最高版本号 '检查有记录的最高版本号
Dim LowerVersionCode As Integer Dim HighestVersionCode As Integer
Const SettingKey = If(BuildType = BuildTypes.Snapshot, "SystemHighestAlphaVersionReg", "SystemHighestBetaVersionReg") Const SettingKey = If(BuildType = BuildTypes.Snapshot, "SystemHighestAlphaVersionReg", "SystemHighestBetaVersionReg")
LowerVersionCode = Settings.Get(Of Integer)("SystemHighestAlphaVersionReg") HighestVersionCode = Settings.Get(Of Integer)(SettingKey)
If LowerVersionCode < VersionCode Then If HighestVersionCode < VersionCode Then
Settings.Set(SettingKey, VersionCode) Settings.Set(SettingKey, VersionCode)
Logger.Info($"最高版本号从 {LowerVersionCode} 升高到 {VersionCode}") Logger.Info($"最高版本号从 {HighestVersionCode} 升高到 {VersionCode}")
End If End If
'被移除的窗口设置选项 '被移除的窗口设置选项
If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 5 Then Settings.Set("LaunchArgumentWindowType", 1) 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"} 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)("UiLauncherThemeHide").ToString.Split("|")))
UnlockedTheme.AddRange(New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|"))) UnlockedTheme.AddRange(New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|")))
@@ -448,12 +464,12 @@ Public Class FormMain
"多谢各位的理解啦!", "重新解锁提醒") "多谢各位的理解啦!", "重新解锁提醒")
End If End If
'移动自定义皮肤 '移动自定义皮肤
If LastVersionCode <= 161 AndAlso FileUtils.Exists(PathExeFolder & "PCL\CustomSkin.png") AndAlso Not FileUtils.Exists(PathAppdata & "CustomSkin.png") Then If LastVersionCode <= 161 AndAlso FileUtils.Exists(Paths.Base & "PCL\CustomSkin.png") AndAlso Not FileUtils.Exists(Paths.AppDataThenName & "CustomSkin.png") Then
FileUtils.Copy(PathExeFolder & "PCL\CustomSkin.png", PathAppdata & "CustomSkin.png") FileUtils.Copy(Paths.Base & "PCL\CustomSkin.png", Paths.AppDataThenName & "CustomSkin.png")
Logger.Info("已移动离线自定义皮肤 (162)") Logger.Info("已移动离线自定义皮肤 (162)")
End If End If
If LastVersionCode <= 263 AndAlso FileUtils.Exists(PathTemp & "CustomSkin.png") AndAlso Not FileUtils.Exists(PathAppdata & "CustomSkin.png") Then If LastVersionCode <= 263 AndAlso FileUtils.Exists(PathTemp & "CustomSkin.png") AndAlso Not FileUtils.Exists(Paths.AppDataThenName & "CustomSkin.png") Then
FileUtils.Copy(PathTemp & "CustomSkin.png", PathAppdata & "CustomSkin.png") FileUtils.Copy(PathTemp & "CustomSkin.png", Paths.AppDataThenName & "CustomSkin.png")
Logger.Info("已移动离线自定义皮肤 (264)") Logger.Info("已移动离线自定义皮肤 (264)")
End If End If
'解除帮助页面的隐藏 '解除帮助页面的隐藏
@@ -484,8 +500,8 @@ Public Class FormMain
End If End If
'输出更新日志 '输出更新日志
If LastVersionCode <= 0 Then Return If LastVersionCode <= 0 Then Return
If LowerVersionCode >= VersionCode Then Return If HighestVersionCode >= VersionCode Then Return
ShowUpdateLog(LowerVersionCode) ShowUpdateLog(HighestVersionCode)
End Sub End Sub
Private Sub DowngradeSub(LastVersionCode As Integer) Private Sub DowngradeSub(LastVersionCode As Integer)
Logger.Info($"版本号从 {LastVersionCode} 降低到 {VersionCode}") Logger.Info($"版本号从 {LastVersionCode} 降低到 {VersionCode}")
@@ -513,7 +529,7 @@ Public Class FormMain
Sub() Sub()
Logger.Info("正在强行停止任务") Logger.Info("正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToList() For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Interrupt() Task.Cancel()
Next Next
End Sub, "强行停止下载任务") End Sub, "强行停止下载任务")
End If End If
@@ -562,11 +578,12 @@ Public Class FormMain
FeedbackInfo() FeedbackInfo()
Logger.Info("请在 https://github.com/Meloong-Git/PCL/issues 提交错误报告,以便于作者解决此问题!") Logger.Info("请在 https://github.com/Meloong-Git/PCL/issues 提交错误报告,以便于作者解决此问题!")
IsLogShown = True IsLogShown = True
StartProcess(PathExeFolder & "PCL\Log1.txt") StartProcess(Paths.Base & "PCL\Log1.txt")
End If End If
Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉 Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉
End If End If
Logger.Info($"程序已退出,返回值:{ReturnCode}") Logger.Info($"程序已退出,返回值:{ReturnCode}")
ConfigUtils.SaveAll()
Logger.Instance.Flush() Logger.Instance.Flush()
If ReturnCode <> ProcessReturnValues.Success Then Environment.Exit(ReturnCode) If ReturnCode <> ProcessReturnValues.Success Then Environment.Exit(ReturnCode)
Process.GetCurrentProcess.Kill() Process.GetCurrentProcess.Kill()
@@ -716,7 +733,7 @@ Public Class FormMain
FrmSetupUI.PanLogoChange.Visibility = Visibility.Visible FrmSetupUI.PanLogoChange.Visibility = Visibility.Visible
End If End If
Try Try
ImageTitleLogo.Source = PathExeFolder & "PCL\Logo.png" ImageTitleLogo.Source = Paths.Base & "PCL\Logo.png"
Catch ex As Exception Catch ex As Exception
ImageTitleLogo.Source = Nothing ImageTitleLogo.Source = Nothing
Logger.Error(ex, "显示标题栏图片失败", LogBehavior.Alert) Logger.Error(ex, "显示标题栏图片失败", LogBehavior.Alert)
@@ -808,12 +825,16 @@ Public Class FormMain
'切回窗口 '切回窗口
Private Sub FormMain_Activated() Handles Me.Activated Private Sub FormMain_Activated() Handles Me.Activated
'切回窗口时自动刷新
Try Try
If PageCurrent = PageType.InstanceSetup AndAlso PageCurrentSub = PageSubType.InstanceMod Then If PageCurrent = PageType.InstanceSetup AndAlso PageCurrentSub = PageSubType.InstanceMod Then
'Mod 管理自动刷新 'Mod 管理
FrmInstanceMod.ReloadModList() FrmInstanceMod.ReloadModList()
ElseIf PageCurrent = PageType.InstanceSetup AndAlso (PageCurrentSub = PageSubType.InstanceSetup OrElse PageCurrentSub = PageSubType.InstanceExport) Then
'更新当前选用的 Java
PageInstanceLeft.ReloadCurrentJava()
ElseIf PageCurrent = PageType.InstanceSelect Then ElseIf PageCurrent = PageType.InstanceSelect Then
'版本选择自动刷新 '版本选择
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
End If End If
Catch ex As Exception Catch ex As Exception
@@ -883,7 +904,7 @@ Public Class FormMain
'Authlib 拖拽 'Authlib 拖拽
e.Handled = True e.Handled = True
e.Effects = DragDropEffects.Copy 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}") Logger.Info($"Authlib 拖拽:{AuthlibServer}")
If Not String.IsNullOrEmpty(New ValidateHttp().Validate(AuthlibServer)) Then If Not String.IsNullOrEmpty(New ValidateHttp().Validate(AuthlibServer)) Then
Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Red) Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Red)
@@ -977,12 +998,12 @@ Public Class FormMain
Dim Extension As String = FilePath.AfterLast(".").Lower Dim Extension As String = FilePath.AfterLast(".").Lower
If Extension = "xaml" Then If Extension = "xaml" Then
Logger.Info("文件后缀为 XAML,作为主页加载") Logger.Info("文件后缀为 XAML,作为主页加载")
If FileUtils.Exists(PathExeFolder & "PCL\Custom.xaml") Then If FileUtils.Exists(Paths.Base & "PCL\Custom.xaml") Then
If MyMsgBox("已存在一个主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then If MyMsgBox("已存在一个主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then
Return Return
End If End If
End If End If
FileUtils.Copy(FilePath, PathExeFolder & "PCL\Custom.xaml") FileUtils.Copy(FilePath, Paths.Base & "PCL\Custom.xaml")
RunInUi( RunInUi(
Sub() Sub()
Settings.Set("UiCustomType", 1) Settings.Set("UiCustomType", 1)
@@ -999,9 +1020,8 @@ Public Class FormMain
Try Try
ModpackInstall(FilePath) ModpackInstall(FilePath)
Return Return
Catch ex As CancelledException
Return '用户主动取消
Catch ex As Exception Catch ex As Exception
If ex.IsCanceled Then Return
'安装失败,继续往后尝试 '安装失败,继续往后尝试
End Try End Try
End If End If
@@ -1598,7 +1618,7 @@ Public Class FormMain
'关闭 Minecraft '关闭 Minecraft
Public Sub BtnExtraShutdown_Click() Handles BtnExtraShutdown.Click Public Sub BtnExtraShutdown_Click() Handles BtnExtraShutdown.Click
Try Try
If McLaunchLoaderReal IsNot Nothing Then McLaunchLoaderReal.Interrupt() If McLaunchLoaderReal IsNot Nothing Then McLaunchLoaderReal.Cancel()
For Each Watcher In McWatcherList For Each Watcher In McWatcherList
Watcher.Kill() Watcher.Kill()
Next Next
+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. ' attributes that are applied to this project.
' Project-level suppressions either have no target or are given ' Project-level suppressions either have no target or are given
' a specific target and scoped to a namespace, type, member, etc. ' a specific target and scoped to a namespace, type, member, etc.
Binary file not shown.

After

Width:  |  Height:  |  Size: 8.4 KiB

@@ -1,4 +1,4 @@
'动画引擎模块 '动画引擎模块
'使用 Ani 作为方法或属性的开头,使用 Aa 作为单个动画对象的开头(便于自动补全) '使用 Ani 作为方法或属性的开头,使用 Aa 作为单个动画对象的开头(便于自动补全)
Imports System.Windows.Media.Effects Imports System.Windows.Media.Effects
@@ -832,7 +832,12 @@ Public Module ModAnimation
AniCount = 0 AniCount = 0
AniTimer(DeltaTime * AniSpeed) 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 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 If
End Sub) End Sub)
Sleeper: Sleeper:
@@ -1018,7 +1023,7 @@ NextAni:
If Convert.ToInt32(Convert.ToChar(NextText)) >= Convert.ToInt32(Convert.ToChar(128)) Then 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)}) NewText &= Encoding.GetEncoding("GB18030").GetString({RandomInteger(16 + 160, 87 + 160), RandomInteger(1 + 160, 89 + 160)})
Else Else
NewText &= RandomOne("0123456789./*-+\[]{};':/?,!@#$%^&*()_+-=qwwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM".ToCharArray) NewText &= RandomInteger(0, 85).ConvertRadix(86)
End If End If
End If End If
'设置文本 '设置文本
+30 -307
View File
@@ -1,21 +1,17 @@
Imports System.Globalization
Imports System.Runtime.CompilerServices Imports System.Runtime.CompilerServices
Imports System.Security.Cryptography
Imports System.Threading.Tasks
Imports System.Xaml Imports System.Xaml
Imports Newtonsoft.Json
Public Module ModBase Public Module ModBase
#Region "声明" #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 自动替换 Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If RELEASE Then #If RELEASE Then
Public Const VersionCode As Integer = 404 '正式版 Public Const VersionCode As Integer = 406 '正式版
#Else #Else
Public Const VersionCode As Integer = 403 '快照版 Public Const VersionCode As Integer = 405 '快照版
#End If #End If
'版本信息 '版本信息
@@ -41,13 +37,9 @@ Public Module ModBase
''' </summary> ''' </summary>
Public Handle As IntPtr Public Handle As IntPtr
''' <summary> ''' <summary>
''' 程序的启动路径,以 \ 结尾。
''' </summary>
Public PathExeFolder As String = AppDomain.CurrentDomain.SetupInformation.ApplicationBase
''' <summary>
''' 包含程序名的完整路径。 ''' 包含程序名的完整路径。
''' </summary> ''' </summary>
Public PathExe As String = PathExeFolder & AppDomain.CurrentDomain.SetupInformation.ApplicationName Public PathExe As String = Paths.Base & AppDomain.CurrentDomain.SetupInformation.ApplicationName
''' <summary> ''' <summary>
''' 程序内嵌图片文件夹路径,以 / 结尾。 ''' 程序内嵌图片文件夹路径,以 / 结尾。
''' </summary> ''' </summary>
@@ -57,10 +49,6 @@ Public Module ModBase
''' </summary> ''' </summary>
Public PathTemp As String = If(Settings.Get(Of String)("SystemSystemCache") = "", Path.GetTempPath() & "PCL\", Settings.Get(Of String)("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\" Public PathTemp As String = If(Settings.Get(Of String)("SystemSystemCache") = "", Path.GetTempPath() & "PCL\", Settings.Get(Of String)("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\"
''' <summary> ''' <summary>
''' AppData 中的 PCL 文件夹路径,以 \ 结尾。
''' </summary>
Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\PCL\"
''' <summary>
''' 当前程序的语言。 ''' 当前程序的语言。
''' </summary> ''' </summary>
Public Lang As String = "zh_CN" Public Lang As String = "zh_CN"
@@ -81,10 +69,6 @@ Public Module ModBase
''' </summary> ''' </summary>
Public IsProgramEnding As Boolean = False Public IsProgramEnding As Boolean = False
''' <summary> ''' <summary>
''' 是否为 32 位系统。
''' </summary>
Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem
''' <summary>
''' 是否使用 GBK 编码。 ''' 是否使用 GBK 编码。
''' </summary> ''' </summary>
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936 Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
@@ -139,7 +123,7 @@ Public Module ModBase
''' <summary> ''' <summary>
''' 图标按钮,刷新,0.85x ''' 图标按钮,刷新,0.85x
''' </summary> ''' </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> ''' <summary>
''' 图标按钮,软盘,1x ''' 图标按钮,软盘,1x
''' </summary> ''' </summary>
@@ -153,10 +137,18 @@ Public Module ModBase
''' </summary> ''' </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" 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> ''' <summary>
''' 图标按钮,文件夹,1.15x ''' 图标按钮,文件夹,1.1x
''' </summary> ''' </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" 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> ''' <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 ''' 图标按钮,名片,1.1x
''' </summary> ''' </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" 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 Loading
Finished Finished
Failed Failed
Interrupted Canceled
End Enum End Enum
''' <summary> ''' <summary>
@@ -531,7 +523,7 @@ Public Module ModBase
''' </summary> ''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param> ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
Public Sub IniClearCache(FileName As String) 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) IniCache.Remove(FileName)
End Sub End Sub
''' <summary> ''' <summary>
@@ -542,7 +534,7 @@ Public Module ModBase
Private Function IniGetContent(FileName As String) As ConcurrentDictionary(Of String, String) Private Function IniGetContent(FileName As String) As ConcurrentDictionary(Of String, String)
Try 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 Dim Cache As ConcurrentDictionary(Of String, String) = Nothing
If IniCache.TryGetValue(FileName, Cache) Then Return Cache If IniCache.TryGetValue(FileName, Cache) Then Return Cache
@@ -616,9 +608,9 @@ Public Module ModBase
FileContent.Append(Pair.Value) FileContent.Append(Pair.Value)
FileContent.Append(vbCrLf) FileContent.Append(vbCrLf)
Next 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) FileUtils.Write(FileName, FileContent.ToString)
Catch ex As Exception Catch ex As Exception
Logger.Error(ex, $"写入文件失败({FileName} → {Key}:{Value})", LogBehavior.Toast) Logger.Error(ex, $"写入文件失败({FileName} → {Key}:{Value})", LogBehavior.Toast)
@@ -657,142 +649,12 @@ Public Module ModBase
FileUtils.Delete(TestFilePath) FileUtils.Delete(TestFilePath)
End Sub 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 #End Region
#Region "文本" #Region "文本"
Public vbLQ As Char = Convert.ToChar(8220) Public vbLQ As Char = Convert.ToChar(8220)
Public vbRQ As Char = Convert.ToChar(8221) 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> ''' <summary>
''' 不会报错的 Val。 ''' 不会报错的 Val。
''' 如果输入有误,返回 0。 ''' 如果输入有误,返回 0。
@@ -958,7 +820,7 @@ Public Module ModBase
TokenSource.Cancel() TokenSource.Cancel()
Throw New TimeoutException($"任务超时({TimeoutMs} ms)") Throw New TimeoutException($"任务超时({TimeoutMs} ms)")
End If End If
Return TargetTask.GetAwaiter().GetResult() Return TargetTask.Run()
End Function End Function
''' <summary> ''' <summary>
''' 为 Task 设置超时,在超时时抛出 TimeoutException。 ''' 为 Task 设置超时,在超时时抛出 TimeoutException。
@@ -969,7 +831,7 @@ Public Module ModBase
TokenSource.Cancel() TokenSource.Cancel()
Throw New TimeoutException($"任务超时({TimeoutMs} ms)") Throw New TimeoutException($"任务超时({TimeoutMs} ms)")
End If End If
TargetTask.GetAwaiter().GetResult() TargetTask.Run()
End Sub End Sub
''' <summary> ''' <summary>
@@ -977,10 +839,10 @@ Public Module ModBase
''' </summary> ''' </summary>
Public PathPure As String = GetPureASCIIDir() Public PathPure As String = GetPureASCIIDir()
Private Function GetPureASCIIDir() As String Private Function GetPureASCIIDir() As String
If (PathExeFolder & "PCL").IsAsciiOnly() Then If Paths.Base.IsAsciiOnly() Then
Return PathExeFolder & "PCL\" Return Paths.Base & "PCL\"
ElseIf PathAppdata.IsAsciiOnly() Then ElseIf Paths.AppDataThenName.IsAsciiOnly() Then
Return PathAppdata Return Paths.AppDataThenName
ElseIf PathTemp.IsAsciiOnly() Then ElseIf PathTemp.IsAsciiOnly() Then
Return PathTemp Return PathTemp
Else Else
@@ -994,12 +856,6 @@ Public Module ModBase
Public Class RestartException Public Class RestartException
Inherits Exception Inherits Exception
End Class End Class
''' <summary>
''' 指示用户手动取消了操作,或用户已知晓操作被取消的原因。
''' </summary>
Public Class CancelledException
Inherits Exception
End Class
''' <summary> ''' <summary>
''' 以管理员权限运行当前程序,并等待程序运行结束。 ''' 以管理员权限运行当前程序,并等待程序运行结束。
@@ -1011,19 +867,6 @@ Public Module ModBase
Return NewProcess.ExitCode Return NewProcess.ExitCode
End Function 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 Uuid As Integer = 1
Private UuidLock As Object Private UuidLock As Object
''' <summary> ''' <summary>
@@ -1045,79 +888,6 @@ Public Module ModBase
Return Stopwatch.GetTimestamp() \ (Stopwatch.Frequency \ 1000L) Return Stopwatch.GetTimestamp() \ (Stopwatch.Frequency \ 1000L)
End Function End Function
''' <summary> ''' <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 时间戳。 ''' 获取十进制 Unix 时间戳。
''' </summary> ''' </summary>
Public Function GetUnixTimestampUtc() As Long Public Function GetUnixTimestampUtc() As Long
@@ -1165,41 +935,6 @@ Public Module ModBase
Logger.Info($"启动进程:{StartInfo.FileName} {StartInfo.Arguments}") Logger.Info($"启动进程:{StartInfo.FileName} {StartInfo.Arguments}")
Return Process.Start(StartInfo) Return Process.Start(StartInfo)
End Function 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> ''' <summary>
''' 在新的工作线程中执行代码。 ''' 在新的工作线程中执行代码。
@@ -1209,8 +944,6 @@ Public Module ModBase
Sub() Sub()
Try Try
Action() Action()
Catch ex As ThreadInterruptedException
Logger.Info($"{Name}:线程已中止")
Catch ex As Exception Catch ex As Exception
Logger.Error(ex, $"{Name}:线程执行失败") Logger.Error(ex, $"{Name}:线程执行失败")
End Try End Try
@@ -1341,7 +1074,7 @@ Public Module ModBase
RunInThread( RunInThread(
Sub() Sub()
Try Try
ResilientUtils.Retry( Retrier.Attempt(delay:=Function(Attempt) TimeSpan.FromMilliseconds(200), maxAttempts:=4, isRetryAllowed:=Function(ex) True, action:=
Sub() Sub()
RunInUi( RunInUi(
Sub() Sub()
@@ -1476,20 +1209,10 @@ Public Module ModBase
''' <summary> ''' <summary>
''' 控件是否受到 TextTrimming 属性影响,导致内容被截取。 ''' 控件是否受到 TextTrimming 属性影响,导致内容被截取。
''' </summary> ''' </summary>
<Extension> Public Function IsTextTrimmed(Control As TextBlock) As Boolean <Extension> Public Function IsTextTrimmed(TextBlock As TextBlock) As Boolean
Control.Measure(New Size(Double.MaxValue, Double.MaxValue)) Dim typeface As New Typeface(TextBlock.FontFamily, TextBlock.FontStyle, TextBlock.FontWeight, TextBlock.FontStretch)
Return Control.DesiredSize.Width > Control.ActualWidth Dim formattedText As New FormattedText(TextBlock.Text, Thread.CurrentThread.CurrentCulture, TextBlock.FlowDirection, typeface, TextBlock.FontSize, TextBlock.Foreground, DPI)
End Function Return formattedText.Width > TextBlock.ActualWidth
''' <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
End Function End Function
''' <summary> ''' <summary>
+126 -47
View File
@@ -1,4 +1,4 @@
Public Module ModLoader Public Module ModLoader
'各类加载器 '各类加载器
''' <summary> ''' <summary>
@@ -89,7 +89,8 @@
Dim OldState = _State Dim OldState = _State
If value = LoadState.Finished AndAlso Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000)) If value = LoadState.Finished AndAlso Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
_State = value _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 回调 '实现 ILoadingTrigger 接口与 OnStateChanged 回调
RunInUi( RunInUi(
Sub() Sub()
@@ -163,14 +164,42 @@
Private _Progress As Double = -1 Private _Progress As Double = -1
Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged
''' <summary> ''' <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> ''' </summary>
Public Property ProgressWeight As Double = 1 Public Property ProgressWeight As Double = 1
'状态变化 '状态变化
Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) 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) 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 = "等待加载器执行超时。" Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。"
@@ -178,16 +207,19 @@
''' <summary> ''' <summary>
''' 无限期地等待加载器完成,直到结束或抛出异常。若加载器尚未开始,则会开始执行。 ''' 无限期地等待加载器完成,直到结束或抛出异常。若加载器尚未开始,则会开始执行。
''' </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) Start(Input, IsForceRestart)
Do While State = LoadState.Loading Do While State = LoadState.Loading
If LoaderToSyncProgress IsNot Nothing Then LoaderToSyncProgress.Progress = Progress If LoaderToSyncProgress IsNot Nothing Then LoaderToSyncProgress.Progress = Progress
p?.Set(Progress)
c.ThrowIfCancellationRequested()
Thread.Sleep(10) Thread.Sleep(10)
Loop Loop
If State = LoadState.Finished Then If State = LoadState.Finished Then
Return Return
ElseIf State = LoadState.Interrupted Then ElseIf State = LoadState.Canceled Then
Throw New ThreadInterruptedException("加载器执行已中断。") Throw New OperationCanceledException("加载器执行已中断")
ElseIf IsNothing([Error]) Then ElseIf IsNothing([Error]) Then
Throw New Exception("未知错误!") Throw New Exception("未知错误!")
Else Else
@@ -209,8 +241,8 @@
Loop Loop
If State = LoadState.Finished Then If State = LoadState.Finished Then
Return Return
ElseIf State = LoadState.Interrupted Then ElseIf State = LoadState.Canceled Then
Throw New ThreadInterruptedException("加载器执行已中断。") Throw New OperationCanceledException("加载器执行已中断")
ElseIf IsNothing([Error]) Then ElseIf IsNothing([Error]) Then
Throw New Exception("未知错误!") Throw New Exception("未知错误!")
Else Else
@@ -240,16 +272,16 @@
''' <summary> ''' <summary>
''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断,不可跨线程调用。 ''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断,不可跨线程调用。
''' </summary> ''' </summary>
Public ReadOnly Property IsInterrupted As Boolean Public ReadOnly Property IsCanceled As Boolean
Get Get
Return IsInterruptedWithThread(Thread.CurrentThread) Return IsCanceledWithThread(Thread.CurrentThread)
End Get End Get
End Property End Property
''' <summary> ''' <summary>
''' 当前执行线程是否应当中断。需要手动提供加载器线程,用于需要跨线程检查的情况。 ''' 当前执行线程是否应当中断。需要手动提供加载器线程,用于需要跨线程检查的情况。
''' </summary> ''' </summary>
Public Function IsInterruptedWithThread(Thread As Thread) As Boolean Public Function IsCanceledWithThread(Thread As Thread) As Boolean
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Interrupted Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Canceled
End Function End Function
''' <summary> ''' <summary>
''' 在输入相同时使用原有结果的超时,单位为毫秒。 ''' 在输入相同时使用原有结果的超时,单位为毫秒。
@@ -318,30 +350,29 @@
Sub() Sub()
Try Try
IsForceRestarting = IsForceRestart IsForceRestarting = IsForceRestart
Logger.Trace(Function() $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动") Logger.Trace(Function() $"加载线程 {Name} 已{If(IsForceRestarting, "强制", "")}启动")
LoadDelegate(Me) LoadDelegate(Me)
If IsInterrupted Then If IsCanceled Then
Logger.Warn($"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})") Logger.Warn($"加载线程 {Name} 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})")
Return Return
End If End If
Logger.Trace(Function() $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成") Logger.Trace(Function() $"加载线程 {Name} 已完成")
RaisePreviewFinish() RaisePreviewFinish()
State = LoadState.Finished State = LoadState.Finished
LastFinishedTime = GetTimeMs() '未中断,本次输出有效 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 Catch ex As Exception
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) Failed(ex)
End If
End Try End Try
End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority} End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
Try Try
LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsInterrupted LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsCanceled
Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”,则等待后重试 Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”,则等待后重试
Thread.Sleep(500) Thread.Sleep(500)
LastRunningThread.Start() LastRunningThread.Start()
@@ -350,16 +381,16 @@
Public Overrides Sub Failed(ex As Exception) Public Overrides Sub Failed(ex As Exception)
[Error] = ex [Error] = ex
SyncLock LockState SyncLock LockState
If IsInterrupted OrElse State >= LoadState.Finished Then Return If IsCanceled OrElse State >= LoadState.Finished Then Return
State = LoadState.Failed State = LoadState.Failed
End SyncLock End SyncLock
Logger.Warn(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%") Logger.Warn(ex, $"加载线程 {Name} 出错,已完成 {Math.Round(Progress * 100)}%")
TriggerThreadInterrupt() TriggerThreadInterrupt()
End Sub End Sub
Public Overrides Sub Interrupt() Public Overrides Sub Cancel()
SyncLock LockState SyncLock LockState
If State <> LoadState.Loading Then Return If State <> LoadState.Loading Then Return
State = LoadState.Interrupted State = LoadState.Canceled
End SyncLock End SyncLock
TriggerThreadInterrupt() TriggerThreadInterrupt()
End Sub End Sub
@@ -367,7 +398,7 @@
If LastRunningThread Is Nothing Then Return If LastRunningThread Is Nothing Then Return
If LastRunningThread.IsAlive Then If LastRunningThread.IsAlive Then
LastRunningThread.Interrupt() LastRunningThread.Interrupt()
Logger.Trace(Function() $"加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断") Logger.Trace(Function() $"加载线程 {Name} 已中断")
End If End If
LastRunningThread = Nothing LastRunningThread = Nothing
End Sub End Sub
@@ -383,6 +414,53 @@
End Sub End Sub
End Class 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>
''' 支持多个加载器连续运作的复合加载器。 ''' 支持多个加载器连续运作的复合加载器。
''' </summary> ''' </summary>
@@ -450,11 +528,11 @@
End If End If
RunInThread(AddressOf Update) RunInThread(AddressOf Update)
End Sub End Sub
Public Overrides Sub Interrupt() Public Overrides Sub Cancel()
'改变状态 '改变状态
SyncLock LockState SyncLock LockState
If State = LoadState.Loading OrElse State = LoadState.Waiting Then If State = LoadState.Loading OrElse State = LoadState.Waiting Then
State = LoadState.Interrupted State = LoadState.Canceled
Else Else
Return Return
End If End If
@@ -463,7 +541,7 @@
Sub() Sub()
'中断加载器 '中断加载器
For Each Loader In Loaders For Each Loader In Loaders
Loader.Interrupt() Loader.Cancel()
Next Next
End Sub) End Sub)
End Sub End Sub
@@ -474,7 +552,7 @@
State = LoadState.Failed State = LoadState.Failed
End SyncLock End SyncLock
For Each Loader In Loaders For Each Loader In Loaders
Loader.Interrupt() Loader.Cancel()
Next Next
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
End Sub End Sub
@@ -492,9 +570,9 @@
Case LoadState.Finished Case LoadState.Finished
'正常结束,触发刷新 '正常结束,触发刷新
Update() Update()
Case LoadState.Interrupted Case LoadState.Canceled
'被中断,这个任务也中断 '被中断,这个任务也中断
Interrupt() Cancel()
Case LoadState.Failed Case LoadState.Failed
'完蛋,出错了 '完蛋,出错了
Failed(New Exception(Loader.Name & "失败", Loader.Error)) Failed(New Exception(Loader.Name & "失败", Loader.Error))
@@ -504,15 +582,15 @@
''' 触发一次更新,以启动新加载器或完成。 ''' 触发一次更新,以启动新加载器或完成。
''' </summary> ''' </summary>
Private Sub Update() 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 IsFinished As Boolean = True
Dim Blocked As Boolean = False Dim Blocked As Boolean = False
Dim Input As Object = Me.Input Dim Input As Object = Me.Input
For Each Loader In Loaders For Each Loader In Loaders
Select Case Loader.State Select Case Loader.State
Case LoadState.Finished Case LoadState.Finished
'检查是否需要重启 '检查 LoaderTask 是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith 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 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}") Logger.Info($"由于输入条件变更,重启已完成的加载器 {Loader.Name}")
GoTo Restart GoTo Restart
@@ -523,8 +601,8 @@
'如果不让继续启动,且已有加载器正在加载中,就不继续启动 '如果不让继续启动,且已有加载器正在加载中,就不继续启动
If Loader.Block AndAlso Not IsFinished Then Blocked = True If Loader.Block AndAlso Not IsFinished Then Blocked = True
Case LoadState.Loading Case LoadState.Loading
'检查是否需要重启 '检查 LoaderTask 是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then 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 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}") Logger.Warn($"由于输入条件变更,重启进行中的加载器 {Loader.Name}")
GoTo Restart GoTo Restart
@@ -540,13 +618,14 @@ Restart:
If Blocked Then Continue For If Blocked Then Continue For
If Input IsNot Nothing Then If Input IsNot Nothing Then
'若输入类型与下一个加载器相同才继续 '若输入类型与下一个加载器相同才继续
Dim LoaderType As String = Loader.GetType.Name If GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderTask(Of ,))) OrElse GeneralUtils.IsGenericInstanceOf(Loader, GetType(LoaderCombo(Of ))) Then
If LoaderType.StartsWithF("LoaderTask") OrElse LoaderType.StartsWithF("LoaderCombo") Then
Loader.Start(If(Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IsForceRestarting) 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) Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting)
Else Else
Throw New Exception("未知的加载器类型(" & LoaderType & ")") Throw New Exception("未知的加载器类型(" & Loader.GetType.Name & ")")
End If End If
Else Else
Loader.Start(IsForceRestart:=IsForceRestarting) 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) Public Shared Sub GetLoaderList(Loader As Object, ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True)
For Each SubLoader In Loader.Loaders For Each SubLoader In Loader.Loaders
If SubLoader.Show OrElse Not RequireShow Then List.Add(SubLoader) 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 Next
End Sub End Sub
''' <summary> ''' <summary>
@@ -606,7 +685,7 @@ Restart:
'若单个任务已中止,或全部任务已完成,则刷新并移除 '若单个任务已中止,或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar For Each Task In LoaderTaskbar
If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse 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) FrmSpeedLeft?.TaskRefresh(Task)
LoaderTaskbar.Remove(Task) LoaderTaskbar.Remove(Task)
Logger.Info($"{Task.Name} 已移出任务列表") Logger.Info($"{Task.Name} 已移出任务列表")
+96 -97
View File
@@ -1,5 +1,4 @@
Imports System.Net.Sockets Imports System.Net.Sockets
Imports System.Threading.Tasks
Public Module ModNet Public Module ModNet
@@ -32,10 +31,8 @@ Public Module ModNet
Return Result Return Result
Catch ex As FormatException Catch ex As FormatException
Throw Throw
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception Catch ex As Exception
If MakeLog Then Logger.Warn(ex, "网络请求失败") If MakeLog Then Logger.Warn(ex, $"网络请求失败({Method.Method},{Url})")
Throw Throw
End Try End Try
End Function End Function
@@ -68,9 +65,8 @@ Retry:
Throw RetryException Throw RetryException
End If End If
End Select End Select
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception Catch ex As Exception
ex.ThrowIfCanceled()
If TypeOf ex Is HttpRequestCodeException Then If TypeOf ex Is HttpRequestCodeException Then
If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.Forbidden Then Throw If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.Forbidden Then Throw
If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.NotFound Then Throw If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.NotFound Then Throw
@@ -161,7 +157,7 @@ RequestFinished:
FileUtils.Delete(Temp) FileUtils.Delete(Temp)
Return Result Return Result
Finally Finally
NewTask.Interrupt() NewTask.Cancel()
End Try End Try
End Function End Function
@@ -179,11 +175,9 @@ RequestFinished:
Retry: Retry:
Try Try
FileUtils.Write(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders)) FileUtils.Write(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders))
Catch ex As ThreadInterruptedException
FileUtils.Delete(LocalPath)
Throw
Catch ex As Exception Catch ex As Exception
FileUtils.Delete(LocalPath) FileUtils.Delete(LocalPath)
ex.ThrowIfCanceled()
If RetryCount < 2 Then If RetryCount < 2 Then
RetryCount += 1 RetryCount += 1
GoTo Retry GoTo Retry
@@ -210,7 +204,7 @@ Retry:
Catch ex As Exception Catch ex As Exception
Throw New WebException($"多线程直接下载文件失败(第一下载源:" & Urls.First() & ")", ex) Throw New WebException($"多线程直接下载文件失败(第一下载源:" & Urls.First() & ")", ex)
Finally Finally
NewTask.Interrupt() NewTask.Cancel()
End Try End Try
End Sub End Sub
@@ -226,32 +220,7 @@ Retry:
Dim Request As HttpRequestMessage = Nothing, CancelToken As CancellationTokenSource = Nothing, Dim Request As HttpRequestMessage = Nothing, CancelToken As CancellationTokenSource = Nothing,
Response As HttpResponseMessage = Nothing, HostIp As String = Nothing Response As HttpResponseMessage = Nothing, HostIp As String = Nothing
Try Try
Url = SecretCdnSign(Url) '构建 RequestClient
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 以提高成功率
'发送请求
Directory.CreateDirectory(PathTemp & "Cache\Http\") Directory.CreateDirectory(PathTemp & "Cache\Http\")
SyncLock RequestClientLock SyncLock RequestClientLock
If RequestClient Is Nothing Then '延迟初始化,以避免在程序启动前加载 CacheCow 导致 DLL 加载失败 If RequestClient Is Nothing Then '延迟初始化,以避免在程序启动前加载 CacheCow 导致 DLL 加载失败
@@ -261,11 +230,41 @@ Retry:
}) })
End If End If
End SyncLock End SyncLock
ResilientUtils.RetryOn(Of FileNotFoundException, IOException)( 'CacheCow 读取缓存时若文件被占用,会调用不存在的 System.Net.Http.Formatting.resources,抛出此异常(#8150) '构建请求
Sub() Url = SecretCdnSign(Url)
CancelToken.Dispose() : CancelToken = New CancellationTokenSource(Timeout) Request = New HttpRequestMessage(Method, Url)
Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout) 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) End Sub)
'读取响应
Dim ResponseBytes As Byte() Dim ResponseBytes As Byte()
CancelToken.Dispose() : CancelToken = New CancellationTokenSource(Timeout) CancelToken.Dispose() : CancelToken = New CancellationTokenSource(Timeout)
Using ResponseStream = Response.Content.ReadAsStreamAsync().GetResultWithTimeout(CancelToken, Timeout) Using ResponseStream = Response.Content.ReadAsStreamAsync().GetResultWithTimeout(CancelToken, Timeout)
@@ -274,26 +273,24 @@ Retry:
ResponseBytes = Stream.ToArray() ResponseBytes = Stream.ToArray()
End Using End Using
End Using End Using
'输出 If Not Response.IsSuccessStatusCode Then
If Response.IsSuccessStatusCode Then
RecordIPReliability(HostIp, 0.5)
Return ResponseBytes
Else
RecordIPReliability(HostIp, -0.7) RecordIPReliability(HostIp, -0.7)
Dim ResponseMessage = ResponseBytes.GetString(Encoding) Dim ResponseMessage = ResponseBytes.GetString(Encoding)
Throw New HttpRequestCodeException( Throw New HttpRequestCodeException(
$"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)}),{Method},{Url},{HostIp}" & $"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)}),{Method},{Url},{HostIp}" &
If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), Response.StatusCode, ResponseMessage) If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), Response.StatusCode, ResponseMessage)
End If End If
Catch ex As ThreadInterruptedException '输出
Throw RecordIPReliability(HostIp, 0.5)
Return ResponseBytes
Catch ex As HttpRequestException Catch ex As HttpRequestException
Throw Throw
Catch ex As Exception Catch ex As TimeoutException
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) Throw New WebException($"连接服务器超时,请稍后再试,或使用 VPN 改善网络环境({Method}, {Url},IP:{HostIp})", WebExceptionStatus.Timeout)
ElseIf ex.IsBadNetwork Then Catch ex As Exception
ex.ThrowIfCanceled()
RecordIPReliability(HostIp, -1)
If ex.IsBadNetwork Then
Throw New WebException($"网络请求失败,请稍后再试,或使用 VPN 改善网络环境({Method}, {Url},IP:{HostIp})", WebExceptionStatus.Timeout) Throw New WebException($"网络请求失败,请稍后再试,或使用 VPN 改善网络环境({Method}, {Url},IP:{HostIp})", WebExceptionStatus.Timeout)
Else Else
Throw New Exception($"网络请求出现意外异常({Method}, {Url},{HostIp})", ex) Throw New Exception($"网络请求出现意外异常({Method}, {Url},{HostIp})", ex)
@@ -478,7 +475,7 @@ Retry:
''' <summary> ''' <summary>
''' 已失败或中断。 ''' 已失败或中断。
''' </summary> ''' </summary>
Interrupted = 6 Canceled = 6
End Enum End Enum
''' <summary> ''' <summary>
''' 预下载检查行为。 ''' 预下载检查行为。
@@ -626,7 +623,7 @@ Retry:
''' </summary> ''' </summary>
Public ReadOnly Property IsEnded As Boolean Public ReadOnly Property IsEnded As Boolean
Get Get
Return State = NetState.Finished OrElse State = NetState.Interrupted Return State = NetState.Finished OrElse State = NetState.Canceled
End Get End Get
End Property End Property
@@ -663,7 +660,7 @@ Retry:
''' <summary> ''' <summary>
''' 所有下载源。 ''' 所有下载源。
''' </summary> ''' </summary>
Public Sources As ConcurrentList(Of NetSource) Public Sources As List(Of NetSource)
''' <summary> ''' <summary>
''' 用于在第一个线程出错时切换下载源。 ''' 用于在第一个线程出错时切换下载源。
''' </summary> ''' </summary>
@@ -819,7 +816,7 @@ Retry:
Return OriginalProgress * 0.93 + 0.05 Return OriginalProgress * 0.93 + 0.05
Case NetState.Merging Case NetState.Merging
Return 0.99 Return 0.99
Case NetState.Finished, NetState.Interrupted Case NetState.Finished, NetState.Canceled
Return 1 Return 1
Case Else Case Else
Throw New ArgumentOutOfRangeException("文件状态未知:" & State) Throw New ArgumentOutOfRangeException("文件状态未知:" & State)
@@ -889,7 +886,7 @@ Retry:
'条件检测 '条件检测
SyncLock LockSource SyncLock LockSource
If NetTaskThreadCount >= NetTaskThreadLimit OrElse Not HasAvailableSource() OrElse 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 If State >= NetState.Merging OrElse State = NetState.WaitingToCheck Then Return Nothing
SyncLock LockState SyncLock LockState
If State < NetState.Connecting Then State = NetState.Connecting If State < NetState.Connecting Then State = NetState.Connecting
@@ -900,7 +897,7 @@ Retry:
If IsNoSplit Then GoTo StartSingleThreadDownload If IsNoSplit Then GoTo StartSingleThreadDownload
'只剩下单线程可用点 '只剩下单线程可用点
If Not HasAvailableSource(False) Then 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: StartSingleThreadDownload:
Reset() Reset()
State = NetState.Reading State = NetState.Reading
@@ -916,7 +913,7 @@ StartSingleThreadDownload:
End If End If
'寻找失败点 '寻找失败点
For Each Thread As NetThread In Threads 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 StartPosition = Thread.DownloadStart + Thread.DownloadDone
StartSource = GetSource(Thread.Source.Id + 1) StartSource = GetSource(Thread.Source.Id + 1)
GoTo StartThread GoTo StartThread
@@ -997,7 +994,7 @@ StartThread:
If Not Response.IsSuccessStatusCode Then '状态码检查 If Not Response.IsSuccessStatusCode Then '状态码检查
Throw New HttpRequestCodeException($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)}),{Th.Source.Url}", Response.StatusCode, Nothing) Throw New HttpRequestCodeException($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)}),{Th.Source.Url}", Response.StatusCode, Nothing)
End If 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}") If Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Logger.Trace(Function() $"{LocalName}:重定向至 {Response.RequestMessage.RequestUri}")
'文件大小校验 '文件大小校验
ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1) ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1)
@@ -1023,7 +1020,7 @@ StartThread:
End If End If
End If End If
FileSize = ContentLength : IsUnknownSize = False FileSize = ContentLength : IsUnknownSize = False
Logger.Info($"{LocalName}:文件大小 {ContentLength}({FormatFileSize(ContentLength)})") Logger.Info($"{LocalName}:文件大小 {ContentLength}({StringUtils.FormatByteSize(ContentLength)})")
'若文件大小大于 50 M,进行剩余磁盘空间校验 '若文件大小大于 50 M,进行剩余磁盘空间校验
If ContentLength > 50 * 1024 * 1024 Then If ContentLength > 50 * 1024 * 1024 Then
For Each Drive As DriveInfo In DriveInfo.GetDrives For Each Drive As DriveInfo In DriveInfo.GetDrives
@@ -1031,7 +1028,7 @@ StartThread:
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) + Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) +
If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0) If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0)
If RequiredSpace > 0 AndAlso Drive.TotalFreeSpace < RequiredSpace Then 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 & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", "")) If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", ""))
End If End If
Next Next
@@ -1111,9 +1108,9 @@ NotSupportRange:
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout) HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
End While End While
SourceBreak: 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}:中断") Logger.Info($"{LocalName}:中断")
ElseIf HttpDataCount = 0 AndAlso Th.DownloadUndone > 0 AndAlso Not IsUnknownSize Then ElseIf HttpDataCount = 0 AndAlso Th.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
'服务器无返回数据 '服务器无返回数据
@@ -1143,7 +1140,7 @@ SourceBreak:
Interlocked.Decrement(NetTaskThreadCount) Interlocked.Decrement(NetTaskThreadCount)
'合并 '合并
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso 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 Try
End Sub End Sub
Private Sub SourceFail(Th As NetThread, ex As Exception, IsMergeFailure As Boolean) Private Sub SourceFail(Th As NetThread, ex As Exception, IsMergeFailure As Boolean)
@@ -1152,7 +1149,7 @@ SourceBreak:
For Each Task In Tasks For Each Task In Tasks
Interlocked.Increment(Task.FailCount) Interlocked.Increment(Task.FailCount)
Next Next
Th.State = NetState.Interrupted Th.State = NetState.Canceled
Th.Source.Ex = ex Th.Source.Ex = ex
'根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传) '根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传)
Dim IsRangeNotSupported As Boolean = TypeOf ex Is RangeNotSupportedException OrElse ex.Message.Contains("(416)") 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) If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
'凉凉 '凉凉
Logger.Info($"{LocalName}:已失败,当前状态 {State}") Logger.Info($"{LocalName}:已失败,当前状态 {State}")
State = NetState.Interrupted State = NetState.Canceled
End SyncLock End SyncLock
InterruptInternal() CancelInternal()
For Each Task In Tasks For Each Task In Tasks
Task.OnFileFail(Me) Task.OnFileFail(Me)
Next Next
End Sub End Sub
''' <summary> ''' <summary>
''' 下载中断。 ''' 取消下载。
''' </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 If Tasks.Any Then Return
'确认中断 '确认中断
SyncLock LockState SyncLock LockState
If State >= NetState.Finished Then Return If State >= NetState.Finished Then Return
Logger.Info($"{LocalName}:已中断,当前状态 {State}") Logger.Info($"{LocalName}:已中断,当前状态 {State}")
State = NetState.Interrupted State = NetState.Canceled
End SyncLock End SyncLock
InterruptInternal() CancelInternal()
End Sub End Sub
Private Sub InterruptInternal() Private Sub CancelInternal()
On Error Resume Next On Error Resume Next
Reset() Reset()
Interlocked.Decrement(NetManager.FileRemain) Interlocked.Decrement(NetManager.FileRemain)
@@ -1395,7 +1392,7 @@ Retry:
''' <summary> ''' <summary>
''' 需要下载的文件。 ''' 需要下载的文件。
''' </summary> ''' </summary>
Public Files As ConcurrentList(Of NetFile) Public Files As ConcurrentQueue(Of NetFile)
''' <summary> ''' <summary>
''' 剩余未完成的文件数。(用于减轻 FilesLock 的占用) ''' 剩余未完成的文件数。(用于减轻 FilesLock 的占用)
''' </summary> ''' </summary>
@@ -1470,12 +1467,12 @@ FinishExCatch:
Public Sub New(Name As String, FileTasks As IEnumerable(Of NetFile)) Public Sub New(Name As String, FileTasks As IEnumerable(Of NetFile))
Me.Name = Name Me.Name = Name
Files = New ConcurrentList(Of NetFile)(FileTasks) Files = New ConcurrentQueue(Of NetFile)(FileTasks)
End Sub End Sub
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) 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 SyncLock FileRemainLock
FileRemain += Files.Where(Function(f) f.State <> NetState.Finished).Count FileRemain += Files.Where(Function(f) f.State <> NetState.Finished).Count
@@ -1507,6 +1504,7 @@ FinishExCatch:
'接入下载管理器,获取新开始下载的文件列表 '接入下载管理器,获取新开始下载的文件列表
Dim NewFiles = NetManager.Start(Me) Dim NewFiles = NetManager.Start(Me)
'==================================== '====================================
' 已存在文件查找 ' 已存在文件查找
'==================================== '====================================
@@ -1514,9 +1512,9 @@ FinishExCatch:
'整理允许进行查找的文件 '整理允许进行查找的文件
Dim FilesToCheck As New List(Of NetFile) Dim FilesToCheck As New List(Of NetFile)
For Each File In NewFiles For Each File In NewFiles
If File.Check?.CanUseExistsFile Then If File.Check IsNot Nothing Then
FilesToCheck.Add(File) FilesToCheck.Add(File)
Else '不允许,直接开始下载 Else '没有校验信息,直接开始下载
SyncLock LockState SyncLock LockState
File.State = NetState.WaitingToDownload File.State = NetState.WaitingToDownload
File.IsCopy = False File.IsCopy = False
@@ -1526,7 +1524,7 @@ FinishExCatch:
If Not FilesToCheck.Any Then Return If Not FilesToCheck.Any Then Return
'获取 MC 文件夹列表 '获取 MC 文件夹列表
Dim Folders As New List(Of String) 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.AddRange(McFolderList.Select(Function(f) f.Location))
Folders = Folders.Distinct.Where(Function(f) DirectoryUtils.Exists(f)).ToList Folders = Folders.Distinct.Where(Function(f) DirectoryUtils.Exists(f)).ToList
'平均分配到多个检查线程 '平均分配到多个检查线程
@@ -1555,7 +1553,7 @@ FinishExCatch:
'列出 MC 文件夹中的各个版本文件夹 '列出 MC 文件夹中的各个版本文件夹
Dim VersionFolders As New List(Of String) Dim VersionFolders As New List(Of String)
For Each McFolder In FolderList 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)) VersionFolders.Add(PathUtils.AddSlashSuffix(VersionFolder))
Next Next
Next Next
@@ -1625,7 +1623,7 @@ FinishExCatch:
Case "versions\" Case "versions\"
'版本 jar 或 json:查找 MC 文件夹下的各个版本文件夹 '版本 jar 或 json:查找 MC 文件夹下的各个版本文件夹
For Each VersionFolder In VersionFolders 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 If CheckCandidate(Candidate, File.Check) Then Return Candidate
Next Next
Next Next
@@ -1633,7 +1631,7 @@ FinishExCatch:
'社区资源 '社区资源
If File.Check.ActualSize < 0 OrElse File.Check.Hash Is Nothing Then Return Nothing '必须要求指定了文件大小和 Hash If File.Check.ActualSize < 0 OrElse File.Check.Hash Is Nothing Then Return Nothing '必须要求指定了文件大小和 Hash
For Each Folder In FolderList.Concat(VersionFolders) 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 If CheckCandidate(Candidate, File.Check) Then Return Candidate
Next Next
Next Next
@@ -1671,12 +1669,12 @@ FinishExCatch:
If State >= LoadState.Finished Then Return If State >= LoadState.Finished Then Return
If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误!")} 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) [Error] = If(UsefulExs.FirstOrDefault, ExList.FirstOrDefault)
'获取实际失败的文件 '获取实际失败的文件
For Each File In Files For Each File In Files
If File.State <> NetState.Interrupted Then Continue For If File.State <> NetState.Canceled 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.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) 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 & [Error] = New Exception("文件下载失败:" & File.LocalPath & vbCrLf &
"各下载源的错误如下:" & vbCrLf & Detail, [Error]) "各下载源的错误如下:" & vbCrLf & Detail, [Error])
@@ -1691,20 +1689,20 @@ FinishExCatch:
End SyncLock End SyncLock
'中断所有文件 '中断所有文件
For Each TaskFile In Files For Each TaskFile In Files
TaskFile.Interrupt(Me) TaskFile.Cancel(Me)
Next Next
'在退出同步锁后再进行日志输出 '在退出同步锁后再进行日志输出
Logger.Error(New AggregateException(ExList), "下载加载器失败", LogBehavior.None) Logger.Error(New AggregateException(ExList), "下载加载器失败", LogBehavior.None)
End Sub End Sub
Public Overrides Sub Interrupt() Public Overrides Sub Cancel()
SyncLock LockState SyncLock LockState
If State >= LoadState.Finished Then Return If State >= LoadState.Finished Then Return
State = LoadState.Interrupted State = LoadState.Canceled
End SyncLock End SyncLock
Logger.Info($"{Name} 已取消!") Logger.Info($"{Name} 已取消!")
'中断所有文件 '中断所有文件
For Each TaskFile In Files For Each TaskFile In Files
TaskFile.Interrupt(Me) TaskFile.Cancel(Me)
Next Next
End Sub End Sub
@@ -1726,7 +1724,7 @@ FinishExCatch:
''' <summary> ''' <summary>
''' 当前的所有下载任务。 ''' 当前的所有下载任务。
''' </summary> ''' </summary>
Public Tasks As New ConcurrentList(Of LoaderDownload) Public Tasks As New ConcurrentBag(Of LoaderDownload)
''' <summary> ''' <summary>
''' 已下载完成的大小。 ''' 已下载完成的大小。
@@ -1777,7 +1775,7 @@ FinishExCatch:
If SpeedLast.Count >= 10 Then Limit = SpeedLast.Take(10).Average * 0.85 '取近 1 秒的平均速度的 85% If SpeedLast.Count >= 10 Then Limit = SpeedLast.Take(10).Average * 0.85 '取近 1 秒的平均速度的 85%
If Limit > NetTaskSpeedLimitLow Then If Limit > NetTaskSpeedLimitLow Then
NetTaskSpeedLimitLow = Limit NetTaskSpeedLimitLow = Limit
Logger.Info($"速度下限已提升到 {FormatFileSize(Limit)}") Logger.Info($"速度下限已提升到 {StringUtils.FormatByteSize(Limit)}")
End If End If
#End Region #End Region
#Region "刷新下载任务属性" #Region "刷新下载任务属性"
@@ -1894,14 +1892,13 @@ FinishExCatch:
End SyncLock End SyncLock
'添加每个文件 '添加每个文件
Dim NewFiles As New List(Of NetFile) Dim NewFiles As New List(Of NetFile)
For i = 0 To Task.Files.Count - 1 Dim NewFilesList As New List(Of NetFile)
Dim File As NetFile = Task.Files(i) For Each File In Task.Files
Dim OngoingFile As NetFile = Nothing Dim OngoingFile As NetFile = Nothing
If AllFiles.TryGetValue(File.LocalPath, OngoingFile) AndAlso OngoingFile.State < NetState.Finished Then If AllFiles.TryGetValue(File.LocalPath, OngoingFile) AndAlso OngoingFile.State < NetState.Finished Then
'该文件正在被另一个任务下载 '该文件正在被另一个任务下载
Logger.Trace(Function() $"{File.LocalName}:无需开始,该文件已在下载中,目标 {File.LocalPath}") Logger.Trace(Function() $"{File.LocalName}:无需开始,该文件已在下载中,目标 {File.LocalPath}")
File = OngoingFile '将列表中的文件替换成下载中的文件,即两个任务指向同一个文件;抛弃现在的 File 对象 File = OngoingFile '将列表中的文件替换成下载中的文件,即两个任务指向同一个文件;抛弃现在的 File 对象
Task.Files(i) = File
Else Else
'常规情况(该文件可能已在其他任务中下载完成,但这并不影响) '常规情况(该文件可能已在其他任务中下载完成,但这并不影响)
Logger.Trace(Function() $"{File.LocalName}:开始,目标 {File.LocalPath}") Logger.Trace(Function() $"{File.LocalName}:开始,目标 {File.LocalPath}")
@@ -1909,8 +1906,10 @@ FinishExCatch:
NewFiles.Add(File) NewFiles.Add(File)
Interlocked.Increment(FileRemain) Interlocked.Increment(FileRemain)
End If End If
NewFilesList.Add(File)
File.Tasks.Add(Task) File.Tasks.Add(Task)
Next Next
Task.Files = New ConcurrentQueue(Of NetFile)(NewFilesList)
Tasks.Add(Task) Tasks.Add(Task)
Return NewFiles Return NewFiles
End Function End Function
@@ -1,4 +1,4 @@
'提供不同的输入验证方法,名称以 Validate 开头 '提供不同的输入验证方法,名称以 Validate 开头
Public Module ModValidate Public Module ModValidate
''' <summary> ''' <summary>
@@ -66,6 +66,20 @@ Public Class ValidateNullOrWhiteSpace
End Function End Function
End Class 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>
''' 必须满足正则表达式。 ''' 必须满足正则表达式。
''' </summary> ''' </summary>
@@ -255,7 +269,7 @@ Public Class ValidateFolderName
Me.IgnoreCase = IgnoreCase Me.IgnoreCase = IgnoreCase
Me.UseMinecraftCharCheck = UseMinecraftCharCheck Me.UseMinecraftCharCheck = UseMinecraftCharCheck
On Error Resume Next On Error Resume Next
PathIgnore = DirectoryUtils.GetDirectories(Folder, True) PathIgnore = DirectoryUtils.EnumerateDirectories(Folder)
End Sub End Sub
Public Overrides Function Validate(Str As String) As String Public Overrides Function Validate(Str As String) As String
Try Try
@@ -1,4 +1,4 @@
'一个万能的自动图片类型转换工具类 '一个万能的自动图片类型转换工具类
Imports System.Drawing.Imaging Imports System.Drawing.Imaging
@@ -126,9 +126,7 @@ Public Class MyBitmap
End Sub End Sub
Private Class WebPDecoder '将代码隔离在另外一个类中,这样只要不调用这个方法就不会加载 Imazen.WebP.dll Private Class WebPDecoder '将代码隔离在另外一个类中,这样只要不调用这个方法就不会加载 Imazen.WebP.dll
Public Shared Function DecodeFromBytes(Bytes As Byte()) As System.Drawing.Bitmap Public Shared Function DecodeFromBytes(Bytes As Byte()) As System.Drawing.Bitmap
If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。") Return New Imazen.WebP.SimpleDecoder().DecodeFromBytes(Bytes, Bytes.Length)
Dim Decoder As New Imazen.WebP.SimpleDecoder()
Return Decoder.DecodeFromBytes(Bytes, Bytes.Length)
End Function End Function
End Class End Class
@@ -1,4 +1,4 @@
Public Class PclLogger Public Class PclLogger
Inherits FileLogger Inherits FileLogger
''' <inheritdoc/> ''' <inheritdoc/>
@@ -1,4 +1,4 @@
Public Class CrashAnalyzer Public Class CrashAnalyzer
'构造函数 '构造函数
Private TempFolder As String Private TempFolder As String
@@ -24,7 +24,7 @@
'简单收集可能的日志文件路径 '简单收集可能的日志文件路径
Dim PossibleLogs As New List(Of String) Dim PossibleLogs As New List(Of String)
Try Try
PossibleLogs.AddRange(DirectoryUtils.GetFiles(VersionPathIndie & "crash-reports\")) PossibleLogs.AddRange(DirectoryUtils.EnumerateFiles(VersionPathIndie & "crash-reports\", True))
Catch ex As Exception Catch ex As Exception
Logger.Warn(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败") Logger.Warn(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败")
End Try End Try
@@ -1,4 +1,4 @@
Public Module ModDownload Public Module ModDownload
#Region "DlClient* | Minecraft 客户端" #Region "DlClient* | Minecraft 客户端"
@@ -20,7 +20,7 @@
Throw New Exception("底层版本 " & Instance.Name & " 中无 jar 文件下载信息") Throw New Exception("底层版本 " & Instance.Name & " 中无 jar 文件下载信息")
End If 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 '通过校验 If ReturnNothingOnFileUseable AndAlso Checker.Check(Instance.PathVersion & Instance.Name & ".jar") Is Nothing Then Return Nothing '通过校验
'返回下载信息 '返回下载信息
Dim JarUrl As String = Instance.JsonObject("downloads")("client")("url") Dim JarUrl As String = Instance.JsonObject("downloads")("client")("url")
@@ -44,14 +44,14 @@
If IndexUrl = "" Then If IndexUrl = "" Then
Return Nothing Return Nothing
Else 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 If
End Function End Function
''' <summary> ''' <summary>
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。 ''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
''' </summary> ''' </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) Dim Loaders As New List(Of LoaderBase)
#Region "下载支持库文件" #Region "下载支持库文件"
@@ -69,6 +69,8 @@
Else Else
Dim LoadersAssets As New List(Of LoaderBase) 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))("分析资源文件索引地址", LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try Try
@@ -76,76 +78,73 @@
If IndexFile Is Nothing Then If IndexFile Is Nothing Then
Task.Output = New List(Of NetFile) Task.Output = New List(Of NetFile)
Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址,游戏 assets 可能缺失") Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址,游戏 assets 可能缺失")
ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then ElseIf DownloadAssetIndexInBackground Then
If IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile) Task.Output = New List(Of NetFile)
Else Else
Task.Output = New List(Of NetFile) From {IndexFile} Task.Output = New List(Of NetFile) From {IndexFile}
End If 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 Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex) Throw New Exception("分析资源文件索引地址失败", ex)
End Try End Try
End Sub) With {.ProgressWeight = 0.5, .Show = False}) End Sub) With {.ProgressWeight = 0.5, .Show = False})
'下载资源文件索引 '下载资源文件索引
LoadersAssets.Add(New LoaderDownload("下载资源文件索引", New List(Of NetFile)) With {.ProgressWeight = 2}) 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 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))("后台分析资源文件索引地址", LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance) Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
If BackAssetsFile Is Nothing Then If BackAssetsFile Is Nothing Then
Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址,游戏 assets 可能缺失") Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址,游戏 assets 可能缺失")
Task.Interrupt() Task.Cancel()
Throw New ThreadInterruptedException Throw New OperationCanceledException
End If End If
RealAddress = BackAssetsFile.LocalPath RealAddressBg = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName TempAddressBg = PathTemp & "Cache\" & BackAssetsFile.LocalName & "_background"
BackAssetsFile.LocalPath = TempAddress BackAssetsFile.LocalPath = TempAddressBg
Task.Output = New List(Of NetFile) From {BackAssetsFile} 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("无需更新资源文件索引,取消") Logger.Info("无需更新资源文件索引,取消")
Task.Interrupt() Task.Cancel()
End If End If
End Sub)) End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile))) LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引", LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
Sub(Task As LoaderTask(Of List(Of NetFile), String)) Sub(Task As LoaderTask(Of List(Of NetFile), String))
FileUtils.Copy(TempAddress, RealAddress) FileUtils.Move(TempAddressBg, RealAddressBg)
McLaunchLog("后台更新资源文件索引成功:" & TempAddress) McLaunchLog("后台更新资源文件索引成功:" & TempAddressBg)
End Sub)) End Sub))
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate) Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
Logger.Info("开始后台检查资源文件索引") Logger.Info("开始后台检查资源文件索引")
Updater.Start() Updater.Start()
End If 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 If
#End Region #End Region
Return Loaders Return Loaders
End Function End Function
Public Enum AssetsIndexExistsBehaviour
''' <summary>
''' 如果文件存在,则不进行下载。
''' </summary>
DontDownload
''' <summary>
''' 如果文件存在,则启动新的下载加载器进行独立的更新。
''' </summary>
DownloadInBackground
''' <summary>
''' 如果文件存在,也同样进行下载。
''' </summary>
AlwaysDownload
End Enum
#End Region #End Region
@@ -227,7 +226,7 @@
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain) Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult)) Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim StartTime As Long = GetTimeMs() 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 Try
Dim Versions As JArray = Json("versions") Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")") If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
@@ -238,7 +237,7 @@
Logger.Info($"Mojang 官方源加载耗时:{DeltaTime}ms,{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}") Logger.Info($"Mojang 官方源加载耗时:{DeltaTime}ms,{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
End If End If
'添加 PCL 特供项 '添加 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} Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
'MC 更新提示 'MC 更新提示
@@ -269,12 +268,12 @@
''' </summary> ''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain) Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult)) 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 Try
Dim Versions As JArray = Json("versions") Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")") If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
'添加 PCL 特供项 '添加 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) '检查是否有要求的版本(#5195)
If Not String.IsNullOrEmpty(Loader.Input) Then If Not String.IsNullOrEmpty(Loader.Input) Then
Dim Id = Loader.Input Dim Id = Loader.Input
@@ -308,7 +307,7 @@
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True) DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
Case LoadState.Loading Case LoadState.Loading
DlClientListLoader.WaitForExit(Id) DlClientListLoader.WaitForExit(Id)
Case LoadState.Failed, LoadState.Interrupted, LoadState.Waiting Case LoadState.Failed, LoadState.Canceled, LoadState.Waiting
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True) DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
End Select End Select
'重新查找版本 '重新查找版本
@@ -447,7 +446,7 @@
''' </summary> ''' </summary>
Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain) Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult)) 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 Try
Dim Versions As New List(Of DlOptiFineListEntry) Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json For Each Token As JObject In Json
@@ -531,8 +530,8 @@
''' </summary> ''' </summary>
Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain) Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult)) Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Dim Result As JArray = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
Encoding:=Encoding.Default, RequireJson:=True)) Encoding:=Encoding.Default, RequireJson:=True).DeserializeJson()
Dim Names As List(Of String) = Result.Select(Function(v) v.ToString).ToList Dim Names As List(Of String) = Result.Select(Function(v) v.ToString).ToList
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足") If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足")
Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names} Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names}
@@ -738,8 +737,8 @@
''' Forge 版本列表,BMCLAPI。 ''' Forge 版本列表,BMCLAPI。
''' </summary> ''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Dim Json As JArray = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4,#4057 Loader.Input.Replace("-", "_"), RequireJson:=True).DeserializeJson() '兼容 Forge 1.7.10-pre4,#4057
Dim Versions As New List(Of DlForgeVersionEntry) Dim Versions As New List(Of DlForgeVersionEntry)
Try Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input) Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -1026,7 +1025,7 @@
''' </summary> ''' </summary>
Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain) Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult)) 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 Try
Dim Json As JObject = Result("versions") Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry) Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -1054,7 +1053,7 @@
''' </summary> ''' </summary>
Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain) Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult)) 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 Try
Dim Json As JObject = Result("versions") Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry) Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -1125,7 +1124,7 @@
''' </summary> ''' </summary>
Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain) Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain)
Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult)) 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 Try
Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result} 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("获取到的列表缺乏必要项") 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> ''' </summary>
Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain) Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult)) 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 Try
Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result} 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("获取到的列表缺乏必要项") 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 = "" Dim Exs As String = ""
For Each Source In Urls For Each Source In Urls
Try 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 Catch ex As Exception
Exs += ex.Message + vbCrLf Exs += ex.Message + vbCrLf
End Try End Try
@@ -1328,7 +1327,7 @@
If SubLoader.Key.State = LoadState.Finished Then If SubLoader.Key.State = LoadState.Finished Then
'检查加载器成功 '检查加载器成功
MainLoader.Output = SubLoader.Key.Output MainLoader.Output = SubLoader.Key.Output
DlSourceLoaderInterrupt(LoaderList) DlSourceLoaderCancel(LoaderList)
Return Return
ElseIf BeforeLoadersAllFailed Then ElseIf BeforeLoadersAllFailed Then
'此前的加载器全部失败,直接启动后续加载器 '此前的加载器全部失败,直接启动后续加载器
@@ -1360,7 +1359,7 @@
End If End If
Next Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时") If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderInterrupt(LoaderList) DlSourceLoaderCancel(LoaderList)
Throw ErrorInfo Throw ErrorInfo
End If End If
Exit For Exit For
@@ -1369,15 +1368,15 @@
Thread.Sleep(10) Thread.Sleep(10)
WaitCycle += 1 WaitCycle += 1
'检查父加载器中断 '检查父加载器中断
If MainLoader.IsInterrupted Then If MainLoader.IsCanceled Then
DlSourceLoaderInterrupt(LoaderList) DlSourceLoaderCancel(LoaderList)
Return Return
End If End If
Loop Loop
End Sub 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 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 Next
End Sub End Sub
File diff suppressed because it is too large Load Diff
@@ -1,4 +1,4 @@
Public Module ModLaunch Public Module ModLaunch
#Region "开始" #Region "开始"
@@ -81,7 +81,7 @@
Public McLaunchWatcher As Watcher Public McLaunchWatcher As Watcher
Private Sub McLaunchState(Loader As LoaderTask(Of McLaunchOptions, Object)) Private Sub McLaunchState(Loader As LoaderTask(Of McLaunchOptions, Object))
Select Case McLaunchLoader.State Select Case McLaunchLoader.State
Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Interrupted Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Canceled
FrmLaunchLeft.PageChangeToLogin() FrmLaunchLeft.PageChangeToLogin()
Case LoadState.Loading Case LoadState.Loading
'在预检测结束后再触发动画 '在预检测结束后再触发动画
@@ -91,7 +91,7 @@
''' <summary> ''' <summary>
''' 指定启动中断时的提示文本。若不为 Nothing 则会显示为绿色。 ''' 指定启动中断时的提示文本。若不为 Nothing 则会显示为绿色。
''' </summary> ''' </summary>
Private InterruptHint As String = Nothing Private CanceledHint As String = Nothing
'实际的启动方法 '实际的启动方法
Private Sub McLaunchStart(Loader As LoaderTask(Of McLaunchOptions, Object)) Private Sub McLaunchStart(Loader As LoaderTask(Of McLaunchOptions, Object))
@@ -102,7 +102,7 @@
McLaunchPrecheck() McLaunchPrecheck()
McLaunchLog("预检测已通过") McLaunchLog("预检测已通过")
Catch ex As Exception 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 Throw
End Try End Try
Dim IsSavingBatch As Boolean = CurrentLaunchOptions?.SaveBatch IsNot Nothing Dim IsSavingBatch As Boolean = CurrentLaunchOptions?.SaveBatch IsNot Nothing
@@ -113,7 +113,7 @@
Dim Loaders As New List(Of LoaderBase) From { Dim Loaders As New List(Of LoaderBase) From {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False}, New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
McLoginLoader, '.ProgressWeight = 15, .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 String, Integer)("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2}, New LoaderTask(Of Integer, Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1}, New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
@@ -138,7 +138,7 @@
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器 If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
'等待加载器执行并更新 UI '等待加载器执行并更新 UI
McLaunchLoaderReal = LaunchLoader McLaunchLoaderReal = LaunchLoader
InterruptHint = Nothing CanceledHint = Nothing
LaunchLoader.Start() LaunchLoader.Start()
'任务栏进度条 '任务栏进度条
LoaderTaskbarAdd(LaunchLoader) LoaderTaskbarAdd(LaunchLoader)
@@ -157,11 +157,11 @@
"Version", McInstanceSelected.VersionDisplayName, "Version", McInstanceSelected.VersionDisplayName,
"LoginType", Settings.Get(Of McLoginType)("LoginType").ToString) "LoginType", Settings.Get(Of McLoginType)("LoginType").ToString)
End If End If
Case LoadState.Interrupted Case LoadState.Canceled
If InterruptHint Is Nothing Then If CanceledHint Is Nothing Then
Hint(If(IsSavingBatch, "已取消导出启动脚本!", "已取消启动!"), HintType.Blue) Hint(If(IsSavingBatch, "已取消导出启动脚本!", "已取消启动!"), HintType.Blue)
Else Else
Hint(InterruptHint, HintType.Green) Hint(CanceledHint, HintType.Green)
End If End If
Case LoadState.Failed Case LoadState.Failed
Throw LaunchLoader.Error Throw LaunchLoader.Error
@@ -169,12 +169,12 @@
Throw New Exception("错误的状态改变:" & LaunchLoader.State.ToString()) Throw New Exception("错误的状态改变:" & LaunchLoader.State.ToString())
End Select End Select
Catch ex As Exception Catch ex As Exception
ex.ThrowIfCanceled()
Dim CurrentEx = ex Dim CurrentEx = ex
NextInner: NextInner:
If CurrentEx.Message.StartsWithF("$") Then If CurrentEx.Message.StartsWithF("$") Then
'若有以 $ 开头的错误信息,则以此为准显示提示 '若有以 $ 开头的错误信息,则以此为准显示提示
'若错误信息为 $$,则不提示 MyMsgBox(CurrentEx.Message.TrimStart("$"), If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
Throw Throw
ElseIf CurrentEx.InnerException IsNot Nothing Then ElseIf CurrentEx.InnerException IsNot Nothing Then
'检查下一级错误 '检查下一级错误
@@ -208,7 +208,7 @@ NextInner:
PageOtherTest.MemoryOptimize(False) PageOtherTest.MemoryOptimize(False)
Finished = True Finished = True
End Sub, "Launch Memory Optimize") 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 If Loader.Progress < 0.7 Then
Loader.Progress += 0.007 '10s Loader.Progress += 0.007 '10s
Else Else
@@ -273,7 +273,7 @@ NextInner:
Hint("游戏将以试玩模式启动!", HintType.Red) Hint("游戏将以试玩模式启动!", HintType.Red)
CurrentLaunchOptions.ExtraGameArgs.Add("--demo") CurrentLaunchOptions.ExtraGameArgs.Add("--demo")
Case 3 Case 3
Throw New Exception("$$") Throw New OperationCanceledException
End Select End Select
End If End If
End If End If
@@ -353,7 +353,8 @@ NextInner:
Type = McLoginType.Ms Type = McLoginType.Ms
End Sub End Sub
Public Overrides Function GetHashCode() As Integer 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 Function
End Class End Class
Public Class McLoginLegacy 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 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 Public Function McLoginInput() As McLoginData
Dim LoginData As McLoginData = Nothing Dim LoginData As McLoginData = Nothing
Dim LoginType As McLoginType = Settings.Get(Of McLoginType)("LoginType") Dim LoginType = Settings.Get(Of McLoginType)("LoginType")
Try Try
Select Case LoginType Select Case LoginType
Case McLoginType.Legacy Case McLoginType.Legacy
@@ -489,10 +490,10 @@ NextInner:
LoginData = PageLoginAuthSkin.GetLoginData() LoginData = PageLoginAuthSkin.GetLoginData()
End If End If
End Select End Select
Catch ex As Exception
Logger.Error(ex, $"获取登录输入信息失败({LoginType})")
End Try
Return LoginData Return LoginData
Catch ex As Exception
Throw New Exception($"获取登录输入信息失败({LoginType})", ex)
End Try
End Function End Function
Private Sub McLoginStart(Data As LoaderTask(Of McLoginData, McLoginResult)) Private Sub McLoginStart(Data As LoaderTask(Of McLoginData, McLoginResult))
McLaunchLog("登录加载已开始") McLaunchLog("登录加载已开始")
@@ -559,24 +560,24 @@ Relogin:
OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken) OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken)
If OAuthTokens.OAuthAccessToken = "Relogin" Then GoTo Relogin '要求重新打开登录网页认证 If OAuthTokens.OAuthAccessToken = "Relogin" Then GoTo Relogin '要求重新打开登录网页认证
End If End If
If Data.IsInterrupted Then Throw New ThreadInterruptedException If Data.IsCanceled Then Throw New OperationCanceledException
Data.Progress = 0.25 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 OAuthAccessToken As String = OAuthTokens.OAuthAccessToken
Dim OAuthRefreshToken As String = OAuthTokens.OAuthRefreshToken Dim OAuthRefreshToken As String = OAuthTokens.OAuthRefreshToken
Dim XBLToken As String = MsLoginStep2(OAuthAccessToken) Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
Data.Progress = 0.4 Data.Progress = 0.4
If Data.IsInterrupted Then Throw New ThreadInterruptedException If Data.IsCanceled Then Throw New OperationCanceledException
Dim Tokens = MsLoginStep3(XBLToken) Dim Tokens = MsLoginStep3(XBLToken)
Data.Progress = 0.55 Data.Progress = 0.55
If Data.IsInterrupted Then Throw New ThreadInterruptedException If Data.IsCanceled Then Throw New OperationCanceledException
Dim LoginResult = MsLoginStep4(Tokens) Dim LoginResult = MsLoginStep4(Tokens)
ExpiresAt = LoginResult.ExpiresAt ExpiresAt = LoginResult.ExpiresAt
Data.Progress = 0.7 Data.Progress = 0.7
If Data.IsInterrupted Then Throw New ThreadInterruptedException If Data.IsCanceled Then Throw New OperationCanceledException
MsLoginStep5(LoginResult.AccessToken) MsLoginStep5(LoginResult.AccessToken)
Data.Progress = 0.85 Data.Progress = 0.85
If Data.IsInterrupted Then Throw New ThreadInterruptedException If Data.IsCanceled Then Throw New OperationCanceledException
Dim Result = MsLoginStep6(LoginResult.AccessToken) Dim Result = MsLoginStep6(LoginResult.AccessToken)
Data.Progress = 0.98 Data.Progress = 0.98
'输出登录结果 '输出登录结果
@@ -586,14 +587,14 @@ Relogin:
Settings.Set("CacheMsV2Name", Result.UserName) Settings.Set("CacheMsV2Name", Result.UserName)
Settings.Set("CacheMsV2ProfileJson", Result.ProfileJson) Settings.Set("CacheMsV2ProfileJson", Result.ProfileJson)
Settings.Set("CacheMsV2Expires", LoginResult.ExpiresAt) 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.Remove(Input.UserName) '如果更改了玩家名……
MsJson(Result.UserName) = OAuthRefreshToken MsJson(Result.UserName) = OAuthRefreshToken
Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None)) 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} Data.Output = New McLoginResult With {.AccessToken = LoginResult.AccessToken, .Name = Result.UserName, .Uuid = Result.UUID, .Type = "Microsoft", .ClientToken = Result.UUID, .ProfileJson = Result.ProfileJson}
'结束 '结束
SkipLogin: SkipLogin:
McLaunchLog($"微软登录结束,AccessToken 将在 {DateTimeOffset.FromUnixTimeSeconds(ExpiresAt).Date.ToLocalTime} 过期") McLaunchLog($"微软登录结束,AccessToken 将在 {DateTimeOffset.FromUnixTimeSeconds(ExpiresAt).LocalDateTime} 过期")
Settings.Set("HintBuy", True) '关闭正版购买提示 Settings.Set("HintBuy", True) '关闭正版购买提示
If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持!" & vbCrLf & "隐藏主题 跳票红 已解锁!", "提示") If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持!" & vbCrLf & "隐藏主题 跳票红 已解锁!", "提示")
End Sub End Sub
@@ -612,7 +613,7 @@ SkipLogin:
Settings.Get(Of String)("Cache" & Input.Token & "Name") <> "" Then Settings.Get(Of String)("Cache" & Input.Token & "Name") <> "" Then
'尝试验证登录 '尝试验证登录
Try Try
If Data.IsInterrupted Then Throw New ThreadInterruptedException If Data.IsCanceled Then Throw New OperationCanceledException
McLoginRequestValidate(Data) McLoginRequestValidate(Data)
GoTo LoginFinish GoTo LoginFinish
Catch ex As Exception Catch ex As Exception
@@ -623,7 +624,7 @@ SkipLogin:
'尝试刷新登录 '尝试刷新登录
Refresh: Refresh:
Try Try
If Data.IsInterrupted Then Throw New ThreadInterruptedException If Data.IsCanceled Then Throw New OperationCanceledException
McLoginRequestRefresh(Data, NeedRefresh) McLoginRequestRefresh(Data, NeedRefresh)
GoTo LoginFinish GoTo LoginFinish
Catch ex As Exception Catch ex As Exception
@@ -634,7 +635,7 @@ Refresh:
End If End If
'尝试普通登录 '尝试普通登录
Try Try
If Data.IsInterrupted Then Throw New ThreadInterruptedException If Data.IsCanceled Then Throw New OperationCanceledException
NeedRefresh = McLoginRequestLogin(Data) NeedRefresh = McLoginRequestLogin(Data)
Catch ex As Exception Catch ex As Exception
McLaunchLog("登录失败:" & ex.GetDisplay(True)) McLaunchLog("登录失败:" & ex.GetDisplay(True))
@@ -718,7 +719,7 @@ LoginFinish:
End Sub End Sub
Private Sub McLoginRequestRefresh(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult), RequestUser As Boolean) Private Sub McLoginRequestRefresh(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult), RequestUser As Boolean)
McLaunchLog("刷新登录开始(Refresh, " & Data.Input.Token & ")") McLaunchLog("刷新登录开始(Refresh, " & Data.Input.Token & ")")
Dim LoginJson As JObject = GetJson(NetRequestByClientRetry( Dim LoginJson As JObject = NetRequestByClientRetry(
Data.Input.BaseUrl & "/refresh", HttpMethod.Post, Data.Input.BaseUrl & "/refresh", HttpMethod.Post,
Content:=New JObject( Content:=New JObject(
New JProperty("selectedProfile", New JObject( New JProperty("selectedProfile", New JObject(
@@ -729,7 +730,7 @@ LoginFinish:
New JProperty("requestUser", True) New JProperty("requestUser", True)
).ToString(Newtonsoft.Json.Formatting.None), ).ToString(Newtonsoft.Json.Formatting.None),
Headers:={{"Accept-Language", "zh-CN"}}, 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") & " 无效!") If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Settings.Get(Of String)("Cache" & Data.Input.Token & "Name") & " 无效!")
Data.Output.AccessToken = LoginJson("accessToken").ToString Data.Output.AccessToken = LoginJson("accessToken").ToString
@@ -755,11 +756,11 @@ LoginFinish:
New JProperty("username", Data.Input.UserName), New JProperty("username", Data.Input.UserName),
New JProperty("password", Data.Input.Password), New JProperty("password", Data.Input.Password),
New JProperty("requestUser", True)) New JProperty("requestUser", True))
Dim LoginJson As JObject = GetJson(NetRequestByClientRetry( Dim LoginJson As JObject = NetRequestByClientRetry(
Data.Input.BaseUrl & "/authenticate", HttpMethod.Post, Data.Input.BaseUrl & "/authenticate", HttpMethod.Post,
Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None), Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
Headers:={{"Accept-Language", "zh-CN"}}, 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 LoginJson("availableProfiles").Count = 0 Then
If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色,无法更换!", HintType.Red) If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色,无法更换!", HintType.Red)
@@ -824,7 +825,7 @@ LoginFinish:
Dim ErrorMessage As String = Nothing Dim ErrorMessage As String = Nothing
Try Try
Dim Response = DirectCast(ex, HttpRequestCodeException).Response 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 Catch
End Try End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
@@ -874,14 +875,14 @@ LoginFinish:
'初始请求 '初始请求
Retry: Retry:
McLaunchLog("开始微软登录步骤 1/6(原始登录)") 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", 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) McLaunchLog("网页登录地址:" & PrepareJson("verification_uri").ToString)
'弹窗 '弹窗
Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login} Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
WaitingMyMsgBox.Add(Converter) WaitingMyMsgBox.Enqueue(Converter)
While Converter.Result Is Nothing While Converter.Result Is Nothing
Thread.Sleep(100) Thread.Sleep(100)
End While End While
@@ -891,7 +892,7 @@ Retry:
Button2Action:=Sub() OpenWebsite("https://account.live.com/password/Change")) = 1 Then Button2Action:=Sub() OpenWebsite("https://account.live.com/password/Change")) = 1 Then
GoTo Retry GoTo Retry
Else Else
Throw New Exception("$$") Throw New OperationCanceledException
End If End If
ElseIf TypeOf Converter.Result Is Exception Then ElseIf TypeOf Converter.Result Is Exception Then
Throw CType(Converter.Result, Exception) Throw CType(Converter.Result, Exception)
@@ -906,7 +907,7 @@ Retry:
Dim Result As String Dim Result As String
Try Try
Result = NetRequestByClientMultiple("https://login.live.com/oauth20_token.srf", HttpMethod.Post, 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", ContentType:="application/x-www-form-urlencoded",
Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}}, Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}},
ThreadCount:=2) ThreadCount:=2)
@@ -919,16 +920,16 @@ Retry:
Return ("Relogin", "") Return ("Relogin", "")
ElseIf Response.Contains("Account security interrupt") Then ElseIf Response.Contains("Account security interrupt") Then
MyMsgBox("该账号由于安全问题无法登陆,请前往微软账户页获取更多信息。", "登录失败", "我知道了", IsWarn:=True) MyMsgBox("该账号由于安全问题无法登陆,请前往微软账户页获取更多信息。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$") Throw New OperationCanceledException
ElseIf Response.Contains("service abuse") Then ElseIf Response.Contains("service abuse") Then
MyMsgBox("非常抱歉,该账号已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True) MyMsgBox("非常抱歉,该账号已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$") Throw New OperationCanceledException
Else Else
Throw Throw
End If End If
End Try End Try
Dim ResultJson As JObject = GetJson(Result) Dim ResultJson As JObject = Result.DeserializeJson()
Dim AccessToken As String = ResultJson("access_token").ToString Dim AccessToken As String = ResultJson("access_token").ToString
Dim RefreshToken As String = ResultJson("refresh_token").ToString Dim RefreshToken As String = ResultJson("refresh_token").ToString
Return (AccessToken, RefreshToken) Return (AccessToken, RefreshToken)
@@ -946,9 +947,8 @@ Retry:
""RelyingParty"": ""http://auth.xboxlive.com"", ""RelyingParty"": ""http://auth.xboxlive.com"",
""TokenType"": ""JWT"" ""TokenType"": ""JWT""
}" }"
Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post, Return NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
Content:=Request, ContentType:="application/json", RequireJson:=True) Content:=Request, ContentType:="application/json", RequireJson:=True).DeserializeJson()("Token").ToString
Return GetJson(Result)("Token").ToString
End Function End Function
'微软登录步骤 3:从 XBLToken 获取 {XSTSToken, UHS} '微软登录步骤 3:从 XBLToken 获取 {XSTSToken, UHS}
Private Function MsLoginStep3(XBLToken As String) As (XSTSToken As String, UHS As String) 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 '参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
If ex.Response.Contains("2148916227") Then If ex.Response.Contains("2148916227") Then
MyMsgBox("该账号似乎已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True) MyMsgBox("该账号似乎已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$") Throw New OperationCanceledException
ElseIf ex.Response.Contains("2148916233") Then ElseIf ex.Response.Contains("2148916233") Then
If MyMsgBox("你尚未注册 Xbox 账户,请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then If MyMsgBox("你尚未注册 Xbox 账户,请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then
OpenWebsite("https://signup.live.com/signup") OpenWebsite("https://signup.live.com/signup")
End If End If
Throw New Exception("$$") Throw New OperationCanceledException
ElseIf ex.Response.Contains("2148916235") Then ElseIf ex.Response.Contains("2148916235") Then
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN,然后再试。", "登录失败", "我知道了") MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN,然后再试。", "登录失败", "我知道了")
Throw New Exception("$$") Throw New OperationCanceledException
ElseIf ex.Response.Contains("2148916238") Then ElseIf ex.Response.Contains("2148916238") Then
If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf & If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf &
"该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then "该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
@@ -990,13 +990,13 @@ Retry:
MyMsgBox("请根据打开的网页的说明,修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf & MyMsgBox("请根据打开的网页的说明,修改账号的出生日期(至少改为 18 岁以上)。" & vbCrLf &
"在修改成功后等待一分钟,然后再回到 PCL,就可以正常登录了!", "登录提示") "在修改成功后等待一分钟,然后再回到 PCL,就可以正常登录了!", "登录提示")
End If End If
Throw New Exception("$$") Throw New OperationCanceledException
Else Else
Throw Throw
End If End If
End Try End Try
Dim ResultJson As JObject = GetJson(Result) Dim ResultJson As JObject = Result.DeserializeJson()
Return ( Return (
ResultJson("Token").ToString(), 'XSTSToken ResultJson("Token").ToString(), 'XSTSToken
ResultJson("DisplayClaims")("xui")(0)("uhs").ToString() 'UHS ResultJson("DisplayClaims")("xui")(0)("uhs").ToString() 'UHS
@@ -1018,15 +1018,18 @@ Retry:
ElseIf ex.StatusCode = HttpStatusCode.Forbidden Then ElseIf ex.StatusCode = HttpStatusCode.Forbidden Then
Logger.Warn(ex, "微软登录第 4 步汇报 403") Logger.Warn(ex, "微软登录第 4 步汇报 403")
Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器,请把它们关掉或更换节点后再试!") 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 ElseIf ex.Response?.Contains("ACCOUNT_SUSPENDED") Then '#8655
MyMsgBox("该账号似乎已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True) MyMsgBox("该账号似乎已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$") Throw New OperationCanceledException
Else Else
Throw Throw
End If End If
End Try End Try
Dim ResultJson As JObject = GetJson(Result) Dim ResultJson As JObject = Result.DeserializeJson()
Return ( Return (
ResultJson("access_token").ToString, ResultJson("access_token").ToString,
ResultJson("expires_in").ToObject(Of Integer) + GetUnixTimestampUtc() - 1200) '提前 20 分钟视作过期 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", Dim Result As String = NetRequestByClientMultiple("https://api.minecraftservices.com/entitlements/mcstore",
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True) ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
Try Try
Dim ResultJson As JObject = GetJson(Result) Dim ResultJson As JObject = Result.DeserializeJson()
If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
Select Case MyMsgBox("你尚未购买正版 Minecraft,或者 Xbox Game Pass 已到期。", "登录失败", "购买 Minecraft", "取消") Select Case MyMsgBox("你尚未购买正版 Minecraft,或者 Xbox Game Pass 已到期。", "登录失败", "购买 Minecraft", "取消")
Case 1 Case 1
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj") OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End Select End Select
Throw New Exception("$$") Throw New OperationCanceledException
End If End If
Catch ex As Exception Catch ex As Exception
Logger.Warn(ex, $"微软登录第 5 步异常:{Result}") Logger.Warn(ex, $"微软登录第 5 步异常:{Result}")
@@ -1073,12 +1076,12 @@ Retry:
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile") OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
End Select End Select
End Sub, "Login Failed: Create Profile") End Sub, "Login Failed: Create Profile")
Throw New Exception("$$") Throw New OperationCanceledException
Case Else Case Else
Throw Throw
End Select End Select
End Try End Try
Dim ResultJson As JObject = GetJson(Result) Dim ResultJson As JObject = Result.DeserializeJson()
Dim UUID As String = ResultJson("id").ToString Dim UUID As String = ResultJson("id").ToString
Dim UserName As String = ResultJson("name").ToString Dim UserName As String = ResultJson("name").ToString
Return (UUID, UserName, Result) Return (UUID, UserName, Result)
@@ -1131,7 +1134,7 @@ Retry:
If Len(Uuid) = 32 Then Return Uuid If Len(Uuid) = 32 Then Return Uuid
'从官网获取 '从官网获取
Try 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 & ")") If GotJson Is Nothing Then Throw New FileNotFoundException("正版玩家档案不存在(" & Name & ")")
Uuid = If(GotJson("id"), "") Uuid = If(GotJson("id"), "")
Catch ex As Exception Catch ex As Exception
@@ -1156,183 +1159,16 @@ Retry:
#Region "Java 处理" #Region "Java 处理"
Public McLaunchJavaSelected As JavaEntry = Nothing Public McLaunchJavaSelected As Java = Nothing
Private Sub McLaunchJava(Task As LoaderTask(Of Integer, Integer)) 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) McLaunchJavaSelected = SelectOrDownloadJava(McInstanceSelected, True, Task.CreateCancellationToken, Task.CreateSyncProgressProvider)
If Task.IsCanceled Then Return
'原版 26-:通过版本号判断 If McLaunchJavaSelected Is Nothing Then Throw New OperationCanceledException 'SelectOrDownloadJava 已经会给予适当的提示
If (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2024, 4, 2)) OrElse If ModeDebug Then
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla >= New Version(20, 0, 5)) Then McLaunchLog($"预期 Java 版本范围:{GetJavaRequirement(McInstanceSelected).Range}")
'1.20.5+(24w14a+):至少 Java 21 McLaunchLog($"Java 版本设置类别:{Settings.Get(Of Integer)("VersionArgumentJavaV2", McInstanceSelected)}")
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)
End If 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) 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
End Sub End Sub
#End Region #End Region
@@ -1427,7 +1263,7 @@ NextInstance:
End If End If
'Authlib-Injector 'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then 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) Dim Server As String = Settings.Get(Of String)("VersionServerAuthServer", Instance:=McInstanceSelected)
Try Try
McLaunchLog($"开始 Authlib Injector Prefetch") McLaunchLog($"开始 Authlib Injector Prefetch")
@@ -1444,13 +1280,13 @@ NextInstance:
'非 GBK 编码下命令行参数乱码的问题(JDK-8272352) '非 GBK 编码下命令行参数乱码的问题(JDK-8272352)
Dim UseJLW As Boolean = Dim UseJLW As Boolean =
Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableJLW", McInstanceSelected) AndAlso 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 If UseJLW AndAlso CustomArg.Contains("-javaagent") Then
UseJLW = False UseJLW = False
McLaunchLog("由于使用了自定义 javaagent,已禁用 JLW,这可能导致游戏崩溃!", LogLevel.Warn) McLaunchLog("由于使用了自定义 javaagent,已禁用 JLW,这可能导致游戏崩溃!", LogLevel.Warn)
End If End If
If UseJLW Then 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") Args.Add("--add-exports") : Args.Add("cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
End If End If
Args.Add("-Doolloo.jlw.tmpdir=${pure_directory}") '这里需要不以 \ 结尾 Args.Add("-Doolloo.jlw.tmpdir=${pure_directory}") '这里需要不以 \ 结尾
@@ -1467,7 +1303,7 @@ NextInstance:
#Region "内存管理" #Region "内存管理"
McLaunchLog("当前剩余内存:" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G") 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") Args.Add("-Xmx" & TargetRam & "m")
'获取设置的管理方式 '获取设置的管理方式
@@ -1480,17 +1316,17 @@ NextInstance:
If SetupType <> 3 Then If SetupType <> 3 Then
'确定是使用 G1GC 还是 ZGC '确定是使用 G1GC 还是 ZGC
Dim UseG1GC As Boolean = False Dim UseG1GC As Boolean = False
If (SetupType = 0 AndAlso McLaunchJavaSelected.MajorVersion < 15) OrElse If (SetupType = 0 AndAlso McLaunchJavaSelected.Version.Major < 15) OrElse
(SetupType = 1 AndAlso McLaunchJavaSelected.MajorVersion < 21) OrElse (SetupType = 1 AndAlso McLaunchJavaSelected.Version.Major < 21) OrElse
(SetupType = 2 OrElse SetupType = 4) Then UseG1GC = True '检查 Java 版本,ZGC 在 Java 15+ 可用,分代 ZGC 在 Java 21+ 可用 (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+ 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.MajorVersion}") McLaunchLog($"GC 设置:{SetupType},选取 {If(UseG1GC, "G1GC", "ZGC")},Java 版本:{McLaunchJavaSelected.Version.Major}")
'移除已有的 GC 参数 '移除已有的 GC 参数
Args = Args.Where(Function(a) Not a.RegexCheck( 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 "( )*-XX:[+-]?(Use\w+GC|ZGenerational|UseCompactObjectHeaders|G1\w+Percent|G1\w+Size|(Max|Min)(GCPauseMillis|HeapFreeRatio))")).ToList
'添加 GC 参数 '添加 GC 参数
Args.Add("-XX:+UnlockExperimentalVMOptions") 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 If UseG1GC AndAlso SetupType = 4 Then
'优化的 G1GC '优化的 G1GC
Args.Add("-XX:+UseG1GC") Args.Add("-XX:+UseG1GC")
@@ -1499,10 +1335,10 @@ NextInstance:
Args.Add("-XX:G1HeapRegionSize=32M") Args.Add("-XX:G1HeapRegionSize=32M")
Args.Add("-XX:MaxGCPauseMillis=50") Args.Add("-XX:MaxGCPauseMillis=50")
If Not ModeDebug Then Args.Add("-XX:+PerfDisableSharedMem") If Not ModeDebug Then Args.Add("-XX:+PerfDisableSharedMem")
If McLaunchJavaSelected.MajorVersion <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286 If McLaunchJavaSelected.Version.Major <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
If McLaunchJavaSelected.MajorVersion = 8 Then Args.Add("-XX:+ParallelRefProcEnabled") If McLaunchJavaSelected.Version.Major = 8 Then Args.Add("-XX:+ParallelRefProcEnabled")
If McLaunchJavaSelected.MajorVersion >= 12 Then Args.Add("-XX:MinHeapFreeRatio=25") '需要比 G1NewSizePercent 大一点 If McLaunchJavaSelected.Version.Major >= 12 Then Args.Add("-XX:MinHeapFreeRatio=25") '需要比 G1NewSizePercent 大一点
If McLaunchJavaSelected.MajorVersion >= 12 Then Args.Add("-XX:MaxHeapFreeRatio=40") '需要比 MinHeapFreeRatio 大一些 If McLaunchJavaSelected.Version.Major >= 12 Then Args.Add("-XX:MaxHeapFreeRatio=40") '需要比 MinHeapFreeRatio 大一些
ElseIf UseG1GC Then ElseIf UseG1GC Then
'Mojang G1GC 'Mojang G1GC
Args.Add("-XX:+UseG1GC") Args.Add("-XX:+UseG1GC")
@@ -1510,11 +1346,11 @@ NextInstance:
Args.Add("-XX:G1ReservePercent=20") Args.Add("-XX:G1ReservePercent=20")
Args.Add("-XX:G1HeapRegionSize=32M") Args.Add("-XX:G1HeapRegionSize=32M")
Args.Add("-XX:MaxGCPauseMillis=50") 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 Else
'ZGC 'ZGC
Args.Add("-XX:+UseZGC") 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
End If End If
@@ -1526,9 +1362,9 @@ NextInstance:
Args.Add("-Dlog4j2.formatMsgNoLookups=true") Args.Add("-Dlog4j2.formatMsgNoLookups=true")
'编码(#4700、#5892、#5909) '编码(#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.Version.Major > 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.Version.Major > 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 >= 18 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dfile.encoding=")) Then Args.Add("-Dfile.encoding=COMPAT") 'Dfile.encoding 需要放在 Dstdout.encoding 后面(#6934)
'为 JLW 添加 -jar,它必须放在最后 '为 JLW 添加 -jar,它必须放在最后
If UseJLW Then If UseJLW Then
@@ -1597,7 +1433,9 @@ NextInstance:
McLaunchLog("发现错误的 OptiFineForge TweakClass,目前的游戏参数:" & Arg) McLaunchLog("发现错误的 OptiFineForge TweakClass,目前的游戏参数:" & Arg)
Arg = Arg.Replace(" --tweakClass optifine.OptiFineTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker" Arg = Arg.Replace(" --tweakClass optifine.OptiFineTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try 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 Catch ex As Exception
Logger.Warn(ex, "替换 OptiFineForge TweakClass 失败") Logger.Warn(ex, "替换 OptiFineForge TweakClass 失败")
End Try End Try
@@ -1690,9 +1528,9 @@ NextInstance:
TargetSize = New Size(854, 480) TargetSize = New Size(854, 480)
End Select End Select
If McInstanceSelected.Version.Vanilla.Major <= 12 AndAlso 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) 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.Width /= DPI / 96
TargetSize.Height /= DPI / 96 TargetSize.Height /= DPI / 96
End If End If
@@ -1843,7 +1681,7 @@ NextInstance:
Next 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 If ExistFiles.Contains(FileName) Then Continue For
Try Try
McLaunchLog("删除:" & FileName) McLaunchLog("删除:" & FileName)
@@ -1862,7 +1700,7 @@ NextInstance:
Private Function GetNativesFolder() As String Private Function GetNativesFolder() As String
Dim Result As String = PathUtils.AddSlashSuffix(PathUtils.ToShortPath(McInstanceSelected.PathVersion)) & McInstanceSelected.Name & "-natives\" Dim Result As String = PathUtils.AddSlashSuffix(PathUtils.ToShortPath(McInstanceSelected.PathVersion)) & McInstanceSelected.Name & "-natives\"
If Not (IsGBKEncoding OrElse Result.IsAsciiOnly()) Then 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 If Not Result.IsAsciiOnly() Then
Result = OsDrive & "ProgramData\PCL\natives\" Result = OsDrive & "ProgramData\PCL\natives\"
End If End If
@@ -1880,15 +1718,15 @@ NextInstance:
'使用高性能显卡 '使用高性能显卡
If Settings.Get(Of Boolean)("LaunchAdvanceGraphicCard") Then If Settings.Get(Of Boolean)("LaunchAdvanceGraphicCard") Then
Try Try
SetGPUPreference(McLaunchJavaSelected.PathJava) SetGPUPreference(McLaunchJavaSelected.JavaExePath)
SetGPUPreference(PathExe) SetGPUPreference(PathExe)
Catch ex As Exception Catch ex As Exception
If SystemUtils.HasAdminRole() Then If WindowsUtils.HasAdminRole() Then
Logger.Warn(ex, "直接调整显卡设置失败") Logger.Warn(ex, "直接调整显卡设置失败")
Else Else
Logger.Warn(ex, "直接调整显卡设置失败,将以管理员权限重启 PCL 再次尝试") Logger.Warn(ex, "直接调整显卡设置失败,将以管理员权限重启 PCL 再次尝试")
Try Try
If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJava}""") = ProcessReturnValues.TaskDone Then If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.JavaExePath}""") = ProcessReturnValues.TaskDone Then
McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功") McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功")
Else Else
Throw New Exception("调整过程中出现异常") Throw New Exception("调整过程中出现异常")
@@ -1924,9 +1762,9 @@ NextInstance:
""profile"": ""66666555554444433333222221111100"" ""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) Profiles.Merge(ReplaceJson)
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030")) FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已更新 launcher_profiles.json") McLaunchLog("已更新 launcher_profiles.json")
@@ -1954,9 +1792,9 @@ NextInstance:
""profile"": ""66666555554444433333222221111100"" ""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) Profiles.Merge(ReplaceJson)
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030")) FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已在删除后更新 launcher_profiles.json") McLaunchLog("已在删除后更新 launcher_profiles.json")
@@ -2026,7 +1864,7 @@ NextInstance:
Try Try
Dim ZipFileAddress As String = McInstanceSelected.PathIndie & "resourcepacks\PCL2 Skin.zip" 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 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 MetaFileAddress As String = PathTemp & "pack.mcmeta"
Dim PackPicAddress As String = PathTemp & "pack.png" Dim PackPicAddress As String = PathTemp & "pack.png"
Dim PackFormat As Integer Dim PackFormat As Integer
@@ -2076,12 +1914,12 @@ NextInstance:
Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png") Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png")
Bit.Save(PackPicAddress) Bit.Save(PackPicAddress)
FileUtils.Write(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}") 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 If (McInstanceSelected.Version.Vanilla.Major = 6 OrElse McInstanceSelected.Version.Vanilla.Major = 7) AndAlso Skin.Pic.Height = 64 Then
McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪") McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪")
Skin = Skin.Clip(0, 0, 64, 32) Skin = Skin.Clip(0, 0, 64, 32)
End If 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 { Dim FilesToCompress As New Dictionary(Of String, String) From {
{"pack.mcmeta", MetaFileAddress}, {"pack.png", PackPicAddress}} {"pack.mcmeta", MetaFileAddress}, {"pack.png", PackPicAddress}}
@@ -2090,15 +1928,15 @@ NextInstance:
For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"} For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
FilesToCompress.Add( FilesToCompress.Add(
$"assets/minecraft/textures/entity/player/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png", $"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 Next
Else Else
FilesToCompress.Add( FilesToCompress.Add(
$"assets/minecraft/textures/entity/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "alex.png", "steve.png")}", $"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 End If
FileUtils.CreateZipFromFiles(ZipFileAddress, FilesToCompress) FileUtils.CreateZipFromFiles(ZipFileAddress, FilesToCompress)
FileUtils.Delete(PathExeFolder & "PCL\CustomSkin_Cliped.png") FileUtils.Delete(Paths.Base & "PCL\CustomSkin_Cliped.png")
'更改设置文件 '更改设置文件
IniClearCache(SetupFileAddress) IniClearCache(SetupFileAddress)
Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]") Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
@@ -2159,25 +1997,25 @@ IgnoreCustomSkin:
'输出 bat '输出 bat
Try Try
Dim CmdString As String = Dim CmdString As String =
$"{If(McLaunchJavaSelected.MajorVersion > 8, "chcp 65001>nul" & vbCrLf, "")}" & $"{If(McLaunchJavaSelected.Version.Major > 8, "chcp 65001>nul" & vbCrLf, "")}" &
"@echo off" & vbCrLf & "@echo off" & vbCrLf &
$"title 启动 - {McInstanceSelected.Name}" & vbCrLf & $"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
"echo 游戏正在启动,请稍候。" & vbCrLf & "echo 游戏正在启动,请稍候。" & vbCrLf &
$"cd /D ""{PathUtils.ToShortPath(McInstanceSelected.PathIndie)}""" & vbCrLf & $"cd /D ""{PathUtils.ToShortPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
CustomCommandGlobal & vbCrLf & CustomCommandGlobal & vbCrLf &
CustomCommandVersion & vbCrLf & CustomCommandVersion & vbCrLf &
$"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf & $"""{McLaunchJavaSelected.JavaExePath}"" {McLaunchArgument}" & vbCrLf &
"echo 游戏已退出。" & vbCrLf & "echo 游戏已退出。" & vbCrLf &
"pause" "pause"
FileUtils.Write( FileUtils.Write(
filePath:=If(CurrentLaunchOptions.SaveBatch, PathExeFolder & "PCL\LatestLaunch.bat"), filePath:=If(CurrentLaunchOptions.SaveBatch, Paths.Base & "PCL\LatestLaunch.bat"),
text:=FilterAccessToken(CmdString, "F").Replace("%", "%%"), 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 If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成,强制结束启动过程") McLaunchLog("导出启动脚本完成,强制结束启动过程")
InterruptHint = "导出启动脚本成功!" CanceledHint = "导出启动脚本成功!"
OpenExplorer(CurrentLaunchOptions.SaveBatch) OpenExplorer(CurrentLaunchOptions.SaveBatch)
Loader.Parent.Interrupt() Loader.Parent.Cancel()
Return '导出脚本完成 Return '导出脚本完成
End If End If
Catch ex As Exception Catch ex As Exception
@@ -2198,14 +2036,14 @@ IgnoreCustomSkin:
.CreateNoWindow = True .CreateNoWindow = True
}) })
If Settings.Get(Of Boolean)("LaunchAdvanceRunWait") Then If Settings.Get(Of Boolean)("LaunchAdvanceRunWait") Then
Do Until CustomProcess.HasExited OrElse Loader.IsInterrupted Do Until CustomProcess.HasExited OrElse Loader.IsCanceled
Thread.Sleep(10) Thread.Sleep(10)
Loop Loop
End If End If
Catch ex As Exception Catch ex As Exception
Logger.Error(ex, "执行全局自定义命令失败", LogBehavior.Toast) Logger.Error(ex, "执行全局自定义命令失败", LogBehavior.Toast)
Finally 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 McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183
CustomProcess.Kill() CustomProcess.Kill()
End If End If
@@ -2223,14 +2061,14 @@ IgnoreCustomSkin:
.CreateNoWindow = True .CreateNoWindow = True
}) })
If Settings.Get(Of Boolean)("VersionAdvanceRunWait", Instance:=McInstanceSelected) Then 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) Thread.Sleep(10)
Loop Loop
End If End If
Catch ex As Exception Catch ex As Exception
Logger.Error(ex, "执行版本自定义命令失败", LogBehavior.Toast) Logger.Error(ex, "执行版本自定义命令失败", LogBehavior.Toast)
Finally 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 McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183
CustomProcess.Kill() CustomProcess.Kill()
End If End If
@@ -2241,13 +2079,13 @@ IgnoreCustomSkin:
Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process)) 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 PathEnv As String = StartInfo.EnvironmentVariables("Path")
Dim Paths As New List(Of String) Dim Paths As New List(Of String)
If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";")) 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("Path") = Paths.Distinct.Join(";"c)
StartInfo.EnvironmentVariables("appdata") = PathUtils.ToShortPath(McFolderSelected) StartInfo.EnvironmentVariables("appdata") = PathUtils.ToShortPath(McFolderSelected)
@@ -2261,8 +2099,8 @@ IgnoreCustomSkin:
'开始进程 '开始进程
Dim GameProcess = StartProcess(StartInfo) Dim GameProcess = StartProcess(StartInfo)
McLaunchLog("已启动游戏进程:" & McLaunchJavaSelected.PathJava) McLaunchLog("已启动游戏进程:" & McLaunchJavaSelected.JavaExePath)
If Loader.IsInterrupted Then If Loader.IsCanceled Then
McLaunchLog("由于取消启动,已强制结束游戏进程") '#1631 McLaunchLog("由于取消启动,已强制结束游戏进程") '#1631
GameProcess.Kill() GameProcess.Kill()
Return Return
@@ -2294,13 +2132,12 @@ IgnoreCustomSkin:
McLaunchLog($"游戏版本:{McInstanceSelected.VersionDisplayName}({McInstanceSelected.Version.Vanilla},Drop {McInstanceSelected.Version.Drop}{If(McInstanceSelected.Version.Reliable, "", ",无法完全确定")})") McLaunchLog($"游戏版本:{McInstanceSelected.VersionDisplayName}({McInstanceSelected.Version.Vanilla},Drop {McInstanceSelected.Version.Drop}{If(McInstanceSelected.Version.Reliable, "", ",无法完全确定")})")
McLaunchLog("资源版本:" & McAssetsGetIndexName(McInstanceSelected)) McLaunchLog("资源版本:" & McAssetsGetIndexName(McInstanceSelected))
McLaunchLog("版本继承:" & If(McInstanceSelected.InheritName = "", "无", McInstanceSelected.InheritName)) 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("MC 文件夹:" & McFolderSelected)
McLaunchLog("版本文件夹:" & McInstanceSelected.PathVersion) McLaunchLog("版本文件夹:" & McInstanceSelected.PathVersion)
McLaunchLog("版本隔离:" & (McInstanceSelected.PathIndie = McInstanceSelected.PathVersion)) McLaunchLog("版本隔离:" & (McInstanceSelected.PathIndie = McInstanceSelected.PathVersion))
McLaunchLog("HMCL 格式:" & McInstanceSelected.IsHmclFormatJson) McLaunchLog("HMCL 格式:" & McInstanceSelected.IsHmclFormatJson)
McLaunchLog("Java 信息:" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java")) McLaunchLog("Java 信息:" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
McLaunchLog("环境变量:" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置"))
McLaunchLog("Natives 文件夹:" & GetNativesFolder()) McLaunchLog("Natives 文件夹:" & GetNativesFolder())
McLaunchLog("") McLaunchLog("")
McLaunchLog("~ 登录参数 ~") McLaunchLog("~ 登录参数 ~")
@@ -2325,7 +2162,7 @@ IgnoreCustomSkin:
Thread.Sleep(100) Thread.Sleep(100)
Loop Loop
If Watcher.State = Watcher.MinecraftState.Crashed Then If Watcher.State = Watcher.MinecraftState.Crashed Then
Throw New Exception("$$") Throw New OperationCanceledException
End If End If
End Sub End Sub
@@ -1,4 +1,4 @@
Public Module ModMinecraft Public Module ModMinecraft
#Region "文件夹" #Region "文件夹"
@@ -16,9 +16,9 @@
End Property End Property
Private Sub SetMcFolder(Value As String) '等同 McFolderSelected.Set Private Sub SetMcFolder(Value As String) '等同 McFolderSelected.Set
If _McFolderSelected = Value Then Return If _McFolderSelected = Value Then Return
_McFolderSelected = Value.Replace("$", PathExeFolder) _McFolderSelected = Value.Replace("$", Paths.Base)
_McFolderSelected = PathUtils.AddSlashSuffix(PathUtils.ForCompare(_McFolderSelected)) _McFolderSelected = PathUtils.AddSlashSuffix(PathUtils.ForCompare(_McFolderSelected))
Settings.Set("LaunchFolderSelect", Value.Replace(PathExeFolder, "$")) Settings.Set("LaunchFolderSelect", Value.Replace(Paths.Base, "$"))
Logger.Info($"当前选择的 Minecraft 文件夹:{_McFolderSelected}") Logger.Info($"当前选择的 Minecraft 文件夹:{_McFolderSelected}")
End Sub End Sub
Private _McFolderSelected As String Private _McFolderSelected As String
@@ -64,8 +64,8 @@
'扫描当前文件夹 '扫描当前文件夹
Try Try
If DirectoryUtils.Exists(PathExeFolder & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder, .Type = McFolder.Types.Vanilla}) 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(PathExeFolder).GetDirectories For Each Folder As DirectoryInfo In DirectoryUtils.GetInfo(Paths.Base).GetDirectories
If DirectoryUtils.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then 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}) CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathUtils.AddSlashSuffix(PathUtils.ForCompare(Folder.FullName)), .Type = McFolder.Types.Vanilla})
End If End If
@@ -75,7 +75,7 @@
End Try 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 '当前文件夹不是官启文件夹 If (Not CacheMcFolderList.Any OrElse MojangPath <> CacheMcFolderList(0).Location) AndAlso '当前文件夹不是官启文件夹
DirectoryUtils.Exists(MojangPath & "versions\") Then '具有权限且存在 versions 文件夹 DirectoryUtils.Exists(MojangPath & "versions\") Then '具有权限且存在 versions 文件夹
CacheMcFolderList.Add(New McFolder With {.Name = "官方启动器文件夹", .Location = MojangPath, .Type = McFolder.Types.Vanilla}) CacheMcFolderList.Add(New McFolder With {.Name = "官方启动器文件夹", .Location = MojangPath, .Type = McFolder.Types.Vanilla})
@@ -123,8 +123,8 @@
'若没有可用文件夹,则创建 .minecraft '若没有可用文件夹,则创建 .minecraft
If Not CacheMcFolderList.Any() Then If Not CacheMcFolderList.Any() Then
DirectoryUtils.Create(PathExeFolder & ".minecraft\versions\") DirectoryUtils.Create(Paths.Base & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder & ".minecraft\", .Type = McFolder.Types.Vanilla}) CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Paths.Base & ".minecraft\", .Type = McFolder.Types.Vanilla})
End If End If
For Each Folder As McFolder In CacheMcFolderList For Each Folder As McFolder In CacheMcFolderList
@@ -463,9 +463,9 @@ VersionSearchFinish:
If Not FileUtils.Exists(JsonPath) Then If Not FileUtils.Exists(JsonPath) Then
'尝试寻找 JSON 文件 '尝试寻找 JSON 文件
JsonPath = Nothing JsonPath = Nothing
For Each JsonCandidatePath In DirectoryUtils.GetFiles(PathVersion, True, "*.json") For Each JsonCandidatePath In DirectoryUtils.EnumerateFiles(PathVersion, searchPattern:="*.json")
Try 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("mainClass") Then Continue For
If Not JsonCandidate.ContainsKey("type") Then Continue For If Not JsonCandidate.ContainsKey("type") Then Continue For
If Not JsonCandidate.ContainsKey("id") Then Continue For If Not JsonCandidate.ContainsKey("id") Then Continue For
@@ -501,12 +501,12 @@ VersionSearchFinish:
If Not FastJsonCheck(_JsonText) Then If Not FastJsonCheck(_JsonText) Then
If RunInUi() Then If RunInUi() Then
Logger.Warn("版本 JSON 文件为空或有误,由于代码在主线程运行,将不再进行重试") Logger.Warn("版本 JSON 文件为空或有误,由于代码在主线程运行,将不再进行重试")
GetJson(_JsonText) '触发异常 _JsonText.DeserializeJson() '触发异常
Else Else
Logger.Warn($"版本 JSON 文件为空或有误,将在 2s 后重试读取({JsonPath})") Logger.Warn($"版本 JSON 文件为空或有误,将在 2s 后重试读取({JsonPath})")
Thread.Sleep(2000) Thread.Sleep(2000)
_JsonText = FileUtils.ReadAsString(JsonPath) _JsonText = FileUtils.ReadAsString(JsonPath)
If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常 If Not FastJsonCheck(_JsonText) Then _JsonText.DeserializeJson() '触发异常
End If End If
End If End If
End If End If
@@ -526,7 +526,7 @@ VersionSearchFinish:
If _JsonObject Is Nothing Then If _JsonObject Is Nothing Then
Dim Text As String = JsonText '触发 JsonText 的 Get 事件 Dim Text As String = JsonText '触发 JsonText 的 Get 事件
Try Try
_JsonObject = GetJson(Text) _JsonObject = Text.DeserializeJson()
'转换 HMCL 关键项 '转换 HMCL 关键项
If _JsonObject.ContainsKey("patches") AndAlso Not _JsonObject.ContainsKey("time") Then If _JsonObject.ContainsKey("patches") AndAlso Not _JsonObject.ContainsKey("time") Then
IsHmclFormatJson = True IsHmclFormatJson = True
@@ -626,7 +626,7 @@ Recheck:
Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json") Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json")
If VersionJson Is Nothing Then Exit Try If VersionJson Is Nothing Then Exit Try
Using VersionJsonStream As New StreamReader(VersionJson.Open) Using VersionJsonStream As New StreamReader(VersionJson.Open)
_JsonVersion = GetJson(VersionJsonStream.ReadToEnd) _JsonVersion = VersionJsonStream.ReadToEnd().DeserializeJson()
End Using End Using
End Using End Using
Catch ex As Exception Catch ex As Exception
@@ -659,22 +659,23 @@ Recheck:
End Property End Property
Private _InheritName As String = Nothing Private _InheritName As String = Nothing
Public Sub ResetIniCache() Public Config As JsonConfigProvider
Public Sub ResetSettingsCache()
IniClearCache(PathIndie & "options.txt") IniClearCache(PathIndie & "options.txt")
IniClearCache(PathVersion & "PCL\Setup.ini") IniClearCache(PathVersion & "PCL\Setup.ini")
Config.DiscardCache()
For Each Entry In Settings.Entries.Values For Each Entry In Settings.Entries.Values
If Entry.Source = Settings.Sources.Instance Then Entry.ValueCache.Remove(PathVersion) If Entry.Source = Settings.Sources.Instance Then Entry.ValueCache.Remove(PathVersion)
Next Next
End Sub End Sub
''' <summary> ''' <summary>
''' 从版本名,或版本文件夹的完整路径初始化(不规定是否以 \ 结尾)。 ''' 从版本名,或版本文件夹的完整路径初始化。
''' </summary> ''' </summary>
Public Sub New(Name As String) Public Sub New(NameOrFullPath As String)
Name = PathUtils.RemoveExtendedPrefix(Name) NameOrFullPath = PathUtils.RemoveExtendedPrefix(NameOrFullPath)
PathVersion = If(Name.Contains(":"), "", McFolderSelected & "versions\") & '补全完整路径 PathVersion = PathUtils.AddSlashSuffix(If(NameOrFullPath.Contains(":"), "", McFolderSelected & "versions\") & NameOrFullPath)
Name & Config = New JsonConfigProvider(Path.Combine(PathVersion, "PCL\config.json"))
If(Name.EndsWithF("\"), "", "\") '补全右划线
End Sub End Sub
''' <summary> ''' <summary>
@@ -1286,7 +1287,7 @@ ExitDataLoad:
GoTo OnLoaded GoTo OnLoaded
End If 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 If Not McInstanceListForceRefresh AndAlso Val(ReadIni(PathMc & "PCL.ini", "InstanceCache")) = FolderListCheck Then
'可以使用缓存 '可以使用缓存
Dim Result = InitMcInstanceListWithCache(PathMc) Dim Result = InitMcInstanceListWithCache(PathMc)
@@ -1307,7 +1308,7 @@ Reload:
'改变当前选择的版本 '改变当前选择的版本
OnLoaded: OnLoaded:
If Loader.IsInterrupted Then Return If Loader.IsCanceled Then Return
If McInstanceList.Any(Function(v) v.Key <> McInstanceCardType.Error) Then If McInstanceList.Any(Function(v) v.Key <> McInstanceCardType.Error) Then
'尝试读取已储存的选择 '尝试读取已储存的选择
Dim SavedSelection As String = ReadIni(PathMc & "PCL.ini", "Version") Dim SavedSelection As String = ReadIni(PathMc & "PCL.ini", "Version")
@@ -1333,9 +1334,8 @@ OnLoaded:
Logger.Info("未找到可用 Minecraft 版本") Logger.Info("未找到可用 Minecraft 版本")
End If End If
If Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000)) If Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000))
Catch ex As ThreadInterruptedException
Catch ex As Exception Catch ex As Exception
If Loader.IsInterrupted Then Return '#5617 If Loader.IsCanceled OrElse ex.IsCanceled Then Return '#5617
WriteIni(PathMc & "PCL.ini", "InstanceCache", "") '要求下次重新加载 WriteIni(PathMc & "PCL.ini", "InstanceCache", "") '要求下次重新加载
Logger.Error(ex, "加载 .minecraft 版本列表失败") Logger.Error(ex, "加载 .minecraft 版本列表失败")
End Try End Try
@@ -1716,7 +1716,7 @@ OnLoaded:
'处理皮肤地址 '处理皮肤地址
Dim SkinValue As String Dim SkinValue As String
Try Try
For Each SkinProperty In GetJson(SkinString)("properties") For Each SkinProperty In SkinString.DeserializeJson()("properties")
If SkinProperty("name") = "textures" Then If SkinProperty("name") = "textures" Then
SkinValue = SkinProperty("value") SkinValue = SkinProperty("value")
Exit Try Exit Try
@@ -1728,7 +1728,7 @@ OnLoaded:
Throw New Exception("皮肤返回值中不包含皮肤数据项,可能是未设置自定义皮肤的用户", ex) Throw New Exception("皮肤返回值中不包含皮肤数据项,可能是未设置自定义皮肤的用户", ex)
End Try End Try
SkinString = Encoding.UTF8.GetString(Convert.FromBase64String(SkinValue)) 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 If SkinJson("textures") Is Nothing OrElse SkinJson("textures")("skin") Is Nothing OrElse SkinJson("textures")("skin")("url") Is Nothing Then
Throw New Exception("用户未设置自定义皮肤") Throw New Exception("用户未设置自定义皮肤")
Else Else
@@ -1751,7 +1751,6 @@ OnLoaded:
SyncLock McSkinDownloadLock SyncLock McSkinDownloadLock
If Not FileUtils.Exists(FileAddress) Then If Not FileUtils.Exists(FileAddress) Then
NetDownloadByClient(Address, FileAddress & ".PCLDownloading") NetDownloadByClient(Address, FileAddress & ".PCLDownloading")
FileUtils.Delete(FileAddress)
FileUtils.Move(FileAddress & ".PCLDownloading", FileAddress) FileUtils.Move(FileAddress & ".PCLDownloading", FileAddress)
Logger.Info($"皮肤下载成功:{FileAddress}") Logger.Info($"皮肤下载成功:{FileAddress}")
End If End If
@@ -1835,7 +1834,7 @@ OnLoaded:
Public OriginalName As String Public OriginalName As String
Public Overrides Function ToString() 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 Function
End Class End Class
@@ -1865,7 +1864,7 @@ OnLoaded:
End If End If
End If End If
If Rule("os")("arch") IsNot Nothing Then '操作系统架构 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
End If End If
If Not IsNothing(Rule("features")) Then '标签 If Not IsNothing(Rule("features")) Then '标签
@@ -2078,11 +2077,11 @@ OnLoaded:
Try Try
'测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/ '测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/
Logger.Info("开始获取统一通行证下载信息") 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( Result.Add(New NetFile(
Urls:={"https://login.mc-user.com:233/index/jar"}, Urls:={"https://login.mc-user.com:233/index/jar"},
LocalPath:=TargetFile, LocalPath:=TargetFile,
Checker:=New FileChecker(Hash:=DownloadInfo("jarHash").ToString))) Checker:=New FileChecker With {.Hash = DownloadInfo("jarHash").ToString}))
Catch ex As Exception Catch ex As Exception
If FileUtils.Exists(TargetFile) Then If FileUtils.Exists(TargetFile) Then
Logger.Warn(ex, "获取统一通行证下载信息失败") Logger.Warn(ex, "获取统一通行证下载信息失败")
@@ -2097,15 +2096,15 @@ OnLoaded:
Dim TargetFile = PathPure & "authlib-injector.jar" Dim TargetFile = PathPure & "authlib-injector.jar"
Try Try
Logger.Info("开始获取 Authlib-Injector 下载信息") Logger.Info("开始获取 Authlib-Injector 下载信息")
Dim DownloadInfo = GetJson(NetRequestByClientRetry( Dim DownloadInfo As JObject = NetRequestByClientRetry(
"https://authlib-injector.yushi.moe/artifact/latest.json", "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. Dim DownloadAddress As String = DownloadInfo("download_url").ToString.
Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe") Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe")
Result.Add(New NetFile({ Result.Add(New NetFile({
DownloadAddress, DownloadAddress,
DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector") 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 Catch ex As Exception
If FileUtils.Exists(TargetFile) Then If FileUtils.Exists(TargetFile) Then
Logger.Warn(ex, "获取 Authlib-Injector 下载信息失败") Logger.Warn(ex, "获取 Authlib-Injector 下载信息失败")
@@ -2144,7 +2143,7 @@ OnLoaded:
If Token.Name.ContainsIgnoreCase("labymod") Then If Token.Name.ContainsIgnoreCase("labymod") Then
Checker = New FileChecker '不检查 LabyMod 的文件,它们提供的文件校验信息是错的(#3225) Checker = New FileChecker '不检查 LabyMod 的文件,它们提供的文件校验信息是错的(#3225)
Else 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 End If
'URL 'URL
Dim Urls As New List(Of String) Dim Urls As New List(Of String)
@@ -2238,16 +2237,16 @@ OnLoaded:
'返回 assets 文件名会由于没有下载地址导致全局失败 '返回 assets 文件名会由于没有下载地址导致全局失败
'If AssetsName IsNot Nothing AndAlso AssetsName <> "legacy" Then 'If AssetsName IsNot Nothing AndAlso AssetsName <> "legacy" Then
' Log("[Minecraft] 无法获取资源文件索引下载地址,使用 assets 项提供的资源文件名:" & AssetsName) ' Log("[Minecraft] 无法获取资源文件索引下载地址,使用 assets 项提供的资源文件名:" & AssetsName)
' Return GetJson("{""id"": """ & AssetsName & """}") ' Return ("{""id"": """ & AssetsName & """}").DeserializeJson()
'Else 'Else
Logger.Info("无法获取资源文件索引下载地址,使用默认的 legacy 下载地址") Logger.Info("无法获取资源文件索引下载地址,使用默认的 legacy 下载地址")
Return GetJson("{ Return "{
""id"": ""legacy"", ""id"": ""legacy"",
""sha1"": ""c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729"", ""sha1"": ""c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729"",
""size"": 134284, ""size"": 134284,
""url"": ""https://launchermeta.mojang.com/mc-staging/assets/legacy/c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729/legacy.json"", ""url"": ""https://launchermeta.mojang.com/mc-staging/assets/legacy/c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729/legacy.json"",
""totalSize"": 111220701 ""totalSize"": 111220701
}") }".DeserializeJson()
'End If 'End If
Else Else
Throw New Exception("该版本不存在资源文件索引信息") Throw New Exception("该版本不存在资源文件索引信息")
@@ -2294,7 +2293,7 @@ OnLoaded:
Public Hash As String Public Hash As String
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Return FormatFileSize(Size) & " | " & LocalPath Return StringUtils.FormatByteSize(Size) & " | " & LocalPath
End Function End Function
End Structure End Structure
''' <summary> ''' <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") 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 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 For Each File As JProperty In Json("objects").Children
@@ -2347,8 +2346,7 @@ OnLoaded:
Select(Function(Token As McAssetsToken) New NetFile( Select(Function(Token As McAssetsToken) New NetFile(
DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"), DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"),
LocalPath:=Token.LocalPath, LocalPath:=Token.LocalPath,
Checker:=New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Checker:=New FileChecker With {.ActualSize = If(Token.Size = 0, -1, Token.Size), .Hash = Token.Hash})).ToList
Hash:=Token.Hash))).ToList
End If End If
'如果不检查 Hash,则立即处理 '如果不检查 Hash,则立即处理
Dim Result As New List(Of NetFile) Dim Result As New List(Of NetFile)
@@ -2365,7 +2363,7 @@ OnLoaded:
Dim File = FileUtils.GetInfo(Token.LocalPath) Dim File = FileUtils.GetInfo(Token.LocalPath)
If File.Exists AndAlso (Token.Size = 0 OrElse Token.Size = File.Length) Then Continue For 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 Next
Catch ex As Exception Catch ex As Exception
Logger.Warn(ex, "获取版本缺失的资源文件下载列表失败") Logger.Warn(ex, "获取版本缺失的资源文件下载列表失败")
@@ -2394,7 +2392,7 @@ OnLoaded:
If Version Is Nothing Then Return If Version Is Nothing Then Return
Dim Time As Date = Version("releaseTime") Dim Time As Date = Version("releaseTime")
Dim MsgBoxText As String = $"新版本:{VersionName}{vbCrLf}" & 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, "更新日志", ""), Dim MsgResult = MyMsgBox(MsgBoxText, "Minecraft 更新提示", "确定", "下载", If((Date.Now - Time).TotalHours > 3, "更新日志", ""),
Button3Action:=Sub() McUpdateLogShow(Version)) Button3Action:=Sub() McUpdateLogShow(Version))
'弹窗结果 '弹窗结果
@@ -1,4 +1,7 @@
Public Module ModModpack Imports System.Collections.ObjectModel
Imports System.Text.RegularExpressions
Public Module ModModpack
'触发整合包安装的外部接口 '触发整合包安装的外部接口
''' <summary> ''' <summary>
@@ -11,8 +14,8 @@
Sub() Sub()
Try Try
ModpackInstall(File) ModpackInstall(File)
Catch ex As CancelledException
Catch ex As Exception Catch ex As Exception
ex.ThrowIfCanceled()
Logger.Error(ex, "手动安装整合包失败", LogBehavior.Alert) Logger.Error(ex, "手动安装整合包失败", LogBehavior.Alert)
End Try End Try
End Sub) End Sub)
@@ -21,7 +24,6 @@
''' 构建并启动安装给定的整合包文件的加载器,并返回该加载器。若失败则抛出异常。 ''' 构建并启动安装给定的整合包文件的加载器,并返回该加载器。若失败则抛出异常。
''' 必须在工作线程执行。 ''' 必须在工作线程执行。
''' </summary> ''' </summary>
''' <exception cref="CancelledException" />
Public Function ModpackInstall(File As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String) 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")}") Logger.Info($"整合包安装请求:{If(File, "null")}")
Dim Archive As ZipArchive = Nothing Dim Archive As ZipArchive = Nothing
@@ -29,7 +31,7 @@
Try Try
'字符校验 '字符校验
Dim TargetFolder As String = $"{McFolderSelected}versions\{InstanceName}\" 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 '获取整合包种类与关键 Json
Dim PackType As Integer = -1 Dim PackType As Integer = -1
Try 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("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("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
If Archive.GetEntry("manifest.json") IsNot Nothing Then 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 If Json("addons") Is Nothing Then
PackType = 0 : Exit Try 'CurseForge 整合包 PackType = 0 : Exit Try 'CurseForge 整合包
Else Else
@@ -59,7 +61,7 @@
If PathSplits(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194) 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) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If PathSplits(1) = "manifest.json" Then 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 If Json("addons") Is Nothing Then
PackType = 0 : Exit Try 'CurseForge 整合包 PackType = 0 : Exit Try 'CurseForge 整合包
Else Else
@@ -163,22 +165,21 @@ Retry:
''' 弹窗提示整合包中存在不兼容的加载器。 ''' 弹窗提示整合包中存在不兼容的加载器。
''' 如果取消,则抛出 CancelledException。 ''' 如果取消,则抛出 CancelledException。
''' </summary> ''' </summary>
''' <exception cref="CancelledException" />
Private Sub NotifyIncompatibleLoader(LoaderName As String) Private Sub NotifyIncompatibleLoader(LoaderName As String)
If MyMsgBox($"整合包中存在不兼容的加载器:{LoaderName}{vbCrLf}如果你知道如何手动安装它,可以先选择跳过,然后在整合包下载结束后手动安装。", If MyMsgBox($"整合包中存在不兼容的加载器:{LoaderName}{vbCrLf}如果你知道如何手动安装它,可以先选择跳过,然后在整合包下载结束后手动安装。",
"不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New CancelledException "不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New OperationCanceledException
End Sub End Sub
#Region "不同类型整合包的安装方法" #Region "不同类型整合包的安装方法"
'CurseForge '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) Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString) Json = Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString().DeserializeJson()
Catch ex As Exception Catch ex As Exception
Throw New Exception("CurseForge 整合包安装信息存在问题", ex) Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
End Try End Try
@@ -189,8 +190,8 @@ Retry:
InstanceName = If(Json("name"), "") InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If End If
'获取 Mod API 版本信息 '获取 Mod API 版本信息
@@ -272,9 +273,9 @@ Retry:
MissingDesc.Add($"{Project.TranslatedName} (文件 ID {Missing.FileId})") MissingDesc.Add($"{Project.TranslatedName} (文件 ID {Missing.FileId})")
End If End If
Next Next
If MyMsgBox($"未找到该整合包所需的以下内容,它们可能已被原作者删除:{vbCrLf}- {MissingDesc.Join(vbCrLf & "- ")}{vbCrLf}{vbCrLf}是否继续安装?缺失这些内容可能导致整合包出现异常!", If MyMsgBox($"未找到该整合包所需的以下内容,它们可能已被原作者删除:{vbCrLf}- {MissingDesc.Join(vbCrLf + "- ")}{vbCrLf}{vbCrLf}是否继续安装?缺失这些内容可能导致整合包出现异常!",
"整合包内容缺失", "继续", "取消", IsWarn:=True) = 2 Then "整合包内容缺失", "继续", "取消", IsWarn:=True) = 2 Then
Task.Interrupt() Task.Cancel()
End If End If
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
'构造 NetFile '构造 NetFile
@@ -364,7 +365,7 @@ Retry:
Dim LoaderName As String = "CurseForge 整合包安装:" & InstanceName & " " Dim LoaderName As String = "CurseForge 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Red) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New OperationCanceledException
End If End If
'启动 '启动
@@ -377,12 +378,12 @@ Retry:
End Function End Function
'Modrinth '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 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try 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 Catch ex As Exception
Throw New Exception("Modrinth 整合包安装信息存在问题", ex) Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
End Try End Try
@@ -412,8 +413,8 @@ Retry:
InstanceName = If(Json("name"), "") InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If End If
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
@@ -452,10 +453,10 @@ Retry:
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}" Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not Path.GetFullPath(TargetPath).StartsWithF(Path.GetFullPath($"{McFolderSelected}versions\{InstanceName}\")) Then If Not Path.GetFullPath(TargetPath).StartsWithF(Path.GetFullPath($"{McFolderSelected}versions\{InstanceName}\")) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹,请向整合包作者反馈此问题!{vbCrLf}目标:{Path.GetFullPath(TargetPath)}{vbCrLf}错误的文件:{TargetPath}", "文件路径校验失败", IsWarn:=True) MyMsgBox($"整合包的文件路径超出了版本文件夹,请向整合包作者反馈此问题!{vbCrLf}目标:{Path.GetFullPath(TargetPath)}{vbCrLf}错误的文件:{TargetPath}", "文件路径校验失败", IsWarn:=True)
Throw New CancelledException Throw New OperationCanceledException
End If End If
FileList.Add(New NetFile(Urls, TargetPath, 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 Next
If FileList.Any Then If FileList.Any Then
InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s 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} " Dim LoaderName As String = $"Modrinth 整合包安装:{InstanceName} "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Red) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New OperationCanceledException
End If End If
'启动 '启动
@@ -515,11 +516,11 @@ Retry:
End Function End Function
'HMCL '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 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try 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 Catch ex As Exception
Throw New Exception("HMCL 整合包安装信息存在问题", ex) Throw New Exception("HMCL 整合包安装信息存在问题", ex)
End Try End Try
@@ -527,8 +528,8 @@ Retry:
Dim InstanceName As String = If(Json("name"), "") Dim InstanceName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
@@ -556,7 +557,7 @@ Retry:
Dim LoaderName As String = "HMCL 整合包安装:" & InstanceName & " " Dim LoaderName As String = "HMCL 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Red) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New OperationCanceledException
End If End If
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -568,11 +569,11 @@ Retry:
End Function End Function
'MMC '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 文件 '读取 Json 文件
Dim PackJson As JObject, PackInstance As String Dim PackJson As JObject, PackInstance As String
Try 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) PackInstance = Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open().ReadString(Encoding.UTF8)
Catch ex As Exception Catch ex As Exception
Throw New Exception("MMC 整合包安装信息存在问题", ex) Throw New Exception("MMC 整合包安装信息存在问题", ex)
@@ -581,8 +582,8 @@ Retry:
Dim InstanceName As String = If(PackInstance.RegexSeek("(?<=\nname\=)[^\n]+"), "") Dim InstanceName As String = If(PackInstance.RegexSeek("(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini" Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
@@ -609,7 +610,7 @@ Retry:
Dim PreLaunchCommand As String = ReadIni(MmcSetupFile, "PreLaunchCommand") Dim PreLaunchCommand As String = ReadIni(MmcSetupFile, "PreLaunchCommand")
If PreLaunchCommand <> "" Then If PreLaunchCommand <> "" Then
PreLaunchCommand = PreLaunchCommand.Replace("\""", """"). 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_MC_DIR\", "{minecraft}").Replace("$INST_MC_DIR", "{minecraft}").
Replace("$INST_DIR\", "{verpath}").Replace("$INST_DIR", "{verpath}"). Replace("$INST_DIR\", "{verpath}").Replace("$INST_DIR", "{verpath}").
Replace("$INST_ID", "{name}").Replace("$INST_NAME", "{name}") Replace("$INST_ID", "{name}").Replace("$INST_NAME", "{name}")
@@ -622,10 +623,6 @@ Retry:
WriteIni(SetupFile, "VersionServerEnter", ServerAddress) WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
Logger.Info($"迁移 MultiMC 版本独立设置:自动进入服务器:{ServerAddress}") Logger.Info($"迁移 MultiMC 版本独立设置:自动进入服务器:{ServerAddress}")
End If 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", "") Dim Logo As String = ReadIni(MmcSetupFile, "iconKey", "")
If Logo <> "" AndAlso FileUtils.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then If Logo <> "" AndAlso FileUtils.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True) WriteIni(SetupFile, "LogoCustom", True)
@@ -685,7 +682,7 @@ Retry:
Dim LoaderName As String = "MMC 整合包安装:" & InstanceName & " " Dim LoaderName As String = "MMC 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Red) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New OperationCanceledException
End If End If
'启动 '启动
@@ -698,13 +695,13 @@ Retry:
End Function End Function
'MCBBS '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) Optional InstanceName As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json")) 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 Catch ex As Exception
Throw New Exception("MCBBS 整合包安装信息存在问题", ex) Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
End Try End Try
@@ -713,8 +710,8 @@ Retry:
InstanceName = If(Json("name"), "") InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If End If
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
@@ -742,7 +739,7 @@ Retry:
If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息,无法安装!") If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息,无法安装!")
If Addons.ContainsKey("quilt") Then If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Red) Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Red)
Throw New CancelledException Throw New OperationCanceledException
End If End If
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName, .NewInstanceName = InstanceName,
@@ -763,7 +760,7 @@ Retry:
Dim LoaderName As String = "MCBBS 整合包安装:" & InstanceName & " " Dim LoaderName As String = "MCBBS 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Red) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New OperationCanceledException
End If End If
'启动 '启动
@@ -777,12 +774,12 @@ Retry:
End Function 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) MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标(必须是一个空文件夹)", False).FirstOrDefault Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标(必须是一个空文件夹)", False).FirstOrDefault
If TargetFolder Is Nothing Then Throw New CancelledException If TargetFolder Is Nothing Then Throw New OperationCanceledException
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标!", HintType.Red) : Throw New CancelledException If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标!", HintType.Red) : Throw New OperationCanceledException
'解压 '解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", { Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包", New LoaderTask(Of String, Integer)("解压压缩包",
@@ -792,7 +789,7 @@ Retry:
Thread.Sleep(400) '避免文件争用 Thread.Sleep(400) '避免文件争用
'查找解压后的 exe 文件 '查找解压后的 exe 文件
Dim Launcher As String = Nothing 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) Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
Logger.Info($"文件 {ExeFile} 的产品名标识为 {Info.ProductName}") Logger.Info($"文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
If Info.ProductName = "Plain Craft Launcher" Then If Info.ProductName = "Plain Craft Launcher" Then
@@ -826,7 +823,7 @@ Retry:
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串) TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
InstanceName, False) InstanceName, False)
'调用 modpack 文件进行安装 '调用 modpack 文件进行安装
Dim ModpackFile = DirectoryUtils.GetFiles(TargetFolder, "modpack.*").First Dim ModpackFile = DirectoryUtils.EnumerateFiles(TargetFolder, True, "modpack.*").First
Logger.Info($"调用 modpack 文件继续安装:{ModpackFile}") Logger.Info($"调用 modpack 文件继续安装:{ModpackFile}")
ModpackInstall(ModpackFile) ModpackInstall(ModpackFile)
End Sub) End Sub)
@@ -839,10 +836,10 @@ Retry:
End Function 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” 的路径 '尝试定位 .minecraft 文件夹:寻找形如 “/versions/XXX/XXX.json” 的路径
Dim Match As RegularExpressions.Match = Nothing Dim Match As Match = Nothing
Dim Regex As New RegularExpressions.Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegularExpressions.RegexOptions.IgnoreCase) Dim Regex As New Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegexOptions.IgnoreCase)
For Each Entry In Archive.Entries For Each Entry In Archive.Entries
Dim EntryMatch = Regex.Match("/" & Entry.FullName) Dim EntryMatch = Regex.Match("/" & Entry.FullName)
If EntryMatch.Success Then If EntryMatch.Success Then
@@ -856,9 +853,9 @@ Retry:
'获取解压路径 '获取解压路径
MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True) MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标(必须是一个空文件夹)", False).FirstOrDefault Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标(必须是一个空文件夹)", False).FirstOrDefault
If TargetFolder Is Nothing Then Throw New CancelledException If TargetFolder Is Nothing Then Throw New OperationCanceledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Red) : Throw New CancelledException 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 CancelledException If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标!", HintType.Red) : Throw New OperationCanceledException
'解压 '解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", { Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包", New LoaderTask(Of String, Integer)("解压压缩包",
@@ -1,4 +1,4 @@
Public Module ModWatcher Public Module ModWatcher
'对全体的监视 '对全体的监视
Public McWatcherList As New List(Of Watcher) Public McWatcherList As New List(Of Watcher)
@@ -91,7 +91,7 @@
RunInNewThread( RunInNewThread(
Sub() Sub()
Try 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() TimerWindow()
TimerLog() TimerLog()
'设置窗口标题 '设置窗口标题
@@ -177,7 +177,7 @@
Logger.Error(ex, "输出 Minecraft 日志失败") Logger.Error(ex, "输出 Minecraft 日志失败")
End Try End Try
End Sub End Sub
Public LatestLog As New Queue(Of String) Public LatestLog As New ConcurrentQueue(Of String)
Private Sub GameLog(Text As String) Private Sub GameLog(Text As String)
'预处理 '预处理
If Text Is Nothing Then Return If Text Is Nothing Then Return
@@ -185,7 +185,7 @@
'If Text.Contains("�����") Then Hint("检测到错误的日志编码:" & Text) 'If Text.Contains("�����") Then Hint("检测到错误的日志编码:" & Text)
'加入预存储 '加入预存储
LatestLog.Enqueue(Text) LatestLog.Enqueue(Text)
If LatestLog.Count >= 501 Then LatestLog.Dequeue() If LatestLog.Count >= 501 Then LatestLog.TryDequeue(Nothing)
Logger.Trace(Text) Logger.Trace(Text)
'进度处理 '进度处理
If LogProgress < 1 Then If LogProgress < 1 Then
@@ -362,7 +362,7 @@
Analyzer.Prepare() Analyzer.Prepare()
Analyzer.Analyze() Analyzer.Analyze()
Analyzer.Output(False, New List(Of String) From 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 Catch ex As Exception
Logger.Error(ex, "崩溃分析失败") Logger.Error(ex, "崩溃分析失败")
End Try End Try
+1 -1
View File
@@ -1,4 +1,4 @@
Public Class ModDevelop Public Class ModDevelop
Public Shared Sub Start() Public Shared Sub Start()
End Sub End Sub
+10 -10
View File
@@ -1,4 +1,4 @@

#Region "附加属性" #Region "附加属性"
''' <summary> ''' <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), "确定")) MyMsgBox(Args(1).Replace("\n", vbCrLf), Args(0).Replace("\n", vbCrLf), If(Args.Length > 2, Args(2), "确定"))
Case EventType.弹出提示 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.切换页面 Case EventType.切换页面
RunInUi(Sub() FrmMain.PageChange( RunInUi(Sub() FrmMain.PageChange(
Args(0).ToEnum(Of FormMain.PageType), EnumUtils.FromString(Of FormMain.PageType)(Args(0)),
If(Args.Length = 1, FormMain.PageSubType.Default, Args(1).ToEnum(Of FormMain.PageSubType)))) If(Args.Length = 1, FormMain.PageSubType.Default, EnumUtils.FromString(Of FormMain.PageSubType)(Args(1)))))
Case EventType.导入整合包, EventType.安装整合包 Case EventType.导入整合包, EventType.安装整合包
RunInUi(Sub() ModpackInstall()) RunInUi(Sub() ModpackInstall())
@@ -372,20 +372,20 @@ Public Class CustomEvent
RelativeUrl = RelativeUrl.Replace("/", "\").Lower.TrimStart("\") 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() HelpTryExtract()
If RelativeUrl.Contains(":\") Then If RelativeUrl.Contains(":\") Then
'绝对路径 '绝对路径
Location = RelativeUrl Location = RelativeUrl
Logger.Info($"自定义事件中由绝对路径{Type}:{Location}") Logger.Info($"自定义事件中由绝对路径{Type}:{Location}")
ElseIf FileUtils.Exists(PathExeFolder & "PCL\" & RelativeUrl) Then ElseIf FileUtils.Exists(Paths.Base & "PCL\" & RelativeUrl) Then
'相对 PCL 文件夹的路径 '相对 PCL 文件夹的路径
Location = PathExeFolder & "PCL\" & RelativeUrl Location = Paths.Base & "PCL\" & RelativeUrl
Logger.Info($"自定义事件中由相对 PCL 文件夹的路径{Type}:{Location}") Logger.Info($"自定义事件中由相对 PCL 文件夹的路径{Type}:{Location}")
ElseIf FileUtils.Exists(PathExeFolder & "PCL\Help\" & RelativeUrl) Then ElseIf FileUtils.Exists(Paths.Base & "PCL\Help\" & RelativeUrl) Then
'相对 PCL 本地帮助文件夹的路径 '相对 PCL 本地帮助文件夹的路径
Location = PathExeFolder & "PCL\Help\" & RelativeUrl Location = Paths.Base & "PCL\Help\" & RelativeUrl
WorkingDir = PathExeFolder & "PCL\Help\" WorkingDir = Paths.Base & "PCL\Help\"
Logger.Info($"自定义事件中由相对 PCL 本地帮助文件夹的路径{Type}:{Location}") Logger.Info($"自定义事件中由相对 PCL 本地帮助文件夹的路径{Type}:{Location}")
ElseIf Type = EventType.打开帮助 AndAlso FileUtils.Exists(PathTemp & "Help\" & RelativeUrl) Then ElseIf Type = EventType.打开帮助 AndAlso FileUtils.Exists(PathTemp & "Help\" & RelativeUrl) Then
'相对 PCL 自带帮助文件夹的路径 '相对 PCL 自带帮助文件夹的路径
+40 -42
View File
@@ -1,4 +1,5 @@
Imports System.Windows.Interop Imports System.Collections.ObjectModel
Imports System.Windows.Interop
Imports System.Windows.Threading Imports System.Windows.Threading
Public Module ModMain Public Module ModMain
@@ -23,27 +24,24 @@ Public Module ModMain
''' <summary> ''' <summary>
''' 等待弹出的提示列表。以 {String, HintType, Log As Boolean} 形式存储为数组。 ''' 等待弹出的提示列表。以 {String, HintType, Log As Boolean} 形式存储为数组。
''' </summary> ''' </summary>
Private HintWaiting As ConcurrentList(Of HintMessage) = If(HintWaiting, New ConcurrentList(Of HintMessage)) Private HintWaiting As New ConcurrentQueue(Of HintMessage)
''' <summary> ''' <summary>
''' 在窗口左下角弹出提示文本。 ''' 在窗口左下角弹出提示文本。
''' </summary> ''' </summary>
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Blue, Optional Log As Boolean = True) 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.Enqueue(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
End Sub End Sub
Private Sub HintTick() Private Sub HintTick()
Try Try
'Tag 存储了:{ 是否可以重用, Uuid } 'Tag 存储了:{ 是否可以重用, Uuid }
If Not HintWaiting.Any() Then Return Dim CurrentHint As HintMessage = Nothing
Do While HintWaiting.Any Do While HintWaiting.TryDequeue(CurrentHint)
''清除空提示 ''清除空提示
'If IsNothing(HintWaiting(0)) OrElse IsNothing(HintWaiting(0)(0)) Then 'If IsNothing(HintWaiting(0)) OrElse IsNothing(HintWaiting(0)(0)) Then
' HintWaiting.RemoveAt(0) ' HintWaiting.RemoveAt(0)
' Continue Do ' Continue Do
'End If 'End If
Dim CurrentHint = HintWaiting(0)
'去回车 '去回车
CurrentHint.Text = CurrentHint.Text.ReplaceLineEndings(" ", mergeMultiple:=True) CurrentHint.Text = CurrentHint.Text.ReplaceLineEndings(" ", mergeMultiple:=True)
'超量提示直接忽略 '超量提示直接忽略
@@ -134,7 +132,6 @@ Public Module ModMain
'结束处理 '结束处理
EndHint: EndHint:
If CurrentHint.Log Then Logger.Info($"弹出提示:{CurrentHint.Text}") If CurrentHint.Log Then Logger.Info($"弹出提示:{CurrentHint.Text}")
HintWaiting.RemoveAt(0)
Loop Loop
Catch ex As Exception Catch ex As Exception
Logger.Info(ex, "显示弹出提示失败") Logger.Info(ex, "显示弹出提示失败")
@@ -173,7 +170,7 @@ EndHint:
''' <summary> ''' <summary>
''' 输入模式:输入验证规则。 ''' 输入模式:输入验证规则。
''' </summary> ''' </summary>
Public ValidateRules As ObjectModel.Collection(Of Validate) Public ValidateRules As Collection(Of Validate)
''' <summary> ''' <summary>
''' 输入模式:提示文本。 ''' 输入模式:提示文本。
''' </summary> ''' </summary>
@@ -236,14 +233,13 @@ EndHint:
Optional Button1Action As Action = Nothing, Optional Button2Action As Action = Nothing, Optional Button3Action As Action = Nothing) As Integer 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} 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 Button2.Length > 0 OrElse ForceWait Then
'若有多个按钮则开始等待 '若有多个按钮则开始等待
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then
'主窗体尚未加载,用老土的弹窗来替代 '主窗体尚未加载,用老土的弹窗来替代
WaitingMyMsgBox.Remove(Converter)
If Button2.Length > 0 Then 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 Select Case RawResult
Case MsgBoxResult.Yes Case MsgBoxResult.Yes
Converter.Result = 1 Converter.Result = 1
@@ -258,6 +254,7 @@ EndHint:
End If End If
Logger.Warn($"主窗体加载完成前出现意料外的等待弹窗:{Button1},{Button2},{Button3}") Logger.Warn($"主窗体加载完成前出现意料外的等待弹窗:{Button1},{Button2},{Button3}")
Else Else
WaitingMyMsgBox.Enqueue(Converter)
Try Try
FrmMain.DragStop() FrmMain.DragStop()
If RunInUi() Then MyMsgBoxTick() If RunInUi() Then MyMsgBoxTick()
@@ -271,6 +268,7 @@ EndHint:
Return Converter.Result Return Converter.Result
Else Else
'不进行等待,直接返回 '不进行等待,直接返回
WaitingMyMsgBox.Enqueue(Converter)
Return 1 Return 1
End If End If
End Function End Function
@@ -285,10 +283,10 @@ EndHint:
''' <param name="Button1">显示的第一个按钮,默认为“确定”。</param> ''' <param name="Button1">显示的第一个按钮,默认为“确定”。</param>
''' <param name="Button2">显示的第二个按钮,默认为“取消”。</param> ''' <param name="Button2">显示的第二个按钮,默认为“取消”。</param>
''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</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} 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.Add(Converter) WaitingMyMsgBox.Enqueue(Converter)
'虽然我也不知道这是啥但是能用就成了 :) '虽然我也不知道这是啥但是能用就成了 :)
Try Try
If FrmMain IsNot Nothing Then FrmMain.DragStop() 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? 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} 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 Try
If FrmMain IsNot Nothing Then FrmMain.DragStop() If FrmMain IsNot Nothing Then FrmMain.DragStop()
@@ -328,27 +326,27 @@ EndHint:
''' <summary> ''' <summary>
''' 等待显示的弹窗。 ''' 等待显示的弹窗。
''' </summary> ''' </summary>
Public WaitingMyMsgBox As List(Of MyMsgBoxConverter) = If(WaitingMyMsgBox, New List(Of MyMsgBoxConverter)) Public WaitingMyMsgBox As New ConcurrentQueue(Of MyMsgBoxConverter)
Public Sub MyMsgBoxTick() Public Sub MyMsgBoxTick()
Try 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 If FrmMain.PanMsg.Children.Count > 0 Then
'弹窗中 '弹窗中
FrmMain.PanMsg.Visibility = Visibility.Visible FrmMain.PanMsg.Visibility = Visibility.Visible
ElseIf WaitingMyMsgBox.Any Then ElseIf WaitingMyMsgBox.TryDequeue(TargetMsgBox) Then
'没有弹窗,显示一个等待的弹窗 '没有弹窗,显示一个等待的弹窗
FrmMain.PanMsg.Visibility = Visibility.Visible FrmMain.PanMsg.Visibility = Visibility.Visible
Select Case WaitingMyMsgBox(0).Type Select Case TargetMsgBox.Type
Case MyMsgBoxType.Input Case MyMsgBoxType.Input
FrmMain.PanMsg.Children.Add(New MyMsgInput(WaitingMyMsgBox(0))) FrmMain.PanMsg.Children.Add(New MyMsgInput(TargetMsgBox))
Case MyMsgBoxType.Select Case MyMsgBoxType.Select
FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0))) FrmMain.PanMsg.Children.Add(New MyMsgSelect(TargetMsgBox))
Case MyMsgBoxType.Text Case MyMsgBoxType.Text
FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0))) FrmMain.PanMsg.Children.Add(New MyMsgText(TargetMsgBox))
Case MyMsgBoxType.Login Case MyMsgBoxType.Login
FrmMain.PanMsg.Children.Add(New MyMsgLogin(WaitingMyMsgBox(0))) FrmMain.PanMsg.Children.Add(New MyMsgLogin(TargetMsgBox))
End Select End Select
WaitingMyMsgBox.RemoveAt(0)
Else Else
'没有弹窗,没有等待的弹窗 '没有弹窗,没有等待的弹窗
If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
@@ -489,7 +487,7 @@ EndHint:
Public Sub New(FilePath As String) Public Sub New(FilePath As String)
RawPath = FilePath RawPath = FilePath
If Not FileUtils.Exists(FilePath) Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, 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 If JsonData("Title") IsNot Nothing Then
Title = JsonData("Title") Title = JsonData("Title")
@@ -503,7 +501,7 @@ EndHint:
ShowInPublic = If(JsonData("ShowInPublic"), ShowInPublic) ShowInPublic = If(JsonData("ShowInPublic"), ShowInPublic)
ShowInSnapshot = If(JsonData("ShowInSnapshot"), ShowInSnapshot) ShowInSnapshot = If(JsonData("ShowInSnapshot"), ShowInSnapshot)
Types = New List(Of String) 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) Types.Add(NameOfType)
Next Next
'加载事件信息 '加载事件信息
@@ -577,8 +575,8 @@ EndHint:
Try Try
Dim IgnoreList As New List(Of String) Dim IgnoreList As New List(Of String)
'读取自定义文件 '读取自定义文件
If DirectoryUtils.Exists(PathExeFolder & "PCL\Help\") Then If DirectoryUtils.Exists(Paths.Base & "PCL\Help\") Then
For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Help\") For Each File In DirectoryUtils.EnumerateFiles(Paths.Base & "PCL\Help\", True)
Select Case PathUtils.GetExtension(File) Select Case PathUtils.GetExtension(File)
Case "helpignore" Case "helpignore"
'加载忽略列表 '加载忽略列表
@@ -596,7 +594,7 @@ EndHint:
End If End If
Logger.Info($"已扫描 PCL 文件夹下的帮助文件,目前总计 {FileList.Count} 条") Logger.Info($"已扫描 PCL 文件夹下的帮助文件,目前总计 {FileList.Count} 条")
'读取自带文件 '读取自带文件
For Each File In DirectoryUtils.GetFiles(PathTemp & "Help") For Each File In DirectoryUtils.EnumerateFiles(PathTemp & "Help", True)
'跳过非 json 文件与以 . 开头的文件夹 '跳过非 json 文件与以 . 开头的文件夹
If PathUtils.RemoveLastPart(File).Replace(PathTemp & "Help", "").Contains("\.") OrElse PathUtils.GetExtension(File) <> "json" Then Continue For 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 Catch ex As Exception
Logger.Error(ex, "检查帮助文件夹失败", LogBehavior.Alert) Logger.Error(ex, "检查帮助文件夹失败", LogBehavior.Alert)
End Try End Try
If Loader.IsInterrupted Then Return If Loader.IsCanceled Then Return
'将文件实例化 '将文件实例化
Dim Dict As New List(Of HelpEntry) Dim Dict As New List(Of HelpEntry)
@@ -630,7 +628,7 @@ NextFile:
'回设 '回设
If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏") If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
If Loader.IsInterrupted Then Return If Loader.IsCanceled Then Return
Loader.Output = Dict Loader.Output = Dict
Catch ex As Exception Catch ex As Exception
@@ -648,7 +646,7 @@ NextFile:
ExtractResources(PathTemp & "Cache\Help.zip", "Help") ExtractResources(PathTemp & "Cache\Help.zip", "Help")
FileUtils.ExtractToDirectory(PathTemp & "Cache\Help.zip", PathTemp & "Help") FileUtils.ExtractToDirectory(PathTemp & "Cache\Help.zip", PathTemp & "Help")
Settings.Set("SystemHelpVersion", VersionCode) Settings.Set("SystemHelpVersion", VersionCode)
Logger.Warn($"已解压内置帮助文件,目前状态:{FileUtils.Exists(PathTemp & "Help\启动器\备份设置.xaml")}") Logger.Info($"已解压内置帮助文件,目前状态:{FileUtils.Exists(PathTemp + "Help\启动器\备份设置.xaml")}")
End If End If
End Sub End Sub
@@ -662,7 +660,7 @@ NextFile:
If _IsAprilEnabled Is Nothing Then If _IsAprilEnabled Is Nothing Then
_IsAprilEnabled = _IsAprilEnabled =
Date.Now.Month = 4 AndAlso Date.Now.Day = 1 AndAlso 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 End If
Return _IsAprilEnabled.Value Return _IsAprilEnabled.Value
End Get End Get
@@ -847,7 +845,7 @@ NextFile:
Text = Text.Replace("{pcl_build_type}", Replacer(BuildType.ToString)) Text = Text.Replace("{pcl_build_type}", Replacer(BuildType.ToString))
Text = Text.Replace("{pcl_branch}", Replacer(VersionBranchMain)) Text = Text.Replace("{pcl_branch}", Replacer(VersionBranchMain))
Text = Text.Replace("{identify}", Replacer(Identify)) 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_with_name}", Replacer(PathExe))
Text = Text.Replace("{path_temp}", Replacer(PathTemp)) Text = Text.Replace("{path_temp}", Replacer(PathTemp))
Text = Text.Replace("{pcl_md5}", Function() Replacer(CryptographyUtils.ComputeFileHash(PathExe, CryptographyUtils.HashMethod.Md5))) 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"))) Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH':'mm':'ss")))
End If End If
'Minecraft 'Minecraft
Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.PathFolder)) Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.Folder))
Text = Text.Replace("{minecraft}", Replacer(McFolderSelected)) Text = Text.Replace("{minecraft}", Replacer(McFolderSelected))
If McInstanceSelected?.IsLoaded Then If McInstanceSelected?.IsLoaded Then
Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion)) Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion))
@@ -968,7 +966,7 @@ NextFile:
On Error Resume Next On Error Resume Next
FeedbackInfo() FeedbackInfo()
If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug,请点击 打开文件夹 按钮,并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关,请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then 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 End If
OpenWebsite("https://github.com/Meloong-Git/PCL/issues/") OpenWebsite("https://github.com/Meloong-Git/PCL/issues/")
End Sub End Sub
@@ -978,11 +976,11 @@ NextFile:
Public Sub FeedbackInfo() Public Sub FeedbackInfo()
On Error Resume Next On Error Resume Next
Logger.Warn($"诊断信息:{vbCrLf}" & 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 & "剩余内存:" & 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 & "DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
"MC 文件夹:" & If(McFolderSelected, "Nothing") & vbCrLf & "MC 文件夹:" & If(McFolderSelected, "Nothing") & vbCrLf &
"文件位置:" & PathExeFolder) "文件位置:" & Paths.Base)
End Sub End Sub
'遥测 '遥测
@@ -994,9 +992,9 @@ NextFile:
Sub() Sub()
Try Try
Logger.Info($"匿名数据上报:{[Event]}") 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 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 Next
NetRequestByClient(Url, MakeLog:=False) NetRequestByClient(Url, MakeLog:=False)
Catch ex As Exception Catch ex As Exception
+3 -4
View File
@@ -1,4 +1,4 @@
Imports NAudio.Wave Imports NAudio.Wave
Public Module ModMusic Public Module ModMusic
@@ -23,8 +23,8 @@ Public Module ModMusic
'初始化全部可用音乐列表 '初始化全部可用音乐列表
If MusicAllList Is Nothing Then If MusicAllList Is Nothing Then
MusicAllList = New List(Of String) MusicAllList = New List(Of String)
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\") DirectoryUtils.Create(Paths.Base & "PCL\Musics\")
For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Musics\") For Each File In DirectoryUtils.EnumerateFiles(Paths.Base & "PCL\Musics\", True)
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的 '文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
If {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(PathUtils.GetExtension(File)) Then Continue For If {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(PathUtils.GetExtension(File)) Then Continue For
MusicAllList.Add(File) MusicAllList.Add(File)
@@ -99,7 +99,6 @@ Public Module ModMusic
End If End If
End If End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
End If End If
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI() If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
+2 -2
View File
@@ -1,4 +1,4 @@
'由于包含加解密等安全信息,本文件中的部分代码已被删除 '由于包含加解密等安全信息,本文件中的部分代码已被删除
Friend Module ModSecret Friend Module ModSecret
@@ -33,7 +33,7 @@ Friend Module ModSecret
End If End If
End If End If
If Not SimulateBrowserHeaders Then Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/") 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 Sub
#End Region #End Region
@@ -1,4 +1,4 @@
''' <summary> ''' <summary>
''' 本地的社区资源文件。 ''' 本地的社区资源文件。
''' </summary> ''' </summary>
Public Class LocalResourceFile Public Class LocalResourceFile
@@ -106,235 +106,6 @@ Public Class LocalResourceFile
#End Region #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 "网络信息" #Region "网络信息"
''' <summary> ''' <summary>
@@ -1,4 +1,4 @@
Public Module LocalResourceLoaders Public Module LocalResourceLoaders
'加载 Mod 列表 '加载 Mod 列表
Public LocalResourceLoader As New LoaderTask(Of String, List(Of LocalResourceFile))("LocalResourceLoader", AddressOf LocalResourceFileLoad) Public LocalResourceLoader As New LoaderTask(Of String, List(Of LocalResourceFile))("LocalResourceLoader", AddressOf LocalResourceFileLoad)
@@ -12,7 +12,7 @@
Try Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod") RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
If Loader.IsInterrupted Then Return If Loader.IsCanceled Then Return
Thread.Sleep(100) Thread.Sleep(100)
Loop Loop
Finally Finally
@@ -25,7 +25,7 @@
Dim ModFileList As New List(Of String) Dim ModFileList As New List(Of String)
If DirectoryUtils.Exists(Loader.Input) Then If DirectoryUtils.Exists(Loader.Input) Then
Dim RawName As String = Loader.Input.Lower 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 If File.BeforeLast("\").Lower & "\" <> RawName Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod '仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
@@ -53,8 +53,8 @@
Try Try
Dim CacheContent As String = FileUtils.TryReadAsString(CachePath) Dim CacheContent As String = FileUtils.TryReadAsString(CachePath)
If Not String.IsNullOrWhiteSpace(CacheContent) Then If Not String.IsNullOrWhiteSpace(CacheContent) Then
Cache = GetJson(CacheContent) Cache = CacheContent.DeserializeJson()
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> Versions.LOCAL_MOD_CACHE_VERSION Then If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> Versions.LocalModCacheVersion Then
Logger.Warn($"本地 Mod 信息缓存版本已过期,将弃用这些缓存信息") Logger.Warn($"本地 Mod 信息缓存版本已过期,将弃用这些缓存信息")
Cache = New JObject Cache = New JObject
End If End If
@@ -63,12 +63,12 @@
Logger.Warn(ex, "读取本地 Mod 信息缓存失败,已重置") Logger.Warn(ex, "读取本地 Mod 信息缓存失败,已重置")
Cache = New JObject Cache = New JObject
End Try End Try
Cache("version") = Versions.LOCAL_MOD_CACHE_VERSION Cache("version") = Versions.LocalModCacheVersion
'加载 Mod 列表 '加载 Mod 列表
Dim ModList As New List(Of LocalResourceFile) Dim ModList As New List(Of LocalResourceFile)
For Each ModFile In ModFileList For Each ModFile In ModFileList
If Loader.IsInterrupted Then Return If Loader.IsCanceled Then Return
Dim ModEntry As New LocalResourceFile(ModFile) Dim ModEntry As New LocalResourceFile(ModFile)
Dim DumpMod As LocalResourceFile = ModList.FirstOrDefault(Function(m) m.EnabledName = ModEntry.EnabledName) '存在两个文件,名称相同,但一个启用一个禁用 Dim DumpMod As LocalResourceFile = ModList.FirstOrDefault(Function(m) m.EnabledName = ModEntry.EnabledName) '存在两个文件,名称相同,但一个启用一个禁用
If DumpMod IsNot Nothing Then If DumpMod IsNot Nothing Then
@@ -88,7 +88,7 @@
ModList = ModList.OrderBy(Function(m) m.File.Name).ToList ModList = ModList.OrderBy(Function(m) m.File.Name).ToList
'回设 '回设
If Loader.IsInterrupted Then Return If Loader.IsCanceled Then Return
Loader.Output = ModList Loader.Output = ModList
'开始联网加载 '开始联网加载
@@ -109,7 +109,7 @@
Dim ModLoaders = Loader.Input.Target.ModLoaders Dim ModLoaders = Loader.Input.Target.ModLoaders
'读取缓存,获取需要更新的 Mod 列表 '读取缓存,获取需要更新的 Mod 列表
For Each ModEntry As LocalResourceFile In Loader.Input.ModList 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 Dim CacheKey = ModEntry.ModrinthHash & Loader.Input.Target.VanillaName & ModLoaders
If Cache.ContainsKey(CacheKey) Then If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey)) ModEntry.FromJson(Cache(CacheKey))
@@ -119,10 +119,7 @@
Mods.Add(ModEntry) Mods.Add(ModEntry)
Next Next
Logger.Info($"有 {Mods.Where(Function(m) m.Project Is Nothing).Count} 个 Mod 需要联网获取信息,{Mods.Where(Function(m) m.Project IsNot Nothing).Count} 个 Mod 需要更新信息") 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 If Not Mods.Any Then Return
Loader.Input.ModList.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar()) '从 JAR 中获取缺失的版本信息(下面有另一个分支)
Return
End If
'获取作为检查目标的加载器和版本 '获取作为检查目标的加载器和版本
'此处不应向下扩展检查的 MC 小版本,例如 Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2 '此处不应向下扩展检查的 MC 小版本,例如 Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
Dim TargetMcVersion As McVersion = Loader.Input.Target Dim TargetMcVersion As McVersion = Loader.Input.Target
@@ -158,7 +155,7 @@
Entry.ProjectVersion.Version = File.Version '使用来自 Modrinth 的版本号 Entry.ProjectVersion.Version = File.Version '使用来自 Modrinth 的版本号
End If End If
Next Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
Logger.Info($"需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息") Logger.Info($"需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Return If Not ModrinthMapping.Any() Then Return
@@ -211,7 +208,7 @@
Dim Hashes As New List(Of UInteger) Dim Hashes As New List(Of UInteger)
For Each Entry In Mods For Each Entry In Mods
Hashes.Add(Entry.CurseForgeHash) Hashes.Add(Entry.CurseForgeHash)
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
Next Next
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post, Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
$"{{""fingerprints"": [{Hashes.Join(",")}]}}", "application/json")("data")("exactMatches") $"{{""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 If Entry.ProjectVersion Is Nothing OrElse Entry.ProjectVersion.ReleaseDate < File.ReleaseDate Then Entry.ProjectVersion = File
Next Next
Next Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return If Loader.IsCanceledWithThread(CurrentTaskThread) Then Return
Logger.Info($"需要从 CurseForge 获取 {ProjectIdToLocalFiles.Count} 个本地 Mod 的工程信息") Logger.Info($"需要从 CurseForge 获取 {ProjectIdToLocalFiles.Count} 个本地 Mod 的工程信息")
If Not ProjectIdToLocalFiles.Any() Then Return If Not ProjectIdToLocalFiles.Any() Then Return
@@ -313,25 +310,23 @@
EndedThreadCount += 1 EndedThreadCount += 1
End Try End Try
End Sub, "Mod List Detail Loader CurseForge") 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 Do Until EndedThreadCount = 2
Thread.Sleep(10) Thread.Sleep(10)
If Loader.IsInterrupted Then Return If Loader.IsCanceled Then Return
Loop Loop
'保存缓存 '保存缓存
Mods = Mods.Where(Function(m) m.Project IsNot Nothing).ToList() Mods = Mods.Where(Function(m) m.Project IsNot Nothing).ToList()
Logger.Info($"联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存") Logger.Info($"联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Return If Not Mods.Any() Then Return
If Loader.IsInterrupted Then Return If Loader.IsCanceled Then Return
For Each Entry In Mods For Each Entry In Mods
Entry.OnlineDataLoaded = Not IsFailed Entry.OnlineDataLoaded = Not IsFailed
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders) = Entry.ToJson() Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders) = Entry.ToJson()
Next Next
FileUtils.Write(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) 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 If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677) RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else Else
@@ -1,4 +1,4 @@
''' <summary> ''' <summary>
''' 社区资源的项目信息。 ''' 社区资源的项目信息。
''' </summary> ''' </summary>
Public Class ResourceProject Public Class ResourceProject
@@ -88,7 +88,7 @@ Public Class ResourceProject
If Not LoadedDatabase Then If Not LoadedDatabase Then
LoadedDatabase = True LoadedDatabase = True
If Types.HasFlag(ResourceTypes.Mod) OrElse Types.HasFlag(ResourceTypes.DataPack) Then 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
End If End If
Return _WikiEntry Return _WikiEntry
@@ -111,7 +111,7 @@ Public Class ResourceProject
''' </summary> ''' </summary>
Public ReadOnly Property TranslatedName As String Public ReadOnly Property TranslatedName As String
Get Get
Return If(WikiEntry Is Nothing OrElse WikiEntry.ChineseName = "", RawName, WikiEntry.ChineseName) Return If(WikiEntry?.ChineseName, RawName)
End Get End Get
End Property End Property
@@ -441,7 +441,7 @@ Public Class ResourceProject
Json("Website") = Website Json("Website") = Website
Json("LastUpdate") = LastUpdate Json("LastUpdate") = LastUpdate
Json("DownloadCount") = DownloadCount 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) Json("Tags") = New JArray(Tags)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If Drops.Any Then Json("Drops") = New JArray(Drops) If Drops.Any Then Json("Drops") = New JArray(Drops)
@@ -561,7 +561,7 @@ Public Class ResourceProject
NewItem.LabVersion.Text = ModLoaderDescriptionFull NewItem.LabVersion.Text = ModLoaderDescriptionFull
End If End If
NewItem.LabSource.Text = Platform.ToString 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 = NewItem.LabDownload.Text =
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿", If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount)) If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
@@ -1,4 +1,4 @@
Public Class ResourceSearcher Public Class ResourceSearcher
Private Const RESULT_PAGE_SIZE = 40 Private Const RESULT_PAGE_SIZE = 40
Private Const MSG_NO_CHINESE_RESULT As String = "无搜索结果,请尝试搜索其英文名称" Private Const MSG_NO_CHINESE_RESULT As String = "无搜索结果,请尝试搜索其英文名称"
@@ -86,7 +86,7 @@
If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/") If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/")
If ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then Address += "&modLoaderType=" & Resource.ToCurseForgeModLoaderType(ModLoaders.Flags.First) 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(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 If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
Return Address Return Address
End Function End Function
@@ -97,7 +97,7 @@
If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0 If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
'应用筛选参数 '应用筛选参数
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={RESULT_PAGE_SIZE}&index=relevance" 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 If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
'facets=[["categories:'game-mechanics'"],["categories:'forge',categories:'fabric'"],["versions:1.19.3"],["project_type:mod"]] 'facets=[["categories:'game-mechanics'"],["categories:'forge',categories:'fabric'"],["versions:1.19.3"],["project_type:mod"]]
Dim Facets As New List(Of String) Dim Facets As New List(Of String)
@@ -189,9 +189,9 @@
#Region "中文搜索" #Region "中文搜索"
Dim RawSearchText As String = If(Request.SearchText, "").Trim Dim RawSearchText As String = If(Request.SearchText, "").Trim
RawSearchText = StrConv(RawSearchText, VbStrConv.SimplifiedChinese) '繁体转简体
RawSearchText = RawSearchText.Lower RawSearchText = RawSearchText.Lower
Logger.Info($"工程列表搜索原始文本:{RawSearchText}") Logger.Info($"工程列表搜索原始文本:{RawSearchText}")
RawSearchText = StrConv(RawSearchText, VbStrConv.SimplifiedChinese) '繁体转简体
Dim IsChineseSearch As Boolean = Dim IsChineseSearch As Boolean =
RawSearchText.RegexCheck("[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawSearchText) AndAlso 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) Function(Result As SearchEntry(Of WikiEntry), Source As ResourcePlatforms) As IEnumerable(Of String)
'从各个可能的来源提取候选 '从各个可能的来源提取候选
Dim Candidates As New List(Of String) Dim Candidates As New List(Of String)
If Result.Item.CurseForgeSlug IsNot Nothing AndAlso Source = ResourcePlatforms.CurseForge Then If Result.Item.Slugs.ContainsKey(Source) Then
Candidates.Add(Result.Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ")) Candidates.Add(Result.Item.Slugs(Source).
Replace("-", " ").Replace("/", " "))
End If End If
If Result.Item.ModrinthSlug IsNot Nothing AndAlso Source = ResourcePlatforms.Modrinth Then If Result.Item.ChineseName IsNot Nothing Then
Candidates.Add(Result.Item.ModrinthSlug.Replace("-", " ").Replace("/", " ")) Candidates.Add(Result.Item.ChineseName.
AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").Replace("-", " ").Replace("/", " ").Replace(":", " ").Replace("(", " ").Replace(")", ""))
End If End If
Candidates.Add(Result.Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
Replace("-", " ").Replace("/", " ").Replace(":", " ").Replace("(", " ").Replace(")", ""))
'分词、清洗、去重 '分词、清洗、去重
Candidates = Candidates. Candidates = Candidates.
SelectMany(Function(c) c.Split(" ")). SelectMany(Function(c) c.Split(" ")).
@@ -220,6 +220,7 @@
If w.Length <= 1 Then Return False '单字或空白 If w.Length <= 1 Then Return False '单字或空白
If {"the", "of", "mod", "and", "forge", "fabric", "for", "quilt", "neoforge"}.Contains(w) 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 Val(w) > 0 Then Return False '数字
If Not w.IsAsciiOnly Then Return False '非纯英文
Return True Return True
End Function).Distinct.ToList End Function).Distinct.ToList
'如果一个词可以由其他词拼成,则去掉这个词(例如将 ender io enderio 的 enderio 剔除,只保留 ender io) '如果一个词可以由其他词拼成,则去掉这个词(例如将 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() 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 Return Candidates
End Function 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 'CurseForge
If Request.Sources.HasFlag(ResourcePlatforms.CurseForge) Then If Request.Sources.HasFlag(ResourcePlatforms.CurseForge) Then
'数据库搜索 '数据库搜索
Static CurseForgeSearchEntries As List(Of SearchEntry(Of WikiEntry)) = Static CurseForgeSearchEntries As List(Of SearchEntry(Of WikiEntry)) = GetSearchEntries(ResourcePlatforms.CurseForge).ToList()
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
Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25) Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25)
If CurseForgeSearchResults.Any Then If CurseForgeSearchResults.Any Then
'选取目标(CurseForge 要求每个词都必须匹配上,所以只能选择一个 Mod 进行搜索) '选取目标(CurseForge 要求每个词都必须匹配上,所以只能选择一个 Mod 进行搜索)
@@ -255,14 +265,7 @@
'Modrinth 'Modrinth
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) Then If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) Then
'数据库搜索 '数据库搜索
Static ModrinthSearchEntries As List(Of SearchEntry(Of WikiEntry)) = Static ModrinthSearchEntries As List(Of SearchEntry(Of WikiEntry)) = GetSearchEntries(ResourcePlatforms.Modrinth).ToList()
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
Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25) Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25)
If ModrinthSearchResults.Any Then If ModrinthSearchResults.Any Then
'分词 '分词
@@ -277,7 +280,7 @@
ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key
Logger.Warn($"中文搜索关键词(Modrinth):{ModrinthAltSearchText}") 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
End If End If
'结束 '结束
@@ -291,16 +294,17 @@
Dim RealResults As New List(Of ResourceProject) Dim RealResults As New List(Of ResourceProject)
NextPage: NextPage:
Dim RawResults As New ConcurrentList(Of ResourceProject) Dim RawResults As New List(Of ResourceProject)
#Region "从 CurseForge 和 Modrinth 获取结果列表,存储于 RawResults" #Region "从 CurseForge 和 Modrinth 获取结果列表,存储于 RawResults"
Dim WorkThreads As New List(Of Thread) 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 筛选就会出现遗漏 '在 1.14-,部分老 Mod 没有设置支持的加载器,因此添加 Forge 筛选就会出现遗漏
'所以,在发起请求时不筛选加载器,然后在返回的结果中自行筛除不是 Forge 的 Mod '所以,在发起请求时不筛选加载器,然后在返回的结果中自行筛除不是 Forge 的 Mod
Dim IgnoreModLoaderFilter = Request.ModLoaders = ModLoaders.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140 Dim IgnoreModLoaderFilter = Request.ModLoaders = ModLoaders.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140
Dim SearchResults As New ConcurrentBag(Of ResourceProject)
Try Try
'CurseForge 搜索 'CurseForge 搜索
@@ -322,7 +326,7 @@ NextPage:
ProjectList.Add(Project) ProjectList.Add(Project)
Next Next
'更新结果 '更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p)) ProjectList.ForEach(Sub(p) SearchResults.Add(p))
Storage.CurseForgeOffset += RequestResult("data").Count Storage.CurseForgeOffset += RequestResult("data").Count
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer) Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
Logger.Info($"从 CurseForge 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)") Logger.Info($"从 CurseForge 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
@@ -350,7 +354,7 @@ NextPage:
ProjectList.Add(New ResourceProject(JsonEntry)) ProjectList.Add(New ResourceProject(JsonEntry))
Next Next
'更新结果 '更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p)) ProjectList.ForEach(Sub(p) SearchResults.Add(p))
Storage.ModrinthOffset += RequestResult("hits").Count Storage.ModrinthOffset += RequestResult("hits").Count
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer) Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
Logger.Info($"从 Modrinth 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)") Logger.Info($"从 Modrinth 搜索到了 {ProjectList.Count} 个工程(总计已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
@@ -386,7 +390,7 @@ NextPage:
ProjectList.Add(Project) ProjectList.Add(Project)
Next Next
'更新结果 '更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p)) ProjectList.ForEach(Sub(p) SearchResults.Add(p))
Logger.Info($"从 Modrinth 直接获取到了 {ProjectList.Count} 个工程") Logger.Info($"从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取 ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
Catch ex As Exception Catch ex As Exception
@@ -400,8 +404,9 @@ NextPage:
'等待线程结束 '等待线程结束
For Each Thread In WorkThreads For Each Thread In WorkThreads
Thread.Join() Thread.Join()
If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程 If Task.IsCanceled Then Return '会自动触发 Finally 以清理线程
Next Next
RawResults = New List(Of ResourceProject)(SearchResults)
'仅保留兼容 Forge 的 Mod,或老版本中没有标注任何 Mod Loader 的 Mod '仅保留兼容 Forge 的 Mod,或老版本中没有标注任何 Mod Loader 的 Mod
If IgnoreModLoaderFilter Then If IgnoreModLoaderFilter Then
@@ -510,7 +515,7 @@ NextPage:
Next Next
End If End If
'根据排序分得出结果并添加 '根据排序分得出结果并添加
If Task.IsInterrupted Then Throw New ThreadInterruptedException '#8246 If Task.IsCanceled Then Throw New OperationCanceledException '#8246
Storage.Results.AddRange( Storage.Results.AddRange(
Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key)) Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
@@ -1,4 +1,4 @@
''' <summary> ''' <summary>
''' 社区资源的单个可下载版本。 ''' 社区资源的单个可下载版本。
''' </summary> ''' </summary>
Public Class ResourceVersion Public Class ResourceVersion
@@ -132,7 +132,7 @@ Public Class ResourceVersion
'DownloadAddress 'DownloadAddress
Dim Url = Data("downloadUrl").ToString 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}" 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.Add(DlSourceModGet(Url)) '添加镜像源;注意 MCIM 源不支持 URL 编码后的文件名,必须传入 URL 编码前的文件名
.DownloadUrls = .DownloadUrls.Distinct.ToList '最终去重 .DownloadUrls = .DownloadUrls.Distinct.ToList '最终去重
'Dependencies 'Dependencies
@@ -178,21 +178,20 @@ Public Class ResourceVersion
.Size = File("size") .Size = File("size")
.Hash = File("hashes")("sha1") .Hash = File("hashes")("sha1")
End If End If
'类别 '类别与 Loaders
'结果可能混杂着 Mod、数据包和服务端插件 '结果可能混杂着 Mod、数据包和服务端插件
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
.ModLoaders = ModLoaders.None .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)() For Each Loader As ModLoaders In EnumUtils.GetAllFlags(Of ModLoaders)()
If RawLoaders.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader If RawLoaders.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader
Next 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 'Dependencies
If Data.ContainsKey("dependencies") Then If Data.ContainsKey("dependencies") Then
.RawDependencies = Data("dependencies"). .RawDependencies = Data("dependencies").
@@ -256,7 +255,7 @@ Public Class ResourceVersion
Else 'Modrinth Else 'Modrinth
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version?include_changelog=false") ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version?include_changelog=false")
End If 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). Where(Function(a) a.DownloadAvailable).
DistinctBy(Function(a) a.Id).ToList 'CurseForge 可能会重复返回相同项(#1330) DistinctBy(Function(a) a.Id).ToList 'CurseForge 可能会重复返回相同项(#1330)
End If End If
@@ -313,13 +312,13 @@ Public Class ResourceVersion
Public Function ToCacheJson() As JObject Public Function ToCacheJson() As JObject
Dim Result As New JObject Dim Result As New JObject
With Result With Result
.Add("ResourceType", ResourceType) .Add("ResourceType", CInt(ResourceType))
.Add("Id", Id) .Add("Id", Id)
If Version IsNot Nothing Then .Add("Version", Version) If Version IsNot Nothing Then .Add("Version", Version)
.Add("DisplayName", Display) .Add("DisplayName", Display)
.Add("ReleaseDate", ReleaseDate) .Add("ReleaseDate", ReleaseDate)
.Add("DownloadCount", DownloadCount) .Add("DownloadCount", DownloadCount)
.Add("ModLoaders", ModLoaders) .Add("ModLoaders", CInt(ModLoaders))
.Add("GameVersions", New JArray(GameVersions)) .Add("GameVersions", New JArray(GameVersions))
.Add("ReleaseType", CInt(ReleaseType)) .Add("ReleaseType", CInt(ReleaseType))
If FileName IsNot Nothing Then .Add("FileName", FileName) If FileName IsNot Nothing Then .Add("FileName", FileName)
@@ -359,17 +358,14 @@ Public Class ResourceVersion
If .Title <> FileName.BeforeLast(".") Then Yield FileName.BeforeLast(".") If .Title <> FileName.BeforeLast(".") Then Yield FileName.BeforeLast(".")
If Dependencies.Any Then Yield $"{Dependencies.Count} 项前置" 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 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 If DownloadCount > 0 Then Yield $"下载 {If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万", DownloadCount.ToString() + " ")}次" 'CurseForge 的下载次数经常错误地返回 0
Yield $"更新于 {GetTimeSpanString(ReleaseDate - Date.Now, False)}" Yield $"更新于 {StringUtils.FormatTimeSpan(ReleaseDate - Date.Now, False)}"
If ReleaseType <> ReleaseTypes.Release Then Yield ReleaseTypeDisplay If ReleaseType <> ReleaseTypes.Release Then Yield ReleaseTypeDisplay
End Function().Join(","c) End Function().Join(","c)
'另存为按钮 '另存为按钮
If SaveAsButtonHandler IsNot Nothing Then If SaveAsButtonHandler IsNot Nothing Then
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} 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 AddHandler BtnSave.Click, SaveAsButtonHandler
.Buttons = {BtnSave} .Buttons = {BtnSave}
End If End If
@@ -387,13 +383,14 @@ Public Class ResourceVersion
Return New NetFile( Return New NetFile(
ParseModrinthTrackArguments(DownloadUrls, TrackDownloadReason, TrackGameVersion, TrackLoader), ParseModrinthTrackArguments(DownloadUrls, TrackDownloadReason, TrackGameVersion, TrackLoader),
LocalFileOrFolder & If(LocalFileOrFolder.EndsWithF("\"), FileName, ""), LocalFileOrFolder & If(LocalFileOrFolder.EndsWithF("\"), FileName, ""),
New FileChecker(Hash:=Hash, ActualSize:=Size), New FileChecker With {.Hash = Hash, .ActualSize = Size},
SimulateBrowserHeaders:=True) SimulateBrowserHeaders:=True)
End Function End Function
''' <summary> ''' <summary>
''' 添加 Modrinth 追踪参数。 ''' 添加 Modrinth 追踪参数。
''' </summary> ''' </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) Dim Arguments As New Dictionary(Of String, String)
If TrackDownloadReason IsNot Nothing Then Arguments.Add("mr_download_reason", TrackDownloadReason.ToString.Lower) If TrackDownloadReason IsNot Nothing Then Arguments.Add("mr_download_reason", TrackDownloadReason.ToString.Lower)
If TrackGameVersion IsNot Nothing Then Arguments.Add("mr_game_version", TrackGameVersion) If TrackGameVersion IsNot Nothing Then Arguments.Add("mr_game_version", TrackGameVersion)
@@ -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
+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.ComponentModel
Imports System.Runtime.InteropServices Imports System.Runtime.InteropServices
@@ -9,10 +9,10 @@ Imports System.Runtime.InteropServices
'查看程序集特性的值 '查看程序集特性的值
<Assembly: AssemblyTitle("Plain Craft Launcher 启动器")> <Assembly: AssemblyTitle("Plain Craft Launcher 启动器")>
<Assembly: AssemblyDescription("Minecraft 启动器 (制作:龙腾猫跃)")> <Assembly: AssemblyDescription("Minecraft 启动器")>
<Assembly: AssemblyCompany("")> <Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("Plain Craft Launcher")> <Assembly: AssemblyProduct("Plain Craft Launcher")>
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016. All Rights Reserved.")> <Assembly: AssemblyCopyright("Copyright © 成都瓜皮龙科技有限公司")>
<Assembly: AssemblyConfiguration("PCL2 Config Mark")> <Assembly: AssemblyConfiguration("PCL2 Config Mark")>
<Assembly: ComVisible(False)> <Assembly: ComVisible(False)>
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.12.8.2")> <Assembly: AssemblyVersion("2.13.0.0")>
<Assembly: AssemblyFileVersion("2.12.8.2")> <Assembly: AssemblyFileVersion("2.13.0.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
@@ -1,4 +1,4 @@
#If _MyType <> "Empty" Then #If _MyType <> "Empty" Then
Namespace My Namespace My
''' <summary> ''' <summary>
+11 -24
View File
@@ -1,4 +1,4 @@
'------------------------------------------------------------------------------ '------------------------------------------------------------------------------
' <auto-generated> ' <auto-generated>
' 此代码由工具生成。 ' 此代码由工具生成。
' 运行时版本:4.0.30319.42000 ' 运行时版本:4.0.30319.42000
@@ -90,6 +90,16 @@ Namespace My.Resources
End Get End Get
End Property 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> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
@@ -180,29 +190,6 @@ Namespace My.Resources
End Get End Get
End Property 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> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
@@ -1,4 +1,4 @@
<?xml version="1.0" encoding="utf-8"?> <?xml version="1.0" encoding="utf-8"?>
<root> <root>
<!-- <!--
Microsoft ResX Schema Microsoft ResX Schema
@@ -127,6 +127,9 @@
<data name="CacheCow.Common" type="System.Resources.ResXFileRef, System.Windows.Forms"> <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> <value>..\Resources\CacheCow.Common.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </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"> <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> <value>..\resources\custom.xaml;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
@@ -154,9 +157,6 @@
<data name="MeloongCore.Wpf" type="System.Resources.ResXFileRef, System.Windows.Forms"> <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> <value>..\..\PCLCS\bin\MeloongCore.Wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </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"> <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> <value>..\Resources\NAudio.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
+1 -1
View File
@@ -1,4 +1,4 @@
'------------------------------------------------------------------------------ '------------------------------------------------------------------------------
' <auto-generated> ' <auto-generated>
' 此代码由工具生成。 ' 此代码由工具生成。
' 运行时版本:4.0.30319.42000 ' 运行时版本:4.0.30319.42000
@@ -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"> <SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles> <Profiles>
<Profile Name="(Default)" /> <Profile Name="(Default)" />
@@ -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"> <assembly manifestVersion="1.0" xmlns="urn:schemas-microsoft-com:asm.v1">
<assemblyIdentity version="1.0.0.0" name="MyApplication.app" /> <assemblyIdentity version="1.0.0.0" name="MyApplication.app" />
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2"> <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
@@ -1,4 +1,4 @@
Public Module ModDownloadLib Public Module ModDownloadLib
#Region "Minecraft 下载" #Region "Minecraft 下载"
@@ -21,7 +21,7 @@
End Sub) With {.ProgressWeight = 2, .Show = False}) End Sub) With {.ProgressWeight = 2, .Show = False})
End If End If
Loaders.Add(New LoaderDownload(McDownloadClientJsonName, New List(Of NetFile) From { 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}) }) With {.ProgressWeight = 3})
'下载支持库文件 '下载支持库文件
@@ -47,7 +47,7 @@
End Try End Try
'顺手添加 Json 项目 '顺手添加 Json 项目
Try Try
Dim InstanceJson As JObject = GetJson(FileUtils.ReadAsString(VersionFolder & InstanceName & ".json")) Dim InstanceJson As JObject = FileUtils.ReadAsJson(VersionFolder & InstanceName & ".json")
InstanceJson.Add("clientVersion", Id) InstanceJson.Add("clientVersion", Id)
FileUtils.Write($"{VersionFolder}{InstanceName}.json", InstanceJson.ToString) FileUtils.Write($"{VersionFolder}{InstanceName}.json", InstanceJson.ToString)
Catch ex As Exception Catch ex As Exception
@@ -106,32 +106,17 @@
End Function End Function
Private Sub McDownloadSaveMenuBuild(sender As Object, e As EventArgs) Private Sub McDownloadSaveMenuBuild(sender As Object, e As EventArgs)
Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} 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 AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog
Dim BtnServer As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonServer, .ToolTip = "下载服务端"} 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 AddHandler BtnServer.Click, AddressOf McDownloadMenuSaveServer
sender.Buttons = {BtnServer, BtnInfo} sender.Buttons = {BtnServer, BtnInfo}
End Sub End Sub
Private Sub McDownloadMenuBuild(sender As Object, e As EventArgs) Private Sub McDownloadMenuBuild(sender As Object, e As EventArgs)
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} 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 AddHandler BtnSave.Click, AddressOf McDownloadMenuSave
Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} 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 AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog
Dim BtnServer As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonServer, .ToolTip = "下载服务端"} 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 AddHandler BtnServer.Click, AddressOf McDownloadMenuSaveServer
sender.Buttons = {BtnSave, BtnInfo, BtnServer} sender.Buttons = {BtnSave, BtnInfo, BtnServer}
End Sub End Sub
@@ -172,7 +157,7 @@
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
'下载版本 JSON 文件 '下载版本 JSON 文件
Loaders.Add(New LoaderDownload("下载版本 JSON 文件", New List(Of NetFile) From { 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}) }) With {.ProgressWeight = 2})
'构建服务端 '构建服务端
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("构建服务端", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("构建服务端",
@@ -185,11 +170,11 @@
Task.Output = New List(Of NetFile) Task.Output = New List(Of NetFile)
Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载,没法下,撤退!", HintType.Red) Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载,没法下,撤退!", HintType.Red)
Thread.Sleep(2000) '等玩家把上一个提示看完 Thread.Sleep(2000) '等玩家把上一个提示看完
Task.Interrupt() Task.Cancel()
Return Return
End If End If
Dim JarUrl As String = Instance.JsonObject("downloads")("server")("url") 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)} Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JarUrl), VersionFolder & Id & "-server.jar", Checker)}
'添加启动脚本 '添加启动脚本
Dim Bat As String = Dim Bat As String =
@@ -205,7 +190,7 @@ echo ----------------------
echo 服务端已停止。 echo 服务端已停止。
pause" pause"
FileUtils.Write(VersionFolder & "Launch Server.bat", Bat, 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 '删除版本 JSON
FileUtils.Delete(VersionFolder & Id & ".json") FileUtils.Delete(VersionFolder & Id & ".json")
End Sub) With {.ProgressWeight = 0.5, .Show = False}) End Sub) With {.ProgressWeight = 0.5, .Show = False})
@@ -248,7 +233,7 @@ pause"
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
'下载版本 JSON 文件 '下载版本 JSON 文件
Loaders.Add(New LoaderDownload("下载版本 JSON 文件", New List(Of NetFile) From { 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}) }) With {.ProgressWeight = 2})
'获取支持库文件地址 '获取支持库文件地址
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 JAR 文件下载地址", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 JAR 文件下载地址",
@@ -357,27 +342,29 @@ pause"
End Try End Try
End Sub End Sub
Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean), UseJavaWrapper As Boolean) Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean), UseJavaWrapper As Boolean)
'选择 Java Dim JavaRange = ValueRange(Of Version).AtLeast(New Version(21, 0)) '默认值
Dim Java As JavaEntry
SyncLock JavaLock
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
If Java Is Nothing Then
'开始自动下载
Dim JavaLoader = GetJavaDownloadLoader()
Try Try
JavaLoader.Start(17, IsForceRestart:=True) Using Installer = FileUtils.OpenZip(Target)
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsInterrupted Dim InstallerClass = Installer.GetEntry("optifine/Installer.class")
Thread.Sleep(10) If InstallerClass Is Nothing Then Throw New FileNotFoundException("未找到 optifine/Installer.class")
Loop Using Stream = InstallerClass.Open(), Reader As New BinaryReader(Stream)
Finally Dim Header = Reader.ReadBytes(8)
JavaLoader.Interrupt() '确保取消时中止 Java 下载 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 End Try
'检查下载结果 '选择 Java
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0)) Dim Java As Java = SelectOrDownloadJava(JavaRange, True, Task.CreateCancellationToken, Task.CreateSyncProgressProvider(0, 0.2))
If Task.IsInterrupted Then Return If Task.IsCanceled Then Return
If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。") If Java Is Nothing Then Throw New OperationCanceledException
End If
End SyncLock
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
Dim Arguments As String Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
@@ -385,11 +372,11 @@ pause"
Else Else
Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer" Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer"
End If 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 SyncLock InstallSyncLock
Dim Info = New ProcessStartInfo With { Dim Info = New ProcessStartInfo With {
.FileName = Java.PathJava, .FileName = Java.JavaExePath,
.Arguments = Arguments, .Arguments = Arguments,
.UseShellExecute = False, .UseShellExecute = False,
.CreateNoWindow = True, .CreateNoWindow = True,
@@ -417,14 +404,14 @@ pause"
LastResult = e.Data LastResult = e.Data
Logger.Trace(LastResult) Logger.Trace(LastResult)
TotalLength += 1 TotalLength += 1
Task.Progress += 0.9 / 7000 Task.Progress += 0.7 / 7000
End If End If
Catch ex As ObjectDisposedException Catch ex As ObjectDisposedException
Catch ex As Exception Catch ex As Exception
Logger.Warn(ex, "读取 OptiFine 安装器信息失败") Logger.Warn(ex, "读取 OptiFine 安装器信息失败")
End Try End Try
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 安装") Logger.Info("由于任务取消,已中止 OptiFine 安装")
process.Kill() process.Kill()
End If End If
@@ -441,14 +428,14 @@ pause"
LastResult = e.Data LastResult = e.Data
Logger.Trace(LastResult) Logger.Trace(LastResult)
TotalLength += 1 TotalLength += 1
Task.Progress += 0.9 / 7000 Task.Progress += 0.7 / 7000
End If End If
Catch ex As ObjectDisposedException Catch ex As ObjectDisposedException
Catch ex As Exception Catch ex As Exception
Logger.Warn(ex, "读取 OptiFine 安装器错误信息失败") Logger.Warn(ex, "读取 OptiFine 安装器错误信息失败")
End Try End Try
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 安装") Logger.Info("由于任务取消,已中止 OptiFine 安装")
process.Kill() process.Kill()
End If End If
@@ -513,7 +500,7 @@ pause"
Logger.Warn(ex, $"获取 OptiFine {DownloadInfo.DisplayName} 官方下载地址失败") Logger.Warn(ex, $"获取 OptiFine {DownloadInfo.DisplayName} 官方下载地址失败")
End Try 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}) End Sub) With {.ProgressWeight = 8})
Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8}) Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载", 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). ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Any Then Logger.Info("OptiFine 安装正在等待原版文件下载完成") 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 TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50) Thread.Sleep(50)
Loop Loop
If Task.IsInterrupted Then Return If Task.IsCanceled Then Return
'复制原版文件 '复制原版文件
If Not IsCustomFolder Then Return If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock SyncLock VanillaSyncLock
@@ -666,7 +653,7 @@ Retry:
End Try End Try
Task.Progress = 0.9 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}) End Sub) With {.ProgressWeight = 6})
'下载 '下载
Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 10, .Block = True}) Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 10, .Block = True})
@@ -700,22 +687,13 @@ Retry:
End Function End Function
Private Sub OptiFineSaveContMenuBuild(sender As Object, e As EventArgs) Private Sub OptiFineSaveContMenuBuild(sender As Object, e As EventArgs)
Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} 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 AddHandler BtnInfo.Click, AddressOf OptiFineLog_Click
sender.Buttons = {BtnInfo} sender.Buttons = {BtnInfo}
End Sub End Sub
Private Sub OptiFineContMenuBuild(sender As Object, e As EventArgs) Private Sub OptiFineContMenuBuild(sender As Object, e As EventArgs)
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} 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 AddHandler BtnSave.Click, AddressOf OptiFineSave_Click
Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} 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 AddHandler BtnInfo.Click, AddressOf OptiFineLog_Click
sender.Buttons = {BtnSave, BtnInfo} sender.Buttons = {BtnSave, BtnInfo}
End Sub 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) 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 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} Dim Loader As New LoaderCombo(Of DlLiteLoaderListEntry)("LiteLoader " & Id & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(DownloadInfo) 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("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("releaseTime", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.InvariantCulture))
VersionJson.Add("type", "release") 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")) 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("mainClass", "net.minecraft.launchwrapper.Launch")
VersionJson.Add("minimumLauncherVersion", 18) VersionJson.Add("minimumLauncherVersion", 18)
VersionJson.Add("inheritsFrom", DownloadInfo.Inherit) VersionJson.Add("inheritsFrom", DownloadInfo.Inherit)
@@ -866,26 +844,17 @@ Retry:
sender.Buttons = {} sender.Buttons = {}
Else Else
Dim BtnList As New MyIconButton With {.Logo = Logo.IconButtonList, .ToolTip = "查看全部版本", .Tag = sender} 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 AddHandler BtnList.Click, AddressOf LiteLoaderAll_Click
sender.Buttons = {BtnList} sender.Buttons = {BtnList}
End If End If
End Sub End Sub
Private Sub LiteLoaderContMenuBuild(sender As MyListItem, e As EventArgs) Private Sub LiteLoaderContMenuBuild(sender As MyListItem, e As EventArgs)
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "保存安装器", .Tag = sender} 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 AddHandler BtnSave.Click, AddressOf LiteLoaderSave_Click
If sender.Tag.IsLegacy Then If sender.Tag.IsLegacy Then
sender.Buttons = {BtnSave} sender.Buttons = {BtnSave}
Else Else
Dim BtnList As New MyIconButton With {.Logo = Logo.IconButtonList, .ToolTip = "查看全部版本", .Tag = sender} 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 AddHandler BtnList.Click, AddressOf LiteLoaderAll_Click
sender.Buttons = {BtnSave, BtnList} sender.Buttons = {BtnSave, BtnList}
End If End If
@@ -936,14 +905,14 @@ Retry:
Dim Url As String = NeoForge.UrlBase & "-installer.jar" Dim Url As String = NeoForge.UrlBase & "-installer.jar"
Files.Add(New NetFile({ Files.Add(New NetFile({
Url.Replace("maven.neoforged.net/releases", "bmclapi2.bangbang93.com/maven"), Url 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 Else
'Forge 'Forge
Dim Forge As DlForgeVersionEntry = Info Dim Forge As DlForgeVersionEntry = Info
Files.Add(New NetFile({ 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://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}" $"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 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) Private Sub ForgelikeInjector(Target As String, Task As LoaderTask(Of Boolean, Boolean), McFolder As String, UseJavaWrapper As Boolean, IsNeoForge As Boolean)
'选择 Java '选择 Java
Dim Java As JavaEntry Dim Java As Java = SelectOrDownloadJava(ValueRange(Of Version).AtLeast(New Version(8, 0, 60)), True, Task.CreateCancellationToken, Task.CreateSyncProgressProvider(0, 0.2))
SyncLock JavaLock If Task.IsCanceled Then Return
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60)) If Java Is Nothing Then Throw New OperationCanceledException
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
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
Dim Arguments As String Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
@@ -991,11 +943,11 @@ Retry:
Else Else
Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}" Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}"
End If 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 SyncLock InstallSyncLock
Dim Info = New ProcessStartInfo With { Dim Info = New ProcessStartInfo With {
.FileName = Java.PathJava, .FileName = Java.JavaExePath,
.Arguments = Arguments, .Arguments = Arguments,
.UseShellExecute = False, .UseShellExecute = False,
.CreateNoWindow = True, .CreateNoWindow = True,
@@ -1023,7 +975,7 @@ Retry:
Logger.Warn(ex, $"读取 {LoaderName} 安装器信息失败") Logger.Warn(ex, $"读取 {LoaderName} 安装器信息失败")
End Try End Try
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} 安装") Logger.Info($"由于任务取消,已中止 {LoaderName} 安装")
process.Kill() process.Kill()
End If End If
@@ -1046,7 +998,7 @@ Retry:
Logger.Warn(ex, $"读取 {LoaderName} 安装器错误信息失败") Logger.Warn(ex, $"读取 {LoaderName} 安装器错误信息失败")
End Try End Try
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} 安装") Logger.Info($"由于任务取消,已中止 {LoaderName} 安装")
process.Kill() process.Kill()
End If End If
@@ -1080,35 +1032,35 @@ Retry:
Private Sub ForgelikeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean)) Private Sub ForgelikeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean))
Select Case Content Select Case Content
Case "Extracting json" Case "Extracting json"
Task.Progress = 0.07 Task.Progress = 0.27
Case "Downloading libraries" Case "Downloading libraries"
Task.Progress = 0.08 Task.Progress = 0.28
Case " File exists: Checksum validated." Case " File exists: Checksum validated."
Task.Progress += 0.003 Task.Progress += 0.003
Case "Building Processors" Case "Building Processors"
Task.Progress = 0.18 Task.Progress = 0.38
Case "Task: DOWNLOAD_MOJMAPS" 'B 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 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 Case "Processing Complete" 'B
Task.Progress = 0.5 Task.Progress = 0.67
Case "log: null" 'new Case "log: null" 'new
Task.Progress = 0.5 Task.Progress = 0.67
Case "Sorting" 'new Case "Sorting" 'new
Task.Progress = 0.65 Task.Progress = 0.8
Case "Remapping final jar" 'A Case "Remapping final jar" 'A
Task.Progress = 0.72 Task.Progress = 0.85
Case "Remapping jar... 50%" 'A Case "Remapping jar... 50%" 'A
Task.Progress = 0.76 Task.Progress = 0.9
Case "Remapping jar... 100%" 'A Case "Remapping jar... 100%" 'A
Task.Progress = 0.81 Task.Progress = 0.95
Case "Injecting profile" Case "Injecting profile"
Task.Progress = 0.91 Task.Progress = 0.98
Case Else Case Else
Logger.Trace(Content) Logger.Trace(Content)
Return Return
@@ -1173,7 +1125,7 @@ Retry:
Dim Url As String = Neo.UrlBase & "-installer.jar" Dim Url As String = Neo.UrlBase & "-installer.jar"
Files.Add(New NetFile({ Files.Add(New NetFile({
Url.Replace("maven.neoforged.net/releases", "bmclapi2.bangbang93.com/maven"), Url 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 Else
'Forge 'Forge
Dim Forge As DlForgeVersionEntry = Info Dim Forge As DlForgeVersionEntry = Info
@@ -1182,7 +1134,7 @@ Retry:
Files.Add(New NetFile({ Files.Add(New NetFile({
$"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/{FileName}", $"https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/{FileName}",
$"https://files.minecraftforge.net/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 End If
Task.Output = Files Task.Output = Files
End Sub) With {.ProgressWeight = 0.5, .Show = False}) End Sub) With {.ProgressWeight = 0.5, .Show = False})
@@ -1200,8 +1152,8 @@ Retry:
'解压并获取、合并两个 Json 的信息 '解压并获取、合并两个 Json 的信息
Installer = FileUtils.OpenZip(InstallerAddress) Installer = FileUtils.OpenZip(InstallerAddress)
Task.Progress = 0.2 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()
Dim Json2 As JObject = GetJson(Installer.GetEntry("version.json").Open().ReadString) Dim Json2 As JObject = Installer.GetEntry("version.json").Open().ReadString().DeserializeJson()
Json.Merge(Json2) Json.Merge(Json2)
'获取 Lib 下载信息 '获取 Lib 下载信息
Libs = McLibListGetWithJson(Json, True) Libs = McLibListGetWithJson(Json, True)
@@ -1209,7 +1161,7 @@ Retry:
If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
'下载原版 Json 文件 '下载原版 Json 文件
Task.Progress = 0.4 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] '[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).BeforeFirst("@") Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).BeforeFirst("@")
Dim Address = McLibGet(OriginalName).Replace(".jar", "." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1)) Dim 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). ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList() Where(Function(l) l.State <> LoadState.Finished).ToList()
If TargetLoaders.Any Then Logger.Info($"{LoaderName} 安装正在等待原版文件下载完成") 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 TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50) Thread.Sleep(50)
Loop Loop
If Task.IsInterrupted Then Return If Task.IsCanceled Then Return
'复制原版文件 '复制原版文件
If Not IsCustomFolder Then Return If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock SyncLock VanillaSyncLock
@@ -1279,10 +1231,10 @@ Retry:
Try Try
Logger.Info($"开始进行 Forgelike 安装:{InstallerAddress}") Logger.Info($"开始进行 Forgelike 安装:{InstallerAddress}")
'记录当前文件夹列表(在新建目标文件夹之前) '记录当前文件夹列表(在新建目标文件夹之前)
Dim OldList = DirectoryUtils.GetDirectories(McFolder & "versions\", True).ToList() Dim OldList = DirectoryUtils.EnumerateDirectories(McFolder & "versions\").ToList()
'解压并获取信息 '解压并获取信息
Installer = FileUtils.OpenZip(InstallerAddress) 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) DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.04 Task.Progress = 0.04
@@ -1309,7 +1261,7 @@ Retry:
End If End If
End Try End Try
'复制新增的版本 Json '复制新增的版本 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() SkipWhile(Function(i) OldList.Contains(i)).Select(Function(f) DirectoryUtils.GetInfo(f)).ToList()
If DeltaList.Count > 1 Then If DeltaList.Count > 1 Then
'它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151) '它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
@@ -1350,7 +1302,7 @@ Retry:
'解压并获取信息 '解压并获取信息
Installer = FileUtils.OpenZip(InstallerAddress) Installer = FileUtils.OpenZip(InstallerAddress)
Task.Progress = 0.2 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 Task.Progress = 0.4
'新建版本文件夹 '新建版本文件夹
DirectoryUtils.Create(VersionFolder) DirectoryUtils.Create(VersionFolder)
@@ -1359,7 +1311,7 @@ Retry:
'中版:Legacy 方式 1 '中版:Legacy 方式 1
Logger.Info($"开始进行 Forge 安装,Legacy 方式 1:{InstallerAddress}") Logger.Info($"开始进行 Forge 安装,Legacy 方式 1:{InstallerAddress}")
'建立 Json 文件 '建立 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 JsonVersion("id") = NewInstanceName
FileUtils.Write(VersionFolder & NewInstanceName & ".json", JsonVersion.ToString) FileUtils.Write(VersionFolder & NewInstanceName & ".json", JsonVersion.ToString)
Task.Progress = 0.6 Task.Progress = 0.6
@@ -1455,22 +1407,13 @@ Retry:
End Function End Function
Private Sub ForgeContMenuBuild(sender As MyListItem, e As EventArgs) Private Sub ForgeContMenuBuild(sender As MyListItem, e As EventArgs)
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} 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 AddHandler BtnSave.Click, AddressOf ForgeSave_Click
Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} 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 AddHandler BtnInfo.Click, AddressOf ForgeLog_Click
sender.Buttons = {BtnSave, BtnInfo} sender.Buttons = {BtnSave, BtnInfo}
End Sub End Sub
Private Sub ForgeSaveContMenuBuild(sender As MyListItem, e As EventArgs) Private Sub ForgeSaveContMenuBuild(sender As MyListItem, e As EventArgs)
Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} 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 AddHandler BtnInfo.Click, AddressOf ForgeLog_Click
sender.Buttons = {BtnInfo} sender.Buttons = {BtnInfo}
End Sub End Sub
@@ -1513,7 +1456,7 @@ Retry:
Logger.Info("刷新 Forge 推荐版本缓存开始") Logger.Info("刷新 Forge 推荐版本缓存开始")
Dim Result As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/promos", RequireJson:=True) Dim Result As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/promos", RequireJson:=True)
If Result.Length < 1000 Then Throw New Exception("获取的结果过短(" & Result & ")") 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) Dim RecommendedList As New List(Of String)
For Each Version As JObject In ResultJson For Each Version As JObject In ResultJson
@@ -1546,7 +1489,7 @@ Retry:
Logger.Info("没有 Forge 推荐版本缓存文件") Logger.Info("没有 Forge 推荐版本缓存文件")
Return Nothing Return Nothing
End If 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 If Json Is Nothing OrElse (Not If(McVersion, "").Contains(".")) OrElse Not Json.ContainsKey(McVersion) Then Return Nothing
Return If(Json(McVersion), "").ToString Return If(Json(McVersion), "").ToString
Catch ex As Exception Catch ex As Exception
@@ -1613,22 +1556,13 @@ Retry:
End Function End Function
Private Sub NeoForgeContMenuBuild(sender As MyListItem, e As EventArgs) Private Sub NeoForgeContMenuBuild(sender As MyListItem, e As EventArgs)
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} 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 AddHandler BtnSave.Click, AddressOf NeoForgeSave_Click
Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} 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 AddHandler BtnInfo.Click, AddressOf NeoForgeLog_Click
sender.Buttons = {BtnSave, BtnInfo} sender.Buttons = {BtnSave, BtnInfo}
End Sub End Sub
Private Sub NeoForgeSaveContMenuBuild(sender As MyListItem, e As EventArgs) Private Sub NeoForgeSaveContMenuBuild(sender As MyListItem, e As EventArgs)
Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} 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 AddHandler BtnInfo.Click, AddressOf NeoForgeLog_Click
sender.Buttons = {BtnInfo} sender.Buttons = {BtnInfo}
End Sub End Sub
@@ -1680,7 +1614,7 @@ Retry:
'BMCLAPI 不支持 Fabric Installer 下载 'BMCLAPI 不支持 Fabric Installer 下载
Dim Address As New List(Of String) Dim Address As New List(Of String)
Address.Add(Url) 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} Dim Loader As New LoaderCombo(Of JObject)("Fabric " & Version & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(DownloadInfo) Loader.Start(DownloadInfo)
@@ -1712,7 +1646,7 @@ Retry:
Task.Output = New List(Of NetFile) From {New NetFile({ Task.Output = New List(Of NetFile) From {New NetFile({
"https://bmclapi2.bangbang93.com/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json", "https://bmclapi2.bangbang93.com/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json",
"https://meta.fabricmc.net/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}) End Sub) With {.ProgressWeight = 0.5})
Loaders.Add(New LoaderDownload("下载 Fabric 主文件", New List(Of NetFile)) With {.ProgressWeight = 2.5}) Loaders.Add(New LoaderDownload("下载 Fabric 主文件", New List(Of NetFile)) With {.ProgressWeight = 2.5})
@@ -1849,7 +1783,7 @@ Retry:
Hint(Loader.Name & "成功!", HintType.Green) Hint(Loader.Name & "成功!", HintType.Green)
Case LoadState.Failed Case LoadState.Failed
Hint(Loader.Name & "失败:" & Loader.Error.GetDisplay(False), HintType.Red) Hint(Loader.Name & "失败:" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted Case LoadState.Canceled
Hint(Loader.Name & "已取消!", HintType.Blue) Hint(Loader.Name & "已取消!", HintType.Blue)
End Select End Select
End Sub End Sub
@@ -1864,7 +1798,7 @@ Retry:
'TODO: 自动选择安装成功的版本 'TODO: 自动选择安装成功的版本
Case LoadState.Failed Case LoadState.Failed
MyMsgBox(Loader.Error.GetDisplay(True), Loader.Name & "失败", IsWarn:=True) MyMsgBox(Loader.Error.GetDisplay(True), Loader.Name & "失败", IsWarn:=True)
Case LoadState.Interrupted Case LoadState.Canceled
Hint(Loader.Name & "已取消!", HintType.Blue) Hint(Loader.Name & "已取消!", HintType.Blue)
Case LoadState.Loading Case LoadState.Loading
Return '不重新加载版本列表 Return '不重新加载版本列表
@@ -1875,7 +1809,7 @@ Retry:
Public Sub McInstallFailedClearFolder(Loader) Public Sub McInstallFailedClearFolder(Loader)
Try Try
Thread.Sleep(1000) '防止存在尚未完全释放的文件,导致清理失败(例如整合包安装) 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 If DirectoryUtils.Exists(Loader.Input & "saves\") OrElse DirectoryUtils.Exists(Loader.Input & "versions\") Then
Logger.Warn($"由于版本已被独立启动,不清理版本文件夹:{Loader.Input}") Logger.Warn($"由于版本已被独立启动,不清理版本文件夹:{Loader.Input}")
@@ -1905,8 +1839,6 @@ Retry:
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
Return True Return True
Catch ex As CancelledException
Return False
Catch ex As Exception Catch ex As Exception
Logger.Error(ex, "开始合并安装失败") Logger.Error(ex, "开始合并安装失败")
Return False Return False
@@ -1915,7 +1847,6 @@ Retry:
''' <summary> ''' <summary>
''' 获取合并安装加载器列表,并进行前期的缓存清理与 Java 检查工作。 ''' 获取合并安装加载器列表,并进行前期的缓存清理与 Java 检查工作。
''' </summary> ''' </summary>
''' <exception cref="CancelledException" />
Public Function McInstallLoader(Request As McInstallRequest) As List(Of LoaderBase) Public Function McInstallLoader(Request As McInstallRequest) As List(Of LoaderBase)
'获取缓存目录(安装 Mod 加载器的文件夹不能包含空格) '获取缓存目录(安装 Mod 加载器的文件夹不能包含空格)
Dim TempMcFolder As String = RequestTaskTempFolder(Request.OptiFineEntry IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing) 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 If FileUtils.Exists($"{VersionFolder}{Request.NewInstanceName}.json") Then
Hint("版本 " & Request.NewInstanceName & " 已经存在!", HintType.Red) Hint("版本 " & Request.NewInstanceName & " 已经存在!", HintType.Red)
Throw New CancelledException Throw New OperationCanceledException
End If End If
Dim LoaderList As New List(Of LoaderBase) Dim LoaderList As New List(Of LoaderBase)
@@ -2115,36 +2046,36 @@ Retry:
#Region "读取文件并检查文件是否合规" #Region "读取文件并检查文件是否合规"
Dim MinecraftJsonText As String = If(FileUtils.TryReadAsString(MinecraftJsonPath), "") Dim MinecraftJsonText As String = If(FileUtils.TryReadAsString(MinecraftJsonPath), "")
If Not MinecraftJsonText.StartsWithF("{") Then Throw New Exception("Minecraft json 有误,地址:" & MinecraftJsonPath & ",前段内容:" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000))) 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 If HasOptiFine Then
Dim OptiFineJsonText As String = If(FileUtils.TryReadAsString(OptiFineJsonPath), "") Dim OptiFineJsonText As String = If(FileUtils.TryReadAsString(OptiFineJsonPath), "")
If Not OptiFineJsonText.StartsWithF("{") Then Throw New Exception("OptiFine json 有误,地址:" & OptiFineJsonPath & ",前段内容:" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000))) 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 End If
If HasForge Then If HasForge Then
Dim ForgeJsonText As String = If(FileUtils.TryReadAsString(ForgeJsonPath), "") Dim ForgeJsonText As String = If(FileUtils.TryReadAsString(ForgeJsonPath), "")
If Not ForgeJsonText.StartsWithF("{") Then Throw New Exception("Forge json 有误,地址:" & ForgeJsonPath & ",前段内容:" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000))) 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 End If
If HasNeoForge Then If HasNeoForge Then
Dim NeoForgeJsonText As String = If(FileUtils.TryReadAsString(NeoForgeJsonPath), "") Dim NeoForgeJsonText As String = If(FileUtils.TryReadAsString(NeoForgeJsonPath), "")
If Not NeoForgeJsonText.StartsWithF("{") Then Throw New Exception("NeoForge json 有误,地址:" & NeoForgeJsonPath & ",前段内容:" & NeoForgeJsonText.Substring(0, Math.Min(NeoForgeJsonText.Length, 1000))) 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 End If
If HasLiteLoader Then If HasLiteLoader Then
Dim LiteLoaderJsonText As String = If(FileUtils.TryReadAsString(LiteLoaderJsonPath), "") Dim LiteLoaderJsonText As String = If(FileUtils.TryReadAsString(LiteLoaderJsonPath), "")
If Not LiteLoaderJsonText.StartsWithF("{") Then Throw New Exception("LiteLoader json 有误,地址:" & LiteLoaderJsonPath & ",前段内容:" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000))) 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 End If
If HasFabric Then If HasFabric Then
Dim FabricJsonText As String = If(FileUtils.TryReadAsString(FabricJsonPath), "") Dim FabricJsonText As String = If(FileUtils.TryReadAsString(FabricJsonPath), "")
If Not FabricJsonText.StartsWithF("{") Then Throw New Exception("Fabric json 有误,地址:" & FabricJsonPath & ",前段内容:" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000))) 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 If
#End Region #End Region

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