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

2.12.8.0

Browse Source
This commit is contained in:
龙腾猫跃
2026-05-15 22:06:22 +08:00
parent 277c020186
commit 53fe8204cf
110 changed files with 30470 additions and 4729 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.editorconfig
+9 -1
View File
@@ -1,4 +1,12 @@
[*.{cs,vb}] # 如果要从更高级别的目录继承 .editorconfig 设置，请删除以下行
root = true
[*.cs]
# IDE0320: 使匿名函数成为静态函数
csharp_prefer_static_anonymous_function = false
[*.{cs,vb}]
# IDE0028: 简化集合初始化 # IDE0028: 简化集合初始化
dotnet_style_collection_initializer = true:silent dotnet_style_collection_initializer = true:silent
PCLCS/Constants.cs
+75
View File
@@ -0,0 +1,75 @@
namespace PCLCS;
/// <summary>
/// 社区资源的类型。
/// </summary>
[Flags]
public enum ResourceTypes {
/// <summary>Mod。</summary>
Mod = 1,
/// <summary>整合包。</summary>
ModPack = 2,
/// <summary>资源包。</summary>
ResourcePack = 4,
/// <summary>光影包。</summary>
Shader = 8,
/// <summary>数据包。</summary>
DataPack = 16,
/// <summary>服务端插件。</summary>
Plugin = 32,
/// <summary>同时包含数据包以及 Mod。</summary>
ModOrDataPack = Mod | DataPack,
/// <summary>允许任意种类，或种类未知。</summary>
Any = Mod | ModPack | ResourcePack | Shader | DataPack | Plugin,
}
/// <summary>
/// 社区资源的来源平台。
/// </summary>
[Flags]
public enum ResourcePlatforms {
CurseForge = 1,
Modrinth = 2,
Any = CurseForge | Modrinth,
}
/// <summary>
/// Mod 加载器的类型。
/// </summary>
[Flags]
public enum ModLoaders {
None = 0,
Forge = 1,
LiteLoader = 2,
Fabric = 4,
Quilt = 8,
NeoForge = 16,
All = Forge | LiteLoader | Fabric | Quilt | NeoForge,
}
/// <summary>
/// 在爱发电中的赞助等级。
/// </summary>
public enum DonationRank {
None = 0,
Rank6 = 6,
Rank12 = 12,
Rank23 = 23,
Rank54 = 54,
Rank98 = 98,
}
public static class Versions {
/// <summary>
/// 土豆码版本号。
/// </summary>
public const char POTATO_VERSION = '1';
/// <summary>
/// 版本管理中 Mod 信息缓存的版本号。
/// </summary>
public const int LOCAL_MOD_CACHE_VERSION = 17;
/// <summary>
/// Minecraft 本地实例信息缓存的版本号。
/// </summary>
public const int MCINSTANCE_CACHE_VERSION = 37;
}
PCLCS/PCLCS.csproj
+12 -19
View File
@@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net462</TargetFramework> <TargetFramework>net48</TargetFramework>
<OutputType>Library</OutputType> <OutputType>Library</OutputType>
<AllowUnsafeBlocks>True</AllowUnsafeBlocks> <AllowUnsafeBlocks>True</AllowUnsafeBlocks>
<OutDir>bin\</OutDir> <OutDir>bin\</OutDir>
@@ -11,34 +11,22 @@
<Deterministic>true</Deterministic> <Deterministic>true</Deterministic>
<LangVersion>13.0</LangVersion> <LangVersion>13.0</LangVersion>
<Nullable>enable</Nullable> <Nullable>enable</Nullable>
<AnalysisLevel>8.0</AnalysisLevel> <ImplicitUsings>enable</ImplicitUsings>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Nullable" Version="1.3.1"> <PackageReference Include="PolySharp" Version="1.15.0">
<PrivateAssets>all</PrivateAssets> <PrivateAssets>all</PrivateAssets>
<IncludeAssets>runtime; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets> <IncludeAssets>runtime; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets>
</PackageReference> </PackageReference>
<PackageReference Include="System.ValueTuple" Version="4.6.1" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<ProjectReference Include="..\MeloongCore\Shared\MeloongCore.csproj" /> <Using Include="System.Diagnostics.CodeAnalysis" />
<ProjectReference Include="..\MeloongCore\Wpf\MeloongCoreWpf.csproj" />
</ItemGroup>
<ItemGroup>
<Using Include="System" />
<Using Include="System.ComponentModel" />
<Using Include="System.Collections" /> <Using Include="System.Collections" />
<Using Include="System.Collections.Generic" /> <Using Include="System.Collections.Generic" />
<Using Include="System.Diagnostics.CodeAnalysis" />
<Using Include="System.Linq" />
<Using Include="System.Text" /> <Using Include="System.Text" />
<Using Include="System.IO" />
<Using Include="System.Net" /> <Using Include="System.Net" />
<Using Include="System.Threading" />
<Using Include="System.Collections.Concurrent" />
<Using Include="System.Runtime.CompilerServices" /> <Using Include="System.Runtime.CompilerServices" />
<Using Include="System.Runtime.InteropServices" /> <Using Include="System.Runtime.InteropServices" />
<Using Include="MeloongCore" /> <Using Include="MeloongCore" />
@@ -47,6 +35,11 @@
<Using Include="MeloongCore.Wpf.Extensions" /> <Using Include="MeloongCore.Wpf.Extensions" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<ProjectReference Include="..\MeloongCore\Shared\MeloongCore.csproj" />
<ProjectReference Include="..\MeloongCore\Wpf\MeloongCore.Wpf.csproj" />
</ItemGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|AnyCPU'"> <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|AnyCPU'">
<DefineConstants>$(DefineConstants);SNAPSHOT</DefineConstants> <DefineConstants>$(DefineConstants);SNAPSHOT</DefineConstants>
</PropertyGroup> </PropertyGroup>
PCLCS/Resource/Resource.cs
+33
View File
@@ -0,0 +1,33 @@
namespace PCLCS;
public static class Resource {
/// <summary>
/// 将 CurseForge 的 ModLoaderType 映射为 <see cref="ModLoaders"/> 枚举。
/// </summary>
public static ModLoaders FromCurseForgeModLoaderType(int modLoaderType) => modLoaderType switch {
// https://docs.curseforge.com/rest-api/#tocS_ModLoaderType
1 => ModLoaders.Forge,
3 => ModLoaders.LiteLoader,
4 => ModLoaders.Fabric,
5 => ModLoaders.Quilt,
6 => ModLoaders.NeoForge,
_ => ModLoaders.None,
};
/// <summary>
/// 将 <see cref="ModLoaders"/> 映射为 CurseForge 的单一 ModLoaderType。
/// </summary>
public static int ToCurseForgeModLoaderType(ModLoaders loaders) {
if (loaders == ModLoaders.None) return 0;
if (!loaders.Flags().IsSingle()) throw new ArgumentException($"传入的枚举值 {loaders} 并非单个 Mod Loader", nameof(loaders));
return loaders switch {
ModLoaders.Forge => 1,
ModLoaders.LiteLoader => 3,
ModLoaders.Fabric => 4,
ModLoaders.Quilt => 5,
ModLoaders.NeoForge => 6,
_ => 0,
};
}
}
Plain Craft Launcher 2.sln
+1 -1
View File
@@ -9,7 +9,7 @@ Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "PCLCS", "PCLCS\PCLCS.csproj
EndProject EndProject
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "MeloongCore", "MeloongCore\Shared\MeloongCore.csproj", "{D22BBF3C-2177-0208-4E29-8466AA41AC6F}" Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "MeloongCore", "MeloongCore\Shared\MeloongCore.csproj", "{D22BBF3C-2177-0208-4E29-8466AA41AC6F}"
EndProject EndProject
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "MeloongCoreWpf", "MeloongCore\Wpf\MeloongCoreWpf.csproj", "{2DFFE2A0-1101-816B-D240-F644B2D74A68}" Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "MeloongCore.Wpf", "MeloongCore\Wpf\MeloongCore.Wpf.csproj", "{2DFFE2A0-1101-816B-D240-F644B2D74A68}"
EndProject EndProject
Global Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution GlobalSection(SolutionConfigurationPlatforms) = preSolution
Plain Craft Launcher 2/App.config
+2 -9
View File
@@ -5,13 +5,10 @@
<httpWebRequest useUnsafeHeaderParsing="true"/> <httpWebRequest useUnsafeHeaderParsing="true"/>
</settings> </settings>
</system.net> </system.net>
<startup> <startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/> <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
</startup> </startup>
<runtime> <runtime>
<AppContextSwitchOverrides value="Switch.System.Net.DontEnableSchUseStrongCrypto=false" />
<AppContextSwitchOverrides value="Switch.System.Windows.DoNotScaleForDpiChanges=false"/> <!-- #5337 -->
<AppContextSwitchOverrides value="Switch.System.IO.UseLegacyPathHandling=false;Switch.System.IO.BlockLongPaths=false" /> <!-- 长路径支持 -->
<generatePublisherEvidence enabled="false"/> <generatePublisherEvidence enabled="false"/>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1"> <assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly> <dependentAssembly>
@@ -25,10 +22,6 @@
<dependentAssembly> <dependentAssembly>
<assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/> <assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/> <bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="System.ValueTuple" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly> </dependentAssembly>
<dependentAssembly> <dependentAssembly>
<assemblyIdentity name="Newtonsoft.Json" publicKeyToken="30ad4fe6b2a6aeed" culture="neutral"/> <assemblyIdentity name="Newtonsoft.Json" publicKeyToken="30ad4fe6b2a6aeed" culture="neutral"/>
Plain Craft Launcher 2/Application.xaml
+7 -4
View File
@@ -3,6 +3,8 @@
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"
xmlns:local="clr-namespace:PCL" xmlns:local="clr-namespace:PCL"
xmlns:core="clr-namespace:MeloongCore;assembly=MeloongCore"
xmlns:corewpf="clr-namespace:MeloongCore.Wpf;assembly=MeloongCore.Wpf"
xmlns:sys="clr-namespace:System;assembly=mscorlib" xmlns:sys="clr-namespace:System;assembly=mscorlib"
StartupUri="FormMain.xaml" StartupUri="FormMain.xaml"
ShutdownMode="OnExplicitShutdown"> ShutdownMode="OnExplicitShutdown">
@@ -10,10 +12,10 @@
<ResourceDictionary> <ResourceDictionary>
<!-- Converter --> <!-- Converter -->
<local:AdditionConverter x:Key="AdditionConverter"/> <corewpf:AdditionConverter x:Key="AdditionConverter"/>
<local:MultiplicationConverter x:Key="MultiplicationConverter"/> <corewpf:MultiplicationConverter x:Key="MultiplicationConverter"/>
<local:InverseBooleanToVisibilityConverter x:Key="InverseBooleanToVisibilityConverter"/> <corewpf:InverseBooleanToVisibilityConverter x:Key="InverseBooleanToVisibilityConverter"/>
<local:InverseBooleanConverter x:Key="InverseBooleanConverter"/> <corewpf:InverseBooleanConverter x:Key="InverseBooleanConverter"/>
<BooleanToVisibilityConverter x:Key="BooleanToVisibilityConverter"/> <BooleanToVisibilityConverter x:Key="BooleanToVisibilityConverter"/>
<!-- 颜色表 --> <!-- 颜色表 -->
@@ -366,6 +368,7 @@
<Setter Property="FocusVisualStyle" Value="{x:Null}" /> <Setter Property="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="FontSize" Value="13" /> <Setter Property="FontSize" Value="13" />
<Setter Property="MaxDropDownHeight" Value="320" /> <Setter Property="MaxDropDownHeight" Value="320" />
<Setter Property="Cursor" Value="Hand" />
<Setter Property="Template"> <Setter Property="Template">
<Setter.Value> <Setter.Value>
<ControlTemplate TargetType="ComboBox"> <ControlTemplate TargetType="ComboBox">
Plain Craft Launcher 2/Application.xaml.vb
+72 -66
View File
@@ -1,47 +1,37 @@
Imports System.Reflection Imports System.Reflection
Imports System.Windows.Threading Imports System.Windows.Threading
Imports Microsoft.Win32
Public Class Application 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
'提升主线程优先级
Thread.CurrentThread.Priority = ThreadPriority.Highest
'执行开发版测试 '执行开发版测试
If BuildType = BuildTypes.Debug Then If BuildType = BuildTypes.Debug Then
Try Try
ModDevelop.Start() ModDevelop.Start()
Catch ex As Exception Catch ex As Exception
Log(ex, "开发者模式测试出错", NotifyLevel.MsgBox) Logger.Error(ex, "开发者模式测试出错", LogBehavior.Alert)
End Try End Try
End If End If
'提升主线程优先级 '检查 .NET Framework 版本
Thread.CurrentThread.Priority = ThreadPriority.Highest
'确保 .NET Framework 版本
Try Try
Dim VersionTest As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI) Using ndpKey As RegistryKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry32).OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\v4\Full\")
Catch ex As UriFormatException '修复 #3555 If ndpKey?.GetValue("Release") IsNot Nothing AndAlso CInt(ndpKey.GetValue("Release")) < 528040 Then OldEnvironmentAssert()
Environment.SetEnvironmentVariable("windir", Environment.GetEnvironmentVariable("SystemRoot"), EnvironmentVariableTarget.User) End Using
Dim VersionTest As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
End Try
'检测当前文件夹权限
Try
DirectoryUtils.Create(PathExeFolder & "PCL\")
Catch ex As Exception Catch ex As Exception
MsgBox($"PCL 无法创建 PCL 文件夹（{PathExeFolder & "PCL"}），请尝试：" & vbCrLf & Logger.Warn(ex, "检查 .NET Framework 版本失败")
"1. 将 PCL 移动到其他文件夹" & If(PathExeFolder.StartsWithF("C:", True), "，例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf & End Try
"2. 删除当前目录中的 PCL 文件夹，然后再试。" & vbCrLf & '修复 WPF 字体加载（#3467）
"3. 右键 PCL 选择属性，打开 兼容性 中的 以管理员身份运行此程序。", Try
MsgBoxStyle.Critical, "运行环境错误") Dim _unused As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
Environment.[Exit](ProcessReturnValues.Cancel) Catch ex As UriFormatException
Environment.SetEnvironmentVariable("windir", Environment.GetEnvironmentVariable("SystemRoot"), EnvironmentVariableTarget.User)
Dim _unused As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
End Try End Try
If Not CheckPermission(PathExeFolder & "PCL") Then
MsgBox("PCL 没有对当前文件夹的写入权限，请尝试：" & vbCrLf &
"1. 将 PCL 移动到其他文件夹" & If(PathExeFolder.StartsWithF("C:", True), "，例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
"2. 删除当前目录中的 PCL 文件夹，然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性，打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误")
Environment.[Exit](ProcessReturnValues.Cancel)
End If
'检查参数调用 '检查参数调用
If e.Args.Length > 0 Then If e.Args.Length > 0 Then
If e.Args(0) = "--update" Then If e.Args(0) = "--update" Then
@@ -73,18 +63,30 @@ Public Class Application
End If End If
End If End If
'初始化文件结构 '初始化文件结构
DirectoryUtils.Create(PathExeFolder & "PCL\Pictures\") Try
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\") DirectoryUtils.Create(PathExeFolder & "PCL\Pictures\")
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\")
CheckPermissionWithException(PathExeFolder & "PCL\")
Catch ex As Exception
MsgBox($"PCL 没有对当前文件夹的权限（{PathExeFolder}PCL\），请尝试：" & vbCrLf &
"1. 将 PCL 移动到其他文件夹" & If(PathExeFolder.StartsWithF("C:", True), "，例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
"2. 删除当前目录中的 PCL 文件夹，然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性，打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误")
Environment.[Exit](ProcessReturnValues.Cancel)
End Try
RetryCacheCheck:
Try Try
DirectoryUtils.Create(PathTemp) DirectoryUtils.Create(PathTemp)
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限") CheckPermissionWithException(PathTemp)
Catch ex As Exception Catch ex As Exception
If PathTemp = Path.GetTempPath() & "PCL\" Then If PathTemp = Path.GetTempPath() & "PCL\" Then
MyMsgBox("PCL 无法访问缓存文件夹，可能导致程序出错或无法正常使用！" & vbCrLf & vbCrLf & "错误原因：" & ex.GetDetail(), "缓存文件夹不可用") MyMsgBox("PCL 无法访问缓存文件夹，可能导致程序出错或无法正常使用！" & vbCrLf & vbCrLf & "错误原因：" & ex.GetDisplay(True), "缓存文件夹不可用")
Else Else
MyMsgBox("手动设置的缓存文件夹不可用，PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因：" & ex.GetDetail(), "缓存文件夹不可用") MyMsgBox("手动设置的缓存文件夹不可用，PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因：" & ex.GetDisplay(True), "缓存文件夹不可用")
Settings.Set("SystemSystemCache", "") Settings.Set("SystemSystemCache", "")
PathTemp = Path.GetTempPath() & "PCL\" PathTemp = Path.GetTempPath() & "PCL\"
GoTo RetryCacheCheck
End If End If
End Try End Try
DirectoryUtils.Create(PathTemp & "Cache\") DirectoryUtils.Create(PathTemp & "Cache\")
@@ -123,22 +125,21 @@ WaitRetry:
ServicePointManager.EnableDnsRoundRobin = True ServicePointManager.EnableDnsRoundRobin = True
ServicePointManager.ReusePort = True ServicePointManager.ReusePort = True
'设置初始窗口 '设置初始窗口
If Settings.Get("UiLauncherLogo") Then If Settings.Get(Of Boolean)("UiLauncherLogo") Then
FrmStart = New SplashScreen("Images\icon.ico") FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True) FrmStart.Show(False, True)
End If End If
'日志初始化 '日志初始化
LogStart() MeloongCore.Main.Init(New PclLogger With {.logFolder = PathUtils.CurrentFolder & "PCL", .MinLevel = If(ModeDebug, LogLevel.Trace, LogLevel.Info)})
'添加日志 Logger.Info($"程序版本：{VersionDisplay} ({VersionCode}{If(CommitHash = "", "", $"，#{CommitHash}")})")
Log($"[Start] 程序版本：{VersionDisplay} ({VersionCode}{If(CommitHash = "", "", $"，#{CommitHash}")})")
If BuildType = BuildTypes.Snapshot Then If BuildType = BuildTypes.Snapshot Then
Log($"[Start] 识别码：{Identify}{If(ThemeCheckOne(9), "，已解锁反馈主题", "，未解锁反馈主题")}") Logger.Info($"识别码：{Identify}{If(ThemeCheckOne(9), "，已解锁反馈主题", "，未解锁反馈主题")}")
Else Else
Log($"[Start] 识别码：{Identify}") Logger.Info($"识别码：{Identify}")
End If End If
Log($"[Start] 程序路径：{PathExe}") Logger.Info($"程序路径：{PathExe}")
Log($"[Start] 系统编码：{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})") Logger.Info($"系统编码：{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Log($"[Start] 管理员权限：{IsAdmin()}") Logger.Info($"管理员权限：{SystemUtils.HasAdminRole()}")
'检测异常环境 '检测异常环境
If PathExeFolder.Contains(Path.GetTempPath()) OrElse PathExeFolder.Contains("AppData\Local\Temp\") Then If PathExeFolder.Contains(Path.GetTempPath()) OrElse PathExeFolder.Contains("AppData\Local\Temp\") Then
MyMsgBox("请将 PCL 从压缩包中解压后再使用！" & vbCrLf & "如果不会解压，可以在网上寻找教程。", "需要解压！", "我知道了", IsWarn:=True, ForceWait:=True) MyMsgBox("请将 PCL 从压缩包中解压后再使用！" & vbCrLf & "如果不会解压，可以在网上寻找教程。", "需要解压！", "我知道了", IsWarn:=True, ForceWait:=True)
@@ -148,7 +149,7 @@ WaitRetry:
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统，部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏！", "环境警告", "我知道了", IsWarn:=True) MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统，部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏！", "环境警告", "我知道了", IsWarn:=True)
End If End If
'计时 '计时
Log("[Start] 第一阶段加载用时：" & GetTimeMs() - ApplicationStartTick & " ms") Logger.Info($"第一阶段加载用时：{GetTimeMs() - ApplicationStartTick} ms")
ApplicationStartTick = GetTimeMs() ApplicationStartTick = GetTimeMs()
AniControlEnabled += 1 AniControlEnabled += 1
Catch ex As Exception Catch ex As Exception
@@ -157,7 +158,7 @@ WaitRetry:
FilePath = PathExe FilePath = PathExe
Catch Catch
End Try End Try
MsgBox(ex.GetDetail(True) & vbCrLf & "PCL 所在路径：" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误") MsgBox(ex.GetDisplay(True) & vbCrLf & "PCL 所在路径：" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
FormMain.EndProgramForce(ProcessReturnValues.Exception) FormMain.EndProgramForce(ProcessReturnValues.Exception)
End Try End Try
End Sub End Sub
@@ -181,43 +182,48 @@ WaitRetry:
End If End If
'正常处理 '正常处理
e.Handled = True e.Handled = True
If IsProgramEnded Then Return If IsProgramEnding Then Return
FeedbackInfo() FeedbackInfo()
Dim Detail As String = e.Exception.GetDetail(True) Dim Detail As String = e.Exception.GetDisplay(True)
If Detail.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse Detail.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse Detail.Contains("未能加载文件或程序集") OrElse If Detail.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse Detail.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse Detail.Contains("未能加载文件或程序集") OrElse
Detail.Contains(".NET Framework") Then ' “自动错误判断” 的结果分析 Detail.Contains(".NET Framework") Then ' “自动错误判断” 的结果分析
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer") OldEnvironmentAssert(e.Exception)
Log(e.Exception, "你的 .NET Framework 版本过低或损坏，请下载并重新安装 .NET Framework 4.6.2！" & vbCrLf & "若无法安装，可在卸载高版本的 .NET Framework 后再试。", NotifyLevel.Critical, "运行环境错误")
Else Else
Log(e.Exception, "程序出现未知错误", NotifyLevel.Critical, "锟斤拷烫烫烫") Logger.Error(e.Exception, "程序出现未知错误", LogBehavior.AlertThenCrash)
End If
End Sub
Private Shared Sub OldEnvironmentAssert(Optional ex As Exception = Nothing)
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net48-offline-installer")
If ex Is Nothing Then
Logger.Error($"你的 .NET Framework 版本过低或损坏，请下载并重新安装 .NET Framework 4.8！{vbCrLf}若安装失败，可以先卸载高版本的 .NET Framework 然后再试。", LogBehavior.AlertThenCrash)
Else
Logger.Error(ex, $"你的 .NET Framework 版本过低或损坏，请下载并重新安装 .NET Framework 4.8！{vbCrLf}若安装失败，可以先卸载高版本的 .NET Framework 然后再试。", LogBehavior.AlertThenCrash)
End If End If
End Sub End Sub
'动态 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", "System.ValueTuple", "PCLCS", "MeloongCore.Wpf", "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 Locks As New Dictionary(Of String, Object)(StringComparer.Ordinal) Static LoadedAssemblies As New ConcurrentDictionary(Of String, Lazy(Of Assembly))(StringComparer.Ordinal) '缓存
Static LoadedAssembly As New Dictionary(Of String, 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
Dim Prefix As String = Prefixes.FirstOrDefault(Function(p) Args.Name.StartsWith(p, StringComparison.Ordinal)) Dim Prefix As String = Prefixes.FirstOrDefault(Function(p) Args.Name.StartsWith(p, StringComparison.Ordinal))
If Prefix Is Nothing Then Return Nothing If Prefix Is Nothing Then Return Nothing
If Not Locks.ContainsKey(Prefix) Then Locks(Prefix) = New Object() Dim LazyAssembly = LoadedAssemblies.GetOrAdd(Prefix, Function(p) New Lazy(Of Assembly)(
SyncLock Locks(Prefix) Function()
If Not LoadedAssembly.ContainsKey(Prefix) Then Dim LoadedAssembly = Assembly.Load(DirectCast(My.Resources.ResourceManager.GetObject(p), Byte()))
LoadedAssembly(Prefix) = Assembly.Load(My.Resources.ResourceManager.GetObject(Prefix)) If p = "Imazen.WebP" Then ExtractLibwebp() 'WebP 特判
If Prefix = "Imazen.WebP" Then ExtractLibwebp() 'WebP 特判 Return LoadedAssembly
End If End Function, LazyThreadSafetyMode.ExecutionAndPublication))
Return LoadedAssembly(Prefix) Return LazyAssembly.Value
End SyncLock
End Function End Function
End Sub End Sub
Private Shared Sub ExtractLibwebp() '这个方法会调用 ModBase，进而调用 MeloongCore，所以不能放在 New 里 Private Shared Sub ExtractLibwebp() '这个方法会调用 ModBase，进而调用 MeloongCore，所以不能放在 New 里
SetDllDirectory(PathPure.TrimEnd("\"c)) SetDllDirectory(PathPure.TrimEnd("\"c))
Try Try
FileUtils.Write(PathPure & "libwebp.dll", GetResources("libwebp64")) ExtractResources(PathPure & "libwebp.dll", "libwebp64")
Catch ex As Exception Catch ex As Exception
Log(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时，同时写入文件导致文件占用，进而导致崩溃 Logger.Warn(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时，同时写入文件导致文件占用，进而导致崩溃
End Try End Try
End Sub End Sub
Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
@@ -226,10 +232,10 @@ WaitRetry:
'控件模板事件 '控件模板事件
Private Sub MyIconButton_Click(sender As Object, e As EventArgs) Private Sub MyIconButton_Click(sender As Object, e As EventArgs)
Select Case Settings.Get("LoginType") Select Case Settings.Get(Of McLoginType)("LoginType")
Case McLoginType.Ms Case McLoginType.Ms
'微软 '微软
Dim MsJson As JObject = GetJson(Settings.Get("LoginMsJson")) Dim MsJson As JObject = GetJson(Settings.Get(Of String)("LoginMsJson"))
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
@@ -237,19 +243,19 @@ WaitRetry:
Case McLoginType.Legacy Case McLoginType.Legacy
'离线 '离线
Dim Names As New List(Of String) Dim Names As New List(Of String)
Names.AddRange(Settings.Get("LoginLegacyName").ToString.Split("¨")) Names.AddRange(Settings.Get(Of String)("LoginLegacyName").ToString.Split("¨"))
Names.Remove(sender.Tag) Names.Remove(sender.Tag)
Settings.Set("LoginLegacyName", Names.Join("¨"c)) Settings.Set("LoginLegacyName", Names.Join("¨"c))
FrmLoginLegacy.ComboName.ItemsSource = Names FrmLoginLegacy.ComboName.ItemsSource = Names
FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "") FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
Case Else Case Else
'第三方 '第三方
Dim Token As String = GetStringFromEnum(Settings.Get("LoginType")) Dim Token As String = Settings.Get(Of McLoginType)("LoginType").ToString()
Dim Dict As New Dictionary(Of String, String) Dim Dict As New Dictionary(Of String, String)
Dim Names As New List(Of String) Dim Names As New List(Of String)
Dim Passs As New List(Of String) Dim Passs As New List(Of String)
If Not Settings.Get("Login" & Token & "Email") = "" Then Names.AddRange(Settings.Get("Login" & Token & "Email").ToString.Split("¨")) If Not Settings.Get(Of String)("Login" & Token & "Email") = "" Then Names.AddRange(Settings.Get(Of String)("Login" & Token & "Email").Split("¨"))
If Not Settings.Get("Login" & Token & "Pass") = "" Then Passs.AddRange(Settings.Get("Login" & Token & "Pass").ToString.Split("¨")) If Not Settings.Get(Of String)("Login" & Token & "Pass") = "" Then Passs.AddRange(Settings.Get(Of String)("Login" & Token & "Pass").Split("¨"))
For i = 0 To Names.Count - 1 For i = 0 To Names.Count - 1
Dict.Add(Names(i), Passs(i)) Dict.Add(Names(i), Passs(i))
Next Next
Plain Craft Launcher 2/Controls/MyButton.xaml.vb
+2 -2
View File
@@ -136,7 +136,7 @@ Public Class MyButton
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新按钮颜色出错") Logger.Warn(ex, "刷新按钮颜色出错")
End Try End Try
End Sub End Sub
@@ -144,7 +144,7 @@ Public Class MyButton
Private IsMouseDown As Boolean = False Private IsMouseDown As Boolean = False
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 IsMouseDown Then Return If Not IsMouseDown Then Return
Log("[Control] 按下按钮：" & Text) Logger.Info($"按下按钮：{Text}")
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
RaiseCustomEvent() '自定义事件 RaiseCustomEvent() '自定义事件
End Sub End Sub
Plain Craft Launcher 2/Controls/MyCard.vb
+10 -3
View File
@@ -164,7 +164,7 @@
Case 13 Case 13
Stack.Children.Add(NeoForgeDownloadListItem(Data, AddressOf NeoForgeSave_Click, True)) Stack.Children.Add(NeoForgeDownloadListItem(Data, AddressOf NeoForgeSave_Click, True))
Case Else Case Else
Log("未知的虚拟化种类：" & Type, NotifyLevel.MsgBoxAndFeedback) Logger.Error($"未知的虚拟化种类：{Type}")
End Select End Select
Next Next
Stack.Children.Add(New FrameworkElement With {.Height = 18}) '下边距，同时适应折叠 Stack.Children.Add(New FrameworkElement With {.Height = 18}) '下边距，同时适应折叠
@@ -296,9 +296,10 @@
If Not IsSwapped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title) If Not IsSwapped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
'若尚未加载，会在 Loaded 事件中触发无动画的折叠，不需要在这里进行 '若尚未加载，会在 Loaded 事件中触发无动画的折叠，不需要在这里进行
If Not IsLoaded Then Return If Not IsLoaded Then Return
'更新高度 '更新样式
SwapControl.Visibility = Visibility.Visible SwapControl.Visibility = Visibility.Visible
TriggerForceResize() TriggerForceResize()
UpdateCursorStyle()
'改变箭头 '改变箭头
AniStart(AaRotateTransform(MainSwap, If(_IsSwapped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 250,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), "MyCard Swap " & Uuid, True) AniStart(AaRotateTransform(MainSwap, If(_IsSwapped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 250,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), "MyCard Swap " & Uuid, True)
End Set End Set
@@ -351,12 +352,18 @@
End If End If
IsSwapped = Not IsSwapped IsSwapped = Not IsSwapped
Log("[Control] " & If(IsSwapped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", "：" & Title)) Logger.Info($"{If(IsSwapped, "折叠卡片", "展开卡片")}{If(Title Is Nothing, "", "：" & Title)}")
RaiseEvent Swap(Me, e) RaiseEvent Swap(Me, e)
End Sub End Sub
Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
IsSwapMouseDown = False IsSwapMouseDown = False
End Sub End Sub
Private Sub UpdateCursorStyle() Handles Me.MouseMove
If _MainSwap Is Nothing Then Cursor = Nothing : Return
Dim Pos As Double = Mouse.GetPosition(Me).Y
Cursor = If(MainSwap.Visibility = Visibility.Visible AndAlso (IsSwapped OrElse (Pos <= SwapedHeight - 6 AndAlso Not (Pos = 0 AndAlso Not IsMouseDirectlyOver))),
Cursors.Hand, Nothing)
End Sub
#End Region #End Region
Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb
+2 -2
View File
@@ -59,7 +59,7 @@ Public Class MyCheckBox
SyncUI() SyncUI()
RaiseCustomEvent() RaiseCustomEvent()
Catch ex As Exception Catch ex As Exception
Log(ex, "设置 Checked 失败") Logger.Warn(ex, "设置 Checked 失败")
End Try End Try
End Sub End Sub
Private Sub SyncUI() Private Sub SyncUI()
@@ -133,7 +133,7 @@ Public Class MyCheckBox
Private AllowMouseDown As Boolean = True Private AllowMouseDown As Boolean = True
Private Sub Checkbox_MouseUp() Handles Me.MouseLeftButtonUp Private Sub Checkbox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Return If Not MouseDowned Then Return
Log("[Control] 按下复选框（" & (Not Checked).ToString & "）：" & Text) Logger.Info($"按下复选框（{(Not Checked)}）：{Text}")
MouseDowned = False MouseDowned = False
SetChecked(Not Checked, True) SetChecked(Not Checked, True)
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid) AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
Plain Craft Launcher 2/Controls/MyComboBox.vb
+3 -3
View File
@@ -22,7 +22,7 @@
End If End If
If HintText.Length > 0 Then TextBox.HintText = HintText If HintText.Length > 0 Then TextBox.HintText = HintText
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化可编辑文本框失败（" & If(Name, "") & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"初始化可编辑文本框失败（{If(Name, "")}）")
End Try End Try
End Sub End Sub
Private _Text As String = SelectedItem Private _Text As String = SelectedItem
@@ -107,7 +107,7 @@
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
Log(ex, "设置下拉框透明度失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "设置下拉框透明度失败")
End Try End Try
End Sub End Sub
Private Sub MyComboBox_DropDownClosed(sender As Object, e As EventArgs) Handles Me.DropDownClosed Private Sub MyComboBox_DropDownClosed(sender As Object, e As EventArgs) Handles Me.DropDownClosed
@@ -147,7 +147,7 @@
ElseIf Items.Count > NewValue Then ElseIf Items.Count > NewValue Then
SelectedIndex = NewValue SelectedIndex = NewValue
Else Else
Log($"[Setting] 尝试显示设置 {SettingService.GetKey(Me)}，但没有找到设置值 {NewValue} 的对应项", NotifyLevel.DebugModeOnly) Logger.Warn($"尝试显示设置 {SettingService.GetKey(Me)}，但没有找到设置值 {NewValue} 的对应项")
SelectedIndex = -1 SelectedIndex = -1
SelectedItem = Nothing SelectedItem = Nothing
End If End If
Plain Craft Launcher 2/Controls/MyComboBoxItem.vb
+1 -1
View File
@@ -61,7 +61,7 @@
End Operator End Operator
Private Sub MyComboBoxItem_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp Private Sub MyComboBoxItem_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
Log("[Control] 选择下拉列表项：" & Tostring()) Logger.Info($"选择下拉列表项：{Tostring()}")
End Sub End Sub
End Class End Class
Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb
+3 -3
View File
@@ -84,7 +84,7 @@
'触发点击事件 '触发点击事件
Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
If IsLeftMouseHeld Then If IsLeftMouseHeld Then
Log("[Control] 按下附加按钮" & If(ToolTip = "", "", "：" & ToolTip.ToString)) Logger.Info($"按下附加按钮{If(ToolTip = "", "", "：" & ToolTip)}")
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
e.Handled = True e.Handled = True
Button_LeftMouseUp() Button_LeftMouseUp()
@@ -92,7 +92,7 @@
End Sub End Sub
Private Sub Button_RightMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonUp Private Sub Button_RightMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonUp
If IsRightMouseHeld Then If IsRightMouseHeld Then
Log("[Control] 右键按下附加按钮" & If(ToolTip = "", "", "：" & ToolTip.ToString)) Logger.Info($"右键按下附加按钮{If(ToolTip = "", "", "：" & ToolTip)}")
RaiseEvent RightClick(sender, e) RaiseEvent RightClick(sender, e)
e.Handled = True e.Handled = True
Button_RightMouseUp() Button_RightMouseUp()
@@ -193,7 +193,7 @@
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新图标按钮颜色出错") Logger.Warn(ex, "刷新图标按钮颜色出错")
End Try End Try
End Sub End Sub
Plain Craft Launcher 2/Controls/MyExtraTextButton.xaml.vb
+2 -2
View File
@@ -82,7 +82,7 @@ Public Class MyExtraTextButton
'触发点击事件 '触发点击事件
Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
If Not IsLeftMouseHeld Then Return If Not IsLeftMouseHeld Then Return
Log("[Control] 按下附加图标按钮：" & Text) Logger.Info($"按下附加图标按钮：{Text}")
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
e.Handled = True e.Handled = True
RaiseCustomEvent() RaiseCustomEvent()
@@ -156,7 +156,7 @@ Public Class MyExtraTextButton
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新附加图标按钮颜色出错") Logger.Warn(ex, "刷新附加图标按钮颜色出错")
End Try End Try
End Sub End Sub
Plain Craft Launcher 2/Controls/MyHint.xaml.vb
+2 -2
View File
@@ -99,7 +99,7 @@ Public Class MyHint
End Property End Property
Public Property RelativeSetup As String = "" Public Property RelativeSetup As String = ""
Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If CanClose AndAlso Settings.Get(RelativeSetup) Then Visibility = Visibility.Collapsed If CanClose AndAlso Settings.Get(Of Boolean)(RelativeSetup) Then Visibility = Visibility.Collapsed
End Sub End Sub
Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
Settings.SetSafe(RelativeSetup, True) Settings.SetSafe(RelativeSetup, True)
@@ -112,7 +112,7 @@ Public Class MyHint
Private Sub MyHint_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp Private Sub MyHint_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return If Not IsMouseDown Then Return
IsMouseDown = False IsMouseDown = False
Log("[Control] 按下提示条" & If(String.IsNullOrEmpty(Name), "", "：" & Name)) Logger.Info($"按下提示条{If(String.IsNullOrEmpty(Name), "", "：" & Name)}")
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
If e.Handled Then Return If e.Handled Then Return
e.Handled = True e.Handled = True
Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb
+2 -2
View File
@@ -54,7 +54,7 @@ Public Class MyIconButton
Private IsMouseDown As Boolean = False Private IsMouseDown As Boolean = False
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 IsMouseDown Then Return If Not IsMouseDown Then Return
Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", "：" & Name)) Logger.Info($"按下图标按钮{If(String.IsNullOrEmpty(Name), "", "：" & Name)}")
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
e.Handled = True e.Handled = True
Button_MouseUp() Button_MouseUp()
@@ -160,7 +160,7 @@ Public Class MyIconButton
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新图标按钮动画状态出错") Logger.Warn(ex, "刷新图标按钮动画状态出错")
End Try End Try
End Sub End Sub
Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb
+2 -2
View File
@@ -70,7 +70,7 @@ Public Class MyIconTextButton
Private IsMouseDown As Boolean = False Private IsMouseDown As Boolean = False
Private Sub MyIconTextButton_MouseUp() Handles Me.MouseLeftButtonUp Private Sub MyIconTextButton_MouseUp() Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return If Not IsMouseDown Then Return
Log("[Control] 按下带图标按钮：" & Text) Logger.Info($"按下带图标按钮：{Text}")
IsMouseDown = False IsMouseDown = False
RaiseEvent Click(Me, New RouteEventArgs(True)) RaiseEvent Click(Me, New RouteEventArgs(True))
RaiseCustomEvent() '自定义事件 RaiseCustomEvent() '自定义事件
@@ -166,7 +166,7 @@ Public Class MyIconTextButton
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新带图标按钮颜色出错") Logger.Warn(ex, "刷新带图标按钮颜色出错")
End Try End Try
End Sub End Sub
Plain Craft Launcher 2/Controls/MyImage.vb
+9 -9
View File
@@ -88,9 +88,9 @@
Dim Bitmap As ImageSource = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取，尽量避免在 UI 线程中读取文件 Dim Bitmap As ImageSource = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取，尽量避免在 UI 线程中读取文件
RunInUi(Sub() MyBase.Source = Bitmap) RunInUi(Sub() MyBase.Source = Bitmap)
Catch ex As Exception Catch ex As Exception
Log(ex, $"加载图片失败（{value}）") Logger.Warn(ex, $"加载图片失败（{value}）")
Try Try
If value.StartsWithF(PathTemp) AndAlso File.Exists(value) Then File.Delete(value) If value.StartsWithF(PathTemp) Then FileUtils.Delete(value)
Catch Catch
End Try End Try
End Try End Try
@@ -113,7 +113,7 @@
'从缓存加载网络图片 '从缓存加载网络图片
Dim EnableCache As Boolean = Me.EnableCache Dim EnableCache As Boolean = Me.EnableCache
Dim TempPath As String = $"{PathTemp}MyImage\{GetHash(Source)}.png{If(EnableCache, "", GetUuid())}" '不启用缓存时在末尾加上随机字符串，避免冲突 Dim TempPath As String = $"{PathTemp}MyImage\{GetHash(Source)}.png{If(EnableCache, "", GetUuid())}" '不启用缓存时在末尾加上随机字符串，避免冲突
Dim TempFile As New FileInfo(TempPath) Dim TempFile = FileUtils.GetInfo(TempPath)
If EnableCache AndAlso TempFile.Exists Then If EnableCache AndAlso TempFile.Exists Then
ActualSource = TempPath '显示缓存的图片 ActualSource = TempPath '显示缓存的图片
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存 If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
@@ -130,24 +130,24 @@
{Source, FallbackSource}, {Source}), {Source, FallbackSource}, {Source}),
TempPath, SimulateBrowserHeaders:=True) TempPath, SimulateBrowserHeaders:=True)
ActualSource = TempPath ActualSource = TempPath
If Not EnableCache Then File.Delete(TempPath) If Not EnableCache Then FileUtils.Delete(TempPath)
Catch ex As Exception Catch ex As Exception
Try Try
If TempPath IsNot Nothing Then File.Delete(TempPath) If TempPath IsNot Nothing Then FileUtils.Delete(TempPath)
Catch Catch
End Try End Try
'加载本地备用图片 '加载本地备用图片
If IsLocalFallback Then If IsLocalFallback Then
Try Try
ActualSource = FallbackSource ActualSource = FallbackSource
Log(ex, $"下载图片失败，使用本地备用图片（{Source}）") Logger.Warn(ex, $"下载图片失败，使用本地备用图片（{Source}）")
Return Return
Catch exx As Exception Catch exx As Exception
Log(ex, $"下载图片失败（{Source}）", NotifyLevel.AllUsers) Logger.Error(ex, $"下载图片失败（{Source}）", LogBehavior.Toast)
Log(exx, $"加载备用图片失败（{FallbackSource}）", NotifyLevel.AllUsers) Logger.Error(exx, $"加载备用图片失败（{FallbackSource}）", LogBehavior.Toast)
End Try End Try
Else Else
Log(ex, $"下载图片失败（{Source}，备用：{FallbackSource}）", NotifyLevel.AllUsers) Logger.Error(ex, $"下载图片失败（{Source}，备用：{FallbackSource}）", LogBehavior.Toast)
End If End If
End Try End Try
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal) End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
Plain Craft Launcher 2/Controls/MyListItem.xaml.vb
+5 -5
View File
@@ -479,7 +479,7 @@ Public Class MyListItem
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "设置 Checked 失败") Logger.Warn(ex, "设置 Checked 失败")
End Try End Try
End Sub End Sub
@@ -515,12 +515,12 @@ Public Class MyListItem
'实际的单击处理 '实际的单击处理
Select Case Type Select Case Type
Case CheckType.Clickable Case CheckType.Clickable
Log("[Control] 按下单击列表项：" & Title) Logger.Info($"按下单击列表项：{Title}")
Case CheckType.RadioBox Case CheckType.RadioBox
Log("[Control] 按下单选列表项：" & Title) Logger.Info($"按下单选列表项：{Title}")
If Not Checked Then SetChecked(True, True, True) If Not Checked Then SetChecked(True, True, True)
Case CheckType.CheckBox Case CheckType.CheckBox
Log("[Control] 按下复选列表项（" & (Not Checked).ToString & "）：" & Title) Logger.Info($"按下复选列表项（{Not Checked}）：{Title}")
SetChecked(Not Checked, True, True) SetChecked(Not Checked, True, True)
End Select End Select
End Sub End Sub
@@ -643,7 +643,7 @@ Public Class MyListItem
Dim Entry As New HelpEntry(CustomEvent.GetAbsoluteUrls(CustomEventService.GetEventData(Me), CustomEventService.GetEventType(Me))(0)) Dim Entry As New HelpEntry(CustomEvent.GetAbsoluteUrls(CustomEventService.GetEventData(Me), CustomEventService.GetEventType(Me))(0))
Entry.SetToListItem(Me) Entry.SetToListItem(Me)
Catch ex As Exception Catch ex As Exception
Log(ex, "设置帮助 MyListItem 失败", NotifyLevel.MsgBox) Logger.Error(ex, "设置帮助 MyListItem 失败", LogBehavior.Alert)
CustomEventService.SetEventType(Me, CustomEvent.EventType.None) CustomEventService.SetEventType(Me, CustomEvent.EventType.None)
CustomEventService.SetEventData(Me, "") CustomEventService.SetEventData(Me, "")
End Try End Try
Plain Craft Launcher 2/Controls/MyLoading.xaml.vb
+2 -4
View File
@@ -76,10 +76,8 @@ Public Class MyLoading
If Ex Is Nothing Then If Ex Is Nothing Then
LabText.Text = "未知错误" LabText.Text = "未知错误"
Else Else
Do While Ex.InnerException IsNot Nothing Ex = Ex.RootException()
Ex = Ex.InnerException LabText.Text = If(Ex.IsBadNetwork(), "网络环境不佳，请稍后再试，或使用 VPN 改善网络环境", Ex.Message)
Loop
LabText.Text = If(Ex.IsNetworkRelated(), "网络环境不佳，请稍后再试，或使用 VPN 改善网络环境", Ex.Message)
End If End If
Else Else
LabText.Text = TextError LabText.Text = TextError
Plain Craft Launcher 2/Controls/MyMenuItem.vb
+1 -1
View File
@@ -7,7 +7,7 @@
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
'对父级设置透明度 '对父级设置透明度
CType(Parent, ContextMenu).Opacity = Settings.Get("UiLauncherTransparent") / 1000 + 0.4 CType(Parent, ContextMenu).Opacity = Settings.Get(Of Integer)("UiLauncherTransparent") / 1000 + 0.4
End Sub End Sub
'基础 '基础
Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb
+3 -3
View File
@@ -26,7 +26,7 @@
ShapeLine.StrokeThickness = GetWPFSize(1) ShapeLine.StrokeThickness = GetWPFSize(1)
Catch ex As Exception Catch ex As Exception
Log(ex, "输入弹窗初始化失败", NotifyLevel.AllUsers) Logger.Error(ex, "输入弹窗初始化失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
@@ -46,10 +46,10 @@
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak)) AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyMsgBox " & Uuid) }, "MyMsgBox " & Uuid)
'记录日志 '记录日志
Log("[Control] 输入弹窗：" & LabTitle.Text) Logger.Info($"输入弹窗：{LabTitle.Text}")
Catch ex As Exception Catch ex As Exception
Log(ex, "输入弹窗加载失败", NotifyLevel.AllUsers) Logger.Error(ex, "输入弹窗加载失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
Private Sub Close() Private Sub Close()
Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb
+3 -3
View File
@@ -35,7 +35,7 @@
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "选择弹窗初始化失败", NotifyLevel.AllUsers) Logger.Error(ex, "选择弹窗初始化失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
@@ -53,10 +53,10 @@
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak)) AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyMsgBox " & Uuid) }, "MyMsgBox " & Uuid)
'记录日志 '记录日志
Log("[Control] 选择弹窗：" & LabTitle.Text) Logger.Info($"选择弹窗：{LabTitle.Text}")
Catch ex As Exception Catch ex As Exception
Log(ex, "选择弹窗加载失败", NotifyLevel.AllUsers) Logger.Error(ex, "选择弹窗加载失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
Private Sub Close() Private Sub Close()
Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb
+3 -3
View File
@@ -25,7 +25,7 @@
ShapeLine.StrokeThickness = GetWPFSize(1) ShapeLine.StrokeThickness = GetWPFSize(1)
Catch ex As Exception Catch ex As Exception
Log(ex, "普通弹窗初始化失败", NotifyLevel.AllUsers) Logger.Error(ex, "普通弹窗初始化失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
@@ -44,10 +44,10 @@
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak)) AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyMsgBox " & Uuid) }, "MyMsgBox " & Uuid)
'记录日志 '记录日志
Log("[Control] 普通弹窗：" & LabTitle.Text & vbCrLf & LabCaption.Text) Logger.Info($"普通弹窗：{LabTitle.Text}{vbCrLf}{LabCaption.Text}")
Catch ex As Exception Catch ex As Exception
Log(ex, "普通弹窗加载失败", NotifyLevel.AllUsers) Logger.Error(ex, "普通弹窗加载失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
Private Sub Close() Private Sub Close()
Plain Craft Launcher 2/Controls/MyPageRight.vb
+72 -26
View File
@@ -35,7 +35,7 @@
Set(value As PageStates) Set(value As PageStates)
If _PageState = value Then Return If _PageState = value Then Return
_PageState = value _PageState = value
If ModeDebug Then Log("[UI] 页面状态切换为 " & GetStringFromEnum(value)) Logger.Trace($"页面状态切换为 {value}")
End Set End Set
End Property End Property
@@ -59,9 +59,9 @@
''' <param name="PanAlways">无论是否在加载总是要显示的容器。可以为 Nothing。</param> ''' <param name="PanAlways">无论是否在加载总是要显示的容器。可以为 Nothing。</param>
''' <param name="RealLoader">在工作线程执行的加载器。</param> ''' <param name="RealLoader">在工作线程执行的加载器。</param>
''' <param name="FinishedInvoke">当加载器执行完成，在 UI 线程触发的 UI 初始化事件。</param> ''' <param name="FinishedInvoke">当加载器执行完成，在 UI 线程触发的 UI 初始化事件。</param>
Public Sub PageLoaderInit(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement, Public Sub PageLoaderInit(Of TIn, TOut)(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement,
RealLoader As LoaderBase, RealLoader As LoaderTask(Of TIn, TOut),
Optional FinishedInvoke As Action(Of LoaderBase) = Nothing, Optional InputInvoke As Func(Of Object) = Nothing, Optional FinishedInvoke As Action(Of LoaderTask(Of TIn, TOut)) = Nothing, Optional InputInvoke As Func(Of TIn) = Nothing,
Optional AutoRun As Boolean = True) Optional AutoRun As Boolean = True)
'初始化参数 '初始化参数
Me.PanLoader = PanLoader Me.PanLoader = PanLoader
@@ -89,13 +89,59 @@
If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
'初次运行加载器 '初次运行加载器
If PageLoaderAutoRun Then If PageLoaderAutoRun Then
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then '上下两个重载只有这里不一样
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Nothing, PageLoaderInputInvoke)) PageLoader.Start(RealLoader.StartGetInput(Nothing, PageLoaderInputInvoke))
Else End If
Dim Input = Nothing If PageLoader.State = LoadState.Finished AndAlso FinishedInvoke IsNot Nothing Then
If PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke() RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成，直接触发事件
PageLoader.Start(Input) End If
End If '设置加载环
PageLoaderUi.State = RealLoader
AddHandler PageLoaderUi.Click, Sub() If RealLoader.State = LoadState.Failed Then PageLoaderRestart() '点击重试事件
End Sub
''' <summary>
''' 表明页面存在需要在后台执行的加载器。
''' </summary>
''' <param name="LoaderUi">MyLoading 控件。</param>
''' <param name="PanLoader">MyLoading 控件对应的卡片。</param>
''' <param name="PanContent">加载结束后出现的内容容器。</param>
''' <param name="PanAlways">无论是否在加载总是要显示的容器。可以为 Nothing。</param>
''' <param name="RealLoader">在工作线程执行的加载器。</param>
''' <param name="FinishedInvoke">当加载器执行完成，在 UI 线程触发的 UI 初始化事件。</param>
Public Sub PageLoaderInit(Of TIn)(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement,
RealLoader As LoaderCombo(Of TIn),
Optional FinishedInvoke As Action(Of LoaderCombo(Of TIn)) = Nothing, Optional InputInvoke As Func(Of TIn) = Nothing,
Optional AutoRun As Boolean = True)
'初始化参数
Me.PanLoader = PanLoader
Me.PanContent = PanContent
Me.PanAlways = PanAlways
Me.PageLoader = RealLoader
Me.PageLoaderUi = LoaderUi
Me.PageLoaderInputInvoke = InputInvoke
Me.PageLoaderAutoRun = AutoRun
'添加结束 Invoke
If FinishedInvoke IsNot Nothing Then
AddHandler RealLoader.PreviewFinish,
Sub()
Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ContentExit
Thread.Sleep(10) '不在退出动画时执行 UI 线程操作，避免退出动画被重置
Loop
RunInUiWait(Sub() FinishedInvoke(RealLoader))
Thread.Sleep(20) '由于大量初始化控件会导致掉帧，延迟触发 State 改变事件
End Sub
End If
AddHandler RealLoader.OnStateChangedUi, Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) RunInUi(Sub() PageLoaderState(Loader, NewState, OldState))
'隐藏 UI
PanLoader.Visibility = Visibility.Collapsed
PanContent.Visibility = Visibility.Collapsed
If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
'初次运行加载器
If PageLoaderAutoRun Then
'上下两个重载只有这里不一样
Dim Input = Nothing
If PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
PageLoader.Start(Input)
End If End If
If PageLoader.State = LoadState.Finished AndAlso FinishedInvoke IsNot Nothing Then If PageLoader.State = LoadState.Finished AndAlso FinishedInvoke IsNot Nothing Then
RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成，直接触发事件 RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成，直接触发事件
@@ -125,7 +171,7 @@
''' 需要根据加载器状态，从 Empty 切换到 ContentEnter、LoaderWait、LoaderEnter。 ''' 需要根据加载器状态，从 Empty 切换到 ContentEnter、LoaderWait、LoaderEnter。
''' </summary> ''' </summary>
Public Sub PageOnEnter() Public Sub PageOnEnter()
If ModeDebug Then Log("[UI] 已触发 PageOnEnter") Logger.Trace("已触发 PageOnEnter")
RaiseEvent PageEnter() RaiseEvent PageEnter()
Select Case PageState Select Case PageState
Case PageStates.Empty Case PageStates.Empty
@@ -155,7 +201,7 @@
Case PageStates.ContentEnter Case PageStates.ContentEnter
'重复调用 PageOnEnter，直接忽略 '重复调用 PageOnEnter，直接忽略
Case Else Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnter 事件。") Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnEnter 事件。")
End Select End Select
End Sub End Sub
Public Event PageEnter() Public Event PageEnter()
@@ -164,7 +210,7 @@
''' 需要立即切换至 PageExit 或 Empty。 ''' 需要立即切换至 PageExit 或 Empty。
''' </summary> ''' </summary>
Public Sub PageOnExit() Public Sub PageOnExit()
If ModeDebug Then Log("[UI] 已触发 PageOnExit") Logger.Trace("已触发 PageOnExit")
RaiseEvent PageExit() RaiseEvent PageExit()
Select Case PageState Select Case PageState
Case PageStates.ContentEnter, PageStates.ContentStay Case PageStates.ContentEnter, PageStates.ContentStay
@@ -189,7 +235,7 @@
''' </summary> ''' </summary>
Public Sub PageOnForceExit() Public Sub PageOnForceExit()
If PageState = PageStates.Empty Then Return If PageState = PageStates.Empty Then Return
If ModeDebug Then Log("[UI] 已触发 PageOnForceExit") Logger.Trace("已触发 PageOnForceExit")
PageState = PageStates.Empty PageState = PageStates.Empty
AniStop("PageRight PageChange " & PageUuid) AniStop("PageRight PageChange " & PageUuid)
'由于动画会被强制中止，所以需要手动进行隐藏 '由于动画会被强制中止，所以需要手动进行隐藏
@@ -206,7 +252,7 @@
''' 需要在 PageEnter 事件确认要显示的子页面有哪些。 ''' 需要在 PageEnter 事件确认要显示的子页面有哪些。
''' </summary> ''' </summary>
Public Sub PageOnContentExit() Public Sub PageOnContentExit()
If ModeDebug Then Log("[UI] 已触发 PageOnContentExit") Logger.Trace("已触发 PageOnContentExit")
If PageLoader IsNot Nothing AndAlso PageLoader.State = LoadState.Loading Then If PageLoader IsNot Nothing AndAlso PageLoader.State = LoadState.Loading Then
'Loading 的加载器可能触发进一步变化，难以预测会触发子页面的动画还是加载器完成的动画 'Loading 的加载器可能触发进一步变化，难以预测会触发子页面的动画还是加载器完成的动画
Throw New Exception("在调用 PageOnContentExit 时，加载器不能为 Loading 状态") Throw New Exception("在调用 PageOnContentExit 时，加载器不能为 Loading 状态")
@@ -235,7 +281,7 @@
''' 需要根据目前状态，从 ContentEnter 切换到 ContentStay，或从 LoaderEnter 切换到 LoaderStayForce。 ''' 需要根据目前状态，从 ContentEnter 切换到 ContentStay，或从 LoaderEnter 切换到 LoaderStayForce。
''' </summary> ''' </summary>
Private Sub PageOnEnterAnimationFinished() Private Sub PageOnEnterAnimationFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnEnterAnimationFinished") Logger.Trace("已触发 PageOnEnterAnimationFinished")
Select Case PageState Select Case PageState
Case PageStates.ContentEnter Case PageStates.ContentEnter
PageState = PageStates.ContentStay PageState = PageStates.ContentStay
@@ -243,7 +289,7 @@
PageState = PageStates.LoaderStayForce PageState = PageStates.LoaderStayForce
AniStart(AaCode(AddressOf PageOnLoaderStayFinished, 400), "PageRight PageChange " & PageUuid) AniStart(AaCode(AddressOf PageOnLoaderStayFinished, 400), "PageRight PageChange " & PageUuid)
Case Else Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnterAnimationFinished 事件。") Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnEnterAnimationFinished 事件。")
End Select End Select
End Sub End Sub
''' <summary> ''' <summary>
@@ -251,7 +297,7 @@
''' 需要根据目前状态，从 AllExit 切换到 Empty，或从 LoaderExit 切换到 ContentEnter，或从 ContentExit 重新触发 PageOnEnter。 ''' 需要根据目前状态，从 AllExit 切换到 Empty，或从 LoaderExit 切换到 ContentEnter，或从 ContentExit 重新触发 PageOnEnter。
''' </summary> ''' </summary>
Private Sub PageOnExitAnimationFinished() Private Sub PageOnExitAnimationFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnExitAnimationFinished") Logger.Trace("已触发 PageOnExitAnimationFinished")
Select Case PageState Select Case PageState
Case PageStates.PageExit Case PageStates.PageExit
PageState = PageStates.Empty PageState = PageStates.Empty
@@ -261,7 +307,7 @@
PageState = PageStates.ContentEnter PageState = PageStates.ContentEnter
TriggerEnterAnimation(PanContent) TriggerEnterAnimation(PanContent)
Case Else Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnExitAnimationFinished 事件。") Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnExitAnimationFinished 事件。")
End Select End Select
End Sub End Sub
''' <summary> ''' <summary>
@@ -269,7 +315,7 @@
''' 需要从 LoaderWait 切换到 LoaderEnter。 ''' 需要从 LoaderWait 切换到 LoaderEnter。
''' </summary> ''' </summary>
Private Sub PageOnLoaderWaitFinished() Private Sub PageOnLoaderWaitFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnLoaderWaitFinished") Logger.Trace("已触发 PageOnLoaderWaitFinished")
Select Case PageState Select Case PageState
Case PageStates.LoaderWait Case PageStates.LoaderWait
PageState = PageStates.LoaderEnter PageState = PageStates.LoaderEnter
@@ -279,7 +325,7 @@
TriggerEnterAnimation(PanLoader) TriggerEnterAnimation(PanLoader)
End If End If
Case Else Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。") Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnLoaderWaitFinished 事件。")
End Select End Select
End Sub End Sub
''' <summary> ''' <summary>
@@ -287,7 +333,7 @@
''' 需要从 LoaderStayForce 切换到 LoaderStay 或 LoaderExit。 ''' 需要从 LoaderStayForce 切换到 LoaderStay 或 LoaderExit。
''' </summary> ''' </summary>
Private Sub PageOnLoaderStayFinished() Private Sub PageOnLoaderStayFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnLoaderStayFinished") Logger.Trace("已触发 PageOnLoaderStayFinished")
Select Case PageState Select Case PageState
Case PageStates.LoaderStayForce Case PageStates.LoaderStayForce
If PageLoader.State = LoadState.Finished Then If PageLoader.State = LoadState.Finished Then
@@ -297,7 +343,7 @@
PageState = PageStates.LoaderStay PageState = PageStates.LoaderStay
End If End If
Case Else Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。") Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnLoaderWaitFinished 事件。")
End Select End Select
End Sub End Sub
@@ -308,7 +354,7 @@
Select Case NewState Select Case NewState
Case LoadState.Failed, LoadState.Loading Case LoadState.Failed, LoadState.Loading
If OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Return If OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Return
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Start/Refresh)") Logger.Trace("已触发 PageLoaderState (Start/Refresh)")
'（重新）开始运行 '（重新）开始运行
'需要从部分状态切换到 ReloadExit '需要从部分状态切换到 ReloadExit
Select Case PageState Select Case PageState
@@ -320,7 +366,7 @@
End Select End Select
Case LoadState.Finished, LoadState.Interrupted, LoadState.Waiting Case LoadState.Finished, LoadState.Interrupted, LoadState.Waiting
If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Interrupt)") Logger.Trace("已触发 PageLoaderState (Stop/Interrupt)")
'运行结束 '运行结束
'需要从 LoaderWait 切换到 ContentEnter，或从 LoaderStay 切换到 LoaderExit '需要从 LoaderWait 切换到 ContentEnter，或从 LoaderStay 切换到 LoaderExit
Select Case PageState Select Case PageState
Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb
+27 -28
View File
@@ -49,12 +49,12 @@ Public Class MyRadioBox
'自定义属性基础 '自定义属性基础
Dim IsChanged As Boolean = False Dim IsChanged As Boolean = False
If IsLoaded AndAlso Not value = Checked Then RaiseEvent PreviewChange(Me, New RouteEventArgs(user)) If IsLoaded AndAlso Not value = Checked Then RaiseEvent PreviewChange(Me, New RouteEventArgs(user))
If Not value = Checked Then If value <> Checked Then
SetValue(CheckedProperty, value) SetValue(CheckedProperty, value)
IsChanged = True IsChanged = True
End If End If
'保证只有一个单选框选中 '保证最多只有一个单选框选中
If Parent Is Nothing Then Return If Parent Is Nothing Then Return
Dim RadioboxList As New List(Of MyRadioBox) Dim RadioboxList As New List(Of MyRadioBox)
Dim CheckedCount As Integer = 0 Dim CheckedCount As Integer = 0
@@ -64,31 +64,26 @@ Public Class MyRadioBox
If Control.Checked Then CheckedCount += 1 If Control.Checked Then CheckedCount += 1
End If End If
Next Next
Select Case CheckedCount '判断选中情况 If CheckedCount > 1 Then
Case 0 If Checked Then
'没有任何单选框被选中，选择第一个 '如果本控件选中，则取消其他所有控件的选中
RadioboxList(0).Checked = True For Each Control As MyRadioBox In RadioboxList
Case Is > 1 If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False
'选中项目多于 1 个 Next
If Checked Then Else
'如果本控件选中，则取消其他所有控件的选中 '如果本控件未选中，则只保留第一个选中的控件
For Each Control As MyRadioBox In RadioboxList Dim FirstChecked = False
If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False For Each Control As MyRadioBox In RadioboxList
Next If Control.Checked Then
Else If FirstChecked Then
'如果本控件未选中，则只保留第一个选中的控件 Control.Checked = False '修改 Checked 会自动触发 Change 事件，所以不用额外触发
Dim FirstChecked = False Else
For Each Control As MyRadioBox In RadioboxList FirstChecked = True
If Control.Checked Then
If FirstChecked Then
Control.Checked = False '修改 Checked 会自动触发 Change 事件，所以不用额外触发
Else
FirstChecked = True
End If
End If End If
Next End If
End If Next
End Select End If
End If
If IsChanged Then If IsChanged Then
'触发事件 '触发事件
@@ -100,10 +95,11 @@ Public Class MyRadioBox
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "单选框勾选改变错误", NotifyLevel.AllUsers) Logger.Error(ex, "单选框勾选改变错误", LogBehavior.Toast)
End Try End Try
End Sub End Sub
Private Sub SyncUI() Private Sub SyncUI()
Cursor = If(Checked, Nothing, Cursors.Hand)
If AniControlEnabled = 0 AndAlso IsLoaded Then '防止默认属性变更触发动画 If AniControlEnabled = 0 AndAlso IsLoaded Then '防止默认属性变更触发动画
If Checked Then If Checked Then
'由无变有 '由无变有
@@ -175,7 +171,7 @@ Public Class MyRadioBox
Private AllowMouseDown As Boolean = True Private AllowMouseDown As Boolean = True
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Return If Not MouseDowned Then Return
Log("[Control] 按下单选框：" & Text) Logger.Info($"按下单选框：{Text}")
SetChecked(True, True) SetChecked(True, True)
MouseDowned = False MouseDowned = False
AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid) AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
@@ -202,6 +198,9 @@ Public Class MyRadioBox
Private Const AnimationTimeOfMouseIn As Integer = 100 '鼠标指向动画长度 Private Const AnimationTimeOfMouseIn As Integer = 100 '鼠标指向动画长度
Private Const AnimationTimeOfMouseOut As Integer = 200 '鼠标指向动画长度 Private Const AnimationTimeOfMouseOut As Integer = 200 '鼠标指向动画长度
Private Const AnimationTimeOfCheck As Integer = 150 '勾选状态变更动画长度 Private Const AnimationTimeOfCheck As Integer = 150 '勾选状态变更动画长度
Private Sub MyRadioBox_Loaded() Handles Me.Loaded
Cursor = If(Checked, Nothing, Cursors.Hand)
End Sub
Private Sub Radiobox_IsEnabledChanged() Handles Me.IsEnabledChanged Private Sub Radiobox_IsEnabledChanged() Handles Me.IsEnabledChanged
If Me.IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 If Me.IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画 '有动画
Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb
+4 -3
View File
@@ -104,7 +104,7 @@ Public Class MyRadioButton
RaiseCustomEvent() RaiseCustomEvent()
Catch ex As Exception Catch ex As Exception
Log(ex, "单选按钮勾选改变错误", NotifyLevel.AllUsers) Logger.Error(ex, "单选按钮勾选改变错误", LogBehavior.Toast)
End Try End Try
End Sub End Sub
@@ -145,7 +145,7 @@ Public Class MyRadioButton
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Checked Then Return If Checked Then Return
If Not IsMouseDown Then Return If Not IsMouseDown Then Return
Log("[Control] 按下单选按钮：" & Text) Logger.Info($"按下单选按钮：{Text}")
IsMouseDown = False IsMouseDown = False
Dim e As New RouteEventArgs(True) Dim e As New RouteEventArgs(True)
RaiseEvent PreviewClick(Me, e) RaiseEvent PreviewClick(Me, e)
@@ -167,6 +167,7 @@ Public Class MyRadioButton
Private Const AnimationTimeOfMouseOut As Integer = 150 '鼠标移出动画长度 Private Const AnimationTimeOfMouseOut As Integer = 150 '鼠标移出动画长度
Private Const AnimationTimeOfCheck As Integer = 120 '勾选状态变更动画长度 Private Const AnimationTimeOfCheck As Integer = 120 '勾选状态变更动画长度
Private Sub RefreshColor(Optional obj = Nothing, Optional e = Nothing) Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded Private Sub RefreshColor(Optional obj = Nothing, Optional e = Nothing) Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded
Cursor = If(Checked, Nothing, Cursors.Hand)
Try Try
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not False.Equals(e) Then '防止默认属性变更触发动画，若强制不执行动画，则 e 为 False If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not False.Equals(e) Then '防止默认属性变更触发动画，若强制不执行动画，则 e 为 False
@@ -255,7 +256,7 @@ Public Class MyRadioButton
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新单选按钮颜色出错") Logger.Warn(ex, "刷新单选按钮颜色出错")
End Try End Try
End Sub End Sub
Plain Craft Launcher 2/Controls/MyScrollBar.vb
+1 -1
View File
@@ -44,7 +44,7 @@
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "滚动条颜色改变出错") Logger.Warn(ex, "滚动条颜色改变出错")
End Try End Try
End Sub End Sub
Plain Craft Launcher 2/Controls/MySlider.xaml.vb
+2 -2
View File
@@ -63,7 +63,7 @@ Public Class MySlider
If AniControlEnabled = 0 Then RaiseEvent Change(Me, False) If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)
Catch ex As Exception Catch ex As Exception
Log(ex, "滑动条进度改变出错", NotifyLevel.AllUsers) Logger.Error(ex, "滑动条进度改变出错", LogBehavior.Toast)
End Try End Try
End Set End Set
End Property End Property
@@ -156,7 +156,7 @@ Public Class MySlider
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "滑动条颜色改变出错") Logger.Warn(ex, "滑动条颜色改变出错")
End Try End Try
End Sub End Sub
Plain Craft Launcher 2/Controls/MySliderDot.xaml.vb
+1 -1
View File
@@ -59,7 +59,7 @@
If AniControlEnabled = 0 Then RaiseEvent Change(Me, False) If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)
Catch ex As Exception Catch ex As Exception
Log(ex, "滑动条进度改变出错", LogLevel.Hint) Logger.Warning(ex, "滑动条进度改变出错", LogLevel.Hint)
End Try End Try
End Set End Set
End Property End Property
Plain Craft Launcher 2/Controls/MyTextBox.vb
+2 -2
View File
@@ -228,7 +228,7 @@
'改变文本 '改变文本
RaiseEvent ValidatedTextChanged(sender, e) RaiseEvent ValidatedTextChanged(sender, e)
Catch ex As Exception Catch ex As Exception
Log(ex, "进行输入验证时出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "进行输入验证时出错")
End Try End Try
End Sub End Sub
@@ -282,7 +282,7 @@
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "文本框颜色改变出错") Logger.Warn(ex, "文本框颜色改变出错")
End Try End Try
End Sub End Sub
Private Sub RefreshTextColor() Handles Me.IsEnabledChanged Private Sub RefreshTextColor() Handles Me.IsEnabledChanged
Plain Craft Launcher 2/Controls/MyTextButton.vb
+1 -1
View File
@@ -45,7 +45,7 @@
Private Sub MyTextButton_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp Private Sub MyTextButton_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If Not IsMouseDown Then Return If Not IsMouseDown Then Return
IsMouseDown = False IsMouseDown = False
Log("[Control] 按下文本按钮：" & Text) Logger.Info($"按下文本按钮：{Text}")
RaiseEvent Click(Me, Nothing) RaiseEvent Click(Me, Nothing)
RaiseCustomEvent() RaiseCustomEvent()
e.Handled = True e.Handled = True
Plain Craft Launcher 2/FormMain.xaml.vb
+107 -204
View File
@@ -11,6 +11,11 @@ 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 < 400 Then 'Release 2.12.8.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：升级框架到 .NET Framework 4.8"))
FeatureCount += 28
BugCount += 19
End If
If LastVersion < 398 Then 'Release 2.12.7.3 If LastVersion < 398 Then 'Release 2.12.7.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：下载游戏、整合包的稳定性")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：下载游戏、整合包的稳定性"))
FeatureCount += 1 FeatureCount += 1
@@ -63,58 +68,17 @@ Public Class FormMain
FeatureCount += 32 FeatureCount += 32
BugCount += 21 BugCount += 21
End If End If
If LastVersion < 372 Then 'Release 2.10.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：如果版本设置了自定义描述，会在标题后面以淡灰色显示其版本号"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增：支持为一个控件设置多个自定义事件"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增：修改变量、弹出提示自定义事件"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增：添加大量替换标记，允许在更多设置和 XAML 中使用更多替换标记"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法安装 MMC 整合包"))
FeatureCount += 33
BugCount += 11
End If
If LastVersion < 369 Then 'Release 2.10.8
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增：允许在版本设置中设置禁止更新 Mod，以防整合包玩家误操作"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：网络与下载稳定性优化"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化：若整合包需要 PCL 不兼容的加载器，允许选择跳过它的安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "删除：由于已不再需要，删除手动安装包下载功能"))
FeatureCount += 21
BugCount += 32
End If
If LastVersion < 367 Then 'Release 2.10.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：启用 MCIM 社区资源镜像源，以缓解社区资源难以下载的问题"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：正版登录出错时无法给出正确的错误信息"))
FeatureCount += 9
BugCount += 9
End If
If LastVersion < 365 Then 'Release 2.10.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：下载资源时，会单独记忆每种资源上次下载到的文件夹，以防混淆"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：网络底层框架与下载稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法启动一部分 LabyMod 和 GTNH 客户端"))
FeatureCount += 22
BugCount += 26
End If
If LastVersion < 361 Then 'Release 2.10.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复：无法安装部分使用老版本 PCL 导出的整合包"))
End If
If LastVersion < 359 Then 'Release 2.10.2
If LastVersion >= 357 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：下载资源包、光影包时能自动跳转到对应的文件夹"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：调整界面样式与动画，让整体视觉更干净，操作体验更顺滑"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复：无法从 CurseForge 下载 Mod 等资源，或是安装整合包"))
FeatureCount += 28
BugCount += 28
End If
If LastVersion < 357 Then 'Release 2.10.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增：下载资源包、光影包、数据包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增：允许设置文件下载源"))
FeatureCount += 9
BugCount += 26
End If
Else Else
'5： FEAT+ '5： FEAT+
'4： IMP+ FEAT* '4： IMP+ FEAT*
'3：BUG+ IMP* FEAT- '3：BUG+ IMP* FEAT-
'2：BUG* IMP- '2：BUG* IMP-
'1：BUG- '1：BUG-
If LastVersion < 399 Then 'Snapshot 2.12.8.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：升级框架到 .NET Framework 4.8"))
FeatureCount += 28
BugCount += 19
End If
If LastVersion < 397 Then 'Snapshot 2.12.7.3 If LastVersion < 397 Then 'Snapshot 2.12.7.3
If LastVersion >= 393 AndAlso LastVersion < 397 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法使用自定义隐藏主题")) If LastVersion >= 393 AndAlso LastVersion < 397 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法使用自定义隐藏主题"))
End If End If
@@ -212,68 +176,6 @@ Public Class FormMain
FeatureCount += 7 FeatureCount += 7
BugCount += 10 BugCount += 10
End If End If
If LastVersion < 371 Then 'Snapshot 2.10.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：如果版本设置了自定义描述，会在标题后面以淡灰色显示其版本号"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增：支持为一个控件设置多个自定义事件"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增：修改变量、弹出提示自定义事件"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增：添加大量替换标记，允许在更多设置和 XAML 中使用更多替换标记"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法安装 MMC 整合包"))
FeatureCount += 33
BugCount += 11
End If
If LastVersion < 370 Then 'Snapshot 2.10.8
If LastVersion >= 368 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：网络与下载稳定性优化"))
FeatureCount += 3
BugCount += 4
End If
If LastVersion < 368 Then 'Snapshot 2.10.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增：允许在版本设置中设置禁止更新 Mod，以防整合包玩家误操作"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：网络与下载稳定性优化"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化：若整合包需要 PCL 不兼容的加载器，允许选择跳过它的安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "删除：由于已不再需要，删除手动安装包下载功能"))
FeatureCount += 19
BugCount += 28
End If
If LastVersion < 366 Then 'Snapshot 2.10.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：启用 MCIM 社区资源镜像源，以缓解社区资源难以下载的问题"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：正版登录出错时无法给出正确的错误信息"))
FeatureCount += 9
BugCount += 9
End If
If LastVersion < 364 Then 'Snapshot 2.10.5
If LastVersion >= 363 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法添加新的正版账号"))
BugCount += 1
End If
End If
If LastVersion < 363 Then 'Snapshot 2.10.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：下载资源时，会单独记忆每种资源上次下载到的文件夹，以防混淆"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：网络底层框架与下载稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法启动一部分 LabyMod 和 GTNH 客户端"))
FeatureCount += 22
BugCount += 26
End If
If LastVersion < 362 Then 'Snapshot 2.10.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复：无法安装部分使用老版本 PCL 导出的整合包"))
End If
If LastVersion < 360 Then 'Snapshot 2.10.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复：无法从 CurseForge 下载 Mod 等资源，或是安装整合包"))
If LastVersion >= 358 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法加载正版皮肤的头像"))
FeatureCount += 3
BugCount += 5
End If
If LastVersion < 358 Then 'Snapshot 2.10.1
If LastVersion >= 356 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：下载资源包、光影包时能自动跳转到对应的文件夹"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：调整界面样式与动画，让整体视觉更干净，操作体验更顺滑"))
FeatureCount += 25
BugCount += 23
End If
If LastVersion < 356 Then 'Snapshot 2.10.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增：下载资源包、光影包、数据包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增：允许设置文件下载源"))
FeatureCount += 9
BugCount += 26
End If
End If End If
'整理更新日志文本 '整理更新日志文本
Dim ContentList As New List(Of String) Dim ContentList As New List(Of String)
@@ -308,7 +210,7 @@ Public Class FormMain
FrmLaunchLeft = New PageLaunchLeft FrmLaunchLeft = New PageLaunchLeft
FrmLaunchRight = New PageLaunchRight FrmLaunchRight = New PageLaunchRight
'版本号改变 '版本号改变
Dim LastVersion As Integer = Settings.Get("SystemLastVersionReg") Dim LastVersion As Integer = Settings.Get(Of Integer)("SystemLastVersionReg")
If LastVersion < VersionCode Then If LastVersion < VersionCode Then
'触发升级 '触发升级
UpgradeSub(LastVersion) UpgradeSub(LastVersion)
@@ -319,19 +221,19 @@ Public Class FormMain
'版本隔离设置迁移 '版本隔离设置迁移
If Not Settings.HasSaved("LaunchArgumentIndieV2") Then If Not Settings.HasSaved("LaunchArgumentIndieV2") Then
If Settings.HasSaved("LaunchArgumentIndie") Then If Settings.HasSaved("LaunchArgumentIndie") Then
Log("[Start] 从老 PCL 迁移版本隔离") Logger.Info("从老 PCL 迁移版本隔离")
Settings.Set("LaunchArgumentIndieV2", Settings.Get("LaunchArgumentIndie")) Settings.Set("LaunchArgumentIndieV2", Settings.Get(Of Integer)("LaunchArgumentIndie"))
ElseIf HasIniKey("Setup", "LaunchVersionSelect") Then ElseIf HasIniKey("Setup", "LaunchVersionSelect") Then
Log("[Start] 从老 PCL 升级，但此前未调整版本隔离，使用老的版本隔离默认值") Logger.Info("从老 PCL 升级，但此前未调整版本隔离，使用老的版本隔离默认值")
Settings.Set("LaunchArgumentIndieV2", Settings.GetDefault("LaunchArgumentIndie")) Settings.Set("LaunchArgumentIndieV2", Settings.GetDefault("LaunchArgumentIndie"))
Else Else
Log("[Start] 全新的 PCL，使用新的版本隔离默认值") Logger.Info("全新的 PCL，使用新的版本隔离默认值")
Settings.Set("LaunchArgumentIndieV2", Settings.GetDefault("LaunchArgumentIndieV2")) Settings.Set("LaunchArgumentIndieV2", Settings.GetDefault("LaunchArgumentIndieV2"))
End If End If
End If End If
'刷新主题 '刷新主题
ThemeCheckAll(False) ThemeCheckAll(False)
ThemeRefresh(Settings.Get("UiLauncherTheme")) ThemeRefresh(Settings.Get(Of Integer)("UiLauncherTheme"))
'注册拖拽事件（不能直接加 Handles，否则没用；#6340） '注册拖拽事件（不能直接加 Handles，否则没用；#6340）
[AddHandler](DragDrop.DragEnterEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True) [AddHandler](DragDrop.DragEnterEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True)
[AddHandler](DragDrop.DragOverEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True) [AddHandler](DragDrop.DragOverEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True)
@@ -339,7 +241,7 @@ Public Class FormMain
InitializeComponent() InitializeComponent()
Opacity = 0 Opacity = 0
'开启管理员权限下的文件拖拽 '开启管理员权限下的文件拖拽
If IsAdmin() Then If SystemUtils.HasAdminRole() Then
Static Helper As New DragHelper Static Helper As New DragHelper
AddHandler SourceInitialized, AddHandler SourceInitialized,
Sub() Sub()
@@ -364,7 +266,7 @@ Public Class FormMain
'尽早执行的加载池 '尽早执行的加载池
McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行，必须跑一次；为了让启动按钮尽快可用，需要尽早执行；为了与 PageLaunchLeft 联动，需要为 0 而不是 GetUuid McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行，必须跑一次；为了让启动按钮尽快可用，需要尽早执行；为了与 PageLaunchLeft 联动，需要为 0 而不是 GetUuid
Log("[Start] 第二阶段加载用时：" & GetTimeMs() - ApplicationStartTick & " ms") Logger.Info($"第二阶段加载用时：{GetTimeMs() - ApplicationStartTick} ms")
End Sub End Sub
Private Sub FormMain_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub FormMain_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
ApplicationStartTick = GetTimeMs() ApplicationStartTick = GetTimeMs()
@@ -397,10 +299,10 @@ Public Class FormMain
'加载窗口 '加载窗口
ThemeRefreshMain() ThemeRefreshMain()
Try Try
Height = Settings.Get("WindowHeight") Height = Settings.Get(Of Integer)("WindowHeight")
Width = Settings.Get("WindowWidth") Width = Settings.Get(Of Integer)("WindowWidth")
Catch ex As Exception '修复 #2019 Catch ex As Exception '修复 #2019
Log(ex, "读取窗口默认大小失败", NotifyLevel.AllUsers) Logger.Error(ex, "读取窗口默认大小失败", LogBehavior.Toast)
Height = MinHeight + 100 Height = MinHeight + 100
Width = MinWidth + 100 Width = MinWidth + 100
End Try End Try
@@ -417,14 +319,14 @@ Public Class FormMain
HwndSource.AddHook(New Interop.HwndSourceHook(AddressOf WndProc)) HwndSource.AddHook(New Interop.HwndSourceHook(AddressOf WndProc))
AniStart({ AniStart({
AaCode(Sub() AniControlEnabled -= 1, 50), AaCode(Sub() AniControlEnabled -= 1, 50),
AaOpacity(Me, Settings.Get("UiLauncherTransparent") / 1000 + 0.4, 250, 100), AaOpacity(Me, Settings.Get(Of Integer)("UiLauncherTransparent") / 1000 + 0.4, 250, 100),
AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 600, 100, New AniEaseOutBack(AniEasePower.Weak)), AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 600, 100, New AniEaseOutBack(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)), AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)),
AaCode( AaCode(
Sub() Sub()
PanBack.RenderTransform = Nothing PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True IsWindowLoadFinished = True
Log($"[System] DPI：{DPI}，系统版本：{Environment.OSVersion.VersionString}，PCL 位置：{PathExe}") Logger.Info($"DPI：{DPI}，系统版本：{Environment.OSVersion.VersionString}，PCL 位置：{PathExe}")
End Sub, , True) End Sub, , True)
}, "Form Show") }, "Form Show")
'Timer 启动 'Timer 启动
@@ -435,9 +337,9 @@ Public Class FormMain
Sub() Sub()
'EULA 提示 'EULA 提示
Const EulaVersion As Integer = 2 Const EulaVersion As Integer = 2
If Settings.Get("SystemEulaVersion") < EulaVersion Then If Settings.Get(Of Integer)("SystemEulaVersion") < EulaVersion Then
Select Case MyMsgBox( Select Case MyMsgBox(
If(Settings.Get("SystemEulaVersion") = 0, If(Settings.Get(Of Integer)("SystemEulaVersion") = 0,
"在使用 PCL 前，请先阅读用户协议与免责声明。", "在使用 PCL 前，请先阅读用户协议与免责声明。",
$"PCL 的用户协议与免责声明已更新。{vbCrLf}请阅读更新后的用户协议与免责声明。"), $"PCL 的用户协议与免责声明已更新。{vbCrLf}请阅读更新后的用户协议与免责声明。"),
"协议授权", "同意", "拒绝", "查看用户协议与免责声明", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
@@ -457,13 +359,13 @@ Public Class FormMain
ServerLoader.Start() ServerLoader.Start()
RunInNewThread(AddressOf TryClearTaskTemp, "TryClearTaskTemp", ThreadPriority.BelowNormal) RunInNewThread(AddressOf TryClearTaskTemp, "TryClearTaskTemp", ThreadPriority.BelowNormal)
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化加载池运行失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "初始化加载池运行失败")
End Try End Try
'清理自动更新文件 '清理自动更新文件
Try Try
File.Delete(PathExeFolder & "PCL\Plain Craft Launcher 2.exe") FileUtils.Delete(PathExeFolder & "PCL\Plain Craft Launcher 2.exe")
Catch ex As Exception Catch ex As Exception
Log(ex, "清理自动更新文件失败") Logger.Warn(ex, "清理自动更新文件失败")
End Try End Try
'上报 '上报
Telemetry("启动") Telemetry("启动")
@@ -473,19 +375,19 @@ Public Class FormMain
End If End If
End Sub, "初始化", ThreadPriority.Lowest) End Sub, "初始化", ThreadPriority.Lowest)
Log("[Start] 第三阶段加载用时：" & GetTimeMs() - ApplicationStartTick & " ms") Logger.Info($"第三阶段加载用时：{GetTimeMs() - ApplicationStartTick} ms")
End Sub End Sub
'根据打开次数触发的事件 '根据打开次数触发的事件
Private Sub RunCountSub() Private Sub RunCountSub()
Settings.Set("SystemCount", Settings.Get("SystemCount") + 1) Settings.Set("SystemCount", Settings.Get(Of Integer)("SystemCount") + 1)
If BuildType = BuildTypes.Snapshot Then If BuildType = BuildTypes.Snapshot Then
Select Case Settings.Get("SystemCount") Select Case Settings.Get(Of Integer)("SystemCount")
Case 1 Case 1
MyMsgBox("欢迎使用 PCL 快照版！" & vbCrLf & MyMsgBox("欢迎使用 PCL 快照版！" & vbCrLf &
"快照版包含尚未在正式版发布的测试性功能，仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦！" & vbCrLf & "快照版包含尚未在正式版发布的测试性功能，仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦！" & vbCrLf &
"如果你并非通过赞助或赞助者本人邀请进群获得的本程序，那么可能是有人在违规传播，记得提醒他一下啦。", "快照版使用说明") "如果你并非通过赞助或赞助者本人邀请进群获得的本程序，那么可能是有人在违规传播，记得提醒他一下啦。", "快照版使用说明")
End Select End Select
If Settings.Get("SystemCount") >= 99 Then If Settings.Get(Of Integer)("SystemCount") >= 99 Then
If ThemeUnlock(6, False) Then If ThemeUnlock(6, False) Then
MyMsgBox("你已经使用了 99 次 PCL 啦，感谢你长期以来的支持！" & vbCrLf & MyMsgBox("你已经使用了 99 次 PCL 啦，感谢你长期以来的支持！" & vbCrLf &
"隐藏主题 铁杆粉 已解锁！", "提示") "隐藏主题 铁杆粉 已解锁！", "提示")
@@ -495,75 +397,75 @@ Public Class FormMain
End Sub End Sub
'升级与降级事件 '升级与降级事件
Private Sub UpgradeSub(LastVersionCode As Integer) Private Sub UpgradeSub(LastVersionCode As Integer)
Log("[Start] 版本号从 " & LastVersionCode & " 升高到 " & VersionCode) Logger.Info($"版本号从 {LastVersionCode} 升高到 {VersionCode}")
Settings.Set("SystemLastVersionReg", VersionCode) Settings.Set("SystemLastVersionReg", VersionCode)
'检查有记录的最高版本号 '检查有记录的最高版本号
Dim LowerVersionCode As Integer Dim LowerVersionCode As Integer
Dim SettingKey = If(BuildType = BuildTypes.Snapshot, "SystemHighestAlphaVersionReg", "SystemHighestBetaVersionReg") Const SettingKey = If(BuildType = BuildTypes.Snapshot, "SystemHighestAlphaVersionReg", "SystemHighestBetaVersionReg")
LowerVersionCode = Settings.Get("SystemHighestAlphaVersionReg") LowerVersionCode = Settings.Get(Of Integer)("SystemHighestAlphaVersionReg")
If LowerVersionCode < VersionCode Then If LowerVersionCode < VersionCode Then
Settings.Set("SystemHighestAlphaVersionReg", VersionCode) Settings.Set(SettingKey, VersionCode)
Log($"[Start] 最高版本号从 {LowerVersionCode} 升高到 {VersionCode}") Logger.Info($"最高版本号从 {LowerVersionCode} 升高到 {VersionCode}")
End If End If
'被移除的窗口设置选项 '被移除的窗口设置选项
If Settings.Get("LaunchArgumentWindowType") = 5 Then Settings.Set("LaunchArgumentWindowType", 1) If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 5 Then Settings.Set("LaunchArgumentWindowType", 1)
'修改主题设置项名称 '修改主题设置项名称
If LowerVersionCode <= 207 Then If LowerVersionCode <= 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("UiLauncherThemeHide").ToString.Split("|"))) UnlockedTheme.AddRange(New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide").ToString.Split("|")))
UnlockedTheme.AddRange(New List(Of String)(Settings.Get("UiLauncherThemeHide2").ToString.Split("|"))) UnlockedTheme.AddRange(New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|")))
Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Distinct.ToList.Join("|"c)) Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Distinct.ToList.Join("|"c))
End If End If
'重置欧皇彩 '重置欧皇彩
If LastVersionCode <= 115 AndAlso Settings.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("13") Then If LastVersionCode <= 115 AndAlso Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|").Contains("13") Then
Dim UnlockedTheme As New List(Of String)(Settings.Get("UiLauncherThemeHide2").ToString.Split("|")) Dim UnlockedTheme As New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|"))
UnlockedTheme.Remove("13") UnlockedTheme.Remove("13")
Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Join("|"c)) Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Join("|"c))
MyMsgBox("由于新版 PCL 修改了欧皇彩的解锁方式，你需要重新解锁欧皇彩。" & vbCrLf & MyMsgBox("由于新版 PCL 修改了欧皇彩的解锁方式，你需要重新解锁欧皇彩。" & vbCrLf &
"多谢各位的理解啦！", "重新解锁提醒") "多谢各位的理解啦！", "重新解锁提醒")
End If End If
'重置滑稽彩 '重置滑稽彩
If LastVersionCode <= 152 AndAlso Settings.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("12") Then If LastVersionCode <= 152 AndAlso Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|").Contains("12") Then
Dim UnlockedTheme As New List(Of String)(Settings.Get("UiLauncherThemeHide2").ToString.Split("|")) Dim UnlockedTheme As New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|"))
UnlockedTheme.Remove("12") UnlockedTheme.Remove("12")
Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Join("|"c)) Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Join("|"c))
MyMsgBox("由于新版 PCL 修改了滑稽彩的解锁方式，你需要重新解锁滑稽彩。" & vbCrLf & MyMsgBox("由于新版 PCL 修改了滑稽彩的解锁方式，你需要重新解锁滑稽彩。" & vbCrLf &
"多谢各位的理解啦！", "重新解锁提醒") "多谢各位的理解啦！", "重新解锁提醒")
End If End If
'移动自定义皮肤 '移动自定义皮肤
If LastVersionCode <= 161 AndAlso File.Exists(PathExeFolder & "PCL\CustomSkin.png") AndAlso Not File.Exists(PathAppdata & "CustomSkin.png") Then If LastVersionCode <= 161 AndAlso FileUtils.Exists(PathExeFolder & "PCL\CustomSkin.png") AndAlso Not FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
CopyFile(PathExeFolder & "PCL\CustomSkin.png", PathAppdata & "CustomSkin.png") FileUtils.Copy(PathExeFolder & "PCL\CustomSkin.png", PathAppdata & "CustomSkin.png")
Log("[Start] 已移动离线自定义皮肤 (162)") Logger.Info("已移动离线自定义皮肤 (162)")
End If End If
If LastVersionCode <= 263 AndAlso File.Exists(PathTemp & "CustomSkin.png") AndAlso Not File.Exists(PathAppdata & "CustomSkin.png") Then If LastVersionCode <= 263 AndAlso FileUtils.Exists(PathTemp & "CustomSkin.png") AndAlso Not FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
CopyFile(PathTemp & "CustomSkin.png", PathAppdata & "CustomSkin.png") FileUtils.Copy(PathTemp & "CustomSkin.png", PathAppdata & "CustomSkin.png")
Log("[Start] 已移动离线自定义皮肤 (264)") Logger.Info("已移动离线自定义皮肤 (264)")
End If End If
'解除帮助页面的隐藏 '解除帮助页面的隐藏
If LastVersionCode <= 205 Then If LastVersionCode <= 205 Then
Settings.Set("UiHiddenOtherHelp", False) Settings.Set("UiHiddenOtherHelp", False)
Log("[Start] 已解除帮助页面的隐藏") Logger.Info("已解除帮助页面的隐藏")
End If End If
'单向迁移微软登录结果（#4836） '单向迁移微软登录结果（#4836）
If Not Settings.Get("CacheMsV2Migrated") Then If Not Settings.Get(Of Boolean)("CacheMsV2Migrated") Then
Settings.Set("CacheMsV2Migrated", True) Settings.Set("CacheMsV2Migrated", True)
Settings.Set("CacheMsV2OAuthRefresh", Settings.Get("CacheMsOAuthRefresh")) Settings.Set("CacheMsV2OAuthRefresh", Settings.Get(Of String)("CacheMsOAuthRefresh"))
Settings.Set("CacheMsV2Access", Settings.Get("CacheMsAccess")) Settings.Set("CacheMsV2Access", Settings.Get(Of String)("CacheMsAccess"))
Settings.Set("CacheMsV2ProfileJson", Settings.Get("CacheMsProfileJson")) Settings.Set("CacheMsV2ProfileJson", Settings.Get(Of String)("CacheMsProfileJson"))
Settings.Set("CacheMsV2Uuid", Settings.Get("CacheMsUuid")) Settings.Set("CacheMsV2Uuid", Settings.Get(Of String)("CacheMsUuid"))
Settings.Set("CacheMsV2Name", Settings.Get("CacheMsName")) Settings.Set("CacheMsV2Name", Settings.Get(Of String)("CacheMsName"))
Log("[Start] 已从老版本迁移微软登录结果") Logger.Info("已从老版本迁移微软登录结果")
End If End If
'Mod 命名设置迁移 'Mod 命名设置迁移
If Settings.HasSaved("ToolDownloadTranslate") AndAlso Not Settings.HasSaved("ToolDownloadTranslateV2") Then If Settings.HasSaved("ToolDownloadTranslate") AndAlso Not Settings.HasSaved("ToolDownloadTranslateV2") Then
Settings.Set("ToolDownloadTranslateV2", Settings.Get("ToolDownloadTranslate") + 1) Settings.Set("ToolDownloadTranslateV2", Settings.Get(Of Integer)("ToolDownloadTranslate") + 1)
Log("[Start] 已从老版本迁移 Mod 命名设置") Logger.Info("已从老版本迁移 Mod 命名设置")
End If End If
'重置 JVM 参数设置 '重置 JVM 参数设置
If LastVersionCode <= 381 AndAlso Settings.HasSaved("LaunchAdvanceJvm") AndAlso If LastVersionCode <= 381 AndAlso Settings.HasSaved("LaunchAdvanceJvm") AndAlso
Settings.Get("LaunchAdvanceJvm").ToString.Replace("-XX:+UseG1GC ", "").Replace("-XX:-UseAdaptiveSizePolicy ", "").Trim = Settings.GetDefault("LaunchAdvanceJvm") Then Settings.Get(Of String)("LaunchAdvanceJvm").ToString.Replace("-XX:+UseG1GC ", "").Replace("-XX:-UseAdaptiveSizePolicy ", "").Trim = Settings.GetDefault("LaunchAdvanceJvm") Then
Settings.Reset("LaunchAdvanceJvm") Settings.Reset("LaunchAdvanceJvm")
Log("[Start] 已重置 JVM 参数设置") Logger.Info("已重置 JVM 参数设置")
End If End If
'输出更新日志 '输出更新日志
If LastVersionCode <= 0 Then Return If LastVersionCode <= 0 Then Return
@@ -571,7 +473,7 @@ Public Class FormMain
ShowUpdateLog(LowerVersionCode) ShowUpdateLog(LowerVersionCode)
End Sub End Sub
Private Sub DowngradeSub(LastVersionCode As Integer) Private Sub DowngradeSub(LastVersionCode As Integer)
Log("[Start] 版本号从 " & LastVersionCode & " 降低到 " & VersionCode) Logger.Info($"版本号从 {LastVersionCode} 降低到 {VersionCode}")
Settings.Set("SystemLastVersionReg", VersionCode) Settings.Set("SystemLastVersionReg", VersionCode)
End Sub End Sub
@@ -594,7 +496,7 @@ Public Class FormMain
If SendWarning AndAlso MyMsgBox("还有下载任务尚未完成，是否确定退出？", "提示", "确定", "取消") = 2 Then Return If SendWarning AndAlso MyMsgBox("还有下载任务尚未完成，是否确定退出？", "提示", "确定", "取消") = 2 Then Return
RunInNewThread( RunInNewThread(
Sub() Sub()
Log("[System] 正在强行停止任务") Logger.Info("正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToList() For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Interrupt() Task.Interrupt()
Next Next
@@ -631,26 +533,26 @@ Public Class FormMain
Else Else
EndProgramForce() EndProgramForce()
End If End If
Log("[System] 收到关闭指令") Logger.Info("收到关闭指令")
End Sub) End Sub)
End Sub End Sub
Private Shared IsLogShown As Boolean = False Private Shared IsLogShown As Boolean = False
Public Shared Sub EndProgramForce(Optional ReturnCode As ProcessReturnValues = ProcessReturnValues.Success) Public Shared Sub EndProgramForce(Optional ReturnCode As ProcessReturnValues = ProcessReturnValues.Success)
On Error Resume Next On Error Resume Next
IsProgramEnded = True IsProgramEnding = True
AniControlEnabled += 1 AniControlEnabled += 1
If IsUpdateWaitingRestart Then UpdateRestart(False) If IsUpdateWaitingRestart Then UpdateRestart(False)
If ReturnCode = ProcessReturnValues.Exception Then If ReturnCode = ProcessReturnValues.Exception Then
If Not IsLogShown Then If Not IsLogShown Then
FeedbackInfo() FeedbackInfo()
Log("请在 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(PathExeFolder & "PCL\Log1.txt")
End If End If
Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉 Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉
End If End If
Log("[System] 程序已退出，返回值：" & GetStringFromEnum(ReturnCode)) Logger.Info($"程序已退出，返回值：{ReturnCode}")
LogFlush() 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()
End Sub End Sub
@@ -693,11 +595,11 @@ Public Class FormMain
FrmMain.UpdateBackgroundAndTitleBar() FrmMain.UpdateBackgroundAndTitleBar()
End Sub End Sub
Public Sub UpdateBackgroundAndTitleBar() Public Sub UpdateBackgroundAndTitleBar()
Log("[FormMain] 从设置更新背景图片与标题栏样式") Logger.Info("从设置更新背景图片与标题栏样式")
'背景图片透明度 '背景图片透明度
ImgBack.Opacity = Settings.Get("UiBackgroundOpacity") / 1000 ImgBack.Opacity = Settings.Get(Of Integer)("UiBackgroundOpacity") / 1000
'背景图片模糊 '背景图片模糊
Dim BlurRadius As Double = Settings.Get("UiBackgroundBlur") + 1 Dim BlurRadius As Double = Settings.Get(Of Integer)("UiBackgroundBlur") + 1
If BlurRadius = 1 Then If BlurRadius = 1 Then
ImgBack.Effect = Nothing ImgBack.Effect = Nothing
Else Else
@@ -705,7 +607,7 @@ Public Class FormMain
End If End If
ImgBack.Margin = New Thickness(-BlurRadius / 1.8) ImgBack.Margin = New Thickness(-BlurRadius / 1.8)
'背景图片适应方式 '背景图片适应方式
Dim BackgroundType As Integer = Settings.Get("UiBackgroundSuit") Dim BackgroundType As Integer = Settings.Get(Of Integer)("UiBackgroundSuit")
If ImgBack.Background IsNot Nothing Then If ImgBack.Background IsNot Nothing Then
Dim Brush As ImageBrush = CType(ImgBack.Background, ImageBrush) Dim Brush As ImageBrush = CType(ImgBack.Background, ImageBrush)
If BackgroundType = 0 Then If BackgroundType = 0 Then
@@ -761,7 +663,7 @@ Public Class FormMain
End Select End Select
End If End If
'标题栏显示类型 '标题栏显示类型
Select Case Settings.Get("UiLogoType") Select Case Settings.Get(Of Integer)("UiLogoType")
Case 0 '无 Case 0 '无
ShapeTitleLogo.Visibility = Visibility.Collapsed ShapeTitleLogo.Visibility = Visibility.Collapsed
LabTitleLogo.Visibility = Visibility.Collapsed LabTitleLogo.Visibility = Visibility.Collapsed
@@ -802,14 +704,14 @@ Public Class FormMain
ImageTitleLogo.Source = PathExeFolder & "PCL\Logo.png" ImageTitleLogo.Source = PathExeFolder & "PCL\Logo.png"
Catch ex As Exception Catch ex As Exception
ImageTitleLogo.Source = Nothing ImageTitleLogo.Source = Nothing
Log(ex, "显示标题栏图片失败", NotifyLevel.MsgBox) Logger.Error(ex, "显示标题栏图片失败", LogBehavior.Alert)
End Try End Try
End Select End Select
FrmSetupUI?.CardLogo.TriggerForceResize() FrmSetupUI?.CardLogo.TriggerForceResize()
'标题栏文本 '标题栏文本
LabTitleLogo.Text = Settings.Get("UiLogoText") LabTitleLogo.Text = Settings.Get(Of String)("UiLogoText")
'标题栏文本是否居左 '标题栏文本是否居左
PanTitleMain.ColumnDefinitions(0).Width = New GridLength(If(Settings.Get("UiLogoLeft") AndAlso Settings.Get("UiLogoType") = 0, 0, 1), GridUnitType.Star) PanTitleMain.ColumnDefinitions(0).Width = New GridLength(If(Settings.Get(Of Boolean)("UiLogoLeft") AndAlso Settings.Get(Of Integer)("UiLogoType") = 0, 0, 1), GridUnitType.Star)
End Sub End Sub
#End Region #End Region
@@ -900,14 +802,14 @@ Public Class FormMain
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
Log(ex, "切回窗口时出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "切回窗口时出错")
End Try End Try
'读取剪贴板，自动加入联机房间 '读取剪贴板，自动加入联机房间
Return 'TODO: 联机复活赛 Return 'TODO: 联机复活赛
If PageLinkMain.LinkState <> PageLinkMain.LinkStates.Waiting Then Return '已启动联机 If PageLinkMain.LinkState <> PageLinkMain.LinkStates.Waiting Then Return '已启动联机
If PageCurrent = PageType.Link Then Return '已在联机界面 If PageCurrent = PageType.Link Then Return '已在联机界面
Dim Code = ClipboardGetText() : If Code Is Nothing Then Return '剪贴板无文本 Dim Code = ClipboardGetText() : If Code Is Nothing Then Return '剪贴板无文本
If Settings.Get("LinkLastAutoJoinInviteCode") = Code Then Return If Settings.Get(Of String)("LinkLastAutoJoinInviteCode") = Code Then Return
If PageLinkMain.ValidateCodeFormat(Code) IsNot Nothing Then Return '不是邀请码 If PageLinkMain.ValidateCodeFormat(Code) IsNot Nothing Then Return '不是邀请码
Settings.Set("LinkLastAutoJoinInviteCode", Code) Settings.Set("LinkLastAutoJoinInviteCode", Code)
RunInThread( RunInThread(
@@ -949,9 +851,9 @@ Public Class FormMain
End If End If
PrevData = e.Data PrevData = e.Data
PrevEffects = e.Effects PrevEffects = e.Effects
Log("[System] 设置拖放类型：" & GetStringFromEnum(e.Effects)) Logger.Info($"设置拖放类型：{e.Effects}")
Catch ex As Exception Catch ex As Exception
Log(ex, "处理拖放时出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "处理拖放时出错")
End Try End Try
End Sub End Sub
Private Sub FrmMain_Drop(sender As Object, e As DragEventArgs) Handles Me.Drop Private Sub FrmMain_Drop(sender As Object, e As DragEventArgs) Handles Me.Drop
@@ -961,13 +863,13 @@ Public Class FormMain
'获取文本 '获取文本
Try Try
Dim Str As String = e.Data.GetData(DataFormats.Text) Dim Str As String = e.Data.GetData(DataFormats.Text)
Log("[System] 接受文本拖拽：" & Str) Logger.Info($"接受文本拖拽：{Str}")
If Str.StartsWithF("authlib-injector:yggdrasil-server:") Then If Str.StartsWithF("authlib-injector:yggdrasil-server:") Then
'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 = EscapeUtils.FormUrlUnescape(Str.Substring("authlib-injector:yggdrasil-server:".Length))
Log("[System] 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)
Return Return
@@ -1014,7 +916,7 @@ Public Class FormMain
FileDrag(New List(Of String) From {FilePath}) FileDrag(New List(Of String) From {FilePath})
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "无法接取文本拖拽事件", NotifyLevel.DevelopOnly) Logger.Warn(ex, "无法接取文本拖拽事件")
Return Return
End Try End Try
ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then
@@ -1029,26 +931,27 @@ Public Class FormMain
FileDrag(CType(FilePathRaw, IEnumerable(Of String))) FileDrag(CType(FilePathRaw, IEnumerable(Of String)))
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "接取拖拽事件失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "接取拖拽事件失败")
End Try End Try
End Sub End Sub
Private Sub FileDrag(FilePathList As IEnumerable(Of String)) Private Sub FileDrag(FilePathList As IEnumerable(Of String))
RunInNewThread( RunInNewThread(
Sub() Sub()
Dim FilePath As String = FilePathList.First Dim FilePath As String = FilePathList.First
Log("[System] 接受文件拖拽：" & FilePath & If(FilePathList.Any, $" 等 {FilePathList.Count} 个文件", ""), NotifyLevel.DevelopOnly) Logger.Warn($"接受文件拖拽：{FilePath}{If(FilePathList.Any, $" 等 {FilePathList.Count} 个文件", "")}")
'基础检查 '基础检查
If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then If DirectoryUtils.Exists(FilePathList.First) AndAlso Not FileUtils.Exists(FilePathList.First) Then
Hint("请拖入一个文件，而非文件夹！", HintType.Red) Hint("请拖入一个文件，而非文件夹！", HintType.Red)
Return Return
ElseIf Not File.Exists(FilePathList.First) Then ElseIf Not FileUtils.Exists(FilePathList.First) Then
Hint("拖入的文件不存在：" & FilePathList.First, HintType.Red) Hint("拖入的文件不存在：" & FilePathList.First, HintType.Red)
Return Return
End If End If
'多文件拖拽 '多文件拖拽
Dim PathList As List(Of String) = FilePathList.ToList()
If FilePathList.Count > 1 Then If FilePathList.Count > 1 Then
'必须要求全部为 jar 文件 '必须要求全部为 jar 文件
For Each File In FilePathList For Each File In PathList
If Not {"jar", "litemod", "disabled", "old"}.Contains(File.AfterLast(".").Lower) Then If Not {"jar", "litemod", "disabled", "old"}.Contains(File.AfterLast(".").Lower) Then
Hint("一次请只拖入一个文件！", HintType.Red) Hint("一次请只拖入一个文件！", HintType.Red)
Return Return
@@ -1058,13 +961,13 @@ 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
Log("[System] 文件后缀为 XAML，作为主页加载") Logger.Info("文件后缀为 XAML，作为主页加载")
If File.Exists(PathExeFolder & "PCL\Custom.xaml") Then If FileUtils.Exists(PathExeFolder & "PCL\Custom.xaml") Then
If MyMsgBox("已存在一个主页文件，是否要将它覆盖？", "覆盖确认", "覆盖", "取消") = 2 Then If MyMsgBox("已存在一个主页文件，是否要将它覆盖？", "覆盖确认", "覆盖", "取消") = 2 Then
Return Return
End If End If
End If End If
CopyFile(FilePath, PathExeFolder & "PCL\Custom.xaml") FileUtils.Copy(FilePath, PathExeFolder & "PCL\Custom.xaml")
RunInUi( RunInUi(
Sub() Sub()
Settings.Set("UiCustomType", 1) Settings.Set("UiCustomType", 1)
@@ -1074,10 +977,10 @@ Public Class FormMain
Return Return
End If End If
'安装 Mod '安装 Mod
If PageInstanceMod.InstallMods(FilePathList) Then Return If PageInstanceMod.InstallMods(PathList) Then Return
'安装整合包 '安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar，总之试一试 If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar，总之试一试
Log("[System] 文件为压缩包，尝试作为整合包安装") Logger.Info("文件为压缩包，尝试作为整合包安装")
Try Try
ModpackInstall(FilePath) ModpackInstall(FilePath)
Return Return
@@ -1094,7 +997,7 @@ Public Class FormMain
End If End If
'错误报告分析 '错误报告分析
Try Try
Log("[System] 尝试进行错误报告分析") Logger.Info("尝试进行错误报告分析")
Dim Analyzer As New CrashAnalyzer Dim Analyzer As New CrashAnalyzer
Analyzer.Import(FilePath) Analyzer.Import(FilePath)
If Not Analyzer.Prepare() Then Exit Try If Not Analyzer.Prepare() Then Exit Try
@@ -1102,7 +1005,7 @@ Public Class FormMain
Analyzer.Output(True, New List(Of String)) Analyzer.Output(True, New List(Of String))
Return Return
Catch ex As Exception Catch ex As Exception
Log(ex, "自主错误报告分析失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "自主错误报告分析失败")
End Try End Try
'未知操作 '未知操作
Hint("PCL 无法确定应当执行的文件拖拽操作……") Hint("PCL 无法确定应当执行的文件拖拽操作……")
@@ -1115,16 +1018,16 @@ Public Class FormMain
If msg = 30 Then If msg = 30 Then
Dim NowDate = Date.Now Dim NowDate = Date.Now
If NowDate.Date = ApplicationOpenTime.Date Then If NowDate.Date = ApplicationOpenTime.Date Then
Log("[System] 系统时间微调为：" & NowDate.ToLongDateString & " " & NowDate.ToLongTimeString) Logger.Info($"系统时间微调为：{NowDate.ToLongDateString} {NowDate.ToLongTimeString}")
IsSystemTimeChanged = False IsSystemTimeChanged = False
Else Else
Log("[System] 系统时间修改为：" & NowDate.ToLongDateString & " " & NowDate.ToLongTimeString) Logger.Info($"系统时间修改为：{NowDate.ToLongDateString} {NowDate.ToLongTimeString}")
IsSystemTimeChanged = True IsSystemTimeChanged = True
End If End If
ElseIf msg = 400 * 16 + 2 Then ElseIf msg = 400 * 16 + 2 Then
Log("[System] 收到置顶信息：" & hwnd.ToInt64) Logger.Info($"收到置顶信息：{hwnd.ToInt64}")
If Not IsWindowLoadFinished Then If Not IsWindowLoadFinished Then
Log("[System] 窗口尚未加载完成，忽略置顶请求") Logger.Info("窗口尚未加载完成，忽略置顶请求")
Return IntPtr.Zero Return IntPtr.Zero
End If End If
ShowWindowToTop() ShowWindowToTop()
@@ -1147,7 +1050,7 @@ Public Class FormMain
Left -= 10000 Left -= 10000
ShowInTaskbar = False ShowInTaskbar = False
Visibility = Visibility.Hidden Visibility = Visibility.Hidden
Log("[System] 窗口已隐藏，位置：(" & Left & "," & Top & ")") Logger.Info($"窗口已隐藏，位置：({Left},{Top})")
Else Else
'取消隐藏 '取消隐藏
If Left < -2000 Then Left += 10000 If Left < -2000 Then Left += 10000
@@ -1170,7 +1073,7 @@ Public Class FormMain
Topmost = False Topmost = False
SetForegroundWindow(Handle) SetForegroundWindow(Handle)
Focus() Focus()
Log($"[System] 窗口已置顶，位置：({Left}, {Top}), {Width} x {Height}") Logger.Info($"窗口已置顶，位置：({Left}, {Top}), {Width} x {Height}")
End Sub) End Sub)
End Sub End Sub
@@ -1501,9 +1404,9 @@ Public Class FormMain
BtnExtraApril.ShowRefresh() BtnExtraApril.ShowRefresh()
#End Region #End Region
Log("[Control] 切换主要页面：" & GetStringFromEnum(Stack) & ", " & SubType) Logger.Info($"切换主要页面：{Stack}, {SubType}")
Catch ex As Exception Catch ex As Exception
Log(ex, "切换主要页面失败（ID " & PageCurrent.Page & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"切换主要页面失败（ID {PageCurrent.Page}）")
Finally Finally
AniControlEnabled -= 1 AniControlEnabled -= 1
End Try End Try
@@ -1686,7 +1589,7 @@ Public Class FormMain
Next Next
Hint("已关闭运行中的 Minecraft！", HintType.Green) Hint("已关闭运行中的 Minecraft！", HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, "强制关闭所有 Minecraft 失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "强制关闭所有 Minecraft 失败")
End Try End Try
End Sub End Sub
Public Function BtnExtraShutdown_ShowCheck() As Boolean Public Function BtnExtraShutdown_ShowCheck() As Boolean
@@ -1701,7 +1604,7 @@ Public Class FormMain
If RealScroll IsNot Nothing Then If RealScroll IsNot Nothing Then
RealScroll.PerformVerticalOffsetDelta(-RealScroll.VerticalOffset) RealScroll.PerformVerticalOffsetDelta(-RealScroll.VerticalOffset)
Else Else
Log("[UI] 无法返回顶部，未找到合适的 RealScroll", NotifyLevel.AllUsers) Logger.Error("无法返回顶部，未找到合适的 RealScroll", LogBehavior.Toast)
End If End If
End Sub End Sub
Private Function BtnExtraBack_ShowCheck() As Boolean Private Function BtnExtraBack_ShowCheck() As Boolean
Plain Craft Launcher 2/Modules/Base/ModAnimation.vb
+11 -10
View File
@@ -12,7 +12,7 @@ Public Module ModAnimation
''' </summary> ''' </summary>
Public ReadOnly Property AniSpeed As Double Public ReadOnly Property AniSpeed As Double
Get Get
Dim Setting As Integer = Settings.Get("SystemDebugAnim") Dim Setting As Integer = Settings.Get(Of Integer)("SystemDebugAnim")
Return If(Setting >= 30, 200, (Setting * 0.1 + 0.1).Clamp(0.1, 3)) Return If(Setting >= 30, 200, (Setting * 0.1 + 0.1).Clamp(0.1, 3))
End Get End Get
End Property End Property
@@ -114,7 +114,7 @@ Public Module ModAnimation
Public ValueLast As Object Public ValueLast As Object
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Return GetStringFromEnum(TypeMain) & " | " & TimeFinished & "/" & TimeTotal & "(" & Math.Round(TimePercent * 100) & "%)" & If(Obj Is Nothing, "", " | " & Obj.ToString & "(" & Obj.GetType.Name & ")") Return TypeMain.ToString() & " | " & TimeFinished & "/" & TimeTotal & "(" & Math.Round(TimePercent * 100) & "%)" & If(Obj Is Nothing, "", " | " & Obj.ToString & "(" & Obj.GetType.Name & ")")
End Function End Function
End Structure End Structure
@@ -521,13 +521,14 @@ Public Module ModAnimation
''' </summary> ''' </summary>
''' <remarks></remarks> ''' <remarks></remarks>
Public Function AaStack(Stack As StackPanel, Optional Time As Integer = 100, Optional Delay As Integer = 25) As List(Of AniData) Public Function AaStack(Stack As StackPanel, Optional Time As Integer = 100, Optional Delay As Integer = 25) As List(Of AniData)
AaStack = New List(Of AniData) Dim Result = New List(Of AniData)
Dim AniDelay As Integer = 0 Dim AniDelay As Integer = 0
For Each Item In Stack.Children For Each Item In Stack.Children
Item.Opacity = 0 Item.Opacity = 0
AaStack.Add(AaOpacity(Item, 1, Time, AniDelay)) Result.Add(AaOpacity(Item, 1, Time, AniDelay))
AniDelay += Delay AniDelay += Delay
Next Next
Return Result
End Function End Function
#End Region #End Region
@@ -810,7 +811,7 @@ Public Module ModAnimation
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
Log("[Animation] 动画线程开始") Logger.Info("动画线程开始")
Do While True Do While True
'两帧之间的间隔时间 '两帧之间的间隔时间
Dim DeltaTime As Long = (GetTimeMs() - AniLastTick).Clamp(0, 100000) Dim DeltaTime As Long = (GetTimeMs() - AniLastTick).Clamp(0, 100000)
@@ -831,7 +832,7 @@ 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
Log("[Report] FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManager.FileRemain & "（" & FormatFileSize(NetManager.Speed) & "/s）") Logger.Info($"FPS {AniFPS}, 动画 {AniCount}, 下载中 {NetManager.FileRemain}（{FormatFileSize(NetManager.Speed)}/s）")
End If End If
End Sub) End Sub)
Sleeper: Sleeper:
@@ -839,7 +840,7 @@ Sleeper:
Thread.Sleep(1) Thread.Sleep(1)
Loop Loop
Catch ex As Exception Catch ex As Exception
Log(ex, "动画帧执行失败", NotifyLevel.Critical) Logger.Error(ex, "动画帧执行失败", LogBehavior.AlertThenCrash)
End Try End Try
End Sub, "Animation", ThreadPriority.AboveNormal) End Sub, "Animation", ThreadPriority.AboveNormal)
End Sub End Sub
@@ -850,7 +851,7 @@ Sleeper:
Public Sub AniTimer(DeltaTick As Integer) Public Sub AniTimer(DeltaTick As Integer)
Try Try
If DeltaTick / AniSpeed > 100 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", NotifyLevel.DevelopOnly) If DeltaTick / AniSpeed > 100 Then Logger.Info($"两个动画帧间隔 {DeltaTick} ms")
Dim i As Integer = -1 Dim i As Integer = -1
'循环每个动画组 '循环每个动画组
Do While i + 1 < AniGroups.Count Do While i + 1 < AniGroups.Count
@@ -915,7 +916,7 @@ NextAni:
Loop Loop
Catch ex As Exception Catch ex As Exception
Log(ex, "动画刻执行失败", NotifyLevel.AllUsers) Logger.Error(ex, "动画刻执行失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
@@ -1052,7 +1053,7 @@ NextAni:
End Select End Select
Ani.TimePercent = Ani.TimeFinished / Ani.TimeTotal '修改执行百分比 Ani.TimePercent = Ani.TimeFinished / Ani.TimeTotal '修改执行百分比
Catch ex As Exception Catch ex As Exception
Log(ex, "执行动画失败：" & Ani.ToString, NotifyLevel.AllUsers) Logger.Error(ex, $"执行动画失败：{Ani}", LogBehavior.Toast)
End Try End Try
Return Ani Return Ani
End Function End Function
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+150 -1207
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+27 -28
View File
@@ -38,7 +38,7 @@
RealParent = RealParent.Parent RealParent = RealParent.Parent
End While End While
Catch ex As Exception Catch ex As Exception
Log(ex, "获取父加载器失败（" & Name & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"获取父加载器失败（{Name}）")
Return Nothing Return Nothing
End Try End Try
End Get End Get
@@ -88,9 +88,9 @@
Set(value As LoadState) Set(value As LoadState)
If _State = value Then Return If _State = value Then Return
Dim OldState = _State Dim OldState = _State
If value = LoadState.Finished AndAlso Settings.Get("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
If Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载器 {Name} 状态改变：{GetStringFromEnum(value)}") If Not LogBlackList.Contains(Name) Then Logger.Info($"加载器 {Name} 状态改变：{value}")
'实现 ILoadingTrigger 接口与 OnStateChanged 回调 '实现 ILoadingTrigger 接口与 OnStateChanged 回调
RunInUi( RunInUi(
Sub() Sub()
@@ -229,13 +229,13 @@
''' <summary> ''' <summary>
''' 用于异步执行并监控单一函数的加载器。 ''' 用于异步执行并监控单一函数的加载器。
''' </summary> ''' </summary>
Public Class LoaderTask(Of InputType, OutputType) Public Class LoaderTask(Of TIn, TOut)
Inherits LoaderBase Inherits LoaderBase
'线程设定 '线程设定
Protected Friend ThreadPriority As ThreadPriority Protected Friend ThreadPriority As ThreadPriority
'执行事件 '执行事件
Protected Friend LoadDelegate As Action(Of LoaderTask(Of InputType, OutputType)) Protected Friend LoadDelegate As Action(Of LoaderTask(Of TIn, TOut))
Protected Friend InputDelegate As Func(Of Object) Protected Friend InputDelegate As Func(Of Object)
'状态指示 '状态指示
''' <summary> ''' <summary>
@@ -265,25 +265,25 @@
''' </summary> ''' </summary>
Public LastRunningThread As Thread = Nothing Public LastRunningThread As Thread = Nothing
'输入输出 '输入输出
Public Input As InputType = Nothing Public Input As TIn = Nothing
Public Output As OutputType = Nothing Public Output As TOut = Nothing
'获取输入 '获取输入
Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType 'InputDelegate 参数存在匿名调用 Public Function StartGetInput(Optional Input As TIn = Nothing, Optional InputDelegate As Func(Of TIn) = Nothing) As TIn 'InputDelegate 参数存在匿名调用
If InputDelegate Is Nothing Then InputDelegate = Me.InputDelegate If InputDelegate Is Nothing Then InputDelegate = Me.InputDelegate
Dim NewInput As InputType = Nothing '若 InputType 不能为 Nothing，则会导致 Input Is Nothing 永远失败，因此需要额外判断 Dim NewInput As TIn = Nothing '若 InputType 不能为 Nothing，则会导致 Input Is Nothing 永远失败，因此需要额外判断
If (Input Is Nothing OrElse (NewInput IsNot Nothing AndAlso Input.Equals(NewInput))) AndAlso InputDelegate IsNot Nothing Then If (Input Is Nothing OrElse (NewInput IsNot Nothing AndAlso Input.Equals(NewInput))) AndAlso InputDelegate IsNot Nothing Then
RunInUiWait(Sub() Input = InputDelegate()) RunInUiWait(Sub() Input = InputDelegate())
End If End If
Return Input Return Input
End Function End Function
'代码执行 '代码执行
Public Function ShouldStart(ByRef Input As Object, Optional IsForceRestart As Boolean = False, Optional IgnoreReloadTimeout As Boolean = False) As Boolean Public Function ShouldStart(ByRef Input As TIn, Optional IsForceRestart As Boolean = False, Optional IgnoreReloadTimeout As Boolean = False) As Boolean
'获取输入 '获取输入
Try Try
Input = StartGetInput(Input) Input = StartGetInput(Input)
Catch ex As Exception Catch ex As Exception
Log(ex, "加载输入获取失败（" & Name & "）", NotifyLevel.AllUsers) Logger.Error(ex, $"加载输入获取失败（{Name}）", LogBehavior.Toast)
[Error] = ex [Error] = ex
SyncLock LockState SyncLock LockState
State = LoadState.Failed State = LoadState.Failed
@@ -319,21 +319,21 @@
Sub() Sub()
Try Try
IsForceRestarting = IsForceRestart IsForceRestarting = IsForceRestart
If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动") If Not LogBlackList.Contains(Name) Then Logger.Trace(Function() $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
LoadDelegate(Me) LoadDelegate(Me)
If IsInterrupted Then If IsInterrupted Then
Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束，输出被弃用（最新线程：{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)}）", NotifyLevel.DevelopOnly) Logger.Warn($"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束，输出被弃用（最新线程：{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)}）")
Return Return
End If End If
If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成") If Not LogBlackList.Contains(Name) Then Logger.Trace(Function() $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
RaisePreviewFinish() RaisePreviewFinish()
State = LoadState.Finished State = LoadState.Finished
LastFinishedTime = GetTimeMs() '未中断，本次输出有效 LastFinishedTime = GetTimeMs() '未中断，本次输出有效
Catch ex As CancelledException Catch ex As CancelledException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断，已完成 {Math.Round(Progress * 100)}%") Logger.Trace(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断，已完成 {Math.Round(Progress * 100)}%")
If Not IsInterrupted Then State = LoadState.Interrupted If Not IsInterrupted Then State = LoadState.Interrupted
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断，已完成 {Math.Round(Progress * 100)}%") Logger.Trace(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断，已完成 {Math.Round(Progress * 100)}%")
'如果线程是因为判断到 IsInterrupted 而提前中止，则代表已有新线程被重启，此时不应当改为 Interrupted '如果线程是因为判断到 IsInterrupted 而提前中止，则代表已有新线程被重启，此时不应当改为 Interrupted
'如果线程是在没有 IsInterrupted 时手动引发了 ThreadInterruptedException，则代表没有重启线程，这通常代表用户手动取消，应当改为 Interrupted '如果线程是在没有 IsInterrupted 时手动引发了 ThreadInterruptedException，则代表没有重启线程，这通常代表用户手动取消，应当改为 Interrupted
If Not IsInterrupted Then State = LoadState.Interrupted If Not IsInterrupted Then State = LoadState.Interrupted
@@ -354,7 +354,7 @@
If IsInterrupted OrElse State >= LoadState.Finished Then Return If IsInterrupted OrElse State >= LoadState.Finished Then Return
State = LoadState.Failed State = LoadState.Failed
End SyncLock End SyncLock
Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错，已完成 {Math.Round(Progress * 100)}%", NotifyLevel.DevelopOnly) Logger.Warn(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错，已完成 {Math.Round(Progress * 100)}%")
TriggerThreadInterrupt() TriggerThreadInterrupt()
End Sub End Sub
Public Overrides Sub Interrupt() Public Overrides Sub Interrupt()
@@ -368,7 +368,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()
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断") Logger.Trace(Function() $"加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
End If End If
LastRunningThread = Nothing LastRunningThread = Nothing
End Sub End Sub
@@ -376,7 +376,7 @@
Public Sub New() Public Sub New()
'仅仅是为了避免一些智障报错（继承类必须重写 New 的情况） '仅仅是为了避免一些智障报错（继承类必须重写 New 的情况）
End Sub End Sub
Public Sub New(Name As String, LoadDelegate As Action(Of LoaderTask(Of InputType, OutputType)), Optional InputDelegate As Func(Of InputType) = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal) Public Sub New(Name As String, LoadDelegate As Action(Of LoaderTask(Of TIn, TOut)), Optional InputDelegate As Func(Of TIn) = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal)
Me.Name = Name Me.Name = Name
Me.LoadDelegate = LoadDelegate Me.LoadDelegate = LoadDelegate
Me.InputDelegate = InputDelegate Me.InputDelegate = InputDelegate
@@ -515,7 +515,7 @@
'检查是否需要重启 '检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型，必须用 StartsWith If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型，必须用 StartsWith
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
Log("[Loader] 由于输入条件变更，重启已完成的加载器 " & Loader.Name) Logger.Info($"由于输入条件变更，重启已完成的加载器 {Loader.Name}")
GoTo Restart GoTo Restart
End If End If
'更新下一个加载器的输入 '更新下一个加载器的输入
@@ -527,7 +527,7 @@
'检查是否需要重启 '检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then If Loader.GetType.Name.StartsWithF("LoaderTask") 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
Log("[Loader] 由于输入条件变更，重启进行中的加载器 " & Loader.Name, NotifyLevel.DevelopOnly) Logger.Warn($"由于输入条件变更，重启进行中的加载器 {Loader.Name}")
GoTo Restart GoTo Restart
End If End If
End If End If
@@ -598,7 +598,7 @@ Restart:
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T)) Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader) If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
LoaderTaskbar.Add(Loader) LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表") Logger.Info($"{Loader.Name} 已加入任务列表")
End Sub End Sub
Public Sub LoaderTaskbarProgressRefresh() Public Sub LoaderTaskbarProgressRefresh()
Try Try
@@ -610,7 +610,7 @@ Restart:
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Interrupted) Then (Task.State = LoadState.Waiting OrElse Task.State = LoadState.Interrupted) Then
FrmSpeedLeft?.TaskRefresh(Task) FrmSpeedLeft?.TaskRefresh(Task)
LoaderTaskbar.Remove(Task) LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表") Logger.Info($"{Task.Name} 已移出任务列表")
End If End If
Next Next
'更新平滑后的进度 '更新平滑后的进度
@@ -635,7 +635,7 @@ Restart:
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新任务栏进度显示失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "刷新任务栏进度显示失败")
End Try End Try
End Sub End Sub
Public Function LoaderTaskbarProgressGet() As Double Public Function LoaderTaskbarProgressGet() As Double
@@ -643,7 +643,7 @@ Restart:
If Not LoaderTaskbar.Any Then Return 1 If Not LoaderTaskbar.Any Then Return 1
Return LoaderTaskbar.Select(Function(l) l.Progress).Average().Clamp(0, 1) Return LoaderTaskbar.Select(Function(l) l.Progress).Average().Clamp(0, 1)
Catch ex As Exception Catch ex As Exception
Log(ex, "获取任务栏进度出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "获取任务栏进度出错")
Return 0.5 Return 0.5
End Try End Try
End Function End Function
@@ -671,11 +671,10 @@ Restart:
''' </summary> ''' </summary>
''' <param name="ExtraPath">用于检查文件夹修改的额外路径。该路径不会传入加载器。</param> ''' <param name="ExtraPath">用于检查文件夹修改的额外路径。该路径不会传入加载器。</param>
Public Function LoaderFolderRun(Loader As LoaderBase, FolderPath As String, Type As LoaderFolderRunType, Optional MaxDepth As Integer = 0, Optional ExtraPath As String = "", Optional WaitForExit As Boolean = False) As Boolean Public Function LoaderFolderRun(Loader As LoaderBase, FolderPath As String, Type As LoaderFolderRunType, Optional MaxDepth As Integer = 0, Optional ExtraPath As String = "", Optional WaitForExit As Boolean = False) As Boolean
Dim FolderInfo As DirectoryInfo
Dim Value As New LoaderFolderDictionaryEntry With {.FolderPath = FolderPath & ExtraPath, .LastCheckTime = Nothing} Dim Value As New LoaderFolderDictionaryEntry With {.FolderPath = FolderPath & ExtraPath, .LastCheckTime = Nothing}
Try Try
'获取数据 '获取数据
FolderInfo = New DirectoryInfo(FolderPath & ExtraPath) Dim FolderInfo = DirectoryUtils.GetInfo(FolderPath & ExtraPath)
Value.LastCheckTime = If(FolderInfo.Exists, GetActualLastWriteTimeUtc(FolderInfo, MaxDepth), DirectCast(Nothing, Date?)) Value.LastCheckTime = If(FolderInfo.Exists, GetActualLastWriteTimeUtc(FolderInfo, MaxDepth), DirectCast(Nothing, Date?))
'如果已经检查过，则跳过 '如果已经检查过，则跳过
If Type = LoaderFolderRunType.RunOnUpdated AndAlso LoaderFolderDictionary.ContainsKey(Loader) Then If Type = LoaderFolderRunType.RunOnUpdated AndAlso LoaderFolderDictionary.ContainsKey(Loader) Then
@@ -687,7 +686,7 @@ Restart:
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "文件夹加载器启动检测出错") Logger.Warn(ex, "文件夹加载器启动检测出错")
End Try End Try
'写入检查数据 '写入检查数据
LoaderFolderDictionary(Loader) = Value LoaderFolderDictionary(Loader) = Value
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+113 -179
View File
@@ -1,5 +1,4 @@
Imports System.Net.Sockets Imports System.Net.Sockets
Imports System.Runtime.CompilerServices
Imports System.Threading.Tasks Imports System.Threading.Tasks
Public Module ModNet Public Module ModNet
@@ -14,12 +13,12 @@ Public Module ModNet
Optional Timeout As Integer = 25000, Optional Headers As String(,) = Nothing, Optional RequireJson As Boolean = False, Optional Timeout As Integer = 25000, Optional Headers As String(,) = Nothing, Optional RequireJson As Boolean = False,
Optional Encoding As Encoding = Nothing, Optional SimulateBrowserHeaders As Boolean = False, Optional MakeLog As Boolean = True) As String Optional Encoding As Encoding = Nothing, Optional SimulateBrowserHeaders As Boolean = False, Optional MakeLog As Boolean = True) As String
If Method Is Nothing Then Method = HttpMethod.Get If Method Is Nothing Then Method = HttpMethod.Get
If MakeLog Then Log("[Net] 发起网络请求（" & Method.Method & "，" & Url & "），最大超时 " & Timeout) If MakeLog Then Logger.Info($"发起网络请求（{Method.Method}，{Url}），最大超时 {Timeout}")
Try Try
Dim HeaderDictionary = If(Headers, {}).ToDictionary Dim HeaderDictionary = If(Headers, {}).ToDictionary
If ContentType IsNot Nothing Then HeaderDictionary("Content-Type") = ContentType If ContentType IsNot Nothing Then HeaderDictionary("Content-Type") = ContentType
If Accept IsNot Nothing Then HeaderDictionary("Accept") = Accept If Accept IsNot Nothing Then HeaderDictionary("Accept") = Accept
Dim Result = If(Encoding, Encoding.UTF8).GetString(SendRequest(Url, Method, Content, HeaderDictionary, Timeout:=Timeout, Encoding:=Encoding, SimulateBrowserHeaders:=SimulateBrowserHeaders)) Dim Result = SendRequest(Url, Method, Content, HeaderDictionary, Timeout:=Timeout, Encoding:=Encoding, SimulateBrowserHeaders:=SimulateBrowserHeaders).GetString(Encoding)
'检查结果是否为完整 JSON（在 #6683 中可能返回空，在被 GFW 截断时可能不完整） '检查结果是否为完整 JSON（在 #6683 中可能返回空，在被 GFW 截断时可能不完整）
'在此处检查并报错，可以让 NetRequestByClientRetry 等方法进行重试 '在此处检查并报错，可以让 NetRequestByClientRetry 等方法进行重试
If RequireJson Then If RequireJson Then
@@ -36,7 +35,7 @@ Public Module ModNet
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As Exception Catch ex As Exception
If MakeLog Then Log(ex, "网络请求失败", NotifyLevel.DevelopOnly) If MakeLog Then Logger.Warn(ex, "网络请求失败")
Throw Throw
End Try End Try
End Function End Function
@@ -72,9 +71,10 @@ Retry:
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As Exception Catch ex As Exception
If TypeOf ex Is ResponsedWebException Then If TypeOf ex Is HttpRequestCodeException Then
If CType(ex, ResponsedWebException).StatusCode = HttpStatusCode.Forbidden Then Throw If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.Forbidden Then Throw
If CType(ex, ResponsedWebException).StatusCode = 429 Then Thread.Sleep(10000) 'Too Many Requests If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.NotFound Then Throw
If CType(ex, HttpRequestCodeException).StatusCode = 429 Then Thread.Sleep(10000) 'Too Many Requests
End If End If
'重试 '重试
Select Case RetryCount Select Case RetryCount
@@ -157,8 +157,9 @@ RequestFinished:
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, SimulateBrowserHeaders)}) Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, SimulateBrowserHeaders)})
Try Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls.First & "）") NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls.First & "）")
NetRequestByLoader = ReadFile(Temp) Dim Result = FileUtils.ReadAsString(Temp)
File.Delete(Temp) FileUtils.Delete(Temp)
Return Result
Finally Finally
NewTask.Interrupt() NewTask.Interrupt()
End Try End Try
@@ -173,29 +174,21 @@ RequestFinished:
''' 不建议用于下载大文件。 ''' 不建议用于下载大文件。
''' </summary> ''' </summary>
Public Sub NetDownloadByClient(Url As String, LocalPath As String, Optional SimulateBrowserHeaders As Boolean = False) Public Sub NetDownloadByClient(Url As String, LocalPath As String, Optional SimulateBrowserHeaders As Boolean = False)
Log($"[Net] 通过网络请求直接下载小文件：{Url} → {LocalPath}") Logger.Info($"通过网络请求直接下载小文件：{Url} → {LocalPath}")
'初始化文件路径
Try
DirectoryUtils.Create(LocalPath, isFilePath:=True)
File.Delete(LocalPath)
Catch ex As Exception
Throw New Exception($"预处理下载文件路径失败（{LocalPath}）", ex)
End Try
'下载
Dim RetryCount As Integer = 0 Dim RetryCount As Integer = 0
Retry: Retry:
Try Try
File.WriteAllBytes(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders)) FileUtils.Write(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders))
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
File.Delete(LocalPath) FileUtils.Delete(LocalPath)
Throw Throw
Catch ex As Exception Catch ex As Exception
File.Delete(LocalPath) FileUtils.Delete(LocalPath)
If RetryCount < 2 Then If RetryCount < 2 Then
RetryCount += 1 RetryCount += 1
GoTo Retry GoTo Retry
End If End If
Throw New WebException($"通过网络请求直接下载小文件失败（{LocalPath}）", ex) Throw New HttpRequestException($"通过网络请求直接下载小文件失败（{LocalPath}）", ex)
End Try End Try
End Sub End Sub
@@ -259,6 +252,7 @@ Retry:
HostIp = DNSLookup(Request, CancelToken.Token) HostIp = DNSLookup(Request, CancelToken.Token)
If HostIp IsNot Nothing Then IPReliability.GetOrAdd(HostIp, -0.01) '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率 If HostIp IsNot Nothing Then IPReliability.GetOrAdd(HostIp, -0.01) '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率
'发送请求 '发送请求
Directory.CreateDirectory(PathTemp & "Cache\Http\")
SyncLock RequestClientLock SyncLock RequestClientLock
If RequestClient Is Nothing Then '延迟初始化，以避免在程序启动前加载 CacheCow 导致 DLL 加载失败 If RequestClient Is Nothing Then '延迟初始化，以避免在程序启动前加载 CacheCow 导致 DLL 加载失败
RequestClient = CacheCow.Client.ClientExtensions.CreateClient(New CacheCow.Client.FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With { RequestClient = CacheCow.Client.ClientExtensions.CreateClient(New CacheCow.Client.FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With {
@@ -283,14 +277,14 @@ Retry:
Return ResponseBytes Return ResponseBytes
Else Else
RecordIPReliability(HostIp, -0.7) RecordIPReliability(HostIp, -0.7)
Dim ResponseMessage = If(Encoding, Encoding.UTF8).GetString(ResponseBytes) Dim ResponseMessage = ResponseBytes.GetString(Encoding)
Throw New ResponsedWebException( 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 Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As ResponsedWebException Catch ex As HttpRequestException
Throw Throw
Catch ex As FileNotFoundException Catch ex As FileNotFoundException
'由于 CacheCow 读取缓存失败，然后系统调用不存在的 System.Net.Http.Formatting.resources 抛出（#8150） '由于 CacheCow 读取缓存失败，然后系统调用不存在的 System.Net.Http.Formatting.resources 抛出（#8150）
@@ -299,7 +293,7 @@ Retry:
RecordIPReliability(HostIp, -1) RecordIPReliability(HostIp, -1)
If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then 'CancellationToken 超时 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.IsNetworkRelated Then ElseIf 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)
@@ -337,12 +331,12 @@ Retry:
If WaitHandle.WaitAny(New WaitHandle() {AsyncResult.AsyncWaitHandle, CancelToken.WaitHandle}) Then Throw New TimeoutException("DNS 解析超时") If WaitHandle.WaitAny(New WaitHandle() {AsyncResult.AsyncWaitHandle, CancelToken.WaitHandle}) Then Throw New TimeoutException("DNS 解析超时")
Candidates = Dns.EndGetHostAddresses(AsyncResult).Distinct.ToArray Candidates = Dns.EndGetHostAddresses(AsyncResult).Distinct.ToArray
Catch ex As Exception Catch ex As Exception
Log(ex, $"DNS 解析失败（{Host}）") Logger.Warn(ex, $"DNS 解析失败（{Host}）")
DNSFailureRecord(Host) = Date.Now DNSFailureRecord(Host) = Date.Now
Return Nothing Return Nothing
End Try End Try
If Not Candidates.Any Then If Not Candidates.Any Then
Log($"[Net] DNS 解析无结果（{Host}）") Logger.Info($"DNS 解析无结果（{Host}）")
Return Nothing Return Nothing
End If End If
'若同时存在 IPv4 和 IPv6 地址，仅选择其中一类（因为 GFW 可能只屏蔽了 IPv4 或 IPv6） '若同时存在 IPv4 和 IPv6 地址，仅选择其中一类（因为 GFW 可能只屏蔽了 IPv4 或 IPv6）
@@ -353,7 +347,7 @@ Retry:
Dim IPv4Reliability = IPv4Targets.Max(Function(i) Reliabilities(i)) Dim IPv4Reliability = IPv4Targets.Max(Function(i) Reliabilities(i))
Dim IPv6Reliability = IPv6Targets.Max(Function(i) Reliabilities(i)) Dim IPv6Reliability = IPv6Targets.Max(Function(i) Reliabilities(i))
If Host = "api.modrinth.com" Then IPv6Reliability -= 0.1 '让 Modrinth 优先使用 IPv4 地址（#6887） If Host = "api.modrinth.com" Then IPv6Reliability -= 0.1 '让 Modrinth 优先使用 IPv4 地址（#6887）
If ModeDebug Then Log($"[Net] DNS IPv4/IPv6 选择（{Host}），IPv4 {IPv4Reliability:0.000}，IPv6 {IPv6Reliability:0.000}") Logger.Trace(Function() $"DNS IPv4/IPv6 选择（{Host}），IPv4 {IPv4Reliability:0.000}，IPv6 {IPv6Reliability:0.000}")
Candidates = If(IPv4Reliability >= IPv6Reliability, IPv4Targets, IPv6Targets) Candidates = If(IPv4Reliability >= IPv6Reliability, IPv4Targets, IPv6Targets)
End If End If
'选择可靠度最高的 IP '选择可靠度最高的 IP
@@ -379,27 +373,6 @@ Retry:
) )
End Sub End Sub
''' <summary>
''' 当 HTTP 状态码不指示成功时引发的异常。
''' 附带额外属性，可用于获取远程服务器给予的回复以及 HTTP 状态码。
''' </summary>
Public Class ResponsedWebException
Inherits WebException
''' <summary>
''' HTTP 状态码。
''' </summary>
Public StatusCode As HttpStatusCode
''' <summary>
''' 远程服务器给予的回复。
''' </summary>
Public Overloads Property Response As String
Public Sub New(Message As String, StatusCode As HttpStatusCode, Response As String)
MyBase.New(Message)
Me.StatusCode = StatusCode
Me.Response = Response
End Sub
End Class
#End Region #End Region
#Region "多线程下载引擎" #Region "多线程下载引擎"
@@ -413,7 +386,7 @@ Retry:
''' </summary> ''' </summary>
Public ReadOnly Property NetTaskThreadLimit As Integer Public ReadOnly Property NetTaskThreadLimit As Integer
Get Get
Return Settings.Get("ToolDownloadThread") + 1 Return Settings.Get(Of Integer)("ToolDownloadThread") + 1
End Get End Get
End Property End Property
''' <summary> ''' <summary>
@@ -426,7 +399,7 @@ Retry:
Public ReadOnly Property NetTaskSpeedLimitHigh As Long Public ReadOnly Property NetTaskSpeedLimitHigh As Long
Get Get
If _NetTaskSpeedLimitHigh Is Nothing Then If _NetTaskSpeedLimitHigh Is Nothing Then
Dim Setting As Integer = Settings.Get("ToolDownloadSpeed") Dim Setting As Integer = Settings.Get(Of Integer)("ToolDownloadSpeed")
If Setting <= 14 Then If Setting <= 14 Then
_NetTaskSpeedLimitHigh = (Setting + 1) * 0.1 * 1024 * 1024L _NetTaskSpeedLimitHigh = (Setting + 1) * 0.1 * 1024 * 1024L
ElseIf Setting <= 31 Then ElseIf Setting <= 31 Then
@@ -822,7 +795,7 @@ Retry:
Private _Speed As Long = 0 Private _Speed As Long = 0
''' <summary> ''' <summary>
''' 该文件是否由本地文件直接拷贝完成。 ''' 该文件是否由本地文件直接复制完成。
''' </summary> ''' </summary>
Public IsCopy As Boolean = False Public IsCopy As Boolean = False
''' <summary> ''' <summary>
@@ -901,7 +874,7 @@ Retry:
Me.LocalPath = LocalPath Me.LocalPath = LocalPath
Me.Check = Checker Me.Check = Checker
Me.SimulateBrowserHeaders = SimulateBrowserHeaders Me.SimulateBrowserHeaders = SimulateBrowserHeaders
Me.LocalName = GetFileNameFromPath(LocalPath) Me.LocalName = PathUtils.GetLastPart(LocalPath)
End Sub End Sub
''' <summary> ''' <summary>
@@ -1003,7 +976,7 @@ StartThread:
''' 每个下载线程执行的代码。 ''' 每个下载线程执行的代码。
''' </summary> ''' </summary>
Private Sub Thread(Th As NetThread) Private Sub Thread(Th As NetThread)
If ModeDebug OrElse Th.DownloadStart = 0 Then Log($"[Download] {LocalName}：开始，起始点 {Th.DownloadStart}，{Th.Source.Url}") Logger.Log($"{LocalName}：开始，起始点 {Th.DownloadStart}，{Th.Source.Url}", If(Th.DownloadStart = 0, LogLevel.Info, LogLevel.Trace))
Dim ResultStream As Stream = Nothing, HttpRequest As HttpRequestMessage = Nothing, Dim ResultStream As Stream = Nothing, HttpRequest As HttpRequestMessage = Nothing,
Response As HttpResponseMessage = Nothing, ResponseStream As Stream = Nothing, Response As HttpResponseMessage = Nothing, ResponseStream As Stream = Nothing,
CancelToken As CancellationTokenSource = Nothing, HostIp As String = Nothing CancelToken As CancellationTokenSource = Nothing, HostIp As String = Nothing
@@ -1021,22 +994,24 @@ StartThread:
If Not Th.IsFirstThread Then HttpRequest.Headers.Range = New Headers.RangeHeaderValue(Th.DownloadStart, Nothing) If Not Th.IsFirstThread Then HttpRequest.Headers.Range = New Headers.RangeHeaderValue(Th.DownloadStart, Nothing)
Dim ContentLength As Long = 0 Dim ContentLength As Long = 0
Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout) Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
If Not Response.IsSuccessStatusCode Then Throw New Exception($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Th.Source.Url}") '状态码检查 If Not Response.IsSuccessStatusCode Then '状态码检查
Throw New HttpRequestCodeException($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Th.Source.Url}", Response.StatusCode, Nothing)
End If
If State = NetState.Interrupted Then GoTo SourceBreak '快速中断 If State = NetState.Interrupted Then GoTo SourceBreak '快速中断
If ModeDebug AndAlso Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Log($"[Download] {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)
If ContentLength < 0 Then If ContentLength < 0 Then
If FileSize > 1 Then If FileSize > 1 Then
If Th.DownloadStart = 0 Then If Th.DownloadStart = 0 Then
Log($"[Download] {LocalName}：文件大小未知，但已从其他下载源获取，不作处理") Logger.Info($"{LocalName}：文件大小未知，但已从其他下载源获取，不作处理")
Else Else
Log($"[Download] {LocalName}：ContentLength 返回了 {ContentLength}，无法确定是否支持分段下载，视作不支持") Logger.Info($"{LocalName}：ContentLength 返回了 {ContentLength}，无法确定是否支持分段下载，视作不支持")
GoTo NotSupportRange GoTo NotSupportRange
End If End If
Else Else
FileSize = -1 : IsUnknownSize = True FileSize = -1 : IsUnknownSize = True
Log($"[Download] {LocalName}：文件大小未知") Logger.Info($"{LocalName}：文件大小未知")
End If End If
ElseIf Th.IsFirstThread Then ElseIf Th.IsFirstThread Then
If Check IsNot Nothing Then If Check IsNot Nothing Then
@@ -1048,7 +1023,7 @@ StartThread:
End If End If
End If End If
FileSize = ContentLength : IsUnknownSize = False FileSize = ContentLength : IsUnknownSize = False
Log($"[Download] {LocalName}：文件大小 {ContentLength}（{FormatFileSize(ContentLength)}）") Logger.Info($"{LocalName}：文件大小 {ContentLength}（{FormatFileSize(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
@@ -1084,17 +1059,16 @@ NotSupportRange:
ResultStream = Cache ResultStream = Cache
Else Else
Th.Temp = $"{PathTemp}Download\{Uuid}_{Th.Uuid}_{RandomInteger(0, 999999)}.tmp" Th.Temp = $"{PathTemp}Download\{Uuid}_{Th.Uuid}_{RandomInteger(0, 999999)}.tmp"
DirectoryUtils.Create(Th.Temp, isFilePath:=True) ResultStream = FileUtils.CreateAsStream(Th.Temp)
ResultStream = New FileStream(Th.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
End If End If
'开始下载 '开始下载
CancelToken.Dispose() : CancelToken = New CancellationTokenSource() '重置超时，不再让 CancellationToken 在固定时间后触发（#8488） CancelToken.Dispose() : CancelToken = New CancellationTokenSource() '重置超时，不再让 CancellationToken 在固定时间后触发（#8488）
ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult() ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult()
If Settings.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000)) If Settings.Get(Of Boolean)("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000))
Dim ResponseBytes As Byte() = New Byte(16384) {} Dim ResponseBytes As Byte() = New Byte(16384) {}
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout) HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成 While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merging AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th) HttpDataCount > 0 AndAlso Not IsProgramEnding AndAlso State < NetState.Merging AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th)
'限速 '限速
While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0 While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0
Threading.Thread.Sleep(16) Threading.Thread.Sleep(16)
@@ -1140,19 +1114,22 @@ 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.Interrupted OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
'被外部中断 '被外部中断
Th.State = NetState.Interrupted Th.State = NetState.Interrupted
Log($"[Download] {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
'服务器无返回数据 '服务器无返回数据
Throw New Exception($"返回的 ContentLength 过多：ContentLength 为 {ContentLength}，但获取到的总数据量仅为 {Th.DownloadDone}（全文件总数据量 {DownloadDone}）") Throw New Exception($"返回的 ContentLength 过多：ContentLength 为 {ContentLength}，但获取到的总数据量仅为 {Th.DownloadDone}（全文件总数据量 {DownloadDone}）")
Else Else
'本线程完成 '本线程完成
Th.State = NetState.Finished Th.State = NetState.Finished
If ModeDebug Then Log($"[Download] {LocalName}：完成，已下载 {Th.DownloadDone}（{Th.DownloadStart}~{Th.DownloadEnd}）") Logger.Trace(Function() $"{LocalName}：完成，已下载 {Th.DownloadDone}（{Th.DownloadStart}~{Th.DownloadEnd}）")
RecordIPReliability(HostIp, 0.5) RecordIPReliability(HostIp, 0.5)
End If End If
Catch ex As Exception Catch ex As Exception
Log($"[Download] {LocalName}：出错，{If(TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException, If ex.IsBadNetwork OrElse TypeOf ex Is TaskCanceledException Then
$"已超时（{Timeout}ms）", ex.GetDetail())}，IP：{HostIp}") Logger.Info(New TimeoutException($"{LocalName}：超时（{Timeout}ms），{ex.Message}，IP：{If(String.IsNullOrEmpty(HostIp), "自动", "")}"))
Else
Logger.Info(ex, $"{LocalName}：出错，IP：{HostIp}")
End If
RecordIPReliability(HostIp, -0.7) RecordIPReliability(HostIp, -0.7)
SourceFail(Th, ex, False) SourceFail(Th, ex, False)
Finally Finally
@@ -1194,9 +1171,8 @@ SourceBreak:
End SyncLock End SyncLock
'……后续处理 '……后续处理
If IsThisFail Then If IsThisFail Then
Log($"[Download] {LocalName}：下载源被禁用（{Th.Source.Id}，Range 问题：{IsRangeNotSupported}）：{Th.Source.Url}") Logger.Info($"{LocalName}：下载源被禁用（{Th.Source.Id}，Range 问题：{IsRangeNotSupported}）：{Th.Source.Url}")
Log(ex, $"{If(SourcesOnce.FirstOrDefault?.SingleThread Is Nothing, "", "单线程")}下载源 {Th.Source.Id} 已被禁用", Logger.Warn(ex, $"{If(SourcesOnce.FirstOrDefault?.SingleThread Is Nothing, "", "单线程")}下载源 {Th.Source.Id} 已被禁用")
If(IsRangeNotSupported OrElse ex.Message.Contains("(404)"), NotifyLevel.DevelopOnly, NotifyLevel.DebugModeOnly))
SyncLock LockSource SyncLock LockSource
SourcesOnce.Remove(Th.Source) SourcesOnce.Remove(Th.Source)
End SyncLock End SyncLock
@@ -1208,7 +1184,7 @@ SourceBreak:
ElseIf Not Retried Then ElseIf Not Retried Then
'合并失败或首次下载失败，未重试：将所有下载源重新标记为不允许断点续传的下载源，逐个重新尝试下载 '合并失败或首次下载失败，未重试：将所有下载源重新标记为不允许断点续传的下载源，逐个重新尝试下载
'若所有源均不支持 Range，也会走到这里重试 '若所有源均不支持 Range，也会走到这里重试
If Not IsRangeNotSupported Then Log($"[Download] {LocalName}：文件下载失败，正在自动重试……", NotifyLevel.DebugModeOnly) If Not IsRangeNotSupported Then Logger.Warn($"{LocalName}：文件下载失败，正在自动重试……")
Retried = True Retried = True
SyncLock LockSource SyncLock LockSource
SourcesOnce.Clear() SourcesOnce.Clear()
@@ -1229,14 +1205,14 @@ SourceBreak:
End SyncLock End SyncLock
Else Else
'失败 '失败
Log($"[Download] {LocalName}：已无可用下载源，下载失败") Logger.Info($"{LocalName}：已无可用下载源，下载失败")
Dim ExampleEx As Exception = Nothing Dim ExampleEx As Exception = Nothing
SyncLock LockSource SyncLock LockSource
For Each Source As NetSource In Sources For Each Source As NetSource In Sources
Log("[Download] 已禁用的下载源：" & Source.Url) Logger.Info($"已禁用的下载源：{Source.Url}")
If Source.Ex IsNot Nothing Then If Source.Ex IsNot Nothing Then
ExampleEx = Source.Ex ExampleEx = Source.Ex
Log(Source.Ex, "下载源禁用原因", NotifyLevel.DevelopOnly) Logger.Warn(Source.Ex, "下载源禁用原因")
End If End If
Next Next
End SyncLock End SyncLock
@@ -1276,26 +1252,26 @@ SourceBreak:
Try Try
Retry: Retry:
'创建文件夹 '创建文件夹
DirectoryUtils.Create(LocalPath, isFilePath:=True) DirectoryUtils.Create(PathUtils.RemoveLastPart(LocalPath))
If File.Exists(LocalPath) Then File.Delete(LocalPath) FileUtils.Delete(LocalPath)
SyncLock LockChain SyncLock LockChain
'合并文件 '合并文件
If IsNoSplit Then If IsNoSplit Then
'仅有一个线程，从内存中输出 '仅有一个线程，从内存中输出
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，从内存输出文件") Logger.Trace(Function() $"{LocalName}：下载结束，从内存输出文件")
FileUtils.Write(LocalPath, Cache) FileUtils.Write(LocalPath, Cache)
ElseIf Threads.DownloadDone = DownloadDone AndAlso Threads.Temp IsNot Nothing Then ElseIf Threads.DownloadDone = DownloadDone AndAlso Threads.Temp IsNot Nothing Then
'仅有一个文件，直接复制 '仅有一个文件，直接复制
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，仅有一个文件，无需合并") Logger.Trace(Function() $"{LocalName}：下载结束，仅有一个文件，无需合并")
CopyFile(Threads.Temp, LocalPath) FileUtils.Copy(Threads.Temp, LocalPath)
Else Else
'有多个线程，合并 '有多个线程，合并
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，开始合并文件") Logger.Trace(Function() $"{LocalName}：下载结束，开始合并文件")
Using MergeFile As New FileStream(LocalPath, FileMode.Create) Using MergeFile = FileUtils.CreateAsStream(LocalPath)
Using AddWriter As New BinaryWriter(MergeFile) Using AddWriter As New BinaryWriter(MergeFile)
For Each Thread As NetThread In Threads For Each Thread As NetThread In Threads
If Thread.DownloadDone = 0 OrElse Thread.Temp Is Nothing Then Continue For If Thread.DownloadDone = 0 OrElse Thread.Temp Is Nothing Then Continue For
Using fs As New FileStream(Thread.Temp, FileMode.Open, FileAccess.Read, FileShare.Read) Using fs = FileUtils.ReadAsStream(Thread.Temp)
Using TempReader As New BinaryReader(fs) Using TempReader As New BinaryReader(fs)
AddWriter.Write(TempReader.ReadBytes(Thread.DownloadDone)) AddWriter.Write(TempReader.ReadBytes(Thread.DownloadDone))
End Using End Using
@@ -1314,16 +1290,16 @@ Retry:
End If End If
End If End If
If CheckResult IsNot Nothing Then If CheckResult IsNot Nothing Then
Log($"[Download] {LocalName} 文件校验失败，下载线程细节：") Logger.Info($"{LocalName} 文件校验失败，下载线程细节：")
For Each T As NetThread In Threads For Each T As NetThread In Threads
Log($"[Download] - {T.Uuid}#，状态 {GetStringFromEnum(T.State)}，范围 {T.DownloadStart}~{T.DownloadEnd}，已下载 {T.DownloadDone}，未下载 {T.DownloadUndone}") Logger.Info($"- {T.Uuid}#，状态 {T.State}，范围 {T.DownloadStart}~{T.DownloadEnd}，已下载 {T.DownloadDone}，未下载 {T.DownloadUndone}")
Next Next
Throw New Exception(CheckResult) Throw New Exception(CheckResult)
End If End If
'后处理 '后处理
If Not IsNoSplit Then If Not IsNoSplit Then
For Each Thread As NetThread In Threads For Each Thread As NetThread In Threads
If Thread.Temp IsNot Nothing Then File.Delete(Thread.Temp) If Thread.Temp IsNot Nothing Then FileUtils.Delete(Thread.Temp)
Next Next
End If End If
Finish() Finish()
@@ -1331,7 +1307,7 @@ Retry:
Catch ex As Exception Catch ex As Exception
RetryCount += 1 RetryCount += 1
If State > NetState.Merging Then Return '通常是因为在合并时被中断了 If State > NetState.Merging Then Return '通常是因为在合并时被中断了
Log(ex, $"合并文件出错，第 {RetryCount} 次尝试（{LocalName}）") Logger.Warn(ex, $"合并文件出错，第 {RetryCount} 次尝试（{LocalName}）")
'重新尝试合并 '重新尝试合并
If RetryCount < 3 Then If RetryCount < 3 Then
Threading.Thread.Sleep(500 * RetryCount) Threading.Thread.Sleep(500 * RetryCount)
@@ -1339,9 +1315,9 @@ Retry:
End If End If
'失败，禁用当前下载源并重启下载 '失败，禁用当前下载源并重启下载
Try Try
If File.Exists(LocalPath) Then File.Delete(LocalPath) FileUtils.Delete(LocalPath)
Catch exx As Exception Catch exx As Exception
Log(ex, $"删除合并失败的文件出错（{LocalPath}）") Logger.Warn(ex, $"删除合并失败的文件出错（{LocalPath}）")
End Try End Try
SourceFail(Th, ex, True) SourceFail(Th, ex, True)
Finally Finally
@@ -1356,7 +1332,7 @@ Retry:
If State >= NetState.Finished Then Return If State >= NetState.Finished Then Return
If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx) If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
'凉凉 '凉凉
Log($"[Download] {LocalName}：已失败，当前状态 {State}") Logger.Info($"{LocalName}：已失败，当前状态 {State}")
State = NetState.Interrupted State = NetState.Interrupted
End SyncLock End SyncLock
InterruptInternal() InterruptInternal()
@@ -1374,7 +1350,7 @@ Retry:
'确认中断 '确认中断
SyncLock LockState SyncLock LockState
If State >= NetState.Finished Then Return If State >= NetState.Finished Then Return
Log($"[Download] {LocalName}：已中断，当前状态 {State}") Logger.Info($"{LocalName}：已中断，当前状态 {State}")
State = NetState.Interrupted State = NetState.Interrupted
End SyncLock End SyncLock
InterruptInternal() InterruptInternal()
@@ -1395,7 +1371,7 @@ Retry:
State = NetState.Finished State = NetState.Finished
End SyncLock End SyncLock
Interlocked.Decrement(NetManager.FileRemain) Interlocked.Decrement(NetManager.FileRemain)
If PrintLog Then Log($"[Download] {LocalName}：已完成") If PrintLog Then Logger.Info($"{LocalName}：已完成")
For Each Task In Tasks For Each Task In Tasks
Task.OnFileFinish(Me) Task.OnFileFinish(Me)
Next Next
@@ -1403,7 +1379,7 @@ Retry:
End Class End Class
Private Class RangeNotSupportedException Private Class RangeNotSupportedException
Inherits WebException Inherits HttpRequestException
Public Sub New(Message As String) Public Sub New(Message As String)
MyBase.New(Message) MyBase.New(Message)
End Sub End Sub
@@ -1451,7 +1427,7 @@ Retry:
Set(value As Integer) Set(value As Integer)
_FailCount = value _FailCount = value
If State = LoadState.Loading AndAlso value >= Math.Min(10000, Math.Max(FileRemain * 5.5, NetTaskThreadLimit * 5.5 + 3)) Then If State = LoadState.Loading AndAlso value >= Math.Min(10000, Math.Max(FileRemain * 5.5, NetTaskThreadLimit * 5.5 + 3)) Then
Log("[Download] 由于同加载器中失败次数过多引发强制失败：连续失败了 " & value & " 次", NotifyLevel.DebugModeOnly) Logger.Warn($"由于同加载器中失败次数过多引发强制失败：连续失败了 {value} 次")
On Error Resume Next On Error Resume Next
Dim ExList As New List(Of Exception) Dim ExList As New List(Of Exception)
For Each File In Files For Each File In Files
@@ -1492,7 +1468,7 @@ FinishExCatch:
_Progress = NewProgress _Progress = NewProgress
End Sub End Sub
Public Sub New(Name As String, FileTasks As List(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 ConcurrentList(Of NetFile)(FileTasks)
End Sub End Sub
@@ -1526,7 +1502,7 @@ FinishExCatch:
File.LocalPath = File.LocalPath.Replace("/", "\") File.LocalPath = File.LocalPath.Replace("/", "\")
If Not File.LocalPath.Lower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确：" & File.LocalPath) If Not File.LocalPath.Lower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确：" & File.LocalPath)
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径：" & File.LocalPath) If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径：" & File.LocalPath)
DirectoryUtils.Create(File.LocalPath, isFilePath:=True) '创建目标文件夹 DirectoryUtils.Create(PathUtils.RemoveLastPart(File.LocalPath)) '创建目标文件夹
Next Next
'接入下载管理器，获取新开始下载的文件列表 '接入下载管理器，获取新开始下载的文件列表
Dim NewFiles = NetManager.Start(Me) Dim NewFiles = NetManager.Start(Me)
@@ -1552,7 +1528,7 @@ FinishExCatch:
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(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里
Folders.AddRange(McFolderList.Select(Function(f) f.Location)) Folders.AddRange(McFolderList.Select(Function(f) f.Location))
Folders = Folders.Distinct.Where(Function(f) Directory.Exists(f)).ToList Folders = Folders.Distinct.Where(Function(f) DirectoryUtils.Exists(f)).ToList
'平均分配到多个检查线程 '平均分配到多个检查线程
Dim ThreadCount As Integer = (FilesToCheck.Count \ 40).Clamp(1, 8) '每个线程至少 40 个文件，最多 8 线程 Dim ThreadCount As Integer = (FilesToCheck.Count \ 40).Clamp(1, 8) '每个线程至少 40 个文件，最多 8 线程
If ThreadCount = 1 Then '只有一个线程，直接执行 If ThreadCount = 1 Then '只有一个线程，直接执行
@@ -1575,43 +1551,27 @@ FinishExCatch:
End Sub End Sub
Private Sub CheckExistingFiles(Files As List(Of NetFile), FolderList As List(Of String)) Private Sub CheckExistingFiles(Files As List(Of NetFile), FolderList As List(Of String))
Try Try
If ModeDebug Then Log($"[Download] 文件检查开始，本线程负责的文件数：{Files.Count}") Logger.Trace(Function() $"文件检查开始，本线程负责 {Files.Count} 个文件，首个文件为 {Files.FirstOrDefault?.LocalName}")
'列出 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
Dim VersionsFolder As New DirectoryInfo(McFolder & "versions\") For Each VersionFolder In DirectoryUtils.GetDirectories(McFolder & "versions\", True)
If VersionsFolder.Exists() Then VersionFolders.Add(PathUtils.AddSlashSuffix(VersionFolder))
For Each VersionFolder In VersionsFolder.GetDirectories Next
VersionFolders.Add(VersionFolder.FullName & "\")
Next
End If
Next Next
'处理每个文件 '处理每个文件
For Each File As NetFile In Files For Each File As NetFile In Files
Dim Target As String = CheckExistingFile(FolderList, VersionFolders, File) Dim Target As String = CheckExistingFile(FolderList, VersionFolders, File)
If ModeDebug Then Log($"[Download] 文件检查结果：{File.LocalName} → {Target}，当前状态 {File.State}") Logger.Trace(Function() $"本地文件匹配：{File.LocalName} → {If(Target, "无匹配")}，当前状态 {File.State}")
If File.State >= NetState.WaitingToDownload Then Continue For '中断 If File.State >= NetState.WaitingToDownload Then Continue For '中断
'已找到相同文件 '已找到相同文件
If Target IsNot Nothing Then If Target IsNot Nothing Then
File.IsCopy = True File.IsCopy = True
Dim RetryCount As Integer = 0
Retry:
Try Try
If Target <> File.LocalPath Then FileUtils.Copy(Target, File.LocalPath)
Log($"[Download] 复制已存在的文件：{Target} → {File.LocalPath}")
CopyFile(Target, File.LocalPath)
Else
If ModeDebug Then Log($"[Download] 需要下载的文件已存在，并通过校验：{Target}")
End If
File.Finish(False) File.Finish(False)
Continue For Continue For
Catch ex As Exception Catch
RetryCount += 1
Log(ex, $"复制已存在的文件失败，第 {RetryCount} 次重试（{Target} → {File.LocalPath}）")
If RetryCount < 3 Then
Thread.Sleep(2000)
GoTo Retry
End If
End Try End Try
End If End If
'回退到下载 '回退到下载
@@ -1628,7 +1588,7 @@ Retry:
'目标文件已存在 '目标文件已存在
If File.Check.Check(File.LocalPath) Is Nothing Then Return File.LocalPath If File.Check.Check(File.LocalPath) Is Nothing Then Return File.LocalPath
'在设置中禁用了复制 '在设置中禁用了复制
If Settings.Get("SystemDebugSkipCopy") Then Return Nothing If Settings.Get(Of Boolean)("SystemDebugSkipCopy") Then Return Nothing
'没有可用的检查规则，只能开始下载 '没有可用的检查规则，只能开始下载
If File.Check.Hash Is Nothing AndAlso File.Check.ActualSize < 0 Then Return Nothing If File.Check.Hash Is Nothing AndAlso File.Check.ActualSize < 0 Then Return Nothing
'大致判断文件类别 '大致判断文件类别
@@ -1646,37 +1606,35 @@ Retry:
Dim Type = TypeIndexes.MaxBy(Function(kv) kv.Item2).FolderName.TrimStart("\"c) Dim Type = TypeIndexes.MaxBy(Function(kv) kv.Item2).FolderName.TrimStart("\"c)
'根据类别进行查找 '根据类别进行查找
Static Sizes As New ConcurrentDictionary(Of String, Long) Static Sizes As New ConcurrentDictionary(Of String, Long)
Static CheckCandidate As Func(Of String, FileChecker, Boolean) =
Function(Candidate, Checker)
'快速进行大小校验
Dim Length = Sizes.GetOrAdd(Candidate, Function(c) If(FileUtils.Exists(c), FileUtils.GetInfo(c).Length, -1))
If Checker.ActualSize <> Length Then Return False
'进一步进行 Hash 校验
Return Checker.Check(Candidate) Is Nothing
End Function
Select Case Type Select Case Type
Case "assets\", "libraries\" Case "assets\", "libraries\"
'assets/libraries：查找 MC 文件夹下的相同路径 'assets/libraries：查找 MC 文件夹下的相同路径
For Each Folder In FolderList For Each Folder In FolderList
Dim Candidate = Folder & Type & File.LocalPath.AfterFirst(Type) Dim Candidate = Folder & Type & File.LocalPath.AfterFirst(Type)
If File.Check.Check(Candidate) Is Nothing Then Return Candidate If CheckCandidate(Candidate, File.Check) Then Return Candidate
Next Next
Return Nothing
Case "versions\" Case "versions\"
'版本 jar 或 json：查找 MC 文件夹下的各个版本文件夹 '版本 jar 或 json：查找 MC 文件夹下的各个版本文件夹
For Each VersionFolder In VersionFolders For Each VersionFolder In VersionFolders
For Each Candidate In Directory.GetFiles(VersionFolder, For Each Candidate In DirectoryUtils.GetFiles(VersionFolder, True, "*." & PathUtils.GetLastPart(File.LocalPath).AfterLast(".").Lower)
"*." & GetFileNameFromPath(File.LocalPath).AfterLast(".").Lower, SearchOption.TopDirectoryOnly) If CheckCandidate(Candidate, File.Check) Then Return Candidate
'快速进行大小校验
Dim Length = Sizes.GetOrAdd(Candidate, Function(c) New FileInfo(c).Length)
If File.Check.ActualSize <> Length Then Continue For
'Hash 校验
If File.Check.Check(Candidate) Is Nothing Then Return Candidate
Next Next
Next Next
Case Else Case Else
'社区资源 '社区资源
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)
Dim TargetFolder = Folder & Type For Each Candidate In DirectoryUtils.GetFiles(Folder & Type, True)
If Not Directory.Exists(TargetFolder) Then Continue For If CheckCandidate(Candidate, File.Check) Then Return Candidate
For Each Candidate In Directory.GetFiles(TargetFolder)
'快速进行大小校验
Dim Length = Sizes.GetOrAdd(Candidate, Function(c) New FileInfo(c).Length)
If File.Check.ActualSize <> Length Then Continue For
'Hash 校验
If File.Check.Check(Candidate) Is Nothing Then Return Candidate
Next Next
Next Next
End Select End Select
@@ -1719,7 +1677,7 @@ Retry:
For Each File In Files For Each File In Files
If File.State <> NetState.Interrupted Then Continue For If File.State <> NetState.Interrupted Then Continue For
If File.Sources.All(Function(s) TypeOf s.Ex Is OperationCanceledException OrElse TypeOf s.Ex Is TimeoutException OrElse TypeOf s.Ex Is ThreadInterruptedException) Then Continue For If File.Sources.All(Function(s) TypeOf s.Ex Is OperationCanceledException OrElse TypeOf s.Ex Is TimeoutException OrElse TypeOf s.Ex Is ThreadInterruptedException) Then Continue For
Dim Detail As String = File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetBrief())}（{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])
'上报 '上报
@@ -1736,18 +1694,14 @@ Retry:
TaskFile.Interrupt(Me) TaskFile.Interrupt(Me)
Next Next
'在退出同步锁后再进行日志输出 '在退出同步锁后再进行日志输出
Dim ErrOutput As New List(Of String) Logger.Error(New AggregateException(ExList), "下载加载器失败", LogBehavior.None)
For Each Ex As Exception In ExList
ErrOutput.Add(Ex.GetDetail())
Next
Log("[Download] " & ErrOutput.Distinct.Join(vbCrLf))
End Sub End Sub
Public Overrides Sub Interrupt() Public Overrides Sub Interrupt()
SyncLock LockState SyncLock LockState
If State >= LoadState.Finished Then Return If State >= LoadState.Finished Then Return
State = LoadState.Interrupted State = LoadState.Interrupted
End SyncLock End SyncLock
Log("[Download] " & Name & " 已取消！") Logger.Info($"{Name} 已取消！")
'中断所有文件 '中断所有文件
For Each TaskFile In Files For Each TaskFile In Files
TaskFile.Interrupt(Me) TaskFile.Interrupt(Me)
@@ -1823,7 +1777,7 @@ Retry:
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
Log("[Download] " & "速度下限已提升到 " & FormatFileSize(Limit)) Logger.Info($"速度下限已提升到 {FormatFileSize(Limit)}")
End If End If
#End Region #End Region
#Region "刷新下载任务属性" #Region "刷新下载任务属性"
@@ -1832,7 +1786,7 @@ Retry:
Next Next
#End Region #End Region
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新下载公开属性失败") Logger.Warn(ex, "刷新下载公开属性失败")
End Try End Try
End Sub End Sub
Private RefreshStatLast As Long Private RefreshStatLast As Long
@@ -1889,7 +1843,7 @@ Retry:
Next Next
End While End While
Catch ex As Exception Catch ex As Exception
Log(ex, $"下载管理启动线程 {Id} 出错", NotifyLevel.Critical) Logger.Error(ex, $"下载管理启动线程 {Id} 出错", LogBehavior.AlertThenCrash)
End Try End Try
End Sub End Sub
RunInNewThread(Sub() ThreadStarter(0), "NetManager ThreadStarter 0") RunInNewThread(Sub() ThreadStarter(0), "NetManager ThreadStarter 0")
@@ -1913,7 +1867,7 @@ Retry:
End If End If
End While End While
Catch ex As Exception Catch ex As Exception
Log(ex, "下载管理刷新线程出错", NotifyLevel.Critical) Logger.Error(ex, "下载管理刷新线程出错", LogBehavior.AlertThenCrash)
End Try End Try
End Sub, "NetManager StatRefresher") End Sub, "NetManager StatRefresher")
End Sub End Sub
@@ -1929,11 +1883,11 @@ Retry:
SyncLock DownloadCacheLock '防止同时开启多个下载任务时重复清理 SyncLock DownloadCacheLock '防止同时开启多个下载任务时重复清理
If Not IsDownloadCacheCleared Then If Not IsDownloadCacheCleared Then
Try Try
Log("[Net] 开始清理下载缓存") Logger.Info("开始清理下载缓存")
DeleteDirectory(PathTemp & "Download") DirectoryUtils.Delete(PathTemp & "Download")
Log("[Net] 下载缓存已清理") Logger.Info("下载缓存已清理")
Catch ex As Exception Catch ex As Exception
Log(ex, "清理下载缓存失败") Logger.Warn(ex, "清理下载缓存失败")
End Try End Try
IsDownloadCacheCleared = True IsDownloadCacheCleared = True
End If End If
@@ -1945,12 +1899,12 @@ Retry:
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
'该文件正在被另一个任务下载 '该文件正在被另一个任务下载
If ModeDebug Then Log($"[Download] {File.LocalName}：无需开始，该文件已在下载中，目标 {File.LocalPath}") Logger.Trace(Function() $"{File.LocalName}：无需开始，该文件已在下载中，目标 {File.LocalPath}")
File = OngoingFile '将列表中的文件替换成下载中的文件，即两个任务指向同一个文件；抛弃现在的 File 对象 File = OngoingFile '将列表中的文件替换成下载中的文件，即两个任务指向同一个文件；抛弃现在的 File 对象
Task.Files(i) = File Task.Files(i) = File
Else Else
'常规情况（该文件可能已在其他任务中下载完成，但这并不影响） '常规情况（该文件可能已在其他任务中下载完成，但这并不影响）
If ModeDebug Then Log($"[Download] {File.LocalName}：开始，目标 {File.LocalPath}") Logger.Trace(Function() $"{File.LocalName}：开始，目标 {File.LocalPath}")
AllFiles(File.LocalPath) = File AllFiles(File.LocalPath) = File
NewFiles.Add(File) NewFiles.Add(File)
Interlocked.Increment(FileRemain) Interlocked.Increment(FileRemain)
@@ -2021,38 +1975,18 @@ Retry:
Try Try
PingResult = (New NetworkInformation.Ping).Send(Ip) PingResult = (New NetworkInformation.Ping).Send(Ip)
Catch ex As Exception Catch ex As Exception
If MakeLog Then Log("[Net] Ping " & Ip & " 失败：" & ex.Message) If MakeLog Then Logger.Info($"Ping {Ip} 失败：{ex.Message}")
Return -1 Return -1
End Try End Try
If PingResult.Status = NetworkInformation.IPStatus.Success Then If PingResult.Status = NetworkInformation.IPStatus.Success Then
If MakeLog Then Log("[Net] Ping " & Ip & " 结束：" & PingResult.RoundtripTime & "ms") If MakeLog Then Logger.Info($"Ping {Ip} 结束：{PingResult.RoundtripTime}ms")
Return PingResult.RoundtripTime Return PingResult.RoundtripTime
Else Else
If MakeLog Then Log("[Net] Ping " & Ip & " 失败") If MakeLog Then Logger.Info($"Ping {Ip} 失败")
Return -1 Return -1
End If End If
End Function End Function
''' <summary>
''' 判断某个 Exception 是否为网络问题所导致。
''' </summary>
<Extension> Public Function IsNetworkRelated(Ex As Exception) As Boolean
'提取 Message（不能用 GetDetail，因为堆栈的方法参数中就有 timeout 字样）
Dim Detail As String = ""
Dim InnerEx As Exception = Ex
Detail += InnerEx.Message
Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException
Detail += InnerEx.Message
Loop
'判断
If Detail.Contains("(403)") Then Return False
Return {
"(408)", "超时", "timeout", "网络请求失败", "连接尝试失败", "远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称",
"由于目标计算机积极拒绝", "基础连接已经关闭"
}.Any(Function(k) Detail.ContainsIgnoreCase(k))
End Function
''' <summary> ''' <summary>
''' 设置是否应当在正版登录时校验 SSL 证书。 ''' 设置是否应当在正版登录时校验 SSL 证书。
''' </summary> ''' </summary>
@@ -2062,7 +1996,7 @@ Retry:
Dim Request As HttpWebRequest = TryCast(Sender, HttpWebRequest) Dim Request As HttpWebRequest = TryCast(Sender, HttpWebRequest)
If Failure = Net.Security.SslPolicyErrors.None Then Return True '已通过验证 If Failure = Net.Security.SslPolicyErrors.None Then Return True '已通过验证
'基于 #3018 和 #5879，只在访问正版登录 API 时跳过证书验证 '基于 #3018 和 #5879，只在访问正版登录 API 时跳过证书验证
Log($"[System] 未通过 SSL 证书验证（{Failure}），提供的证书为 {Certificate?.Subject}，URL：{Request?.Address}", NotifyLevel.DebugModeOnly) Logger.Warn($"未通过 SSL 证书验证（{Failure}），提供的证书为 {Certificate?.Subject}，URL：{Request?.Address}")
If Request Is Nothing Then If Request Is Nothing Then
Return Not Enabled Return Not Enabled
ElseIf Request.Address.Host.Contains("xboxlive") OrElse Request.Address.Host.Contains("minecraftservices") Then ElseIf Request.Address.Host.Contains("xboxlive") OrElse Request.Address.Host.Contains("minecraftservices") Then
Plain Craft Launcher 2/Modules/Base/ModValidate.vb
+16 -15
View File
@@ -80,7 +80,7 @@ Public Class ValidateRegex
Me.ErrorDescription = ErrorDescription Me.ErrorDescription = ErrorDescription
End Sub End Sub
Public Overrides Function Validate(Str As String) As String Public Overrides Function Validate(Str As String) As String
If Not RegexCheck(Str, Regex) Then Return ErrorDescription If Not Str.RegexCheck(Regex) Then Return ErrorDescription
Return "" Return ""
End Function End Function
End Class End Class
@@ -94,7 +94,7 @@ Public Class ValidateHttp
End Sub '用于 XAML 初始化 End Sub '用于 XAML 初始化
Public Overrides Function Validate(Str As String) As String Public Overrides Function Validate(Str As String) As String
If Str.EndsWithF("/") Then Str = Str.Substring(0, Str.Length - 1) If Str.EndsWithF("/") Then Str = Str.Substring(0, Str.Length - 1)
If Not RegexCheck(Str, "^(http[s]?)\://") Then Return "输入的网址无效！" If Not Str.RegexCheck("^(http[s]?)\://") Then Return "输入的网址无效！"
Return "" Return ""
End Function End Function
End Class End Class
@@ -247,7 +247,7 @@ Public Class ValidateFolderName
Public Property Folder As String Public Property Folder As String
Public Property UseMinecraftCharCheck As Boolean = True Public Property UseMinecraftCharCheck As Boolean = True
Public Property IgnoreCase As Boolean = True Public Property IgnoreCase As Boolean = True
Private ReadOnly PathIgnore As IEnumerable(Of DirectoryInfo) Private ReadOnly PathIgnore As IEnumerable(Of String)
Public Sub New() Public Sub New()
End Sub End Sub
Public Sub New(Folder As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True) Public Sub New(Folder As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
@@ -255,7 +255,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 = New DirectoryInfo(Folder).EnumerateDirectories PathIgnore = DirectoryUtils.GetDirectories(Folder, True)
End Sub End Sub
Public Overrides Function Validate(Str As String) As String Public Overrides Function Validate(Str As String) As String
Try Try
@@ -277,19 +277,19 @@ Public Class ValidateFolderName
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！", True).Validate(Str) Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！", True).Validate(Str)
If InvalidStrCheck <> "" Then Return InvalidStrCheck If InvalidStrCheck <> "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名（#4505） '检查 NTFS 8.3 文件名（#4505）
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！" If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
'检查文件夹重名 '检查文件夹重名
Dim Arr As New List(Of String) Dim Arr As New List(Of String)
If PathIgnore IsNot Nothing Then If PathIgnore IsNot Nothing Then
For Each Folder As DirectoryInfo In PathIgnore For Each FolderPath In PathIgnore
Arr.Add(Folder.Name) Arr.Add(PathUtils.GetLastPart(FolderPath))
Next Next
End If End If
Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名！", IgnoreCase).Validate(Str) Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名！", IgnoreCase).Validate(Str)
If Not SameNameCheck = "" Then Return SameNameCheck If Not SameNameCheck = "" Then Return SameNameCheck
Return "" Return ""
Catch ex As Exception Catch ex As Exception
Log(ex, "检查文件夹名出错") Logger.Warn(ex, "检查文件夹名出错")
Return "错误：" & ex.Message Return "错误：" & ex.Message
End Try End Try
End Function End Function
@@ -332,10 +332,10 @@ Public Class ValidateFileName
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件名不可为 %！", True).Validate(Str) Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件名不可为 %！", True).Validate(Str)
If InvalidStrCheck <> "" Then Return InvalidStrCheck If InvalidStrCheck <> "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名（#4505） '检查 NTFS 8.3 文件名（#4505）
If RegexCheck(Str, ".{2,}~\d") Then Return "文件名不能包含这一特殊格式！" If Str.RegexCheck(".{2,}~\d") Then Return "文件名不能包含这一特殊格式！"
'检查文件重名 '检查文件重名
If ParentFolder IsNot Nothing Then If ParentFolder IsNot Nothing Then
Dim DirInfo As New DirectoryInfo(ParentFolder) Dim DirInfo = DirectoryUtils.GetInfo(ParentFolder)
If DirInfo.Exists Then If DirInfo.Exists Then
Dim SameNameCheck = New ValidateExceptSame(DirInfo.EnumerateFiles("*").Select(Function(f) f.Name), Dim SameNameCheck = New ValidateExceptSame(DirInfo.EnumerateFiles("*").Select(Function(f) f.Name),
"不可与现有文件重名！", IgnoreCase).Validate(Str) "不可与现有文件重名！", IgnoreCase).Validate(Str)
@@ -346,7 +346,7 @@ Public Class ValidateFileName
End If End If
Return "" Return ""
Catch ex As Exception Catch ex As Exception
Log(ex, "检查文件名出错") Logger.Warn(ex, "检查文件名出错")
Return "错误：" & ex.Message Return "错误：" & ex.Message
End Try End Try
End Function End Function
@@ -375,9 +375,10 @@ Public Class ValidateFolderPath
If LengthCheck <> "" Then Return LengthCheck If LengthCheck <> "" Then Return LengthCheck
'检查开头 '检查开头
If Str.StartsWithF("\\Mac\") Then GoTo Fin If Str.StartsWithF("\\Mac\") Then GoTo Fin
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives For Each Drive In Environment.GetLogicalDrives().Where(Function(p) DirectoryUtils.Exists(p))
If Str.Upper = Drive.Name Then Return "" Dim DriveName As String = Drive.Upper.First & ":\"
If Str.StartsWithF(Drive.Name, True) Then GoTo Fin If Str.Upper = DriveName Then Return ""
If Str.StartsWithF(DriveName, True) Then GoTo Fin
Next Next
Return "文件夹路径头存在错误！" Return "文件夹路径头存在错误！"
Fin: Fin:
@@ -399,7 +400,7 @@ Fin:
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！").Validate(SubStr) Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！").Validate(SubStr)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名（#4505） '检查 NTFS 8.3 文件名（#4505）
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！" If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
Next Next
Return "" Return ""
End Function End Function
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
+3 -3
View File
@@ -72,7 +72,7 @@ Public Class MyBitmap
End If End If
Else Else
'使用这种自己接管 FileStream 的方法加载才能解除文件占用 '使用这种自己接管 FileStream 的方法加载才能解除文件占用
Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open, FileAccess.Read, FileShare.Read) Using InputStream = FileUtils.ReadAsStream(FilePathOrResourceName)
'判断是否为 WebP 文件头 '判断是否为 WebP 文件头
Dim Header(1) As Byte Dim Header(1) As Byte
InputStream.Read(Header, 0, 2) InputStream.Read(Header, 0, 2)
@@ -97,7 +97,7 @@ Public Class MyBitmap
Throw New Exception($"加载 MyBitmap 意外失败（{FilePathOrResourceName}）", ex) Throw New Exception($"加载 MyBitmap 意外失败（{FilePathOrResourceName}）", ex)
End If End If
Else Else
Log(ex, $"指定类型有误的 MyBitmap 加载（{FilePathOrResourceName}）", NotifyLevel.DevelopOnly) Logger.Warn(ex, $"指定类型有误的 MyBitmap 加载（{FilePathOrResourceName}）")
Exit Try Exit Try
End If End If
End Try End Try
@@ -162,7 +162,7 @@ Public Class MyBitmap
Public Sub Save(FilePath As String) Public Sub Save(FilePath As String)
Dim encoder As BitmapEncoder = New PngBitmapEncoder() Dim encoder As BitmapEncoder = New PngBitmapEncoder()
encoder.Frames.Add(BitmapFrame.Create(Me)) encoder.Frames.Add(BitmapFrame.Create(Me))
Using fileStream As New FileStream(FilePath, FileMode.Create) Using fileStream = FileUtils.CreateAsStream(FilePath)
encoder.Save(fileStream) encoder.Save(fileStream)
End Using End Using
End Sub End Sub
Plain Craft Launcher 2/Modules/Base/PclLogger.vb
+54
View File
@@ -0,0 +1,54 @@
Public Class PclLogger
Inherits FileLogger
''' <inheritdoc/>
Public Overrides Function Format(Text As String, Level As LogLevel, FilePath As String, Ex As Exception) As String
Text = MyBase.Format(Text, Level, FilePath, Ex)
Text = FilterUserName(FilterAccessToken(Text, "*"c), "*"c)
Return Text
End Function
''' <inheritdoc/>
Public Overrides Sub HandleBehavior(RawMessage As String, FormattedMessage As String, Behavior As LogBehavior, Ex As Exception)
If IsProgramEnding Then Return
MyBase.HandleBehavior(RawMessage, FormattedMessage, Behavior, Ex)
Dim BriefText = If(Ex Is Nothing, RawMessage, If(RawMessage Is Nothing, "", $"{RawMessage}：") & Ex.GetDisplay(False))
BriefText = FilterUserName(FilterAccessToken(BriefText, "*"c), "*"c)
Dim DetailText = If(Ex Is Nothing, RawMessage, If(RawMessage Is Nothing, "", $"{RawMessage}：") & Ex.GetDisplay(True))
DetailText = FilterUserName(FilterAccessToken(DetailText, "*"c), "*"c)
Select Case Behavior
Case LogBehavior.None
'啥也不干
Case LogBehavior.ToastIfDebug
If BuildType = BuildTypes.Debug OrElse ModeDebug Then Hint("[调试模式] " & BriefText, HintType.Blue, False)
Case LogBehavior.Toast
Hint(BriefText, HintType.Red, False)
Case LogBehavior.Alert
MyMsgBox(DetailText, "错误", IsWarn:=True)
Case LogBehavior.AlertThenFeedback
If PageSetupSystem.IsLauncherNewest Then
If MyMsgBox(DetailText & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", "错误", "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
Else
MyMsgBox(DetailText & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", "错误", IsWarn:=True)
End If
Case LogBehavior.AlertThenCrash
Static FirstTrigger As Boolean = True
If FirstTrigger Then
'首次触发
FirstTrigger = False
If PageSetupSystem.IsLauncherNewest Then
If MsgBox(DetailText & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, "错误") = MsgBoxResult.Yes Then Feedback(False, True)
Else
MsgBox(DetailText & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, "错误")
End If
Else
'多次触发，直接使程序崩溃（这通常代表着在其他线程循环触发严重异常）
Thread.Sleep(2000)
End If
FormMain.EndProgramForce(ProcessReturnValues.Exception)
End Select
'遥测
If Behavior >= LogBehavior.Toast Then Telemetry("错误日志", "Exception", DetailText)
End Sub
End Class
Plain Craft Launcher 2/Modules/Constants.vb
-78
View File
@@ -1,78 +0,0 @@
''' <summary>
''' 社区资源的类型。
''' </summary>
<Flags> Public Enum ResourceTypes
''' <summary>
''' Mod。
''' </summary>
[Mod] = 1
''' <summary>
''' 整合包。
''' </summary>
ModPack = 2
''' <summary>
''' 资源包。
''' </summary>
ResourcePack = 4
''' <summary>
''' 光影包。
''' </summary>
Shader = 8
''' <summary>
''' 数据包。
''' </summary>
DataPack = 16
''' <summary>
''' 服务端插件。
''' </summary>
Plugin = 32
''' <summary>
''' 同时包含数据包以及 Mod。
''' </summary>
ModOrDataPack = [Mod] Or DataPack
''' <summary>
''' 允许任意种类，或种类未知。
''' </summary>
Any = [Mod] Or ModPack Or ResourcePack Or Shader Or DataPack Or Plugin
End Enum
''' <summary>
''' 社区资源的来源平台。
''' </summary>
<Flags> Public Enum ResourcePlatforms
CurseForge = 1
Modrinth = 2
Any = CurseForge Or Modrinth
End Enum
''' <summary>
''' Mod 加载器的类型。
''' </summary>
Public Enum ModLoaderTypes
'https://docs.curseforge.com/rest-api/#tocS_ModLoaderType
Any = 0
Forge = 1
LiteLoader = 3
Fabric = 4
Quilt = 5
NeoForge = 6
End Enum
''' <summary>
''' 在爱发电中的赞助等级。
''' </summary>
Public Enum DonationRanks
None = 0
Rank6 = 6
Rank12 = 12
Rank23 = 23
Rank54 = 54
Rank98 = 98
End Enum
Public Module Constants
''' <summary>
''' 土豆码版本号。
''' </summary>
Public Const POTATO_VERSION As Char = "1"c
End Module
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+140 -147
View File
@@ -9,7 +9,7 @@
TempFolder = RequestTaskTempFolder() TempFolder = RequestTaskTempFolder()
DirectoryUtils.Create(TempFolder & "Temp\") DirectoryUtils.Create(TempFolder & "Temp\")
DirectoryUtils.Create(TempFolder & "Report\") DirectoryUtils.Create(TempFolder & "Report\")
Log("[Crash] 崩溃分析暂存文件夹：" & TempFolder) Logger.Info($"崩溃分析暂存文件夹：{TempFolder}")
End Sub End Sub
'1：准备用于分析的 Log 文件 '1：准备用于分析的 Log 文件
@@ -19,35 +19,30 @@
''' </summary> ''' </summary>
''' <param name="LatestLog">从 PCL 捕获到的最后 200 行程序输出。</param> ''' <param name="LatestLog">从 PCL 捕获到的最后 200 行程序输出。</param>
Public Sub Collect(VersionPathIndie As String, Optional LatestLog As IList(Of String) = Nothing) Public Sub Collect(VersionPathIndie As String, Optional LatestLog As IList(Of String) = Nothing)
Log("[Crash] 步骤 1：收集日志文件") Logger.Info("步骤 1：收集日志文件")
'简单收集可能的日志文件路径 '简单收集可能的日志文件路径
Dim PossibleLogs As New List(Of String) Dim PossibleLogs As New List(Of String)
Try Try
Dim DirInfo As New DirectoryInfo(VersionPathIndie & "crash-reports\") PossibleLogs.AddRange(DirectoryUtils.GetFiles(VersionPathIndie & "crash-reports\"))
If DirInfo.Exists Then
For Each File In DirInfo.EnumerateFiles
PossibleLogs.Add(File.FullName)
Next
End If
Catch ex As Exception Catch ex As Exception
Log(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败") Logger.Warn(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败")
End Try End Try
Try Try
For Each File In New DirectoryInfo(VersionPathIndie).Parent.Parent.EnumerateFiles For Each File In DirectoryUtils.GetInfo(VersionPathIndie).Parent.Parent.EnumerateFiles
If If(File.Extension, "") <> ".log" Then Continue For If If(File.Extension, "") <> ".log" Then Continue For
PossibleLogs.Add(File.FullName) PossibleLogs.Add(PathUtils.RemoveExtendedPrefix(File.FullName))
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "收集 Minecraft 主文件夹下的日志失败") Logger.Warn(ex, "收集 Minecraft 主文件夹下的日志失败")
End Try End Try
Try Try
For Each File In New DirectoryInfo(VersionPathIndie).EnumerateFiles For Each File In DirectoryUtils.GetInfo(VersionPathIndie).EnumerateFiles
If If(File.Extension, "") <> ".log" Then Continue For If If(File.Extension, "") <> ".log" Then Continue For
PossibleLogs.Add(File.FullName) PossibleLogs.Add(PathUtils.RemoveExtendedPrefix(File.FullName))
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "收集 Minecraft 隔离文件夹下的日志失败") Logger.Warn(ex, "收集 Minecraft 隔离文件夹下的日志失败")
End Try End Try
PossibleLogs.Add(VersionPathIndie & "logs\latest.log") 'Minecraft 日志 PossibleLogs.Add(VersionPathIndie & "logs\latest.log") 'Minecraft 日志
PossibleLogs.Add(VersionPathIndie & "logs\debug.log") 'Minecraft Debug 日志 PossibleLogs.Add(VersionPathIndie & "logs\debug.log") 'Minecraft Debug 日志
@@ -57,74 +52,75 @@
Dim RightLogs As New List(Of String) Dim RightLogs As New List(Of String)
For Each LogFile In PossibleLogs For Each LogFile In PossibleLogs
Try Try
Dim Info As New FileInfo(LogFile) Dim Info = FileUtils.GetInfo(LogFile)
If Not Info.Exists Then Continue For If Not Info.Exists Then Continue For
Dim Time = Math.Abs((Info.LastWriteTime - Date.Now).TotalMinutes) Dim Time = Math.Abs((Info.LastWriteTime - Date.Now).TotalMinutes)
If Time < 3 AndAlso Info.Length > 0 Then If Time < 3 AndAlso Info.Length > 0 Then
RightLogs.Add(LogFile) RightLogs.Add(LogFile)
Log("[Crash] 可能可用的日志文件：" & LogFile & "（" & Math.Round(Time, 1) & " 分钟）") Logger.Info($"可能可用的日志文件：{LogFile}（{Math.Round(Time, 1)} 分钟）")
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "确认崩溃日志时间失败（" & LogFile & "）") Logger.Warn(ex, $"确认崩溃日志时间失败（{LogFile}）")
End Try End Try
Next Next
If Not RightLogs.Any() Then Log("[Crash] 未发现可能可用的日志文件") If Not RightLogs.Any() Then Logger.Info("未发现可能可用的日志文件")
'将可能可用的日志文件导出 '将可能可用的日志文件导出
For Each FilePath In RightLogs For Each FilePath In RightLogs
Try Try
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath).Split(vbCrLf.ToCharArray))) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, FileUtils.ReadAsLines(FilePath)))
Catch ex As Exception Catch ex As Exception
Log(ex, "读取可能的崩溃日志文件失败（" & FilePath & "）") Logger.Warn(ex, $"读取可能的崩溃日志文件失败（{FilePath}）")
End Try End Try
Next Next
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
Dim RawOutput As String = LatestLog.Join(vbCrLf) Dim RawOutput As String = LatestLog.Join(vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容：" & vbCrLf & RawOutput) Logger.Info($"以下为游戏输出的最后一段内容：{vbCrLf}{RawOutput}")
FileUtils.Write(TempFolder & "RawOutput.log", RawOutput) FileUtils.Write(TempFolder & "RawOutput.log", RawOutput)
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray)) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray))
LatestLog.Clear() LatestLog.Clear()
End If End If
Log("[Crash] 步骤 1：收集日志文件完成，收集到 " & AnalyzeRawFiles.Count & " 个文件") Logger.Info($"步骤 1：收集日志文件完成，收集到 {AnalyzeRawFiles.Count} 个文件")
End Sub End Sub
''' <summary> ''' <summary>
''' 从文件路径直接导入日志文件或崩溃报告压缩包。 ''' 从文件路径直接导入日志文件或崩溃报告压缩包。
''' </summary> ''' </summary>
Public Sub Import(FilePath As String) Public Sub Import(FilePath As String)
Log("[Crash] 步骤 1：自主导入日志文件") Logger.Info("步骤 1：自主导入日志文件")
'尝试视作压缩包解压 '尝试视作压缩包解压
Try Try
Dim Info As New FileInfo(FilePath) Dim Info = FileUtils.GetInfo(FilePath)
If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then
ExtractCompressedFile(FilePath, TempFolder & "Temp\") FileUtils.ExtractToDirectory(FilePath, TempFolder & "Temp\")
Log("[Crash] 已解压导入的日志文件：" & FilePath) Logger.Info($"已解压导入的日志文件：{FilePath}")
GoTo Extracted GoTo Extracted
End If End If
Catch Catch
End Try End Try
'并非压缩包 '并非压缩包
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath)) FileUtils.Copy(FilePath, TempFolder & "Temp\" & PathUtils.GetLastPart(FilePath))
Log("[Crash] 已复制导入的日志文件：" & FilePath) Logger.Info($"已复制导入的日志文件：{FilePath}")
Extracted: Extracted:
'导入其中的日志文件 '导入其中的日志文件
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList() For Each TargetFile As FileInfo In DirectoryUtils.GetInfo(TempFolder & "Temp\").EnumerateFiles
Try Try
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.Lower Dim Ext As String = TargetFile.Extension.Lower
If Ext = ".log" OrElse Ext = ".txt" Then If Ext = ".log" OrElse Ext = ".txt" Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray))) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(
PathUtils.RemoveExtendedPrefix(TargetFile.FullName), FileUtils.ReadAsLines(TargetFile.FullName)))
Else Else
File.Delete(TargetFile.FullName) FileUtils.Delete(TargetFile.FullName)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "导入单个日志文件失败") Logger.Warn(ex, "导入单个日志文件失败")
End Try End Try
Next Next
Log("[Crash] 步骤 1：自主导入日志文件，收集到 " & AnalyzeRawFiles.Count & " 个文件") Logger.Info($"步骤 1：自主导入日志文件，收集到 {AnalyzeRawFiles.Count} 个文件")
End Sub End Sub
'2：确认实际用于分析的 Log 文本 '2：确认实际用于分析的 Log 文本
@@ -141,25 +137,25 @@ Extracted:
''' 返回是否有足够信息可用于分析。 ''' 返回是否有足够信息可用于分析。
''' </summary> ''' </summary>
Public Function Prepare() As Boolean Public Function Prepare() As Boolean
Log("[Crash] 步骤 2：准备日志文本") Logger.Info("步骤 2：准备日志文本")
'对日志文件进行分类 '对日志文件进行分类
DirectFile = Nothing DirectFile = Nothing
Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))) Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
For Each LogFile In AnalyzeRawFiles For Each LogFile In AnalyzeRawFiles
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).Lower Dim MatchName As String = PathUtils.GetLastPart(LogFile.Key).Lower
Dim TargetType As AnalyzeFileType Dim TargetType As AnalyzeFileType
If MatchName.StartsWithF("hs_err") Then If MatchName.StartsWithF("hs_err") Then
TargetType = AnalyzeFileType.HsErr TargetType = AnalyzeFileType.HsErr
DirectFile = LogFile If DirectFile Is Nothing Then DirectFile = LogFile
ElseIf MatchName.StartsWithF("crash-") Then ElseIf MatchName.StartsWithF("crash-") Then
TargetType = AnalyzeFileType.CrashReport TargetType = AnalyzeFileType.CrashReport
DirectFile = LogFile If DirectFile Is Nothing Then DirectFile = LogFile
ElseIf MatchName = "latest.log" OrElse MatchName = "latest log.txt" OrElse ElseIf MatchName = "latest.log" OrElse MatchName = "latest log.txt" OrElse
MatchName = "debug.log" OrElse MatchName = "debug log.txt" OrElse MatchName = "debug.log" OrElse MatchName = "debug log.txt" OrElse
MatchName = "游戏崩溃前的输出.txt" OrElse MatchName = "rawoutput.log" Then MatchName = "游戏崩溃前的输出.txt" OrElse MatchName = "rawoutput.log" Then
TargetType = AnalyzeFileType.MinecraftLog TargetType = AnalyzeFileType.MinecraftLog
If DirectFile Is Nothing Then DirectFile = LogFile DirectFile = LogFile
ElseIf MatchName = "启动器日志.txt" OrElse MatchName = "PCL2 启动器日志.txt" OrElse MatchName = "PCL 启动器日志.txt" OrElse MatchName = "log1.txt" Then ElseIf MatchName = "启动器日志.txt" OrElse MatchName = "PCL2 启动器日志.txt" OrElse MatchName = "PCL 启动器日志.txt" OrElse MatchName = "log1.txt" Then
If LogFile.Value.Any(Function(s) s.Contains("以下为游戏输出的最后一段内容")) Then If LogFile.Value.Any(Function(s) s.Contains("以下为游戏输出的最后一段内容")) Then
TargetType = AnalyzeFileType.MinecraftLog TargetType = AnalyzeFileType.MinecraftLog
@@ -172,20 +168,20 @@ Extracted:
ElseIf MatchName.EndsWithF(".txt", True) Then ElseIf MatchName.EndsWithF(".txt", True) Then
TargetType = AnalyzeFileType.ExtraReportFile TargetType = AnalyzeFileType.ExtraReportFile
Else Else
Log("[Crash] " & MatchName & " 分类为 Ignore") Logger.Info($"{MatchName} 分类为 Ignore")
Continue For Continue For
End If End If
If LogFile.Value.Any Then If LogFile.Value.Any Then
AllFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile)) AllFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
Log("[Crash] " & MatchName & " 分类为 " & GetStringFromEnum(TargetType)) Logger.Info($"{MatchName} 分类为 {TargetType}")
Else Else
Log("[Crash] " & MatchName & " 由于内容为空跳过") Logger.Info($"{MatchName} 由于内容为空跳过")
End If End If
Next Next
'若只有额外日志，则将它们视作 Minecraft 日志 '若只有额外日志，则将它们视作 Minecraft 日志
If AllFiles.Any() AndAlso AllFiles.All(Function(p) p.Key = AnalyzeFileType.ExtraLogFile) Then If AllFiles.Any() AndAlso AllFiles.All(Function(p) p.Key = AnalyzeFileType.ExtraLogFile) Then
Log("[Crash] 由于仅发现了额外日志，将它们视作 Minecraft 日志进行分析") Logger.Info("由于仅发现了额外日志，将它们视作 Minecraft 日志进行分析")
AllFiles = AllFiles.Select(Function(p) New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(AnalyzeFileType.MinecraftLog, p.Value)).ToList AllFiles = AllFiles.Select(Function(p) New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(AnalyzeFileType.MinecraftLog, p.Value)).ToList
End If End If
@@ -205,9 +201,9 @@ Extracted:
Dim DatedFiles As New SortedList(Of Date, KeyValuePair(Of String, String()))() Dim DatedFiles As New SortedList(Of Date, KeyValuePair(Of String, String()))()
For Each File In SelectedFiles For Each File In SelectedFiles
Try Try
DatedFiles.Add(New FileInfo(File.Key).LastWriteTime, File) DatedFiles.Add(FileUtils.GetInfo(File.Key).LastWriteTime, File)
Catch ex As Exception Catch ex As Exception
Log(ex, "获取日志文件修改时间失败") Logger.Warn(ex, "获取日志文件修改时间失败")
DatedFiles.Add(New Date(1900, 1, 1), File) DatedFiles.Add(New Date(1900, 1, 1), File)
End Try End Try
Next Next
@@ -216,12 +212,12 @@ Extracted:
OutputFiles.Add(NewestFile.Key) OutputFiles.Add(NewestFile.Key)
If SelectType = AnalyzeFileType.HsErr Then If SelectType = AnalyzeFileType.HsErr Then
LogHs = GetHeadTailLines(NewestFile.Value, 200, 100) LogHs = GetHeadTailLines(NewestFile.Value, 200, 100)
Log("[Crash] 输出报告：" & NewestFile.Key & "，作为虚拟机错误信息") Logger.Info($"输出报告：{NewestFile.Key}，作为虚拟机错误信息")
Log("[Crash] 导入分析：" & NewestFile.Key & "，作为虚拟机错误信息") Logger.Info($"导入分析：{NewestFile.Key}，作为虚拟机错误信息")
Else Else
LogCrash = GetHeadTailLines(NewestFile.Value, 300, 700) LogCrash = GetHeadTailLines(NewestFile.Value, 300, 700)
Log("[Crash] 输出报告：" & NewestFile.Key & "，作为 Minecraft 崩溃报告") Logger.Info($"输出报告：{NewestFile.Key}，作为 Minecraft 崩溃报告")
Log("[Crash] 导入分析：" & NewestFile.Key & "，作为 Minecraft 崩溃报告") Logger.Info($"导入分析：{NewestFile.Key}，作为 Minecraft 崩溃报告")
End If End If
Case AnalyzeFileType.MinecraftLog Case AnalyzeFileType.MinecraftLog
LogMc = "" LogMc = ""
@@ -229,9 +225,9 @@ Extracted:
'创建文件名词典 '创建文件名词典
Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String())) Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String()))
For Each SelectedFile In SelectedFiles For Each SelectedFile In SelectedFiles
FileNameDict(GetFileNameFromPath(SelectedFile.Key).Lower) = SelectedFile FileNameDict(PathUtils.GetLastPart(SelectedFile.Key).Lower) = SelectedFile
OutputFiles.Add(SelectedFile.Key) OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告：" & SelectedFile.Key & "，作为 Minecraft 或启动器日志") Logger.Info($"输出报告：{SelectedFile.Key}，作为 Minecraft 或启动器日志")
Next Next
'选择一份最佳的来自启动器的游戏日志 '选择一份最佳的来自启动器的游戏日志
For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt", "PCL 启动器日志.txt"} For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt", "PCL 启动器日志.txt"}
@@ -244,13 +240,13 @@ Extracted:
LogMc += Line & vbLf LogMc += Line & vbLf
ElseIf Line.Contains("以下为游戏输出的最后一段内容") Then ElseIf Line.Contains("以下为游戏输出的最后一段内容") Then
HasLauncherMark = True HasLauncherMark = True
Log("[Crash] 找到 PCL 输出的游戏实时日志头") Logger.Info("找到 PCL 输出的游戏实时日志头")
End If End If
Next Next
'导入后 500 行 '导入后 500 行
If Not HasLauncherMark Then LogMc += GetHeadTailLines(CurrentLog.Value, 0, 500) If Not HasLauncherMark Then LogMc += GetHeadTailLines(CurrentLog.Value, 0, 500)
LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray) LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为启动器日志") Logger.Info($"导入分析：{CurrentLog.Key}，作为启动器日志")
Exit For Exit For
Next Next
'选择一份最佳的 Minecraft Log '选择一份最佳的 Minecraft Log
@@ -258,7 +254,7 @@ Extracted:
If Not FileNameDict.ContainsKey(FileName) Then Continue For If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName) Dim CurrentLog = FileNameDict(FileName)
LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500) LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为 Minecraft 日志") Logger.Info($"导入分析：{CurrentLog.Key}，作为 Minecraft 日志")
Exit For Exit For
Next Next
'查找 Debug Log '查找 Debug Log
@@ -266,7 +262,7 @@ Extracted:
If Not FileNameDict.ContainsKey(FileName) Then Continue For If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName) Dim CurrentLog = FileNameDict(FileName)
LogMcDebug += GetHeadTailLines(CurrentLog.Value, 1000, 0) LogMcDebug += GetHeadTailLines(CurrentLog.Value, 1000, 0)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为 Minecraft Debug 日志") Logger.Info($"导入分析：{CurrentLog.Key}，作为 Minecraft Debug 日志")
Exit For Exit For
Next Next
'兜底 '兜底
@@ -276,7 +272,7 @@ Extracted:
ElseIf FileNameDict.Any() Then '如果都没有找到，则使用第一个文件 ElseIf FileNameDict.Any() Then '如果都没有找到，则使用第一个文件
Dim CurrentLog = FileNameDict.First.Value Dim CurrentLog = FileNameDict.First.Value
LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500) LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为兜底日志") Logger.Info($"导入分析：{CurrentLog.Key}，作为兜底日志")
Else Else
LogMc = Nothing LogMc = Nothing
Throw New Exception("无法找到匹配的 Minecraft Log") Throw New Exception("无法找到匹配的 Minecraft Log")
@@ -287,21 +283,22 @@ Extracted:
'全部丢过去 '全部丢过去
For Each SelectedFile In SelectedFiles For Each SelectedFile In SelectedFiles
OutputFiles.Add(SelectedFile.Key) OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告：" & SelectedFile.Key & "，不用作分析") Logger.Info($"输出报告：{SelectedFile.Key}，不用作分析")
Next Next
End Select End Select
Catch ex As Exception Catch ex As Exception
Log(ex, "分类处理日志文件时出错") Logger.Warn(ex, "分类处理日志文件时出错")
End Try End Try
Next Next
'结束 '结束
Prepare = LogMc IsNot Nothing OrElse LogHs IsNot Nothing OrElse LogCrash IsNot Nothing Dim Result = LogMc IsNot Nothing OrElse LogHs IsNot Nothing OrElse LogCrash IsNot Nothing
If Prepare Then If Result Then
Log(("[Crash] 步骤 2：准备日志文本完成，找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogMcDebug Is Nothing, "", "游戏 Debug 日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、") & "用作分析") Logger.Info($"{("[Crash] 步骤 2：准备日志文本完成，找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogMcDebug Is Nothing, "", "游戏 Debug 日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、")}用作分析")
Else Else
Log("[Crash] 步骤 2：准备日志文本完成，没有任何可供分析的日志") Logger.Info("步骤 2：准备日志文本完成，没有任何可供分析的日志")
End If End If
Return Result
End Function End Function
''' <summary> ''' <summary>
''' 输出字符串的前后某些行，并统一行尾为 vbLf (正则 \n)、删除空行和重复行。 ''' 输出字符串的前后某些行，并统一行尾为 vbLf (正则 \n)、删除空行和重复行。
@@ -392,7 +389,7 @@ Extracted:
''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。 ''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。
''' </summary> ''' </summary>
Public Sub Analyze() Public Sub Analyze()
Log("[Crash] 步骤 3：分析崩溃原因") Logger.Info("步骤 3：分析崩溃原因")
LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "") LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "")
'1. 精准日志匹配，中/高优先级 '1. 精准日志匹配，中/高优先级
@@ -406,21 +403,21 @@ Extracted:
Dim Keywords As New List(Of String) Dim Keywords As New List(Of String)
'崩溃日志 '崩溃日志
If LogCrash IsNot Nothing Then If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析") Logger.Info("开始进行崩溃日志堆栈分析")
Keywords.AddRange(AnalyzeStackKeyword(LogCrash.BeforeFirst("System Details"))) Keywords.AddRange(AnalyzeStackKeyword(LogCrash.BeforeFirst("System Details")))
End If End If
'Minecraft 日志 'Minecraft 日志
If LogMc IsNot Nothing Then If LogMc IsNot Nothing Then
Dim Fatals As List(Of String) = RegexSearch(LogMc, "/FATAL] .+?(?=[\n]+\[)") Dim Fatals As List(Of String) = LogMc.RegexSearch("/FATAL] .+?(?=[\n]+\[)").ToList
If LogMc.Contains("Unreported exception thrown!") Then Fatals.Add(LogMc.Between("Unreported exception thrown!", "at oolloo.jlw.Wrapper")) If LogMc.Contains("Unreported exception thrown!") Then Fatals.Add(LogMc.Between("Unreported exception thrown!", "at oolloo.jlw.Wrapper"))
Log("[Crash] 开始进行 Minecraft 日志堆栈分析，发现 " & Fatals.Count & " 个报错项") Logger.Info($"开始进行 Minecraft 日志堆栈分析，发现 {Fatals.Count} 个报错项")
For Each Fatal In Fatals For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal)) Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next Next
End If End If
'虚拟机日志 '虚拟机日志
If LogHs IsNot Nothing Then If LogHs IsNot Nothing Then
Log("[Crash] 开始进行虚拟机堆栈分析") Logger.Info("开始进行虚拟机堆栈分析")
Dim StackLogs As String = LogHs.Between("T H R E A D", "Registers:") Dim StackLogs As String = LogHs.Between("T H R E A D", "Registers:")
Keywords.AddRange(AnalyzeStackKeyword(StackLogs)) Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
End If End If
@@ -435,7 +432,7 @@ Extracted:
GoTo Done GoTo Done
End If End If
Else Else
Log("[Crash] 可能并未安装 Mod，不进行堆栈分析") Logger.Info("可能并未安装 Mod，不进行堆栈分析")
End If End If
'3. 精准日志匹配，低优先级 '3. 精准日志匹配，低优先级
@@ -444,27 +441,27 @@ Extracted:
'输出到日志 '输出到日志
Done: Done:
If Not CrashReasons.Any() Then If Not CrashReasons.Any() Then
Log("[Crash] 步骤 3：分析崩溃原因完成，未找到可能的原因") Logger.Info("步骤 3：分析崩溃原因完成，未找到可能的原因")
Else Else
Log("[Crash] 步骤 3：分析崩溃原因完成，找到 " & CrashReasons.Count & " 条可能的原因") Logger.Info($"步骤 3：分析崩溃原因完成，找到 {CrashReasons.Count} 条可能的原因")
For Each Reason In CrashReasons For Each Reason In CrashReasons
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "（" & Reason.Value.Join("；"c) & "）", "")) Logger.Info($"- {Reason.Key}{If(Reason.Value.Any, "（" & Reason.Value.Join("；"c) & "）", "")}")
Next Next
End If End If
End Sub End Sub
''' <summary> ''' <summary>
''' 增加一个可能的崩溃原因。 ''' 增加一个可能的崩溃原因。
''' </summary> ''' </summary>
Private Sub AppendReason(Reason As CrashReason, Optional Additional As ICollection(Of String) = Nothing) Private Sub AppendReason(Reason As CrashReason, Optional Additional As IEnumerable(Of String) = Nothing)
If CrashReasons.ContainsKey(Reason) Then If CrashReasons.ContainsKey(Reason) Then
If Additional IsNot Nothing Then If Additional IsNot Nothing Then
CrashReasons(Reason).AddRange(Additional) CrashReasons(Reason).AddRange(Additional)
CrashReasons(Reason) = CrashReasons(Reason).Distinct.ToList CrashReasons(Reason) = CrashReasons(Reason).Distinct.ToList
End If End If
Else Else
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {}))) CrashReasons.Add(Reason, New List(Of String)(If(Additional, {}).ToList))
End If End If
Log("[Crash] 可能的崩溃原因：" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "（" & Additional.Join("；"c) & "）", "")) Logger.Info($"可能的崩溃原因：{Reason}{If(Additional IsNot Nothing AndAlso Additional.Any, "（" & Additional.Join("；"c) & "）", "")}")
End Sub End Sub
Private Sub AppendReason(Reason As CrashReason, Additional As String) Private Sub AppendReason(Reason As CrashReason, Additional As String)
AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional})) AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional}))
@@ -485,7 +482,7 @@ Done:
'崩溃报告分析，高优先级 '崩溃报告分析，高优先级
If LogCrash IsNot Nothing Then If LogCrash IsNot Nothing Then
If LogCrash.Contains("Unable to make protected final java.lang.Class java.lang.ClassLoader.defineClass") Then AppendReason(CrashReason.Java版本过高) If LogCrash.Contains("Unable to make protected final java.lang.Class java.lang.ClassLoader.defineClass") Then AppendReason(CrashReason.Java版本过高)
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)}) '#7071 If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(LogCrash.RegexSeek("(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(LogCrash.RegexSeek("(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)}) '#7071
End If End If
'游戏日志分析 '游戏日志分析
@@ -495,7 +492,6 @@ Done:
If LogMc.Contains("The driver does not appear to support OpenGL") Then AppendReason(CrashReason.显卡不支持OpenGL) If LogMc.Contains("The driver does not appear to support OpenGL") Then AppendReason(CrashReason.显卡不支持OpenGL)
If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK) If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("java.lang.ClassCastException: class jdk.") Then AppendReason(CrashReason.使用JDK) If LogMc.Contains("java.lang.ClassCastException: class jdk.") Then AppendReason(CrashReason.使用JDK)
If LogMc.Contains("TRANSFORMER/net.optifine/net.optifine.reflect.Reflector.<clinit>(Reflector.java") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.texture.SpriteContents.<init>") Then AppendReason(CrashReason.OptiFine与Forge不兼容) If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.texture.SpriteContents.<init>") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'java.lang.String com.mojang.blaze3d.systems.RenderSystem.getBackendDescription") Then AppendReason(CrashReason.OptiFine与Forge不兼容) If LogMc.Contains("java.lang.NoSuchMethodError: 'java.lang.String com.mojang.blaze3d.systems.RenderSystem.getBackendDescription") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.block.model.BakedQuad.<init>") Then AppendReason(CrashReason.OptiFine与Forge不兼容) If LogMc.Contains("java.lang.NoSuchMethodError: 'void net.minecraft.client.renderer.block.model.BakedQuad.<init>") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
@@ -515,7 +511,7 @@ Done:
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与OptiFine同时安装) If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与OptiFine同时安装)
If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") OrElse LogMc.Contains("java.lang.NoSuchMethodError: 'void sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容) If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") OrElse LogMc.Contains("java.lang.NoSuchMethodError: 'void sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容)
If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误) If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误)
If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf)) If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(LogMc.RegexSeek("(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf))
If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足) If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足)
If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界) If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界)
If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容) If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容)
@@ -536,18 +532,18 @@ Done:
End If End If
End If End If
'确定的 Mod 导致崩溃 '确定的 Mod 导致崩溃
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray))) If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(LogMc.RegexSeek("(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'Mod 重复 / 前置问题 'Mod 重复 / 前置问题
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, LogMc.RegexSearch("(?<=\n\t[\w]+ : [A-Z]:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, If(LogMc.RegexSeek("Found a duplicate mod[^\n]+"), "").RegexSearch("[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList) If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, LogMc.RegexSearch("(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, If(LogMc.RegexSeek("ModResolutionException: Duplicate[^\n]+"), "").RegexSearch("[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Incompatible mods found!") Then '#5006, #5115 If LogMc.Contains("Incompatible mods found!") Then '#5006, #5115
AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), "").BeforeFirst("更多信息：").Replace("Some of your mods are incompatible with the game or each other!", "").Trim((vbCrLf & " ").ToCharArray)) AppendReason(CrashReason.Mod互不兼容, If(LogMc.RegexSeek("(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), "").BeforeFirst("更多信息：").Replace("Some of your mods are incompatible with the game or each other!", "").Trim((vbCrLf & " ").ToCharArray))
End If End If
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
AppendReason(CrashReason.Mod缺少前置或MC版本错误, AppendReason(CrashReason.Mod缺少前置或MC版本错误,
RegexSearch(LogMc, "(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase). LogMc.RegexSearch("(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase).
Select(Function(s) s.Trim((vbCrLf & vbTab & " ").ToCharArray)).Distinct().ToList()) Select(Function(s) s.Trim((vbCrLf & vbTab & " ").ToCharArray)).Distinct().ToList())
End If End If
End If End If
@@ -569,19 +565,19 @@ Done:
If LogCrash.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足) If LogCrash.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式) If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃) If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃)
If LogCrash.Contains("has mods that were not found") AndAlso RegexCheck(LogCrash, "The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容) If LogCrash.Contains("has mods that were not found") AndAlso LogCrash.RegexCheck("The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
'Mod 导致的崩溃 'Mod 导致的崩溃
If LogCrash.Contains("-- MOD ") Then If LogCrash.Contains("-- MOD ") Then
Dim LogCrashMod As String = LogCrash.Between("-- MOD ", "Failure message:") Dim LogCrashMod As String = LogCrash.Between("-- MOD ", "Failure message:")
If LogCrashMod.ContainsIgnoreCase(".jar") Then If LogCrashMod.ContainsIgnoreCase(".jar") Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrashMod, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray)) AppendReason(CrashReason.确定Mod导致游戏崩溃, If(LogCrashMod.RegexSeek("(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Else Else
AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray)) AppendReason(CrashReason.Mod加载器报错, If(LogCrash.RegexSeek("(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
End If End If
End If End If
If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(LogCrash.RegexSeek("(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(LogCrash.RegexSeek("(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)}) If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(LogCrash.RegexSeek("(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(LogCrash.RegexSeek("(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)})
End If End If
End Sub End Sub
@@ -600,14 +596,14 @@ Done:
LogText.Contains("mixin.injection.throwables.") OrElse LogText.Contains(".json] FAILED during )") LogText.Contains("mixin.injection.throwables.") OrElse LogText.Contains(".json] FAILED during )")
If Not IsMixin Then Return False If Not IsMixin Then Return False
'Mod 名称匹配 'Mod 名称匹配
Dim ModName As String = RegexSeek(LogText, "(?<=from mod )[^.\/ ]+(?=\] from)") Dim ModName As String = LogText.RegexSeek("(?<=from mod )[^.\/ ]+(?=\] from)")
If ModName Is Nothing Then ModName = RegexSeek(LogText, "(?<=for mod )[^.\/ ]+(?= failed)") If ModName Is Nothing Then ModName = LogText.RegexSeek("(?<=for mod )[^.\/ ]+(?= failed)")
If ModName IsNot Nothing Then If ModName IsNot Nothing Then
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(ModName.TrimEnd((vbCrLf & " ").ToCharArray))) AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(ModName.TrimEnd((vbCrLf & " ").ToCharArray)))
Return True Return True
End If End If
'JSON 名称匹配 'JSON 名称匹配
For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(])[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline) For Each JsonName In LogText.RegexSearch("(?<=^[^\t]+[ \[{(])[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
AppendReason(CrashReason.ModMixin失败, AppendReason(CrashReason.ModMixin失败,
TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", ""))) TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
Return True Return True
@@ -622,12 +618,12 @@ Done:
'Mixin 崩溃 'Mixin 崩溃
Dim IsMixin As Boolean = MixinAnalyze(LogMc) Dim IsMixin As Boolean = MixinAnalyze(LogMc)
'常规信息 '常规信息
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf)) If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, LogMc.RegexSeek("(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf)) If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, If(LogMc.RegexSeek("(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), "").RegexSearch("(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf)) If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, If(LogMc.RegexSeek("(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), "").RegexSearch("(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("确定了一种可能的解决方法，这样做可能会解决你的问题：") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法，这样做可能会解决你的问题：\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf)) If LogMc.Contains("确定了一种可能的解决方法，这样做可能会解决你的问题：") Then AppendReason(CrashReason.Fabric报错并给出解决方案, If(LogMc.RegexSeek("(?<=确定了一种可能的解决方法，这样做可能会解决你的问题：\n)(\s+ - [^\n]+\n)+"), "").RegexSearch("(?<=\s+)[^\n]+").Join(vbLf))
If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下，这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败 If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下，这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(LogMc.RegexSeek("(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If End If
End If End If
@@ -639,7 +635,7 @@ Done:
If LogCrash.Contains("Suspected Mod") Then If LogCrash.Contains("Suspected Mod") Then
Dim SuspectsRaw As String = LogCrash.Between("Suspected Mod", "Stacktrace") Dim SuspectsRaw As String = LogCrash.Between("Suspected Mod", "Stacktrace")
If Not SuspectsRaw.StartsWithF("s: None") Then 'Suspected Mods: None If Not SuspectsRaw.StartsWithF("s: None") Then 'Suspected Mods: None
Dim Suspects = RegexSearch(SuspectsRaw, "(?<=\n\t[^(\t]+\()[^)\n]+") Dim Suspects = SuspectsRaw.RegexSearch("(?<=\n\t[^(\t]+\()[^)\n]+")
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects)) If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
End If End If
End If End If
@@ -660,14 +656,14 @@ Done:
'Mod 解析错误（常见于 Fabric 前置校验失败） 'Mod 解析错误（常见于 Fabric 前置校验失败）
If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错) If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错)
'Mixin 失败可以导致大量 Mod 实例创建失败，因此需要放到低优先级中 'Mixin 失败可以导致大量 Mod 实例创建失败，因此需要放到低优先级中
If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf))) If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(LogMc.RegexSeek("(?<=Failed to create mod instance. ModID: )[^,]+"), If(LogMc.RegexSeek("(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf)))
'注意：Fabric 的 Warnings were found! 不一定是崩溃原因，它可能是单纯的警报 '注意：Fabric 的 Warnings were found! 不一定是崩溃原因，它可能是单纯的警报
End If End If
'崩溃报告分析 '崩溃报告分析
If LogCrash IsNot Nothing Then If LogCrash IsNot Nothing Then
If LogCrash.Contains(vbTab & "Block location: World: ") Then AppendReason(CrashReason.特定方块导致崩溃, If(RegexSeek(LogCrash, "(?<=\tBlock: Block\{)[^\}]+"), "") & " " & If(RegexSeek(LogCrash, "(?<=\tBlock location: World: )\([^\)]+\)"), "")) If LogCrash.Contains(vbTab & "Block location: World: ") Then AppendReason(CrashReason.特定方块导致崩溃, If(LogCrash.RegexSeek("(?<=\tBlock: Block\{)[^\}]+"), "") & " " & If(LogCrash.RegexSeek("(?<=\tBlock location: World: )\([^\)]+\)"), ""))
If LogCrash.Contains(vbTab & "Entity's Exact location: ") Then AppendReason(CrashReason.特定实体导致崩溃, If(RegexSeek(LogCrash, "(?<=\tEntity Type: )[^\n]+(?= \()"), "") & " (" & If(RegexSeek(LogCrash, "(?<=\tEntity's Exact location: )[^\n]+"), "").TrimEnd(vbCrLf.ToCharArray) & ")") If LogCrash.Contains(vbTab & "Entity's Exact location: ") Then AppendReason(CrashReason.特定实体导致崩溃, If(LogCrash.RegexSeek("(?<=\tEntity Type: )[^\n]+(?= \()"), "") & " (" & If(LogCrash.RegexSeek("(?<=\tEntity's Exact location: )[^\n]+"), "").TrimEnd(vbCrLf.ToCharArray) & ")")
End If End If
End Sub End Sub
@@ -679,8 +675,8 @@ Done:
'进行正则匹配 '进行正则匹配
Dim StackSearchResults As New List(Of String) Dim StackSearchResults As New List(Of String)
StackSearchResults.AddRange(RegexSearch(ErrorStack, "(?<=\n[^{]+)[a-zA-Z_]+\w+\.[a-zA-Z_]+[\w\.]+(?=\.[\w\.$]+\.)")) StackSearchResults.AddRange(ErrorStack.RegexSearch("(?<=\n[^{]+)[a-zA-Z_]+\w+\.[a-zA-Z_]+[\w\.]+(?=\.[\w\.$]+\.)"))
StackSearchResults.AddRange(RegexSearch(ErrorStack, "(?<=at [^(]+?\.\w+\$\w+\$)[\w\$]+?(?=\$\w+\()").Select(Function(s) s.Replace("$", "."))) 'Mixin 堆栈：xxx.xxx.xxxx$xxxx$xxx StackSearchResults.AddRange(ErrorStack.RegexSearch("(?<=at [^(]+?\.\w+\$\w+\$)[\w\$]+?(?=\$\w+\()").Select(Function(s) s.Replace("$", "."))) 'Mixin 堆栈：xxx.xxx.xxxx$xxxx$xxx
StackSearchResults = StackSearchResults.Distinct.ToList StackSearchResults = StackSearchResults.Distinct.ToList
'检查堆栈开头 '检查堆栈开头
@@ -698,10 +694,10 @@ Done:
NextStack: NextStack:
Next Next
PossibleStacks = PossibleStacks.Distinct.ToList PossibleStacks = PossibleStacks.Distinct.ToList
Log("[Crash] 找到 " & PossibleStacks.Count & " 条可能的堆栈信息") Logger.Info($"找到 {PossibleStacks.Count} 条可能的堆栈信息")
If Not PossibleStacks.Any() Then Return New List(Of String) If Not PossibleStacks.Any() Then Return New List(Of String)
For Each Stack As String In PossibleStacks For Each Stack As String In PossibleStacks
Log("[Crash] - " & Stack) Logger.Info($"- {Stack}")
Next Next
'检查堆栈关键词 '检查堆栈关键词
@@ -724,10 +720,10 @@ NextStack:
Next Next
Next Next
PossibleWords = PossibleWords.Distinct.ToList PossibleWords = PossibleWords.Distinct.ToList
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词") Logger.Info($"从堆栈信息中找到 {PossibleWords.Count} 个可能的 Mod ID 关键词")
If PossibleWords.Any Then Log("[Crash] - " & PossibleWords.Join(", ")) If PossibleWords.Any Then Logger.Info($"- {PossibleWords.Join(", ")}")
If PossibleWords.Count > 10 Then If PossibleWords.Count > 10 Then
Log("[Crash] 关键词过多，考虑匹配出错，不纳入考虑") Logger.Info("关键词过多，考虑匹配出错，不纳入考虑")
Return New List(Of String) Return New List(Of String)
Else Else
Return PossibleWords Return PossibleWords
@@ -738,7 +734,7 @@ NextStack:
''' 根据 Mod 关键词尝试获取实际的 Mod 名称。 ''' 根据 Mod 关键词尝试获取实际的 Mod 名称。
''' 若失败则返回 Nothing。 ''' 若失败则返回 Nothing。
''' </summary> ''' </summary>
Private Function AnalyzeModName(Keywords As List(Of String)) As List(Of String) Private Function AnalyzeModName(Keywords As IEnumerable(Of String)) As List(Of String)
Dim ModFileNames As New List(Of String) Dim ModFileNames As New List(Of String)
'预处理关键词（分割括号） '预处理关键词（分割括号）
@@ -756,7 +752,7 @@ NextStack:
Dim IsFabricDetail As Boolean = Details.Contains("Fabric Mods") '是否为 Fabric 信息格式 Dim IsFabricDetail As Boolean = Details.Contains("Fabric Mods") '是否为 Fabric 信息格式
If IsFabricDetail Then If IsFabricDetail Then
Details = Details.Replace("Fabric Mods", "¨") Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式") Logger.Info("崩溃报告中检测到 Fabric Mod 信息格式")
End If End If
Details = Details.AfterLast("¨") Details = Details.AfterLast("¨")
@@ -765,9 +761,9 @@ NextStack:
Dim ModNameLines As New List(Of String) Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf) For Each Line In Details.Split(vbLf)
If (Line.ContainsIgnoreCase(".jar") AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar If (Line.ContainsIgnoreCase(".jar") AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line) (IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not Line.RegexCheck("\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行") Logger.Info($"崩溃报告中找到 {ModNameLines.Count} 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行 '获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String) Dim HintLines As New List(Of String)
@@ -781,18 +777,18 @@ NextStack:
Next Next
Next Next
HintLines = HintLines.Distinct.ToList HintLines = HintLines.Distinct.ToList
Log("[Crash] 崩溃报告中找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行") Logger.Info($"崩溃报告中找到 {HintLines.Count} 个可能的崩溃 Mod 匹配行")
For Each ModLine As String In HintLines For Each ModLine As String In HintLines
Log("[Crash] - " & ModLine) Logger.Info($"- {ModLine}")
Next Next
'从 Mod 匹配行中提取 .jar 文件的名称 '从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines For Each Line As String In HintLines
Dim Name As String Dim Name As String
If IsFabricDetail Then If IsFabricDetail Then
Name = RegexSeek(Line, "(?<=: )[^\n]+(?= [^\n]+)") Name = Line.RegexSeek("(?<=: )[^\n]+(?= [^\n]+)")
Else Else
Name = RegexSeek(Line, "(?<=\()[^\t]+.jar(?=\))|(?<=(\t\t)|(\| ))[^\t\|]+.jar", RegularExpressions.RegexOptions.IgnoreCase) Name = Line.RegexSeek("(?<=\()[^\t]+.jar(?=\))|(?<=(\t\t)|(\| ))[^\t\|]+.jar", RegularExpressions.RegexOptions.IgnoreCase)
End If End If
If Name IsNot Nothing Then ModFileNames.Add(Name) If Name IsNot Nothing Then ModFileNames.Add(Name)
Next Next
@@ -803,8 +799,8 @@ NextStack:
If LogMcDebug IsNot Nothing Then If LogMcDebug IsNot Nothing Then
'Forge: Found valid mod file YungsBetterStrongholds-1.20-Forge-4.0.1.jar with {betterstrongholds} mods - versions {1.20-Forge-4.0.1} 'Forge: Found valid mod file YungsBetterStrongholds-1.20-Forge-4.0.1.jar with {betterstrongholds} mods - versions {1.20-Forge-4.0.1}
Dim ModNameLines As List(Of String) = RegexSearch(LogMcDebug, "(?<=valid mod file ).*", RegularExpressions.RegexOptions.Multiline) Dim ModNameLines = LogMcDebug.RegexSearch("(?<=valid mod file ).*", RegularExpressions.RegexOptions.Multiline)
Log("[Crash] Debug 信息中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行") Logger.Info($"Debug 信息中找到 {ModNameLines.Count} 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行 '获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String) Dim HintLines As New List(Of String)
@@ -814,15 +810,15 @@ NextStack:
Next Next
Next Next
HintLines = HintLines.Distinct.ToList HintLines = HintLines.Distinct.ToList
Log("[Crash] Debug 信息中找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行") Logger.Info($"Debug 信息中找到 {HintLines.Count} 个可能的崩溃 Mod 匹配行")
For Each ModLine As String In HintLines For Each ModLine As String In HintLines
Log("[Crash] - " & ModLine) Logger.Info($"- {ModLine}")
Next Next
'从 Mod 匹配行中提取 .jar 文件的名称 '从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines For Each Line As String In HintLines
Dim Name As String Dim Name As String
Name = RegexSeek(Line, ".*(?= with)") Name = Line.RegexSeek(".*(?= with)")
If Name IsNot Nothing Then ModFileNames.Add(Name) If Name IsNot Nothing Then ModFileNames.Add(Name)
Next Next
@@ -833,9 +829,9 @@ NextStack:
If Not ModFileNames.Any() Then If Not ModFileNames.Any() Then
Return Nothing Return Nothing
Else Else
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名") Logger.Info($"找到 {ModFileNames.Count} 个可能的崩溃 Mod 文件名")
For Each ModFileName As String In ModFileNames For Each ModFileName As String In ModFileNames
Log("[Crash] - " & ModFileName) Logger.Info($"- {ModFileName}")
Next Next
Return ModFileNames Return ModFileNames
End If End If
@@ -851,9 +847,9 @@ NextStack:
''' <summary> ''' <summary>
''' 尝试从关键字获取 Mod 名称，若失败则返回原关键字。 ''' 尝试从关键字获取 Mod 名称，若失败则返回原关键字。
''' </summary> ''' </summary>
Private Function TryAnalyzeModName(Keywords As List(Of String)) As List(Of String) Private Function TryAnalyzeModName(Keywords As IEnumerable(Of String)) As List(Of String)
If Not Keywords.Any Then Return Keywords If Not Keywords.Any Then Return Keywords.ToList
Return If(AnalyzeModName(Keywords), Keywords) Return If(AnalyzeModName(Keywords), Keywords.ToList)
End Function End Function
'4：根据原因输出信息 '4：根据原因输出信息
@@ -866,11 +862,11 @@ NextStack:
FrmMain.ShowWindowToTop() FrmMain.ShowWindowToTop()
Dim Detail As String = GetAnalyzeResult(IsManualAnalyze) Dim Detail As String = GetAnalyzeResult(IsManualAnalyze)
Select Case MyMsgBox(Detail, If(IsManualAnalyze, "错误报告分析结果", "Minecraft 出现错误"), Select Case MyMsgBox(Detail, If(IsManualAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsManualAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsManualAnalyze, "", "导出错误报告"), "确定", If(IsManualAnalyze OrElse DirectFile Is Nothing, "", "查看输出"), If(IsManualAnalyze, "", "导出错误报告"),
Button2Action:=If(IsManualAnalyze OrElse DirectFile Is Nothing, Nothing, Button2Action:=If(IsManualAnalyze OrElse DirectFile Is Nothing, Nothing,
Sub() Sub()
'弹窗选择：查看日志 '弹窗选择：查看输出
If File.Exists(DirectFile.Value.Key) Then If FileUtils.Exists(DirectFile.Value.Key) Then
StartProcess(DirectFile.Value.Key) StartProcess(DirectFile.Value.Key)
Else Else
Dim FilePath As String = PathTemp & "Crash.txt" Dim FilePath As String = PathTemp & "Crash.txt"
@@ -883,17 +879,16 @@ NextStack:
Dim FileAddress As String = Nothing Dim FileAddress As String = Nothing
Try Try
'获取文件路径 '获取文件路径
RunInUiWait(Sub() FileAddress = SelectSaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip")) RunInUiWait(Sub() FileAddress = Dialogs.SaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", filter:={("zip", "Minecraft 错误报告")}))
If String.IsNullOrEmpty(FileAddress) Then Return If FileAddress Is Nothing Then Return
If File.Exists(FileAddress) Then File.Delete(FileAddress) FileUtils.Delete(FileAddress)
DirectoryUtils.Create(FileAddress, isFilePath:=True)
'输出诊断信息 '输出诊断信息
FeedbackInfo() FeedbackInfo()
LogFlush() Logger.Instance.Flush()
'复制文件 '复制文件
If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles) If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles)
For Each OutputFile In OutputFiles For Each OutputFile In OutputFiles
Dim FileName As String = GetFileNameFromPath(OutputFile) Dim FileName As String = PathUtils.GetLastPart(OutputFile)
Dim FileEncoding As Encoding = Nothing Dim FileEncoding As Encoding = Nothing
Select Case FileName Select Case FileName
Case "LatestLaunch.bat" Case "LatestLaunch.bat"
@@ -905,23 +900,21 @@ NextStack:
FileName = "游戏崩溃前的输出.txt" FileName = "游戏崩溃前的输出.txt"
FileEncoding = Encoding.UTF8 FileEncoding = Encoding.UTF8
End Select End Select
If File.Exists(OutputFile) Then If Not FileUtils.Exists(OutputFile) Then Continue For
If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile)) Dim FileContent As String = FileUtils.ReadAsString(OutputFile, FileEncoding)
Dim FileContent As String = ReadFile(OutputFile, FileEncoding) FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*") FileUtils.Write(TempFolder & "Report\" & FileName, FileContent, FileEncoding)
FileUtils.Write(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding) Logger.Info($"导出错误报告文件：{FileName}")
Log($"[Crash] 导出文件：{FileName}，编码：{FileEncoding.HeaderName}")
End If
Next Next
'导出报告 '导出报告
Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress) FileUtils.CreateZipFromDirectory(FileAddress, TempFolder & "Report\")
DeleteDirectory(TempFolder & "Report\") DirectoryUtils.Delete(TempFolder & "Report\")
Hint("错误报告已导出！", HintType.Green) Hint("错误报告已导出！", HintType.Green)
OpenExplorer(FileAddress)
Catch ex As Exception Catch ex As Exception
Log(ex, "导出错误报告失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "导出错误报告失败")
Return Return
End Try End Try
OpenExplorer(FileAddress)
End Select End Select
'上报 '上报
If IsManualAnalyze Then Return If IsManualAnalyze Then Return
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+59 -57
View File
@@ -13,7 +13,7 @@
Instance = New McInstance(Instance.InheritName) Instance = New McInstance(Instance.InheritName)
Loop Loop
Catch ex As Exception Catch ex As Exception
Log(ex, "获取底层继承版本失败") Logger.Warn(ex, "获取底层继承版本失败")
End Try End Try
'检查 Json 是否标准 '检查 Json 是否标准
If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("client") Is Nothing OrElse Instance.JsonObject("downloads")("client")("url") Is Nothing Then If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("client") Is Nothing OrElse Instance.JsonObject("downloads")("client")("url") Is Nothing Then
@@ -39,7 +39,7 @@
'获取信息 '获取信息
Dim IndexInfo = McAssetsGetIndex(Instance, True, True) Dim IndexInfo = McAssetsGetIndex(Instance, True, True)
Dim IndexAddress As String = McFolderSelected & "assets\indexes\" & IndexInfo("id").ToString & ".json" Dim IndexAddress As String = McFolderSelected & "assets\indexes\" & IndexInfo("id").ToString & ".json"
Log("[Download] 版本 " & Instance.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString) Logger.Info($"版本 {Instance.Name} 对应的资源文件索引为 {IndexInfo("id")}")
Dim IndexUrl As String = If(IndexInfo("url"), "") Dim IndexUrl As String = If(IndexInfo("url"), "")
If IndexUrl = "" Then If IndexUrl = "" Then
Return Nothing Return Nothing
@@ -65,7 +65,7 @@
#Region "下载资源文件" #Region "下载资源文件"
If ShouldIgnoreFileCheck(Instance) Then If ShouldIgnoreFileCheck(Instance) Then
Log("[Download] 已跳过所有 Assets 检查") Logger.Info("已跳过所有 Assets 检查")
Else Else
Dim LoadersAssets As New List(Of LoaderBase) Dim LoadersAssets As New List(Of LoaderBase)
'获取资源文件索引地址 '获取资源文件索引地址
@@ -75,7 +75,7 @@
Dim IndexFile = DlClientAssetIndexGet(Instance) Dim IndexFile = DlClientAssetIndexGet(Instance)
If IndexFile Is Nothing Then If IndexFile Is Nothing Then
Task.Output = New List(Of NetFile) Task.Output = New List(Of NetFile)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", NotifyLevel.DebugModeOnly) Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile) Task.Output = New List(Of NetFile)
Else Else
@@ -96,7 +96,7 @@
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
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", NotifyLevel.DebugModeOnly) Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
Task.Interrupt() Task.Interrupt()
Throw New ThreadInterruptedException Throw New ThreadInterruptedException
End If End If
@@ -105,19 +105,19 @@
BackAssetsFile.LocalPath = TempAddress BackAssetsFile.LocalPath = TempAddress
Task.Output = New List(Of NetFile) From {BackAssetsFile} Task.Output = New List(Of NetFile) From {BackAssetsFile}
'检查是否需要更新：每天只更新一次 '检查是否需要更新：每天只更新一次
If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then If FileUtils.Exists(RealAddress) AndAlso Math.Abs((FileUtils.GetInfo(RealAddress).LastWriteTime.Date - Now.Date).TotalDays) < 1 Then
Log("[Download] 无需更新资源文件索引，取消") Logger.Info("无需更新资源文件索引，取消")
Task.Interrupt() Task.Interrupt()
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))
CopyFile(TempAddress, RealAddress) FileUtils.Copy(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功：" & TempAddress) McLaunchLog("后台更新资源文件索引成功：" & TempAddress)
End Sub)) End Sub))
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate) Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
Log("[Download] 开始后台检查资源文件索引") Logger.Info("开始后台检查资源文件索引")
Updater.Start() Updater.Start()
End If End If
'获取资源文件地址 '获取资源文件地址
@@ -158,8 +158,8 @@
Public Property AllDrops As List(Of Integer) Public Property AllDrops As List(Of Integer)
Get Get
If _AllDrops Is Nothing Then If _AllDrops Is Nothing Then
_AllDrops = Settings.Get("CacheDrops").ToString. _AllDrops = Settings.Get(Of String)("CacheDrops").ToString.
Split(",".ToCharArray, StringSplitOptions.RemoveEmptyEntries).Select(Function(d) CInt(Val(d))).ToList() Split(",", True).Select(Function(d) CInt(Val(d))).ToList()
End If End If
Return If(_AllDrops.Any, _AllDrops, Nothing) '不要将 _AllDrops 再设为 Nothing，以防止反复获取设置尝试初始化 Return If(_AllDrops.Any, _AllDrops, Nothing) '不要将 _AllDrops 再设为 Nothing，以防止反复获取设置尝试初始化
End Get End Get
@@ -191,7 +191,7 @@
''' </summary> ''' </summary>
Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain) Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult)) Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult))
Select Case Settings.Get("ToolDownloadVersion") Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
@@ -211,7 +211,9 @@
'提取所有 Drop 序数 '提取所有 Drop 序数
Dim Drops As New List(Of Integer) Dim Drops As New List(Of Integer)
For Each Version As JObject In Loader.Output.Value("versions") For Each Version As JObject In Loader.Output.Value("versions")
Dim Drop As Integer = McVersion.VersionToDrop(Version("id")) Dim Id As String = Version("id").ToString
If Id.Contains("-") Then Continue For
Dim Drop As Integer = McVersion.VersionToDrop(Id)
If Drop = 209 Then Continue For If Drop = 209 Then Continue For
Drops.Add(Drop) Drops.Add(Drop)
Next Next
@@ -233,10 +235,10 @@
If Not DlPreferMojang Then If Not DlPreferMojang Then
Dim DeltaTime = GetTimeMs() - StartTime Dim DeltaTime = GetTimeMs() - StartTime
DlPreferMojang = DeltaTime < 4000 DlPreferMojang = DeltaTime < 4000
Log($"[Download] Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}") Logger.Info($"Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
End If End If
'添加 PCL 特供项 '添加 PCL 特供项
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json"))) If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(FileUtils.ReadAsString(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 更新提示
@@ -244,16 +246,16 @@
Dim Version As String Dim Version As String
'快照版 '快照版
Version = Json("latest")("snapshot") Version = Json("latest")("snapshot")
If Settings.Get("ToolUpdateSnapshot") AndAlso Not Settings.Get("ToolUpdateSnapshotLast") = "" AndAlso If Settings.Get(Of Boolean)("ToolUpdateSnapshot") AndAlso Not Settings.Get(Of String)("ToolUpdateSnapshotLast") = "" AndAlso
Settings.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then Settings.Get(Of String)("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
IsHinted = True IsHinted = True
McDownloadClientUpdateHint(Version, Json) McDownloadClientUpdateHint(Version, Json)
End If End If
Settings.Set("ToolUpdateSnapshotLast", If(Version, "Nothing")) Settings.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
'正式版 '正式版
Version = Json("latest")("release") Version = Json("latest")("release")
If Settings.Get("ToolUpdateRelease") AndAlso Not Settings.Get("ToolUpdateReleaseLast") = "" AndAlso If Settings.Get(Of Boolean)("ToolUpdateRelease") AndAlso Not Settings.Get(Of String)("ToolUpdateReleaseLast") = "" AndAlso
Settings.Get("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then Settings.Get(Of String)("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
IsHinted = True IsHinted = True
McDownloadClientUpdateHint(Version, Json) McDownloadClientUpdateHint(Version, Json)
End If End If
@@ -272,7 +274,7 @@
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 File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json"))) If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(FileUtils.ReadAsString(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
@@ -313,10 +315,10 @@
For Each Version As JObject In DlClientListLoader.Output.Value("versions") For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then Return Version("url").ToString If Version("id") = Id Then Return Version("url").ToString
Next Next
Log($"未发现版本 {Id} 的 json 下载地址，版本列表返回为：{vbCrLf}{DlClientListLoader.Output.Value.ToString}", NotifyLevel.DebugModeOnly) Logger.Warn($"未发现版本 {Id} 的 json 下载地址，版本列表返回为：{vbCrLf}{DlClientListLoader.Output.Value}")
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
Log(ex, $"获取版本 {Id} 的 json 下载地址失败") Logger.Warn(ex, $"获取版本 {Id} 的 json 下载地址失败")
Return Nothing Return Nothing
End Try End Try
End Function End Function
@@ -385,7 +387,7 @@
''' </summary> ''' </summary>
Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain) Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain)
Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult)) Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Select Case Settings.Get("ToolDownloadVersion") Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30),
@@ -413,9 +415,9 @@
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）") If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）")
Try Try
'获取所有版本信息 '获取所有版本信息
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*") Dim Forge As List(Of String) = Result.RegexSearch("(?<=colForge'>)[^<]*").ToList
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+") Dim ReleaseTime As List(Of String) = Result.RegexSearch("(?<=colDate'>)[^<]+").ToList
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")") Dim Name As List(Of String) = Result.RegexSearch("(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")").ToList
If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应") If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应") If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）") If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）")
@@ -491,7 +493,7 @@
''' </summary> ''' </summary>
Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain) Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain)
Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult)) Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Select Case Settings.Get("ToolDownloadVersion") Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30),
@@ -518,7 +520,7 @@
Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", SimulateBrowserHeaders:=True) Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", SimulateBrowserHeaders:=True)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）") If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）")
'获取所有版本信息 '获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+((_pre|[_-]snapshot[_-]?)[0-9]?)?(?=.html)") Dim Names As List(Of String) = Result.RegexSearch("(?<=a href=""index_)[0-9.]+((_pre|[_-]snapshot[_-]?)[0-9]?)?(?=.html)").ToList
Names.Add("1.2.4") '1.2.4 不会被匹配上 Names.Add("1.2.4") '1.2.4 不会被匹配上
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）") If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）")
Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names} Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names}
@@ -640,7 +642,7 @@
Public Sub DlForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) Public Sub DlForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim DlForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Official", AddressOf DlForgeVersionOfficialMain) Dim DlForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Official", AddressOf DlForgeVersionOfficialMain)
Dim DlForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Bmclapi", AddressOf DlForgeVersionBmclapiMain) Dim DlForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Bmclapi", AddressOf DlForgeVersionBmclapiMain)
Select Case Settings.Get("ToolDownloadVersion") Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30),
@@ -669,7 +671,7 @@
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4，#4057 Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4，#4057
".html", SimulateBrowserHeaders:=True) ".html", SimulateBrowserHeaders:=True)
Catch ex As Exception Catch ex As Exception
If ex.GetBrief().Contains("(404)") Then If ex.GetDisplay(False).Contains("(404)") Then
Throw New Exception("无") Throw New Exception("无")
Else Else
Throw Throw
@@ -685,14 +687,14 @@
Dim VersionCode = VersionCodes(i) Dim VersionCode = VersionCodes(i)
Try Try
'基础信息获取 '基础信息获取
Dim Name As String = RegexSeek(VersionCode, "(?<=[^(0-9)]+)[0-9\.]+") Dim Name As String = VersionCode.RegexSeek("(?<=[^(0-9)]+)[0-9\.]+")
Dim IsRecommended As Boolean = VersionCode.Contains("fa promo-recommended") Dim IsRecommended As Boolean = VersionCode.Contains("fa promo-recommended")
Dim Inherit As String = Loader.Input Dim Inherit As String = Loader.Input
'分支获取 '分支获取
Dim Branch As String = RegexSeek(VersionCode, $"(?<=-{Name}-)[^-""]+(?=-[a-z]+.[a-z]{{3}})") Dim Branch As String = VersionCode.RegexSeek($"(?<=-{Name}-)[^-""]+(?=-[a-z]+.[a-z]{{3}})")
If String.IsNullOrWhiteSpace(Branch) Then Branch = Nothing If String.IsNullOrWhiteSpace(Branch) Then Branch = Nothing
'发布时间获取 '发布时间获取
Dim ReleaseTimeOriginal = RegexSeek(VersionCode, "(?<=""download-time"" title="")[^""]+") Dim ReleaseTimeOriginal = VersionCode.RegexSeek("(?<=""download-time"" title="")[^""]+")
Dim ReleaseTimeSplit = ReleaseTimeOriginal.Split(" -:".ToCharArray) '原格式："2021-02-15 03:24:02" Dim ReleaseTimeSplit = ReleaseTimeOriginal.Split(" -:".ToCharArray) '原格式："2021-02-15 03:24:02"
Dim ReleaseDate As New Date(ReleaseTimeSplit(0), ReleaseTimeSplit(1), ReleaseTimeSplit(2), '年月日 Dim ReleaseDate As New Date(ReleaseTimeSplit(0), ReleaseTimeSplit(1), ReleaseTimeSplit(2), '年月日
ReleaseTimeSplit(3), ReleaseTimeSplit(4), ReleaseTimeSplit(5), '时分秒 ReleaseTimeSplit(3), ReleaseTimeSplit(4), ReleaseTimeSplit(5), '时分秒
@@ -703,17 +705,17 @@
If VersionCode.Contains("classifier-installer""") Then If VersionCode.Contains("classifier-installer""") Then
'类型为 installer.jar，支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部) '类型为 installer.jar，支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部)
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("installer.jar")) VersionCode = VersionCode.Substring(VersionCode.IndexOfF("installer.jar"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+") MD5 = VersionCode.RegexSeek("(?<=MD5:</strong> )[^<]+")
Category = "installer" Category = "installer"
ElseIf VersionCode.Contains("classifier-universal""") Then ElseIf VersionCode.Contains("classifier-universal""") Then
'类型为 universal.zip，支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分) '类型为 universal.zip，支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分)
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("universal.zip")) VersionCode = VersionCode.Substring(VersionCode.IndexOfF("universal.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+") MD5 = VersionCode.RegexSeek("(?<=MD5:</strong> )[^<]+")
Category = "universal" Category = "universal"
ElseIf VersionCode.Contains("client.zip") Then ElseIf VersionCode.Contains("client.zip") Then
'类型为 client.zip，支持范围 182~ (1.3.2 部分 ~) '类型为 client.zip，支持范围 182~ (1.3.2 部分 ~)
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("client.zip")) VersionCode = VersionCode.Substring(VersionCode.IndexOfF("client.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+") MD5 = VersionCode.RegexSeek("(?<=MD5:</strong> )[^<]+")
Category = "client" Category = "client"
Else Else
'没有任何下载（1.6.4 有一部分这种情况） '没有任何下载（1.6.4 有一部分这种情况）
@@ -875,7 +877,7 @@
''' </summary> ''' </summary>
Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain) Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain)
Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult)) Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Select Case Settings.Get("ToolDownloadVersion") Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
@@ -931,7 +933,7 @@
End Sub End Sub
Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry) Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry)
Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson, Dim VersionNames = (LatestLegacyJson & LatestJson).RegexSearch(
"(?<="")(1\.20\.1-)?\d+\.[^\.]+\.\d+(\.\d+)?(-(beta|alpha)(\.\d+)?)?(\+snapshot-\d+)?(?="")") "(?<="")(1\.20\.1-)?\d+\.[^\.]+\.\d+(\.\d+)?(-(beta|alpha)(\.\d+)?)?(\+snapshot-\d+)?(?="")")
Dim Versions = VersionNames. Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中，但不能下载 Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中，但不能下载
@@ -1000,7 +1002,7 @@
''' </summary> ''' </summary>
Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain) Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain)
Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult)) Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Select Case Settings.Get("ToolDownloadVersion") Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30),
@@ -1099,7 +1101,7 @@
''' </summary> ''' </summary>
Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain) Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain)
Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult)) Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Select Case Settings.Get("ToolDownloadVersion") Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30),
@@ -1170,32 +1172,32 @@
''' </summary> ''' </summary>
Public Function DlModRequest(Url As String, Optional Method As HttpMethod = Nothing, Public Function DlModRequest(Url As String, Optional Method As HttpMethod = Nothing,
Optional Content As String = Nothing, Optional ContentType As String = Nothing) As JToken Optional Content As String = Nothing, Optional ContentType As String = Nothing) As JToken
Dim Urls As New List(Of KeyValuePair(Of String, Integer)) Dim Urls As New List(Of (Url As String, Timeout As Integer))
Dim McimUrl As String = DlSourceModGet(Url) Dim McimUrl As String = DlSourceModGet(Url)
If McimUrl <> Url Then If McimUrl <> Url Then
Select Case Settings.Get("ToolDownloadMod") Select Case Settings.Get(Of Integer)("ToolDownloadMod")
Case 0 Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) Urls.Add((McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) Urls.Add((McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) Urls.Add((Url, 30))
Case 1 Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10))) '至少 20s，要不然 Modrinth 返回不过来 Urls.Add((Url, If(Url.Contains("modrinth"), 20, 10))) '至少 20s，要不然 Modrinth 返回不过来
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) Urls.Add((McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) Urls.Add((Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) Urls.Add((McimUrl, 30))
Case Else Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10))) Urls.Add((Url, If(Url.Contains("modrinth"), 20, 10)))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) Urls.Add((Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) Urls.Add((McimUrl, 30))
End Select End Select
Else Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10))) Urls.Add((Url, If(Url.Contains("modrinth"), 20, 10)))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) Urls.Add((Url, 30))
End If End If
Dim Exs As String = "" Dim Exs As String = ""
For Each Source In Urls For Each Source In Urls
Try Try
Return GetJson(NetRequestByClient(Source.Key, Method, Content, ContentType, Timeout:=Source.Value * 1000, Encoding:=Encoding.UTF8, RequireJson:=True)) Return GetJson(NetRequestByClient(Source.Url, Method, Content, ContentType, Timeout:=Source.Timeout * 1000, Encoding:=Encoding.UTF8, RequireJson:=True))
Catch ex As Exception Catch ex As Exception
Exs += ex.Message + vbCrLf Exs += ex.Message + vbCrLf
End Try End Try
@@ -1213,7 +1215,7 @@
''' </summary> ''' </summary>
Public ReadOnly Property DlSourcePreferMojang As Boolean Public ReadOnly Property DlSourcePreferMojang As Boolean
Get Get
Return Settings.Get("ToolDownloadSource") = 2 OrElse (Settings.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang) Return Settings.Get(Of Integer)("ToolDownloadSource") = 2 OrElse (Settings.Get(Of Integer)("ToolDownloadSource") = 1 AndAlso DlPreferMojang)
End Get End Get
End Property End Property
''' <summary> ''' <summary>
@@ -1227,7 +1229,7 @@
''' </summary> ''' </summary>
Public ReadOnly Property DlVersionListPreferMojang As Boolean Public ReadOnly Property DlVersionListPreferMojang As Boolean
Get Get
Return Settings.Get("ToolDownloadVersion") = 2 OrElse (Settings.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang) Return Settings.Get(Of Integer)("ToolDownloadVersion") = 2 OrElse (Settings.Get(Of Integer)("ToolDownloadVersion") = 1 AndAlso DlPreferMojang)
End Get End Get
End Property End Property
''' <summary> ''' <summary>
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+79 -80
View File
@@ -79,8 +79,7 @@
''' 输入 javaw.exe 文件所在文件夹的路径，不限制结尾。 ''' 输入 javaw.exe 文件所在文件夹的路径，不限制结尾。
''' </summary> ''' </summary>
Public Sub New(Folder As String, IsUserImport As Boolean) Public Sub New(Folder As String, IsUserImport As Boolean)
If Not Folder.EndsWithF("\") Then Folder += "\" PathFolder = PathUtils.AddSlashSuffix(PathUtils.ForCompare(Folder))
PathFolder = Folder.Replace("/", "\")
Me.IsUserImport = IsUserImport Me.IsUserImport = IsUserImport
End Sub End Sub
@@ -94,18 +93,18 @@
Dim Output As String = Nothing Dim Output As String = Nothing
Try Try
'确定文件存在 '确定文件存在
If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava) If Not FileUtils.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
If {"finalshell", "Paranoia File"}.Any(Function(n) PathJava.ContainsIgnoreCase(n)) Then Throw New Exception("不兼容该精简版 Java") '#2249、#8080 If {"finalshell", "Paranoia File"}.Any(Function(n) PathJava.ContainsIgnoreCase(n)) Then Throw New Exception("不兼容该精简版 Java") '#2249、#8080
If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326 If FileUtils.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
IsJre = Not File.Exists(PathFolder & "javac.exe") IsJre = Not FileUtils.Exists(PathFolder & "javac.exe")
'运行 -version '运行 -version
Output = StartProcessAndGetOutput(PathJava, "-version", 15000).Lower Output = StartProcessAndGetOutput(PathJava, "-version", 15000).Lower
If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败") If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
If ModeDebug Then Log("[Java] Java 检查输出：" & PathJava & vbCrLf & Output) Logger.Trace($"Java 检查输出：{PathJava}{vbCrLf}{Output}")
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java，请在删除 Java 文件夹中的 /lib/ext 文件夹后再试") If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java，请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
If Output.Contains("a fatal error") Then Throw New ApplicationException("无法运行该 Java，该 Java 或系统存在问题") If Output.Contains("a fatal error") Then Throw New ApplicationException("无法运行该 Java，该 Java 或系统存在问题")
'获取详细信息 '获取详细信息
Dim VersionString = If(RegexSeek(Output, "(?<=version "")[^""]+"), If(RegexSeek(Output, "(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First Dim VersionString = If(Output.RegexSeek("(?<=version "")[^""]+"), If(Output.RegexSeek("(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First
If VersionString.Split(".").Count > 4 Then VersionString = VersionString.Replace(".0.", ".") '#3493，VersionString = "21.0.2.0.2" If VersionString.Split(".").Count > 4 Then VersionString = VersionString.Replace(".0.", ".") '#3493，VersionString = "21.0.2.0.2"
Do While VersionString.Split(".").Count < 4 Do While VersionString.Split(".").Count < 4
If VersionString.StartsWithF("1.") Then If VersionString.StartsWithF("1.") Then
@@ -117,7 +116,7 @@
If VersionString = "" Then Throw New ApplicationException($"未找到该 Java 的版本号{If(Output.Length < 500, $"{vbCrLf}输出为：{vbCrLf}{Output}", "")}") If VersionString = "" Then Throw New ApplicationException($"未找到该 Java 的版本号{If(Output.Length < 500, $"{vbCrLf}输出为：{vbCrLf}{Output}", "")}")
Version = New Version(VersionString) Version = New Version(VersionString)
If Version.Minor = 0 Then If Version.Minor = 0 Then
Log("[Java] 疑似 X.0.X.X 格式版本号：" & Version.ToString) Logger.Info($"疑似 X.0.X.X 格式版本号：{Version}")
Version = New Version(1, Version.Major, Version.Build, Version.Revision) Version = New Version(1, Version.Major, Version.Build, Version.Revision)
End If End If
Is64Bit = Output.Contains("64-bit") Is64Bit = Output.Contains("64-bit")
@@ -129,7 +128,7 @@
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw ex Throw ex
Catch ex As Exception Catch ex As Exception
Log("[Java] 检查失败的 Java 输出：" & If(PathJava, "Nothing") & vbCrLf & If(Output, "无程序输出")) Logger.Info($"检查失败的 Java 输出：{If(PathJava, "Nothing")}{vbCrLf}{If(Output, "无程序输出")}")
Throw New Exception("检查 Java 失败（" & If(PathJava, "Nothing") & "）", ex) Throw New Exception("检查 Java 失败（" & If(PathJava, "Nothing") & "）", ex)
End Try End Try
IsChecked = True IsChecked = True
@@ -165,25 +164,25 @@
Public Sub JavaListInit() Public Sub JavaListInit()
JavaList = New List(Of JavaEntry) JavaList = New List(Of JavaEntry)
Try Try
If Settings.Get("CacheJavaListVersion") < JavaListCacheVersion Then If Settings.Get(Of Integer)("CacheJavaListVersion") < JavaListCacheVersion Then
'不使用缓存 '不使用缓存
Log("[Java] 要求 Java 列表缓存更新") Logger.Info("要求 Java 列表缓存更新")
Settings.Set("CacheJavaListVersion", JavaListCacheVersion) Settings.Set("CacheJavaListVersion", JavaListCacheVersion)
Else Else
'使用缓存 '使用缓存
For Each JsonEntry In GetJson(Settings.Get("LaunchArgumentJavaAll")) For Each JsonEntry In GetJson(Settings.Get(Of String)("LaunchArgumentJavaAll"))
JavaList.Add(JavaEntry.FromJson(JsonEntry)) JavaList.Add(JavaEntry.FromJson(JsonEntry))
Next Next
End If End If
If Not JavaList.Any() Then If Not JavaList.Any() Then
Log("[Java] 初始化未找到可用的 Java，将自动触发搜索", NotifyLevel.DevelopOnly) Logger.Warn("初始化未找到可用的 Java，将自动触发搜索")
JavaSearchLoader.Start(0) JavaSearchLoader.Start(0)
Else Else
Log("[Java] 缓存中有 " & JavaList.Count & " 个可用的 Java：") Logger.Info($"缓存中有 {JavaList.Count} 个可用的 Java：")
JavaList.ForEach(Sub(j) Log($"[Java] - {j}")) JavaList.ForEach(Sub(j) Logger.Info($"- {j}"))
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化 Java 列表失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "初始化 Java 列表失败")
Settings.Set("LaunchArgumentJavaAll", "[]") Settings.Set("LaunchArgumentJavaAll", "[]")
End Try End Try
End Sub End Sub
@@ -205,7 +204,7 @@
'添加特定的 Java '添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean) Dim JavaPreList As New Dictionary(Of String, Boolean)
If McFolderSelected.Split("\").Count > 3 AndAlso Not McFolderSelected.Contains("AppData\Roaming") Then If McFolderSelected.Split("\").Count > 3 AndAlso Not McFolderSelected.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(McFolderSelected), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录或 %APPDATA% 的话） JavaSearchFolder(PathUtils.AddSlashSuffix(PathUtils.RemoveLastPart(McFolderSelected)), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录或 %APPDATA% 的话）
End If End If
JavaSearchFolder(McFolderSelected, JavaPreList, False, True) 'Minecraft 文件夹 JavaSearchFolder(McFolderSelected, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")). JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
@@ -219,9 +218,9 @@
'检查特定的 Java '检查特定的 Java
If TargetJavaList.Any Then If TargetJavaList.Any Then
TargetJavaList = JavaCheckList(TargetJavaList) TargetJavaList = JavaCheckList(TargetJavaList)
Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定路径下的 Java：") Logger.Info($"检查后找到 {TargetJavaList.Count} 个特定路径下的 Java：")
For Each Java In TargetJavaList For Each Java In TargetJavaList
Log($"[Java] - {Java}") Logger.Info($"- {Java}")
Next Next
End If End If
@@ -232,7 +231,7 @@
'获取版本独立设置中指定的 Java '获取版本独立设置中指定的 Java
Dim VersionSelect As String = "" Dim VersionSelect As String = ""
If GameInstance IsNot Nothing Then If GameInstance IsNot Nothing Then
VersionSelect = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance) VersionSelect = Settings.Get(Of String)("VersionArgumentJavaSelect", Instance:=GameInstance)
If VersionSelect.StartsWithF("{") Then If VersionSelect.StartsWithF("{") Then
Try Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect)) UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
@@ -242,28 +241,28 @@
Catch ex As Exception Catch ex As Exception
UserJava = Nothing UserJava = Nothing
Settings.Reset("VersionArgumentJavaSelect", Instance:=GameInstance) Settings.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Log(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", NotifyLevel.AllUsers) Logger.Error(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", LogBehavior.Toast)
End Try End Try
End If End If
End If End If
'获取全局设置中指定的 Java '获取全局设置中指定的 Java
If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Settings.Get("LaunchArgumentJavaSelect") <> "" Then If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Settings.Get(Of String)("LaunchArgumentJavaSelect") <> "" Then
Try Try
UserJava = JavaEntry.FromJson(GetJson(Settings.Get("LaunchArgumentJavaSelect"))) UserJava = JavaEntry.FromJson(GetJson(Settings.Get(Of String)("LaunchArgumentJavaSelect")))
UserJava.Check() UserJava.Check()
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As Exception Catch ex As Exception
UserJava = Nothing UserJava = Nothing
Settings.Reset("LaunchArgumentJavaSelect") Settings.Reset("LaunchArgumentJavaSelect")
Log(ex, "全局设置中指定的 Java 已无法使用，此设置已重置", NotifyLevel.AllUsers) Logger.Error(ex, "全局设置中指定的 Java 已无法使用，此设置已重置", LogBehavior.Toast)
End Try End Try
End If End If
'添加到特定 Java 列表 '添加到特定 Java 列表
If UserJava IsNot Nothing Then If UserJava IsNot Nothing Then
Log($"[Java] 用户指定的 Java：{UserJava}") Logger.Info($"用户指定的 Java：{UserJava}")
TargetJavaList.Add(UserJava) TargetJavaList.Add(UserJava)
End If End If
@@ -294,7 +293,7 @@ RetryGet:
'若未找到适合的 Java，尝试触发搜索 '若未找到适合的 Java，尝试触发搜索
If Not AllowedJavaList.Any() AndAlso JavaSearchLoader.State = LoadState.Waiting Then If Not AllowedJavaList.Any() AndAlso JavaSearchLoader.State = LoadState.Waiting Then
Log("[Java] 未找到满足条件的 Java，尝试进行搜索") Logger.Info("未找到满足条件的 Java，尝试进行搜索")
JavaSearchLoader.Start(IsForceRestart:=True) JavaSearchLoader.Start(IsForceRestart:=True)
GoTo RetryGet GoTo RetryGet
End If End If
@@ -304,16 +303,16 @@ RetryGet:
'确保指定的 Java 可用 '确保指定的 Java 可用
If UserJava Is Nothing Then GoTo ExitUserJavaCheck If UserJava Is Nothing Then GoTo ExitUserJavaCheck
If AllowedJavaList.Any(Function(j) j.PathFolder = UserJava.PathFolder) Then If AllowedJavaList.Any(Function(j) j.PathFolder = UserJava.PathFolder) Then
Log("[Java] 使用用户指定的 Java：" & UserJava.PathFolder) Logger.Info($"使用用户指定的 Java：{UserJava.PathFolder}")
AllowedJavaList = New List(Of JavaEntry) From {UserJava} AllowedJavaList = New List(Of JavaEntry) From {UserJava}
GoTo UserPass GoTo UserPass
End If End If
'指定的 Java 不可用，弹窗要求选择 '指定的 Java 不可用，弹窗要求选择
Log("[Java] 发现用户指定的不兼容 Java：" & UserJava.ToString) Logger.Info($"发现用户指定的不兼容 Java：{UserJava}")
Log($"[Java] 目前实际可用的 Java 列表：") Logger.Info($"目前实际可用的 Java 列表：")
For Each Java In AllowedJavaList For Each Java In AllowedJavaList
Log($"[Java] - {Java}") Logger.Info($"- {Java}")
Next Next
Dim Requirement As String = "" Dim Requirement As String = ""
Dim ShowRevision As Boolean = False Dim ShowRevision As Boolean = False
@@ -330,20 +329,20 @@ RetryGet:
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right) Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If End If
Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "") Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If GameInstance IsNot Nothing AndAlso Settings.Get("VersionAdvanceJava", GameInstance) Then If GameInstance IsNot Nothing AndAlso Settings.Get(Of Boolean)("VersionAdvanceJava", GameInstance) Then
'直接跳过弹窗 '直接跳过弹窗
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & "，但当前版本" & Requirement & "，这可能会导致游戏崩溃！", NotifyLevel.DebugModeOnly) Logger.Warn($"设置中指定了使用 Java {JavaCurrent}，但当前版本{Requirement}，这可能会导致游戏崩溃！")
AllowedJavaList = New List(Of JavaEntry) From {UserJava} AllowedJavaList = New List(Of JavaEntry) From {UserJava}
Else Else
Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & "，但当前" & Requirement & "。" & vbCrLf & Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & "，但当前" & Requirement & "。" & vbCrLf &
"如果强制使用该 Java，可能导致游戏崩溃。" & vbCrLf & "如果强制使用该 Java，可能导致游戏崩溃。" & vbCrLf &
"你也可以将 游戏 Java 设置修改为 自动选择合适的 Java。" & vbCrLf & "你也可以将 游戏 Java 设置修改为 自动选择。" & vbCrLf &
vbCrLf & vbCrLf &
" - 指定的 Java：" & UserJava.ToString, " - 指定的 Java：" & UserJava.ToString,
"Java 兼容性警告", "让 PCL 自动选择", "强制使用该 Java", "取消") "Java 兼容性警告", "让 PCL 自动选择", "强制使用该 Java", "取消")
Case 1 '让 PCL 自动选择 Case 1 '让 PCL 自动选择
Case 2 '强制使用指定的 Java Case 2 '强制使用指定的 Java
Log("[Java] 已强制使用用户指定的不兼容 Java") Logger.Info("已强制使用用户指定的不兼容 Java")
AllowedJavaList = New List(Of JavaEntry) From {UserJava} AllowedJavaList = New List(Of JavaEntry) From {UserJava}
Case 3 '取消启动 Case 3 '取消启动
Throw New Exception(CancelException) Throw New Exception(CancelException)
@@ -364,7 +363,7 @@ ExitUserJavaCheck:
If TargetJavaList.Contains(Java) Then If TargetJavaList.Contains(Java) Then
'直接使用指定的 Java '直接使用指定的 Java
AllowedJavaList = New List(Of JavaEntry) From {Java} AllowedJavaList = New List(Of JavaEntry) From {Java}
Log("[Java] 优先使用特定路径下的 Java：" & Java.ToString) Logger.Info($"优先使用特定路径下的 Java：{Java}")
GoTo UserPass GoTo UserPass
End If End If
Next Next
@@ -372,9 +371,9 @@ UserPass:
'对适合的 Java 进行排序 '对适合的 Java 进行排序
AllowedJavaList = AllowedJavaList.SortByComparison(AddressOf JavaSorter) AllowedJavaList = AllowedJavaList.SortByComparison(AddressOf JavaSorter)
Log($"[Java] 排序后的 Java 优先顺序：") Logger.Info($"排序后的 Java 优先顺序：")
For Each Java In AllowedJavaList For Each Java In AllowedJavaList
Log($"[Java] - {Java}") Logger.Info($"- {Java}")
Next Next
'检查选定的 Java，若测试失败则尝试进行搜索 '检查选定的 Java，若测试失败则尝试进行搜索
@@ -384,23 +383,23 @@ UserPass:
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As Exception Catch ex As Exception
If ex.InnerException IsNot Nothing AndAlso TypeOf (ex.InnerException) Is ThreadInterruptedException Then Throw ex.InnerException If ex.InnerException IsNot Nothing AndAlso TypeOf ex.InnerException Is ThreadInterruptedException Then Throw ex.InnerException
Log(ex, "最终选定的 Java 已无法使用，尝试进行搜索") Logger.Warn(ex, "最终选定的 Java 已无法使用，尝试进行搜索")
AllowedJavaList = New List(Of JavaEntry) AllowedJavaList = New List(Of JavaEntry)
JavaSearchLoader.Start(IsForceRestart:=True) JavaSearchLoader.Start(IsForceRestart:=True)
GoTo RetryGet GoTo RetryGet
End Try End Try
'返回 '返回
Log("[Java] 最终选定的 Java：" & AllowedJavaList.First.ToString) Logger.Info($"最终选定的 Java：{AllowedJavaList.First}")
Return SelectedJava Return SelectedJava
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Log(ex, "查找符合条件的 Java 时出现加载器中断") Logger.Warn(ex, "查找符合条件的 Java 时出现加载器中断")
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
If ex.Message = "$$" Then Throw ex If ex.Message = "$$" Then Throw ex
Log(ex, "查找符合条件的 Java 失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "查找符合条件的 Java 失败")
Return Nothing Return Nothing
End Try End Try
End Function End Function
@@ -410,9 +409,9 @@ UserPass:
Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean
Try Try
'检查强制指定 '检查强制指定
Dim UserSetup As String = Settings.Get("LaunchArgumentJavaSelect") Dim UserSetup As String = Settings.Get(Of String)("LaunchArgumentJavaSelect")
If GameInstance IsNot Nothing Then If GameInstance IsNot Nothing Then
Dim UserSetupVersion As String = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance) Dim UserSetupVersion As String = Settings.Get(Of String)("VersionArgumentJavaSelect", Instance:=GameInstance)
If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion
End If End If
If UserSetup <> "" Then If UserSetup <> "" Then
@@ -420,7 +419,7 @@ UserPass:
Try Try
UserJava = JavaEntry.FromJson(GetJson(UserSetup)) UserJava = JavaEntry.FromJson(GetJson(UserSetup))
Catch ex As Exception Catch ex As Exception
Log(ex, "版本指定的 Java 信息已损坏，已重置版本设置中指定的 Java") Logger.Warn(ex, "版本指定的 Java 信息已损坏，已重置版本设置中指定的 Java")
Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance) Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance)
GoTo NoUserJava GoTo NoUserJava
End Try End Try
@@ -435,7 +434,7 @@ NoUserJava:
Next Next
Return False Return False
Catch ex As Exception Catch ex As Exception
Log(ex, "检查 Java 类别时出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "检查 Java 类别时出错")
Settings.Set("LaunchArgumentJavaSelect", "") Settings.Set("LaunchArgumentJavaSelect", "")
Return True Return True
End Try End Try
@@ -444,12 +443,12 @@ NoUserJava:
''' 将 Java 按照适用性排序。 ''' 将 Java 按照适用性排序。
''' </summary> ''' </summary>
Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
Dim PathInfo As New DirectoryInfo(PathExeFolder)
Dim PathMcInfo As New DirectoryInfo(McFolderSelected)
'1. 尽量在当前文件夹或当前 Minecraft 文件夹 '1. 尽量在当前文件夹或当前 Minecraft 文件夹
Dim ProgramPathParent As String, MinecraftPathParent As String = "" Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName Dim PathInfo = DirectoryUtils.GetInfo(PathExeFolder)
If McFolderSelected <> "" Then MinecraftPathParent = If(PathMcInfo.Parent, PathMcInfo).FullName ProgramPathParent = PathUtils.RemoveExtendedPrefix(If(PathInfo.Parent, PathInfo).FullName)
Dim PathMcInfo = DirectoryUtils.GetInfo(McFolderSelected)
If McFolderSelected <> "" Then MinecraftPathParent = PathUtils.RemoveExtendedPrefix(If(PathMcInfo.Parent, PathMcInfo).FullName)
If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
If McFolderSelected <> "" Then If McFolderSelected <> "" Then
@@ -505,12 +504,12 @@ NoUserJava:
#Region "模糊查找可能可用的 Java" #Region "模糊查找可能可用的 Java"
'查找环境变量中的 Java '查找环境变量中的 Java
For Each PathInEnv As String In Split((PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\"), ";") For Each PathInEnv As String In (PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\").Split(";")
PathInEnv = PathInEnv.Trim(" """.ToCharArray()) PathInEnv = PathInEnv.Trim(" """.ToCharArray())
If PathInEnv = "" Then Continue For If PathInEnv = "" Then Continue For
If Not PathInEnv.EndsWithF("\") Then PathInEnv += "\" If Not PathInEnv.EndsWithF("\") Then PathInEnv += "\"
'粗略检查有效性 '粗略检查有效性
If File.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False If FileUtils.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False
Next Next
'查找磁盘中的 Java '查找磁盘中的 Java
For Each Disk As DriveInfo In DriveInfo.GetDrives() For Each Disk As DriveInfo In DriveInfo.GetDrives()
@@ -530,15 +529,15 @@ NoUserJava:
Dim JavaWithoutReparse As New Dictionary(Of String, Boolean) Dim JavaWithoutReparse As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList For Each Pair In JavaPreList
Dim Folder As String = Pair.Key.Replace("\\", "\").Replace("/", "\") Dim Folder As String = Pair.Key.Replace("\\", "\").Replace("/", "\")
Dim Info As FileSystemInfo = New FileInfo(Folder & "javaw.exe") Dim Info As FileSystemInfo = FileUtils.GetInfo(Folder & "javaw.exe")
Do Do
If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then
Log("[Java] 位于 " & Folder & " 的 Java 包含符号链接") Logger.Info($"位于 {Folder} 的 Java 包含符号链接")
Continue For Continue For
End If End If
Info = If(TypeOf Info Is FileInfo, CType(Info, FileInfo).Directory, CType(Info, DirectoryInfo).Parent) Info = If(TypeOf Info Is FileInfo, CType(Info, FileInfo).Directory, CType(Info, DirectoryInfo).Parent)
Loop While Info IsNot Nothing Loop While Info IsNot Nothing
Log("[Java] 位于 " & Folder & " 的 Java 不含符号链接") Logger.Info($"位于 {Folder} 的 Java 不含符号链接")
JavaWithoutReparse.Add(Pair.Key, Pair.Value) JavaWithoutReparse.Add(Pair.Key, Pair.Value)
Next Next
If JavaWithoutReparse.Any Then JavaPreList = JavaWithoutReparse If JavaWithoutReparse.Any Then JavaPreList = JavaWithoutReparse
@@ -547,7 +546,7 @@ NoUserJava:
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean) Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList For Each Pair In JavaPreList
If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") OrElse Pair.Key.Contains("system32") Then If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") OrElse Pair.Key.Contains("system32") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 位于特殊路径，不应优先使用") Logger.Info($"位于 {Pair.Key} 的 Java 位于特殊路径，不应优先使用")
Else Else
JavaWithoutInherit.Add(Pair.Key, Pair.Value) JavaWithoutInherit.Add(Pair.Key, Pair.Value)
End If End If
@@ -558,14 +557,14 @@ NoUserJava:
#Region "添加玩家手动导入的 Java" #Region "添加玩家手动导入的 Java"
Dim ImportedJava As String = Settings.Get("LaunchArgumentJavaAll") Dim ImportedJava As String = Settings.Get(Of String)("LaunchArgumentJavaAll")
Try Try
For Each JavaJsonObject In GetJson(ImportedJava) For Each JavaJsonObject In GetJson(ImportedJava)
Dim Entry = JavaEntry.FromJson(JavaJsonObject) Dim Entry = JavaEntry.FromJson(JavaJsonObject)
If Entry.IsUserImport Then JavaPreList(Entry.PathFolder) = True If Entry.IsUserImport Then JavaPreList(Entry.PathFolder) = True
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "Java 列表已损坏", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "Java 列表已损坏")
Settings.Set("LaunchArgumentJavaAll", "[]") Settings.Set("LaunchArgumentJavaAll", "[]")
End Try End Try
@@ -587,11 +586,11 @@ NoUserJava:
JavaList = NewJavaList JavaList = NewJavaList
Catch ex As Exception Catch ex As Exception
Log(ex, "搜索 Java 时出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "搜索 Java 时出错")
JavaList = New List(Of JavaEntry) JavaList = New List(Of JavaEntry)
End Try End Try
Log("[Java] Java 搜索完成，发现 " & JavaList.Count & " 个 Java") Logger.Info($"Java 搜索完成，发现 {JavaList.Count} 个 Java")
If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.UpdateJavaComboBox()) If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.UpdateJavaComboBox())
If FrmInstanceSetup IsNot Nothing Then RunInUi(Sub() FrmInstanceSetup.RefreshJavaComboBox()) If FrmInstanceSetup IsNot Nothing Then RunInUi(Sub() FrmInstanceSetup.RefreshJavaComboBox())
End Sub End Sub
@@ -600,8 +599,8 @@ NoUserJava:
''' 多线程检查列表中的所有 Java 项。 ''' 多线程检查列表中的所有 Java 项。
''' </summary> ''' </summary>
Private Function JavaCheckList(JavaEntries As List(Of JavaEntry)) As List(Of JavaEntry) Private Function JavaCheckList(JavaEntries As List(Of JavaEntry)) As List(Of JavaEntry)
Log("[Java] 开始确认列表 Java 状态，共 " & JavaEntries.Count & " 项") Logger.Info($"开始确认列表 Java 状态，共 {JavaEntries.Count} 项")
JavaCheckList = New List(Of JavaEntry) Dim Result = New List(Of JavaEntry)
Dim ListLock As New Object Dim ListLock As New Object
'启动检查线程 '启动检查线程
@@ -611,16 +610,16 @@ NoUserJava:
Sub() Sub()
Try Try
Entry.Check() Entry.Check()
If ModeDebug Then Log("[Java] - " & Entry.ToString) Logger.Trace($"- {Entry}")
SyncLock ListLock SyncLock ListLock
JavaCheckList.Add(Entry) Result.Add(Entry)
End SyncLock End SyncLock
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Catch ex As Exception Catch ex As Exception
If Entry.IsUserImport Then If Entry.IsUserImport Then
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常，将被自动移除", NotifyLevel.AllUsers) Logger.Error(ex, $"位于 {Entry.PathFolder} 的 Java 存在异常，将被自动移除", LogBehavior.Toast)
Else Else
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常") Logger.Warn(ex, $"位于 {Entry.PathFolder} 的 Java 存在异常")
End If End If
End Try End Try
End Sub) End Sub)
@@ -634,6 +633,7 @@ Wait:
For Each CheckThread In CheckThreads For Each CheckThread In CheckThreads
If CheckThread.IsAlive Then GoTo Wait If CheckThread.IsAlive Then GoTo Wait
Next Next
Return Result
End Function End Function
''' <summary> ''' <summary>
''' 模糊搜索指定文件夹下的 Java，并只进行粗略的检查。这不会搜索全部路径。 ''' 模糊搜索指定文件夹下的 Java，并只进行粗略的检查。这不会搜索全部路径。
@@ -642,12 +642,12 @@ Wait:
''' <param name="IsFullSearch">搜索当前文件夹下的全部文件夹（此参数不会传递到子文件夹）。</param> ''' <param name="IsFullSearch">搜索当前文件夹下的全部文件夹（此参数不会传递到子文件夹）。</param>
Private Sub JavaSearchFolder(OriginalPath As String, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False) Private Sub JavaSearchFolder(OriginalPath As String, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False)
Try Try
Log("[Java] 开始" & If(IsFullSearch, "完全", "部分") & "遍历查找：" & OriginalPath) Logger.Info($"开始{If(IsFullSearch, "完全", "部分")}遍历查找：{OriginalPath}")
JavaSearchFolder(New DirectoryInfo(OriginalPath), Results, Source, IsFullSearch) JavaSearchFolder(DirectoryUtils.GetInfo(OriginalPath), Results, Source, IsFullSearch)
Catch ex As UnauthorizedAccessException Catch ex As UnauthorizedAccessException
Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath) Logger.Info($"遍历查找 Java 时遭遇无权限的文件夹：{OriginalPath}")
Catch ex As Exception Catch ex As Exception
Log(ex, "遍历查找 Java 时出错（" & OriginalPath & "）") Logger.Warn(ex, $"遍历查找 Java 时出错（{OriginalPath}）")
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -659,10 +659,9 @@ Wait:
Try Try
'确认目录存在 '确认目录存在
If Not OriginalPath.Exists Then Return If Not OriginalPath.Exists Then Return
Dim Folder As String = OriginalPath.FullName.Replace("\\", "\") Dim Folder As String = PathUtils.AddSlashSuffix(PathUtils.ForCompare(OriginalPath.FullName))
If Not Folder.EndsWithF("\") Then Folder += "\"
'若该目录有 Java，则加入结果 '若该目录有 Java，则加入结果
If File.Exists(Folder & "javaw.exe") Then Results(Folder) = Source If FileUtils.Exists(Folder & "javaw.exe") Then Results(Folder) = Source
'查找其下的所有文件夹 '查找其下的所有文件夹
'不应使用网易的 Java：https://github.com/Meloong-Git/PCL/issues/1279#issuecomment-2761489121 '不应使用网易的 Java：https://github.com/Meloong-Git/PCL/issues/1279#issuecomment-2761489121
Static Keywords As String() = { Static Keywords As String() = {
@@ -674,16 +673,16 @@ Wait:
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages", "4297127d64ec6", "1.", "启动", "jbr"} "download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages", "4297127d64ec6", "1.", "启动", "jbr"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接 If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).Lower '用于搜索的字符串 Dim SearchEntry = PathUtils.GetLastPart(FolderInfo.Name).Lower '用于搜索的字符串
If IsFullSearch OrElse If IsFullSearch OrElse
OriginalPath.Name.Lower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then OriginalPath.Name.Lower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
JavaSearchFolder(FolderInfo, Results, Source) JavaSearchFolder(FolderInfo, Results, Source)
End If End If
Next Next
Catch ex As UnauthorizedAccessException Catch ex As UnauthorizedAccessException
Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath.FullName) Logger.Trace(Function() $"遍历查找 Java 时遭遇无权限的文件夹（{OriginalPath.FullName}）：{ex.GetDisplay(False)}")
Catch ex As Exception Catch ex As Exception
Log(ex, "遍历查找 Java 时出错（" & OriginalPath.FullName & "）") Logger.Warn(ex, $"遍历查找 Java 时出错（{OriginalPath.FullName}）")
End Try End Try
End Sub End Sub
@@ -704,8 +703,8 @@ Wait:
AddHandler JavaDownloadLoader.OnStateChangedThread, AddHandler JavaDownloadLoader.OnStateChangedThread,
Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState) Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState)
If (NewState = LoadState.Failed OrElse NewState = LoadState.Interrupted) AndAlso LastJavaBaseDir IsNot Nothing Then If (NewState = LoadState.Failed OrElse NewState = LoadState.Interrupted) AndAlso LastJavaBaseDir IsNot Nothing Then
Log($"[Java] 由于下载未完成，清理未下载完成的 Java 文件：{LastJavaBaseDir}", NotifyLevel.DebugModeOnly) Logger.Warn($"由于下载未完成，清理未下载完成的 Java 文件：{LastJavaBaseDir}")
DeleteDirectory(LastJavaBaseDir) DirectoryUtils.Delete(LastJavaBaseDir)
ElseIf NewState = LoadState.Finished Then ElseIf NewState = LoadState.Finished Then
LastJavaBaseDir = Nothing LastJavaBaseDir = Nothing
End If End If
@@ -715,7 +714,7 @@ Wait:
End Function End Function
Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹，防止残留只下了一半但 -version 能跑的 Java Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹，防止残留只下了一半但 -version 能跑的 Java
Private Sub JavaFileList(Loader As LoaderTask(Of String, List(Of NetFile))) Private Sub JavaFileList(Loader As LoaderTask(Of String, List(Of NetFile)))
Log("[Java] 开始获取 Java 下载信息") Logger.Info("开始获取 Java 下载信息")
Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder( Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder(
{"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}, {"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"} {"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}
@@ -751,7 +750,7 @@ Wait:
Results.Add(New NetFile(DlSourceOrder({Url}, {Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com")}), LastJavaBaseDir & File.Name, Checker)) Results.Add(New NetFile(DlSourceOrder({Url}, {Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com")}), LastJavaBaseDir & File.Name, Checker))
Next Next
Loader.Output = Results Loader.Output = Results
Log($"[Java] 需要下载 {Results.Count} 个文件，目标文件夹：{LastJavaBaseDir}") Logger.Info($"需要下载 {Results.Count} 个文件，目标文件夹：{LastJavaBaseDir}")
End Sub End Sub
#End Region #End Region
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+262 -272
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+280 -254
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+136 -143
View File
@@ -5,7 +5,7 @@
''' 弹窗要求选择一个整合包文件并进行安装。 ''' 弹窗要求选择一个整合包文件并进行安装。
''' </summary> ''' </summary>
Public Sub ModpackInstall() Public Sub ModpackInstall()
Dim File As String = SelectFile("整合包文件(*.rar;*.zip;*.mrpack)|*.rar;*.zip;*.mrpack", "选择整合包压缩文件") '选择整合包文件 Dim File As String = Dialogs.SelectFile("选择整合包压缩文件", False, filter:={({"rar", "zip", "mrpack"}, "整合包文件")}).FirstOrDefault() '选择整合包文件
If String.IsNullOrEmpty(File) Then Return If String.IsNullOrEmpty(File) Then Return
RunInThread( RunInThread(
Sub() Sub()
@@ -13,7 +13,7 @@
ModpackInstall(File) ModpackInstall(File)
Catch ex As CancelledException Catch ex As CancelledException
Catch ex As Exception Catch ex As Exception
Log(ex, "手动安装整合包失败", NotifyLevel.MsgBox) Logger.Error(ex, "手动安装整合包失败", LogBehavior.Alert)
End Try End Try
End Sub) End Sub)
End Sub End Sub
@@ -23,7 +23,7 @@
''' </summary> ''' </summary>
''' <exception cref="CancelledException" /> ''' <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)
Log("[ModPack] 整合包安装请求：" & If(File, "null")) Logger.Info($"整合包安装请求：{If(File, "null")}")
Dim Archive As ZipArchive = Nothing Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = "" Dim ArchiveBaseFolder As String = ""
Try Try
@@ -33,13 +33,13 @@
'获取整合包种类与关键 Json '获取整合包种类与关键 Json
Dim PackType As Integer = -1 Dim PackType As Integer = -1
Try Try
Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.Read)) Archive = FileUtils.OpenZip(File)
'从根目录判断整合包类型 '从根目录判断整合包类型
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断） If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
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(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8)) Dim Json As JObject = GetJson(Archive.GetEntry("manifest.json").Open().ReadString(Encoding.UTF8))
If Json("addons") Is Nothing Then If Json("addons") Is Nothing Then
PackType = 0 : Exit Try 'CurseForge 整合包 PackType = 0 : Exit Try 'CurseForge 整合包
Else Else
@@ -50,27 +50,27 @@
If Archive.GetEntry("modpack.zip") IsNot Nothing OrElse Archive.GetEntry("modpack.mrpack") IsNot Nothing Then PackType = 9 : Exit Try '带启动器的压缩包 If Archive.GetEntry("modpack.zip") IsNot Nothing OrElse Archive.GetEntry("modpack.mrpack") IsNot Nothing Then PackType = 9 : Exit Try '带启动器的压缩包
'从一级目录判断整合包类型 '从一级目录判断整合包类型
For Each Entry In Archive.Entries For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/") Dim PathSplits As String() = Entry.FullName.Split("/")
ArchiveBaseFolder = FullNames(0) & "/" ArchiveBaseFolder = PathSplits(0) & "/"
'确定为一级目录下 '确定为一级目录下
If FullNames.Count <> 2 Then Continue For If PathSplits.Count <> 2 Then Continue For
'判断是否为关键文件 '判断是否为关键文件
If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断） If PathSplits(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
If FullNames(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 FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包 If PathSplits(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If FullNames(1) = "manifest.json" Then If PathSplits(1) = "manifest.json" Then
Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8)) Dim Json As JObject = GetJson(Entry.Open().ReadString(Encoding.UTF8))
If Json("addons") Is Nothing Then If Json("addons") Is Nothing Then
PackType = 0 : Exit Try 'CurseForge 整合包 PackType = 0 : Exit Try 'CurseForge 整合包
Else Else
PackType = 3 : ArchiveBaseFolder = "overrides/" : Exit Try 'MCBBS 整合包 PackType = 3 : ArchiveBaseFolder = "overrides/" : Exit Try 'MCBBS 整合包
End If End If
End If End If
If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包 If PathSplits(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包 If PathSplits(1) = "modpack.zip" OrElse PathSplits(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
Next Next
Catch ex As Exception Catch ex As Exception
If ex.GetDetail(True).Contains("Error.WinIOError") Then If ex.GetDisplay(True).Contains("Error.WinIOError") Then
Throw New Exception("打开整合包文件失败", ex) Throw New Exception("打开整合包文件失败", ex)
ElseIf File.EndsWithF(".rar", True) Then ElseIf File.EndsWithF(".rar", True) Then
Throw New Exception("PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", ex) Throw New Exception("PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", ex)
@@ -81,25 +81,25 @@
'执行对应的安装方法 '执行对应的安装方法
Select Case PackType Select Case PackType
Case 0 Case 0
Log("[ModPack] 整合包种类：CurseForge") Logger.Info("整合包种类：CurseForge")
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, InstanceName, Logo) Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 1 Case 1
Log("[ModPack] 整合包种类：HMCL") Logger.Info("整合包种类：HMCL")
Return InstallPackHMCL(File, Archive, ArchiveBaseFolder) Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
Case 2 Case 2
Log("[ModPack] 整合包种类：MMC") Logger.Info("整合包种类：MMC")
Return InstallPackMMC(File, Archive, ArchiveBaseFolder) Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
Case 3 Case 3
Log("[ModPack] 整合包种类：MCBBS") Logger.Info("整合包种类：MCBBS")
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, InstanceName) Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, InstanceName)
Case 4 Case 4
Log("[ModPack] 整合包种类：Modrinth") Logger.Info("整合包种类：Modrinth")
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, InstanceName, Logo) Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 9 Case 9
Log("[ModPack] 整合包种类：带启动器的压缩包") Logger.Info("整合包种类：带启动器的压缩包")
Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder) Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
Case Else Case Else
Log("[ModPack] 整合包种类：未能识别，假定为压缩包") Logger.Info("整合包种类：未能识别，假定为压缩包")
Return InstallPackCompress(File, Archive) Return InstallPackCompress(File, Archive)
End Select End Select
Finally Finally
@@ -111,13 +111,14 @@
'解压文件 '解压文件
Dim RetryCount As Integer = 1 Dim RetryCount As Integer = 1
Dim InitialProgress = Loader.Progress Dim InitialProgress = Loader.Progress
Try
Retry: Retry:
Try
Loader.Progress = InitialProgress Loader.Progress = InitialProgress
DeleteDirectory(InstallTemp) DirectoryUtils.Delete(InstallTemp)
ExtractCompressedFile(FileAddress, InstallTemp, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * ProgressIncrement) Dim RawProgress As Double = Loader.Progress
FileUtils.ExtractToDirectory(FileAddress, InstallTemp, progressHandler:=Sub(Percentage) Loader.Progress = RawProgress + Percentage * ProgressIncrement)
Catch ex As Exception Catch ex As Exception
Log(ex, "第 " & RetryCount & " 次解压尝试失败") Logger.Warn(ex, $"第 {RetryCount} 次解压尝试失败")
'完全不知道为啥会出现文件正在被另一进程使用的问题，总之加个重试 '完全不知道为啥会出现文件正在被另一进程使用的问题，总之加个重试
If RetryCount < 5 Then If RetryCount < 5 Then
Thread.Sleep(RetryCount * 2000) Thread.Sleep(RetryCount * 2000)
@@ -134,25 +135,24 @@ Retry:
''' 从整合包的 override 目录复制文件，同时设置 PCL 的配置文件与版本隔离。 ''' 从整合包的 override 目录复制文件，同时设置 PCL 的配置文件与版本隔离。
''' 对路径末尾是否为 \ 没有要求。 ''' 对路径末尾是否为 \ 没有要求。
''' </summary> ''' </summary>
Private Sub CopyOverrideDirectory(OverridesFolder As String, VersionFolder As String, Loader As LoaderBase, ProgressIncrement As Double) Private Sub CopyOverrideDirectory(OverridesFolder As String, VersionFolder As String, Loader As LoaderBase)
If Not OverridesFolder.EndsWithF("\") Then OverridesFolder += "\" If Not OverridesFolder.EndsWithF("\") Then OverridesFolder += "\"
If Not VersionFolder.EndsWithF("\") Then VersionFolder += "\" If Not VersionFolder.EndsWithF("\") Then VersionFolder += "\"
'复制文件 '复制文件
If Directory.Exists(OverridesFolder) Then If DirectoryUtils.Exists(OverridesFolder) Then
Log($"[ModPack] 处理整合包覆写文件夹：{OverridesFolder} → {VersionFolder}") Logger.Info($"处理整合包覆写文件夹：{OverridesFolder} → {VersionFolder}")
CopyDirectory(OverridesFolder, VersionFolder, Sub(Delta) Loader.Progress += Delta * ProgressIncrement) DirectoryUtils.Copy(OverridesFolder, VersionFolder)
Else Else
Log($"[ModPack] 整合包中没有覆写文件夹：{OverridesFolder}") Logger.Info($"整合包中没有覆写文件夹：{OverridesFolder}")
Loader.Progress += ProgressIncrement
End If End If
'设置 ini '设置 ini
Dim OverridesIni As String = $"{OverridesFolder}PCL\Setup.ini" Dim OverridesIni As String = $"{OverridesFolder}PCL\Setup.ini"
Dim VersionIni As String = $"{VersionFolder}PCL\Setup.ini" Dim VersionIni As String = $"{VersionFolder}PCL\Setup.ini"
If File.Exists(OverridesIni) Then If FileUtils.Exists(OverridesIni) Then
WriteIni(OverridesIni, "VersionArgumentIndie", 1) '开启版本隔离 WriteIni(OverridesIni, "VersionArgumentIndie", 1) '开启版本隔离
WriteIni(OverridesIni, "VersionArgumentIndieV2", True) WriteIni(OverridesIni, "VersionArgumentIndieV2", True)
WriteIni(OverridesIni, "IsStar", False) WriteIni(OverridesIni, "IsStar", False)
CopyFile(OverridesIni, VersionIni) '覆写已有的 ini FileUtils.Copy(OverridesIni, VersionIni) '覆写已有的 ini
Else Else
WriteIni(VersionIni, "VersionArgumentIndie", 1) '开启版本隔离 WriteIni(VersionIni, "VersionArgumentIndie", 1) '开启版本隔离
WriteIni(VersionIni, "VersionArgumentIndieV2", True) WriteIni(VersionIni, "VersionArgumentIndieV2", True)
@@ -178,7 +178,7 @@ Retry:
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open)) Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString)
Catch ex As Exception Catch ex As Exception
Throw New Exception("CurseForge 整合包安装信息存在问题", ex) Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
End Try End Try
@@ -194,24 +194,23 @@ Retry:
End If End If
'获取 Mod API 版本信息 '获取 Mod API 版本信息
Dim ForgeVersion As String = Nothing Dim TargetVersion As New McVersion
Dim NeoForgeVersion As String = Nothing TargetVersion.VanillaName = Json("minecraft")("version").ToString
Dim FabricVersion As String = Nothing
For Each Entry In If(Json("minecraft")("modLoaders"), {}) For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.Lower Dim Id As String = If(Entry("id"), "").ToString.Lower
If Id.StartsWithF("forge-") Then If Id.StartsWithF("forge-") Then
'Forge 指定 'Forge 指定
If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老，已不支持进行安装！") If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老，已不支持进行安装！")
Log("[ModPack] 整合包 Forge 版本：" & Id) Logger.Info($"整合包 Forge 版本：{Id}")
ForgeVersion = Id.Replace("forge-", "") TargetVersion.Forge = Id.Replace("forge-", "")
ElseIf Id.StartsWithF("neoforge-") Then ElseIf Id.StartsWithF("neoforge-") Then
'NeoForge 指定 'NeoForge 指定
Log("[ModPack] 整合包 NeoForge 版本：" & Id) Logger.Info($"整合包 NeoForge 版本：{Id}")
NeoForgeVersion = Id.Replace("neoforge-", "") TargetVersion.NeoForge = Id.Replace("neoforge-", "")
ElseIf Id.StartsWithF("fabric-") Then ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定 'Fabric 指定
Log("[ModPack] 整合包 Fabric 版本：" & Id) Logger.Info($"整合包 Fabric 版本：{Id}")
FabricVersion = Id.Replace("fabric-", "") TargetVersion.Fabric = Id.Replace("fabric-", "")
Else Else
'ElseIf Id.StartsWithF("quilt-") Then 'ElseIf Id.StartsWithF("quilt-") Then
NotifyIncompatibleLoader(Id) NotifyIncompatibleLoader(Id)
@@ -227,10 +226,9 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613 InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
$"{McFolderSelected}versions\{InstanceName}", $"{McFolderSelected}versions\{InstanceName}", Task)
Task, 0.4)
End Sub) With { End Sub) With {
.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s .ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
End If End If
'获取 Mod 列表 '获取 Mod 列表
Dim ModList As New List(Of Integer) Dim ModList As New List(Of Integer)
@@ -253,17 +251,17 @@ Retry:
'如果文件已被删除，则 API 会跳过那一项，导致返回的列表数量小于请求的数量。后面的都是对此的错误处理。 '如果文件已被删除，则 API 会跳过那一项，导致返回的列表数量小于请求的数量。后面的都是对此的错误处理。
'获取缺失的 fileId 列表 '获取缺失的 fileId 列表
Dim MissingIds = ModList.Except(Task.Output.Select(Function(j) j("id").ToObject(Of Integer))).ToList Dim MissingIds = ModList.Except(Task.Output.Select(Function(j) j("id").ToObject(Of Integer))).ToList
Log("[Modpack] 缺失的 fileIds：" & MissingIds.Join("、")) Logger.Info($"缺失的 fileIds：{MissingIds.Join("、")}")
'将 fileId 映射到 projectId '将 fileId 映射到 projectId
Dim Missings = MissingIds.Select(Of (ProjectId As Integer, FileId As Integer))( Dim Missings = MissingIds.Select(Of (ProjectId As Integer, FileId As Integer))(
Function(id) (CType(Json("files").AsEnumerable.First(Function(f) f("fileID").ToObject(Of Integer) = id), JObject)("projectID").ToObject(Of Integer), id)).ToList Function(id) (CType(Json("files").AsEnumerable.First(Function(f) f("fileID").ToObject(Of Integer) = id), JObject)("projectID").ToObject(Of Integer), id)).ToList
Log("[Modpack] 缺失项：" & Missings.Join("、")) Logger.Info($"缺失项：{Missings.Join("、")}")
'尝试获取对应的工程信息 '尝试获取对应的工程信息
Dim Projects As New List(Of ResourceProject) Dim Projects As New List(Of ResourceProject)
Try Try
Projects = ResourceProject.FromProjectIds(Missings.Select(Function(e) e.ProjectId.ToString), ResourcePlatforms.CurseForge).ToList Projects = ResourceProject.FromProjectIds(Missings.Select(Function(e) e.ProjectId.ToString), ResourcePlatforms.CurseForge).ToList
Catch ex As Exception Catch ex As Exception
Log(ex, "获取缺失的工程信息失败") Logger.Warn(ex, "获取缺失的工程信息失败")
End Try End Try
Dim MissingDesc As New List(Of String) Dim MissingDesc As New List(Of String)
For Each Missing In Missings For Each Missing In Missings
@@ -312,7 +310,8 @@ Retry:
Dim File = ResourceVersion.FromPlatformJson(ModJson, Type) Dim File = ResourceVersion.FromPlatformJson(ModJson, Type)
If Not File.DownloadAvailable Then Continue For If Not File.DownloadAvailable Then Continue For
'实际的添加 '实际的添加
FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\")) FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\",
ResourceVersion.DownloadReason.ModPack, TargetVersion.VanillaName, TargetVersion.ModLoaders))
Task.Progress += 1 / (1 + ModList.Count) Task.Progress += 1 / (1 + ModList.Count)
Next Next
Task.Output = FileList.Values.ToList Task.Output = FileList.Values.ToList
@@ -328,10 +327,10 @@ Retry:
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName, .NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\", .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("minecraft")("version").ToString, .MinecraftName = TargetVersion.VanillaName,
.ForgeVersion = ForgeVersion, .ForgeVersion = TargetVersion.Forge,
.NeoForgeVersion = NeoForgeVersion, .NeoForgeVersion = TargetVersion.NeoForge,
.FabricVersion = FabricVersion .FabricVersion = TargetVersion.Fabric
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
'构造总加载器 '构造总加载器
@@ -342,22 +341,22 @@ Retry:
Sub(Task As LoaderTask(Of String, String)) Sub(Task As LoaderTask(Of String, String))
'设置图标 '设置图标
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\" Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then If Logo IsNot Nothing AndAlso FileUtils.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True) FileUtils.Copy(Logo, VersionFolder & "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png") WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True") WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo：" & Logo) Logger.Info($"已设置整合包 Logo：{Logo}")
End If End If
'删除原始整合包文件 '删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"} For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If File.Exists(Target) Then If FileUtils.Exists(Target) Then
Log("[ModPack] 删除原始整合包文件：" & Target) Logger.Info($"删除原始整合包文件：{Target}")
File.Delete(Target) FileUtils.Delete(Target)
End If End If
Next Next
If File.Exists(FileAddress) AndAlso Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then If FileUtils.Exists(FileAddress) AndAlso PathUtils.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件：" & FileAddress) Logger.Info($"删除安装整合包文件：{FileAddress}")
File.Delete(FileAddress) FileUtils.Delete(FileAddress)
End If End If
End Sub) With {.ProgressWeight = 0.1, .Show = False}) End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -383,29 +382,26 @@ Retry:
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open)) Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open().ReadString)
Catch ex As Exception Catch ex As Exception
Throw New Exception("Modrinth 整合包安装信息存在问题", ex) Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
End Try End Try
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息") If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息")
'获取 Mod API 版本信息 '获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing Dim TargetVersion As New McVersion
Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
For Each Entry As JProperty In If(Json("dependencies"), {}) For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.Lower Select Case Entry.Name.Lower
Case "minecraft" Case "minecraft"
MinecraftVersion = Entry.Value.ToString TargetVersion.VanillaName = Entry.Value.ToString
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0 Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
ForgeVersion = Entry.Value.ToString TargetVersion.Forge = Entry.Value.ToString
Log("[ModPack] 整合包 Forge 版本：" & ForgeVersion) Logger.Info($"整合包 Forge 版本：{TargetVersion.Forge}")
Case "neoforge", "neo-forge" 'eg. 20.6.98-beta Case "neoforge", "neo-forge" 'eg. 20.6.98-beta
NeoForgeVersion = Entry.Value.ToString TargetVersion.NeoForge = Entry.Value.ToString
Log("[ModPack] 整合包 NeoForge 版本：" & NeoForgeVersion) Logger.Info($"整合包 NeoForge 版本：{TargetVersion.NeoForge}")
Case "fabric-loader" 'eg. 0.14.14 Case "fabric-loader" 'eg. 0.14.14
FabricVersion = Entry.Value.ToString TargetVersion.Fabric = Entry.Value.ToString
Log("[ModPack] 整合包 Fabric 版本：" & FabricVersion) Logger.Info($"整合包 Fabric 版本：{TargetVersion.Fabric}")
Case Else Case Else
'Case "quilt-loader" 'eg. 1.0.0 'Case "quilt-loader" 'eg. 1.0.0
NotifyIncompatibleLoader(Entry.Name) NotifyIncompatibleLoader(Entry.Name)
@@ -427,13 +423,11 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides", InstallTemp & ArchiveBaseFolder & "overrides",
McFolderSelected & "versions\" & InstanceName, McFolderSelected & "versions\" & InstanceName, Task)
Task, 0.4)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "client-overrides", InstallTemp & ArchiveBaseFolder & "client-overrides",
McFolderSelected & "versions\" & InstanceName, McFolderSelected & "versions\" & InstanceName, Task)
Task, 0.1) End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表 '获取下载文件列表
Dim FileList As New List(Of NetFile) Dim FileList As New List(Of NetFile)
For Each File In If(Json("files"), {}) For Each File In If(Json("files"), {})
@@ -441,7 +435,7 @@ Retry:
If File("env") IsNot Nothing Then If File("env") IsNot Nothing Then
Select Case File("env")("client").ToString Select Case File("env")("client").ToString
Case "optional" Case "optional"
If MyMsgBox("是否要下载可选文件 " & GetFileNameFromPath(File("path").ToString) & "？", If MyMsgBox("是否要下载可选文件 " & PathUtils.GetLastPart(File("path").ToString) & "？",
"下载可选文件", "是", "否") = 2 Then "下载可选文件", "是", "否") = 2 Then
Continue For Continue For
End If End If
@@ -452,10 +446,12 @@ Retry:
'添加下载文件 '添加下载文件
Dim Urls = File("downloads").SelectMany(Function(t) ResourceVersion.ParseCurseForgeDownloadUrls(t.ToString)).ToList Dim Urls = File("downloads").SelectMany(Function(t) ResourceVersion.ParseCurseForgeDownloadUrls(t.ToString)).ToList
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList) Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = ResourceVersion.ParseModrinthTrackArguments(Urls,
ResourceVersion.DownloadReason.ModPack, TargetVersion.VanillaName, TargetVersion.ModLoaders).ToList 'Modrinth 来源追踪信息
Urls = Urls.Distinct.ToList() Urls = Urls.Distinct.ToList()
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}" Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then If Not Path.GetFullPath(TargetPath).StartsWithF(Path.GetFullPath($"{McFolderSelected}versions\{InstanceName}\")) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！" & vbCrLf & "错误的文件：" & TargetPath, "文件路径校验失败", IsWarn:=True) MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！{vbCrLf}目标：{Path.GetFullPath(TargetPath)}{vbCrLf}错误的文件：{TargetPath}", "文件路径校验失败", IsWarn:=True)
Throw New CancelledException Throw New CancelledException
End If End If
FileList.Add(New NetFile(Urls, TargetPath, FileList.Add(New NetFile(Urls, TargetPath,
@@ -469,10 +465,10 @@ Retry:
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName, .NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\", .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = MinecraftVersion, .MinecraftName = TargetVersion.VanillaName,
.ForgeVersion = ForgeVersion, .ForgeVersion = TargetVersion.Forge,
.NeoForgeVersion = NeoForgeVersion, .NeoForgeVersion = TargetVersion.NeoForge,
.FabricVersion = FabricVersion .FabricVersion = TargetVersion.Fabric
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
'构造总加载器 '构造总加载器
@@ -483,22 +479,22 @@ Retry:
Sub(Task As LoaderTask(Of String, String)) Sub(Task As LoaderTask(Of String, String))
'设置图标 '设置图标
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\" Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then If Logo IsNot Nothing AndAlso FileUtils.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True) FileUtils.Copy(Logo, VersionFolder & "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png") WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True") WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo：" & Logo) Logger.Info($"已设置整合包 Logo：{Logo}")
End If End If
'删除原始整合包文件 '删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"} For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If File.Exists(Target) Then If FileUtils.Exists(Target) Then
Log("[ModPack] 删除原始整合包文件：" & Target) Logger.Info($"删除原始整合包文件：{Target}")
File.Delete(Target) FileUtils.Delete(Target)
End If End If
Next Next
If File.Exists(FileAddress) AndAlso Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then If FileUtils.Exists(FileAddress) AndAlso PathUtils.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件：" & FileAddress) Logger.Info($"删除安装整合包文件：{FileAddress}")
File.Delete(FileAddress) FileUtils.Delete(FileAddress)
End If End If
End Sub) With {.ProgressWeight = 0.1, .Show = False}) End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -523,7 +519,7 @@ Retry:
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8)) Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open().ReadString(Encoding.UTF8))
Catch ex As Exception Catch ex As Exception
Throw New Exception("HMCL 整合包安装信息存在问题", ex) Throw New Exception("HMCL 整合包安装信息存在问题", ex)
End Try End Try
@@ -541,9 +537,8 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "minecraft", InstallTemp & ArchiveBaseFolder & "minecraft",
McFolderSelected & "versions\" & InstanceName, McFolderSelected & "versions\" & InstanceName, Task)
Task, 0.4) End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造游戏本体安装加载器 '构造游戏本体安装加载器
If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！") If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
@@ -577,13 +572,13 @@ Retry:
'读取 Json 文件 '读取 Json 文件
Dim PackJson As JObject, PackInstance As String Dim PackJson As JObject, PackInstance As String
Try Try
PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8)) PackJson = GetJson(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open().ReadString(Encoding.UTF8))
PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, 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)
End Try End Try
'获取版本名 '获取版本名
Dim InstanceName As String = If(RegexSeek(PackInstance, "(?<=\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 ObjectModel.Collection(Of Validate) From {Validate})
@@ -597,15 +592,14 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & ".minecraft", InstallTemp & ArchiveBaseFolder & ".minecraft",
McFolderSelected & "versions\" & InstanceName, McFolderSelected & "versions\" & InstanceName, Task)
Task, 0.4)
'读取 MMC 设置文件（#2655） '读取 MMC 设置文件（#2655）
Try Try
Dim MmcSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg" Dim MmcSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
If File.Exists(MmcSetupFile) Then If FileUtils.Exists(MmcSetupFile) Then
'将其中的等号替换为冒号，以符合 ini 文件格式 '将其中的等号替换为冒号，以符合 ini 文件格式
Dim Lines As New List(Of String) Dim Lines As New List(Of String)
For Each Line In ReadFile(MmcSetupFile).Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries) For Each Line In FileUtils.ReadAsLines(MmcSetupFile, True)
If Not Line.Contains("=") Then Continue For If Not Line.Contains("=") Then Continue For
Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("=")) Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
Next Next
@@ -620,42 +614,42 @@ Retry:
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}")
WriteIni(SetupFile, "VersionAdvanceRun", PreLaunchCommand) WriteIni(SetupFile, "VersionAdvanceRun", PreLaunchCommand)
Log("[ModPack] 迁移 MultiMC 版本独立设置：启动前执行命令：" & PreLaunchCommand) Logger.Info($"迁移 MultiMC 版本独立设置：启动前执行命令：{PreLaunchCommand}")
End If End If
End If End If
If ReadIni(MmcSetupFile, "JoinServerOnLaunch", False) Then If ReadIni(MmcSetupFile, "JoinServerOnLaunch", False) Then
Dim ServerAddress As String = ReadIni(MmcSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """") Dim ServerAddress As String = ReadIni(MmcSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """")
WriteIni(SetupFile, "VersionServerEnter", ServerAddress) WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
Log("[ModPack] 迁移 MultiMC 版本独立设置：自动进入服务器：" & ServerAddress) Logger.Info($"迁移 MultiMC 版本独立设置：自动进入服务器：{ServerAddress}")
End If End If
If ReadIni(MmcSetupFile, "IgnoreJavaCompatibility", False) Then If ReadIni(MmcSetupFile, "IgnoreJavaCompatibility", False) Then
WriteIni(SetupFile, "VersionAdvanceJava", True) WriteIni(SetupFile, "VersionAdvanceJava", True)
Log("[ModPack] 迁移 MultiMC 版本独立设置：忽略 Java 兼容性警告") Logger.Info("迁移 MultiMC 版本独立设置：忽略 Java 兼容性警告")
End If End If
Dim Logo As String = ReadIni(MmcSetupFile, "iconKey", "") Dim Logo As String = ReadIni(MmcSetupFile, "iconKey", "")
If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then If Logo <> "" AndAlso FileUtils.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True) WriteIni(SetupFile, "LogoCustom", True)
WriteIni(SetupFile, "Logo", "PCL\Logo.png") WriteIni(SetupFile, "Logo", "PCL\Logo.png")
CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png") FileUtils.Copy($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png")
Log($"[ModPack] 迁移 MultiMC 版本独立设置：版本图标（{Logo}.png）") Logger.Info($"迁移 MultiMC 版本独立设置：版本图标（{Logo}.png）")
End If End If
'JVM 参数 'JVM 参数
Dim JvmArgs As String = ReadIni(MmcSetupFile, "JvmArgs", "") Dim JvmArgs As String = ReadIni(MmcSetupFile, "JvmArgs", "")
If JvmArgs <> "" Then If JvmArgs <> "" Then
If ReadIni(MmcSetupFile, "OverrideJavaArgs", False) Then If ReadIni(MmcSetupFile, "OverrideJavaArgs", False) Then
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs) WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数（覆盖）：" & JvmArgs) Logger.Info($"迁移 MultiMC 版本独立设置：JVM 参数（覆盖）：{JvmArgs}")
Else Else
JvmArgs += " " & Settings.Get("LaunchAdvanceJvm") JvmArgs += " " & Settings.Get(Of String)("LaunchAdvanceJvm")
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs) WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数（追加）：" & JvmArgs) Logger.Info($"迁移 MultiMC 版本独立设置：JVM 参数（追加）：{JvmArgs}")
End If End If
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, $"读取 MMC 配置文件失败（{InstallTemp}{ArchiveBaseFolder}instance.cfg）") Logger.Warn(ex, $"读取 MMC 配置文件失败（{InstallTemp}{ArchiveBaseFolder}instance.cfg）")
End Try End Try
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造版本安装请求 '构造版本安装请求
If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息，无法安装！") If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With {.NewInstanceName = InstanceName, .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\"} Dim Request As New McInstallRequest With {.NewInstanceName = InstanceName, .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\"}
@@ -674,7 +668,7 @@ Retry:
'Case "org.quiltmc.quilt-loader" 'eg. 1.0.0 'Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
Case Else Case Else
If UID.StartsWithF("org.lwjgl") Then '#8210 If UID.StartsWithF("org.lwjgl") Then '#8210
Log("[ModPack] 已跳过 LWJGL 项：" & UID) Logger.Info($"已跳过 LWJGL 项：{UID}")
Else Else
NotifyIncompatibleLoader(UID) NotifyIncompatibleLoader(UID)
End If End If
@@ -710,7 +704,7 @@ Retry:
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(ReadFile(Entry.Open, Encoding.UTF8)) Json = GetJson(Entry.Open().ReadString(Encoding.UTF8))
Catch ex As Exception Catch ex As Exception
Throw New Exception("MCBBS 整合包安装信息存在问题", ex) Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
End Try End Try
@@ -731,15 +725,14 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides", InstallTemp & ArchiveBaseFolder & "overrides",
McFolderSelected & "versions\" & InstanceName, McFolderSelected & "versions\" & InstanceName, Task)
Task, 0.4)
'JVM 参数 'JVM 参数
If Json("launchInfo") IsNot Nothing Then If Json("launchInfo") IsNot Nothing Then
Dim LaunchInfo As JObject = Json("launchInfo") Dim LaunchInfo As JObject = Json("launchInfo")
If LaunchInfo.ContainsKey("javaArgument") Then WriteIni(SetupFile, "VersionAdvanceJvm", String.Join(" ", LaunchInfo("javaArgument"))) If LaunchInfo.ContainsKey("javaArgument") Then WriteIni(SetupFile, "VersionAdvanceJvm", String.Join(" ", LaunchInfo("javaArgument")))
If LaunchInfo.ContainsKey("launchArgument") Then WriteIni(SetupFile, "VersionAdvanceGame", String.Join(" ", LaunchInfo("launchArgument"))) If LaunchInfo.ContainsKey("launchArgument") Then WriteIni(SetupFile, "VersionAdvanceGame", String.Join(" ", LaunchInfo("launchArgument")))
End If End If
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造加载器 '构造加载器
If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息，无法安装！") If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息，无法安装！")
Dim Addons As New Dictionary(Of String, String) Dim Addons As New Dictionary(Of String, String)
@@ -787,9 +780,9 @@ Retry:
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 Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'获取解压路径 '获取解压路径
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True) MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）") Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException If TargetFolder Is Nothing Then Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
'解压 '解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", { Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包", New LoaderTask(Of String, Integer)("解压压缩包",
@@ -799,42 +792,42 @@ Retry:
Thread.Sleep(400) '避免文件争用 Thread.Sleep(400) '避免文件争用
'查找解压后的 exe 文件 '查找解压后的 exe 文件
Dim Launcher As String = Nothing Dim Launcher As String = Nothing
For Each ExeFile In Directory.GetFiles(TargetFolder, "*.exe", SearchOption.TopDirectoryOnly) For Each ExeFile In DirectoryUtils.GetFiles(TargetFolder, True, "*.exe")
Dim Info = FileVersionInfo.GetVersionInfo(ExeFile) Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
Log($"[Modpack] 文件 {ExeFile} 的产品名标识为 {Info.ProductName}") Logger.Info($"文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
If Info.ProductName = "Plain Craft Launcher" Then If Info.ProductName = "Plain Craft Launcher" Then
Launcher = ExeFile Launcher = ExeFile
Log($"[Modpack] 发现整合包附带的 PCL 启动器：{ExeFile}") Logger.Info($"发现整合包附带的 PCL 启动器：{ExeFile}")
ElseIf (Info.ProductName.ContainsIgnoreCase("Launcher") OrElse Info.ProductName.Contains("启动")) AndAlso ElseIf (Info.ProductName.ContainsIgnoreCase("Launcher") OrElse Info.ProductName.Contains("启动")) AndAlso
Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then
If Launcher Is Nothing Then If Launcher Is Nothing Then
Launcher = ExeFile Launcher = ExeFile
Log($"[Modpack] 发现整合包附带的疑似第三方启动器：{ExeFile}") Logger.Info($"发现整合包附带的疑似第三方启动器：{ExeFile}")
End If End If
End If End If
Next Next
Task.Progress = 0.95 Task.Progress = 0.95
'尝试使用附带的启动器打开 '尝试使用附带的启动器打开
If Launcher IsNot Nothing Then If Launcher IsNot Nothing Then
Log("[Modpack] 找到压缩包中附带的启动器：" & Launcher) Logger.Info($"找到压缩包中附带的启动器：{Launcher}")
If MyMsgBox($"整合包里似乎自带了启动器，是否换用它继续安装？{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "换用", "不换用") = 1 Then If MyMsgBox($"整合包里似乎自带了启动器，是否换用它继续安装？{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "换用", "不换用") = 1 Then
StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出 StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出
Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序") Logger.Info("为换用整合包中的启动器启动，强制结束程序")
FrmMain.EndProgram(False) FrmMain.EndProgram(False)
Return Return
End If End If
Else Else
Log("[Modpack] 未找到压缩包中附带的启动器") Logger.Info("未找到压缩包中附带的启动器")
End If End If
'加入文件夹列表 '加入文件夹列表
Dim InstanceName As String = GetFolderNameFromPath(TargetFolder) Dim InstanceName As String = PathUtils.GetLastPart(TargetFolder)
DirectoryUtils.Create(TargetFolder & ".minecraft\") DirectoryUtils.Create(TargetFolder & ".minecraft\")
PageSelectLeft.AddFolder( PageSelectLeft.AddFolder(
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串） TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
InstanceName, False) InstanceName, False)
'调用 modpack 文件进行安装 '调用 modpack 文件进行安装
Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First Dim ModpackFile = DirectoryUtils.GetFiles(TargetFolder, "modpack.*").First
Log("[Modpack] 调用 modpack 文件继续安装：" & ModpackFile) Logger.Info($"调用 modpack 文件继续安装：{ModpackFile}")
ModpackInstall(ModpackFile) ModpackInstall(ModpackFile)
End Sub) End Sub)
}) })
@@ -859,20 +852,20 @@ Retry:
Next Next
If Match Is Nothing Then Throw New Exception("文件结构不匹配，这可能不是 Minecraft 客户端压缩包？") '没有匹配 If Match Is Nothing Then Throw New Exception("文件结构不匹配，这可能不是 Minecraft 客户端压缩包？") '没有匹配
Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如：包裹文件夹\.minecraft\（最短为空字符串） Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
Log("[ModPack] 检测到压缩包的 .minecraft 根目录：" & ArchiveBaseFolder & "，命中的版本名：" & Match.Groups(1).Value) Logger.Info($"检测到压缩包的 .minecraft 根目录：{ArchiveBaseFolder}，命中的版本名：{Match.Groups(1).Value}")
'获取解压路径 '获取解压路径
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True) MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）") Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException If TargetFolder Is Nothing Then Throw New CancelledException
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 CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
'解压 '解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", { Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包", New LoaderTask(Of String, Integer)("解压压缩包",
Sub(Task As LoaderTask(Of String, Integer)) Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.95) ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.95)
'加入文件夹列表 '加入文件夹列表
PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False) PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, PathUtils.GetLastPart(TargetFolder), False)
Thread.Sleep(400) '避免文件争用 Thread.Sleep(400) '避免文件争用
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.InstanceSelect)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.InstanceSelect))
End Sub) End Sub)
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+19 -18
View File
@@ -33,13 +33,13 @@
HasRunningMinecraft = False HasRunningMinecraft = False
FrmMain.BtnExtraShutdown.ShowRefresh() FrmMain.BtnExtraShutdown.ShowRefresh()
'音乐播放 '音乐播放
If Settings.Get("UiMusicStop") Then If Settings.Get(Of Boolean)("UiMusicStop") Then
RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置，在结束后开始音乐播放")) RunInUi(Sub() If MusicResume() Then Logger.Info("已根据设置，在结束后开始音乐播放"))
ElseIf Settings.Get("UiMusicStart") Then ElseIf Settings.Get(Of Boolean)("UiMusicStart") Then
RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置，在结束后暂停音乐播放")) RunInUi(Sub() If MusicPause() Then Logger.Info("已根据设置，在结束后暂停音乐播放"))
End If End If
'启动器可见性 '启动器可见性
Select Case Settings.Get("LaunchArgumentVisible") Select Case Settings.Get(Of Integer)("LaunchArgumentVisible")
Case 2 Case 2
'直接关闭 '直接关闭
If TriggerLauncherShutdown Then If TriggerLauncherShutdown Then
@@ -105,7 +105,7 @@
Loop Loop
WatcherLog("Minecraft 日志监控已退出") WatcherLog("Minecraft 日志监控已退出")
Catch ex As Exception Catch ex As Exception
Log(ex, "Minecraft 日志监控主循环出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "Minecraft 日志监控主循环出错")
State = MinecraftState.Ended State = MinecraftState.Ended
End Try End Try
End Sub, "Minecraft Watcher PID " & PID) End Sub, "Minecraft Watcher PID " & PID)
@@ -174,7 +174,7 @@
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "输出 Minecraft 日志失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "输出 Minecraft 日志失败")
End Try End Try
End Sub End Sub
Public LatestLog As New Queue(Of String) Public LatestLog As New Queue(Of String)
@@ -186,6 +186,7 @@
'加入预存储 '加入预存储
LatestLog.Enqueue(Text) LatestLog.Enqueue(Text)
If LatestLog.Count >= 501 Then LatestLog.Dequeue() If LatestLog.Count >= 501 Then LatestLog.Dequeue()
Logger.Trace(Text)
'进度处理 '进度处理
If LogProgress < 1 Then If LogProgress < 1 Then
WatcherLog("日志 1/5：已出现日志输出") WatcherLog("日志 1/5：已出现日志输出")
@@ -265,7 +266,7 @@
MinecraftWindow = TryGetMinecraftWindow() MinecraftWindow = TryGetMinecraftWindow()
Catch ex As ComponentModel.Win32Exception Catch ex As ComponentModel.Win32Exception
'拒绝访问（#1062） '拒绝访问（#1062）
Log(ex, "由于反作弊或安全软件拦截，PCL 无法操作游戏窗口", NotifyLevel.AllUsers) Logger.Error(ex, "由于反作弊或安全软件拦截，PCL 无法操作游戏窗口", LogBehavior.Toast)
IsWindowFinished = True IsWindowFinished = True
End Try End Try
If MinecraftWindow Is Nothing Then Return If MinecraftWindow Is Nothing Then Return
@@ -277,7 +278,7 @@
WatcherLog($"Minecraft 窗口已加载：{MinecraftWindowName}（{MinecraftWindowHandle.ToInt64}）") WatcherLog($"Minecraft 窗口已加载：{MinecraftWindowName}（{MinecraftWindowHandle.ToInt64}）")
IsWindowFinished = True IsWindowFinished = True
'最大化 '最大化
If Settings.Get("LaunchArgumentWindowType") = 4 Then If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 4 Then
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
@@ -287,7 +288,7 @@
ShowWindow(WindowHandle, 3) ShowWindow(WindowHandle, 3)
WatcherLog($"已最大化 Minecraft 窗口：{MinecraftWindowHandle.ToInt64}") WatcherLog($"已最大化 Minecraft 窗口：{MinecraftWindowHandle.ToInt64}")
Catch ex As Exception Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误") Logger.Warn(ex, "最大化 Minecraft 窗口时出现错误")
End Try End Try
End Sub, "MinecraftWindowMaximize") End Sub, "MinecraftWindowMaximize")
End If End If
@@ -297,7 +298,7 @@
End If End If
IsWindowAppeared = True IsWindowAppeared = True
Catch ex As Exception Catch ex As Exception
Log(ex, "检查 Minecraft 窗口失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "检查 Minecraft 窗口失败")
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -305,10 +306,10 @@
''' Nothing 代表未找到。 ''' Nothing 代表未找到。
''' </summary> ''' </summary>
Private Function TryGetMinecraftWindow() As KeyValuePair(Of IntPtr, String)? Private Function TryGetMinecraftWindow() As KeyValuePair(Of IntPtr, String)?
TryGetMinecraftWindow = Nothing Dim Result = Nothing
EnumWindows( EnumWindows(
Sub(hwnd As IntPtr, lParam As Integer) Sub(hwnd As IntPtr, lParam As Integer)
If TryGetMinecraftWindow IsNot Nothing Then Return If Result IsNot Nothing Then Return
'检查类名 '检查类名
Dim str As New StringBuilder(512) Dim str As New StringBuilder(512)
GetClassName(hwnd, str, str.Capacity) GetClassName(hwnd, str, str.Capacity)
@@ -327,13 +328,13 @@
Try Try
If Process.GetProcessById(ProcessId).StartTime < GameProcess.StartTime Then Return '需要是此后启动的进程 If Process.GetProcessById(ProcessId).StartTime < GameProcess.StartTime Then Return '需要是此后启动的进程
Catch ex As Exception Catch ex As Exception
Log(ex, "枚举 Minecraft 窗口进程失败") Logger.Warn(ex, "枚举 Minecraft 窗口进程失败")
Return Return
End Try End Try
'返回 '返回
TryGetMinecraftWindow = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText) Result = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText)
End Sub, 0) End Sub, 0)
Return TryGetMinecraftWindow Return Result
End Function End Function
Private Delegate Sub EnumWindowsSub(hwnd As IntPtr, lParam As Integer) Private Delegate Sub EnumWindowsSub(hwnd As IntPtr, lParam As Integer)
Private Declare Function EnumWindows Lib "user32" (hWnd As EnumWindowsSub, lParam As Integer) As Boolean Private Declare Function EnumWindows Lib "user32" (hWnd As EnumWindowsSub, lParam As Integer) As Boolean
@@ -363,7 +364,7 @@
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", PathExeFolder & "PCL\Log1.txt", PathExeFolder & "PCL\LatestLaunch.bat"})
Catch ex As Exception Catch ex As Exception
Log(ex, "崩溃分析失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "崩溃分析失败")
End Try End Try
End Sub, "Crash Analyzer") End Sub, "Crash Analyzer")
End Sub End Sub
@@ -376,7 +377,7 @@
If Not GameProcess.HasExited Then GameProcess.Kill() If Not GameProcess.HasExited Then GameProcess.Kill()
WatcherLog("已强制结束 Minecraft 进程") WatcherLog("已强制结束 Minecraft 进程")
Catch ex As Exception Catch ex As Exception
Log(ex, "强制结束 Minecraft 进程失败", NotifyLevel.AllUsers) Logger.Error(ex, "强制结束 Minecraft 进程失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
Plain Craft Launcher 2/Modules/ModEvent.vb
+16 -16
View File
@@ -175,7 +175,7 @@ Public Class CustomEvent
''' </summary> ''' </summary>
Public Shared Sub Raise(Type As EventType, Arg As String) Public Shared Sub Raise(Type As EventType, Arg As String)
If Type = EventType.None Then Return If Type = EventType.None Then Return
Log($"[Control] 执行自定义事件：{Type}, {Arg}") Logger.Info($"执行自定义事件：{Type}, {Arg}")
If Arg Is Nothing Then Arg = "" If Arg Is Nothing Then Arg = ""
Dim Args As String() = Arg.Split("|") Dim Args As String() = Arg.Split("|")
Try Try
@@ -196,7 +196,7 @@ Public Class CustomEvent
'确认实际路径 '确认实际路径
Dim ActualPaths = GetAbsoluteUrls(Args(0), Type) Dim ActualPaths = GetAbsoluteUrls(Args(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1) Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
Log($"[Control] 打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}") Logger.Info($"打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}")
'执行 '执行
If Type = EventType.打开帮助 Then If Type = EventType.打开帮助 Then
PageOtherHelp.EnterHelpPage(Location) PageOtherHelp.EnterHelpPage(Location)
@@ -210,7 +210,7 @@ Public Class CustomEvent
StartProcess(Info) StartProcess(Info)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", NotifyLevel.MsgBox) Logger.Error(ex, "执行打开类自定义事件失败", LogBehavior.Alert)
End Try End Try
End Sub) End Sub)
@@ -289,7 +289,7 @@ Public Class CustomEvent
Try Try
Select Case Args.Length Select Case Args.Length
Case 1 Case 1
PageOtherTest.StartCustomDownload(Args(0), GetFileNameFromPath(Args(0))) PageOtherTest.StartCustomDownload(Args(0), PathUtils.GetLastPart(Args(0)))
Case 2 Case 2
PageOtherTest.StartCustomDownload(Args(0), Args(1)) PageOtherTest.StartCustomDownload(Args(0), Args(1))
Case Else Case Else
@@ -328,7 +328,7 @@ Public Class CustomEvent
MyMsgBox("未知的事件类型：" & Type & vbCrLf & "请检查事件类型填写是否正确，或者 PCL 是否为最新版本。", "事件执行失败") MyMsgBox("未知的事件类型：" & Type & vbCrLf & "请检查事件类型填写是否正确，或者 PCL 是否为最新版本。", "事件执行失败")
End Select End Select
Catch ex As Exception Catch ex As Exception
Log(ex, $"事件执行失败（{Type}, {Arg}）", NotifyLevel.MsgBox) Logger.Error(ex, $"事件执行失败（{Type}, {Arg}）", LogBehavior.Alert)
End Try End Try
End Sub End Sub
@@ -346,7 +346,7 @@ Public Class CustomEvent
'获取文件名 '获取文件名
Dim RawFileName As String Dim RawFileName As String
Try Try
RawFileName = GetFileNameFromPath(RelativeUrl) RawFileName = PathUtils.GetLastPart(RelativeUrl)
If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件") If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件")
Catch ex As Exception Catch ex As Exception
Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件，并在同路径下包含相应 XAML 文件！" & vbCrLf & Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件，并在同路径下包含相应 XAML 文件！" & vbCrLf &
@@ -356,7 +356,7 @@ Public Class CustomEvent
End Try End Try
'下载文件 '下载文件
Dim LocalTemp As String = RequestTaskTempFolder() & RawFileName Dim LocalTemp As String = RequestTaskTempFolder() & RawFileName
Log("[Event] 转换网络资源：" & RelativeUrl & " -> " & LocalTemp) Logger.Info($"转换网络资源：{RelativeUrl} -> {LocalTemp}")
Try Try
NetDownloadByClient(RelativeUrl, LocalTemp) NetDownloadByClient(RelativeUrl, LocalTemp)
NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp.Replace(".json", ".xaml")) NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp.Replace(".json", ".xaml"))
@@ -377,25 +377,25 @@ Public Class CustomEvent
If RelativeUrl.Contains(":\") Then If RelativeUrl.Contains(":\") Then
'绝对路径 '绝对路径
Location = RelativeUrl Location = RelativeUrl
Log("[Control] 自定义事件中由绝对路径" & Type & "：" & Location) Logger.Info($"自定义事件中由绝对路径{Type}：{Location}")
ElseIf File.Exists(PathExeFolder & "PCL\" & RelativeUrl) Then ElseIf FileUtils.Exists(PathExeFolder & "PCL\" & RelativeUrl) Then
'相对 PCL 文件夹的路径 '相对 PCL 文件夹的路径
Location = PathExeFolder & "PCL\" & RelativeUrl Location = PathExeFolder & "PCL\" & RelativeUrl
Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & Type & "：" & Location) Logger.Info($"自定义事件中由相对 PCL 文件夹的路径{Type}：{Location}")
ElseIf File.Exists(PathExeFolder & "PCL\Help\" & RelativeUrl) Then ElseIf FileUtils.Exists(PathExeFolder & "PCL\Help\" & RelativeUrl) Then
'相对 PCL 本地帮助文件夹的路径 '相对 PCL 本地帮助文件夹的路径
Location = PathExeFolder & "PCL\Help\" & RelativeUrl Location = PathExeFolder & "PCL\Help\" & RelativeUrl
WorkingDir = PathExeFolder & "PCL\Help\" WorkingDir = PathExeFolder & "PCL\Help\"
Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & Type & "：" & Location) Logger.Info($"自定义事件中由相对 PCL 本地帮助文件夹的路径{Type}：{Location}")
ElseIf Type = EventType.打开帮助 AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then ElseIf Type = EventType.打开帮助 AndAlso FileUtils.Exists(PathTemp & "Help\" & RelativeUrl) Then
'相对 PCL 自带帮助文件夹的路径 '相对 PCL 自带帮助文件夹的路径
Location = PathTemp & "Help\" & RelativeUrl Location = PathTemp & "Help\" & RelativeUrl
WorkingDir = PathTemp & "Help\" WorkingDir = PathTemp & "Help\"
Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & Type & "：" & Location) Logger.Info($"自定义事件中由相对 PCL 自带帮助文件夹的路径{Type}：{Location}")
ElseIf Type = EventType.打开文件 OrElse Type = EventType.执行命令 Then ElseIf Type = EventType.打开文件 OrElse Type = EventType.执行命令 Then
'直接使用原有路径启动程序 '直接使用原有路径启动程序
Location = RelativeUrl Location = RelativeUrl
Log("[Control] 自定义事件中直接" & Type & "：" & Location) Logger.Info($"自定义事件中直接{Type}：{Location}")
Else Else
'打开帮助，但是格式不对劲 '打开帮助，但是格式不对劲
Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件：" & RelativeUrl, RelativeUrl) Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件：" & RelativeUrl, RelativeUrl)
@@ -408,7 +408,7 @@ Public Class CustomEvent
''' 弹出安全确认弹窗。返回是否继续执行。 ''' 弹出安全确认弹窗。返回是否继续执行。
''' </summary> ''' </summary>
Private Shared Function EventSafetyConfirm(Message As String) As Boolean Private Shared Function EventSafetyConfirm(Message As String) As Boolean
If Settings.Get("HintCustomCommand") Then Return True If Settings.Get(Of Boolean)("HintCustomCommand") Then Return True
Select Case MyMsgBox(Message & vbCrLf & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消") Select Case MyMsgBox(Message & vbCrLf & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
Case 1 Case 1
Return True Return True
Plain Craft Launcher 2/Modules/ModMain.vb
+108 -59
View File
@@ -133,11 +133,11 @@ Public Module ModMain
End If End If
'结束处理 '结束处理
EndHint: EndHint:
If CurrentHint.Log Then Log("[UI] 弹出提示：" & CurrentHint.Text) If CurrentHint.Log Then Logger.Info($"弹出提示：{CurrentHint.Text}")
HintWaiting.RemoveAt(0) HintWaiting.RemoveAt(0)
Loop Loop
Catch ex As Exception Catch ex As Exception
Log(ex, "显示弹出提示失败", NotifyLevel.Silent) Logger.Info(ex, "显示弹出提示失败")
End Try End Try
End Sub End Sub
Private Sub HideAllHint() Private Sub HideAllHint()
@@ -256,7 +256,7 @@ EndHint:
MsgBox(Caption, MsgBoxStyle.OkOnly + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title) MsgBox(Caption, MsgBoxStyle.OkOnly + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
Converter.Result = 1 Converter.Result = 1
End If End If
Log("[Control] 主窗体加载完成前出现意料外的等待弹窗：" & Button1 & "," & Button2 & "," & Button3, NotifyLevel.DebugModeOnly) Logger.Warn($"主窗体加载完成前出现意料外的等待弹窗：{Button1},{Button2},{Button3}")
Else Else
Try Try
FrmMain.DragStop() FrmMain.DragStop()
@@ -267,7 +267,7 @@ EndHint:
ComponentDispatcher.PopModal() ComponentDispatcher.PopModal()
End Try End Try
End If End If
Log("[Control] 普通弹框返回：" & If(Converter.Result, "null")) Logger.Info($"普通弹框返回：{If(Converter.Result, "null")}")
Return Converter.Result Return Converter.Result
Else Else
'不进行等待，直接返回 '不进行等待，直接返回
@@ -298,7 +298,7 @@ EndHint:
Finally Finally
ComponentDispatcher.PopModal() ComponentDispatcher.PopModal()
End Try End Try
Log("[Control] 输入弹框返回：" & If(Converter.Result, "null")) Logger.Info($"输入弹框返回：{If(Converter.Result, "null")}")
Return Converter.Result Return Converter.Result
End Function End Function
''' <summary> ''' <summary>
@@ -321,7 +321,7 @@ EndHint:
Finally Finally
ComponentDispatcher.PopModal() ComponentDispatcher.PopModal()
End Try End Try
Log("[Control] 选择弹框返回：" & If(Converter.Result, "null")) Logger.Info($"选择弹框返回：{If(Converter.Result, "null")}")
Return Converter.Result Return Converter.Result
End Function End Function
@@ -354,7 +354,7 @@ EndHint:
If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "处理等待中的弹窗失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "处理等待中的弹窗失败")
End Try End Try
End Sub End Sub
@@ -488,8 +488,8 @@ EndHint:
''' </summary> ''' </summary>
Public Sub New(FilePath As String) Public Sub New(FilePath As String)
RawPath = FilePath RawPath = FilePath
Dim JsonData As JObject = GetJson(ArgumentReplace(ReadFile(FilePath), AddressOf EscapeUtils.XmlEscape)) If Not FileUtils.Exists(FilePath) Then Throw New FileNotFoundException("未找到帮助文件：" & FilePath, FilePath)
If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件：" & FilePath, FilePath) Dim JsonData As JObject = GetJson(ArgumentReplace(FileUtils.ReadAsString(FilePath), AddressOf EscapeUtils.XmlEscape))
'加载常规信息 '加载常规信息
If JsonData("Title") IsNot Nothing Then If JsonData("Title") IsNot Nothing Then
Title = JsonData("Title") Title = JsonData("Title")
@@ -508,13 +508,13 @@ EndHint:
Next Next
'加载事件信息 '加载事件信息
If If(JsonData("IsEvent"), False) Then If If(JsonData("IsEvent"), False) Then
EventType = [Enum].Parse(GetType(CustomEvent.EventType), JsonData("EventType").ToString) EventType = JsonData("EventType").ToObject(Of CustomEvent.EventType)
EventData = If(JsonData("EventData"), "") EventData = If(JsonData("EventData"), "")
IsEvent = True IsEvent = True
Else Else
Dim XamlAddress As String = FilePath.Lower.Replace(".json", ".xaml") Dim XamlAddress As String = FilePath.Lower.Replace(".json", ".xaml")
If File.Exists(XamlAddress) Then If FileUtils.Exists(XamlAddress) Then
XamlContent = ReadFile(XamlAddress) XamlContent = FileUtils.ReadAsString(XamlAddress)
IsEvent = False IsEvent = False
Else Else
Throw New FileNotFoundException("未找到帮助条目 .json 对应的 .xaml 文件（" & XamlAddress & "）") Throw New FileNotFoundException("未找到帮助条目 .json 对应的 .xaml 文件（" & XamlAddress & "）")
@@ -577,42 +577,42 @@ EndHint:
Try Try
Dim IgnoreList As New List(Of String) Dim IgnoreList As New List(Of String)
'读取自定义文件 '读取自定义文件
If Directory.Exists(PathExeFolder & "PCL\Help\") Then If DirectoryUtils.Exists(PathExeFolder & "PCL\Help\") Then
For Each File In EnumerateFiles(PathExeFolder & "PCL\Help\") For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Help\")
Select Case File.Extension.Lower Select Case PathUtils.GetExtension(File)
Case ".helpignore" Case "helpignore"
'加载忽略列表 '加载忽略列表
Log("[Help] 发现 .helpignore 文件：" & File.FullName) Logger.Info($"发现 .helpignore 文件：{File}")
For Each Line In ReadFile(File.FullName).Split(vbCrLf.ToCharArray) For Each Line In FileUtils.ReadAsLines(File, True)
Dim RealString As String = Line.BeforeFirst("#").Trim Dim RealString As String = Line.BeforeFirst("#").Trim
If String.IsNullOrWhiteSpace(RealString) Then Continue For If String.IsNullOrWhiteSpace(RealString) Then Continue For
IgnoreList.Add(RealString) IgnoreList.Add(RealString)
If ModeDebug Then Log("[Help] > " & RealString) Logger.Trace($"> {RealString}")
Next Next
Case ".json" Case "json"
FileList.Add(File.FullName) FileList.Add(File)
End Select End Select
Next Next
End If End If
Log("[Help] 已扫描 PCL 文件夹下的帮助文件，目前总计 " & FileList.Count & " 条") Logger.Info($"已扫描 PCL 文件夹下的帮助文件，目前总计 {FileList.Count} 条")
'读取自带文件 '读取自带文件
For Each File In EnumerateFiles(PathTemp & "Help") For Each File In DirectoryUtils.GetFiles(PathTemp & "Help")
'跳过非 json 文件与以 . 开头的文件夹 '跳过非 json 文件与以 . 开头的文件夹
If File.Extension.Lower <> ".json" OrElse File.Directory.FullName.Replace(PathTemp & "Help", "").Contains("\.") Then Continue For If PathUtils.RemoveLastPart(File).Replace(PathTemp & "Help", "").Contains("\.") OrElse PathUtils.GetExtension(File) <> "json" Then Continue For
'检查忽略列表 '检查忽略列表
Dim RealPath As String = File.FullName.Replace(PathTemp & "Help\", "") Dim RealPath As String = File.Replace(PathTemp & "Help\", "")
For Each Ignore In IgnoreList For Each Ignore In IgnoreList
If RegexCheck(RealPath, Ignore) Then If RealPath.RegexCheck(Ignore) Then
If ModeDebug Then Log("[Help] 已忽略 " & RealPath & "：" & Ignore) Logger.Trace($"已忽略 {RealPath}：{Ignore}")
GoTo NextFile GoTo NextFile
End If End If
Next Next
FileList.Add(File.FullName) FileList.Add(File)
NextFile: NextFile:
Next Next
Log("[Help] 已扫描缓存文件夹下的帮助文件，目前总计 " & FileList.Count & " 条") Logger.Info($"已扫描缓存文件夹下的帮助文件，目前总计 {FileList.Count} 条")
Catch ex As Exception Catch ex As Exception
Log(ex, "检查帮助文件夹失败", NotifyLevel.MsgBox) Logger.Error(ex, "检查帮助文件夹失败", LogBehavior.Alert)
End Try End Try
If Loader.IsInterrupted Then Return If Loader.IsInterrupted Then Return
@@ -622,9 +622,9 @@ NextFile:
Try Try
Dim Entry As New HelpEntry(FilePath) Dim Entry As New HelpEntry(FilePath)
Dict.Add(Entry) Dict.Add(Entry)
If ModeDebug Then Log("[Help] 已加载的帮助条目：" & Entry.Title & " ← " & FilePath) Logger.Trace($"已加载的帮助条目：{Entry.Title} ← {FilePath}")
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化帮助条目失败（" & FilePath & "）", NotifyLevel.MsgBox) Logger.Error(ex, $"初始化帮助条目失败（{FilePath}）", LogBehavior.Alert)
End Try End Try
Next Next
@@ -634,7 +634,7 @@ NextFile:
Loader.Output = Dict Loader.Output = Dict
Catch ex As Exception Catch ex As Exception
Log(ex, "帮助列表初始化失败") Logger.Warn(ex, "帮助列表初始化失败")
Throw Throw
End Try End Try
End SyncLock End SyncLock
@@ -643,13 +643,12 @@ NextFile:
''' 尝试解压内置帮助文件。 ''' 尝试解压内置帮助文件。
''' </summary> ''' </summary>
Public Sub HelpTryExtract() Public Sub HelpTryExtract()
If Settings.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then If Settings.Get(Of Integer)("SystemHelpVersion") <> VersionCode OrElse Not FileUtils.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
DeleteDirectory(PathTemp & "Help") DirectoryUtils.Delete(PathTemp & "Help")
DirectoryUtils.Create(PathTemp & "Help") ExtractResources(PathTemp & "Cache\Help.zip", "Help")
FileUtils.Write(PathTemp & "Cache\Help.zip", GetResources("Help")) FileUtils.ExtractToDirectory(PathTemp & "Cache\Help.zip", PathTemp & "Help")
ExtractCompressedFile(PathTemp & "Cache\Help.zip", PathTemp & "Help")
Settings.Set("SystemHelpVersion", VersionCode) Settings.Set("SystemHelpVersion", VersionCode)
Log("[Help] 已解压内置帮助文件，目前状态：" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), NotifyLevel.DebugModeOnly) Logger.Warn($"已解压内置帮助文件，目前状态：{FileUtils.Exists(PathTemp & "Help\启动器\备份设置.xaml")}")
End If End If
End Sub End Sub
@@ -663,7 +662,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("AprilDoneYear") <> Date.Now.Year '成功后同年内则不再触发 Settings.Get(Of Integer)("AprilDoneYear") <> Date.Now.Year '成功后同年内则不再触发
End If End If
Return _IsAprilEnabled.Value Return _IsAprilEnabled.Value
End Get End Get
@@ -774,7 +773,7 @@ NextFile:
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "愚人节移动出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "愚人节移动出错")
End Try End Try
End Sub End Sub
@@ -790,7 +789,7 @@ NextFile:
PostMessage(Handle, 400 * 16 + 2, 0, 0) PostMessage(Handle, 400 * 16 + 2, 0, 0)
SetForegroundWindow(Handle) '不在这里放不行，神秘 WinAPI，建议别动 SetForegroundWindow(Handle) '不在这里放不行，神秘 WinAPI，建议别动
Catch ex As Exception Catch ex As Exception
Log(ex, "设置窗口置顶失败", NotifyLevel.AllUsers) Logger.Error(ex, "设置窗口置顶失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ClassName As String, WindowName As String) As IntPtr Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ClassName As String, WindowName As String) As IntPtr
@@ -808,19 +807,19 @@ NextFile:
Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False) Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False)
If ReadOnlyKey IsNot Nothing Then If ReadOnlyKey IsNot Nothing Then
If REG_VALUE = ReadOnlyKey.GetValue(Executeable)?.ToString() Then If REG_VALUE = ReadOnlyKey.GetValue(Executeable)?.ToString() Then
Log($"[System] 无需调整显卡设置：{Executeable}") Logger.Info($"无需调整显卡设置：{Executeable}")
Return Return
End If End If
Else Else
'创建父级键 '创建父级键
Log($"[System] 需要创建显卡设置的父级键") Logger.Info($"需要创建显卡设置的父级键")
My.Computer.Registry.CurrentUser.CreateSubKey(REG_KEY) My.Computer.Registry.CurrentUser.CreateSubKey(REG_KEY)
End If End If
End Using End Using
'写入新设置 '写入新设置
Using WriteKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, True) Using WriteKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, True)
WriteKey.SetValue(Executeable, REG_VALUE) WriteKey.SetValue(Executeable, REG_VALUE)
Log($"[System] 已调整显卡设置：{Executeable}") Logger.Info($"已调整显卡设置：{Executeable}")
End Using End Using
End Sub End Sub
@@ -829,12 +828,16 @@ NextFile:
''' </summary> ''' </summary>
Public Function ArgumentReplace(Text As String, Optional EscapeHandler As Func(Of String, String) = Nothing, Optional ReplaceTime As Boolean = True) As String Public Function ArgumentReplace(Text As String, Optional EscapeHandler As Func(Of String, String) = Nothing, Optional ReplaceTime As Boolean = True) As String
If Text Is Nothing OrElse Not Text.Contains("{") Then Return Text If Text Is Nothing OrElse Not Text.Contains("{") Then Return Text
'预处理 '预处理（注意，文件夹必须以 \ 结尾）
Static Replacer As Func(Of String, String) = Static Replacer As Func(Of String, String) =
Function(s As String) As String Function(s As String) As String
If s Is Nothing Then Return "" If s Is Nothing Then Return ""
If EscapeHandler Is Nothing Then Return s If EscapeHandler Is Nothing Then Return s
If s.Contains(":\") Then s = FileUtils.ShortenPath(s) If s.Contains(":\") Then
Dim IsFolder = s.EndsWithF("\") OrElse s.EndsWithF("/")
s = PathUtils.ToShortPath(s)
If IsFolder Then s = PathUtils.AddSlashSuffix(s)
End If
Return EscapeHandler(s) Return EscapeHandler(s)
End Function End Function
'基础 '基础
@@ -844,10 +847,10 @@ 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(PathExeFolder)) Text = Text.Replace("{path}", Replacer(PathUtils.CurrentFolder))
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.ReplaceOnDemand("{pcl_md5}", Function() Replacer(GetFileMD5(PathExe))) Text = Text.Replace("{pcl_md5}", Function() Replacer(HashUtils.ComputeFromFile(PathExe, HashUtils.HashMethod.Md5)))
'时间 '时间
If ReplaceTime Then '在窗口标题中，时间会被后续动态替换，所以此时不应该替换 If ReplaceTime Then '在窗口标题中，时间会被后续动态替换，所以此时不应该替换
Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy'/'M'/'d"))) Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy'/'M'/'d")))
@@ -915,12 +918,12 @@ NextFile:
IsTaskTempCleared = True IsTaskTempCleared = True
IsTaskTempClearing = True IsTaskTempClearing = True
Try Try
Log("[System] 开始清理任务缓存文件夹") Logger.Info("开始清理任务缓存文件夹")
DeleteDirectory($"{OsDrive}ProgramData\PCL\TaskTemp\") DirectoryUtils.Delete($"{OsDrive}ProgramData\PCL\TaskTemp\")
DeleteDirectory($"{PathTemp}TaskTemp\") DirectoryUtils.Delete($"{PathTemp}TaskTemp\")
Log("[System] 已清理任务缓存文件夹") Logger.Info("已清理任务缓存文件夹")
Catch ex As Exception Catch ex As Exception
Log(ex, "清理任务缓存文件夹失败") Logger.Warn(ex, "清理任务缓存文件夹失败")
Finally Finally
IsTaskTempClearing = False IsTaskTempClearing = False
End Try End Try
@@ -955,6 +958,52 @@ NextFile:
Return ResultFolder Return ResultFolder
End Function End Function
#End Region
#Region "反馈与遥测"
'反馈
Public Sub Feedback(Optional ShowMsgbox As Boolean = True, Optional ForceOpenLog As Boolean = False)
On Error Resume Next
FeedbackInfo()
If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug，请点击 打开文件夹 按钮，并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关，请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
OpenExplorer(PathExeFolder & "PCL\Log1.txt")
End If
OpenWebsite("https://github.com/Meloong-Git/PCL/issues/")
End Sub
''' <summary>
''' 在日志中输出系统诊断信息。
''' </summary>
Public Sub FeedbackInfo()
On Error Resume Next
Logger.Info($"诊断信息：{vbCrLf}" &
"操作系统：" & My.Computer.Info.OSFullName & "（32 位：" & Is32BitSystem & "）" & vbCrLf &
"剩余内存：" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
"DPI：" & DPI & "（" & Math.Round(DPI / 96, 2) * 100 & "%）" & vbCrLf &
"MC 文件夹：" & If(McFolderSelected, "Nothing") & vbCrLf &
"文件位置：" & PathExeFolder)
End Sub
'遥测
Public Sub Telemetry([Event] As String, ParamArray Datas As String())
If BuildType = BuildTypes.Debug Then Return '开发版不上传遥测
If Not Settings.Get(Of Boolean)("SystemSystemTelemetry") Then Return '用户关闭了遥测
If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址
RunInNewThread(
Sub()
Try
Logger.Info($"匿名数据上报：{[Event]}")
Dim Url As String = $"{ClsBaseUrl}&Event={EscapeUtils.UrlEscape([Event])}"
For i = 0 To Datas.Length - 1 Step 2
Url &= "&" & EscapeUtils.UrlEscape(Datas(i)) & "=" & EscapeUtils.UrlEscape(Datas(i + 1).ReplaceLineEndings(vbLf, mergeMultiple:=True))
Next
NetRequestByClient(Url, MakeLog:=False)
Catch ex As Exception
Logger.Warn(ex, "匿名数据上报失败")
End Try
End Sub, "Telemetry", ThreadPriority.Lowest)
End Sub
#End Region #End Region
Public DragControl = Nothing Public DragControl = Nothing
@@ -970,7 +1019,7 @@ NextFile:
If ThemeDontClick = 2 Then ThemeRefresh() If ThemeDontClick = 2 Then ThemeRefresh()
#End Region #End Region
Catch ex As Exception Catch ex As Exception
Log(ex, "短程主时钟执行异常", NotifyLevel.Critical) Logger.Error(ex, "短程主时钟执行异常", LogBehavior.AlertThenCrash)
End Try End Try
Timer4Count += 1 Timer4Count += 1
If Timer4Count = 4 Then If Timer4Count = 4 Then
@@ -980,7 +1029,7 @@ NextFile:
If ThemeNow = 12 Then ThemeRefresh() If ThemeNow = 12 Then ThemeRefresh()
#End Region #End Region
Catch ex As Exception Catch ex As Exception
Log(ex, "中程主时钟执行异常", NotifyLevel.DebugModeOnly) Logger.Warn(ex, "中程主时钟执行异常")
End Try End Try
End If End If
Timer150Count += 1 Timer150Count += 1
@@ -999,7 +1048,7 @@ NextFile:
End Sub) End Sub)
#End Region #End Region
Catch ex As Exception Catch ex As Exception
Log(ex, "长程主时钟执行异常", NotifyLevel.Critical) Logger.Error(ex, "长程主时钟执行异常", LogBehavior.AlertThenCrash)
End Try End Try
End If End If
End Sub End Sub
@@ -1012,7 +1061,7 @@ NextFile:
Thread.Sleep(50 * 0.98) Thread.Sleep(50 * 0.98)
Loop Loop
Catch ex As Exception Catch ex As Exception
Log(ex, "程序主时钟出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "程序主时钟出错")
End Try End Try
End Sub, "Timer Main") End Sub, "Timer Main")
If Not IsAprilEnabled Then Return If Not IsAprilEnabled Then Return
@@ -1028,7 +1077,7 @@ NextFile:
Thread.Sleep(1) Thread.Sleep(1)
Loop Loop
Catch ex As Exception Catch ex As Exception
Log(ex, "愚人节主时钟出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "愚人节主时钟出错")
End Try End Try
End Sub, "Timer Main Fool") End Sub, "Timer Main Fool")
End Sub End Sub
Plain Craft Launcher 2/Modules/ModMusic.vb
+30 -29
View File
@@ -24,22 +24,21 @@ 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(PathExeFolder & "PCL\Musics\")
For Each File In EnumerateFiles(PathExeFolder & "PCL\Musics\") For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Musics\")
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的 '文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
Dim Ext As String = File.Extension.Lower If {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(PathUtils.GetExtension(File)) Then Continue For
If {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(Ext) Then Continue For MusicAllList.Add(File)
MusicAllList.Add(File.FullName)
Next Next
End If End If
'打乱顺序播放 '打乱顺序播放
MusicWaitingList = If(Settings.Get("UiMusicRandom"), New List(Of String)(MusicAllList).Shuffle().ToList, New List(Of String)(MusicAllList)) MusicWaitingList = If(Settings.Get(Of Boolean)("UiMusicRandom"), New List(Of String)(MusicAllList).Shuffle().ToList, New List(Of String)(MusicAllList))
If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then
'若需要避免成为第一项的为第一项，则将它放在最后 '若需要避免成为第一项的为第一项，则将它放在最后
MusicWaitingList.RemoveAt(0) MusicWaitingList.RemoveAt(0)
MusicWaitingList.Add(PreventFirst) MusicWaitingList.Add(PreventFirst)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化音乐列表失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "初始化音乐列表失败")
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -47,16 +46,18 @@ Public Module ModMusic
''' 如果没有，可能会返回 Nothing。 ''' 如果没有，可能会返回 Nothing。
''' </summary> ''' </summary>
Private Function DequeueNextMusicAddress() As String Private Function DequeueNextMusicAddress() As String
Dim Result As String
'初始化，确保存在音乐 '初始化，确保存在音乐
If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False) If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False)
'出列下一个音乐，如果出列结束则生成新列表 '出列下一个音乐，如果出列结束则生成新列表
If MusicWaitingList.Any() Then If MusicWaitingList.Any() Then
DequeueNextMusicAddress = MusicWaitingList(0) Result = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0) MusicWaitingList.RemoveAt(0)
Else Else
DequeueNextMusicAddress = Nothing Result = Nothing
End If End If
If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress) If Not MusicWaitingList.Any() Then MusicListInit(False, Result)
Return Result
End Function End Function
#End Region #End Region
@@ -81,7 +82,7 @@ Public Module ModMusic
If MusicState = MusicStates.Pause Then If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8 FrmMain.BtnExtraMusic.LogoScale = 0.8
ToolTipText = "已暂停：" & Path.GetFileNameWithoutExtension(MusicCurrent) ToolTipText = "已暂停：" & PathUtils.GetFileNameWithoutExtension(MusicCurrent)
If MusicAllList.Count > 1 Then If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。" ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。"
Else Else
@@ -90,7 +91,7 @@ Public Module ModMusic
Else Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1 FrmMain.BtnExtraMusic.LogoScale = 1
ToolTipText = "正在播放：" & Path.GetFileNameWithoutExtension(MusicCurrent) ToolTipText = "正在播放：" & PathUtils.GetFileNameWithoutExtension(MusicCurrent)
If MusicAllList.Count > 1 Then If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。" ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。"
Else Else
@@ -103,7 +104,7 @@ Public Module ModMusic
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI() If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新背景音乐 UI 失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "刷新背景音乐 UI 失败")
End Try End Try
End Sub) End Sub)
End Sub End Sub
@@ -121,7 +122,7 @@ Public Module ModMusic
Case MusicStates.Play Case MusicStates.Play
MusicPause() MusicPause()
Case Else Case Else
Log("[Music] 音乐目前为停止状态，已强制尝试开始播放", NotifyLevel.DebugModeOnly) Logger.Warn("音乐目前为停止状态，已强制尝试开始播放")
MusicRefreshPlay(False) MusicRefreshPlay(False)
End Select End Select
End If End If
@@ -133,14 +134,14 @@ Public Module ModMusic
Public Sub MusicControlNext() Public Sub MusicControlNext()
If MusicAllList.IsSingle Then If MusicAllList.IsSingle Then
MusicStartPlay(MusicCurrent) MusicStartPlay(MusicCurrent)
Hint("重新播放：" & GetFileNameFromPath(MusicCurrent), HintType.Green) Hint("重新播放：" & PathUtils.GetLastPart(MusicCurrent), HintType.Green)
Else Else
Dim Address As String = DequeueNextMusicAddress() Dim Address As String = DequeueNextMusicAddress()
If Address Is Nothing Then If Address Is Nothing Then
Hint("没有可以播放的音乐！", HintType.Red) Hint("没有可以播放的音乐！", HintType.Red)
Else Else
MusicStartPlay(Address) MusicStartPlay(Address)
Hint("正在播放：" & GetFileNameFromPath(Address), HintType.Green) Hint("正在播放：" & PathUtils.GetLastPart(Address), HintType.Green)
End If End If
End If End If
MusicRefreshUI() MusicRefreshUI()
@@ -196,7 +197,7 @@ Public Module ModMusic
Else Else
Try Try
MusicStartPlay(Address, IsFirstLoad) MusicStartPlay(Address, IsFirstLoad)
If ShowHint Then Hint("背景音乐已刷新：" & GetFileNameFromPath(Address), HintType.Green, False) If ShowHint Then Hint("背景音乐已刷新：" & PathUtils.GetLastPart(Address), HintType.Green, False)
Catch Catch
End Try End Try
End If End If
@@ -204,7 +205,7 @@ Public Module ModMusic
MusicRefreshUI() MusicRefreshUI()
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新背景音乐播放失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "刷新背景音乐播放失败")
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -212,7 +213,7 @@ Public Module ModMusic
''' </summary> ''' </summary>
Private Sub MusicStartPlay(Address As String, Optional IsFirstLoad As Boolean = False) Private Sub MusicStartPlay(Address As String, Optional IsFirstLoad As Boolean = False)
If Address Is Nothing Then Return If Address Is Nothing Then Return
Log("[Music] 播放开始：" & Address) Logger.Info($"播放开始：{Address}")
MusicCurrent = Address MusicCurrent = Address
RunInNewThread(Sub() MusicLoop(IsFirstLoad), "Music", ThreadPriority.BelowNormal) RunInNewThread(Sub() MusicLoop(IsFirstLoad), "Music", ThreadPriority.BelowNormal)
End Sub End Sub
@@ -226,13 +227,13 @@ Public Module ModMusic
If MusicState = MusicStates.Play Then If MusicState = MusicStates.Play Then
RunInThread( RunInThread(
Sub() Sub()
Log("[Music] 已暂停播放") Logger.Info("已暂停播放")
MusicNAudio?.Pause() MusicNAudio?.Pause()
MusicRefreshUI() MusicRefreshUI()
End Sub) End Sub)
Return True Return True
Else Else
Log($"[Music] 无需暂停播放，当前状态为 {MusicState}") Logger.Info($"无需暂停播放，当前状态为 {MusicState}")
Return False Return False
End If End If
End Function End Function
@@ -241,12 +242,12 @@ Public Module ModMusic
''' </summary> ''' </summary>
Public Function MusicResume() As Boolean Public Function MusicResume() As Boolean
If MusicState = MusicStates.Play OrElse Not MusicAllList.Any() Then If MusicState = MusicStates.Play OrElse Not MusicAllList.Any() Then
Log($"[Music] 无需继续播放，当前状态为 {MusicState}") Logger.Info($"无需继续播放，当前状态为 {MusicState}")
Return False Return False
Else Else
RunInThread( RunInThread(
Sub() Sub()
Log("[Music] 已恢复播放") Logger.Info("已恢复播放")
Try Try
MusicNAudio?.Play() MusicNAudio?.Play()
Catch 'https://github.com/Meloong-Git/PCL/pull/5415#issuecomment-2751135223 Catch 'https://github.com/Meloong-Git/PCL/pull/5415#issuecomment-2751135223
@@ -285,20 +286,20 @@ Public Module ModMusic
Try Try
Reader = New AudioFileReader(MusicCurrent) Reader = New AudioFileReader(MusicCurrent)
Catch ex As Exception Catch ex As Exception
Log(ex, "使用 AudioFileReader 加载音频文件失败，换用 MediaFoundationReader 重试", NotifyLevel.DevelopOnly) Logger.Warn(ex, "使用 AudioFileReader 加载音频文件失败，换用 MediaFoundationReader 重试")
Reader = New MediaFoundationReader(MusicCurrent) Reader = New MediaFoundationReader(MusicCurrent)
End Try End Try
CurrentWave.Init(Reader) CurrentWave.Init(Reader)
CurrentWave.Play() CurrentWave.Play()
'第一次打开的暂停 '第一次打开的暂停
If IsFirstLoad AndAlso Not Settings.Get("UiMusicAuto") Then CurrentWave.Pause() If IsFirstLoad AndAlso Not Settings.Get(Of Boolean)("UiMusicAuto") Then CurrentWave.Pause()
MusicRefreshUI() MusicRefreshUI()
'停止条件：播放完毕或变化 '停止条件：播放完毕或变化
Dim PreviousVolume = 0 Dim PreviousVolume = 0
While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = PlaybackState.Stopped While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = PlaybackState.Stopped
If Settings.Get("UiMusicVolume") <> PreviousVolume Then If Settings.Get(Of Integer)("UiMusicVolume") <> PreviousVolume Then
'更新音量 '更新音量
PreviousVolume = Settings.Get("UiMusicVolume") PreviousVolume = Settings.Get(Of Integer)("UiMusicVolume")
#Disable Warning BC40008 '类型或成员已过时 #Disable Warning BC40008 '类型或成员已过时
CurrentWave.Volume = PreviousVolume / 1000 CurrentWave.Volume = PreviousVolume / 1000
#Enable Warning BC40008 '类型或成员已过时 #Enable Warning BC40008 '类型或成员已过时
@@ -311,7 +312,7 @@ Public Module ModMusic
'当前音乐已播放结束，继续下一曲 '当前音乐已播放结束，继续下一曲
If CurrentWave.PlaybackState = PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress) If CurrentWave.PlaybackState = PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception Catch ex As Exception
Log(ex, "播放音乐出现内部错误（" & MusicCurrent & "）", NotifyLevel.DevelopOnly) Logger.Warn(ex, $"播放音乐出现内部错误（{MusicCurrent}）")
If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then
Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL，才能恢复音乐播放功能！", HintType.Red) Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL，才能恢复音乐播放功能！", HintType.Red)
Thread.Sleep(1000000000) Thread.Sleep(1000000000)
@@ -322,9 +323,9 @@ Public Module ModMusic
End If End If
If Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse If Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
ex.Message.Contains("0xC00D36C4") Then '#5096：不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4) ex.Message.Contains("0xC00D36C4") Then '#5096：不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Red) Hint("播放音乐失败（" & PathUtils.GetLastPart(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Red)
Else Else
Log(ex, "播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）", NotifyLevel.AllUsers) Logger.Error(ex, $"播放音乐失败（{PathUtils.GetLastPart(MusicCurrent)}）", LogBehavior.Toast)
End If End If
'将播放错误的音乐从列表中移除 '将播放错误的音乐从列表中移除
MusicAllList.Remove(MusicCurrent) MusicAllList.Remove(MusicCurrent)
Plain Craft Launcher 2/Modules/ModSecret.vb
+5 -5
View File
@@ -150,7 +150,7 @@ Friend Module ModSecret
Application.Current.Resources("ColorObjectBg1") = CType(ColorBg1, Color) Application.Current.Resources("ColorObjectBg1") = CType(ColorBg1, Color)
ThemeRefreshMain() ThemeRefreshMain()
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新主题颜色失败", NotifyLevel.AllUsers) Logger.Warn(ex, "刷新主题颜色失败", NotifyLevel.AllUsers)
End Try End Try
End Sub End Sub
Public Sub ThemeRefreshMain() Public Sub ThemeRefreshMain()
@@ -166,7 +166,7 @@ Friend Module ModSecret
FrmMain.PanTitle.Background = Brush FrmMain.PanTitle.Background = Brush
FrmMain.PanTitle.Background.Freeze() FrmMain.PanTitle.Background.Freeze()
'主页面背景 '主页面背景
If Settings.Get("UiBackgroundColorful") Then If Settings.Get(Of Boolean)("UiBackgroundColorful") Then
Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)} Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)}
Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 15, ColorSat * 0.8, 91)}) Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 15, ColorSat * 0.8, 91)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.8, 91)}) Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.8, 91)})
@@ -219,16 +219,16 @@ Friend Module ModSecret
''' </summary> ''' </summary>
Public ServerConfig As JObject Public ServerConfig As JObject
Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 配置更新", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal) With Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 配置更新", Sub() Logger.Info("该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal) With
{.ReloadTimeout = 1000 * 60 * 60} '超时 1 小时 {.ReloadTimeout = 1000 * 60 * 60} '超时 1 小时
#End Region #End Region
#Region "赞助等级" #Region "赞助等级"
Public ReadOnly Property DonationRank As DonationRanks Public ReadOnly Property CurrentRank As DonationRank
Get Get
Return DonationRanks.None Return DonationRank.None
End Get End Get
End Property End Property
Plain Craft Launcher 2/Modules/Resource/ResourceFile.vb → Plain Craft Launcher 2/Modules/Resource/LocalResourceFile.vb
+25 -26
View File
@@ -1,7 +1,7 @@
''' <summary> ''' <summary>
''' 本地的社区资源文件。 ''' 本地的社区资源文件。
''' </summary> ''' </summary>
Public Class ResourceFile Public Class LocalResourceFile
#Region "文件信息" #Region "文件信息"
@@ -13,7 +13,7 @@ Public Class ResourceFile
Me.File = FileInfo Me.File = FileInfo
End Sub End Sub
Public Sub New(FullName As String) Public Sub New(FullName As String)
Me.New(New FileInfo(FullName)) Me.New(FileUtils.GetInfo(FullName))
End Sub End Sub
''' <summary> ''' <summary>
@@ -48,7 +48,7 @@ Public Class ResourceFile
''' <summary> ''' <summary>
''' 在初始化结束之后，任何信息被后续更新时触发此事件。 ''' 在初始化结束之后，任何信息被后续更新时触发此事件。
''' </summary> ''' </summary>
Public Event OnUpdate(sender As ResourceFile) Public Event OnUpdate(sender As LocalResourceFile)
''' <summary> ''' <summary>
''' 可读名称。 ''' 可读名称。
@@ -57,7 +57,7 @@ Public Class ResourceFile
Public Property Display As String Public Property Display As String
Get Get
If _Display Is Nothing Then _Display = ProjectVersion?.Display If _Display Is Nothing Then _Display = ProjectVersion?.Display
If _Display Is Nothing Then _Display = Path.GetFileNameWithoutExtension(File.FullName) If _Display Is Nothing Then _Display = PathUtils.GetFileNameWithoutExtension(File.FullName)
Return _Display Return _Display
End Get End Get
Set(value As String) Set(value As String)
@@ -97,7 +97,7 @@ Public Class ResourceFile
Return _Version Return _Version
End Get End Get
Set(value As String) Set(value As String)
If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return If _Version IsNot Nothing AndAlso _Version.RegexCheck("[0-9.\-]+") Then Return
If value IsNot Nothing AndAlso value.ContainsIgnoreCase("version") Then value = "version" '需要修改的标识 If value IsNot Nothing AndAlso value.ContainsIgnoreCase("version") Then value = "version" '需要修改的标识
_Version = value _Version = value
End Set End Set
@@ -118,16 +118,15 @@ Public Class ResourceFile
Dim Jar As ZipArchive = Nothing Dim Jar As ZipArchive = Nothing
Try Try
'基础可用性检查 '基础可用性检查
If File.FullName.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径（" & If(File.FullName, "null") & "）") If Not FileUtils.Exists(File.FullName) Then Throw New FileNotFoundException("未找到 Mod 文件（" & File.FullName & "）")
If Not IO.File.Exists(File.FullName) Then Throw New FileNotFoundException("未找到 Mod 文件（" & File.FullName & "）")
'打开 Jar 文件 '打开 Jar 文件
Jar = New ZipArchive(New FileStream(File.FullName, FileMode.Open, FileAccess.Read, FileShare.Read)) Jar = FileUtils.OpenZip(File.FullName)
'信息获取 '信息获取
LoadMetadataFromJar(Jar) LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException Catch ex As UnauthorizedAccessException
Log(ex, $"Mod 文件由于无权限无法打开（{File.FullName}）", NotifyLevel.DevelopOnly) Logger.Warn(ex, $"Mod 文件由于无权限无法打开（{File.FullName}）")
Catch ex As Exception Catch ex As Exception
Log(ex, $"Mod 文件无法打开（{File.FullName}）", NotifyLevel.DevelopOnly) Logger.Warn(ex, $"Mod 文件无法打开（{File.FullName}）")
Finally Finally
If Jar IsNot Nothing Then Jar.Dispose() If Jar IsNot Nothing Then Jar.Dispose()
End Try End Try
@@ -140,7 +139,7 @@ Public Class ResourceFile
Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info") Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info")
Dim InfoString As String = Nothing Dim InfoString As String = Nothing
If InfoEntry IsNot Nothing Then If InfoEntry IsNot Nothing Then
InfoString = ReadFile(InfoEntry.Open()) InfoString = InfoEntry.Open().ReadString()
If InfoString.Length < 15 Then InfoString = Nothing If InfoString.Length < 15 Then InfoString = Nothing
End If End If
If InfoString Is Nothing Then Exit Try If InfoString Is Nothing Then Exit Try
@@ -157,7 +156,7 @@ Public Class ResourceFile
Description = InfoObject("description") Description = InfoObject("description")
Version = InfoObject("version") Version = InfoObject("version")
Catch ex As Exception Catch ex As Exception
Log(ex, $"读取 mcmod.info 时出现未知错误（{File.FullName}）", NotifyLevel.DevelopOnly) Logger.Warn(ex, $"读取 mcmod.info 时出现未知错误（{File.FullName}）")
End Try End Try
#End Region #End Region
#Region "尝试使用 fabric.mod.json" #Region "尝试使用 fabric.mod.json"
@@ -166,7 +165,7 @@ Public Class ResourceFile
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json") Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
Dim FabricText As String = Nothing Dim FabricText As String = Nothing
If FabricEntry IsNot Nothing Then If FabricEntry IsNot Nothing Then
FabricText = ReadFile(FabricEntry.Open(), Encoding.UTF8) FabricText = FabricEntry.Open().ReadString(Encoding.UTF8)
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
End If End If
If FabricText Is Nothing Then Exit Try If FabricText Is Nothing Then Exit Try
@@ -179,7 +178,7 @@ GotFabric:
'加载成功 '加载成功
GoTo Finished GoTo Finished
Catch ex As Exception Catch ex As Exception
Log(ex, "读取 fabric.mod.json 时出现未知错误（" & File.FullName & "）", NotifyLevel.DevelopOnly) Logger.Warn(ex, $"读取 fabric.mod.json 时出现未知错误（{File.FullName}）")
End Try End Try
#End Region #End Region
#Region "尝试使用 mods.toml" #Region "尝试使用 mods.toml"
@@ -188,13 +187,13 @@ GotFabric:
Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml") Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml")
Dim TomlText As String = Nothing Dim TomlText As String = Nothing
If TomlEntry IsNot Nothing Then If TomlEntry IsNot Nothing Then
TomlText = ReadFile(TomlEntry.Open()) TomlText = TomlEntry.Open().ReadString()
If TomlText.Length < 15 Then TomlText = Nothing If TomlText.Length < 15 Then TomlText = Nothing
End If End If
If TomlText Is Nothing Then Exit Try If TomlText Is Nothing Then Exit Try
'文件标准化：统一换行符为 vbLf，去除注释、头尾的空格、空行 '文件标准化：统一换行符为 vbLf，去除注释、头尾的空格、空行
Dim Lines As New List(Of String) Dim Lines As New List(Of String)
For Each Line In TomlText.ReplaceLineEndings(vbLf).Split(vbLf) '统一换行符 For Each Line In TomlText.SplitLines(True)
If Line.StartsWithF("#") Then '去除注释 If Line.StartsWithF("#") Then '去除注释
Continue For Continue For
ElseIf Line.Contains("#") Then ElseIf Line.Contains("#") Then
@@ -268,7 +267,7 @@ GotFabric:
'加载成功 '加载成功
GoTo Finished GoTo Finished
Catch ex As Exception Catch ex As Exception
Log(ex, $"读取 mods.toml 时出现未知错误（{File.FullName}）", NotifyLevel.DevelopOnly) Logger.Warn(ex, $"读取 mods.toml 时出现未知错误（{File.FullName}）")
End Try End Try
#End Region #End Region
#Region "尝试使用 fml_cache_annotation.json" #Region "尝试使用 fml_cache_annotation.json"
@@ -277,7 +276,7 @@ GotFabric:
Dim FmlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/fml_cache_annotation.json") Dim FmlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/fml_cache_annotation.json")
Dim FmlText As String = Nothing Dim FmlText As String = Nothing
If FmlEntry IsNot Nothing Then If FmlEntry IsNot Nothing Then
FmlText = ReadFile(FmlEntry.Open(), Encoding.UTF8) FmlText = FmlEntry.Open().ReadString(Encoding.UTF8)
If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing
End If End If
If FmlText Is Nothing Then Exit Try If FmlText Is Nothing Then Exit Try
@@ -305,7 +304,7 @@ Got:
'加载成功 '加载成功
GoTo Finished GoTo Finished
Catch ex As Exception Catch ex As Exception
Log(ex, $"读取 fml_cache_annotation.json 时出现未知错误（{File.FullName}）", NotifyLevel.DevelopOnly) Logger.Warn(ex, $"读取 fml_cache_annotation.json 时出现未知错误（{File.FullName}）")
End Try End Try
#End Region #End Region
Return '没能成功获取任何信息 Return '没能成功获取任何信息
@@ -316,7 +315,7 @@ Finished:
Try Try
Dim MetaEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/MANIFEST.MF") Dim MetaEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/MANIFEST.MF")
If MetaEntry IsNot Nothing Then If MetaEntry IsNot Nothing Then
Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":") Dim MetaString As String = MetaEntry.Open().ReadString().Replace(" :", ":").Replace(": ", ":")
If MetaString.Contains("Implementation-Version:") Then If MetaString.Contains("Implementation-Version:") Then
MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count) MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
@@ -324,7 +323,7 @@ Finished:
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
Log($"获取 META-INF 中的版本信息失败（{File.FullName}）", NotifyLevel.DevelopOnly) Logger.Warn($"获取 META-INF 中的版本信息失败（{File.FullName}）")
Version = Nothing Version = Nothing
End Try End Try
End If End If
@@ -408,7 +407,7 @@ Finished:
''' </summary> ''' </summary>
Public ReadOnly Property HasUpdate As Boolean Public ReadOnly Property HasUpdate As Boolean
Get Get
Return Not Settings.Get("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing Return Not Settings.Get(Of Boolean)("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
End Get End Get
End Property End Property
@@ -421,13 +420,13 @@ Finished:
'读取缓存 '读取缓存
Dim CacheKey As String = GetHash($"{EnabledFullName}-{File.LastWriteTime.ToLongTimeString}-{File.Length}-C") Dim CacheKey As String = GetHash($"{EnabledFullName}-{File.LastWriteTime.ToLongTimeString}-{File.Length}-C")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey) Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" AndAlso RegexCheck(Cached, "^\d+$") Then '#5062 If Cached <> "" AndAlso Cached.RegexCheck("^\d+$") Then '#5062
_CurseForgeHash = Cached _CurseForgeHash = Cached
Return _CurseForgeHash Return _CurseForgeHash
End If End If
'读取文件 '读取文件
Dim data As New List(Of Byte) Dim data As New List(Of Byte)
For Each b As Byte In ReadFileBytes(File.FullName) For Each b As Byte In FileUtils.ReadAsBytes(File.FullName)
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
data.Add(b) data.Add(b)
Next Next
@@ -481,7 +480,7 @@ Finished:
Return _ModrinthHash Return _ModrinthHash
End If End If
'计算 SHA1 '计算 SHA1
_ModrinthHash = GetFileSHA1(File.FullName) _ModrinthHash = HashUtils.ComputeFromFile(File.FullName, HashUtils.HashMethod.Sha1)
'写入缓存 '写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash) WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
End If End If
@@ -498,7 +497,7 @@ Finished:
Return File.FullName Return File.FullName
End Function End Function
Public Overrides Function Equals(obj As Object) As Boolean Public Overrides Function Equals(obj As Object) As Boolean
Dim Target = TryCast(obj, ResourceFile) Dim Target = TryCast(obj, LocalResourceFile)
Return Target IsNot Nothing AndAlso File.FullName = Target.File.FullName Return Target IsNot Nothing AndAlso File.FullName = Target.File.FullName
End Function End Function
Plain Craft Launcher 2/Modules/Resource/ResourceFileLoader.vb → Plain Craft Launcher 2/Modules/Resource/LocalResourceLoaders.vb
+102 -105
View File
@@ -1,15 +1,14 @@
Public Module ResourceFileLoader Public Module LocalResourceLoaders
Private Const ResourceFileCacheVersion As Integer = 16
'加载 Mod 列表 '加载 Mod 列表
Public McModLoader As New LoaderTask(Of String, List(Of ResourceFile))("Mod List Loader", AddressOf McModLoad) Public LocalResourceLoader As New LoaderTask(Of String, List(Of LocalResourceFile))("LocalResourceLoader", AddressOf LocalResourceFileLoad)
Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of ResourceFile))) Private Sub LocalResourceFileLoad(Loader As LoaderTask(Of String, List(Of LocalResourceFile)))
Try Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.ShowProgress = False) RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.ShowProgress = False)
'等待 Mod 更新完成 '等待 Mod 更新完成
If PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Then If PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表：" & Loader.Input) Logger.Info($"等待 Mod 更新完成后才能继续加载 Mod 列表：{Loader.Input}")
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)
@@ -23,15 +22,15 @@
End If End If
'获取 Mod 文件夹下的可用文件列表 '获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo) Dim ModFileList As New List(Of String)
If Directory.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 As FileInfo In EnumerateFiles(Loader.Input) For Each File In DirectoryUtils.GetFiles(Loader.Input)
If File.DirectoryName.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
PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
File.Directory.Name = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then PathUtils.GetLastPart(PathUtils.RemoveLastPart(File)) = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then
Continue For Continue For
End If End If
End If End If
@@ -44,7 +43,7 @@
FullName.EndsWithF(".jar.old", True) OrElse FullName.EndsWithF(".zip.old", True) OrElse FullName.EndsWithF(".litemod.old", True) Then Return True FullName.EndsWithF(".jar.old", True) OrElse FullName.EndsWithF(".zip.old", True) OrElse FullName.EndsWithF(".litemod.old", True) Then Return True
Return False Return False
End Function End Function
If IsModFile(File.FullName) Then ModFileList.Add(File) If IsModFile(File) Then ModFileList.Add(File)
Next Next
End If End If
@@ -52,29 +51,29 @@
Dim CachePath As String = PathTemp & "Cache\LocalMod.json" Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
Dim Cache As New JObject Dim Cache As New JObject
Try Try
Dim CacheContent As String = ReadFile(CachePath) Dim CacheContent As String = FileUtils.TryReadAsString(CachePath)
If Not String.IsNullOrWhiteSpace(CacheContent) Then If Not String.IsNullOrWhiteSpace(CacheContent) Then
Cache = GetJson(CacheContent) Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> ResourceFileCacheVersion Then If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> Versions.LOCAL_MOD_CACHE_VERSION Then
Log($"[Mod] 本地 Mod 信息缓存版本已过期，将弃用这些缓存信息", NotifyLevel.DebugModeOnly) Logger.Warn($"本地 Mod 信息缓存版本已过期，将弃用这些缓存信息")
Cache = New JObject Cache = New JObject
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "读取本地 Mod 信息缓存失败，已重置") Logger.Warn(ex, "读取本地 Mod 信息缓存失败，已重置")
Cache = New JObject Cache = New JObject
End Try End Try
Cache("version") = ResourceFileCacheVersion Cache("version") = Versions.LOCAL_MOD_CACHE_VERSION
'加载 Mod 列表 '加载 Mod 列表
Dim ModList As New List(Of ResourceFile) Dim ModList As New List(Of LocalResourceFile)
For Each ModFile As FileInfo In ModFileList For Each ModFile In ModFileList
If Loader.IsInterrupted Then Return If Loader.IsInterrupted Then Return
Dim ModEntry As New ResourceFile(ModFile) Dim ModEntry As New LocalResourceFile(ModFile)
Dim DumpMod As ResourceFile = 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
Dim DisabledMod As ResourceFile = If(DumpMod.IsEnabled, ModEntry, DumpMod) Dim DisabledMod As LocalResourceFile = If(DumpMod.IsEnabled, ModEntry, DumpMod)
Log($"[Mod] 重复的 Mod 文件：{DumpMod.File.Name} 与 {ModEntry.File.Name}，已忽略 {DisabledMod.File.Name}", NotifyLevel.DebugModeOnly) Logger.Warn($"重复的 Mod 文件：{DumpMod.File.Name} 与 {ModEntry.File.Name}，已忽略 {DisabledMod.File.Name}")
If DisabledMod Is ModEntry Then If DisabledMod Is ModEntry Then
Continue For Continue For
Else Else
@@ -83,7 +82,7 @@
End If End If
ModList.Add(ModEntry) ModList.Add(ModEntry)
Next Next
Log($"[Mod] 共发现 {ModList.Count} 个 Mod") Logger.Info($"共发现 {ModList.Count} 个 Mod")
'排序 '排序
ModList = ModList.OrderBy(Function(m) m.File.Name).ToList ModList = ModList.OrderBy(Function(m) m.File.Name).ToList
@@ -94,33 +93,24 @@
'开始联网加载 '开始联网加载
'TODO: 添加信息获取中提示 'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of ResourceFile), JObject)(ModList, Cache), IsForceRestart:=True) LocalResourceOnlineLoader.Start((ModList, Cache, PageInstanceLeft.Instance.Version), IsForceRestart:=True)
Catch ex As Exception Catch ex As Exception
Log(ex, "Mod 列表加载失败", NotifyLevel.DebugModeOnly) Logger.Warn(ex, "Mod 列表加载失败")
Throw Throw
End Try End Try
End Sub End Sub
'联网加载 Mod 详情 '联网加载 Mod 详情
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of ResourceFile), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad) Public LocalResourceOnlineLoader As New LoaderTask(Of (ModList As List(Of LocalResourceFile), Cache As JObject, Target As McVersion), Integer)("LocalResourceOnlineLoader", AddressOf LocalResourceOnlineLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of ResourceFile), JObject), Integer)) Private Sub LocalResourceOnlineLoad(Loader As LoaderTask(Of (ModList As List(Of LocalResourceFile), Cache As JObject, Target As McVersion), Integer))
Dim Mods As New List(Of ResourceFile) Dim Mods As New List(Of LocalResourceFile)
Dim Cache As JObject = Loader.Input.Value Dim Cache As JObject = Loader.Input.Cache
Static GetTargetModLoaders As Func(Of List(Of ModLoaderTypes)) = Dim ModLoaders = Loader.Input.Target.ModLoaders
Function() As List(Of ModLoaderTypes)
Dim Loaders As New List(Of ModLoaderTypes)
If PageInstanceLeft.Instance.Version.HasForge Then Loaders.Add(ModLoaderTypes.Forge)
If PageInstanceLeft.Instance.Version.HasNeoForge Then Loaders.Add(ModLoaderTypes.NeoForge)
If PageInstanceLeft.Instance.Version.HasFabric Then Loaders.Add(ModLoaderTypes.Fabric)
If PageInstanceLeft.Instance.Version.HasLiteLoader Then Loaders.Add(ModLoaderTypes.LiteLoader)
If Not Loaders.Any() Then Loaders.AddRange({ModLoaderTypes.Forge, ModLoaderTypes.NeoForge, ModLoaderTypes.Fabric, ModLoaderTypes.LiteLoader, ModLoaderTypes.Quilt})
Return Loaders
End Function
'读取缓存，获取需要更新的 Mod 列表 '读取缓存，获取需要更新的 Mod 列表
For Each ModEntry As ResourceFile In Loader.Input.Key For Each ModEntry As LocalResourceFile In Loader.Input.ModList
If Loader.IsInterrupted Then Return If Loader.IsInterrupted Then Return
Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("") 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))
'如果缓存中的信息在 6 小时以内更新过，则无需重新获取 '如果缓存中的信息在 6 小时以内更新过，则无需重新获取
@@ -128,18 +118,17 @@
End If End If
Mods.Add(ModEntry) Mods.Add(ModEntry)
Next Next
Log($"[Mod] 有 {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
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar()) '从 JAR 中获取缺失的版本信息（下面有另一个分支） Loader.Input.ModList.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar()) '从 JAR 中获取缺失的版本信息（下面有另一个分支）
Return Return
End If 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 = PageInstanceLeft.Instance.Version Dim TargetMcVersion As McVersion = Loader.Input.Target
Dim ModLoaders = GetTargetModLoaders()
Dim VanillaVersion = TargetMcVersion.VanillaName Dim VanillaVersion = TargetMcVersion.VanillaName
'开始网络获取 '开始网络获取
Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{VanillaVersion}") Logger.Info($"目标加载器：{ModLoaders}，版本：{VanillaVersion}")
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim CurrentTaskThread As Thread = Thread.CurrentThread Dim CurrentTaskThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息 '从 Modrinth 获取信息
@@ -150,16 +139,16 @@
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList() Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthVersion As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post, Dim ModrinthVersion As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json") $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息") Logger.Info($"从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系 '步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
If ModrinthVersion.Count = 0 Then Return If ModrinthVersion.Count = 0 Then Return
Dim ModrinthMapping As New Dictionary(Of String, List(Of ResourceFile)) Dim ModrinthMapping As New Dictionary(Of String, List(Of LocalResourceFile))
For Each Entry In Mods For Each Entry In Mods
If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
If ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash Then Continue For If ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash Then Continue For
Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString
If ResourceProject.Cache.ContainsKey(ProjectId) AndAlso Entry.Project Is Nothing Then Entry.Project = ResourceProject.Cache(ProjectId) '读取已加载的缓存，加快结果出现速度 If ResourceProject.Cache.ContainsKey(ProjectId) AndAlso Entry.Project Is Nothing Then Entry.Project = ResourceProject.Cache(ProjectId) '读取已加载的缓存，加快结果出现速度
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of ResourceFile) If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of LocalResourceFile)
ModrinthMapping(ProjectId).Add(Entry) ModrinthMapping(ProjectId).Add(Entry)
'记录对应的 ProjectVersion '记录对应的 ProjectVersion
Dim File = ResourceVersion.FromPlatformJson(ModrinthVersion(Entry.ModrinthHash), ResourceTypes.Mod) Dim File = ResourceVersion.FromPlatformJson(ModrinthVersion(Entry.ModrinthHash), ResourceTypes.Mod)
@@ -170,7 +159,7 @@
End If End If
Next Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息") Logger.Info($"需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3：获取工程信息 '步骤 3：获取工程信息
If Not ModrinthMapping.Any() Then Return If Not ModrinthMapping.Any() Then Return
Dim ModrinthProject As JArray = DlModRequest( Dim ModrinthProject As JArray = DlModRequest(
@@ -181,16 +170,20 @@
Entry.Project = Project Entry.Project = Project
Next Next
Next Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息，继续获取更新信息") Logger.Info($"已从 Modrinth 获取本地 Mod 信息，继续获取更新信息")
'步骤 4：获取更新信息 '步骤 4：获取更新信息
If ModLoaders = ModLoaders.None Then
Logger.Warn("该 Minecraft 版本没有可用的 Mod 加载器，不获取 Mod 更新信息")
Return
End If
Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post, Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"", $"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").Lower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json") ""loaders"": [""{ModLoaders.Flags.Join(""",""").Lower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
For Each Entry In Mods For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.ProjectVersion Is Nothing Then Continue For If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.ProjectVersion Is Nothing Then Continue For
Dim UpdateFile = ResourceVersion.FromPlatformJson(ModrinthUpdate(Entry.ModrinthHash), ResourceTypes.Mod) Dim UpdateFile = ResourceVersion.FromPlatformJson(ModrinthUpdate(Entry.ModrinthHash), ResourceTypes.Mod)
If Not UpdateFile.DownloadAvailable Then Continue For If Not UpdateFile.DownloadAvailable Then Continue For
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.ProjectVersion.FileName} 在 Modrinth 上的最新版为 {UpdateFile.FileName}") Logger.Trace(Function() $"本地文件 {Entry.ProjectVersion.FileName} 在 Modrinth 上的最新版为 {UpdateFile.FileName}")
If Entry.ProjectVersion.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.ProjectVersion.Hash = UpdateFile.Hash Then Continue For If Entry.ProjectVersion.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.ProjectVersion.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件 '设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并 If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
@@ -202,9 +195,9 @@
Entry.UpdateFile = UpdateFile Entry.UpdateFile = UpdateFile
End If End If
Next Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束") Logger.Info($"从 Modrinth 获取本地 Mod 信息结束")
Catch ex As Exception Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败") Logger.Warn(ex, "从 Modrinth 获取本地 Mod 信息失败")
IsFailed = True IsFailed = True
Finally Finally
EndedThreadCount += 1 EndedThreadCount += 1
@@ -215,90 +208,92 @@
Sub() Sub()
Try Try
'步骤 1：获取 Hash 与对应的工程 ID '步骤 1：获取 Hash 与对应的工程 ID
Dim CurseForgeHashes As New List(Of UInteger) Dim Hashes As New List(Of UInteger)
For Each Entry In Mods For Each Entry In Mods
CurseForgeHashes.Add(Entry.CurseForgeHash) Hashes.Add(Entry.CurseForgeHash)
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return If Loader.IsInterruptedWithThread(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"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches") $"{{""fingerprints"": [{Hashes.Join(",")}]}}", "application/json")("data")("exactMatches")
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息") Logger.Info($"从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
If Not CurseForgeRaw.Any() Then Return If Not CurseForgeRaw.Any() Then Return
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of ResourceFile))
'步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
Dim ProjectIdToLocalFiles As New Dictionary(Of Integer, List(Of LocalResourceFile))
For Each Project In CurseForgeRaw For Each Project In CurseForgeRaw
Dim ProjectId = Project("id").ToString Dim ProjectId = Project("id").ToString
Dim Hash As UInteger = Project("file")("fileFingerprint") Dim Hash As UInteger = Project("file")("fileFingerprint")
For Each Entry In Mods For Each Entry In Mods
If Entry.CurseForgeHash <> Hash Then Continue For If Entry.CurseForgeHash <> Hash Then Continue For
If ResourceProject.Cache.ContainsKey(ProjectId) AndAlso Entry.Project Is Nothing Then Entry.Project = ResourceProject.Cache(ProjectId) '读取已加载的缓存，加快结果出现速度 If ResourceProject.Cache.ContainsKey(ProjectId) AndAlso Entry.Project Is Nothing Then Entry.Project = ResourceProject.Cache(ProjectId) '读取已加载的缓存，加快结果出现速度
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of ResourceFile) ProjectIdToLocalFiles.AddIntoValueCollection(ProjectId, Entry)
CurseForgeMapping(ProjectId).Add(Entry)
'记录对应的 ProjectVersion '记录对应的 ProjectVersion
Dim File = ResourceVersion.FromPlatformJson(Project("file"), ResourceTypes.Mod) Dim File = ResourceVersion.FromPlatformJson(Project("file"), ResourceTypes.Mod)
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.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息") Logger.Info($"需要从 CurseForge 获取 {ProjectIdToLocalFiles.Count} 个本地 Mod 的工程信息")
If Not ProjectIdToLocalFiles.Any() Then Return
'步骤 3：获取工程信息 '步骤 3：获取工程信息
If Not CurseForgeMapping.Any() Then Return
Dim CurseForgeProject = DlModRequest("https://api.curseforge.com/v1/mods", HttpMethod.Post, Dim CurseForgeProject = DlModRequest("https://api.curseforge.com/v1/mods", HttpMethod.Post,
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")("data") $"{{""modIds"": [{ProjectIdToLocalFiles.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of ResourceFile)) 'FileId -> 本地 Mod 文件列表 Dim UpdateFileIds As New Dictionary(Of Integer, List(Of LocalResourceFile)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String) Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject For Each ProjectJson In CurseForgeProject
If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息 '设置 Entry 中的工程信息
Dim Project As New ResourceProject(ProjectJson) Dim Project As New ResourceProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏 Dim TargetLoaders As ModLoaders = ModLoaders.None
If Entry.Project IsNot Nothing AndAlso Entry.Project.Platform = ResourcePlatforms.Modrinth Then For Each LocalFile In ProjectIdToLocalFiles(Project.Id) '倒查防止 CurseForge 返回的内容有漏
Entry.Project = Entry.Project '再次触发修改事件 If LocalFile.Project?.Platform = ResourcePlatforms.Modrinth Then
Continue For LocalFile.Project = LocalFile.Project '再次触发修改事件
Else
LocalFile.Project = Project
TargetLoaders = TargetLoaders Or LocalFile.Project.ModLoaders
End If End If
Entry.Project = Project
Next Next
TargetLoaders = TargetLoaders And ModLoaders '与目标 MC 版本的加载器取交集
'查找或许版本更新的文件列表 '查找或许版本更新的文件列表
If ModLoaders.IsSingle Then If ModLoaders = ModLoaders.None Then Continue For '无法判断 MC 版本使用的加载器，跳过更新检查
Dim NewestVersion As String = Nothing Dim LatestFiles = ProjectJson("latestFilesIndexes").Where(
Dim NewestFileIds As New List(Of Integer) Function(Entry)
For Each IndexEntry In ProjectJson("latestFilesIndexes") 'Mod Loader 匹配
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配 If Entry("modLoader") Is Nothing Then Return False
Dim IndexVersion As String = IndexEntry("gameVersion") Dim EntryLoader As ModLoaders = Resource.FromCurseForgeModLoaderType(Entry("modLoader").ToObject(Of Integer))
If IndexVersion <> VanillaVersion Then Continue For 'MC 版本匹配 If Not TargetLoaders.HasFlag(EntryLoader) Then Return False
'由于 latestFilesIndexes 是按时间从新到老排序的，所以只需取第一个；如果需要检查多个 releaseType 下的文件，将 > -1 改为 = 1，但这应当并不会获取到更新的文件 'MC 版本匹配
If NewestVersion IsNot Nothing AndAlso CompareVersion(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本 Dim EntryVersion As String = Entry("gameVersion")
If NewestVersion <> IndexVersion Then Return EntryVersion IsNot Nothing AndAlso EntryVersion = VanillaVersion
NewestVersion = IndexVersion End Function).
NewestFileIds.Clear() MaxByAll(Function(Entry) Entry("gameVersion").ToString, New VersionComparer) '只保留最新的 MC 版本
End If For Each Entry In LatestFiles
NewestFileIds.Add(IndexEntry("fileId").ToObject(Of Integer)) Dim FileId = Entry("fileId").ToObject(Of Integer)
Next If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of LocalResourceFile)
For Each FileId In NewestFileIds UpdateFileIds(FileId).AddRange(ProjectIdToLocalFiles(Project.Id))
If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of ResourceFile) FileIdToProjectSlug(FileId) = Project.Slug
UpdateFileIds(FileId).AddRange(CurseForgeMapping(Project.Id)) Next
FileIdToProjectSlug(FileId) = Project.Slug
Next
End If
Next Next
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息，需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息") Logger.Info($"已从 CurseForge 获取本地 Mod 信息，需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4：获取更新文件信息
If Not UpdateFileIds.Any() Then Return If Not UpdateFileIds.Any() Then Return
'步骤 4：获取更新文件信息
Dim CurseForgeFiles = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, Dim CurseForgeFiles = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post,
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")("data") $"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFiles As New Dictionary(Of ResourceFile, ResourceVersion) Dim UpdateFiles As New Dictionary(Of LocalResourceFile, ResourceVersion)
For Each FileJson In CurseForgeFiles For Each FileJson In CurseForgeFiles
Dim File = ResourceVersion.FromPlatformJson(FileJson, ResourceTypes.Mod) Dim File = ResourceVersion.FromPlatformJson(FileJson, ResourceTypes.Mod)
If Not File.DownloadAvailable Then Continue For If Not File.DownloadAvailable Then Continue For
For Each Entry As ResourceFile In UpdateFileIds(File.Id) For Each Entry As LocalResourceFile In UpdateFileIds(File.Id)
If UpdateFiles.ContainsKey(Entry) AndAlso UpdateFiles(Entry).ReleaseDate >= File.ReleaseDate Then Continue For If UpdateFiles.ContainsKey(Entry) AndAlso UpdateFiles(Entry).ReleaseDate >= File.ReleaseDate Then Continue For
UpdateFiles(Entry) = File UpdateFiles(Entry) = File
Next Next
Next Next
For Each Pair In UpdateFiles For Each Pair In UpdateFiles
Dim Entry As ResourceFile = Pair.Key Dim Entry As LocalResourceFile = Pair.Key
Dim UpdateFile As ResourceVersion = Pair.Value Dim UpdateFile As ResourceVersion = Pair.Value
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.ProjectVersion.FileName} 在 CurseForge 上的最新版为 {UpdateFile.FileName}") Logger.Trace(Function() $"本地文件 {Entry.ProjectVersion.FileName} 在 CurseForge 上的最新版为 {UpdateFile.FileName}")
If Entry.ProjectVersion.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.ProjectVersion.Hash = UpdateFile.Hash Then Continue For If Entry.ProjectVersion.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.ProjectVersion.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件 '设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并 If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
@@ -309,16 +304,17 @@
Entry.UpdateFile = UpdateFile Entry.UpdateFile = UpdateFile
End If End If
Next Next
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
Logger.Info($"从 CurseForge 获取 Mod 更新信息结束")
Catch ex As Exception Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败") Logger.Warn(ex, "从 CurseForge 获取本地 Mod 信息失败")
IsFailed = True IsFailed = True
Finally Finally
EndedThreadCount += 1 EndedThreadCount += 1
End Try End Try
End Sub, "Mod List Detail Loader CurseForge") End Sub, "Mod List Detail Loader CurseForge")
'从 JAR 中获取缺失的版本信息（上面有另一个分支） '从 JAR 中获取缺失的版本信息（上面有另一个分支）
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForAll(Sub(m) m.LoadMetadataFromJar()) 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)
@@ -326,11 +322,12 @@
Loop Loop
'保存缓存 '保存缓存
Mods = Mods.Where(Function(m) m.Project IsNot Nothing).ToList() Mods = Mods.Where(Function(m) m.Project IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 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
For Each Entry In Mods For Each Entry In Mods
Entry.OnlineDataLoaded = Not IsFailed Entry.OnlineDataLoaded = Not IsFailed
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = 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)))
'刷新边栏 '刷新边栏
@@ -342,4 +339,4 @@
End If End If
End Sub End Sub
End Module End Module
Plain Craft Launcher 2/Modules/Resource/ResourceProject.vb
+30 -43
View File
@@ -52,9 +52,9 @@ Public Class ResourceProject
''' </summary> ''' </summary>
Public ReadOnly DownloadCount As Integer Public ReadOnly DownloadCount As Integer
''' <summary> ''' <summary>
''' 支持的 Mod 加载器列表。可能为空。 ''' 所有支持的 Mod 加载器。可能为 <see cref="ModLoaders.None"/>。
''' </summary> ''' </summary>
Public ReadOnly Loaders As List(Of ModLoaderTypes) Public ReadOnly ModLoaders As ModLoaders = ModLoaders.None
''' <summary> ''' <summary>
''' 描述性标签的内容。已转换为中文。 ''' 描述性标签的内容。已转换为中文。
''' </summary> ''' </summary>
@@ -133,11 +133,7 @@ Public Class ResourceProject
Website = Data("Website") Website = Data("Website")
LastUpdate = Data("LastUpdate") LastUpdate = Data("LastUpdate")
DownloadCount = Data("DownloadCount") DownloadCount = Data("DownloadCount")
If Data.ContainsKey("ModLoaders") Then If Data.ContainsKey("ModLoaders") Then ModLoaders = Data("ModLoaders").ToObject(Of Integer)
Loaders = CType(Data("ModLoaders"), JArray).Select(Function(t) CType(t.ToObject(Of Integer), ModLoaderTypes)).ToList
Else
Loaders = New List(Of ModLoaderTypes)
End If
Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList
If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl") If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl")
If Data.ContainsKey("Drops") Then If Data.ContainsKey("Drops") Then
@@ -181,12 +177,12 @@ Public Class ResourceProject
Types = ResourceTypes.DataPack Types = ResourceTypes.DataPack
End If End If
'FileIndexes / VanillaMajorVersions / ModLoaders 'FileIndexes / VanillaMajorVersions / ModLoaders
Loaders = New List(Of ModLoaderTypes) ModLoaders = ModLoaders.None
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
For Each File In If(Data("latestFiles"), New JArray) For Each File In If(Data("latestFiles"), New JArray)
Dim NewFile = ResourceVersion.FromPlatformJson(File, Types) Dim NewFile = ResourceVersion.FromPlatformJson(File, Types)
If Not NewFile.DownloadAvailable Then Continue For If Not NewFile.DownloadAvailable Then Continue For
Loaders.AddRange(NewFile.Loaders) ModLoaders = ModLoaders Or NewFile.ModLoaders
Dim GameVersions = File("gameVersions").ToObject(Of List(Of String)) Dim GameVersions = File("gameVersions").ToObject(Of List(Of String))
If Not GameVersions.Any(Function(v) McVersion.IsFormatFit(v)) Then Continue For If Not GameVersions.Any(Function(v) McVersion.IsFormatFit(v)) Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions)) Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions))
@@ -198,7 +194,6 @@ Public Class ResourceProject
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
Drops = Files.SelectMany(Function(f) f.Value). Drops = Files.SelectMany(Function(f) f.Value).
Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v <> 209).Distinct.OrderByDescending(Function(v) v).ToList Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v <> 209).Distinct.OrderByDescending(Function(v) v).ToList
Loaders = Loaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Tags 'Tags
Tags = New List(Of String) Tags = New List(Of String)
For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段 (4267#issuecomment-2254590831) For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段 (4267#issuecomment-2254590831)
@@ -303,24 +298,17 @@ Public Class ResourceProject
End Select End Select
'Tags & ModLoaders 'Tags & ModLoaders
Tags = New List(Of String) Tags = New List(Of String)
Loaders = New List(Of ModLoaderTypes) ModLoaders = ModLoaders.None
If Data.ContainsKey("loaders") Then For Each Category In If(Data("loaders")?.Select(Function(t) t.ToString), {}).Concat(Data("categories").Select(Function(t) t.ToString))
For Each Category In Data("loaders").Select(Function(t) t.ToString) For Each Loader In EnumUtils.GetAllFlags(Of ModLoaders)()
Select Case Category If Category = Loader.ToString.Lower Then
Case "forge" : Loaders.Add(ModLoaderTypes.Forge) ModLoaders = ModLoaders Or Loader
Case "fabric" : Loaders.Add(ModLoaderTypes.Fabric) Exit For
Case "quilt" : Loaders.Add(ModLoaderTypes.Quilt) End If
Case "neoforge" : Loaders.Add(ModLoaderTypes.NeoForge)
End Select
Next Next
End If Next
For Each Category In Data("categories").Select(Function(t) t.ToString) For Each Category In Data("categories").Select(Function(t) t.ToString)
Select Case Category Select Case Category
'加载器
Case "forge" : Loaders.Add(ModLoaderTypes.Forge)
Case "fabric" : Loaders.Add(ModLoaderTypes.Fabric)
Case "quilt" : Loaders.Add(ModLoaderTypes.Quilt)
Case "neoforge" : Loaders.Add(ModLoaderTypes.NeoForge)
Case "datapack" : Types = ResourceTypes.DataPack Case "datapack" : Types = ResourceTypes.DataPack
'共用 '共用
Case "technology" : Tags.Add("科技") Case "technology" : Tags.Add("科技")
@@ -388,12 +376,11 @@ Public Class ResourceProject
Case "vanilla" : Tags.Add("原版可用") Case "vanilla" : Tags.Add("原版可用")
End Select End Select
Next Next
If Types = ResourceTypes.DataPack AndAlso Loaders.Any Then Types = ResourceTypes.DataPack Or ResourceTypes.Mod If Types = ResourceTypes.DataPack AndAlso ModLoaders <> ModLoaders.None Then Types = ResourceTypes.DataPack Or ResourceTypes.Mod
#End Region #End Region
End If End If
If Not Tags.Any() Then Tags.Add("其他") If Not Tags.Any() Then Tags.Add("其他")
Tags.Sort() Tags.Sort()
Loaders.Sort()
End If End If
'保存缓存 '保存缓存
Cache(Id) = Me Cache(Id) = Me
@@ -454,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 Loaders IsNot Nothing AndAlso Loaders.Any Then Json("ModLoaders") = New JArray(Loaders.Select(Function(m) CInt(m))) If ModLoaders <> ModLoaders.None Then Json("ModLoaders") = 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)
@@ -514,13 +501,13 @@ Public Class ResourceProject
End If End If
'获取 Mod 加载器描述 '获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
Dim ModLoadersForDesc As New List(Of ModLoaderTypes)(Loaders) Dim ModLoadersForDesc = ModLoaders.Flags().ToList()
If Settings.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(ModLoaderTypes.Quilt) If Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(ModLoaders.Quilt)
Select Case ModLoadersForDesc.Count Select Case ModLoadersForDesc.Count
Case 0 Case 0
If Loaders.IsSingle Then If ModLoadersForDesc.IsSingle Then
ModLoaderDescriptionFull = "仅 " & Loaders.Single.ToString ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
ModLoaderDescriptionPart = Loaders.Single.ToString ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
Else Else
ModLoaderDescriptionFull = "未知" ModLoaderDescriptionFull = "未知"
ModLoaderDescriptionPart = "" ModLoaderDescriptionPart = ""
@@ -530,10 +517,10 @@ Public Class ResourceProject
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
Case Else Case Else
Dim NewestDrop As Integer = If(Drops.Any, Drops.First, 9999) Dim NewestDrop As Integer = If(Drops.Any, Drops.First, 9999)
If Loaders.Contains(ModLoaderTypes.Forge) AndAlso If ModLoadersForDesc.Contains(ModLoaders.Forge) AndAlso
(NewestDrop < 140 OrElse Loaders.Contains(ModLoaderTypes.Fabric)) AndAlso (NewestDrop < 140 OrElse ModLoadersForDesc.Contains(ModLoaders.Fabric)) AndAlso
(NewestDrop < 200 OrElse Loaders.Contains(ModLoaderTypes.NeoForge)) AndAlso (NewestDrop < 200 OrElse ModLoadersForDesc.Contains(ModLoaders.NeoForge)) AndAlso
(NewestDrop < 140 OrElse Loaders.Contains(ModLoaderTypes.Quilt) OrElse Settings.Get("ToolDownloadIgnoreQuilt")) Then (NewestDrop < 140 OrElse ModLoadersForDesc.Contains(ModLoaders.Quilt) OrElse Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt")) Then
ModLoaderDescriptionFull = "任意" ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = "" ModLoaderDescriptionPart = ""
Else Else
@@ -596,7 +583,7 @@ Public Class ResourceProject
If TranslatedName = RawName Then If TranslatedName = RawName Then
'没有中文翻译 '没有中文翻译
'将所有名称分段 '将所有名称分段
Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries). Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, True).
Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)) Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w))
If NameLists.IsSingle Then GoTo NoSubtitle If NameLists.IsSingle Then GoTo NoSubtitle
'查找其中的缩写、Forge/Fabric 等版本标记 '查找其中的缩写、Forge/Fabric 等版本标记
@@ -608,7 +595,7 @@ Public Class ResourceProject
'缩写 '缩写
SubtitleList.Add(Name) SubtitleList.Add(Name)
ElseIf {"neoforge", "forge", "fabric", "quilt"}.Any(Function(l) LowerName.Contains(l)) AndAlso ElseIf {"neoforge", "forge", "fabric", "quilt"}.Any(Function(l) LowerName.Contains(l)) AndAlso
Not RegexCheck(LowerName.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", ""), "[a-z]+") Then '去掉关键词后没有其他字母 Not LowerName.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", "").RegexCheck("[a-z]+") Then '去掉关键词后没有其他字母
'Forge/Fabric 等版本标记 'Forge/Fabric 等版本标记
SubtitleList.Add(Name) SubtitleList.Add(Name)
Else Else
@@ -631,7 +618,7 @@ Public Class ResourceProject
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "") If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c) EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
'中段的额外信息截取 '中段的额外信息截取
SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries). SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, True).
Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList
If SubtitleList.Count > 1 AndAlso If SubtitleList.Count > 1 AndAlso
Not SubtitleList.Any(Function(s) s.Lower.Contains("forge") OrElse s.Lower.Contains("fabric") OrElse s.Lower.Contains("quilt")) AndAlso '不是标注 XX 版 Not SubtitleList.Any(Function(s) s.Lower.Contains("forge") OrElse s.Lower.Contains("fabric") OrElse s.Lower.Contains("quilt")) AndAlso '不是标注 XX 版
@@ -690,16 +677,16 @@ NoSubtitle:
'来自不同的网站 '来自不同的网站
If Platform = Project.Platform Then Return False If Platform = Project.Platform Then Return False
'Mod 加载器一致 'Mod 加载器一致
If Loaders.Count <> Project.Loaders.Count OrElse Loaders.Except(Project.Loaders).Any() Then Return False If ModLoaders <> Project.ModLoaders Then Return False
'若不为光影，则要求 MC 版本一致 '若不为光影，则要求 MC 版本一致
If Types <> ResourceTypes.Shader AndAlso (Drops.Count <> Project.Drops.Count OrElse Drops.Except(Project.Drops).Any()) Then Return False If Types <> ResourceTypes.Shader AndAlso Drops.Ordered.SequenceEqual(Project.Drops.Ordered) Then Return False
'最近更新时间差距在一周以内 '最近更新时间差距在一周以内
If Math.Abs((LastUpdate - Project.LastUpdate).TotalDays) > 7 Then Return False If Math.Abs((LastUpdate - Project.LastUpdate).TotalDays) > 7 Then Return False
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同 'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse RawName = Project.RawName OrElse Description = Project.Description OrElse
GetRaw(Slug) = GetRaw(Project.Slug) Then GetRaw(Slug) = GetRaw(Project.Slug) Then
Log($"[Resource] 将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程") Logger.Info($"将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程")
'如果只有一个有 DatabaseEntry，设置给另外一个 '如果只有一个有 DatabaseEntry，设置给另外一个
If WikiEntry Is Nothing AndAlso Project.WikiEntry IsNot Nothing Then WikiEntry = Project.WikiEntry If WikiEntry Is Nothing AndAlso Project.WikiEntry IsNot Nothing Then WikiEntry = Project.WikiEntry
If WikiEntry IsNot Nothing AndAlso Project.WikiEntry Is Nothing Then Project.WikiEntry = WikiEntry If WikiEntry IsNot Nothing AndAlso Project.WikiEntry Is Nothing Then Project.WikiEntry = WikiEntry
Plain Craft Launcher 2/Modules/Resource/ResourceSearcher.vb
+39 -34
View File
@@ -40,8 +40,10 @@
Public Tag As String = "" Public Tag As String = ""
''' <summary> ''' <summary>
''' 筛选 Mod 加载器类别。 ''' 筛选 Mod 加载器类别。
''' <see cref="ModLoaders.None"/> 代表不筛选。
''' 对于 Modrinth 请求，支持多个枚举值。
''' </summary> ''' </summary>
Public ModLoader As ModLoaderTypes = ModLoaderTypes.Any Public ModLoaders As ModLoaders = ModLoaders.None
''' <summary> ''' <summary>
''' 筛选 MC 版本。 ''' 筛选 MC 版本。
''' </summary> ''' </summary>
@@ -82,7 +84,7 @@
Address += "&classId=12" Address += "&classId=12"
End Select End Select
If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/") If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/")
If ModLoader <> ModLoaderTypes.Any AndAlso Not IgnoreModLoaderFilter Then Address += "&modLoaderType=" & CType(ModLoader, Integer) 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=" & EscapeUtils.UrlEscape(SearchText)
If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
@@ -97,11 +99,13 @@
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=" & EscapeUtils.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'"],["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)
Facets.Add($"[""project_type:{Type.ToString.Lower}""]") Facets.Add($"[""project_type:{Type.ToString.Lower}""]")
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]") If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
If ModLoader <> ModLoaderTypes.Any AndAlso Not IgnoreModLoaderFilter Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).Lower}'""]") If ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter Then
Facets.Add($"[""categories:'{ModLoaders.Flags.Select(Function(f) f.ToString.Lower).Join("',categories:'")}'""]")
End If
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]") If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
Address += "&facets=[" & String.Join(",", Facets) & "]" Address += "&facets=[" & String.Join(",", Facets) & "]"
Return Address Return Address
@@ -112,7 +116,7 @@
Dim request = TryCast(obj, SearchRequest) Dim request = TryCast(obj, SearchRequest)
Return request IsNot Nothing AndAlso Return request IsNot Nothing AndAlso
Type = request.Type AndAlso TargetResultCount = request.TargetResultCount AndAlso Type = request.Type AndAlso TargetResultCount = request.TargetResultCount AndAlso
Tag = request.Tag AndAlso ModLoader = request.ModLoader AndAlso Sources = request.Sources AndAlso Tag = request.Tag AndAlso ModLoaders = request.ModLoaders AndAlso Sources = request.Sources AndAlso
GameVersion = request.GameVersion AndAlso SearchText = request.SearchText GameVersion = request.GameVersion AndAlso SearchText = request.SearchText
End Function End Function
Public Shared Operator =(left As SearchRequest, right As SearchRequest) As Boolean Public Shared Operator =(left As SearchRequest, right As SearchRequest) As Boolean
@@ -122,7 +126,7 @@
Return Not left = right Return Not left = right
End Operator End Operator
Public Overrides Function GetHashCode() As Integer Public Overrides Function GetHashCode() As Integer
Return (Type, Tag, ModLoader, GameVersion, SearchText, Sources).GetHashCode() Return (Type, Tag, ModLoaders, GameVersion, SearchText, Sources).GetHashCode()
End Function End Function
End Class End Class
@@ -164,19 +168,19 @@
#Region "前置检查" #Region "前置检查"
If Storage.Results.Count >= Request.TargetResultCount Then If Storage.Results.Count >= Request.TargetResultCount Then
Log($"[Resource] 已有 {Storage.Results.Count} 个结果，多于所需的 {Request.TargetResultCount} 个结果，结束处理") Logger.Info($"已有 {Storage.Results.Count} 个结果，多于所需的 {Request.TargetResultCount} 个结果，结束处理")
Return Return
ElseIf Not Request.CanContinue Then ElseIf Not Request.CanContinue Then
If Not Storage.Results.Any() Then If Not Storage.Results.Any() Then
Throw New Exception("没有符合条件的结果") Throw New Exception("没有符合条件的结果")
Else Else
Log($"[Resource] 已有 {Storage.Results.Count} 个结果，少于所需的 {Request.TargetResultCount} 个结果，但无法继续获取，结束处理") Logger.Info($"已有 {Storage.Results.Count} 个结果，少于所需的 {Request.TargetResultCount} 个结果，但无法继续获取，结束处理")
Return Return
End If End If
End If End If
'拒绝 1.13- Quilt（这个版本根本没有 Quilt） '拒绝 1.13- Quilt（这个版本根本没有 Quilt）
If Request.ModLoader = ModLoaderTypes.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then If Request.ModLoaders = ModLoaders.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion) Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
End If End If
@@ -186,10 +190,10 @@
Dim RawSearchText As String = If(Request.SearchText, "").Trim Dim RawSearchText As String = If(Request.SearchText, "").Trim
RawSearchText = RawSearchText.Lower RawSearchText = RawSearchText.Lower
Log("[Resource] 工程列表搜索原始文本：" & RawSearchText) Logger.Info($"工程列表搜索原始文本：{RawSearchText}")
Dim IsChineseSearch As Boolean = Dim IsChineseSearch As Boolean =
RegexCheck(RawSearchText, "[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawSearchText) AndAlso RawSearchText.RegexCheck("[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawSearchText) AndAlso
(Request.Type = ResourceTypes.Mod OrElse Request.Type = ResourceTypes.DataPack) '目前仅对 Mod 和数据包进行中文搜索，注意整合包的名称可能已经有中文了 (Request.Type = ResourceTypes.Mod OrElse Request.Type = ResourceTypes.DataPack) '目前仅对 Mod 和数据包进行中文搜索，注意整合包的名称可能已经有中文了
Dim CurseForgeAltSearchText As String = Nothing, ModrinthAltSearchText As String = Nothing, ModrinthSlugs As New List(Of String) '从中文转为英文的替代搜索内容 Dim CurseForgeAltSearchText As String = Nothing, ModrinthAltSearchText As String = Nothing, ModrinthSlugs As New List(Of String) '从中文转为英文的替代搜索内容
If IsChineseSearch Then If IsChineseSearch Then
@@ -231,7 +235,7 @@
Function(Entry) New SearchEntry(Of WikiEntry) With { Function(Entry) New SearchEntry(Of WikiEntry) With {
.Item = Entry, .Item = Entry,
.SearchSource = New List(Of SearchSource) From { .SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名 New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split("/"c, True), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.CurseForgeSlug, 0.5)} New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.CurseForgeSlug, 0.5)}
}).ToList }).ToList
Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25) Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25)
@@ -244,7 +248,7 @@
MaxBy(Function(s) s.Item.Popularity) '然后从中选择最受欢迎的那一个 MaxBy(Function(s) s.Item.Popularity) '然后从中选择最受欢迎的那一个
'后处理 '后处理
CurseForgeAltSearchText = ExtractWords(CurseForgeTarget, ResourcePlatforms.CurseForge).Join(" ") CurseForgeAltSearchText = ExtractWords(CurseForgeTarget, ResourcePlatforms.CurseForge).Join(" ")
Log("[Resource] 中文搜索关键词（CurseForge）：" & CurseForgeAltSearchText, NotifyLevel.DebugModeOnly) Logger.Warn($"中文搜索关键词（CurseForge）：{CurseForgeAltSearchText}")
End If End If
End If End If
'Modrinth 'Modrinth
@@ -255,7 +259,7 @@
Function(Entry) New SearchEntry(Of WikiEntry) With { Function(Entry) New SearchEntry(Of WikiEntry) With {
.Item = Entry, .Item = Entry,
.SearchSource = New List(Of SearchSource) From { .SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名 New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split("/"c, True), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.ModrinthSlug, 0.5)} New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.ModrinthSlug, 0.5)}
}).ToList }).ToList
Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25) Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25)
@@ -270,7 +274,7 @@
Next Next
Next Next
ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key
Log("[Resource] 中文搜索关键词（Modrinth）：" & ModrinthAltSearchText, NotifyLevel.DebugModeOnly) Logger.Warn($"中文搜索关键词（Modrinth）：{ModrinthAltSearchText}")
'直接请求工程 '直接请求工程
ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.ModrinthSlug).ToList ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.ModrinthSlug).ToList
End If End If
@@ -295,7 +299,7 @@ NextPage:
'在 1.14-，部分老 Mod 没有设置支持的加载器，因此添加 Forge 筛选就会出现遗漏 '在 1.14-，部分老 Mod 没有设置支持的加载器，因此添加 Forge 筛选就会出现遗漏
'所以，在发起请求时不筛选加载器，然后在返回的结果中自行筛除不是 Forge 的 Mod '所以，在发起请求时不筛选加载器，然后在返回的结果中自行筛除不是 Forge 的 Mod
Dim IgnoreModLoaderFilter = Request.ModLoader = ModLoaderTypes.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140 Dim IgnoreModLoaderFilter = Request.ModLoaders = ModLoaders.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140
Try Try
'CurseForge 搜索 'CurseForge 搜索
@@ -307,21 +311,22 @@ NextPage:
Try Try
'获取工程列表 '获取工程列表
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress(If(CurseForgeAltSearchText, RawSearchText), IgnoreModLoaderFilter) Dim CurseForgeUrl As String = Request.GetCurseForgeAddress(If(CurseForgeAltSearchText, RawSearchText), IgnoreModLoaderFilter)
Log("[Resource] 开始 CurseForge 搜索：" & CurseForgeUrl) Logger.Info($"开始 CurseForge 搜索：{CurseForgeUrl}")
Dim RequestResult As JObject = DlModRequest(CurseForgeUrl) Dim RequestResult As JObject = DlModRequest(CurseForgeUrl)
Dim ProjectList As New List(Of ResourceProject) Dim ProjectList As New List(Of ResourceProject)
For Each JsonEntry As JObject In RequestResult("data") For Each JsonEntry As JObject In RequestResult("data")
Dim Project As New ResourceProject(JsonEntry) Dim Project As New ResourceProject(JsonEntry)
If Request.Type = ResourceTypes.ResourcePack AndAlso Project.Tags.Contains("数据包") Then Continue For 'CurseForge 将一些数据包分类成了资源包 If Request.Type = ResourceTypes.ResourcePack AndAlso Project.Tags.Contains("数据包") Then Continue For 'CurseForge 将一些数据包分类成了资源包
If Request.Type <> ResourceTypes.Any AndAlso Not Project.Types.HasFlag(Request.Type) Then Continue For '过滤分区不匹配的搜索结果（#8265）
ProjectList.Add(Project) ProjectList.Add(Project)
Next Next
'更新结果 '更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p)) ProjectList.ForEach(Sub(p) RawResults.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)
Log($"[Resource] 从 CurseForge 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）") Logger.Info($"从 CurseForge 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.CurseForgeOffset} 个，共 {Storage.CurseForgeTotal} 个）")
Catch ex As Exception Catch ex As Exception
Log(ex, "CurseForge 搜索失败") Logger.Warn(ex, "CurseForge 搜索失败")
Storage.CurseForgeTotal = -1 Storage.CurseForgeTotal = -1
Errors.Add((ex, ResourcePlatforms.CurseForge)) Errors.Add((ex, ResourcePlatforms.CurseForge))
End Try End Try
@@ -337,7 +342,7 @@ NextPage:
Sub() Sub()
Try Try
Dim ModrinthUrl As String = Request.GetModrinthAddress(If(ModrinthAltSearchText, RawSearchText), IgnoreModLoaderFilter) Dim ModrinthUrl As String = Request.GetModrinthAddress(If(ModrinthAltSearchText, RawSearchText), IgnoreModLoaderFilter)
Log("[Resource] 开始 Modrinth 搜索：" & ModrinthUrl) Logger.Info($"开始 Modrinth 搜索：{ModrinthUrl}")
Dim RequestResult As JObject = DlModRequest(ModrinthUrl) Dim RequestResult As JObject = DlModRequest(ModrinthUrl)
Dim ProjectList As New List(Of ResourceProject) Dim ProjectList As New List(Of ResourceProject)
For Each JsonEntry As JObject In RequestResult("hits") For Each JsonEntry As JObject In RequestResult("hits")
@@ -347,9 +352,9 @@ NextPage:
ProjectList.ForEach(Sub(p) RawResults.Add(p)) ProjectList.ForEach(Sub(p) RawResults.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)
Log($"[Resource] 从 Modrinth 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）") Logger.Info($"从 Modrinth 搜索到了 {ProjectList.Count} 个工程（总计已获取 {Storage.ModrinthOffset} 个，共 {Storage.ModrinthTotal} 个）")
Catch ex As Exception Catch ex As Exception
Log(ex, "Modrinth 搜索失败") Logger.Warn(ex, "Modrinth 搜索失败")
Storage.ModrinthTotal = -1 Storage.ModrinthTotal = -1
Errors.Add((ex, ResourcePlatforms.Modrinth)) Errors.Add((ex, ResourcePlatforms.Modrinth))
End Try End Try
@@ -365,7 +370,7 @@ NextPage:
Sub() Sub()
Try Try
Dim ModrinthUrl As String = $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthSlugs.Join(""",""")}""]" Dim ModrinthUrl As String = $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthSlugs.Join(""",""")}""]"
Log("[Resource] 开始 Modrinth 直接获取：" & ModrinthUrl) Logger.Info($"开始 Modrinth 直接获取：{ModrinthUrl}")
Dim ProjectList As New List(Of ResourceProject) Dim ProjectList As New List(Of ResourceProject)
For Each JsonEntry As JObject In DlModRequest(ModrinthUrl) For Each JsonEntry As JObject In DlModRequest(ModrinthUrl)
Dim Project As New ResourceProject(JsonEntry) Dim Project As New ResourceProject(JsonEntry)
@@ -373,18 +378,18 @@ NextPage:
If Request.Type <> ResourceTypes.Any AndAlso Not Project.Types.HasFlag(Request.Type) Then Continue For If Request.Type <> ResourceTypes.Any AndAlso Not Project.Types.HasFlag(Request.Type) Then Continue For
If Not String.IsNullOrEmpty(Request.Tag) AndAlso If Not String.IsNullOrEmpty(Request.Tag) AndAlso
Not JsonEntry("categories").Any(Function(c) c.ToString = Request.Tag.AfterLast("/")) Then Continue For 'Project.Tags 已经转换成中文了，只能从 json 判 Not JsonEntry("categories").Any(Function(c) c.ToString = Request.Tag.AfterLast("/")) Then Continue For 'Project.Tags 已经转换成中文了，只能从 json 判
If Request.ModLoader <> ModLoaderTypes.Any AndAlso Not IgnoreModLoaderFilter AndAlso If Request.ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter AndAlso
Not Project.Loaders.Any(Function(m) m = Request.ModLoader) Then Continue For Not Project.ModLoaders.Flags.Intersect(Request.ModLoaders.Flags).Any() Then Continue For
If Not String.IsNullOrEmpty(Request.GameVersion) AndAlso If Not String.IsNullOrEmpty(Request.GameVersion) AndAlso
Not Project.UnsafeGameVersions.Any(Function(d) d = Request.GameVersion) Then Continue For Not Project.UnsafeGameVersions.Any(Function(d) d = Request.GameVersion) Then Continue For
ProjectList.Add(Project) ProjectList.Add(Project)
Next Next
'更新结果 '更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p)) ProjectList.ForEach(Sub(p) RawResults.Add(p))
Log($"[Resource] 从 Modrinth 直接获取到了 {ProjectList.Count} 个工程") Logger.Info($"从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取 ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
Catch ex As Exception Catch ex As Exception
Log(ex, "Modrinth 直接获取失败") Logger.Warn(ex, "Modrinth 直接获取失败")
Errors.Add((ex, ResourcePlatforms.Modrinth)) Errors.Add((ex, ResourcePlatforms.Modrinth))
End Try End Try
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够 If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够
@@ -397,9 +402,9 @@ NextPage:
If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程 If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程
Next Next
'筛除不是 Forge 的 Mod '仅保留兼容 Forge 的 Mod，或老版本中没有标注任何 Mod Loader 的 Mod
If IgnoreModLoaderFilter Then If IgnoreModLoaderFilter Then
RawResults = RawResults.Where(Function(p) Not p.Loaders.Any() OrElse p.Loaders.Contains(ModLoaderTypes.Forge)).ToList RawResults.KeepIf(Function(p) p.ModLoaders = ModLoaders.None OrElse p.ModLoaders.HasFlag(ModLoaders.Forge))
End If End If
'确保存在结果 '确保存在结果
@@ -446,19 +451,19 @@ NextPage:
Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList
'加入列表 '加入列表
RealResults.AddRange(RawResults) RealResults.AddRange(RawResults)
Log($"[Resource] 去重、筛选后累计新增结果 {RealResults.Count} 个（目前已有结果 {Storage.Results.Count} 个）") Logger.Info($"去重、筛选后累计新增结果 {RealResults.Count} 个（目前已有结果 {Storage.Results.Count} 个）")
#End Region #End Region
#Region "检查结果数量，如果不足且可继续，会继续加载下一页" #Region "检查结果数量，如果不足且可继续，会继续加载下一页"
If RealResults.Count + Storage.Results.Count < Request.TargetResultCount Then If RealResults.Count + Storage.Results.Count < Request.TargetResultCount Then
Log($"[Resource] 总结果数需求最少 {Request.TargetResultCount} 个，仅获得了 {RealResults.Count + Storage.Results.Count} 个") Logger.Info($"总结果数需求最少 {Request.TargetResultCount} 个，仅获得了 {RealResults.Count + Storage.Results.Count} 个")
If Request.CanContinue AndAlso Not Errors.Any Then '如果有某个源失败则不再重试，这时候重试可能导致无限循环 If Request.CanContinue AndAlso Not Errors.Any Then '如果有某个源失败则不再重试，这时候重试可能导致无限循环
Log("[Resource] 将继续尝试加载下一页") Logger.Info("将继续尝试加载下一页")
GoTo NextPage GoTo NextPage
Else Else
Log("[Resource] 无法继续加载，将强制结束") Logger.Info("无法继续加载，将强制结束")
End If End If
End If End If
@@ -493,7 +498,7 @@ NextPage:
Scores(Result) = If(Result.WikiId > 0, 0.2, 0) + Scores(Result) = If(Result.WikiId > 0, 0.2, 0) +
Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9 Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9
SearchEntries.Add(New SearchEntry(Of ResourceProject) With {.Item = Result, .SearchSource = New List(Of SearchSource) From { SearchEntries.Add(New SearchEntry(Of ResourceProject) With {.Item = Result, .SearchSource = New List(Of SearchSource) From {
New SearchSource(If(IsChineseSearch, Result.TranslatedName, Result.RawName).Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), New SearchSource(If(IsChineseSearch, Result.TranslatedName, Result.RawName).Split("/"c, True), 1),
New SearchSource(Result.Description, 0.05)}}) New SearchSource(Result.Description, 0.05)}})
Next Next
Dim SearchResult = Search(SearchEntries, RawSearchText, 10000, -1) Dim SearchResult = Search(SearchEntries, RawSearchText, 10000, -1)
Plain Craft Launcher 2/Modules/Resource/ResourceVersion.vb
+48 -26
View File
@@ -36,10 +36,9 @@ Public Class ResourceVersion
''' </summary> ''' </summary>
Public Version As String Public Version As String
''' <summary> ''' <summary>
''' 支持的 Mod 加载器列表。 ''' 所有支持的 Mod 加载器列表。可能为 <see cref="ModLoaders.None"/>。
''' 可能为空列表，不为 Nothing。
''' </summary> ''' </summary>
Public Loaders As List(Of ModLoaderTypes) Public ModLoaders As ModLoaders = ModLoaders.None
''' <summary> ''' <summary>
''' 支持的游戏版本列表。类型包括："26.1.5"，"26.1"，"26.1 预览版"，"1.18.5"，"1.18"，"1.18 预览版"，"21w15a"，"未知版本"。 ''' 支持的游戏版本列表。类型包括："26.1.5"，"26.1"，"26.1 预览版"，"1.18.5"，"1.18"，"1.18 预览版"，"21w15a"，"未知版本"。
''' </summary> ''' </summary>
@@ -158,11 +157,10 @@ Public Class ResourceVersion
.GameVersions = New List(Of String) From {"未知版本"} .GameVersions = New List(Of String) From {"未知版本"}
End If End If
'ModLoaders 'ModLoaders
.Loaders = New List(Of ModLoaderTypes) .ModLoaders = ModLoaders.None
If RawVersions.Contains("forge") Then .Loaders.Add(ModLoaderTypes.Forge) For Each Loader In EnumUtils.GetAllFlags(Of ModLoaders)()
If RawVersions.Contains("fabric") Then .Loaders.Add(ModLoaderTypes.Fabric) If RawVersions.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader
If RawVersions.Contains("quilt") Then .Loaders.Add(ModLoaderTypes.Quilt) Next
If RawVersions.Contains("neoforge") Then .Loaders.Add(ModLoaderTypes.NeoForge)
#End Region #End Region
Else Else
#Region "Modrinth" #Region "Modrinth"
@@ -183,14 +181,13 @@ Public Class ResourceVersion
'Loaders '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
.Loaders = New List(Of ModLoaderTypes) .ModLoaders = ModLoaders.None
If .ResourceType.HasFlag(ResourceTypes.Mod) OrElse .ResourceType.HasFlag(ResourceTypes.DataPack) Then 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.Intersect({"bukkit", "folia", "paper", "purpur", "spigot"}).Any() Then .ResourceType = ResourceTypes.Plugin 'Veinminer Enchantment 同时支持服务端与 Fabric
If RawLoaders.Contains("datapack") Then .ResourceType = ResourceTypes.DataPack If RawLoaders.Contains("datapack") Then .ResourceType = ResourceTypes.DataPack
If RawLoaders.Contains("forge") Then .Loaders.Add(ModLoaderTypes.Forge) : .ResourceType = ResourceTypes.Mod For Each Loader As ModLoaders In EnumUtils.GetAllFlags(Of ModLoaders)()
If RawLoaders.Contains("neoforge") Then .Loaders.Add(ModLoaderTypes.NeoForge) : .ResourceType = ResourceTypes.Mod If RawLoaders.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader : .ResourceType = ResourceTypes.Mod
If RawLoaders.Contains("fabric") Then .Loaders.Add(ModLoaderTypes.Fabric) : .ResourceType = ResourceTypes.Mod Next
If RawLoaders.Contains("quilt") Then .Loaders.Add(ModLoaderTypes.Quilt) : .ResourceType = ResourceTypes.Mod
Else Else
'使用传入的类别，不作修改（#8377） '使用传入的类别，不作修改（#8377）
End If End If
@@ -212,8 +209,8 @@ Public Class ResourceVersion
ElseIf .GameVersions.Count > 1 Then ElseIf .GameVersions.Count > 1 Then
.GameVersions = .GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList .GameVersions = .GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
If .ResourceType = ResourceTypes.ModPack Then .GameVersions = New List(Of String) From { .GameVersions(0)} '整合包理应只 “支持” 一个版本 If .ResourceType = ResourceTypes.ModPack Then .GameVersions = New List(Of String) From { .GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")) Then ElseIf RawVersions.Any(Function(v) v.RegexCheck("[0-9]{2}w[0-9]{2}[a-z]")) Then
.GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")).ToList .GameVersions = RawVersions.Where(Function(v) v.RegexCheck("[0-9]{2}w[0-9]{2}[a-z]")).ToList
Else Else
.GameVersions = New List(Of String) From {"未知版本"} .GameVersions = New List(Of String) From {"未知版本"}
End If End If
@@ -230,7 +227,7 @@ Public Class ResourceVersion
Dim TargetProject = ResourceProject.FromProjectId(ProjectId, Platform) Dim TargetProject = ResourceProject.FromProjectId(ProjectId, Platform)
'获取项目对象的文件列表 '获取项目对象的文件列表
If Not ProjectFilesCache.ContainsKey(ProjectId) Then If Not ProjectFilesCache.ContainsKey(ProjectId) Then
Log("[Resource] 开始获取项目版本列表：" & ProjectId) Logger.Info($"开始获取项目版本列表：{ProjectId}")
Dim ResultJsonArray As JArray = Nothing Dim ResultJsonArray As JArray = Nothing
If Platform = ResourcePlatforms.CurseForge Then If Platform = ResourcePlatforms.CurseForge Then
For RetryCount As Integer = 0 To 2 For RetryCount As Integer = 0 To 2
@@ -247,10 +244,10 @@ Public Class ResourceVersion
ResultJsonArray = ResultJson("data") ResultJsonArray = ResultJson("data")
Exit For Exit For
ElseIf RetryCount < 2 Then ElseIf RetryCount < 2 Then
Log($"[Resource] CurseForge 返回的资源版本列表存在缺失，即将进行第 {RetryCount + 1} 次重试", NotifyLevel.DebugModeOnly) '#6224 Logger.Warn($"CurseForge 返回的资源版本列表存在缺失，即将进行第 {RetryCount + 1} 次重试") '#6224
Log($"[Resource] 返回的原始内容如下：{vbCrLf}{ResultJson}") Logger.Info($"返回的原始内容如下：{vbCrLf}{ResultJson}")
Else Else
Log($"[Resource] CurseForge 返回的资源版本列表存在缺失，返回的原始内容如下：{vbCrLf}{ResultJson}") Logger.Info($"CurseForge 返回的资源版本列表存在缺失，返回的原始内容如下：{vbCrLf}{ResultJson}")
Throw New Exception("CurseForge 返回的资源版本列表存在缺失") Throw New Exception("CurseForge 返回的资源版本列表存在缺失")
End If End If
Next Next
@@ -266,7 +263,7 @@ Public Class ResourceVersion
'加载前置信息 '加载前置信息
Dim Dependencies As List(Of String) = Result.SelectMany(Function(f) f.RawDependencies).Distinct().ToList Dim Dependencies As List(Of String) = Result.SelectMany(Function(f) f.RawDependencies).Distinct().ToList
If Dependencies.Any Then If Dependencies.Any Then
Log($"[Resource] 项目 {ProjectId} 中需要加载的前置：{Dependencies.Join("，")}") Logger.Info($"项目 {ProjectId} 中需要加载的前置：{Dependencies.Join("，")}")
For Each DependencyProject In ResourceProject.FromProjectIds(Dependencies, TargetProject.Platform) For Each DependencyProject In ResourceProject.FromProjectIds(Dependencies, TargetProject.Platform)
For Each File In Result For Each File In Result
If File.RawDependencies.Contains(DependencyProject.Id) AndAlso DependencyProject.Id <> ProjectId AndAlso Not File.Dependencies.Contains(DependencyProject.Id) Then If File.RawDependencies.Contains(DependencyProject.Id) AndAlso DependencyProject.Id <> ProjectId AndAlso Not File.Dependencies.Contains(DependencyProject.Id) Then
@@ -290,16 +287,16 @@ Public Class ResourceVersion
Public Shared Function FromCacheJson(Data As JObject) As ResourceVersion Public Shared Function FromCacheJson(Data As JObject) As ResourceVersion
Dim Result As New ResourceVersion Dim Result As New ResourceVersion
With Result With Result
.ResourceType = CType(Data("ResourceType").ToObject(Of Integer), ResourceTypes) .ResourceType = Data("ResourceType").ToObject(Of ResourceTypes)
.Id = Data("Id").ToString .Id = Data("Id").ToString
.Display = Data("DisplayName").ToString .Display = Data("DisplayName").ToString
If Data.ContainsKey("Version") Then .Version = Data("Version").ToString If Data.ContainsKey("Version") Then .Version = Data("Version").ToString
.ReleaseDate = Data("ReleaseDate").ToObject(Of Date) .ReleaseDate = Data("ReleaseDate").ToObject(Of Date)
.DownloadCount = Data("DownloadCount").ToObject(Of Integer) .DownloadCount = Data("DownloadCount").ToObject(Of Integer)
.ReleaseType = CType(Data("ReleaseType").ToObject(Of Integer), ReleaseTypes) .ReleaseType = Data("ReleaseType").ToObject(Of ReleaseTypes)
If Data.ContainsKey("FileName") Then .FileName = Data("FileName").ToString If Data.ContainsKey("FileName") Then .FileName = Data("FileName").ToString
If Data.ContainsKey("DownloadUrls") Then .DownloadUrls = Data("DownloadUrls").ToObject(Of List(Of String)) If Data.ContainsKey("DownloadUrls") Then .DownloadUrls = Data("DownloadUrls").ToObject(Of List(Of String))
If Data.ContainsKey("ModLoaders") Then .Loaders = Data("ModLoaders").ToObject(Of List(Of ModLoaderTypes)) If Data.ContainsKey("ModLoaders") Then .ModLoaders = Data("ModLoaders").ToObject(Of ModLoaders)
If Data.ContainsKey("Size") Then .Size = Data("Size").ToObject(Of Integer) If Data.ContainsKey("Size") Then .Size = Data("Size").ToObject(Of Integer)
If Data.ContainsKey("Hash") Then .Hash = Data("Hash").ToString If Data.ContainsKey("Hash") Then .Hash = Data("Hash").ToString
If Data.ContainsKey("GameVersions") Then .GameVersions = Data("GameVersions").ToObject(Of List(Of String)) If Data.ContainsKey("GameVersions") Then .GameVersions = Data("GameVersions").ToObject(Of List(Of String))
@@ -320,7 +317,7 @@ Public Class ResourceVersion
.Add("DisplayName", Display) .Add("DisplayName", Display)
.Add("ReleaseDate", ReleaseDate) .Add("ReleaseDate", ReleaseDate)
.Add("DownloadCount", DownloadCount) .Add("DownloadCount", DownloadCount)
.Add("ModLoaders", New JArray(Loaders.Select(Function(m) CInt(m)))) .Add("ModLoaders", 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)
@@ -383,10 +380,35 @@ Public Class ResourceVersion
''' 获取下载信息。 ''' 获取下载信息。
''' </summary> ''' </summary>
''' <param name="LocalFileOrFolder">目标本地文件夹，或完整的文件路径。会自动判断类型。</param> ''' <param name="LocalFileOrFolder">目标本地文件夹，或完整的文件路径。会自动判断类型。</param>
Public Function ToNetFile(LocalFileOrFolder As String) As NetFile Public Function ToNetFile(LocalFileOrFolder As String,
Return New NetFile(DownloadUrls, LocalFileOrFolder & If(LocalFileOrFolder.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash, ActualSize:=Size), SimulateBrowserHeaders:=True) Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As NetFile
Return New NetFile(
ParseModrinthTrackArguments(DownloadUrls, TrackDownloadReason, TrackGameVersion, TrackLoader),
LocalFileOrFolder & If(LocalFileOrFolder.EndsWithF("\"), FileName, ""),
New FileChecker(Hash:=Hash, ActualSize:=Size),
SimulateBrowserHeaders:=True)
End Function End Function
''' <summary> ''' <summary>
''' 添加 Modrinth 追踪参数。
''' </summary>
Public Shared Iterator Function ParseModrinthTrackArguments(Urls As List(Of String), Optional TrackDownloadReason As DownloadReason? = Nothing, Optional TrackGameVersion As String = Nothing, Optional TrackLoader As ModLoaders = ModLoaders.None) As IEnumerable(Of String)
Dim Arguments As New Dictionary(Of String, String)
If TrackDownloadReason IsNot Nothing Then Arguments.Add("mr_download_reason", TrackDownloadReason.ToString.Lower)
If TrackGameVersion IsNot Nothing Then Arguments.Add("mr_game_version", TrackGameVersion)
If TrackLoader.Flags.Any Then Arguments.Add("mr_loader", TrackLoader.Flags.First.ToString.Lower)
Dim Argument = Arguments.Select(Function(a) $"{a.Key}={a.Value}").Join("&")
For Each Url In Urls
If Not Url.ContainsIgnoreCase("cdn.modrinth.com/") Then Yield Url
Yield $"{Url}{If(Url.Contains("?"), "&", "?")}{Argument}"
Next
End Function
Public Enum DownloadReason
Standalone
Dependency
ModPack
Update
End Enum
''' <summary>
''' 重新整理 CurseForge 的下载地址。 ''' 重新整理 CurseForge 的下载地址。
''' </summary> ''' </summary>
Public Shared Function ParseCurseForgeDownloadUrls(Url As String) As List(Of String) Public Shared Function ParseCurseForgeDownloadUrls(Url As String) As List(Of String)
Plain Craft Launcher 2/Modules/Resource/WikiEntry.vb
+14 -15
View File
@@ -42,33 +42,32 @@ Public Class WikiEntry
If Cache IsNot Nothing Then Return Cache If Cache IsNot Nothing Then Return Cache
'实际加载 '实际加载
Cache = New List(Of WikiEntry) Cache = New List(Of WikiEntry)
Dim Data As String
Using Archive As New ZipArchive(New MemoryStream(GetResources("ModData")), ZipArchiveMode.Read)
Data = ReadFile(Archive.GetEntry("moddata.txt").Open(), Encoding.UTF8)
End Using
Dim i As Integer = 0 Dim i As Integer = 0
For Each Line In Data.ReplaceLineEndings(vbLf).Split(vbLf) 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 i += 1
If Line = "" Then Continue For If Line = "" Then Continue For
For Each EntryData As String In Line.Split("¨") For Each EntryData As String In Line.Split("¨")
Dim Entry = New WikiEntry Dim Entry = New WikiEntry
Dim Splited = EntryData.Split("|") Dim Splited = EntryData.Split("|")
Entry.Popularity = Val(Splited(0)) If Splited(0).StartsWithF("@") Then
If Splited(1).StartsWithF("@") Then
Entry.CurseForgeSlug = Nothing Entry.CurseForgeSlug = Nothing
Entry.ModrinthSlug = Splited(1).Replace("@", "") Entry.ModrinthSlug = Splited(0).Replace("@", "")
ElseIf Splited(1).EndsWithF("@") Then ElseIf Splited(0).EndsWithF("@") Then
Entry.CurseForgeSlug = Splited(1).TrimEnd("@") Entry.CurseForgeSlug = Splited(0).TrimEnd("@")
Entry.ModrinthSlug = Entry.CurseForgeSlug Entry.ModrinthSlug = Entry.CurseForgeSlug
ElseIf Splited(1).Contains("@") Then ElseIf Splited(0).Contains("@") Then
Entry.CurseForgeSlug = Splited(1).Split("@")(0) Entry.CurseForgeSlug = Splited(0).Split("@")(0)
Entry.ModrinthSlug = Splited(1).Split("@")(1) Entry.ModrinthSlug = Splited(0).Split("@")(1)
Else Else
Entry.CurseForgeSlug = Splited(1) Entry.CurseForgeSlug = Splited(0)
Entry.ModrinthSlug = Nothing Entry.ModrinthSlug = Nothing
End If End If
Entry.Id = i Entry.Id = i
If Splited.Count >= 3 Then Entry.Popularity = Val(Ranks(i - 1))
If Splited.Count >= 2 Then
Entry.ChineseName = Splited.Last Entry.ChineseName = Splited.Last
If Entry.ChineseName.Contains("*") Then '处理 * If Entry.ChineseName.Contains("*") Then '处理 *
Entry.ChineseName = Entry.ChineseName.Replace("*", Entry.ChineseName = Entry.ChineseName.Replace("*",
Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+2 -2
View File
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.12.7.3")> <Assembly: AssemblyVersion("2.12.8.0")>
<Assembly: AssemblyFileVersion("2.12.7.3")> <Assembly: AssemblyFileVersion("2.12.8.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
Plain Craft Launcher 2/My Project/Resources.Designer.vb
Generated
+17 -14
View File
@@ -181,12 +181,25 @@ Namespace My.Resources
End Property End Property
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找类似
'''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> '''</summary>
Friend ReadOnly Property ModData() As Byte() Friend ReadOnly Property ModData() As String
Get Get
Dim obj As Object = ResourceManager.GetObject("ModData", resourceCulture) Return ResourceManager.GetString("ModData", resourceCulture)
Return CType(obj,Byte())
End Get End Get
End Property End Property
@@ -240,16 +253,6 @@ Namespace My.Resources
End Get End Get
End Property End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property System_ValueTuple() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("System.ValueTuple", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
Plain Craft Launcher 2/My Project/Resources.resx
+1 -4
View File
@@ -155,7 +155,7 @@
<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"> <data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\moddata.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\moddata.txt;System.String, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089;utf-8</value>
</data> </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>
@@ -172,9 +172,6 @@
<data name="System.Net.Http.Formatting" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="System.Net.Http.Formatting" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\System.Net.Http.Formatting.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\System.Net.Http.Formatting.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="System.ValueTuple" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\System.ValueTuple.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+176 -191
View File
@@ -29,7 +29,7 @@
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析原版支持库文件（副加载器）", LoadersLib.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)))
Thread.Sleep(50) '等待 JSON 文件实际写入硬盘（#3710） Thread.Sleep(50) '等待 JSON 文件实际写入硬盘（#3710）
Log("[Download] 开始分析原版支持库文件：" & VersionFolder) Logger.Info($"开始分析原版支持库文件：{VersionFolder}")
Task.Output = McLibNetFilesFromInstance(New McInstance(VersionFolder)) Task.Output = McLibNetFilesFromInstance(New McInstance(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False}) End Sub) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载原版支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False}) LoadersLib.Add(New LoaderDownload("下载原版支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False})
@@ -47,7 +47,7 @@
End Try End Try
'顺手添加 Json 项目 '顺手添加 Json 项目
Try Try
Dim InstanceJson As JObject = GetJson(ReadFile(VersionFolder & InstanceName & ".json")) Dim InstanceJson As JObject = GetJson(FileUtils.ReadAsString(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
@@ -158,8 +158,8 @@
Try Try
Dim Id = Version.Title Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder() Dim VersionFolder As String = Dialogs.SelectFolder("选择目标文件夹", False).FirstOrDefault
If Not VersionFolder.Contains("\") Then Return If VersionFolder Is Nothing Then Return
VersionFolder = VersionFolder & Id & "\" VersionFolder = VersionFolder & Id & "\"
'重复任务检查 '重复任务检查
@@ -180,8 +180,8 @@
'分析服务端 JAR 文件下载地址 '分析服务端 JAR 文件下载地址
Dim Instance As New McInstance(VersionFolder) Dim Instance As New McInstance(VersionFolder)
If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("server") Is Nothing OrElse Instance.JsonObject("downloads")("server")("url") Is Nothing Then If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("server") Is Nothing OrElse Instance.JsonObject("downloads")("server")("url") Is Nothing Then
File.Delete(VersionFolder & Id & ".json") FileUtils.Delete(VersionFolder & Id & ".json")
If Not New DirectoryInfo(VersionFolder).GetFileSystemInfos.Any() Then DeleteDirectory(VersionFolder) If Not DirectoryUtils.GetInfo(VersionFolder).GetFileSystemInfos.Any() Then DirectoryUtils.Delete(VersionFolder)
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) '等玩家把上一个提示看完
@@ -207,7 +207,7 @@ 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
File.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})
'下载服务端文件 '下载服务端文件
Loaders.Add(New LoaderDownload("下载服务端文件", New List(Of NetFile)) With {.ProgressWeight = 5}) Loaders.Add(New LoaderDownload("下载服务端文件", New List(Of NetFile)) With {.ProgressWeight = 5})
@@ -219,7 +219,7 @@ pause"
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception Catch ex As Exception
Log(ex, "开始 Minecraft 服务端下载失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "开始 Minecraft 服务端下载失败")
End Try End Try
End Sub End Sub
Public Sub McDownloadMenuSave(sender As Object, e As RoutedEventArgs) Public Sub McDownloadMenuSave(sender As Object, e As RoutedEventArgs)
@@ -234,8 +234,8 @@ pause"
Try Try
Dim Id = Version.Title Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder() Dim VersionFolder As String = Dialogs.SelectFolder("选择目标文件夹", False).FirstOrDefault
If Not VersionFolder.Contains("\") Then Return If VersionFolder Is Nothing Then Return
VersionFolder = VersionFolder & Id & "\" VersionFolder = VersionFolder & Id & "\"
'重复任务检查 '重复任务检查
@@ -264,7 +264,7 @@ pause"
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception Catch ex As Exception
Log(ex, "开始 Minecraft 下载失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "开始 Minecraft 下载失败")
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -323,7 +323,7 @@ pause"
ElseIf Id.StartsWithF("rd-") Then ElseIf Id.StartsWithF("rd-") Then
WikiName = "Java版Pre-classic_" & Id WikiName = "Java版Pre-classic_" & Id
Else Else
Log("[Error] 未知的版本格式：" & Id & "。", NotifyLevel.MsgBoxAndFeedback) Logger.Error($"未知的版本格式：{Id}。")
Return Return
End If End If
OpenWebsite("https://zh.minecraft.wiki/w/" & WikiName.Replace("_experimental-snapshot-", "-exp")) OpenWebsite("https://zh.minecraft.wiki/w/" & WikiName.Replace("_experimental-snapshot-", "-exp"))
@@ -336,8 +336,8 @@ pause"
Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry) Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry)
Try Try
Dim Id As String = DownloadInfo.InstanceName Dim Id As String = DownloadInfo.InstanceName
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName, "OptiFine Jar (*.jar)|*.jar") Dim Target As String = Dialogs.SaveFile("选择保存位置", DownloadInfo.FileName, filter:={("jar", "OptiFine Jar")})
If Not Target.Contains("\") Then Return If Target Is Nothing Then Return
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList() For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -353,7 +353,7 @@ pause"
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception Catch ex As Exception
Log(ex, "开始 OptiFine 下载失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "开始 OptiFine 下载失败")
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)
@@ -380,7 +380,7 @@ pause"
End SyncLock End SyncLock
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
Dim Arguments As String Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get("LaunchAdvanceDisableJLW") Then If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" -jar ""{ExtractPatch("JavaWrapper")}"" optifine.Installer" Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" -jar ""{ExtractPatch("JavaWrapper")}"" optifine.Installer"
Else Else
Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer" Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer"
@@ -395,14 +395,14 @@ pause"
.CreateNoWindow = True, .CreateNoWindow = True,
.RedirectStandardError = True, .RedirectStandardError = True,
.RedirectStandardOutput = True, .RedirectStandardOutput = True,
.WorkingDirectory = FileUtils.ShortenPath(BaseMcFolderHome) .WorkingDirectory = PathUtils.ToShortPath(BaseMcFolderHome)
} }
If Info.EnvironmentVariables.ContainsKey("appdata") Then If Info.EnvironmentVariables.ContainsKey("appdata") Then
Info.EnvironmentVariables("appdata") = BaseMcFolderHome Info.EnvironmentVariables("appdata") = BaseMcFolderHome
Else Else
Info.EnvironmentVariables.Add("appdata", BaseMcFolderHome) Info.EnvironmentVariables.Add("appdata", BaseMcFolderHome)
End If End If
Log("[Download] 开始安装 OptiFine：" & Target) Logger.Info($"开始安装 OptiFine：{Target}")
Dim TotalLength As Integer = 0 Dim TotalLength As Integer = 0
Dim process As New Process With {.StartInfo = Info} Dim process As New Process With {.StartInfo = Info}
Dim LastResult As String = "" Dim LastResult As String = ""
@@ -415,17 +415,17 @@ pause"
outputWaitHandle.[Set]() outputWaitHandle.[Set]()
Else Else
LastResult = e.Data LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult) Logger.Trace(LastResult)
TotalLength += 1 TotalLength += 1
Task.Progress += 0.9 / 7000 Task.Progress += 0.9 / 7000
End If End If
Catch ex As ObjectDisposedException Catch ex As ObjectDisposedException
Catch ex As Exception Catch ex As Exception
Log(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.Interrupted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消，已中止 OptiFine 安装") Logger.Info("由于任务取消，已中止 OptiFine 安装")
process.Kill() process.Kill()
End If End If
Catch Catch
@@ -439,17 +439,17 @@ pause"
errorWaitHandle.[Set]() errorWaitHandle.[Set]()
Else Else
LastResult = e.Data LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult) Logger.Trace(LastResult)
TotalLength += 1 TotalLength += 1
Task.Progress += 0.9 / 7000 Task.Progress += 0.9 / 7000
End If End If
Catch ex As ObjectDisposedException Catch ex As ObjectDisposedException
Catch ex As Exception Catch ex As Exception
Log(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.Interrupted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消，已中止 OptiFine 安装") Logger.Info("由于任务取消，已中止 OptiFine 安装")
process.Kill() process.Kill()
End If End If
Catch Catch
@@ -507,10 +507,10 @@ pause"
PageData = NetRequestByClientRetry("https://optifine.net/adloadx?f=" & DownloadInfo.FileName, PageData = NetRequestByClientRetry("https://optifine.net/adloadx?f=" & DownloadInfo.FileName,
Encoding:=New UTF8Encoding(False), Accept:="text/html", SimulateBrowserHeaders:=True) Encoding:=New UTF8Encoding(False), Accept:="text/html", SimulateBrowserHeaders:=True)
Task.Progress = 0.8 Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) Sources.Add("https://optifine.net/" & PageData.RegexSearch("downloadx\?f=[^""']+").First)
Log("[Download] OptiFine " & DownloadInfo.DisplayName & " 官方下载地址：" & Sources.Last) Logger.Info($"OptiFine {DownloadInfo.DisplayName} 官方下载地址：{Sources.Last}")
Catch ex As Exception Catch ex As Exception
Log(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(MinSize:=300 * 1024))}
@@ -522,43 +522,43 @@ pause"
Dim TargetLoaders As List(Of LoaderBase) = Dim TargetLoaders As List(Of LoaderBase) =
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 Log("[Download] OptiFine 安装正在等待原版文件下载完成") If TargetLoaders.Any Then Logger.Info("OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
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.IsInterrupted Then Return
'拷贝原版文件 '复制原版文件
If Not IsCustomFolder Then Return If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder) Dim ClientName As String = PathUtils.GetLastPart(ClientFolder)
DirectoryUtils.Create(McFolder & "versions\" & DownloadInfo.Inherit) DirectoryUtils.Create(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then If Not FileUtils.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json") FileUtils.Copy($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json")
End If End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then If Not FileUtils.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar") FileUtils.Copy($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar")
End If End If
End SyncLock End SyncLock
End Sub) With {.ProgressWeight = 0.1, .Show = False}) End Sub) With {.ProgressWeight = 0.1, .Show = False})
'安装（新旧方式均需要原版 Jar 和 Json） '安装（新旧方式均需要原版 Jar 和 Json）
If IsNewerVersion Then If IsNewerVersion Then
Log("[Download] 检测为新版 OptiFine：" & DownloadInfo.Inherit) Logger.Info($"检测为新版 OptiFine：{DownloadInfo.Inherit}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine（方式 A）", Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine（方式 A）",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim BaseMcFolderHome As String = RequestTaskTempFolder() Dim BaseMcFolderHome As String = RequestTaskTempFolder()
Dim BaseMcFolder As String = BaseMcFolderHome & ".minecraft\" Dim BaseMcFolder As String = BaseMcFolderHome & ".minecraft\"
Try Try
'准备安装环境 '准备安装环境
If Directory.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then If DirectoryUtils.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then
DeleteDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit) DirectoryUtils.Delete(BaseMcFolder & "versions\" & DownloadInfo.Inherit)
End If End If
DirectoryUtils.Create(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\") DirectoryUtils.Create(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\")
McFolderLauncherProfilesJsonCreate(BaseMcFolder) McFolderLauncherProfilesJsonCreate(BaseMcFolder)
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json", FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
Task.Progress = 0.06 Task.Progress = 0.06
'进行安装 '进行安装
@@ -568,7 +568,7 @@ Retry:
McDownloadOptiFineInstall(BaseMcFolderHome, Target, Task, UseJavaWrapper) McDownloadOptiFineInstall(BaseMcFolderHome, Target, Task, UseJavaWrapper)
Catch ex As Exception Catch ex As Exception
If UseJavaWrapper Then If UseJavaWrapper Then
Log(ex, "使用 JavaWrapper 安装 OptiFine 失败，将不使用 JavaWrapper 并重试") Logger.Warn(ex, "使用 JavaWrapper 安装 OptiFine 失败，将不使用 JavaWrapper 并重试")
UseJavaWrapper = False UseJavaWrapper = False
GoTo Retry GoTo Retry
Else Else
@@ -577,27 +577,23 @@ Retry:
End Try End Try
Task.Progress = 0.96 Task.Progress = 0.96
'复制文件 '复制文件
File.Delete(BaseMcFolder & "launcher_profiles.json") FileUtils.Delete(BaseMcFolder & "launcher_profiles.json")
CopyDirectory(BaseMcFolder, McFolder) DirectoryUtils.Copy(BaseMcFolder, McFolder)
Task.Progress = 0.98 Task.Progress = 0.98
'清理文件 '清理文件
File.Delete(Target) FileUtils.Delete(Target)
DeleteDirectory(BaseMcFolderHome) DirectoryUtils.Delete(BaseMcFolderHome)
Catch ex As Exception Catch ex As Exception
Throw New Exception("安装 OptiFine（方式 A）失败", ex) Throw New Exception("安装 OptiFine（方式 A）失败", ex)
End Try End Try
End Sub) With {.ProgressWeight = 8}) End Sub) With {.ProgressWeight = 8})
Else Else
Log("[Download] 检测为旧版 OptiFine：" & DownloadInfo.Inherit) Logger.Info($"检测为旧版 OptiFine：{DownloadInfo.Inherit}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine（方式 B）", Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine（方式 B）",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Try Try
'新建版本文件夹
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.1
'复制 Jar 文件 '复制 Jar 文件
If File.Exists(VersionFolder & Id & ".jar") Then File.Delete(VersionFolder & Id & ".jar") FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar")
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar")
Task.Progress = 0.7 Task.Progress = 0.7
'建立 Json 文件 '建立 Json 文件
Dim InheritInstance As New McInstance(McFolder & "versions\" & DownloadInfo.Inherit) Dim InheritInstance As New McInstance(McFolder & "versions\" & DownloadInfo.Inherit)
@@ -663,10 +659,10 @@ Retry:
PageData = NetRequestByClientRetry("https://optifine.net/adloadx?f=" & DownloadInfo.FileName, PageData = NetRequestByClientRetry("https://optifine.net/adloadx?f=" & DownloadInfo.FileName,
Encoding:=New UTF8Encoding(False), Accept:="text/html", SimulateBrowserHeaders:=True) Encoding:=New UTF8Encoding(False), Accept:="text/html", SimulateBrowserHeaders:=True)
Task.Progress = 0.8 Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) Sources.Add("https://optifine.net/" & PageData.RegexSearch("downloadx\?f=[^""']+").First)
Log("[Download] OptiFine " & DownloadInfo.DisplayName & " 官方下载地址：" & Sources.Last) Logger.Info($"OptiFine {DownloadInfo.DisplayName} 官方下载地址：{Sources.Last}")
Catch ex As Exception Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.DisplayName & " 官方下载地址失败") Logger.Warn(ex, $"获取 OptiFine {DownloadInfo.DisplayName} 官方下载地址失败")
End Try End Try
Task.Progress = 0.9 Task.Progress = 0.9
'构造文件请求 '构造文件请求
@@ -753,8 +749,8 @@ Retry:
Private Sub McDownloadLiteLoaderSave(DownloadInfo As DlLiteLoaderListEntry) Private Sub McDownloadLiteLoaderSave(DownloadInfo As DlLiteLoaderListEntry)
Try Try
Dim Id As String = DownloadInfo.Inherit Dim Id As String = DownloadInfo.Inherit
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), "LiteLoader 安装器 (*.jar)|*.jar") Dim Target As String = Dialogs.SaveFile("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), filter:={("jar", "LiteLoader 安装器")})
If Not Target.Contains("\") Then Return If Target Is Nothing Then Return
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList() For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -796,7 +792,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception Catch ex As Exception
Log(ex, "开始 LiteLoader 安装器下载失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "开始 LiteLoader 安装器下载失败")
End Try End Try
End Sub End Sub
@@ -920,10 +916,10 @@ Retry:
Public Sub McDownloadForgelikeSave(Info As DlForgelikeEntry) Public Sub McDownloadForgelikeSave(Info As DlForgelikeEntry)
Try Try
Dim Target As String = SelectSaveFile("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}", Dim Target As String = Dialogs.SaveFile("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
$"{Info.LoaderName} 安装器 (*.{Info.FileExtension})|*.{Info.FileExtension}") filter:={(Info.FileExtension, $"{Info.LoaderName} 安装器")})
If Target Is Nothing Then Return
Dim DisplayName As String = $"{Info.LoaderName} {Info.Inherit} - {Info.VersionName}" Dim DisplayName As String = $"{Info.LoaderName} {Info.Inherit} - {Info.VersionName}"
If Not Target.Contains("\") Then Return
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList() For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -962,7 +958,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception Catch ex As Exception
Log(ex, $"开始 {Info.LoaderName} 安装器下载失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"开始 {Info.LoaderName} 安装器下载失败")
End Try End Try
End Sub End Sub
@@ -990,7 +986,7 @@ Retry:
End SyncLock End SyncLock
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
Dim Arguments As String Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get("LaunchAdvanceDisableJLW") Then If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractPatch("JavaWrapper")}"" com.bangbang93.ForgeInstaller ""{McFolder}" Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractPatch("JavaWrapper")}"" com.bangbang93.ForgeInstaller ""{McFolder}"
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}"
@@ -1007,7 +1003,7 @@ Retry:
.RedirectStandardOutput = True .RedirectStandardOutput = True
} }
Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge") Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge")
Log($"[Download] 开始安装 {LoaderName}：" & Arguments) Logger.Info($"开始安装 {LoaderName}：{Arguments}")
Dim process As New Process With {.StartInfo = Info} Dim process As New Process With {.StartInfo = Info}
Dim LastResults As New Queue(Of String) Dim LastResults As New Queue(Of String)
Using outputWaitHandle As New AutoResetEvent(False) Using outputWaitHandle As New AutoResetEvent(False)
@@ -1024,11 +1020,11 @@ Retry:
End If End If
Catch ex As ObjectDisposedException Catch ex As ObjectDisposedException
Catch ex As Exception Catch ex As Exception
Log(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.Interrupted AndAlso Not process.HasExited Then
Log($"[Installer] 由于任务取消，已中止 {LoaderName} 安装") Logger.Info($"由于任务取消，已中止 {LoaderName} 安装")
process.Kill() process.Kill()
End If End If
Catch Catch
@@ -1047,11 +1043,11 @@ Retry:
End If End If
Catch ex As ObjectDisposedException Catch ex As ObjectDisposedException
Catch ex As Exception Catch ex As Exception
Log(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.Interrupted AndAlso Not process.HasExited Then
Log($"[Installer] 由于任务取消，已中止 {LoaderName} 安装") Logger.Info($"由于任务取消，已中止 {LoaderName} 安装")
process.Kill() process.Kill()
End If End If
Catch Catch
@@ -1071,7 +1067,7 @@ Retry:
process.Dispose() process.Dispose()
'检查是否安装成功：最后 5 行中是否有 true（true 可能在倒数数行，见 #832） '检查是否安装成功：最后 5 行中是否有 true（true 可能在倒数数行，见 #832）
If LastResults.Reverse().Take(5).Any(Function(l) l = "true") Then Return If LastResults.Reverse().Take(5).Any(Function(l) l = "true") Then Return
Log(LastResults.Join(vbCrLf)) Logger.Warn(LastResults.Join(vbCrLf))
Dim LastLines As String = "" Dim LastLines As String = ""
For i As Integer = Math.Max(0, LastResults.Count - 5) To LastResults.Count - 1 '最后 5 行 For i As Integer = Math.Max(0, LastResults.Count - 5) To LastResults.Count - 1 '最后 5 行
LastLines &= vbCrLf & LastResults(i) LastLines &= vbCrLf & LastResults(i)
@@ -1084,13 +1080,10 @@ 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"
Log("[Installer] " & Content)
Task.Progress = 0.07 Task.Progress = 0.07
Case "Downloading libraries" Case "Downloading libraries"
Log("[Installer] " & Content)
Task.Progress = 0.08 Task.Progress = 0.08
Case " File exists: Checksum validated." Case " File exists: Checksum validated."
If ModeDebug Then Log("[Installer] " & Content)
Task.Progress += 0.003 Task.Progress += 0.003
Case "Building Processors" Case "Building Processors"
Task.Progress = 0.18 Task.Progress = 0.18
@@ -1117,10 +1110,10 @@ Retry:
Case "Injecting profile" Case "Injecting profile"
Task.Progress = 0.91 Task.Progress = 0.91
Case Else Case Else
If ModeDebug Then Log("[Installer] " & Content) Logger.Trace(Content)
Return Return
End Select End Select
Log("[Installer] " & Content) Logger.Info(Content)
End Sub End Sub
''' <summary> ''' <summary>
@@ -1197,18 +1190,18 @@ Retry:
'安装（仅在新版安装时需要原版 Jar） '安装（仅在新版安装时需要原版 Jar）
If IsNeoForge OrElse LoaderVersion.BeforeFirst(".") >= 20 Then If IsNeoForge OrElse LoaderVersion.BeforeFirst(".") >= 20 Then
Log($"[Download] 检测为{If(IsNeoForge, " Neo", "新版 ")}Forge：" & LoaderVersion) Logger.Info($"检测为{If(IsNeoForge, " Neo", "新版 ")}Forge：{LoaderVersion}")
Dim Libs As List(Of McLibToken) = Nothing Dim Libs As List(Of McLibEntry) = Nothing
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = New List(Of NetFile) Task.Output = New List(Of NetFile)
Dim Installer As ZipArchive = Nothing Dim Installer As ZipArchive = Nothing
Try Try
'解压并获取、合并两个 Json 的信息 '解压并获取、合并两个 Json 的信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read)) Installer = FileUtils.OpenZip(InstallerAddress)
Task.Progress = 0.2 Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open)) Dim Json2 As JObject = GetJson(Installer.GetEntry("version.json").Open().ReadString)
Json.Merge(Json2) Json.Merge(Json2)
'获取 Lib 下载信息 '获取 Lib 下载信息
Libs = McLibListGetWithJson(Json, True) Libs = McLibListGetWithJson(Json, True)
@@ -1221,17 +1214,17 @@ Retry:
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))
Dim ClientMappings As JToken = RawJson("downloads")("client_mappings") Dim ClientMappings As JToken = RawJson("downloads")("client_mappings")
Libs.Add(New McLibToken With { Libs.Add(New McLibEntry With {
.IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.Url = ClientMappings("url"), .Size = ClientMappings("size"), .SHA1 = ClientMappings("sha1")}) .Url = ClientMappings("url"), .Size = ClientMappings("size"), .SHA1 = ClientMappings("sha1")})
Log($"[Download] 需要下载 Mappings：{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})") Logger.Info($"需要下载 Mappings：{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})")
End If End If
Task.Progress = 0.8 Task.Progress = 0.8
'去除其中的原始 Forgelike 项 '去除其中的原始 Forgelike 项
For i = 0 To Libs.Count - 1 For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}.jar") OrElse If Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}.jar") OrElse
Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}-client.jar") Then Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}-client.jar") Then
Log($"[Download] 已从待下载 {LoaderName} 支持库中移除：" & Libs(i).LocalPath, NotifyLevel.DebugModeOnly) Logger.Warn($"已从待下载 {LoaderName} 支持库中移除：{Libs(i).LocalPath}")
Libs.RemoveAt(i) Libs.RemoveAt(i)
Exit For Exit For
End If End If
@@ -1240,7 +1233,6 @@ Retry:
Catch ex As Exception Catch ex As Exception
Throw New Exception($"获取{If(IsNeoForge, " Neo", "新版 ")}Forge 支持库列表失败", ex) Throw New Exception($"获取{If(IsNeoForge, " Neo", "新版 ")}Forge 支持库列表失败", ex)
Finally Finally
'释放文件
If Installer IsNot Nothing Then Installer.Dispose() If Installer IsNot Nothing Then Installer.Dispose()
End Try End Try
End Sub) With {.ProgressWeight = 1}) End Sub) With {.ProgressWeight = 1})
@@ -1249,13 +1241,10 @@ Retry:
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
#Region "Forgelike 文件" #Region "Forgelike 文件"
If IsCustomFolder Then If IsCustomFolder Then
For Each LibFile As McLibToken In Libs For Each LibFile As McLibEntry In Libs
Dim RealPath As String = LibFile.LocalPath.Replace(McFolderSelected, McFolder) Dim RealPath As String = LibFile.LocalPath.Replace(McFolderSelected, McFolder)
If Not File.Exists(RealPath) Then If Not FileUtils.Exists(RealPath) Then FileUtils.Copy(LibFile.LocalPath, RealPath)
DirectoryUtils.Create(RealPath, isFilePath:=True) Logger.Trace($"复制的 {LoaderName} 支持库文件：{LibFile.LocalPath}")
CopyFile(LibFile.LocalPath, RealPath)
End If
If ModeDebug Then Log($"[Download] 复制的 {LoaderName} 支持库文件：" & LibFile.LocalPath)
Next Next
End If End If
#End Region #End Region
@@ -1264,22 +1253,22 @@ Retry:
Dim TargetLoaders As List(Of LoaderBase) = Dim TargetLoaders As List(Of LoaderBase) =
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 Log($"[Download] {LoaderName} 安装正在等待原版文件下载完成") If TargetLoaders.Any Then Logger.Info($"{LoaderName} 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
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.IsInterrupted Then Return
'拷贝原版文件 '复制原版文件
If Not IsCustomFolder Then Return If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder) Dim ClientName As String = PathUtils.GetLastPart(ClientFolder)
DirectoryUtils.Create(McFolder & "versions\" & Inherit) DirectoryUtils.Create(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then If Not FileUtils.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json") FileUtils.Copy(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
End If End If
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then If Not FileUtils.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
CopyFile(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") FileUtils.Copy(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
End If End If
End SyncLock End SyncLock
#End Region #End Region
@@ -1288,12 +1277,12 @@ Retry:
Sub(Task As LoaderTask(Of Boolean, Boolean)) Sub(Task As LoaderTask(Of Boolean, Boolean))
Dim Installer As ZipArchive = Nothing Dim Installer As ZipArchive = Nothing
Try Try
Log($"[Download] 开始进行 Forgelike 安装：" & InstallerAddress) Logger.Info($"开始进行 Forgelike 安装：{InstallerAddress}")
'记录当前文件夹列表（在新建目标文件夹之前） '记录当前文件夹列表（在新建目标文件夹之前）
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(i) i.FullName).ToList() Dim OldList = DirectoryUtils.GetDirectories(McFolder & "versions\", True).ToList()
'解压并获取信息 '解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read)) Installer = FileUtils.OpenZip(InstallerAddress)
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
'新建目标版本文件夹 '新建目标版本文件夹
DirectoryUtils.Create(VersionFolder) DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.04 Task.Progress = 0.04
@@ -1305,23 +1294,23 @@ Retry:
Retry: Retry:
Try Try
'释放 Forge 注入器 '释放 Forge 注入器
FileUtils.Write(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller")) ExtractResources(PathTemp & "Cache\forge_installer.jar", "ForgeInstaller")
Task.Progress = 0.06 Task.Progress = 0.06
'运行注入器 '运行注入器
ForgelikeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper, IsNeoForge) ForgelikeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper, IsNeoForge)
Task.Progress = 0.97 Task.Progress = 0.97
Catch ex As Exception Catch ex As Exception
If UseJavaWrapper Then If UseJavaWrapper Then
Log(ex, $"使用 JavaWrapper 安装 {LoaderName} 失败，将不使用 JavaWrapper 并重试") Logger.Warn(ex, $"使用 JavaWrapper 安装 {LoaderName} 失败，将不使用 JavaWrapper 并重试")
UseJavaWrapper = False UseJavaWrapper = False
GoTo Retry GoTo Retry
Else Else
Throw New Exception($"运行 {LoaderName} 安装器失败", ex) Throw New Exception($"运行 {LoaderName} 安装器失败", ex)
End If End If
End Try End Try
'拷贝新增的版本 Json '复制新增的版本 Json
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories. Dim DeltaList = DirectoryUtils.GetDirectories(McFolder & "versions\", True).
SkipWhile(Function(i) OldList.Contains(i.FullName)).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）
'也可能是因为 Forge 安装器的 Bug，生成了一个名字错误的文件夹，所以需要检查文件夹是否为空 '也可能是因为 Forge 安装器的 Bug，生成了一个名字错误的文件夹，所以需要检查文件夹是否为空
@@ -1329,62 +1318,61 @@ Retry:
End If End If
If DeltaList.Count = 1 Then If DeltaList.Count = 1 Then
'如果没有新增文件夹，那么预测的文件夹名就是正确的 '如果没有新增文件夹，那么预测的文件夹名就是正确的
'如果只新增 1 个文件夹，那么拷贝 json 文件 '如果只新增 1 个文件夹，那么复制 json 文件
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First() Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
FileUtils.Write(VersionFolder & NewInstanceName & ".json", ReadFile(JsonFile.FullName)) FileUtils.Copy(JsonFile.FullName, VersionFolder & NewInstanceName & ".json")
Log($"[Download] 已拷贝新增的版本 JSON 文件：{JsonFile.FullName} -> {VersionFolder}{NewInstanceName}.json") Logger.Info($"已复制新增的版本 JSON 文件：{JsonFile.FullName} -> {VersionFolder}{NewInstanceName}.json")
ElseIf DeltaList.Count > 1 Then ElseIf DeltaList.Count > 1 Then
'新增了多个文件夹 '新增了多个文件夹
Log($"[Download] 有多个疑似的新增版本，无法确定：{DeltaList.Select(Function(d) d.Name).Join(";")}") Logger.Info($"有多个疑似的新增版本，无法确定：{DeltaList.Select(Function(d) d.Name).Join(";")}")
Else Else
'没有新增文件夹 '没有新增文件夹
Log("[Download] 未找到新增的版本文件夹") Logger.Info("未找到新增的版本文件夹")
End If End If
Catch ex As Exception Catch ex As Exception
Throw New Exception($"安装新 {LoaderName} 版本失败", ex) Throw New Exception($"安装新 {LoaderName} 版本失败", ex)
Finally Finally
'清理文件 '清理文件
Try Try
If Installer IsNot Nothing Then Installer.Dispose() Installer?.Dispose()
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress) FileUtils.Delete(InstallerAddress)
Catch ex As Exception Catch ex As Exception
Log(ex, $"安装 {LoaderName} 清理文件时出错") Logger.Warn(ex, $"安装 {LoaderName} 清理文件时出错")
End Try End Try
End Try End Try
End Sub) With {.ProgressWeight = 10}) End Sub) With {.ProgressWeight = 10})
Else Else
Log("[Download] 检测为非新版 Forge：" & LoaderVersion) Logger.Info($"检测为非新版 Forge：{LoaderVersion}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"安装 {LoaderName}（方式 B）", Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"安装 {LoaderName}（方式 B）",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim Installer As ZipArchive = Nothing Dim Installer As ZipArchive = Nothing
Try Try
'解压并获取信息 '解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read)) Installer = FileUtils.OpenZip(InstallerAddress)
Task.Progress = 0.2 Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
Task.Progress = 0.4 Task.Progress = 0.4
'新建版本文件夹 '新建版本文件夹
DirectoryUtils.Create(VersionFolder) DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.5 Task.Progress = 0.5
If Json("install") Is Nothing Then If Json("install") Is Nothing Then
'中版：Legacy 方式 1 '中版：Legacy 方式 1
Log("[Download] 开始进行 Forge 安装，Legacy 方式 1：" & InstallerAddress) Logger.Info($"开始进行 Forge 安装，Legacy 方式 1：{InstallerAddress}")
'建立 Json 文件 '建立 Json 文件
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open)) Dim JsonVersion As JObject = GetJson(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open().ReadString)
JsonVersion("id") = NewInstanceName 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
'解压支持库文件 '解压支持库文件
Installer.Dispose() Installer.Dispose()
ExtractCompressedFile(InstallerAddress, InstallerAddress & "_unrar\") FileUtils.ExtractToDirectory(InstallerAddress, InstallerAddress & "_unrar\")
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\") If DirectoryUtils.Exists(InstallerAddress & "_unrar\maven\") Then DirectoryUtils.Copy(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DeleteDirectory(InstallerAddress & "_unrar\") DirectoryUtils.Delete(InstallerAddress & "_unrar\")
Else Else
'旧版：Legacy 方式 2 '旧版：Legacy 方式 2
Log("[Download] 开始进行 Forge 安装，Legacy 方式 2：" & InstallerAddress) Logger.Info($"开始进行 Forge 安装，Legacy 方式 2：{InstallerAddress}")
'解压 Jar 文件 '解压 Jar 文件
Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder) Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
If File.Exists(JarAddress) Then File.Delete(JarAddress)
FileUtils.Write(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open) FileUtils.Write(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
Task.Progress = 0.9 Task.Progress = 0.9
'建立 Json 文件 '建立 Json 文件
@@ -1398,10 +1386,10 @@ Retry:
Try Try
'清理文件 '清理文件
If Installer IsNot Nothing Then Installer.Dispose() If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress) FileUtils.Delete(InstallerAddress)
If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\") DirectoryUtils.Delete(InstallerAddress & "_unrar\")
Catch ex As Exception Catch ex As Exception
Log(ex, "非新版方式安装 Forge 清理文件时出错") Logger.Warn(ex, "非新版方式安装 Forge 清理文件时出错")
End Try End Try
End Try End Try
End Sub) With {.ProgressWeight = 1}) End Sub) With {.ProgressWeight = 1})
@@ -1422,7 +1410,7 @@ Retry:
If Entries.Any Then If Entries.Any Then
FreshVersion = Entries(0) FreshVersion = Entries(0)
Else Else
Log("[System] 未找到可用的 Forge 版本") Logger.Info("未找到可用的 Forge 版本")
End If End If
Dim RecommendedVersion As DlForgeVersionEntry = Nothing Dim RecommendedVersion As DlForgeVersionEntry = Nothing
For Each Entry In Entries For Each Entry In Entries
@@ -1522,7 +1510,7 @@ Retry:
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
Log("[Download] 刷新 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 = GetJson(Result)
@@ -1539,9 +1527,9 @@ Retry:
'保存 '保存
Dim CacheJson As String = "{" & RecommendedList.Join(",") & "}" Dim CacheJson As String = "{" & RecommendedList.Join(",") & "}"
FileUtils.Write(PathTemp & "Cache\ForgeRecommendedList.json", CacheJson) FileUtils.Write(PathTemp & "Cache\ForgeRecommendedList.json", CacheJson)
Log("[Download] 刷新 Forge 推荐版本缓存成功") Logger.Info("刷新 Forge 推荐版本缓存成功")
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新 Forge 推荐版本缓存失败") Logger.Warn(ex, "刷新 Forge 推荐版本缓存失败")
End Try End Try
End Sub, "ForgeRecommendedRefresh") End Sub, "ForgeRecommendedRefresh")
End Sub End Sub
@@ -1553,16 +1541,16 @@ Retry:
Public Function McDownloadForgeRecommendedGet(McVersion As String) As String Public Function McDownloadForgeRecommendedGet(McVersion As String) As String
Try Try
If McVersion Is Nothing Then Return Nothing If McVersion Is Nothing Then Return Nothing
Dim List As String = ReadFile(PathTemp & "Cache\ForgeRecommendedList.json") Dim List As String = FileUtils.TryReadAsString(PathTemp & "Cache\ForgeRecommendedList.json")
If List Is Nothing OrElse List = "" Then If String.IsNullOrEmpty(List) Then
Log("[Download] 没有 Forge 推荐版本缓存文件") Logger.Info("没有 Forge 推荐版本缓存文件")
Return Nothing Return Nothing
End If End If
Dim Json As JObject = GetJson(List) Dim Json As JObject = GetJson(List)
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
Log(ex, "获取 Forge 推荐版本失败（" & If(McVersion, "null") & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"获取 Forge 推荐版本失败（{If(McVersion, "null")}）")
Return Nothing Return Nothing
End Try End Try
End Function End Function
@@ -1587,7 +1575,7 @@ Retry:
End If End If
Next Next
Else Else
Log("[System] 未找到可用的 NeoForge 版本", NotifyLevel.DebugModeOnly) Logger.Warn("未找到可用的 NeoForge 版本")
End If End If
'显示各个版本 '显示各个版本
If FreshStableVersion IsNot Nothing Then If FreshStableVersion IsNot Nothing Then
@@ -1674,10 +1662,10 @@ Retry:
Public Sub McDownloadFabricLoaderSave(DownloadInfo As JObject) Public Sub McDownloadFabricLoaderSave(DownloadInfo As JObject)
Try Try
Dim Url As String = DownloadInfo("url").ToString Dim Url As String = DownloadInfo("url").ToString
Dim FileName As String = GetFileNameFromPath(Url) Dim FileName As String = PathUtils.GetLastPart(Url)
Dim Version As String = GetFileNameFromPath(DownloadInfo("version").ToString) Dim Version As String = PathUtils.GetLastPart(DownloadInfo("version").ToString)
Dim Target As String = SelectSaveFile("选择保存位置", FileName, "Fabric 安装器 (*.jar)|*.jar") Dim Target As String = Dialogs.SaveFile("选择保存位置", FileName, filter:={("jar", "Fabric 安装器")})
If Not Target.Contains("\") Then Return If Target Is Nothing Then Return
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList() For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -1701,7 +1689,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception Catch ex As Exception
Log(ex, "开始 Fabric 安装器下载失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "开始 Fabric 安装器下载失败")
End Try End Try
End Sub End Sub
@@ -1860,7 +1848,7 @@ Retry:
Case LoadState.Finished Case LoadState.Finished
Hint(Loader.Name & "成功！", HintType.Green) Hint(Loader.Name & "成功！", HintType.Green)
Case LoadState.Failed Case LoadState.Failed
Hint(Loader.Name & "失败：" & Loader.Error.GetBrief(), HintType.Red) Hint(Loader.Name & "失败：" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted Case LoadState.Interrupted
Hint(Loader.Name & "已取消！", HintType.Blue) Hint(Loader.Name & "已取消！", HintType.Blue)
End Select End Select
@@ -1875,7 +1863,7 @@ Retry:
Hint(Loader.Name & "成功！", HintType.Green) Hint(Loader.Name & "成功！", HintType.Green)
'TODO: 自动选择安装成功的版本 'TODO: 自动选择安装成功的版本
Case LoadState.Failed Case LoadState.Failed
MyMsgBox(Loader.Error.GetDetail, Loader.Name & "失败", IsWarn:=True) MyMsgBox(Loader.Error.GetDisplay(True), Loader.Name & "失败", IsWarn:=True)
Case LoadState.Interrupted Case LoadState.Interrupted
Hint(Loader.Name & "已取消！", HintType.Blue) Hint(Loader.Name & "已取消！", HintType.Blue)
Case LoadState.Loading Case LoadState.Loading
@@ -1889,15 +1877,15 @@ Retry:
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.Interrupted Then
'删除版本文件夹 '删除版本文件夹
If Directory.Exists(Loader.Input & "saves\") OrElse Directory.Exists(Loader.Input & "versions\") Then If DirectoryUtils.Exists(Loader.Input & "saves\") OrElse DirectoryUtils.Exists(Loader.Input & "versions\") Then
Log("[Download] 由于版本已被独立启动，不清理版本文件夹：" & Loader.Input, NotifyLevel.DevelopOnly) Logger.Warn($"由于版本已被独立启动，不清理版本文件夹：{Loader.Input}")
Else Else
Log("[Download] 由于下载失败或取消，清理版本文件夹：" & Loader.Input, NotifyLevel.DevelopOnly) Logger.Warn($"由于下载失败或取消，清理版本文件夹：{Loader.Input}")
DeleteDirectory(Loader.Input) DirectoryUtils.Delete(Loader.Input)
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "下载失败或取消后清理版本文件夹失败") Logger.Warn(ex, "下载失败或取消后清理版本文件夹失败")
End Try End Try
End Sub End Sub
@@ -1920,7 +1908,7 @@ Retry:
Catch ex As CancelledException Catch ex As CancelledException
Return False Return False
Catch ex As Exception Catch ex As Exception
Log(ex, "开始合并安装失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "开始合并安装失败")
Return False Return False
End Try End Try
End Function End Function
@@ -1934,7 +1922,7 @@ Retry:
'获取参数 '获取参数
Dim VersionFolder As String = McFolderSelected & "versions\" & Request.NewInstanceName & "\" Dim VersionFolder As String = McFolderSelected & "versions\" & Request.NewInstanceName & "\"
If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder) If DirectoryUtils.Exists(TempMcFolder) Then DirectoryUtils.Delete(TempMcFolder)
Dim OptiFineFolder As String = Nothing Dim OptiFineFolder As String = Nothing
If Request.OptiFineVersion IsNot Nothing Then If Request.OptiFineVersion IsNot Nothing Then
If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.AfterLast("_HD_U_") '#735 If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.AfterLast("_HD_U_") '#735
@@ -1964,7 +1952,7 @@ Retry:
Dim ModsTempFolder As String = TempMcFolder & "mods\" Dim ModsTempFolder As String = TempMcFolder & "mods\"
Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso Modable '选择了 OptiFine 与任意 Mod 加载器 Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso Modable '选择了 OptiFine 与任意 Mod 加载器
If OptiFineAsMod Then If OptiFineAsMod Then
Log("[Download] OptiFine 将作为 Mod 进行下载") Logger.Info("OptiFine 将作为 Mod 进行下载")
If Request.LiteLoaderEntry IsNot Nothing Then If Request.LiteLoaderEntry IsNot Nothing Then
OptiFineFolder = ModsTempFolder & Request.MinecraftName & "\" '#8147 OptiFineFolder = ModsTempFolder & Request.MinecraftName & "\" '#8147
Else Else
@@ -1973,15 +1961,15 @@ Retry:
End If End If
'记录日志 '记录日志
If OptiFineFolder IsNot Nothing Then Log("[Download] OptiFine 缓存：" & OptiFineFolder) If OptiFineFolder IsNot Nothing Then Logger.Info($"OptiFine 缓存：{OptiFineFolder}")
If ForgeFolder IsNot Nothing Then Log("[Download] Forge 缓存：" & ForgeFolder) If ForgeFolder IsNot Nothing Then Logger.Info($"Forge 缓存：{ForgeFolder}")
If NeoForgeFolder IsNot Nothing Then Log("[Download] NeoForge 缓存：" & NeoForgeFolder) If NeoForgeFolder IsNot Nothing Then Logger.Info($"NeoForge 缓存：{NeoForgeFolder}")
If FabricFolder IsNot Nothing Then Log("[Download] Fabric 缓存：" & FabricFolder) If FabricFolder IsNot Nothing Then Logger.Info($"Fabric 缓存：{FabricFolder}")
If LiteLoaderFolder IsNot Nothing Then Log("[Download] LiteLoader 缓存：" & LiteLoaderFolder) If LiteLoaderFolder IsNot Nothing Then Logger.Info($"LiteLoader 缓存：{LiteLoaderFolder}")
Log("[Download] 对应的原版版本：" & Request.MinecraftName) Logger.Info($"对应的原版版本：{Request.MinecraftName}")
'重复版本检查 '重复版本检查
If File.Exists($"{VersionFolder}{Request.NewInstanceName}.json") Then If FileUtils.Exists($"{VersionFolder}{Request.NewInstanceName}.json") Then
Hint("版本 " & Request.NewInstanceName & " 已经存在！", HintType.Red) Hint("版本 " & Request.NewInstanceName & " 已经存在！", HintType.Red)
Throw New CancelledException Throw New CancelledException
End If End If
@@ -1991,11 +1979,11 @@ Retry:
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() FileUtils.Write(VersionFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False}) LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() FileUtils.Write(VersionFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
'Fabric API 'Fabric API
If Request.FabricApi IsNot Nothing Then If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False}) LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsTempFolder, ResourceVersion.DownloadReason.Dependency, Request.MinecraftName, ModLoaders.Fabric)}) With {.ProgressWeight = 3, .Block = False})
End If End If
'OptiFabric 'OptiFabric
If Request.OptiFabric IsNot Nothing Then If Request.OptiFabric IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False}) LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsTempFolder, ResourceVersion.DownloadReason.Dependency, Request.MinecraftName, ModLoaders.Fabric)}) With {.ProgressWeight = 3, .Block = False})
End If End If
'原版 '原版
Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.NewInstanceName)) With {.Show = False, .ProgressWeight = 39, Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.NewInstanceName)) With {.Show = False, .ProgressWeight = 39,
@@ -2038,19 +2026,19 @@ Retry:
MergeJson(VersionFolder, VersionFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder) MergeJson(VersionFolder, VersionFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.2 Task.Progress = 0.2
'迁移文件 '迁移文件
If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", McFolderSelected & "libraries") DirectoryUtils.Copy(TempMcFolder & "libraries", McFolderSelected & "libraries")
Task.Progress = 0.8 Task.Progress = 0.8
'创建 Mod 和资源包文件夹 '创建 Mod 和资源包文件夹
Dim ModsFolder = New McInstance(VersionFolder).PathIndie & "mods\" '版本隔离信息在此时被决定 Dim ModsFolder = New McInstance(VersionFolder).PathIndie & "mods\" '版本隔离信息在此时被决定
If Directory.Exists(ModsTempFolder) Then If DirectoryUtils.Exists(ModsTempFolder) Then
CopyDirectory(ModsTempFolder, ModsFolder) DirectoryUtils.Copy(ModsTempFolder, ModsFolder)
ElseIf Modable Then ElseIf Modable Then
DirectoryUtils.Create(ModsFolder) DirectoryUtils.Create(ModsFolder)
Log("[Download] 自动创建 Mod 文件夹：" & ModsFolder) Logger.Info($"自动创建 Mod 文件夹：{ModsFolder}")
End If End If
Dim ResourcepacksFolder = New McInstance(VersionFolder).PathIndie & "resourcepacks\" Dim ResourcepacksFolder = New McInstance(VersionFolder).PathIndie & "resourcepacks\"
DirectoryUtils.Create(ResourcepacksFolder) DirectoryUtils.Create(ResourcepacksFolder)
Log("[Download] 自动创建资源包文件夹：" & ResourcepacksFolder) Logger.Info($"自动创建资源包文件夹：{ResourcepacksFolder}")
End Sub) With {.ProgressWeight = 2, .Block = True}) End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件 '补全文件
If Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then If Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then
@@ -2060,7 +2048,7 @@ Retry:
LoaderList.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) LoaderList.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
End If End If
'删除忽略标识 '删除忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() File.Delete(VersionFolder & ".pclignore")) With {.Show = False}) LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() FileUtils.Delete(VersionFolder & ".pclignore")) With {.Show = False})
'总加载器 '总加载器
Return LoaderList Return LoaderList
End Function End Function
@@ -2069,7 +2057,7 @@ Retry:
''' 将多个版本 JSON 进行合并，如果目标已存在则直接覆盖。失败会抛出异常。 ''' 将多个版本 JSON 进行合并，如果目标已存在则直接覆盖。失败会抛出异常。
''' </summary> ''' </summary>
Private Sub MergeJson(OutputFolder As String, MinecraftFolder As String, Optional OptiFineFolder As String = Nothing, Optional OptiFineAsMod As Boolean = False, Optional ForgeFolder As String = Nothing, Optional ForgeVersion As String = Nothing, Optional NeoForgeFolder As String = Nothing, Optional NeoForgeVersion As String = Nothing, Optional FabricFolder As String = Nothing, Optional LiteLoaderFolder As String = Nothing) Private Sub MergeJson(OutputFolder As String, MinecraftFolder As String, Optional OptiFineFolder As String = Nothing, Optional OptiFineAsMod As Boolean = False, Optional ForgeFolder As String = Nothing, Optional ForgeVersion As String = Nothing, Optional NeoForgeFolder As String = Nothing, Optional NeoForgeVersion As String = Nothing, Optional FabricFolder As String = Nothing, Optional LiteLoaderFolder As String = Nothing)
Log("[Download] 开始进行版本合并，输出：" & OutputFolder & "，Minecraft：" & MinecraftFolder & Logger.Info($"开始进行版本合并，输出：{OutputFolder}，Minecraft：{MinecraftFolder}" &
If(OptiFineFolder IsNot Nothing, "，OptiFine：" & OptiFineFolder, "") & If(OptiFineFolder IsNot Nothing, "，OptiFine：" & OptiFineFolder, "") &
If(ForgeFolder IsNot Nothing, "，Forge：" & ForgeFolder, "") & If(ForgeFolder IsNot Nothing, "，Forge：" & ForgeFolder, "") &
If(NeoForgeFolder IsNot Nothing, "，NeoForge：" & NeoForgeFolder, "") & If(NeoForgeFolder IsNot Nothing, "，NeoForge：" & NeoForgeFolder, "") &
@@ -2083,78 +2071,78 @@ Retry:
Dim OutputJar As String, MinecraftJar As String Dim OutputJar As String, MinecraftJar As String
#Region "初始化路径信息" #Region "初始化路径信息"
If Not OutputFolder.EndsWithF("\") Then OutputFolder += "\" If Not OutputFolder.EndsWithF("\") Then OutputFolder += "\"
OutputName = GetFolderNameFromPath(OutputFolder) OutputName = PathUtils.GetLastPart(OutputFolder)
OutputJsonPath = OutputFolder & OutputName & ".json" OutputJsonPath = OutputFolder & OutputName & ".json"
OutputJar = OutputFolder & OutputName & ".jar" OutputJar = OutputFolder & OutputName & ".jar"
If Not MinecraftFolder.EndsWithF("\") Then MinecraftFolder += "\" If Not MinecraftFolder.EndsWithF("\") Then MinecraftFolder += "\"
MinecraftName = GetFolderNameFromPath(MinecraftFolder) MinecraftName = PathUtils.GetLastPart(MinecraftFolder)
MinecraftJsonPath = MinecraftFolder & MinecraftName & ".json" MinecraftJsonPath = MinecraftFolder & MinecraftName & ".json"
MinecraftJar = MinecraftFolder & MinecraftName & ".jar" MinecraftJar = MinecraftFolder & MinecraftName & ".jar"
If HasOptiFine Then If HasOptiFine Then
If Not OptiFineFolder.EndsWithF("\") Then OptiFineFolder += "\" If Not OptiFineFolder.EndsWithF("\") Then OptiFineFolder += "\"
OptiFineName = GetFolderNameFromPath(OptiFineFolder) OptiFineName = PathUtils.GetLastPart(OptiFineFolder)
OptiFineJsonPath = OptiFineFolder & OptiFineName & ".json" OptiFineJsonPath = OptiFineFolder & OptiFineName & ".json"
End If End If
If HasForge Then If HasForge Then
If Not ForgeFolder.EndsWithF("\") Then ForgeFolder += "\" If Not ForgeFolder.EndsWithF("\") Then ForgeFolder += "\"
ForgeName = GetFolderNameFromPath(ForgeFolder) ForgeName = PathUtils.GetLastPart(ForgeFolder)
ForgeJsonPath = ForgeFolder & ForgeName & ".json" ForgeJsonPath = ForgeFolder & ForgeName & ".json"
End If End If
If HasNeoForge Then If HasNeoForge Then
If Not NeoForgeFolder.EndsWithF("\") Then NeoForgeFolder += "\" If Not NeoForgeFolder.EndsWithF("\") Then NeoForgeFolder += "\"
NeoForgeName = GetFolderNameFromPath(NeoForgeFolder) NeoForgeName = PathUtils.GetLastPart(NeoForgeFolder)
NeoForgeJsonPath = NeoForgeFolder & NeoForgeName & ".json" NeoForgeJsonPath = NeoForgeFolder & NeoForgeName & ".json"
End If End If
If HasLiteLoader Then If HasLiteLoader Then
If Not LiteLoaderFolder.EndsWithF("\") Then LiteLoaderFolder += "\" If Not LiteLoaderFolder.EndsWithF("\") Then LiteLoaderFolder += "\"
LiteLoaderName = GetFolderNameFromPath(LiteLoaderFolder) LiteLoaderName = PathUtils.GetLastPart(LiteLoaderFolder)
LiteLoaderJsonPath = LiteLoaderFolder & LiteLoaderName & ".json" LiteLoaderJsonPath = LiteLoaderFolder & LiteLoaderName & ".json"
End If End If
If HasFabric Then If HasFabric Then
If Not FabricFolder.EndsWithF("\") Then FabricFolder += "\" If Not FabricFolder.EndsWithF("\") Then FabricFolder += "\"
FabricName = GetFolderNameFromPath(FabricFolder) FabricName = PathUtils.GetLastPart(FabricFolder)
FabricJsonPath = FabricFolder & FabricName & ".json" FabricJsonPath = FabricFolder & FabricName & ".json"
End If End If
#End Region #End Region
Dim OutputJson As JObject, MinecraftJson As JObject, OptiFineJson As JObject = Nothing, ForgeJson As JObject = Nothing, NeoForgeJson As JObject = Nothing, LiteLoaderJson As JObject = Nothing, FabricJson As JObject = Nothing Dim OutputJson As JObject, MinecraftJson As JObject, OptiFineJson As JObject = Nothing, ForgeJson As JObject = Nothing, NeoForgeJson As JObject = Nothing, LiteLoaderJson As JObject = Nothing, FabricJson As JObject = Nothing
#Region "读取文件并检查文件是否合规" #Region "读取文件并检查文件是否合规"
Dim MinecraftJsonText As String = ReadFile(MinecraftJsonPath) Dim MinecraftJsonText As String = If(FileUtils.TryReadAsString(MinecraftJsonPath), "")
If Not MinecraftJsonText.StartsWithF("{") Then Throw New Exception("Minecraft json 有误，地址：" & MinecraftJsonPath & "，前段内容：" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000))) If Not MinecraftJsonText.StartsWithF("{") Then Throw New Exception("Minecraft json 有误，地址：" & MinecraftJsonPath & "，前段内容：" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000)))
MinecraftJson = GetJson(MinecraftJsonText) MinecraftJson = GetJson(MinecraftJsonText)
If HasOptiFine Then If HasOptiFine Then
Dim OptiFineJsonText As String = ReadFile(OptiFineJsonPath) Dim OptiFineJsonText As String = If(FileUtils.TryReadAsString(OptiFineJsonPath), "")
If Not OptiFineJsonText.StartsWithF("{") Then Throw New Exception("OptiFine json 有误，地址：" & OptiFineJsonPath & "，前段内容：" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000))) If Not OptiFineJsonText.StartsWithF("{") Then Throw New Exception("OptiFine json 有误，地址：" & OptiFineJsonPath & "，前段内容：" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000)))
OptiFineJson = GetJson(OptiFineJsonText) OptiFineJson = GetJson(OptiFineJsonText)
End If End If
If HasForge Then If HasForge Then
Dim ForgeJsonText As String = ReadFile(ForgeJsonPath) Dim ForgeJsonText As String = If(FileUtils.TryReadAsString(ForgeJsonPath), "")
If Not ForgeJsonText.StartsWithF("{") Then Throw New Exception("Forge json 有误，地址：" & ForgeJsonPath & "，前段内容：" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000))) If Not ForgeJsonText.StartsWithF("{") Then Throw New Exception("Forge json 有误，地址：" & ForgeJsonPath & "，前段内容：" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000)))
ForgeJson = GetJson(ForgeJsonText) ForgeJson = GetJson(ForgeJsonText)
End If End If
If HasNeoForge Then If HasNeoForge Then
Dim NeoForgeJsonText As String = ReadFile(NeoForgeJsonPath) Dim NeoForgeJsonText As String = If(FileUtils.TryReadAsString(NeoForgeJsonPath), "")
If Not NeoForgeJsonText.StartsWithF("{") Then Throw New Exception("NeoForge json 有误，地址：" & NeoForgeJsonPath & "，前段内容：" & NeoForgeJsonText.Substring(0, Math.Min(NeoForgeJsonText.Length, 1000))) If Not NeoForgeJsonText.StartsWithF("{") Then Throw New Exception("NeoForge json 有误，地址：" & NeoForgeJsonPath & "，前段内容：" & NeoForgeJsonText.Substring(0, Math.Min(NeoForgeJsonText.Length, 1000)))
NeoForgeJson = GetJson(NeoForgeJsonText) NeoForgeJson = GetJson(NeoForgeJsonText)
End If End If
If HasLiteLoader Then If HasLiteLoader Then
Dim LiteLoaderJsonText As String = ReadFile(LiteLoaderJsonPath) Dim LiteLoaderJsonText As String = If(FileUtils.TryReadAsString(LiteLoaderJsonPath), "")
If Not LiteLoaderJsonText.StartsWithF("{") Then Throw New Exception("LiteLoader json 有误，地址：" & LiteLoaderJsonPath & "，前段内容：" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000))) If Not LiteLoaderJsonText.StartsWithF("{") Then Throw New Exception("LiteLoader json 有误，地址：" & LiteLoaderJsonPath & "，前段内容：" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000)))
LiteLoaderJson = GetJson(LiteLoaderJsonText) LiteLoaderJson = GetJson(LiteLoaderJsonText)
End If End If
If HasFabric Then If HasFabric Then
Dim FabricJsonText As String = ReadFile(FabricJsonPath) Dim FabricJsonText As String = If(FileUtils.TryReadAsString(FabricJsonPath), "")
If Not FabricJsonText.StartsWithF("{") Then Throw New Exception("Fabric json 有误，地址：" & FabricJsonPath & "，前段内容：" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000))) If Not FabricJsonText.StartsWithF("{") Then Throw New Exception("Fabric json 有误，地址：" & FabricJsonPath & "，前段内容：" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000)))
FabricJson = GetJson(FabricJsonText) FabricJson = GetJson(FabricJsonText)
End If End If
@@ -2169,7 +2157,7 @@ Retry:
If(NeoForgeJson IsNot Nothing, If(NeoForgeJson("minecraftArguments"), " ").ToString, " ") & " " & If(NeoForgeJson IsNot Nothing, If(NeoForgeJson("minecraftArguments"), " ").ToString, " ") & " " &
If(LiteLoaderJson IsNot Nothing, If(LiteLoaderJson("minecraftArguments"), " ").ToString, " ") If(LiteLoaderJson IsNot Nothing, If(LiteLoaderJson("minecraftArguments"), " ").ToString, " ")
'分割参数字符串 '分割参数字符串
Dim RawArguments As List(Of String) = AllArguments.Split(" ").Where(Function(l) l <> "").Select(Function(l) l.Trim).ToList Dim RawArguments As List(Of String) = AllArguments.Split(" ", True).Select(Function(l) l.Trim).ToList
Dim SplitArguments As New List(Of String) Dim SplitArguments As New List(Of String)
For i = 0 To RawArguments.Count - 1 For i = 0 To RawArguments.Count - 1
If RawArguments(i).StartsWithF("-") Then If RawArguments(i).StartsWithF("-") Then
@@ -2224,11 +2212,8 @@ Retry:
#Region "保存" #Region "保存"
FileUtils.Write(OutputJsonPath, OutputJson.ToString) FileUtils.Write(OutputJsonPath, OutputJson.ToString)
If MinecraftJar <> OutputJar Then '可能是同一个文件 FileUtils.Copy(MinecraftJar, OutputJar)
If File.Exists(OutputJar) Then File.Delete(OutputJar) Logger.Info($"版本合并 {OutputName} 完成")
CopyFile(MinecraftJar, OutputJar)
End If
Log("[Download] 版本合并 " & OutputName & " 完成")
#End Region #End Region
End Sub End Sub
@@ -2250,23 +2235,23 @@ Retry:
''' <param name="Patch">"LUA" 或 "JavaWrapper"。</param> ''' <param name="Patch">"LUA" 或 "JavaWrapper"。</param>
Public Function ExtractPatch(Patch As String) As String Public Function ExtractPatch(Patch As String) As String
Dim PatchPath As String = $"{PathPure}{Patch}.jar" Dim PatchPath As String = $"{PathPure}{Patch}.jar"
Log($"[Java] 选定的 {Patch} 路径：{PatchPath}") Logger.Info($"选定的 {Patch} 路径：{PatchPath}")
Static Lock As New Object Static Lock As New Object
SyncLock Lock '避免 OptiFine 和 Forge 安装时同时释放导致冲突 SyncLock Lock '避免 OptiFine 和 Forge 安装时同时释放导致冲突
Try Try
FileUtils.Write(PatchPath, GetResources(Patch)) ExtractResources(PatchPath, Patch)
Catch ex As Exception Catch ex As Exception
If File.Exists(PatchPath) Then If FileUtils.Exists(PatchPath) Then
'因为未知原因可能变为只读文件（#4243） '因为未知原因可能变为只读文件（#4243）
Log(ex, $"{Patch} 文件释放失败，但文件已存在，将在删除后尝试重新生成", NotifyLevel.DevelopOnly) Logger.Warn(ex, $"{Patch} 文件释放失败，但文件已存在，将在删除后尝试重新生成")
Try Try
File.Delete(PatchPath) FileUtils.Delete(PatchPath)
FileUtils.Write(PatchPath, GetResources(Patch)) ExtractResources(PatchPath, Patch)
Catch ex2 As Exception Catch ex2 As Exception
Log(ex2, $"{Patch} 文件重新释放失败，将尝试更换文件名重新生成", NotifyLevel.DevelopOnly) Logger.Warn(ex2, $"{Patch} 文件重新释放失败，将尝试更换文件名重新生成")
PatchPath = $"{PathPure}{Patch}2.jar" PatchPath = $"{PathPure}{Patch}2.jar"
Try Try
FileUtils.Write(PatchPath, GetResources(Patch)) ExtractResources(PatchPath, Patch)
Catch ex3 As Exception Catch ex3 As Exception
Throw New FileNotFoundException($"释放 {Patch} 最终尝试失败", ex3) Throw New FileNotFoundException($"释放 {Patch} 最终尝试失败", ex3)
End Try End Try
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
+17 -17
View File
@@ -525,7 +525,7 @@
Next Next
'自动选择版本 '自动选择版本
If VersionWaitingSelect Is Nothing Then Exit Try If VersionWaitingSelect Is Nothing Then Exit Try
Log("[Download] 自动选择 MC 版本：" & VersionWaitingSelect) Logger.Info($"自动选择 MC 版本：{VersionWaitingSelect}")
For Each Version As JObject In Versions For Each Version As JObject In Versions
If Version("id").ToString <> VersionWaitingSelect Then Continue For If Version("id").ToString <> VersionWaitingSelect Then Continue For
Dim Item = McDownloadListItem(Version, Sub() Dim Item = McDownloadListItem(Version, Sub()
@@ -535,7 +535,7 @@
Return Return
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化安装版本列表出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "可视化安装版本列表出错")
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -627,7 +627,7 @@
PanOptiFine.Children.Add(OptiFineDownloadListItem(Version, AddressOf OptiFine_Selected, False)) PanOptiFine.Children.Add(OptiFineDownloadListItem(Version, AddressOf OptiFine_Selected, False))
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化 OptiFine 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "可视化 OptiFine 安装版本列表出错")
End Try End Try
End Sub End Sub
@@ -689,7 +689,7 @@
PanLiteLoader.Children.Add(LiteLoaderDownloadListItem(Version, AddressOf LiteLoader_Selected, False)) PanLiteLoader.Children.Add(LiteLoaderDownloadListItem(Version, AddressOf LiteLoader_Selected, False))
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化 LiteLoader 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "可视化 LiteLoader 安装版本列表出错")
End Try End Try
End Sub End Sub
@@ -763,7 +763,7 @@
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False)) PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化 Forge 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "可视化 Forge 安装版本列表出错")
End Try End Try
End Sub End Sub
@@ -821,7 +821,7 @@
PanNeoForge.Children.Add(NeoForgeDownloadListItem(Version, AddressOf NeoForge_Selected, False)) PanNeoForge.Children.Add(NeoForgeDownloadListItem(Version, AddressOf NeoForge_Selected, False))
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化 NeoForge 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "可视化 NeoForge 安装版本列表出错")
End Try End Try
End Sub End Sub
@@ -883,7 +883,7 @@
CardFabric.SwapControl = PanFabric CardFabric.SwapControl = PanFabric
CardFabric.SwapType = 12 CardFabric.SwapType = 12
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化 Fabric 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "可视化 Fabric 安装版本列表出错")
End Try End Try
End Sub End Sub
@@ -926,8 +926,8 @@
If Part = TargetName Then Return True If Part = TargetName Then Return True
Next Next
'将版本名分割语素（例如 1.16.4/5） '将版本名分割语素（例如 1.16.4/5）
Dim Lefts = RegexSearch(FabricApiName.BeforeFirst("]"), "[a-z/]+|[0-9/]+") Dim Lefts = FabricApiName.BeforeFirst("]").RegexSearch("[a-z/]+|[0-9/]+").ToList
Dim Rights = RegexSearch(TargetName.BeforeFirst("]"), "[a-z/]+|[0-9/]+") Dim Rights = TargetName.BeforeFirst("]").RegexSearch("[a-z/]+|[0-9/]+").ToList
'对每段进行判断 '对每段进行判断
Dim i As Integer = 0 Dim i As Integer = 0
While True While True
@@ -946,7 +946,7 @@
End While End While
Return True Return True
Catch ex As Exception Catch ex As Exception
Log(ex, "判断 Fabric API 版本适配性出错（" & FabricApiName & ", " & VanillaName & "）") Logger.Warn(ex, $"判断 Fabric API 版本适配性出错（{FabricApiName}, {VanillaName}）")
Return False Return False
End Try End Try
End Function End Function
@@ -984,7 +984,7 @@
For Each Version In DlFabricApiLoader.Output For Each Version In DlFabricApiLoader.Output
If IsFabricApiCompatible(Version) Then If IsFabricApiCompatible(Version) Then
If Not Version.Display.StartsWithF("[") Then If Not Version.Display.StartsWithF("[") Then
Log("[Download] 已特判修改 Fabric API 显示名：" & Version.Display, NotifyLevel.DebugModeOnly) Logger.Warn($"已特判修改 Fabric API 显示名：{Version.Display}")
Version.Display = "[" & VanillaName & "] " & Version.Display Version.Display = "[" & VanillaName & "] " & Version.Display
End If End If
Versions.Add(Version) Versions.Add(Version)
@@ -1002,11 +1002,11 @@
If Not AutoSelectedFabricApi Then If Not AutoSelectedFabricApi Then
AutoSelectedFabricApi = True AutoSelectedFabricApi = True
Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanFabricApi.Children(0)) Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanFabricApi.Children(0))
Log($"[Download] 已自动选择 Fabric API：{Item.Title}") Logger.Info($"已自动选择 Fabric API：{Item.Title}")
FabricApi_Selected(Item, Nothing) FabricApi_Selected(Item, Nothing)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化 Fabric API 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "可视化 Fabric API 安装版本列表出错")
End Try End Try
End Sub End Sub
@@ -1035,7 +1035,7 @@
If VanillaName Is Nothing Then Return False If VanillaName Is Nothing Then Return False
Return ModFile.GameVersions.Contains(VanillaName) Return ModFile.GameVersions.Contains(VanillaName)
Catch ex As Exception Catch ex As Exception
Log(ex, "判断 OptiFabric 版本适配性出错（" & VanillaName & "）") Logger.Warn(ex, $"判断 OptiFabric 版本适配性出错（{VanillaName}）")
Return False Return False
End Try End Try
End Function End Function
@@ -1095,10 +1095,10 @@
If AutoSelectedOptiFabric OrElse VanillaDrop >= 140 AndAlso VanillaDrop <= 150 Then Return '1.14~15 不自动选择 If AutoSelectedOptiFabric OrElse VanillaDrop >= 140 AndAlso VanillaDrop <= 150 Then Return '1.14~15 不自动选择
AutoSelectedOptiFabric = True AutoSelectedOptiFabric = True
Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanOptiFabric.Children(0)) Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanOptiFabric.Children(0))
Log($"[Download] 已自动选择 OptiFabric：{Item.Title}") Logger.Info($"已自动选择 OptiFabric：{Item.Title}")
OptiFabric_Selected(Item, Nothing) OptiFabric_Selected(Item, Nothing)
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化 OptiFabric 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "可视化 OptiFabric 安装版本列表出错")
End Try End Try
End Sub End Sub
@@ -1125,7 +1125,7 @@
Private Sub BtnStart_Click() Handles BtnStart.Click Private Sub BtnStart_Click() Handles BtnStart.Click
'确认版本隔离 '确认版本隔离
If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
(Settings.Get("LaunchArgumentIndieV2") = 0 OrElse Settings.Get("LaunchArgumentIndieV2") = 2) Then (Settings.Get(Of Integer)("LaunchArgumentIndieV2") = 0 OrElse Settings.Get(Of Integer)("LaunchArgumentIndieV2") = 2) Then
If MyMsgBox("你尚未开启版本隔离，多个 MC 版本会共用同一个 Mod 文件夹。" & vbCrLf & If MyMsgBox("你尚未开启版本隔离，多个 MC 版本会共用同一个 Mod 文件夹。" & vbCrLf &
"因此，游戏可能会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf & "因此，游戏可能会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
"推荐先在 设置 → 启动选项 → 默认版本隔离 中开启版本隔离！", "版本隔离提示", "取消下载", "继续") = 1 Then "推荐先在 设置 → 启动选项 → 默认版本隔离 中开启版本隔离！", "版本隔离提示", "取消下载", "继续") = 1 Then
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb
+1 -1
View File
@@ -53,7 +53,7 @@
PageChangeRun(PageGet(ID)) PageChangeRun(PageGet(ID))
PageID = ID PageID = ID
Catch ex As Exception Catch ex As Exception
Log(ex, "切换分页面失败（ID " & ID & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"切换分页面失败（ID {ID}）")
Finally Finally
AniControlEnabled -= 1 AniControlEnabled -= 1
End Try End Try
Plain Craft Launcher 2/Pages/PageDownload/Resource/MyResourceItem.xaml.vb
+4 -4
View File
@@ -79,7 +79,7 @@
If IsMouseDown Then If IsMouseDown Then
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
If e.Handled Then Return If e.Handled Then Return
Log("[Control] 按下资源工程列表项：" & LabTitle.Text) Logger.Info($"按下资源工程列表项：{LabTitle.Text}")
End If End If
End Sub End Sub
Private Sub MyResourceItem_Click(sender As MyResourceItem, e As EventArgs) Handles Me.Click Private Sub MyResourceItem_Click(sender As MyResourceItem, e As EventArgs) Handles Me.Click
@@ -89,20 +89,20 @@
For Each Card As MyCard In FrmDownloadResourceDetail.PanResults.Children For Each Card As MyCard In FrmDownloadResourceDetail.PanResults.Children
If Card.Title <> "" AndAlso Not Card.IsSwapped Then Titles.Add(Card.Title) If Card.Title <> "" AndAlso Not Card.IsSwapped Then Titles.Add(Card.Title)
Next Next
Log("[Resource] 记录当前已展开的卡片：" & String.Join("、", Titles)) Logger.Info($"记录当前已展开的卡片：{String.Join("、", Titles)}")
FrmMain.PageCurrent.Additional(1) = Titles FrmMain.PageCurrent.Additional(1) = Titles
End If End If
'打开详情页 '打开详情页
Dim TargetType As ResourceTypes Dim TargetType As ResourceTypes
Dim TargetInstance As String = Nothing Dim TargetInstance As String = Nothing
Dim TargetLoader As ModLoaderTypes = ModLoaderTypes.Any Dim TargetLoader As ModLoaders = ModLoaders.None
If FrmMain.PageCurrent.Page = FormMain.PageType.Download Then If FrmMain.PageCurrent.Page = FormMain.PageType.Download Then
'从下载页进入 '从下载页进入
Select Case FrmMain.PageCurrentSub Select Case FrmMain.PageCurrentSub
Case FormMain.PageSubType.DownloadMod Case FormMain.PageSubType.DownloadMod
TargetType = ResourceTypes.Mod TargetType = ResourceTypes.Mod
TargetInstance = FrmDownloadMod.Content.Loader.Input.GameVersion TargetInstance = FrmDownloadMod.Content.Loader.Input.GameVersion
TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoader TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoaders
Case FormMain.PageSubType.DownloadPack Case FormMain.PageSubType.DownloadPack
TargetType = ResourceTypes.ModPack TargetType = ResourceTypes.ModPack
TargetInstance = FrmDownloadPack.Content.Loader.Input.GameVersion TargetInstance = FrmDownloadPack.Content.Loader.Input.GameVersion
Plain Craft Launcher 2/Pages/PageDownload/Resource/PageDownloadCompDetail.xaml.vb
+73 -73
View File
@@ -1,12 +1,28 @@
Public Class PageDownloadResourceDetail Public Class PageDownloadResourceDetail
Private ResourceItem As MyResourceItem = Nothing Private ResourceItem As MyResourceItem = Nothing
''' <summary>
''' 当前页面应展示的内容类别。
''' 若当前页面是在查看前置时进入，则为 Any；这也能用于指示当前是否在查看前置。
''' </summary>
Private TargetResourceType As ResourceTypes
Private Project As ResourceProject
Private TargetVersion As String
Private TargetLoaders As ModLoaders
Public Sub LoadPageArguments() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoaders = CType(FrmMain.PageCurrent.Additional(3), ModLoaders)
If TargetLoaders <> ModLoaders.None AndAlso Not TargetLoaders.Flags.IsSingle Then TargetLoaders = TargetLoaders.Flags.First() '强制取第一个
TargetResourceType = FrmMain.PageCurrent.Additional(4)
End Sub
#Region "加载器" #Region "加载器"
Private ResourceFileLoader As New LoaderTask(Of Integer, List(Of ResourceVersion))( Private ResourceFileLoader As New LoaderTask(Of Integer, List(Of ResourceVersion))(
"Resource File", "Resource File",
Sub(Task) Sub(Task)
LoadTargetFromAdditional() LoadPageArguments()
Dim Result = ResourceVersion.FromProjectId(Project.Id, Project.Platform) Dim Result = ResourceVersion.FromProjectId(Project.Id, Project.Platform)
If Task.IsInterrupted Then Return If Task.IsInterrupted Then Return
Task.Output = Result Task.Output = Result
@@ -14,22 +30,9 @@
'初始化加载器信息 '初始化加载器信息
Private Sub PageDownloadResourceDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized Private Sub PageDownloadResourceDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
LoadTargetFromAdditional() LoadPageArguments()
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, ResourceFileLoader, AddressOf Load_OnFinish) PageLoaderInit(Load, PanLoad, PanMain, CardIntro, ResourceFileLoader, AddressOf Load_OnFinish)
End Sub End Sub
Public Sub LoadTargetFromAdditional() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
TargetInstance = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
TargetType = FrmMain.PageCurrent.Additional(4)
End Sub
Private Project As ResourceProject
Private TargetInstance As String, TargetLoader As ModLoaderTypes
''' <summary>
''' 当前页面应展示的内容类别。
''' 若当前页面是在查看前置时进入，则也可能为 Any。
''' </summary>
Private TargetType As ResourceTypes
'自动重试 '自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case ResourceFileLoader.State Select Case ResourceFileLoader.State
@@ -37,7 +40,7 @@
Dim ErrorMessage As String = "" Dim ErrorMessage As String = ""
If ResourceFileLoader.Error IsNot Nothing Then ErrorMessage = ResourceFileLoader.Error.Message If ResourceFileLoader.Error IsNot Nothing Then ErrorMessage = ResourceFileLoader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Resource] 下载的文件 json 列表损坏，已自动重试", NotifyLevel.DebugModeOnly) Logger.Warn("下载的文件 json 列表损坏，已自动重试")
PageLoaderRestart() PageLoaderRestart()
End If End If
End Select End Select
@@ -75,13 +78,13 @@
'筛选类型相同的结果（Modrinth 会返回 Mod、服务端插件、数据包混合的列表） '筛选类型相同的结果（Modrinth 会返回 Mod、服务端插件、数据包混合的列表）
Private Function GetResults() As List(Of ResourceVersion) Private Function GetResults() As List(Of ResourceVersion)
Dim Results As List(Of ResourceVersion) = ResourceFileLoader.Output Dim Results As List(Of ResourceVersion) = ResourceFileLoader.Output
Select Case TargetType Select Case TargetResourceType
Case ResourceTypes.Any Case ResourceTypes.Any
Results = Results.Where(Function(r) r.ResourceType <> ResourceTypes.Plugin).ToList Results = Results.Where(Function(r) r.ResourceType <> ResourceTypes.Plugin).ToList
Case ResourceTypes.Shader, ResourceTypes.ResourcePack Case ResourceTypes.Shader, ResourceTypes.ResourcePack
'不筛选光影和资源包，否则原版光影会因为是资源包格式而被过滤（#6473） '不筛选光影和资源包，否则原版光影会因为是资源包格式而被过滤（#6473）
Case Else Case Else
Results = Results.Where(Function(r) r.ResourceType = TargetType).ToList Results = Results.Where(Function(r) r.ResourceType = TargetResourceType).ToList
End Select End Select
Return Results Return Results
End Function End Function
@@ -132,10 +135,10 @@ GroupDone:
Next Next
'自动选择 '自动选择
Dim ToCheck As MyRadioButton = Nothing Dim ToCheck As MyRadioButton = Nothing
If TargetInstance <> "" Then If TargetVersion <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetInstance)) Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
If TargetFile IsNot Nothing Then If TargetFile IsNot Nothing Then
Dim TargetGroup = GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld) Dim TargetGroup = GetGroupedVersionName(TargetVersion, GroupedDrop, GroupedOld)
For Each Button As MyRadioButton In PanFilter.Children For Each Button As MyRadioButton In PanFilter.Children
If Button.Text <> TargetGroup Then Continue For If Button.Text <> TargetGroup Then Continue For
ToCheck = Button ToCheck = Button
@@ -153,12 +156,11 @@ GroupDone:
Private Sub UpdateFilterResult() Private Sub UpdateFilterResult()
Dim Results = GetResults() Dim Results = GetResults()
Dim TargetCardName As String = If(TargetInstance <> "" OrElse TargetLoader <> ModLoaderTypes.Any, Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoaders <> ModLoaders.None,
$"{If(TargetLoader <> ModLoaderTypes.Any, TargetLoader.ToString & " ", "")}{TargetInstance}（所选版本）", "") $"{If(TargetLoaders <> ModLoaders.None, TargetLoaders.ToString & " ", "")}{TargetVersion}（所选版本）", "")
'归类到卡片下 '归类到卡片下
Dim Dict As New SortedDictionary(Of String, List(Of ResourceVersion))(New CardSorter(TargetCardName)) Dim Dict As New SortedDictionary(Of String, List(Of ResourceVersion))(New CardSorter(TargetCardName))
Dict.Add("其他", New List(Of ResourceVersion)) Dict.Add("其他", New List(Of ResourceVersion))
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(ModLoaderTypes)))
For Each Version As ResourceVersion In Results For Each Version As ResourceVersion In Results
For Each GameVersion In Version.GameVersions For Each GameVersion In Version.GameVersions
'检查是否符合版本筛选器 '检查是否符合版本筛选器
@@ -168,12 +170,12 @@ GroupDone:
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False) Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
'遍历加入的加载器列表 '遍历加入的加载器列表
Dim Loaders As New List(Of String) Dim Loaders As New List(Of String)
If Project.Loaders.Count > 1 AndAlso '工程至少有两个加载器 If Project.ModLoaders.Flags.Count > 1 AndAlso '工程至少有两个加载器
Version.ResourceType = ResourceTypes.Mod AndAlso '是 Mod Version.ResourceType = ResourceTypes.Mod AndAlso '是 Mod
McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的 McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的
For Each Loader In Version.Loaders For Each Loader In Version.ModLoaders.Flags
If Loader = ModLoaderTypes.Quilt AndAlso Settings.Get("ToolDownloadIgnoreQuilt") Then Continue For If Loader = ModLoaders.Quilt AndAlso Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ") Loaders.Add(Loader.ToString & " ")
Next Next
End If End If
If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的，确保它在一张卡片里 If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的，确保它在一张卡片里
@@ -186,11 +188,11 @@ GroupDone:
Next Next
Next Next
'添加筛选的版本的卡片 '添加筛选的版本的卡片
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetVersion, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then
Dict.Add(TargetCardName, New List(Of ResourceVersion)) Dict.Add(TargetCardName, New List(Of ResourceVersion))
For Each Version As ResourceVersion In Results For Each Version As ResourceVersion In Results
If Version.GameVersions.Contains(TargetInstance) AndAlso If Version.GameVersions.Contains(TargetVersion) AndAlso
(TargetLoader = ModLoaderTypes.Any OrElse Version.Loaders.Contains(TargetLoader)) Then (TargetLoaders = ModLoaders.None OrElse TargetLoaders.Flags.Intersect(Version.ModLoaders.Flags).Any) Then
'检查是否符合版本筛选器 '检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso If VersionFilter IsNot Nothing AndAlso
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld) = VersionFilter) Then Continue For Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld) = VersionFilter) Then Continue For
@@ -205,16 +207,16 @@ GroupDone:
If Not Pair.Value.Any() Then Continue For If Not Pair.Value.Any() Then Continue For
If Pair.Key = TargetCardName.Replace("（所选版本）", "") Then Continue For If Pair.Key = TargetCardName.Replace("（所选版本）", "") Then Continue For
'增加卡片 '增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(TargetType = ResourceTypes.ModPack, 9, 8)} '9 是安装，8 是另存为 Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(TargetResourceType = ResourceTypes.ModPack, 9, 8)} '9 是安装，8 是另存为
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value} Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack) NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack NewCard.SwapControl = NewStack
PanResults.Children.Add(NewCard) PanResults.Children.Add(NewCard)
'确定卡片是否展开 '确定卡片是否默认展开
If Pair.Key = TargetCardName OrElse If Pair.Key = TargetCardName OrElse
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761 (FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
MyCard.StackInstall(NewStack, If(TargetType = ResourceTypes.ModPack, 9, 8), Pair.Key) '9 是安装，8 是另存为 MyCard.StackInstall(NewStack, If(TargetResourceType = ResourceTypes.ModPack, 9, 8), Pair.Key) '9 是安装，8 是另存为
Else Else
NewCard.IsSwapped = True NewCard.IsSwapped = True
End If End If
@@ -228,15 +230,15 @@ GroupDone:
CType(PanResults.Children(0), MyCard).IsSwapped = False CType(PanResults.Children(0), MyCard).IsSwapped = False
End If End If
'替代提示 '替代提示
If Project.Types = ResourceTypes.ModOrDataPack AndAlso (TargetType = ResourceTypes.Mod OrElse TargetType = ResourceTypes.DataPack) Then If Project.Types = ResourceTypes.ModOrDataPack AndAlso (TargetResourceType = ResourceTypes.Mod OrElse TargetResourceType = ResourceTypes.DataPack) Then
HintAlternative.Visibility = Visibility.Visible HintAlternative.Visibility = Visibility.Visible
HintAlternative.Text = If(TargetType = ResourceTypes.Mod, HintAlternative.Text = If(TargetResourceType = ResourceTypes.Mod,
"以下是该项目的 Mod 版本。点击这里查看其数据包版本。", "以下是该项目的数据包版本。点击这里查看其 Mod 版本。") "以下是该项目的 Mod 版本。点击这里查看其数据包版本。", "以下是该项目的数据包版本。点击这里查看其 Mod 版本。")
Else Else
HintAlternative.Visibility = Visibility.Collapsed HintAlternative.Visibility = Visibility.Collapsed
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化工程下载列表出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "可视化工程下载列表出错")
End Try End Try
End Sub End Sub
Private Function GetGroupedVersionName(Name As String, GroupedByDrop As Boolean, FoldOld As Boolean) As String Private Function GetGroupedVersionName(Name As String, GroupedByDrop As Boolean, FoldOld As Boolean) As String
@@ -303,16 +305,18 @@ GroupDone:
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
Dim Target As String = $"{McFolderSelected}versions\{InstanceName}\原始整合包.{If(Project.Platform = ResourcePlatforms.CurseForge, "zip", "mrpack")}" Dim Target As String = $"{McFolderSelected}versions\{InstanceName}\原始整合包.{If(Project.Platform = ResourcePlatforms.CurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = ResourceItem.PathLogo.ActualSource Dim LogoFileAddress As String = ResourceItem.PathLogo.ActualSource
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True}) Loaders.Add(New LoaderDownload("下载整合包文件", {
File.ToNetFile(Target, ResourceVersion.DownloadReason.Standalone, File.GameVersions.FirstOrDefault, File.ModLoaders)
}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包", Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() ModpackInstall(Target, InstanceName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1}) Sub() ModpackInstall(Target, InstanceName, If(FileUtils.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
Sub(MyLoader) Sub(MyLoader)
Select Case MyLoader.State Select Case MyLoader.State
Case LoadState.Failed Case LoadState.Failed
Hint(MyLoader.Name & "失败：" & MyLoader.Error.GetBrief(), HintType.Red) Hint(MyLoader.Name & "失败：" & MyLoader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted Case LoadState.Interrupted
Hint(MyLoader.Name & "已取消！", HintType.Blue) Hint(MyLoader.Name & "已取消！", HintType.Blue)
Case LoadState.Loading Case LoadState.Loading
@@ -326,7 +330,7 @@ GroupDone:
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception Catch ex As Exception
Log(ex, "下载资源整合包失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "下载资源整合包失败")
End Try End Try
End Sub End Sub
'资源下载；整合包另存为 '资源下载；整合包另存为
@@ -356,13 +360,13 @@ GroupDone:
End Select End Select
Dim IsInstanceSuitable As Func(Of McInstance, Boolean) = Nothing Dim IsInstanceSuitable As Func(Of McInstance, Boolean) = Nothing
'获取资源所需的加载器 '获取资源所需的加载器
Dim AllowedLoaders As New List(Of ModLoaderTypes) Dim AllowedLoaders As ModLoaders = ModLoaders.None
If File.Loaders.Any Then If File.ModLoaders <> ModLoaders.None Then
AllowedLoaders = File.Loaders AllowedLoaders = File.ModLoaders
ElseIf Project.Loaders.Any Then ElseIf Project.ModLoaders <> ModLoaders.None Then
AllowedLoaders = Project.Loaders AllowedLoaders = Project.ModLoaders
End If End If
Log($"[Resource] {Desc}要求的加载器种类：" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求")) Logger.Info($"{Desc}要求的加载器种类：{AllowedLoaders}")
'判断某个版本是否符合资源要求 '判断某个版本是否符合资源要求
IsInstanceSuitable = IsInstanceSuitable =
Function(Instance As McInstance) Function(Instance As McInstance)
@@ -403,21 +407,16 @@ GroupDone:
End Function) Then Return False End Function) Then Return False
End If End If
'加载器 '加载器
If Not AllowedLoaders.Any() Then Return True '无要求 Return AllowedLoaders = ModLoaders.None OrElse AllowedLoaders.Flags.Intersect(Instance.Version.ModLoaders.Flags).Any
If AllowedLoaders.Contains(ModLoaderTypes.Forge) AndAlso Instance.Version.HasForge Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.Fabric) AndAlso Instance.Version.HasFabric Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.NeoForge) AndAlso Instance.Version.HasNeoForge Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.LiteLoader) AndAlso Instance.Version.HasLiteLoader Then Return True
Return False
End Function End Function
'获取常规资源默认下载位置 '获取常规资源默认下载位置
If CachedFolder.ContainsKey(File.ResourceType) Then If CachedFolder.ContainsKey(File.ResourceType) Then
DefaultFolder = CachedFolder(File.ResourceType) DefaultFolder = CachedFolder(File.ResourceType)
Log($"[Resource] 使用上次下载时的文件夹作为默认下载位置：{DefaultFolder}") Logger.Info($"使用上次下载时的文件夹作为默认下载位置：{DefaultFolder}")
ElseIf McInstanceSelected IsNot Nothing AndAlso IsInstanceSuitable(McInstanceSelected) Then ElseIf McInstanceSelected IsNot Nothing AndAlso IsInstanceSuitable(McInstanceSelected) Then
DefaultFolder = $"{McInstanceSelected.PathIndie}{SubFolder}" DefaultFolder = $"{McInstanceSelected.PathIndie}{SubFolder}"
DirectoryUtils.Create(DefaultFolder) DirectoryUtils.Create(DefaultFolder)
Log($"[Resource] 使用当前版本作为默认下载位置：{DefaultFolder}") Logger.Info($"使用当前版本作为默认下载位置：{DefaultFolder}")
Else Else
'查找所有可能的版本 '查找所有可能的版本
Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished
@@ -426,21 +425,21 @@ GroupDone:
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
End If End If
Dim SuitableInstanceList = McInstanceList.Values.SelectMany(Function(l) l).Where(Function(v) IsInstanceSuitable(v)). Dim SuitableInstanceList = McInstanceList.Values.SelectMany(Function(l) l).Where(Function(v) IsInstanceSuitable(v)).
Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}")) Select(Function(v) DirectoryUtils.GetInfo($"{v.PathIndie}{SubFolder}"))
If SuitableInstanceList.Any Then If SuitableInstanceList.Any Then
Dim SelectedInstance = SuitableInstanceList. Dim SelectedInstance = SuitableInstanceList.
OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序 OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序 ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
First() First()
DefaultFolder = SelectedInstance.FullName DefaultFolder = PathUtils.RemoveExtendedPrefix(SelectedInstance.FullName)
DirectoryUtils.Create(DefaultFolder) DirectoryUtils.Create(DefaultFolder)
Log($"[Resource] 使用适合的游戏版本作为默认下载位置：{DefaultFolder}") Logger.Info($"使用适合的游戏版本作为默认下载位置：{DefaultFolder}")
Else Else
DefaultFolder = McFolderSelected DefaultFolder = McFolderSelected
If NeedLoad Then If NeedLoad Then
Hint($"当前 MC 文件夹中没有找到合适的版本！") Hint($"当前 MC 文件夹中没有找到合适的版本！")
Else Else
Log("[Resource] 由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置") Logger.Info("由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置")
End If End If
End If End If
End If End If
@@ -452,7 +451,7 @@ GroupDone:
Else Else
Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - "). Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - ").
Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：") Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：")
Select Case Settings.Get("ToolDownloadTranslateV2") Select Case Settings.Get(Of Integer)("ToolDownloadTranslateV2")
Case 0 Case 0
FileName = $"【{ChineseName}】{File.FileName}" FileName = $"【{ChineseName}】{File.FileName}"
Case 1 Case 1
@@ -470,17 +469,18 @@ GroupDone:
Sub() Sub()
'弹窗要求选择保存位置 '弹窗要求选择保存位置
Dim Target As String Dim Target As String
Target = SelectSaveFile("选择保存位置", FileName, Dim Ext As String = If(File.ResourceType = ResourceTypes.Mod,
Desc & "文件|" & If(File.FileName.EndsWithF(".litemod"), "litemod", "jar"),
If(File.ResourceType = ResourceTypes.Mod, If(File.FileName.EndsWithF(".mrpack"), "mrpack", "zip"))
If(File.FileName.EndsWithF(".litemod"), "*.litemod", "*.jar"), Target = Dialogs.SaveFile("选择保存位置", FileName, DefaultFolder, {(Ext, Desc & "文件")})
If(File.FileName.EndsWithF(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder) If Target Is Nothing Then Return
If Not Target.Contains("\") Then Return
'构造步骤加载器 '构造步骤加载器
Dim LoaderName As String = Desc & "下载：" & Path.GetFileNameWithoutExtension(Target) & " " Dim LoaderName As String = Desc & "下载：" & PathUtils.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder Then CachedFolder(File.ResourceType) = GetPathFromFullPath(Target) If Target <> DefaultFolder Then CachedFolder(File.ResourceType) = PathUtils.RemoveLastPart(Target)
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True}) Loaders.Add(New LoaderDownload("下载文件", {
File.ToNetFile(Target, If(TargetResourceType = ResourceTypes.Any, ResourceVersion.DownloadReason.Dependency, ResourceVersion.DownloadReason.Standalone))
}) With {.ProgressWeight = 6, .Block = True})
'启动 '启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly} Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(1) Loader.Start(1)
@@ -489,7 +489,7 @@ GroupDone:
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
End Sub) End Sub)
Catch ex As Exception Catch ex As Exception
Log(ex, "保存资源文件失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "保存资源文件失败")
End Try End Try
End Sub, "Download Resource Detail Save") End Sub, "Download Resource Detail Save")
End Sub End Sub
@@ -506,8 +506,8 @@ GroupDone:
'Mod / 数据包 互相跳转 'Mod / 数据包 互相跳转
Private Sub HintAlternative_Click() Handles HintAlternative.Click Private Sub HintAlternative_Click() Handles HintAlternative.Click
TargetType = If(TargetType = ResourceTypes.Mod, ResourceTypes.DataPack, ResourceTypes.Mod) TargetResourceType = If(TargetResourceType = ResourceTypes.Mod, ResourceTypes.DataPack, ResourceTypes.Mod)
FrmMain.PageCurrent.Additional(4) = TargetType '加载器会从这里重新拿数据 FrmMain.PageCurrent.Additional(4) = TargetResourceType '加载器会从这里重新拿数据
PageLoaderRestart(IsForceRestart:=True) PageLoaderRestart(IsForceRestart:=True)
End Sub End Sub
@@ -522,7 +522,7 @@ GroupDone:
If Not Deps.Any() Then Return If Not Deps.Any() Then Return
Deps = Deps.Where( Deps = Deps.Where(
Function(dep) Function(dep)
If Not ResourceProject.Cache.ContainsKey(dep) Then Log($"[Resource] 未找到 ID {dep} 的前置信息", NotifyLevel.DebugModeOnly) If Not ResourceProject.Cache.ContainsKey(dep) Then Logger.Warn($"未找到 ID {dep} 的前置信息")
Return ResourceProject.Cache.ContainsKey(dep) Return ResourceProject.Cache.ContainsKey(dep)
End Function).ToList End Function).ToList
'添加开头间隔 '添加开头间隔
Plain Craft Launcher 2/Pages/PageDownload/Resource/PageResource.xaml
+3 -2
View File
@@ -49,9 +49,10 @@
<local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" Margin="10,0,0,0"> <local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" Margin="10,0,0,0">
<local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" /> <local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="Forge" Tag="1" /> <local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="NeoForge" Tag="6" /> <local:MyComboBoxItem Content="NeoForge" Tag="16" />
<local:MyComboBoxItem Content="Fabric" Tag="4" /> <local:MyComboBoxItem Content="Fabric" Tag="4" />
<local:MyComboBoxItem Content="Quilt" Tag="5" /> <local:MyComboBoxItem Content="Quilt" Tag="8" />
<local:MyComboBoxItem Content="LiteLoader" Tag="2" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" /> <TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" /> <local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" />
Plain Craft Launcher 2/Pages/PageDownload/Resource/PageResource.xaml.vb
+7 -7
View File
@@ -74,7 +74,7 @@ Public Class PageResource
Public Shared TargetName As String = Nothing Public Shared TargetName As String = Nothing
'在点击 MyResourceItem 时会获取 Loader 的输入，以使资源详情页面可以应用相同的筛选项 '在点击 MyResourceItem 时会获取 Loader 的输入，以使资源详情页面可以应用相同的筛选项
Public Loader = ResourceSearcher.GetLoader(AddressOf LoaderInput) Public Loader As LoaderTask(Of ResourceSearcher.SearchRequest, Integer) = ResourceSearcher.GetLoader(AddressOf LoaderInput)
Private Sub PageResource_Loaded(sender As Object, e As EventArgs) Handles Me.Loaded Private Sub PageResource_Loaded(sender As Object, e As EventArgs) Handles Me.Loaded
Static IsFirstLoaded As Boolean = False Static IsFirstLoaded As Boolean = False
@@ -126,7 +126,7 @@ Public Class PageResource
.SearchText = TextSearchName.Text .SearchText = TextSearchName.Text
.GameVersion = GameVersion .GameVersion = GameVersion
.Tag = ComboSearchTag.SelectedItem.Tag .Tag = ComboSearchTag.SelectedItem.Tag
.ModLoader = If(PageType = ResourceTypes.Mod, Val(ComboSearchLoader.SelectedItem.Tag), ModLoaderTypes.Any) .ModLoaders = If(PageType = ResourceTypes.Mod, Val(ComboSearchLoader.SelectedItem.Tag), ModLoaders.None)
.Sources = CType(Val(ComboSearchSource.SelectedItem.Tag), ResourcePlatforms) .Sources = CType(Val(ComboSearchSource.SelectedItem.Tag), ResourcePlatforms)
End With End With
Return Request Return Request
@@ -144,14 +144,14 @@ Public Class PageResource
'结果 UI 化 '结果 UI 化
Private Sub Load_OnFinish() Private Sub Load_OnFinish()
Try Try
Log($"[Resource] 开始可视化{TypeNameSpaced}列表，已储藏 {Storage.Results.Count} 个结果，当前在第 {Page + 1} 页") Logger.Info($"开始可视化{TypeNameSpaced}列表，已储藏 {Storage.Results.Count} 个结果，当前在第 {Page + 1} 页")
'列表项 '列表项
PanProjects.Children.Clear() PanProjects.Children.Clear()
Dim Index As Integer = Math.Min(Page * PAGE_SIZE, Storage.Results.Count - 1) Dim Index As Integer = Math.Min(Page * PAGE_SIZE, Storage.Results.Count - 1)
For Each Result In Storage.Results.GetRange(Index, Math.Min(Storage.Results.Count - Index, PAGE_SIZE)) For Each Result In Storage.Results.GetRange(Index, Math.Min(Storage.Results.Count - Index, PAGE_SIZE))
PanProjects.Children.Add(Result.ToResourceItem( PanProjects.Children.Add(Result.ToResourceItem(
ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing, ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing,
ShowLoaderDesc:=Loader.Input.ModLoader = ModLoaderTypes.Any AndAlso (PageType = ResourceTypes.Mod OrElse PageType = ResourceTypes.ModPack))) ShowLoaderDesc:=Loader.Input.ModLoaders = ModLoaders.None AndAlso (PageType = ResourceTypes.Mod OrElse PageType = ResourceTypes.ModPack)))
Next Next
'页码 '页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
@@ -177,7 +177,7 @@ Public Class PageResource
'强制返回顶部 '强制返回顶部
ScrollToTop() ScrollToTop()
Catch ex As Exception Catch ex As Exception
Log(ex, $"可视化{TypeNameSpaced}列表出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"可视化{TypeNameSpaced}列表出错")
End Try End Try
End Sub End Sub
@@ -188,7 +188,7 @@ Public Class PageResource
Dim ErrorMessage As String = "" Dim ErrorMessage As String = ""
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then If ErrorMessage.Contains("不是有效的 json 文件") Then
Log($"[Download] 下载的{TypeNameSpaced}列表 json 文件损坏，已自动重试", NotifyLevel.DebugModeOnly) Logger.Warn($"下载的{TypeNameSpaced}列表 json 文件损坏，已自动重试")
CType(Parent, MyPageRight).PageLoaderRestart() CType(Parent, MyPageRight).PageLoaderRestart()
End If End If
End Select End Select
@@ -208,7 +208,7 @@ Public Class PageResource
CardPages.IsEnabled = False CardPages.IsEnabled = False
Page = NewPage Page = NewPage
FrmMain.BackToTop() FrmMain.BackToTop()
Log($"[Download] {TypeName}：切换到第 {Page + 1} 页") Logger.Info($"{TypeName}：切换到第 {Page + 1} 页")
RunInThread( RunInThread(
Sub() Sub()
Thread.Sleep(100) '等待向上滚的动画结束 Thread.Sleep(100) '等待向上滚的动画结束
Plain Craft Launcher 2/Pages/PageInstance/MyLocalModItem.xaml
+1 -1
View File
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL;assembly=" xmlns:local="clr-namespace:PCL;assembly="
x:Name="PanBack" Height="44" x:Name="PanBack" Height="44"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True"> RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True" Cursor="Hand">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="6" /> <ColumnDefinition Width="6" />
<ColumnDefinition Width="34" /> <ColumnDefinition Width="34" />
Plain Craft Launcher 2/Pages/PageInstance/MyLocalModItem.xaml.vb
+6 -6
View File
@@ -61,11 +61,11 @@ Public Class MyLocalModItem
End Property End Property
'相关联的 Mod '相关联的 Mod
Public Property Entry As ResourceFile Public Property Entry As LocalResourceFile
Get Get
Return Tag Return Tag
End Get End Get
Set(value As ResourceFile) Set(value As LocalResourceFile)
Tag = value Tag = value
End Set End Set
End Property End Property
@@ -80,7 +80,7 @@ Public Class MyLocalModItem
If IsMouseDown Then If IsMouseDown Then
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
If e.Handled Then Return If e.Handled Then Return
Log("[Control] 按下本地 Mod 列表项：" & LabTitle.Text) Logger.Info($"按下本地 Mod 列表项：{LabTitle.Text}")
End If End If
End Sub End Sub
@@ -203,7 +203,7 @@ Public Class MyLocalModItem
AniStop("MyLocalModItem Checked " & Uuid) AniStop("MyLocalModItem Checked " & Uuid)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "设置 Checked 失败") Logger.Warn(ex, "设置 Checked 失败")
End Try End Try
End Set End Set
End Property End Property
@@ -335,9 +335,9 @@ Public Class MyLocalModItem
BtnUpdate.Visibility = Visibility.Collapsed BtnUpdate.Visibility = Visibility.Collapsed
End If End If
'标题与描述 '标题与描述
Dim DescFileName As String = Path.GetFileNameWithoutExtension(Entry.File.FullName) Dim DescFileName As String = Entry.File.Name.BeforeLast(".")
Dim NewDescription As String Dim NewDescription As String
If Settings.Get("ToolModLocalNameStyle") = 1 Then If Settings.Get(Of Integer)("ToolModLocalNameStyle") = 1 Then
'标题显示文件名，详情显示译名 '标题显示文件名，详情显示译名
'标题 '标题
Title = DescFileName Title = DescFileName
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceExport.xaml.vb
+72 -75
View File
@@ -25,7 +25,7 @@ Public Class PageInstanceExport
AniControlEnabled -= 1 AniControlEnabled -= 1
End Sub End Sub
Public Sub RefreshAll() Implements IRefreshable.Refresh Public Sub RefreshAll() Implements IRefreshable.Refresh
Log($"[Export] 刷新导出页面") Logger.Info($"刷新导出页面")
HintOptiFine.Visibility = If(PageInstanceLeft.Instance.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed) HintOptiFine.Visibility = If(PageInstanceLeft.Instance.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
CurrentInstance = PageInstanceLeft.Instance.PathVersion CurrentInstance = PageInstanceLeft.Instance.PathVersion
TextExportName.Text = "" TextExportName.Text = ""
@@ -56,7 +56,7 @@ Public Class PageInstanceExport
Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String()) Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String())
Panel.Children.Clear() Panel.Children.Clear()
For Each Folder In Folders For Each Folder In Folders
Dim TargetFolder As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Folder) Dim TargetFolder = DirectoryUtils.GetInfo(PageInstanceLeft.Instance.PathIndie & Folder)
If Not TargetFolder.Exists() Then Continue For If Not TargetFolder.Exists() Then Continue For
'查找文件夹下的对应项 '查找文件夹下的对应项
If AcceptCompressedFile Then If AcceptCompressedFile Then
@@ -98,14 +98,14 @@ Public Class PageInstanceExport
Return False Return False
End Try End Try
End Function End Function
Dim PathInfo As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie) Dim PathInfo = DirectoryUtils.GetInfo(PageInstanceLeft.Instance.PathIndie)
AllEntries.AddRange(PathInfo.EnumerateFiles().Select(Function(f) f.Name)) AllEntries.AddRange(PathInfo.EnumerateFiles().Select(Function(f) f.Name))
For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory) For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory)
AllEntries.Add($"{SubFolder.Name}\") AllEntries.Add($"{SubFolder.Name}\")
AllEntries.AddRange(SubFolder.EnumerateFiles().Select(Function(f) $"{SubFolder.Name}\{f.Name}")) AllEntries.AddRange(SubFolder.EnumerateFiles().Select(Function(f) $"{SubFolder.Name}\{f.Name}"))
AllEntries.AddRange(SubFolder.EnumerateDirectories().Where(IsValidDirectory).Select(Function(d) $"{SubFolder.Name}\{d.Name}\")) AllEntries.AddRange(SubFolder.EnumerateDirectories().Where(IsValidDirectory).Select(Function(d) $"{SubFolder.Name}\{d.Name}\"))
Next Next
Log($"[Export] 共发现 {AllEntries.Count} 个可行的二级文件/文件夹") Logger.Info($"共发现 {AllEntries.Count} 个可行的二级文件/文件夹")
'确认选项是否应该被显示 '确认选项是否应该被显示
Dim IsVisible = Dim IsVisible =
Function(TargetOption As ExportOption) As Boolean Function(TargetOption As ExportOption) As Boolean
@@ -121,16 +121,16 @@ Public Class PageInstanceExport
Try Try
If AllEntries.Any(Function(Entry) Entry Like Rule) Then Return True If AllEntries.Any(Function(Entry) Entry Like Rule) Then Return True
Catch ex As Exception Catch ex As Exception
Log(ex, $"错误的规则：{Rule}", NotifyLevel.AllUsers) Logger.Error(ex, $"错误的规则：{Rule}", LogBehavior.Toast)
Return False Return False
End Try End Try
'粗略检查所有级 '粗略检查所有级
Rule = Rule.Trim("*?".ToCharArray) Rule = Rule.Trim("*?".ToCharArray)
If Rule.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries).Count >= 3 Then If Rule.Split("\"c, True).Count >= 3 Then
If Rule.EndsWithF("\") Then If Rule.EndsWithF("\") Then
Return IsValidDirectory(New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Rule)) '文件夹有效 Return IsValidDirectory(DirectoryUtils.GetInfo(PageInstanceLeft.Instance.PathIndie & Rule)) '文件夹有效
Else Else
Return File.Exists(PageInstanceLeft.Instance.PathIndie & Rule) '文件有效 Return FileUtils.Exists(PageInstanceLeft.Instance.PathIndie & Rule) '文件有效
End If End If
Else Else
Return False Return False
@@ -303,8 +303,8 @@ Public Class PageInstanceExport
'保存配置文件 '保存配置文件
Private Sub ExportConfig() Handles BtnAdvancedExport.Click Private Sub ExportConfig() Handles BtnAdvancedExport.Click
Try Try
Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Settings.Get("CacheExportConfig")) Dim ConfigPath As String = Dialogs.SaveFile("选择文件位置", "export_config.txt", Settings.Get(Of String)("CacheExportConfig"), {("txt", "整合包导出配置")})
If String.IsNullOrEmpty(ConfigPath) Then Return If ConfigPath Is Nothing Then Return
Settings.Set("CacheExportConfig", ConfigPath) Settings.Set("CacheExportConfig", ConfigPath)
Dim ConfigLines As New List(Of String) Dim ConfigLines As New List(Of String)
'ini 段 'ini 段
@@ -343,19 +343,19 @@ Public Class PageInstanceExport
Hint("已保存配置文件：" & ConfigPath, HintType.Green) Hint("已保存配置文件：" & ConfigPath, HintType.Green)
OpenExplorer(ConfigPath) OpenExplorer(ConfigPath)
Catch ex As Exception Catch ex As Exception
Log(ex, "保存配置失败", NotifyLevel.MsgBox) Logger.Error(ex, "保存配置失败", LogBehavior.Alert)
End Try End Try
End Sub End Sub
'读取配置文件 '读取配置文件
Private Sub ImportConfig() Handles BtnAdvancedImport.Click Private Sub ImportConfig() Handles BtnAdvancedImport.Click
Try Try
Dim ConfigPath As String = SelectFile("整合包导出配置(*.txt)|*.txt", "选择配置文件", Settings.Get("CacheExportConfig")) Dim ConfigPath As String = Dialogs.SelectFile("选择配置文件", False, Settings.Get(Of String)("CacheExportConfig"), {({"txt"}, "整合包导出配置")}).FirstOrDefault()
If String.IsNullOrEmpty(ConfigPath) Then Return If String.IsNullOrEmpty(ConfigPath) Then Return
Settings.Set("CacheExportConfig", ConfigPath) Settings.Set("CacheExportConfig", ConfigPath)
Dim Segments As String() = ReadFile(ConfigPath).Split(Sperator) Dim Segments As String() = FileUtils.ReadAsString(ConfigPath).Split(Sperator)
'ini 段 'ini 段
Dim Ini As New Dictionary(Of String, String) Dim Ini As New Dictionary(Of String, String)
For Each Line In Segments(0).Split(vbCrLf.ToCharArray()) For Each Line In Segments(0).SplitLines(True)
Line = Line.Trim Line = Line.Trim
If Line = "" OrElse Line.StartsWithF("#") OrElse Line.StartsWithF("=") Then Continue For If Line = "" OrElse Line.StartsWithF("#") OrElse Line.StartsWithF("=") Then Continue For
Dim Index As Integer = Line.IndexOfF(":") Dim Index As Integer = Line.IndexOfF(":")
@@ -369,17 +369,17 @@ Public Class PageInstanceExport
If Not CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = Ini.GetOrDefault("ModrinthUploadMode", False) '#7979，加个特判 If Not CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = Ini.GetOrDefault("ModrinthUploadMode", False) '#7979，加个特判
ConfigPackPath = Ini.GetOrDefault("PackPath", Nothing) ConfigPackPath = Ini.GetOrDefault("PackPath", Nothing)
'导出内容段 '导出内容段
RulesOverrides = Segments(1).ReplaceLineEndings(vbLf, mergeMultiple:=True).Split(vbLf).ToList RulesOverrides = Segments(1).SplitLines(True).ToList
'追加内容段 '追加内容段
If Segments.Length > 2 Then If Segments.Length > 2 Then
ExtraFiles = Segments(2).ReplaceLineEndings(vbLf, mergeMultiple:=True).Split(vbLf).ToList ExtraFiles = Segments(2).SplitLines(True).ToList
Else Else
ExtraFiles = Nothing ExtraFiles = Nothing
End If End If
'结束 '结束
Hint("已读取配置文件：" & ConfigPath, HintType.Green) Hint("已读取配置文件：" & ConfigPath, HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, "读取配置失败", NotifyLevel.MsgBox) Logger.Error(ex, "读取配置失败", LogBehavior.Alert)
End Try End Try
End Sub End Sub
@@ -412,23 +412,23 @@ Public Class PageInstanceExport
If Not String.IsNullOrWhiteSpace(ConfigPackPath) AndAlso If Not String.IsNullOrWhiteSpace(ConfigPackPath) AndAlso
(Not ConfigPackPath.EndsWithF("\") AndAlso Not ConfigPackPath.EndsWithF("/")) Then (Not ConfigPackPath.EndsWithF("\") AndAlso Not ConfigPackPath.EndsWithF("/")) Then
Try Try
DirectoryUtils.Create(ConfigPackPath, isFilePath:=True) DirectoryUtils.Create(PathUtils.RemoveLastPart(ConfigPackPath))
PackPath = ConfigPackPath PackPath = ConfigPackPath
Log($"[Export] 使用配置文件中指定的导出路径：{ConfigPackPath}") Logger.Info($"使用配置文件中指定的导出路径：{ConfigPackPath}")
Catch ex As Exception Catch ex As Exception
Log(ex, $"无法使用配置文件中指定的导出路径（{ConfigPackPath}）", NotifyLevel.DebugModeOnly) Logger.Warn(ex, $"无法使用配置文件中指定的导出路径（{ConfigPackPath}）")
If MyMsgBox($"指定的路径：{ConfigPackPath}{vbCrLf}{vbCrLf}{ex.GetDetail}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return If MyMsgBox($"指定的路径：{ConfigPackPath}{vbCrLf}{vbCrLf}{ex.GetDisplay(True)}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
End Try End Try
End If End If
If PackPath Is Nothing Then If PackPath Is Nothing Then
Dim Extensions As New List(Of String) Dim Extensions As New List(Of (Extension As String, Display As String))
Extensions.Add("压缩文件(*.zip)|*.zip") Extensions.Add(("zip", "压缩文件"))
If Not CheckOptionsPcl.Checked Then Extensions.Add("Modrinth 整合包文件(*.mrpack)|*.mrpack") If Not CheckOptionsPcl.Checked Then Extensions.Add(("mrpack", "Modrinth 整合包文件"))
PackPath = SelectSaveFile("选择导出位置", PackPath = Dialogs.SaveFile("选择导出位置",
PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), Extensions.Join("|")) PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), filter:=Extensions)
Log($"[Export] 手动指定的导出路径：{PackPath}") Logger.Info($"手动指定的导出路径：{PackPath}")
End If End If
If String.IsNullOrEmpty(PackPath) Then Return If PackPath Is Nothing Then Return
'缓存所需参数 '缓存所需参数
Dim CacheFolder = RequestTaskTempFolder() Dim CacheFolder = RequestTaskTempFolder()
@@ -441,7 +441,7 @@ Public Class PageInstanceExport
Dim IncludePCLCustom As Boolean = IncludePCL AndAlso CheckOptionsPclCustom.Checked Dim IncludePCLCustom As Boolean = IncludePCL AndAlso CheckOptionsPclCustom.Checked
Dim AllRules = StandardizeLines(GetAllRules(), True).ToList() Dim AllRules = StandardizeLines(GetAllRules(), True).ToList()
Dim AllExtraFiles = StandardizeLines(GetExtraFileLines(), False).ToList() Dim AllExtraFiles = StandardizeLines(GetExtraFileLines(), False).ToList()
Log($"[Export] 准备导出整合包，共有 {AllRules.Count} 条规则，{AllExtraFiles.Count} 条追加内容行") Logger.Info($"准备导出整合包，共有 {AllRules.Count} 条规则，{AllExtraFiles.Count} 条追加内容行")
'构造步骤加载器 '构造步骤加载器
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
@@ -452,7 +452,7 @@ Public Class PageInstanceExport
Loaders.Add(New LoaderTask(Of Integer, Integer)("下载 PCL 正式版", Loaders.Add(New LoaderTask(Of Integer, Integer)("下载 PCL 正式版",
Sub(Loader As LoaderTask(Of Integer, Integer)) Sub(Loader As LoaderTask(Of Integer, Integer))
DownloadLatestPCL(Loader) DownloadLatestPCL(Loader)
CopyFile(PathTemp & "Latest.exe", CacheFolder & "Plain Craft Launcher.exe") FileUtils.Copy(PathTemp & "Latest.exe", CacheFolder & "Plain Craft Launcher.exe")
End Sub) With {.ProgressWeight = 0.5, .Block = False}) End Sub) With {.ProgressWeight = 0.5, .Block = False})
End If End If
@@ -460,9 +460,9 @@ Public Class PageInstanceExport
#Region "复制文件" #Region "复制文件"
Loaders.Add(New LoaderTask(Of Integer, List(Of ResourceFile))("复制导出内容", Loaders.Add(New LoaderTask(Of Integer, List(Of LocalResourceFile))("复制导出内容",
Sub(Loader As LoaderTask(Of Integer, List(Of ResourceFile))) Sub(Loader As LoaderTask(Of Integer, List(Of LocalResourceFile)))
Loader.Output = New List(Of ResourceFile) Loader.Output = New List(Of LocalResourceFile)
'复制版本文件 '复制版本文件
Dim Progress As Integer = 0 Dim Progress As Integer = 0
Dim SearchFolder As Action(Of DirectoryInfo) Dim SearchFolder As Action(Of DirectoryInfo)
@@ -471,7 +471,7 @@ Public Class PageInstanceExport
'文件夹：进一步搜索 '文件夹：进一步搜索
For Each SubFolder In Folder.EnumerateDirectories("*", SearchOption.TopDirectoryOnly) For Each SubFolder In Folder.EnumerateDirectories("*", SearchOption.TopDirectoryOnly)
'跳过部分又没用文件又多的文件夹，加快搜索 '跳过部分又没用文件又多的文件夹，加快搜索
If Folder.FullName = PathIndie AndAlso {"assets", "versions", "libraries"}.Contains(SubFolder.Name) Then Continue For If {"assets", "versions", "libraries"}.Contains(SubFolder.Name) AndAlso PathIndie = PathUtils.RemoveExtendedPrefix(Folder.FullName) Then Continue For
If {"structureCacheV1", ".fabric", ".git", "avatar-cache", "cosmetic-cache"}.Contains(SubFolder.Name) Then Continue For If {"structureCacheV1", ".fabric", ".git", "avatar-cache", "cosmetic-cache"}.Contains(SubFolder.Name) Then Continue For
SearchFolder(SubFolder) SearchFolder(SubFolder)
Next Next
@@ -486,12 +486,12 @@ Public Class PageInstanceExport
Next Next
If Not ShouldKeep Then Continue For If Not ShouldKeep Then Continue For
Dim TargetPath As String = OverridesFolder & RelativePath Dim TargetPath As String = OverridesFolder & RelativePath
CopyFile(Entry.FullName, TargetPath) FileUtils.Copy(Entry.FullName, TargetPath)
'若为压缩包，考虑联网获取路径 '若为压缩包，考虑联网获取路径
If CheckHostedAssets AndAlso If CheckHostedAssets AndAlso
{".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.Lower) AndAlso {".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.Lower) AndAlso
{"mods", "packs", "openloader", "resource"}.Any(Function(s) RelativePath.Contains(s)) Then {"mods", "packs", "openloader", "resource"}.Any(Function(s) RelativePath.Contains(s)) Then
Dim ModFile As New ResourceFile(TargetPath) Dim ModFile As New LocalResourceFile(TargetPath)
Dim Unused = ModFile.ModrinthHash '提前计算 Hash Dim Unused = ModFile.ModrinthHash '提前计算 Hash
Unused = ModFile.CurseForgeHash Unused = ModFile.CurseForgeHash
Loader.Output.Add(ModFile) Loader.Output.Add(ModFile)
@@ -504,21 +504,21 @@ Public Class PageInstanceExport
End If End If
Next Next
End Sub End Sub
SearchFolder(New DirectoryInfo(PathIndie)) SearchFolder(DirectoryUtils.GetInfo(PathIndie))
Log($"[Export] 复制 overrides 文件完成，有 {Loader.Output.Count} 个文件需要联网检查") Logger.Info($"复制 overrides 文件完成，有 {Loader.Output.Count} 个文件需要联网检查")
Loader.Progress = 0.95 Loader.Progress = 0.95
'复制追加内容到根目录 '复制追加内容到根目录
Dim BaseFolder As String = If(IncludePCL, CacheFolder, CacheFolder & "modpack\") Dim BaseFolder As String = If(IncludePCL, CacheFolder, CacheFolder & "modpack\")
For Each Line In AllExtraFiles For Each Line In AllExtraFiles
If Line.EndsWithF("\") OrElse Line.EndsWithF("/") Then If Line.EndsWithF("\") OrElse Line.EndsWithF("/") Then
If Directory.Exists(Line) Then If DirectoryUtils.Exists(Line) Then
CopyDirectory(Line, BaseFolder & GetFolderNameFromPath(Line) & "\") DirectoryUtils.Copy(Line, BaseFolder & PathUtils.GetLastPart(Line) & "\")
Else Else
Hint($"未找到配置文件中指定的文件夹：{Line}", HintType.Red) Hint($"未找到配置文件中指定的文件夹：{Line}", HintType.Red)
End If End If
Else Else
If File.Exists(Line) Then If FileUtils.Exists(Line) Then
CopyFile(Line, BaseFolder & GetFileNameFromPath(Line)) FileUtils.Copy(Line, BaseFolder & PathUtils.GetLastPart(Line))
Else Else
Hint($"未找到配置文件中指定的单个文件：{Line}", HintType.Red) Hint($"未找到配置文件中指定的单个文件：{Line}", HintType.Red)
End If End If
@@ -526,19 +526,19 @@ Public Class PageInstanceExport
Next Next
Loader.Progress = 0.97 Loader.Progress = 0.97
'复制 PCL 版本设置 '复制 PCL 版本设置
CopyDirectory(McVersion.PathVersion & "PCL\", OverridesFolder & "PCL\") If DirectoryUtils.Exists(McVersion.PathVersion & "PCL\") Then DirectoryUtils.Copy(McVersion.PathVersion & "PCL\", OverridesFolder & "PCL\")
WriteIni(OverridesFolder & "PCL\Setup.ini", "IsStar", False) WriteIni(OverridesFolder & "PCL\Setup.ini", "IsStar", False)
'复制 PCL 本体（正式版） '复制 PCL 本体（正式版）
If BuildType = BuildTypes.Release AndAlso IncludePCL Then CopyFile(PathExe, CacheFolder & "Plain Craft Launcher.exe") If BuildType = BuildTypes.Release AndAlso IncludePCL Then FileUtils.Copy(PathExe, CacheFolder & "Plain Craft Launcher.exe")
'复制 PCL 个性化内容 '复制 PCL 个性化内容
If IncludePCLCustom Then If IncludePCLCustom Then
If Directory.Exists(PathExeFolder & "PCL\Pictures\") Then CopyDirectory(PathExeFolder & "PCL\Pictures\", CacheFolder & "PCL\Pictures\") If DirectoryUtils.Exists(PathExeFolder & "PCL\Pictures\") Then DirectoryUtils.Copy(PathExeFolder & "PCL\Pictures\", CacheFolder & "PCL\Pictures\")
If Directory.Exists(PathExeFolder & "PCL\Musics\") Then CopyDirectory(PathExeFolder & "PCL\Musics\", CacheFolder & "PCL\Musics\") If DirectoryUtils.Exists(PathExeFolder & "PCL\Musics\") Then DirectoryUtils.Copy(PathExeFolder & "PCL\Musics\", CacheFolder & "PCL\Musics\")
If Directory.Exists(PathExeFolder & "PCL\Help\") Then CopyDirectory(PathExeFolder & "PCL\Help\", CacheFolder & "PCL\Help\") If DirectoryUtils.Exists(PathExeFolder & "PCL\Help\") Then DirectoryUtils.Copy(PathExeFolder & "PCL\Help\", CacheFolder & "PCL\Help\")
If File.Exists(PathExeFolder & "PCL\Custom.xaml") Then CopyFile(PathExeFolder & "PCL\Custom.xaml", CacheFolder & "PCL\Custom.xaml") If FileUtils.Exists(PathExeFolder & "PCL\Custom.xaml") Then FileUtils.Copy(PathExeFolder & "PCL\Custom.xaml", CacheFolder & "PCL\Custom.xaml")
If File.Exists(PathExeFolder & "PCL\Setup.ini") Then CopyFile(PathExeFolder & "PCL\Setup.ini", CacheFolder & "PCL\Setup.ini") If FileUtils.Exists(PathExeFolder & "PCL\Setup.ini") Then FileUtils.Copy(PathExeFolder & "PCL\Setup.ini", CacheFolder & "PCL\Setup.ini")
If File.Exists(PathExeFolder & "PCL\hints.txt") Then CopyFile(PathExeFolder & "PCL\hints.txt", CacheFolder & "PCL\hints.txt") If FileUtils.Exists(PathExeFolder & "PCL\hints.txt") Then FileUtils.Copy(PathExeFolder & "PCL\hints.txt", CacheFolder & "PCL\hints.txt")
If File.Exists(PathExeFolder & "PCL\Logo.png") Then CopyFile(PathExeFolder & "PCL\Logo.png", CacheFolder & "PCL\Logo.png") If FileUtils.Exists(PathExeFolder & "PCL\Logo.png") Then FileUtils.Copy(PathExeFolder & "PCL\Logo.png", CacheFolder & "PCL\Logo.png")
End If End If
End Sub) With {.ProgressWeight = 5}) End Sub) With {.ProgressWeight = 5})
@@ -546,11 +546,11 @@ Public Class PageInstanceExport
#Region "联网检查" #Region "联网检查"
Loaders.Add(New LoaderTask(Of List(Of ResourceFile), Dictionary(Of ResourceFile, List(Of String)))("联网获取文件信息", Loaders.Add(New LoaderTask(Of List(Of LocalResourceFile), Dictionary(Of LocalResourceFile, List(Of String)))("联网获取文件信息",
Sub(Loader As LoaderTask(Of List(Of ResourceFile), Dictionary(Of ResourceFile, List(Of String)))) Sub(Loader As LoaderTask(Of List(Of LocalResourceFile), Dictionary(Of LocalResourceFile, List(Of String))))
Loader.Output = New Dictionary(Of ResourceFile, List(Of String)) Loader.Output = New Dictionary(Of LocalResourceFile, List(Of String))
If Not CheckHostedAssets Then Log($"[Export] 要求跳过联网获取步骤") : Return If Not CheckHostedAssets Then Logger.Info($"要求跳过联网获取步骤") : Return
If Not Loader.Input.Any Then Log($"[Export] 没有需要联网检查的文件，跳过联网获取步骤") : Return If Not Loader.Input.Any Then Logger.Info($"没有需要联网检查的文件，跳过联网获取步骤") : Return
'分平台获取下载地址 '分平台获取下载地址
Dim EndedThreadCount As Integer = 0, FailedExceptions As New List(Of Exception) Dim EndedThreadCount As Integer = 0, FailedExceptions As New List(Of Exception)
@@ -569,9 +569,9 @@ Public Class PageInstanceExport
'写入下载地址 '写入下载地址
Loader.Output.AddIntoValueCollection(ModFile, ModrinthRaw(ModFile.ModrinthHash)("files")(0)("url")) Loader.Output.AddIntoValueCollection(ModFile, ModrinthRaw(ModFile.ModrinthHash)("files")(0)("url"))
Next Next
Log($"[Export] 从 Modrinth 获取到 {ModrinthRaw.Count} 个本地资源项的对应信息") Logger.Info($"从 Modrinth 获取到 {ModrinthRaw.Count} 个本地资源项的对应信息")
Catch ex As Exception Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败") Logger.Warn(ex, "从 Modrinth 获取本地 Mod 信息失败")
FailedExceptions.Add(ex) FailedExceptions.Add(ex)
Finally Finally
EndedThreadCount += 1 EndedThreadCount += 1
@@ -592,16 +592,16 @@ Public Class PageInstanceExport
Dim File As JObject = ResultJson("file") Dim File As JObject = ResultJson("file")
If String.IsNullOrEmpty(File("downloadUrl")) Then Continue For If String.IsNullOrEmpty(File("downloadUrl")) Then Continue For
'查找对应的文件 '查找对应的文件
Dim ModFile As ResourceFile = Loader.Input.FirstOrDefault(Function(m) m.CurseForgeHash = File("fileFingerprint").ToObject(Of UInteger)) Dim ModFile As LocalResourceFile = Loader.Input.FirstOrDefault(Function(m) m.CurseForgeHash = File("fileFingerprint").ToObject(Of UInteger))
If ModFile Is Nothing Then Continue For If ModFile Is Nothing Then Continue For
'写入下载地址 '写入下载地址
For Each Address In ResourceVersion.ParseCurseForgeDownloadUrls(File("downloadUrl").ToString) For Each Address In ResourceVersion.ParseCurseForgeDownloadUrls(File("downloadUrl").ToString)
Loader.Output.AddIntoValueCollection(ModFile, Address) Loader.Output.AddIntoValueCollection(ModFile, Address)
Next Next
Next Next
Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地资源项的对应信息") Logger.Info($"从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地资源项的对应信息")
Catch ex As Exception Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败") Logger.Warn(ex, "从 CurseForge 获取本地 Mod 信息失败")
FailedExceptions.Add(ex) FailedExceptions.Add(ex)
Finally Finally
EndedThreadCount += 1 EndedThreadCount += 1
@@ -633,17 +633,17 @@ Public Class PageInstanceExport
#Region "生成压缩包" #Region "生成压缩包"
Loaders.Add(New LoaderTask(Of Dictionary(Of ResourceFile, List(Of String)), Integer)("生成压缩包", Loaders.Add(New LoaderTask(Of Dictionary(Of LocalResourceFile, List(Of String)), Integer)("生成压缩包",
Sub(Loader As LoaderTask(Of Dictionary(Of ResourceFile, List(Of String)), Integer)) Sub(Loader As LoaderTask(Of Dictionary(Of LocalResourceFile, List(Of String)), Integer))
'整理文件列表 '整理文件列表
Dim Files As New JArray Dim Files As New JArray
For Each Pair In Loader.Input For Each Pair In Loader.Input
Dim ModFile As ResourceFile = Pair.Key Dim ModFile As LocalResourceFile = Pair.Key
Files.Add(New JObject From { Files.Add(New JObject From {
{"path", ModFile.File.FullName.AfterFirst(OverridesFolder).Replace("\", "/")}, {"path", PathUtils.RemoveExtendedPrefix(ModFile.File.FullName).AfterFirst(OverridesFolder).Replace("\", "/")},
{"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.File.FullName)}}}, {"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", HashUtils.ComputeFromFile(ModFile.File.FullName, HashUtils.HashMethod.Sha512)}}},
{"downloads", New JArray(Pair.Value.OrderBy(Function(u) u.Contains("modrinth.com")))}, '不优先选择 Modrinth {"downloads", New JArray(Pair.Value.OrderBy(Function(u) u.Contains("modrinth.com")))}, '不优先选择 Modrinth
{"fileSize", New FileInfo(ModFile.File.FullName).Length} {"fileSize", ModFile.File.Length}
}) })
ModFile.File.Delete() ModFile.File.Delete()
Next Next
@@ -662,25 +662,22 @@ Public Class PageInstanceExport
{"files", Files}, {"files", Files},
{"dependencies", Dependencies} {"dependencies", Dependencies}
} }
File.WriteAllText(CacheFolder & "modpack\modrinth.index.json", ResultJson.ToString(Newtonsoft.Json.Formatting.Indented)) FileUtils.Write(CacheFolder & "modpack\modrinth.index.json", ResultJson.ToString(Newtonsoft.Json.Formatting.Indented))
'打包 '打包
DirectoryUtils.Create(PackPath, isFilePath:=True)
If File.Exists(PackPath) Then File.Delete(PackPath)
If IncludePCL Then If IncludePCL Then
'首次压缩整合包 '首次压缩整合包
ZipFile.CreateFromDirectory(CacheFolder & "modpack\", CacheFolder & "modpack.mrpack") FileUtils.CreateZipFromDirectory(CacheFolder & "modpack.mrpack", CacheFolder & "modpack\")
Loader.Progress = 0.5 Loader.Progress = 0.5
DeleteDirectory(CacheFolder & "modpack\") DirectoryUtils.Delete(CacheFolder & "modpack\")
Loader.Progress = 0.6 Loader.Progress = 0.6
'二次压缩整合包 '二次压缩整合包
ZipFile.CreateFromDirectory(CacheFolder, PackPath) FileUtils.CreateZipFromDirectory(PackPath, CacheFolder)
Loader.Progress = 0.9 Loader.Progress = 0.9
Else Else
'直接压缩整合包 '直接压缩整合包
ZipFile.CreateFromDirectory(CacheFolder & "modpack\", PackPath) FileUtils.CreateZipFromDirectory(PackPath, CacheFolder & "modpack\")
Loader.Progress = 0.8 Loader.Progress = 0.8
End If End If
DeleteDirectory(CacheFolder, True)
OpenExplorer(PackPath) OpenExplorer(PackPath)
End Sub) With {.ProgressWeight = 6}) End Sub) With {.ProgressWeight = 6})
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceLeft.xaml.vb
+1 -1
View File
@@ -65,7 +65,7 @@
PageChangeRun(PageGet(ID)) PageChangeRun(PageGet(ID))
PageID = ID PageID = ID
Catch ex As Exception Catch ex As Exception
Log(ex, "切换分页面失败（ID " & ID & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"切换分页面失败（ID {ID}）")
Finally Finally
AniControlEnabled -= 1 AniControlEnabled -= 1
End Try End Try
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceMod.xaml.vb
+86 -96
View File
@@ -29,7 +29,7 @@
''' </summary> ''' </summary>
Public Sub ReloadModList(Optional ForceReload As Boolean = False) Public Sub ReloadModList(Optional ForceReload As Boolean = False)
If Not LoaderRun(If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then Return If Not LoaderRun(If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then Return
Log("[System] 已刷新 Mod 列表") Logger.Info("已刷新 Mod 列表")
Filter = FilterType.All Filter = FilterType.All
PanBack.ScrollToHome() PanBack.ScrollToHome()
SearchBox.Text = "" SearchBox.Text = ""
@@ -42,10 +42,10 @@
Try Try
ResourceProject.Cache.Clear() ResourceProject.Cache.Clear()
ResourceVersion.ProjectFilesCache.Clear() ResourceVersion.ProjectFilesCache.Clear()
File.Delete(PathTemp & "Cache\LocalMod.json") FileUtils.Delete(PathTemp & "Cache\LocalMod.json")
Log("[Mod] 由于点击刷新按钮，清理本地 Mod 信息缓存") Logger.Info("由于点击刷新按钮，清理本地 Mod 信息缓存")
Catch ex As Exception Catch ex As Exception
Log(ex, "强制刷新时清理本地 Mod 信息缓存失败") Logger.Warn(ex, "强制刷新时清理本地 Mod 信息缓存失败")
End Try End Try
If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.ReloadModList(True) '无需 Else，还没加载刷个鬼的新 If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.ReloadModList(True) '无需 Else，还没加载刷个鬼的新
FrmInstanceLeft.ItemMod.Checked = True FrmInstanceLeft.ItemMod.Checked = True
@@ -53,15 +53,13 @@
End Sub End Sub
Private Sub LoaderInit() Handles Me.Initialized Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanAllBack, Nothing, McModLoader, AddressOf LoadUIFromLoaderOutput, AutoRun:=False) PageLoaderInit(Load, PanLoad, PanAllBack, Nothing, LocalResourceLoader, AddressOf LoadUIFromLoaderOutput, AutoRun:=False)
End Sub End Sub
Private Sub Load_Click(sender As Object, e As MouseButtonEventArgs) Handles Load.Click Private Sub Load_Click(sender As Object, e As MouseButtonEventArgs) Handles Load.Click
If McModLoader.State = LoadState.Failed Then If LocalResourceLoader.State = LoadState.Failed Then LoaderRun(LoaderFolderRunType.ForceRun)
LoaderRun(LoaderFolderRunType.ForceRun)
End If
End Sub End Sub
Public Function LoaderRun(Type As LoaderFolderRunType) As Boolean Public Function LoaderRun(Type As LoaderFolderRunType) As Boolean
Return LoaderFolderRun(McModLoader, PageInstanceLeft.Instance.PathIndie & "mods\", Type) Return LoaderFolderRun(LocalResourceLoader, PageInstanceLeft.Instance.PathIndie & "mods\", Type)
End Function End Function
#End Region #End Region
@@ -78,7 +76,7 @@
Private Sub LoadUIFromLoaderOutput() Private Sub LoadUIFromLoaderOutput()
Try Try
'判断应该显示哪一个页面 '判断应该显示哪一个页面
If McModLoader.Output.Any() Then If LocalResourceLoader.Output.Any() Then
PanBack.Visibility = Visibility.Visible PanBack.Visibility = Visibility.Visible
PanEmpty.Visibility = Visibility.Collapsed PanEmpty.Visibility = Visibility.Collapsed
Else Else
@@ -88,7 +86,7 @@
End If End If
'修改缓存 '修改缓存
ModItems.Clear() ModItems.Clear()
For Each ModEntity As ResourceFile In McModLoader.Output For Each ModEntity As LocalResourceFile In LocalResourceLoader.Output
ModItems(ModEntity.EnabledName) = McModListItem(ModEntity) ModItems(ModEntity.EnabledName) = McModListItem(ModEntity)
Next Next
'显示结果 '显示结果
@@ -96,10 +94,10 @@
SearchBox.Text = "" '这会触发结果刷新，所以需要在 ModItems 更新之后，详见 #3124 的视频 SearchBox.Text = "" '这会触发结果刷新，所以需要在 ModItems 更新之后，详见 #3124 的视频
RefreshUI() RefreshUI()
Catch ex As Exception Catch ex As Exception
Log(ex, "加载 Mod 列表 UI 失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "加载 Mod 列表 UI 失败")
End Try End Try
End Sub End Sub
Private Function McModListItem(Entry As ResourceFile) As MyLocalModItem Private Function McModListItem(Entry As LocalResourceFile) As MyLocalModItem
AniControlEnabled += 1 AniControlEnabled += 1
Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry, Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry,
.ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.EnabledName)} .ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.EnabledName)}
@@ -145,7 +143,7 @@
''' </summary> ''' </summary>
Public Sub RefreshUI() Public Sub RefreshUI()
If PanList Is Nothing Then Return If PanList Is Nothing Then Return
Dim ShowingMods = If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of ResourceFile))).Where(Function(m) CanPassFilter(m)).ToList Dim ShowingMods = If(IsSearching, SearchResult, If(LocalResourceLoader.Output, New List(Of LocalResourceFile))).Where(Function(m) CanPassFilter(m)).ToList
'重新列出列表 '重新列出列表
AniControlEnabled += 1 AniControlEnabled += 1
If ShowingMods.Any() Then If ShowingMods.Any() Then
@@ -178,7 +176,7 @@
Dim AnyCount As Integer = 0 Dim AnyCount As Integer = 0
Dim EnabledCount As Integer = 0 Dim EnabledCount As Integer = 0
Dim UpdateCount As Integer = 0 Dim UpdateCount As Integer = 0
For Each ModItem In If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of ResourceFile))) For Each ModItem In If(IsSearching, SearchResult, If(LocalResourceLoader.Output, New List(Of LocalResourceFile)))
AnyCount += 1 AnyCount += 1
If ModItem.HasUpdate Then UpdateCount += 1 If ModItem.HasUpdate Then UpdateCount += 1
If ModItem.IsEnabled Then EnabledCount += 1 If ModItem.IsEnabled Then EnabledCount += 1
@@ -206,7 +204,7 @@
Dim HasUpdate As Boolean = False Dim HasUpdate As Boolean = False
Dim HasEnabled As Boolean = False Dim HasEnabled As Boolean = False
Dim HasDisabled As Boolean = False Dim HasDisabled As Boolean = False
For Each ModEntity In McModLoader.Output For Each ModEntity In LocalResourceLoader.Output
If Not SelectedMods.Contains(ModEntity.EnabledName) Then Continue For If Not SelectedMods.Contains(ModEntity.EnabledName) Then Continue For
If ModEntity.HasUpdate Then HasUpdate = True If ModEntity.HasUpdate Then HasUpdate = True
If ModEntity.IsEnabled Then HasEnabled = True If ModEntity.IsEnabled Then HasEnabled = True
@@ -274,7 +272,7 @@
DirectoryUtils.Create(PageInstanceLeft.Instance.PathIndie & "mods\") DirectoryUtils.Create(PageInstanceLeft.Instance.PathIndie & "mods\")
OpenExplorer(PageInstanceLeft.Instance.PathIndie & "mods\") OpenExplorer(PageInstanceLeft.Instance.PathIndie & "mods\")
Catch ex As Exception Catch ex As Exception
Log(ex, "打开 Mods 文件夹失败", NotifyLevel.MsgBox) Logger.Error(ex, "打开 Mods 文件夹失败", LogBehavior.Alert)
End Try End Try
End Sub End Sub
@@ -289,7 +287,7 @@
''' 安装 Mod。 ''' 安装 Mod。
''' </summary> ''' </summary>
Private Sub BtnManageInstall_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageInstall.Click, BtnHintInstall.Click Private Sub BtnManageInstall_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageInstall.Click, BtnHintInstall.Click
Dim FileList = SelectFiles("Mod 文件(*.jar;*.litemod;*.disabled;*.old)|*.jar;*.litemod;*.disabled;*.old", "选择要安装的 Mod") Dim FileList = Dialogs.SelectFile("选择要安装的 Mod", True, filter:={({"jar", "litemod", "disabled", "old"}, "Mod 文件")})
If Not FileList.Any Then Return If Not FileList.Any Then Return
InstallMods(FileList) InstallMods(FileList)
End Sub End Sub
@@ -301,7 +299,7 @@
Dim Extension As String = FilePathList.First.AfterLast(".").Lower Dim Extension As String = FilePathList.First.AfterLast(".").Lower
'检查文件扩展名 '检查文件扩展名
If Not {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then Return False If Not {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then Return False
Log("[System] 文件为 jar/litemod 格式，尝试作为 Mod 安装") Logger.Info("文件为 jar/litemod 格式，尝试作为 Mod 安装")
'检查回收站：回收站中的文件有错误的文件名 '检查回收站：回收站中的文件有错误的文件名
If FilePathList.First.Contains(":\$RECYCLE.BIN\") Then If FilePathList.First.Contains(":\$RECYCLE.BIN\") Then
Hint("请先将文件从回收站还原，再尝试安装！", HintType.Red) Hint("请先将文件从回收站还原，再尝试安装！", HintType.Red)
@@ -321,21 +319,21 @@
Install: Install:
Try Try
For Each ModFile In FilePathList For Each ModFile In FilePathList
Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "").Replace(".old", "") Dim NewFileName = PathUtils.GetLastPart(ModFile).Replace(".disabled", "").Replace(".old", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227 If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, Instance.PathIndie & "mods\" & NewFileName) FileUtils.Copy(ModFile, Instance.PathIndie & "mods\" & NewFileName)
Next Next
If FilePathList.IsSingle Then If FilePathList.IsSingle Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}！", HintType.Green) Hint($"已安装 {PathUtils.GetLastPart(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}！", HintType.Green)
Else Else
Hint($"已安装 {FilePathList.Count} 个 Mod！", HintType.Green) Hint($"已安装 {FilePathList.Count} 个 Mod！", HintType.Green)
End If End If
'刷新列表 '刷新列表
If FrmMain.PageCurrent = FormMain.PageType.InstanceSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.InstanceMod Then If FrmMain.PageCurrent = FormMain.PageType.InstanceSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.InstanceMod Then
LoaderFolderRun(McModLoader, Instance.PathIndie & "mods\", LoaderFolderRunType.ForceRun) LoaderFolderRun(LocalResourceLoader, Instance.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "复制 Mod 文件失败", NotifyLevel.MsgBox) Logger.Error(ex, "复制 Mod 文件失败", LogBehavior.Alert)
End Try End Try
End If End If
Return True Return True
@@ -435,7 +433,7 @@ Install:
''' <summary> ''' <summary>
''' 检查该 Mod 项是否符合当前筛选的类别。 ''' 检查该 Mod 项是否符合当前筛选的类别。
''' </summary> ''' </summary>
Private Function CanPassFilter(CheckingMod As ResourceFile) As Boolean Private Function CanPassFilter(CheckingMod As LocalResourceFile) As Boolean
Select Case Filter Select Case Filter
Case FilterType.All Case FilterType.All
Return True Return True
@@ -462,18 +460,18 @@ Install:
'启用 / 禁用 '启用 / 禁用
Private Sub BtnSelectED_Click(sender As MyIconTextButton, e As RouteEventArgs) Handles BtnSelectEnable.Click, BtnSelectDisable.Click Private Sub BtnSelectED_Click(sender As MyIconTextButton, e As RouteEventArgs) Handles BtnSelectEnable.Click, BtnSelectDisable.Click
EDMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName)), EDMods(LocalResourceLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName)),
Not sender.Equals(BtnSelectDisable)) Not sender.Equals(BtnSelectDisable))
ChangeAllSelected(False) ChangeAllSelected(False)
End Sub End Sub
Private Sub EDMods(ModList As IEnumerable(Of ResourceFile), IsEnable As Boolean) Private Sub EDMods(ModList As IEnumerable(Of LocalResourceFile), IsEnable As Boolean)
Dim IsSuccessful As Boolean = True Dim IsSuccessful As Boolean = True
For Each ModE In ModList.ToList For Each ModE In ModList.ToList
Dim ModEntity = ModE '仅用于去除迭代变量无法修改的限制 Dim ModEntity = ModE '仅用于去除迭代变量无法修改的限制
Dim NewPath As String = Nothing Dim NewPath As String = Nothing
If ModEntity.IsEnabled AndAlso Not IsEnable Then If ModEntity.IsEnabled AndAlso Not IsEnable Then
'禁用 '禁用
NewPath = ModEntity.File.FullName & If(File.Exists(ModEntity.File.FullName & ".old"), ".old", ".disabled") NewPath = PathUtils.RemoveExtendedPrefix(ModEntity.File.FullName) & If(FileUtils.Exists(ModEntity.File.FullName & ".old"), ".old", ".disabled")
ElseIf Not ModEntity.IsEnabled AndAlso IsEnable Then ElseIf Not ModEntity.IsEnabled AndAlso IsEnable Then
'启用 '启用
NewPath = ModEntity.EnabledFullName NewPath = ModEntity.EnabledFullName
@@ -482,36 +480,36 @@ Install:
End If End If
'重命名 '重命名
Try Try
If File.Exists(NewPath) Then If FileUtils.Exists(NewPath) Then
If File.Exists(ModEntity.File.FullName) Then If FileUtils.Exists(ModEntity.File.FullName) Then
'同时存在两个名称的 Mod '同时存在两个名称的 Mod
If GetFileMD5(ModEntity.File.FullName) <> GetFileMD5(NewPath) Then If HashUtils.ComputeFromFile(ModEntity.File.FullName, HashUtils.HashMethod.Md5) <> HashUtils.ComputeFromFile(NewPath, HashUtils.HashMethod.Md5) Then
MyMsgBox($"目前同时存在启用和禁用的两个 Mod 文件：{vbCrLf} - {NewPath}{vbCrLf} - {ModEntity.File.FullName}{vbCrLf}{vbCrLf}注意，这两个文件的内容并不相同。{vbCrLf}在手动删除或重命名其中一个文件后，才能继续操作。", "存在文件冲突") MyMsgBox($"目前同时存在启用和禁用的两个 Mod 文件：{vbCrLf} - {PathUtils.GetLastPart(NewPath)}{vbCrLf} - {ModEntity.File.Name}{vbCrLf}{vbCrLf}注意，这两个文件的内容并不相同。{vbCrLf}在手动删除或重命名其中一个文件后，才能继续操作。", "存在文件冲突")
Continue For Continue For
End If End If
Else Else
'已经重命名过了 '已经重命名过了
Log("[Mod] Mod 的状态已被切换", NotifyLevel.DebugModeOnly) Logger.Warn("Mod 的状态已被切换")
Continue For Continue For
End If End If
End If End If
File.Delete(NewPath) FileUtils.Delete(NewPath)
File.Move(ModEntity.File.FullName, NewPath) FileUtils.Move(ModEntity.File.FullName, NewPath)
Catch ex As FileNotFoundException Catch ex As FileNotFoundException
Log(ex, $"未找到需要重命名的 Mod（{If(ModEntity.File.FullName, "null")}）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"未找到需要重命名的 Mod（{If(ModEntity.File.FullName, "null")}）")
ReloadModList(True) ReloadModList(True)
Return Return
Catch ex As Exception Catch ex As Exception
Log(ex, $"重命名 Mod 失败（{If(ModEntity.File.FullName, "null")}）") Logger.Warn(ex, $"重命名 Mod 失败（{If(ModEntity.File.FullName, "null")}）")
IsSuccessful = False IsSuccessful = False
End Try End Try
'更改 Loader 中的列表 '更改 Loader 中的列表
Dim NewModEntity As New ResourceFile(NewPath) Dim NewModEntity As New LocalResourceFile(NewPath)
NewModEntity.FromJson(ModEntity.ToJson) NewModEntity.FromJson(ModEntity.ToJson)
If McModLoader.Output.Contains(ModEntity) Then If LocalResourceLoader.Output.Contains(ModEntity) Then
Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity) Dim IndexOfLoader As Integer = LocalResourceLoader.Output.IndexOf(ModEntity)
McModLoader.Output.RemoveAt(IndexOfLoader) LocalResourceLoader.Output.RemoveAt(IndexOfLoader)
McModLoader.Output.Insert(IndexOfLoader, NewModEntity) LocalResourceLoader.Output.Insert(IndexOfLoader, NewModEntity)
End If End If
If SearchResult IsNot Nothing AndAlso SearchResult.Contains(ModEntity) Then '#4862 If SearchResult IsNot Nothing AndAlso SearchResult.Contains(ModEntity) Then '#4862
Dim IndexOfResult As Integer = SearchResult.IndexOf(ModEntity) Dim IndexOfResult As Integer = SearchResult.IndexOf(ModEntity)
@@ -538,7 +536,7 @@ Install:
'更新 '更新
Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click
Dim UpdateList As List(Of ResourceFile) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName) AndAlso m.HasUpdate).ToList() Dim UpdateList As List(Of LocalResourceFile) = LocalResourceLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName) AndAlso m.HasUpdate).ToList()
If Not UpdateList.Any() Then Return If Not UpdateList.Any() Then Return
UpdateMods(UpdateList) UpdateMods(UpdateList)
ChangeAllSelected(False) ChangeAllSelected(False)
@@ -547,9 +545,9 @@ Install:
''' 记录正在进行 Mod 更新的 mods 文件夹路径。 ''' 记录正在进行 Mod 更新的 mods 文件夹路径。
''' </summary> ''' </summary>
Public Shared UpdatingInstanceModFolders As New List(Of String) Public Shared UpdatingInstanceModFolders As New List(Of String)
Public Sub UpdateMods(ModList As IEnumerable(Of ResourceFile)) Public Sub UpdateMods(ModList As IEnumerable(Of LocalResourceFile))
'更新前警告 '更新前警告
If Not Settings.Get("HintUpdateMod") OrElse ModList.Count >= 15 Then If Not Settings.Get(Of Boolean)("HintUpdateMod") OrElse ModList.Count >= 15 Then
If MyMsgBox($"新版本 Mod 可能不兼容旧存档或者其他 Mod，这可能导致游戏崩溃，甚至永久损坏存档！{vbCrLf}如果你在游玩整合包，请千万不要自行更新 Mod！{vbCrLf}{vbCrLf}在更新前，请先备份存档，并检查 Mod 的更新日志。{vbCrLf}如果更新后出现问题，你也可以在回收站找回更新前的 Mod。", "Mod 更新警告", "我已了解风险，继续更新", "取消", IsWarn:=True) = 1 Then If MyMsgBox($"新版本 Mod 可能不兼容旧存档或者其他 Mod，这可能导致游戏崩溃，甚至永久损坏存档！{vbCrLf}如果你在游玩整合包，请千万不要自行更新 Mod！{vbCrLf}{vbCrLf}在更新前，请先备份存档，并检查 Mod 的更新日志。{vbCrLf}如果更新后出现问题，你也可以在回收站找回更新前的 Mod。", "Mod 更新警告", "我已了解风险，继续更新", "取消", IsWarn:=True) = 1 Then
Settings.Set("HintUpdateMod", True) Settings.Set("HintUpdateMod", True)
Else Else
@@ -561,7 +559,7 @@ Install:
ModList = ModList.ToList() '防止刷新影响迭代器 ModList = ModList.ToList() '防止刷新影响迭代器
Dim FileList As New List(Of NetFile) Dim FileList As New List(Of NetFile)
Dim FileCopyList As New Dictionary(Of String, String) Dim FileCopyList As New Dictionary(Of String, String)
For Each Entry As ResourceFile In ModList For Each Entry As LocalResourceFile In ModList
Dim File As ResourceVersion = Entry.UpdateFile Dim File As ResourceVersion = Entry.UpdateFile
If Not File.DownloadAvailable Then Continue For If Not File.DownloadAvailable Then Continue For
'确认更新后的文件名 '确认更新后的文件名
@@ -590,8 +588,8 @@ Install:
End If End If
'添加到下载列表 '添加到下载列表
Dim TempAddress As String = PathTemp & "mods\" & Entry.File.Name.Replace(CurrentReplaceName, NewestReplaceName) '需要下载到 mods 文件夹，以便重复文件检查时识别 Dim TempAddress As String = PathTemp & "mods\" & Entry.File.Name.Replace(CurrentReplaceName, NewestReplaceName) '需要下载到 mods 文件夹，以便重复文件检查时识别
Dim RealAddress As String = GetPathFromFullPath(Entry.File.FullName) & Entry.File.Name.Replace(CurrentReplaceName, NewestReplaceName) Dim RealAddress As String = Path.Combine(PathUtils.RemoveLastPart(Entry.File.FullName), Entry.File.Name.Replace(CurrentReplaceName, NewestReplaceName))
FileList.Add(File.ToNetFile(TempAddress)) FileList.Add(File.ToNetFile(TempAddress, ResourceVersion.DownloadReason.Update, PageInstanceLeft.Instance.Version.VanillaName, PageInstanceLeft.Instance.Version.ModLoaders))
FileCopyList(TempAddress) = RealAddress FileCopyList(TempAddress) = RealAddress
Next Next
'构造加载器 '构造加载器
@@ -601,31 +599,31 @@ Install:
InstallLoaders.Add(New LoaderTask(Of Integer, Integer)("替换旧版 Mod 文件", InstallLoaders.Add(New LoaderTask(Of Integer, Integer)("替换旧版 Mod 文件",
Sub() Sub()
Try Try
For Each Entry As ResourceFile In ModList For Each Entry As LocalResourceFile In ModList
If File.Exists(Entry.File.FullName) Then If FileUtils.Exists(Entry.File.FullName) Then
My.Computer.FileSystem.DeleteFile(Entry.File.FullName, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin) FileUtils.Delete(Entry.File.FullName, True)
Else Else
Log($"[Mod] 未找到更新前的 Mod 文件，跳过对它的删除：{Entry.File.FullName}", NotifyLevel.DebugModeOnly) Logger.Warn($"未找到更新前的 Mod 文件，跳过对它的删除：{Entry.File.FullName}")
End If End If
Next Next
For Each Entry As KeyValuePair(Of String, String) In FileCopyList For Each Entry As KeyValuePair(Of String, String) In FileCopyList
If File.Exists(Entry.Value) Then If FileUtils.Exists(Entry.Value) Then
My.Computer.FileSystem.DeleteFile(Entry.Value, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin) FileUtils.Delete(Entry.Value, True)
Log($"[Mod] 更新后的 Mod 文件已存在，将会把它放入回收站：{Entry.Value}", NotifyLevel.DebugModeOnly) Logger.Warn($"更新后的 Mod 文件已存在，将会把它放入回收站：{Entry.Value}")
End If End If
If Directory.Exists(GetPathFromFullPath(Entry.Value)) Then If DirectoryUtils.Exists(PathUtils.RemoveLastPart(Entry.Value)) Then
File.Move(Entry.Key, Entry.Value) FileUtils.Move(Entry.Key, Entry.Value)
FinishedFileNames.Add(GetFileNameFromPath(Entry.Value)) FinishedFileNames.Add(PathUtils.GetLastPart(Entry.Value))
Else Else
Log($"[Mod] 更新后的目标文件夹已被删除：{Entry.Value}", NotifyLevel.DebugModeOnly) Logger.Warn($"更新后的目标文件夹已被删除：{Entry.Value}")
End If End If
Next Next
Catch ex As OperationCanceledException Catch ex As OperationCanceledException
Log(ex, "替换旧版 Mod 文件时被主动取消") Logger.Warn(ex, "替换旧版 Mod 文件时被主动取消")
End Try End Try
End Sub)) End Sub))
'结束处理 '结束处理
Dim Loader As New LoaderCombo(Of IEnumerable(Of ResourceFile))("Mod 更新：" & PageInstanceLeft.Instance.Name, InstallLoaders) Dim Loader As New LoaderCombo(Of IEnumerable(Of LocalResourceFile))("Mod 更新：" & PageInstanceLeft.Instance.Name, InstallLoaders)
Dim PathMods As String = PageInstanceLeft.Instance.PathIndie & "mods\" Dim PathMods As String = PageInstanceLeft.Instance.PathIndie & "mods\"
Loader.OnStateChanged = Loader.OnStateChanged =
Sub() Sub()
@@ -634,35 +632,35 @@ Install:
Case LoadState.Finished Case LoadState.Finished
Select Case FinishedFileNames.Count Select Case FinishedFileNames.Count
Case 0 '一般是由于 Mod 文件被占用，然后玩家主动取消 Case 0 '一般是由于 Mod 文件被占用，然后玩家主动取消
Log($"[Mod] 没有 Mod 被成功更新") Logger.Info($"没有 Mod 被成功更新")
Case 1 Case 1
Hint($"已成功更新 {FinishedFileNames.Single}！", HintType.Green) Hint($"已成功更新 {FinishedFileNames.Single}！", HintType.Green)
Case Else Case Else
Hint($"已成功更新 {FinishedFileNames.Count} 个 Mod！", HintType.Green) Hint($"已成功更新 {FinishedFileNames.Count} 个 Mod！", HintType.Green)
End Select End Select
Case LoadState.Failed Case LoadState.Failed
Hint("Mod 更新失败：" & Loader.Error.GetBrief(), HintType.Red) Hint("Mod 更新失败：" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted Case LoadState.Interrupted
Hint("Mod 更新已中止！", HintType.Blue) Hint("Mod 更新已中止！", HintType.Blue)
Case Else Case Else
Return Return
End Select End Select
Log($"[Mod] 已从正在进行 Mod 更新的文件夹列表移除：{PathMods}") Logger.Info($"已从正在进行 Mod 更新的文件夹列表移除：{PathMods}")
UpdatingInstanceModFolders.Remove(PathMods) UpdatingInstanceModFolders.Remove(PathMods)
'清理缓存 '清理缓存
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
For Each TempFile In FileCopyList.Keys For Each TempFile In FileCopyList.Keys
If File.Exists(TempFile) Then File.Delete(TempFile) FileUtils.Delete(TempFile)
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "清理 Mod 更新缓存失败") Logger.Warn(ex, "清理 Mod 更新缓存失败")
End Try End Try
End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal) End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal)
End Sub End Sub
'启动加载器 '启动加载器
Log($"[Mod] 开始更新 {ModList.Count} 个 Mod：{PathMods}") Logger.Info($"开始更新 {ModList.Count} 个 Mod：{PathMods}")
UpdatingInstanceModFolders.Add(PathMods) UpdatingInstanceModFolders.Add(PathMods)
Loader.Start() Loader.Start()
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
@@ -670,49 +668,45 @@ Install:
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
ReloadModList(True) ReloadModList(True)
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化 Mod 更新失败") Logger.Warn(ex, "初始化 Mod 更新失败")
End Try End Try
End Sub End Sub
'删除 '删除
Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click
DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName))) DeleteMods(LocalResourceLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName)))
ChangeAllSelected(False) ChangeAllSelected(False)
End Sub End Sub
Private Sub DeleteMods(ModList As IEnumerable(Of ResourceFile)) Private Sub DeleteMods(ModsToDelete As IEnumerable(Of LocalResourceFile))
Try Try
Dim IsSuccessful As Boolean = True Dim IsSuccessful As Boolean = True
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
'确认需要删除的文件 '确认需要删除的文件
ModList = ModList.SelectMany( Dim ModList = ModsToDelete.SelectMany(
Function(Target As ResourceFile) Function(Target As LocalResourceFile)
If Target.IsEnabled Then If Target.IsEnabled Then
Return {Target.File.FullName, Target.File.FullName & If(File.Exists(Target.File.FullName & ".old"), ".old", ".disabled")} Return {Target.File.FullName, Target.File.FullName & If(FileUtils.Exists(Target.File.FullName & ".old"), ".old", ".disabled")}
Else Else
Return {Target.File.FullName, Target.EnabledFullName} Return {Target.File.FullName, Target.EnabledFullName}
End If End If
End Function).Distinct.Where(Function(m) File.Exists(m)).Select(Function(m) New ResourceFile(m)).ToList() End Function).Distinct.Where(Function(m) FileUtils.Exists(m)).Select(Function(m) New LocalResourceFile(m)).ToList()
'实际删除文件 '实际删除文件
For Each ModEntity In ModList For Each ModEntity In ModList
'删除 '删除
Try Try
If IsShiftPressed Then FileUtils.Delete(ModEntity.File.FullName, Not IsShiftPressed)
ModEntity.File.Delete()
Else
My.Computer.FileSystem.DeleteFile(ModEntity.File.FullName, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
Catch ex As OperationCanceledException Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消") Logger.Warn(ex, "删除 Mod 被主动取消")
ReloadModList(True) ReloadModList(True)
Return Return
Catch ex As Exception Catch ex As Exception
Log(ex, $"删除 Mod 失败（{ModEntity.File.FullName}）", NotifyLevel.MsgBox) Logger.Error(ex, $"删除 Mod 失败（{ModEntity.File.FullName}）", LogBehavior.Alert)
IsSuccessful = False IsSuccessful = False
End Try End Try
'取消选中 '取消选中
SelectedMods.Remove(ModEntity.EnabledName) SelectedMods.Remove(ModEntity.EnabledName)
'更改 Loader 和 UI 中的列表 '更改 Loader 和 UI 中的列表
McModLoader.Output.Remove(ModEntity) LocalResourceLoader.Output.Remove(ModEntity)
SearchResult?.Remove(ModEntity) SearchResult?.Remove(ModEntity)
ModItems.Remove(ModEntity.EnabledName) ModItems.Remove(ModEntity.EnabledName)
Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry.Equals(ModEntity))) Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry.Equals(ModEntity)))
@@ -743,10 +737,10 @@ Install:
End If End If
End If End If
Catch ex As OperationCanceledException Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消") Logger.Warn(ex, "删除 Mod 被主动取消")
ReloadModList(True) ReloadModList(True)
Catch ex As Exception Catch ex As Exception
Log(ex, "删除 Mod 出现未知错误", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "删除 Mod 出现未知错误")
ReloadModList(True) ReloadModList(True)
End Try End Try
LoaderRun(LoaderFolderRunType.UpdateOnly) LoaderRun(LoaderFolderRunType.UpdateOnly)
@@ -765,16 +759,12 @@ Install:
Public Sub Info_Click(sender As Object, e As EventArgs) Public Sub Info_Click(sender As Object, e As EventArgs)
Try Try
Dim ModEntry As ResourceFile = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry Dim ModEntry As LocalResourceFile = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry
'加载失败信息 '加载失败信息
If ModEntry.Project IsNot Nothing Then If ModEntry.Project IsNot Nothing Then
'跳转到 Mod 下载页面 '跳转到 Mod 下载页面
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.ResourceDetail, FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.ResourceDetail,
.Additional = {ModEntry.Project, New List(Of String), PageInstanceLeft.Instance.Version.VanillaName, .Additional = {ModEntry.Project, New List(Of String), PageInstanceLeft.Instance.Version.VanillaName, PageInstanceLeft.Instance.Version.ModLoaders, ResourceTypes.Mod}})
If(PageInstanceLeft.Instance.Version.HasForge, ModLoaderTypes.Forge,
If(PageInstanceLeft.Instance.Version.HasNeoForge, ModLoaderTypes.NeoForge,
If(PageInstanceLeft.Instance.Version.HasFabric, ModLoaderTypes.Fabric, ModLoaderTypes.Any))),
ResourceTypes.Mod}})
Else Else
'获取信息 '获取信息
Dim ContentLines As New List(Of String) Dim ContentLines As New List(Of String)
@@ -805,7 +795,7 @@ Install:
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "获取 Mod 详情失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "获取 Mod 详情失败")
End Try End Try
End Sub End Sub
'打开文件所在的位置 '打开文件所在的位置
@@ -814,7 +804,7 @@ Install:
Dim ListItem As MyLocalModItem = sender.Tag Dim ListItem As MyLocalModItem = sender.Tag
OpenExplorer(ListItem.Entry.File.FullName) OpenExplorer(ListItem.Entry.File.FullName)
Catch ex As Exception Catch ex As Exception
Log(ex, "打开 Mod 文件位置失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "打开 Mod 文件位置失败")
End Try End Try
End Sub End Sub
'删除 '删除
@@ -837,12 +827,12 @@ Install:
Return Not String.IsNullOrWhiteSpace(SearchBox.Text) Return Not String.IsNullOrWhiteSpace(SearchBox.Text)
End Get End Get
End Property End Property
Private SearchResult As List(Of ResourceFile) Private SearchResult As List(Of LocalResourceFile)
Public Sub SearchRun() Handles SearchBox.TextChanged Public Sub SearchRun() Handles SearchBox.TextChanged
If IsSearching Then If IsSearching Then
'构造请求 '构造请求
Dim QueryList As New List(Of SearchEntry(Of ResourceFile)) Dim QueryList As New List(Of SearchEntry(Of LocalResourceFile))
For Each Entry As ResourceFile In McModLoader.Output For Each Entry As LocalResourceFile In LocalResourceLoader.Output
Dim SearchSources As New List(Of SearchSource) Dim SearchSources As New List(Of SearchSource)
SearchSources.Add(New SearchSource(Entry.Display, 1)) SearchSources.Add(New SearchSource(Entry.Display, 1))
SearchSources.Add(New SearchSource(Entry.File.Name, 1)) SearchSources.Add(New SearchSource(Entry.File.Name, 1))
@@ -858,7 +848,7 @@ Install:
If Entry.Project.Description <> Entry.Description Then SearchSources.Add(New SearchSource(Entry.Project.Description, 0.4)) If Entry.Project.Description <> Entry.Description Then SearchSources.Add(New SearchSource(Entry.Project.Description, 0.4))
SearchSources.Add(New SearchSource(String.Join("", Entry.Project.Tags), 0.2)) SearchSources.Add(New SearchSource(String.Join("", Entry.Project.Tags), 0.2))
End If End If
QueryList.Add(New SearchEntry(Of ResourceFile) With {.Item = Entry, .SearchSource = SearchSources}) QueryList.Add(New SearchEntry(Of LocalResourceFile) With {.Item = Entry, .SearchSource = SearchSources})
Next Next
'进行搜索 '进行搜索
SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35).Select(Function(r) r.Item).ToList SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35).Select(Function(r) r.Item).ToList
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceModDisabled.xaml.vb
+1 -1
View File
@@ -9,7 +9,7 @@
End Sub End Sub
Public Sub BtnDownload_Loaded() Handles BtnDownload.Loaded Public Sub BtnDownload_Loaded() Handles BtnDownload.Loaded
Dim NewVisibility = If((Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse If(FrmSelectRight Is Nothing, False, FrmSelectRight.ShowHidden), Visibility.Collapsed, Visibility.Visible) Dim NewVisibility = If((Settings.Get(Of Boolean)("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse If(FrmSelectRight Is Nothing, False, FrmSelectRight.ShowHidden), Visibility.Collapsed, Visibility.Visible)
If BtnDownload.Visibility <> NewVisibility Then If BtnDownload.Visibility <> NewVisibility Then
BtnDownload.Visibility = NewVisibility BtnDownload.Visibility = NewVisibility
PanMain.TriggerForceResize() PanMain.TriggerForceResize()
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceOverall.xaml.vb
+33 -60
View File
@@ -65,13 +65,13 @@
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存 WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "修改版本分类失败（" & PageInstanceLeft.Instance.Name & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"修改版本分类失败（{PageInstanceLeft.Instance.Name}）")
End Try End Try
Reload() '更新 “打开 Mod 文件夹” 按钮 Reload() '更新 “打开 Mod 文件夹” 按钮
Else Else
'改为隐藏 '改为隐藏
Try Try
If Not Settings.Get("HintHide") Then If Not Settings.Get(Of Boolean)("HintHide") Then
If MyMsgBox("确认要从版本列表中隐藏该版本吗？隐藏该版本后，它将不再出现于 PCL 显示的版本列表中。" & vbCrLf & "此后，在版本列表页面按下 F11 才可以查看被隐藏的版本。", "隐藏版本提示",, "取消") <> 1 Then If MyMsgBox("确认要从版本列表中隐藏该版本吗？隐藏该版本后，它将不再出现于 PCL 显示的版本列表中。" & vbCrLf & "此后，在版本列表页面按下 F11 才可以查看被隐藏的版本。", "隐藏版本提示",, "取消") <> 1 Then
ComboDisplayType.SelectedIndex = 0 ComboDisplayType.SelectedIndex = 0
Return Return
@@ -82,7 +82,7 @@
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存 WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "隐藏版本 " & PageInstanceLeft.Instance.Name & " 失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"隐藏版本 {PageInstanceLeft.Instance.Name} 失败")
End Try End Try
End If End If
End Sub End Sub
@@ -97,7 +97,7 @@
Reload() Reload()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 描述更改失败", NotifyLevel.MsgBox) Logger.Error(ex, $"版本 {PageInstanceLeft.Instance.Name} 描述更改失败", LogBehavior.Alert)
End Try End Try
End Sub End Sub
@@ -109,51 +109,29 @@
Dim OldPath As String = PageInstanceLeft.Instance.PathVersion Dim OldPath As String = PageInstanceLeft.Instance.PathVersion
'修改此部分的同时修改快速安装的版本名检测* '修改此部分的同时修改快速安装的版本名检测*
Dim NewName As String = MyMsgBoxInput("重命名版本", "", OldName, New ObjectModel.Collection(Of Validate) From { Dim NewName As String = MyMsgBoxInput("重命名版本", "", OldName, New ObjectModel.Collection(Of Validate) From {
New ValidateFolderName(McFolderSelected & "versions", IgnoreCase:=False), New ValidateExceptSame(OldName & "_temp", "不能使用该名称！")}) New ValidateFolderName(McFolderSelected & "versions", IgnoreCase:=False)})
If String.IsNullOrWhiteSpace(NewName) Then Return If String.IsNullOrWhiteSpace(NewName) Then Return
Dim NewPath As String = McFolderSelected & "versions\" & NewName & "\" Dim NewPath As String = McFolderSelected & "versions\" & NewName & "\"
'获取临时中间名，以防止仅修改大小写的重命名失败
Dim TempName As String = NewName & "_temp"
Dim TempPath As String = McFolderSelected & "versions\" & TempName & "\"
Dim OnlyChangedCase As Boolean = NewName.Lower = OldName.Lower
'重新读取版本 JSON 信息，避免 JsonObject 中已被合并的项被重新存储 '重新读取版本 JSON 信息，避免 JsonObject 中已被合并的项被重新存储
Dim JsonObject As JObject Dim JsonObject As JObject
Dim OldJsonPath As String = PageInstanceLeft.Instance.GetJsonPath() Dim OldJsonPath As String = PageInstanceLeft.Instance.GetJsonPath()
Try Try
JsonObject = GetJson(ReadFile(OldJsonPath)) JsonObject = GetJson(FileUtils.ReadAsString(OldJsonPath))
Catch ex As Exception Catch ex As Exception
Log(ex, "在重命名读取 json 时失败") Logger.Warn(ex, "在重命名读取 json 时失败")
JsonObject = PageInstanceLeft.Instance.JsonObject JsonObject = PageInstanceLeft.Instance.JsonObject
End Try End Try
'重命名主文件夹 '重命名主文件夹
Directory.Move(OldPath, TempPath) DirectoryUtils.Move(OldPath, NewPath)
Directory.Move(TempPath, NewPath)
'清理 ini 缓存 '清理 ini 缓存
IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt") PageInstanceLeft.Instance.ResetIniCache()
IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini")
'重命名 jar 文件与 natives 文件夹 '重命名 jar 文件与 natives 文件夹
'不能进行遍历重命名，否则在版本名很短的时候容易误伤其他文件（#6443） '不能进行遍历重命名，否则在版本名很短的时候容易误伤其他文件（#6443）
If Directory.Exists($"{NewPath}{OldName}-natives") Then If DirectoryUtils.Exists($"{NewPath}{OldName}-natives") Then DirectoryUtils.Move($"{NewPath}{OldName}-natives", $"{NewPath}{NewName}-natives")
If OnlyChangedCase Then If FileUtils.Exists($"{NewPath}{OldName}.jar") Then FileUtils.Move($"{NewPath}{OldName}.jar", $"{NewPath}{NewName}.jar")
Directory.Move($"{NewPath}{OldName}-natives", $"{NewPath}{OldName}natives_temp")
Directory.Move($"{NewPath}{OldName}-natives_temp", $"{NewPath}{NewName}-natives")
Else
DeleteDirectory($"{NewPath}{NewName}-natives")
Directory.Move($"{NewPath}{OldName}-natives", $"{NewPath}{NewName}-natives")
End If
End If
If File.Exists($"{NewPath}{OldName}.jar") Then
If OnlyChangedCase Then
File.Move($"{NewPath}{OldName}.jar", $"{NewPath}{OldName}_temp.jar")
File.Move($"{NewPath}{OldName}_temp.jar", $"{NewPath}{NewName}.jar")
Else
File.Delete($"{NewPath}{NewName}.jar")
File.Move($"{NewPath}{OldName}.jar", $"{NewPath}{NewName}.jar")
End If
End If
'替换版本设置文件中的路径 '替换版本设置文件中的路径
If File.Exists(NewPath & "PCL\Setup.ini") Then If FileUtils.Exists(NewPath & "PCL\Setup.ini") Then
FileUtils.Write(NewPath & "PCL\Setup.ini", ReadFile(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath)) FileUtils.Write(NewPath & "PCL\Setup.ini", FileUtils.ReadAsString(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath))
End If End If
'更改已选中的版本 '更改已选中的版本
If ReadIni(McFolderSelected & "PCL.ini", "Version") = OldName Then If ReadIni(McFolderSelected & "PCL.ini", "Version") = OldName Then
@@ -162,10 +140,10 @@
'更新版本 Json '更新版本 Json
Try Try
JsonObject("id") = NewName JsonObject("id") = NewName
FileUtils.Delete(NewPath & PathUtils.GetLastPart(OldJsonPath))
FileUtils.Write(NewPath & NewName & ".json", JsonObject.ToString) FileUtils.Write(NewPath & NewName & ".json", JsonObject.ToString)
File.Delete(NewPath & GetFileNameFromPath(OldJsonPath))
Catch ex As Exception Catch ex As Exception
Log(ex, "重命名版本 json 失败") Logger.Warn(ex, "重命名版本 json 失败")
End Try End Try
'刷新与提示 '刷新与提示
Hint("重命名成功！", HintType.Green) Hint("重命名成功！", HintType.Green)
@@ -174,7 +152,7 @@
Reload() Reload()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "重命名版本失败", NotifyLevel.MsgBox) Logger.Error(ex, "重命名版本失败", LogBehavior.Alert)
End Try End Try
End Sub End Sub
@@ -184,17 +162,17 @@
'选择 自定义 时修改图片 '选择 自定义 时修改图片
Try Try
If ComboDisplayLogo.SelectedItem Is ItemDisplayLogoCustom Then If ComboDisplayLogo.SelectedItem Is ItemDisplayLogoCustom Then
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpeg;*.jpg;*.gif;*.webp)|*.png;*.jpeg;*.jpg;*.gif;*.webp", "选择图片") Dim FileName As String = Dialogs.SelectFile("选择图片", False, filter:={({"png", "jpeg", "jpg", "gif", "webp"}, "常用图片文件")}).FirstOrDefault()
If FileName = "" Then If String.IsNullOrEmpty(FileName) Then
Reload() '还原选项 Reload() '还原选项
Return Return
End If End If
CopyFile(FileName, PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png") FileUtils.Copy(FileName, PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
Else Else
File.Delete(PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png") FileUtils.Delete(PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "更改自定义版本图标失败（" & PageInstanceLeft.Instance.Name & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"更改自定义版本图标失败（{PageInstanceLeft.Instance.Name}）")
End Try End Try
'进行更改 '进行更改
Try Try
@@ -207,7 +185,7 @@
Reload() Reload()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "更改版本图标失败（" & PageInstanceLeft.Instance.Name & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"更改版本图标失败（{PageInstanceLeft.Instance.Name}）")
End Try End Try
End Sub End Sub
@@ -220,7 +198,7 @@
McInstanceListForceRefresh = True McInstanceListForceRefresh = True
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 收藏状态更改失败", NotifyLevel.MsgBox) Logger.Error(ex, $"版本 {PageInstanceLeft.Instance.Name} 收藏状态更改失败", LogBehavior.Alert)
End Try End Try
End Sub End Sub
@@ -258,8 +236,8 @@
Private Sub BtnManageScript_Click() Handles BtnManageScript.Click Private Sub BtnManageScript_Click() Handles BtnManageScript.Click
Try Try
'弹窗要求指定脚本的保存位置 '弹窗要求指定脚本的保存位置
Dim SavePath As String = SelectSaveFile("选择脚本保存位置", "启动 " & PageInstanceLeft.Instance.Name & ".bat", "批处理文件(*.bat)|*.bat") Dim SavePath As String = Dialogs.SaveFile("选择脚本保存位置", "启动 " & PageInstanceLeft.Instance.Name & ".bat", filter:={("bat", "批处理文件")})
If SavePath = "" Then Return If SavePath Is Nothing Then Return
'检查中断（等玩家选完弹窗指不定任务就结束了呢……） '检查中断（等玩家选完弹窗指不定任务就结束了呢……）
If McLaunchLoader.State = LoadState.Loading Then If McLaunchLoader.State = LoadState.Loading Then
Hint("请在当前启动任务结束后再试！", HintType.Red) Hint("请在当前启动任务结束后再试！", HintType.Red)
@@ -267,14 +245,14 @@
End If End If
'生成脚本 '生成脚本
If McLaunchStart(New McLaunchOptions With {.SaveBatch = SavePath, .Instance = PageInstanceLeft.Instance}) Then If McLaunchStart(New McLaunchOptions With {.SaveBatch = SavePath, .Instance = PageInstanceLeft.Instance}) Then
If Settings.Get("LoginType") = McLoginType.Legacy Then If Settings.Get(Of McLoginType)("LoginType") = McLoginType.Legacy Then
Hint("正在导出启动脚本……") Hint("正在导出启动脚本……")
Else Else
Hint("正在导出启动脚本……（注意，使用脚本启动可能会导致登录失效！）") Hint("正在导出启动脚本……（注意，使用脚本启动可能会导致登录失效！）")
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "导出启动脚本失败（" & PageInstanceLeft.Instance.Name & "）", NotifyLevel.MsgBox) Logger.Error(ex, $"导出启动脚本失败（{PageInstanceLeft.Instance.Name}）", LogBehavior.Alert)
End Try End Try
End Sub End Sub
@@ -300,7 +278,7 @@
Case LoadState.Finished Case LoadState.Finished
Hint(Loader.Name & "成功！", HintType.Green) Hint(Loader.Name & "成功！", HintType.Green)
Case LoadState.Failed Case LoadState.Failed
Hint(Loader.Name & "失败：" & Loader.Error.GetBrief(), HintType.Red) Hint(Loader.Name & "失败：" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted Case LoadState.Interrupted
Hint(Loader.Name & "已取消！", HintType.Blue) Hint(Loader.Name & "已取消！", HintType.Blue)
End Select End Select
@@ -310,7 +288,7 @@
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception Catch ex As Exception
Log(ex, "尝试补全文件失败（" & PageInstanceLeft.Instance.Name & "）", NotifyLevel.MsgBox) Logger.Error(ex, $"尝试补全文件失败（{PageInstanceLeft.Instance.Name}）", LogBehavior.Alert)
End Try End Try
End Sub End Sub
@@ -324,13 +302,8 @@
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""), If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""),
"版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed) "版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed)
Case 1 Case 1
IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt") PageInstanceLeft.Instance.ResetIniCache()
IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini") DirectoryUtils.Delete(PageInstanceLeft.Instance.PathVersion, Not IsShiftPressed)
If IsShiftPressed Then
DeleteDirectory(PageInstanceLeft.Instance.PathVersion)
Else
FileIO.FileSystem.DeleteDirectory(PageInstanceLeft.Instance.PathVersion, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
Hint("已删除版本 " & PageInstanceLeft.Instance.Name & "！", HintType.Green) Hint("已删除版本 " & PageInstanceLeft.Instance.Name & "！", HintType.Green)
Case 2 Case 2
Return Return
@@ -338,9 +311,9 @@
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
FrmMain.PageBack() FrmMain.PageBack()
Catch ex As OperationCanceledException Catch ex As OperationCanceledException
Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 被主动取消") Logger.Warn(ex, $"删除版本 {PageInstanceLeft.Instance.Name} 被主动取消")
Catch ex As Exception Catch ex As Exception
Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 失败", NotifyLevel.MsgBox) Logger.Error(ex, $"删除版本 {PageInstanceLeft.Instance.Name} 失败", LogBehavior.Alert)
End Try End Try
End Sub End Sub
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceSetup.xaml
+2 -2
View File
@@ -36,7 +36,7 @@
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏窗口标题" Margin="0,0,25,0" /> <TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏窗口标题" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="2" Grid.ColumnSpan="2" local:SettingService.Key="VersionArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题，若留空则跟随全局设置的值。&#xa;你可以用替换标记来动态改变其内容，在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="跟随全局设置" MaxLength="100" /> <local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="2" Grid.ColumnSpan="2" local:SettingService.Key="VersionArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题，若留空则跟随全局设置的值。&#xa;你可以用替换标记来动态改变其内容，在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="跟随全局设置" MaxLength="100" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" /> <TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="4" Grid.ColumnSpan="2" local:SettingService.Key="VersionArgumentInfo" Grid.Column="1" HintText="跟随全局设置" ToolTip="该信息会显示在游戏主界面的左下角，与 F3 调试页面的左上角。&#xa;若留空，则跟随全局设置的值。&#xa;&#xa;你可以用替换标记来动态改变其内容，在 更多 → 帮助 中搜索 “替换标记” 以了解用法。"> <local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="4" Grid.ColumnSpan="2" local:SettingService.Key="VersionArgumentInfo" Grid.Column="1" HintText="跟随全局设置" ToolTip="注意：Mojang 于 Minecraft 26.1 移除了该设置，因此该设置在新版本中无效。&#xa;&#xa;该信息会显示在游戏主界面的左下角，与 F3 调试页面的左上角。&#xa;若留空，则跟随全局设置的值。&#xa;&#xa;你可以用替换标记来动态改变其内容，在 更多 → 帮助 中搜索 “替换标记” 以了解用法。">
<local:MyTextBox.ValidateRules> <local:MyTextBox.ValidateRules>
<local:ValidateExcept> <local:ValidateExcept>
<local:ValidateExcept.Excepts> <local:ValidateExcept.Excepts>
@@ -250,7 +250,7 @@
ToolTip="是否使用 Java Launch Wrapper 修复 Java 18- 在中文路径下可能无法正常启动的问题。&#xa;详见：https://github.com/00ll00/java_launch_wrapper" /> ToolTip="是否使用 Java Launch Wrapper 修复 Java 18- 在中文路径下可能无法正常启动的问题。&#xa;详见：https://github.com/00ll00/java_launch_wrapper" />
<local:MyCheckBox Height="28" Text="禁用 LWJGL Unsafe Agent" local:SettingService.Key="VersionAdvanceDisableLUA" <local:MyCheckBox Height="28" Text="禁用 LWJGL Unsafe Agent" local:SettingService.Key="VersionAdvanceDisableLUA"
ToolTipService.Placement="Right" ToolTipService.Placement="Right"
ToolTip="是否使用 LWJGL Unsafe Agent 修复 Java 25+ 的一个性能问题。&#xa;详见：https://github.com/HMCL-dev/lwjgl-unsafe-agent" /> ToolTip="是否使用 LWJGL Unsafe Agent 修复 LWJGL 3.4.1 的一个性能问题。&#xa;详见：https://github.com/HMCL-dev/lwjgl-unsafe-agent" />
</StackPanel> </StackPanel>
</Grid> </Grid>
</local:MyCard> </local:MyCard>
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceSetup.xaml.vb
+18 -18
View File
@@ -28,17 +28,17 @@
'启动参数 '启动参数
Dim _unused = PageInstanceLeft.Instance.PathIndie '触发自动判定 Dim _unused = PageInstanceLeft.Instance.PathIndie '触发自动判定
ComboArgumentIndieV2.SelectedIndex = If(Settings.Get("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance), 0, 1) ComboArgumentIndieV2.SelectedIndex = If(Settings.Get(Of Boolean)("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance), 0, 1)
RefreshJavaComboBox() RefreshJavaComboBox()
'服务器 '服务器
ComboServerLogin.SelectedIndex = Settings.Get("VersionServerLogin", Instance:=PageInstanceLeft.Instance) ComboServerLogin.SelectedIndex = Settings.Get(Of Integer)("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
ComboServerLoginLast = ComboServerLogin.SelectedIndex ComboServerLoginLast = ComboServerLogin.SelectedIndex
UpdateServerLoginUI() UpdateServerLoginUI()
'高级设置 '高级设置
If Settings.Get("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) = 2 Then If Settings.Get(Of Integer)("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) = 2 Then
Log("[Setup] 已迁移老版本的关闭文件校验设置") Logger.Info("已迁移老版本的关闭文件校验设置")
Settings.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance)
Settings.Set("VersionAdvanceAssetsV2", True, Instance:=PageInstanceLeft.Instance) Settings.Set("VersionAdvanceAssetsV2", True, Instance:=PageInstanceLeft.Instance)
End If End If
@@ -46,10 +46,10 @@
SettingService.RefreshSettings(Me) SettingService.RefreshSettings(Me)
'游戏内存 '游戏内存
OnVersionRamTypeChanged(Settings.Get("VersionRamType", Instance:=PageInstanceLeft.Instance)) OnVersionRamTypeChanged(Settings.Get(Of Integer)("VersionRamType", Instance:=PageInstanceLeft.Instance))
Catch ex As Exception Catch ex As Exception
Log(ex, "重载版本独立设置时出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "重载版本独立设置时出错")
End Try End Try
End Sub End Sub
@@ -65,10 +65,10 @@
Settings.Reset("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance) Settings.Reset("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
JavaSearchLoader.Start(IsForceRestart:=True) JavaSearchLoader.Start(IsForceRestart:=True)
Log("[Setup] 已初始化版本独立设置") Logger.Info("已初始化版本独立设置")
Hint("已初始化版本独立设置！", HintType.Green, False) Hint("已初始化版本独立设置！", HintType.Green, False)
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化版本独立设置失败", NotifyLevel.MsgBox) Logger.Error(ex, "初始化版本独立设置失败", LogBehavior.Alert)
End Try End Try
Reload() Reload()
@@ -219,7 +219,7 @@
''' </summary> ''' </summary>
Public Shared Function GetRam(Instance As McInstance, Optional Is32BitJava As Boolean? = Nothing) As Double Public Shared Function GetRam(Instance As McInstance, Optional Is32BitJava As Boolean? = Nothing) As Double
'跟随全局设置 '跟随全局设置
If Settings.Get("VersionRamType", Instance:=Instance) = 2 Then If Settings.Get(Of Integer)("VersionRamType", Instance:=Instance) = 2 Then
Return PageSetupLaunch.GetRam(Instance, True, Is32BitJava) Return PageSetupLaunch.GetRam(Instance, True, Is32BitJava)
End If End If
@@ -229,7 +229,7 @@
'使用当前版本的设置 '使用当前版本的设置
Dim RamGive As Double Dim RamGive As Double
If Settings.Get("VersionRamType", Instance:=Instance) = 0 Then If Settings.Get(Of Integer)("VersionRamType", Instance:=Instance) = 0 Then
'自动配置 '自动配置
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
'确定需求的内存值 '确定需求的内存值
@@ -240,7 +240,7 @@
If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load() If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load()
If Instance IsNot Nothing AndAlso Instance.Modable Then If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 Mod 的版本 '可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Instance.PathIndie & "mods\") Dim ModDir = DirectoryUtils.GetInfo(Instance.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Count(Function(f) {".jar", ".zip", ".litemod"}.Contains(f.Extension.Lower)), 0) Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Count(Function(f) {".jar", ".zip", ".litemod"}.Contains(f.Extension.Lower)), 0)
RamMininum = 0.5 + ModCount / 150 RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90 RamTarget1 = 1.5 + ModCount / 90
@@ -285,7 +285,7 @@ PreFin:
RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1) RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1)
Else Else
'手动配置 '手动配置
Dim Value As Integer = Settings.Get("VersionRamCustom", Instance:=Instance) Dim Value As Integer = Settings.Get(Of Integer)("VersionRamCustom", Instance:=Instance)
If Value <= 12 Then If Value <= 12 Then
RamGive = Value * 0.1 + 0.3 RamGive = Value * 0.1 + 0.3
ElseIf Value <= 25 Then ElseIf Value <= 25 Then
@@ -374,10 +374,10 @@ PreFin:
'初始化列表 '初始化列表
ComboArgumentJava.Items.Clear() ComboArgumentJava.Items.Clear()
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "跟随全局设置", .Tag = "使用全局设置"}) ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "跟随全局设置", .Tag = "使用全局设置"})
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"}) ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择（推荐）", .Tag = "自动选择"})
'更新列表 '更新列表
Dim SelectedItem As MyComboBoxItem = Nothing Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Settings.Get("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance) Dim SelectedBySetup As String = Settings.Get(Of String)("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
Try Try
For Each Java In JavaList.ToList().OrderByDescending(Function(v) v.MajorVersion) For Each Java In JavaList.ToList().OrderByDescending(Function(v) v.MajorVersion)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java} Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
@@ -389,7 +389,7 @@ PreFin:
Next Next
Catch ex As Exception Catch ex As Exception
Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance) Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log(ex, "更新版本设置 Java 下拉框失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "更新版本设置 Java 下拉框失败")
End Try End Try
'更新选择项 '更新选择项
If SelectedItem Is Nothing AndAlso JavaList.Any Then If SelectedItem Is Nothing AndAlso JavaList.Any Then
@@ -424,15 +424,15 @@ PreFin:
If "使用全局设置".Equals(SelectedJava) Then If "使用全局设置".Equals(SelectedJava) Then
'选择 “自动” '选择 “自动”
Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance) Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置：跟随全局设置") Logger.Info("修改版本 Java 选择设置：跟随全局设置")
ElseIf "自动选择".Equals(SelectedJava) Then ElseIf "自动选择".Equals(SelectedJava) Then
'选择 “自动” '选择 “自动”
Settings.Set("VersionArgumentJavaSelect", "", Instance:=PageInstanceLeft.Instance) Settings.Set("VersionArgumentJavaSelect", "", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置：自动选择") Logger.Info("修改版本 Java 选择设置：自动选择")
Else Else
'选择指定项 '选择指定项
Settings.Set("VersionArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None), Instance:=PageInstanceLeft.Instance) Settings.Set("VersionArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None), Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置：" & SelectedJava.ToString) Logger.Info($"修改版本 Java 选择设置：{SelectedJava}")
End If End If
RefreshRam(True) RefreshRam(True)
End Sub End Sub
Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml.vb
+6 -6
View File
@@ -20,7 +20,7 @@
Data = Converter.Content Data = Converter.Content
Init() Init()
Catch ex As Exception Catch ex As Exception
Log(ex, "登录弹窗初始化失败", NotifyLevel.AllUsers) Logger.Error(ex, "登录弹窗初始化失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
@@ -35,9 +35,9 @@
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak)) AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyMsgBox " & Uuid) }, "MyMsgBox " & Uuid)
'记录日志 '记录日志
Log("[Control] 登录弹窗：" & LabTitle.Text & vbCrLf & LabCaption.Text) Logger.Info($"登录弹窗：{LabTitle.Text}{vbCrLf}{LabCaption.Text}")
Catch ex As Exception Catch ex As Exception
Log(ex, "登录弹窗加载失败", NotifyLevel.AllUsers) Logger.Error(ex, "登录弹窗加载失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
Private Sub Close() Private Sub Close()
@@ -123,8 +123,8 @@
Return Return
Catch ex As Exception Catch ex As Exception
'修改错误列表时，同时修改 ModLaunch.MsLoginStep1Refresh 中的对应代码 '修改错误列表时，同时修改 ModLaunch.MsLoginStep1Refresh 中的对应代码
If TypeOf ex Is ResponsedWebException Then If TypeOf ex Is HttpRequestCodeException Then
Dim Response = CType(ex, ResponsedWebException).Response Dim Response = CType(ex, HttpRequestCodeException).Response
If Response.Contains("authorization_declined") Then If Response.Contains("authorization_declined") Then
Finished(New Exception("$你拒绝了 PCL 申请的权限……")) Finished(New Exception("$你拒绝了 PCL 申请的权限……"))
Return Return
@@ -147,7 +147,7 @@
End If End If
If UnknownFailureCount <= 2 Then If UnknownFailureCount <= 2 Then
UnknownFailureCount += 1 UnknownFailureCount += 1
Log(ex, $"登录轮询第 {UnknownFailureCount} 次失败") Logger.Warn(ex, $"登录轮询第 {UnknownFailureCount} 次失败")
Thread.Sleep(2000) Thread.Sleep(2000)
Else Else
Finished(New Exception("登录轮询失败", ex)) Finished(New Exception("登录轮询失败", ex))
Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb
+22 -21
View File
@@ -14,7 +14,7 @@
ToolTip = If(_Address = "", "加载中", "点击更换皮肤（右键查看更多选项）") ToolTip = If(_Address = "", "加载中", "点击更换皮肤（右键查看更多选项）")
End Set End Set
End Property End Property
Public Loader As LoaderTask(Of EqualableList(Of String), String) Public Loader As LoaderTask(Of (String, String), String)
'控件动画 '控件动画
Private Sub PanSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter Private Sub PanSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter
@@ -44,7 +44,7 @@
Public Sub BtnSkinSave_Click() Handles BtnSkinSave.Click Public Sub BtnSkinSave_Click() Handles BtnSkinSave.Click
Save(Loader) Save(Loader)
End Sub End Sub
Public Shared Sub Save(Loader As LoaderTask(Of EqualableList(Of String), String)) Public Shared Sub Save(Loader As LoaderTask(Of (String, String), String))
Dim Address = Loader.Output Dim Address = Loader.Output
If Not Loader.State = LoadState.Finished Then If Not Loader.State = LoadState.Finished Then
Hint("皮肤正在获取中，请稍候！", HintType.Red) Hint("皮肤正在获取中，请稍候！", HintType.Red)
@@ -52,19 +52,20 @@
Return Return
End If End If
Try Try
Dim FileAddress As String = SelectSaveFile("选取保存皮肤的位置", GetFileNameFromPath(Address), "皮肤图片文件(*.png)|*.png") Dim FileAddress As String = Dialogs.SaveFile("选取保存皮肤的位置", PathUtils.GetLastPart(Address), filter:={("png", "皮肤图片文件")})
If FileAddress Is Nothing Then Return
If FileAddress.Contains("\") Then If FileAddress.Contains("\") Then
File.Delete(FileAddress) FileUtils.Delete(FileAddress)
If Address.StartsWithF(PathImage) Then If Address.StartsWithF(PathImage) Then
Dim Image As New MyBitmap(Address) Dim Image As New MyBitmap(Address)
Image.Save(FileAddress) Image.Save(FileAddress)
Else Else
CopyFile(Address, FileAddress) FileUtils.Copy(Address, FileAddress)
End If End If
Hint("皮肤保存成功！", HintType.Green) Hint("皮肤保存成功！", HintType.Green)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "保存皮肤失败", NotifyLevel.AllUsers) Logger.Error(ex, "保存皮肤失败", LogBehavior.Toast)
End Try End Try
End Sub End Sub
Private Sub BtnSkinSave_Checked(sender As MyMenuItem, e As RoutedEventArgs) Handles BtnSkinSave.Checked Private Sub BtnSkinSave_Checked(sender As MyMenuItem, e As RoutedEventArgs) Handles BtnSkinSave.Checked
@@ -79,14 +80,14 @@
'检查文件存在 '检查文件存在
Address = Loader.Output Address = Loader.Output
If String.IsNullOrEmpty(Address) Then Throw New Exception("皮肤加载器 " & Loader.Name & " 没有输出") If String.IsNullOrEmpty(Address) Then Throw New Exception("皮肤加载器 " & Loader.Name & " 没有输出")
If Not Address.StartsWithF(PathImage) AndAlso Not File.Exists(Address) Then Throw New FileNotFoundException("皮肤文件未找到", Address) If Not Address.StartsWithF(PathImage) AndAlso Not FileUtils.Exists(Address) Then Throw New FileNotFoundException("皮肤文件未找到", Address)
'加载 '加载
Dim Image As MyBitmap Dim Image As MyBitmap
Try Try
Image = New MyBitmap(Address) Image = New MyBitmap(Address)
Catch ex As Exception '#2272 Catch ex As Exception '#2272
Log(ex, $"皮肤文件已损坏：{Address}", NotifyLevel.AllUsers) Logger.Error(ex, $"皮肤文件已损坏：{Address}", LogBehavior.Toast)
File.Delete(Address) FileUtils.Delete(Address)
Return Return
End Try End Try
ImgBack.Tag = Address ImgBack.Tag = Address
@@ -113,9 +114,9 @@
End If End If
'脸层 '脸层
ImgBack.Source = Image.Clip(Scale * 8, Scale * 8, Scale * 8, Scale * 8) ImgBack.Source = Image.Clip(Scale * 8, Scale * 8, Scale * 8, Scale * 8)
Log("[Skin] 载入头像成功：" & Loader.Name) Logger.Info($"载入头像成功：{Loader.Name}")
Catch ex As Exception Catch ex As Exception
Log(ex, "载入头像失败（" & If(Address, "null") & "," & Loader.Name & "）", NotifyLevel.AllUsers) Logger.Error(ex, $"载入头像失败（{If(Address, "null")},{Loader.Name}）", LogBehavior.Toast)
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -134,7 +135,7 @@
''' <summary> ''' <summary>
''' 刷新皮肤缓存。 ''' 刷新皮肤缓存。
''' </summary> ''' </summary>
Public Shared Sub RefreshCache(Optional sender As LoaderTask(Of EqualableList(Of String), String) = Nothing) Public Shared Sub RefreshCache(Optional sender As LoaderTask(Of (String, String), String) = Nothing)
Dim HasLoaderRunning As Boolean = False Dim HasLoaderRunning As Boolean = False
For Each SkinLoader In PageLaunchLeft.SkinLoaders For Each SkinLoader In PageLaunchLeft.SkinLoaders
If SkinLoader.State = LoadState.Loading Then If SkinLoader.State = LoadState.Loading Then
@@ -150,9 +151,9 @@
Try Try
Hint("正在刷新头像……") Hint("正在刷新头像……")
'清空缓存 '清空缓存
Log("[Skin] 正在清空皮肤缓存") Logger.Info("正在清空皮肤缓存")
If Directory.Exists(PathTemp & "Cache\Skin") Then DeleteDirectory(PathTemp & "Cache\Skin") If DirectoryUtils.Exists(PathTemp & "Cache\Skin") Then DirectoryUtils.Delete(PathTemp & "Cache\Skin")
If Directory.Exists(PathTemp & "Cache\Uuid") Then DeleteDirectory(PathTemp & "Cache\Uuid") If DirectoryUtils.Exists(PathTemp & "Cache\Uuid") Then DirectoryUtils.Delete(PathTemp & "Cache\Uuid")
IniClearCache(PathTemp & "Cache\Skin\IndexMs.ini") IniClearCache(PathTemp & "Cache\Skin\IndexMs.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexNide.ini") IniClearCache(PathTemp & "Cache\Skin\IndexNide.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexAuth.ini") IniClearCache(PathTemp & "Cache\Skin\IndexAuth.ini")
@@ -163,7 +164,7 @@
Next Next
Hint("已刷新头像！", HintType.Green) Hint("已刷新头像！", HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新皮肤缓存失败", NotifyLevel.MsgBox) Logger.Error(ex, "刷新皮肤缓存失败", LogBehavior.Alert)
End Try End Try
End Sub) End Sub)
End If End If
@@ -177,8 +178,8 @@
Sub() Sub()
Try Try
'更新缓存 '更新缓存
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Settings.Get("CacheMsV2Uuid"), SkinAddress) WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Settings.Get(Of String)("CacheMsV2Uuid"), SkinAddress)
Log($"[Skin] 已写入皮肤地址缓存 {Settings.Get("CacheMsV2Uuid")} -> {SkinAddress}") Logger.Info($"已写入皮肤地址缓存 {Settings.Get(Of String)("CacheMsV2Uuid")} -> {SkinAddress}")
'刷新控件 '刷新控件
For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy} For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}
SkinLoader.WaitForExit(IsForceRestart:=True) SkinLoader.WaitForExit(IsForceRestart:=True)
@@ -186,7 +187,7 @@
'完成提示 '完成提示
Hint("更改皮肤成功！", HintType.Green) Hint("更改皮肤成功！", HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, "更改正版皮肤后刷新皮肤失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "更改正版皮肤后刷新皮肤失败")
End Try End Try
End Sub) End Sub)
End Sub End Sub
@@ -255,7 +256,7 @@ Retry:
Next Next
SelectedIndex = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消") SelectedIndex = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception Catch ex As Exception
Log(ex, "获取玩家皮肤列表失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "获取玩家皮肤列表失败")
End Try End Try
End Sub) End Sub)
If SelectedIndex Is Nothing Then Return If SelectedIndex Is Nothing Then Return
@@ -278,7 +279,7 @@ Retry:
McLoginMsLoader.Output.ProfileJson = SkinData.ToString() McLoginMsLoader.Output.ProfileJson = SkinData.ToString()
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "更改披风失败", NotifyLevel.AllUsers) Logger.Error(ex, "更改披风失败", LogBehavior.Toast)
Finally Finally
IsChanging = False IsChanging = False
End Try End Try
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb
+92 -92
View File
@@ -23,39 +23,39 @@
Sub() Sub()
'自动整合包安装：准备 '自动整合包安装：准备
Dim PackInstallPath As String = Nothing Dim PackInstallPath As String = Nothing
If File.Exists(PathExeFolder & "modpack.zip") Then PackInstallPath = PathExeFolder & "modpack.zip" If FileUtils.Exists(PathExeFolder & "modpack.zip") Then PackInstallPath = PathExeFolder & "modpack.zip"
If File.Exists(PathExeFolder & "modpack.mrpack") Then PackInstallPath = PathExeFolder & "modpack.mrpack" If FileUtils.Exists(PathExeFolder & "modpack.mrpack") Then PackInstallPath = PathExeFolder & "modpack.mrpack"
If PackInstallPath IsNot Nothing Then If PackInstallPath IsNot Nothing Then
Log("[Launch] 需自动安装整合包：" & PackInstallPath, NotifyLevel.DebugModeOnly) Logger.Warn($"需自动安装整合包：{PackInstallPath}")
PageSelectLeft.CreateMcFolderInCurrentPath() PageSelectLeft.CreateMcFolderInCurrentPath()
McFolderListLoader.WaitForExit() McFolderListLoader.WaitForExit()
End If End If
'确认 Minecraft 文件夹存在 '确认 Minecraft 文件夹存在
If McFolderSelected = "" OrElse Not Directory.Exists(McFolderSelected) Then If McFolderSelected = "" OrElse Not DirectoryUtils.Exists(McFolderSelected) Then
'无效的文件夹 '无效的文件夹
If McFolderSelected = "" Then If McFolderSelected = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹") Logger.Info("没有已储存的 Minecraft 文件夹")
Else Else
Log("[Launch] Minecraft 文件夹无效，该文件夹已不存在：" & McFolderSelected, NotifyLevel.DebugModeOnly) Logger.Warn($"Minecraft 文件夹无效，该文件夹已不存在：{McFolderSelected}")
End If End If
McFolderListLoader.WaitForExit(IsForceRestart:=True) McFolderListLoader.WaitForExit(IsForceRestart:=True)
McFolderSelected = McFolderList.First.Location McFolderSelected = McFolderList.First.Location
End If End If
If Settings.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000)) If Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'自动整合包安装 '自动整合包安装
If PackInstallPath IsNot Nothing Then If PackInstallPath IsNot Nothing Then
Try Try
Dim InstallLoader = ModpackInstall(PackInstallPath) Dim InstallLoader = ModpackInstall(PackInstallPath)
Log("[Launch] 自动安装整合包已开始：" & PackInstallPath) Logger.Info($"自动安装整合包已开始：{PackInstallPath}")
InstallLoader.WaitForExit() InstallLoader.WaitForExit()
If InstallLoader.State = LoadState.Finished Then If InstallLoader.State = LoadState.Finished Then
Log("[Launch] 自动安装整合包成功，清理安装包：" & PackInstallPath) Logger.Info($"自动安装整合包成功，清理安装包：{PackInstallPath}")
If File.Exists(PackInstallPath) Then File.Delete(PackInstallPath) FileUtils.Delete(PackInstallPath)
End If End If
Catch ex As CancelledException Catch ex As CancelledException
Log(ex, "自动安装整合包被用户取消：" & PackInstallPath) Logger.Warn(ex, $"自动安装整合包被用户取消：{PackInstallPath}")
Catch ex As Exception Catch ex As Exception
Log(ex, "自动安装整合包失败：" & PackInstallPath, NotifyLevel.MsgBox) Logger.Error(ex, $"自动安装整合包失败：{PackInstallPath}", LogBehavior.Alert)
End Try End Try
End If End If
'确认 Minecraft 版本存在 '确认 Minecraft 版本存在
@@ -63,14 +63,14 @@
Dim Instance As McInstance = If(Selection = "", Nothing, New McInstance(Selection)) Dim Instance As McInstance = If(Selection = "", Nothing, New McInstance(Selection))
If Instance Is Nothing OrElse Not Instance.PathVersion.StartsWithF(McFolderSelected) OrElse Not Instance.Check() Then If Instance Is Nothing OrElse Not Instance.PathVersion.StartsWithF(McFolderSelected) OrElse Not Instance.Check() Then
'无效的版本 '无效的版本
Log("[Launch] 当前选择的 Minecraft 版本无效：" & If(Instance Is Nothing, "null", Instance.PathVersion), If(IsNothing(Instance), NotifyLevel.Silent, NotifyLevel.DebugModeOnly)) Logger.Info($"当前选择的 Minecraft 版本无效：{If(Instance Is Nothing, "null", Instance.PathVersion)}", If(IsNothing(Instance), LogBehavior.None, LogBehavior.ToastIfDebug))
If Not McInstanceListLoader.State = LoadState.Finished Then LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) If Not McInstanceListLoader.State = LoadState.Finished Then LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McInstanceList.Any() OrElse McInstanceList.First.Value(0).Logo.Contains("RedstoneBlock") Then If Not McInstanceList.Any() OrElse McInstanceList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Instance = Nothing Instance = Nothing
Log("[Launch] 无可用 Minecraft 版本") Logger.Info("无可用 Minecraft 版本")
Else Else
Instance = McInstanceList.First.Value(0) Instance = McInstanceList.First.Value(0)
Log("[Launch] 自动选择 Minecraft 版本：" & Instance.PathVersion) Logger.Info($"自动选择 Minecraft 版本：{Instance.PathVersion}")
End If End If
End If End If
RunInUi( RunInUi(
@@ -85,7 +85,7 @@
End Sub, "Version Check", ThreadPriority.AboveNormal) End Sub, "Version Check", ThreadPriority.AboveNormal)
'改变页面 '改变页面
Dim LoginType As McLoginType = Settings.Get("LoginType") Dim LoginType = Settings.Get(Of McLoginType)("LoginType")
If LoginType = McLoginType.Legacy OrElse LoginType = McLoginType.Ms Then CType(FindName("RadioLoginType" & LoginType), MyRadioButton).Checked = True If LoginType = McLoginType.Legacy OrElse LoginType = McLoginType.Ms Then CType(FindName("RadioLoginType" & LoginType), MyRadioButton).Checked = True
RefreshPage(False, False) RefreshPage(False, False)
@@ -99,7 +99,7 @@
''' </summary> ''' </summary>
Public Sub PageChangeToLaunching() Public Sub PageChangeToLaunching()
'修改登陆方式 '修改登陆方式
Select Case Settings.Get("LoginType") Select Case Settings.Get(Of McLoginType)("LoginType")
Case McLoginType.Legacy Case McLoginType.Legacy
LabLaunchingMethod.Text = "离线登录" LabLaunchingMethod.Text = "离线登录"
Case McLoginType.Ms Case McLoginType.Ms
@@ -257,7 +257,7 @@
PageCurrent = Type PageCurrent = Type
Return PageNew Return PageNew
Catch ex As Exception Catch ex As Exception
Log(ex, "切换登录分页失败（" & GetStringFromEnum(CType(Type, [Enum])) & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"切换登录分页失败（{Type}）")
Return PageNew Return PageNew
End Try End Try
End Function End Function
@@ -270,17 +270,17 @@
Dim Type As PageType Dim Type As PageType
Dim LoginPageType As Integer Dim LoginPageType As Integer
If McInstanceSelected IsNot Nothing Then If McInstanceSelected IsNot Nothing Then
LoginPageType = Settings.Get("VersionServerLogin", Instance:=McInstanceSelected) LoginPageType = Settings.Get(Of Integer)("VersionServerLogin", Instance:=McInstanceSelected)
'缓存当前版本的页面种类，下一次打开 McInstanceSelected 为空时才能加载出正确的页面 '缓存当前版本的页面种类，下一次打开 McInstanceSelected 为空时才能加载出正确的页面
Settings.Set("LoginPageType", LoginPageType) Settings.Set("LoginPageType", LoginPageType)
Else Else
LoginPageType = Settings.Get("LoginPageType") LoginPageType = Settings.Get(Of Integer)("LoginPageType")
End If End If
Select Case LoginPageType Select Case LoginPageType
Case 0 '正版或离线 Case 0 '正版或离线
UnknownType: UnknownType:
If RadioLoginType5.Checked Then If RadioLoginType5.Checked Then
If Settings.Get("CacheMsV2Access") = "" Then If Settings.Get(Of String)("CacheMsV2Access") = "" Then
Type = PageType.Ms Type = PageType.Ms
Else Else
Type = PageType.MsSkin Type = PageType.MsSkin
@@ -295,7 +295,7 @@ UnknownType:
RadioLoginType5.Visibility = Visibility.Visible RadioLoginType5.Visibility = Visibility.Visible
RadioLoginType0.Visibility = Visibility.Visible RadioLoginType0.Visibility = Visibility.Visible
Case 1 '仅正版 Case 1 '仅正版
If Settings.Get("CacheMsV2Access") = "" Then If Settings.Get(Of String)("CacheMsV2Access") = "" Then
Type = PageType.Ms Type = PageType.Ms
Else Else
Type = PageType.MsSkin Type = PageType.MsSkin
@@ -315,7 +315,7 @@ UnknownType:
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonOffline) PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonOffline)
LabTypeOne.Text = "离线登录" LabTypeOne.Text = "离线登录"
Case 3 '统一通行证 Case 3 '统一通行证
If Settings.Get("CacheNideAccess") = "" Then If Settings.Get(Of String)("CacheNideAccess") = "" Then
Type = PageType.Nide Type = PageType.Nide
Else Else
Type = PageType.NideSkin Type = PageType.NideSkin
@@ -326,7 +326,7 @@ UnknownType:
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard) PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard)
LabTypeOne.Text = "统一通行证登录" LabTypeOne.Text = "统一通行证登录"
Case 4 'Authlib-Injector Case 4 'Authlib-Injector
If Settings.Get("CacheAuthAccess") = "" Then If Settings.Get(Of String)("CacheAuthAccess") = "" Then
Type = PageType.Auth Type = PageType.Auth
Else Else
Type = PageType.AuthSkin Type = PageType.AuthSkin
@@ -335,16 +335,16 @@ UnknownType:
PanType.Visibility = Visibility.Collapsed PanType.Visibility = Visibility.Collapsed
PanTypeOne.Visibility = Visibility.Visible PanTypeOne.Visibility = Visibility.Visible
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard) PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard)
LabTypeOne.Text = If(McInstanceSelected Is Nothing, Settings.Get("CacheAuthServerName"), Settings.Get("VersionServerAuthName", Instance:=McInstanceSelected)) LabTypeOne.Text = If(McInstanceSelected Is Nothing, Settings.Get(Of String)("CacheAuthServerName"), Settings.Get(Of String)("VersionServerAuthName", Instance:=McInstanceSelected))
If LabTypeOne.Text = "" Then LabTypeOne.Text = "第三方登录" If LabTypeOne.Text = "" Then LabTypeOne.Text = "第三方登录"
Case Else Case Else
Log("[Control] 未知的登录页面：" & LoginPageType, NotifyLevel.AllUsers) Logger.Error($"未知的登录页面：{LoginPageType}", LogBehavior.Toast)
GoTo UnknownType GoTo UnknownType
End Select End Select
'刷新页面 '刷新页面
If PageCurrent = Type Then Return If PageCurrent = Type Then Return
PageChange(Type, Anim).Reload(KeepInput) PageChange(Type, Anim).Reload(KeepInput)
Dim Control As MyRadioButton = FindName("RadioLoginType" & Settings.Get("LoginType")) Dim Control As MyRadioButton = FindName("RadioLoginType" & Settings.Get(Of McLoginType)("LoginType"))
If Control IsNot Nothing Then Control.Checked = True If Control IsNot Nothing Then Control.Checked = True
End Sub End Sub
Private Sub RadioLoginType_Change(sender As Object, raiseByMouse As Boolean) Handles RadioLoginType0.Check, RadioLoginType5.Check Private Sub RadioLoginType_Change(sender As Object, raiseByMouse As Boolean) Handles RadioLoginType0.Check, RadioLoginType5.Check
@@ -356,21 +356,21 @@ UnknownType:
#Region "皮肤" #Region "皮肤"
'微软正版皮肤 '微软正版皮肤
Public Shared SkinMs As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal) Public Shared SkinMs As New LoaderTask(Of (String, String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal)
Private Shared Function SkinMsInput() As EqualableList(Of String) Private Shared Function SkinMsInput() As (String, String)
'获取名称 '获取名称
Return New EqualableList(Of String) From {Settings.Get("CacheMsV2Name"), Settings.Get("CacheMsV2Uuid")} Return (Settings.Get(Of String)("CacheMsV2Name"), Settings.Get(Of String)("CacheMsV2Uuid"))
End Function End Function
Private Shared Sub SkinMsLoad(Data As LoaderTask(Of EqualableList(Of String), String)) Private Shared Sub SkinMsLoad(Data As LoaderTask(Of (String, String), String))
'清空已有皮肤 '清空已有皮肤
'如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载 '如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载
RunInUi(Sub() If FrmLoginMsSkin IsNot Nothing AndAlso FrmLoginMsSkin.Skin IsNot Nothing Then FrmLoginMsSkin.Skin.Clear()) RunInUi(Sub() If FrmLoginMsSkin IsNot Nothing AndAlso FrmLoginMsSkin.Skin IsNot Nothing Then FrmLoginMsSkin.Skin.Clear())
'获取 Url '获取 Url
Dim UserName As String = Data.Input(0) Dim UserName As String = Data.Input.Item1
Dim Uuid As String = Data.Input(1) Dim Uuid As String = Data.Input.Item2
If UserName = "" Then If UserName = "" Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取微软正版皮肤失败，ID 为空") Logger.Info("获取微软正版皮肤失败，ID 为空")
GoTo Finish GoTo Finish
End If End If
Try Try
@@ -383,15 +383,15 @@ UnknownType:
Data.Output = "" Data.Output = ""
Return Return
Catch ex As Exception Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then If ex.GetDisplay(False).Contains("(429)") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取正版皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", NotifyLevel.AllUsers) Logger.Error($"获取正版皮肤失败（{UserName}）：获取皮肤太过频繁，请 5 分钟后再试！", LogBehavior.Toast)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then ElseIf ex.GetDisplay(False).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载") Logger.Info("用户未设置自定义皮肤，跳过皮肤加载")
Else Else
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log(ex, "获取微软正版皮肤失败（" & UserName & "）", NotifyLevel.AllUsers) Logger.Error(ex, $"获取微软正版皮肤失败（{UserName}）", LogBehavior.Toast)
End If End If
End Try End Try
Finish: Finish:
@@ -404,39 +404,39 @@ Finish:
End Sub End Sub
'离线皮肤 '离线皮肤
Public Shared SkinLegacy As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Legacy", AddressOf SkinLegacyLoad, AddressOf SkinLegacyInput, ThreadPriority.AboveNormal) Public Shared SkinLegacy As New LoaderTask(Of (String, String), String)("Loader Skin Legacy", AddressOf SkinLegacyLoad, AddressOf SkinLegacyInput, ThreadPriority.AboveNormal)
Private Shared Function SkinLegacyInput() As EqualableList(Of String) Private Shared Function SkinLegacyInput() As (String, String)
'根据类型判断输入 '根据类型判断输入
Dim Type As Integer = Settings.Get("LaunchSkinType") Dim Type As Integer = Settings.Get(Of Integer)("LaunchSkinType")
Select Case Type Select Case Type
Case 0 Case 0
If FrmLoginLegacy IsNot Nothing AndAlso FrmLoginLegacy.IsReloaded Then If FrmLoginLegacy?.IsReloaded Then
Return New EqualableList(Of String) From {0, If(FrmLoginLegacy.ComboName.Text.Trim, "")} Return ("0", If(FrmLoginLegacy.ComboName.Text.Trim, ""))
ElseIf Settings.Get("LoginLegacyName") = "" Then ElseIf Settings.Get(Of String)("LoginLegacyName") = "" Then
Return New EqualableList(Of String) From {0, ""} Return ("0", "")
Else Else
Return New EqualableList(Of String) From {0, If(Settings.Get("LoginLegacyName").ToString.BeforeFirst("¨"), "")} Return ("0", If(Settings.Get(Of String)("LoginLegacyName").ToString.BeforeFirst("¨"), ""))
End If End If
Case 3 Case 3
Return New EqualableList(Of String) From {3, Settings.Get("LaunchSkinID")} Return ("3", Settings.Get(Of String)("LaunchSkinID"))
Case Else Case Else
Return New EqualableList(Of String) From {Type} Return (Type.ToString, "")
End Select End Select
End Function End Function
Private Shared Sub SkinLegacyLoad(Data As LoaderTask(Of EqualableList(Of String), String)) Private Shared Sub SkinLegacyLoad(Data As LoaderTask(Of (String, String), String))
'清空已有皮肤 '清空已有皮肤
RunInUi(Sub() If FrmLoginLegacy IsNot Nothing AndAlso FrmLoginLegacy.Skin IsNot Nothing Then FrmLoginLegacy.Skin.Clear()) RunInUi(Sub() If FrmLoginLegacy IsNot Nothing AndAlso FrmLoginLegacy.Skin IsNot Nothing Then FrmLoginLegacy.Skin.Clear())
'获取 Url '获取 Url
Select Case Data.Input(0) Select Case CInt(Data.Input.Item1)
Case 0 '默认 Case 0 '默认
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(Data.Input(1))) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(Data.Input.Item2)) & ".png"
Case 1 'Steve Case 1 'Steve
UseDefault: UseDefault:
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Case 2 'Alex Case 2 'Alex
Data.Output = PathImage & "Skins/Alex.png" Data.Output = PathImage & "Skins/Alex.png"
Case 3 '正版 Case 3 '正版
Dim ID As String = Data.Input(1) Dim ID As String = Data.Input.Item2
Try Try
If ID.Count < 2 Then If ID.Count < 2 Then
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
@@ -453,16 +453,16 @@ UseDefault:
Data.Output = "" Data.Output = ""
Return Return
Catch ex As Exception Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then If ex.GetDisplay(False).Contains("(429)") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png"
Log("获取离线登录使用的正版皮肤失败（" & ID & "）：获取皮肤太过频繁，请 5 分钟后再试！") Logger.Info($"获取离线登录使用的正版皮肤失败（{ID}）：获取皮肤太过频繁，请 5 分钟后再试！")
Else Else
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png"
Log(ex, "获取离线登录使用的正版皮肤失败（" & ID & "）") Logger.Warn(ex, $"获取离线登录使用的正版皮肤失败（{ID}）")
End If End If
End Try End Try
Case 4 '自定义 Case 4 '自定义
If Not File.Exists(PathAppdata & "CustomSkin.png") Then If Not FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
Hint("未找到离线皮肤自定义文件，可能它已被删除。PCL 将使用默认的 Steve 皮肤！") Hint("未找到离线皮肤自定义文件，可能它已被删除。PCL 将使用默认的 Steve 皮肤！")
Settings.Set("LaunchSkinType", 1) Settings.Set("LaunchSkinType", 1)
GoTo UseDefault GoTo UseDefault
@@ -478,21 +478,21 @@ UseDefault:
End Sub End Sub
'统一通行证皮肤 '统一通行证皮肤
Public Shared SkinNide As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Nide", AddressOf SkinNideLoad, AddressOf SkinNideInput, ThreadPriority.AboveNormal) Public Shared SkinNide As New LoaderTask(Of (String, String), String)("Loader Skin Nide", AddressOf SkinNideLoad, AddressOf SkinNideInput, ThreadPriority.AboveNormal)
Private Shared Function SkinNideInput() As EqualableList(Of String) Private Shared Function SkinNideInput() As (String, String)
'获取名称 '获取名称
Return New EqualableList(Of String) From {Settings.Get("CacheNideName"), Settings.Get("CacheNideUuid")} Return (Settings.Get(Of String)("CacheNideName"), Settings.Get(Of String)("CacheNideUuid"))
End Function End Function
Private Shared Sub SkinNideLoad(Data As LoaderTask(Of EqualableList(Of String), String)) Private Shared Sub SkinNideLoad(Data As LoaderTask(Of (String, String), String))
'清空已有皮肤 '清空已有皮肤
'如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载 '如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载
RunInUi(Sub() If FrmLoginNideSkin IsNot Nothing AndAlso FrmLoginNideSkin.Skin IsNot Nothing Then FrmLoginNideSkin.Skin.Clear()) RunInUi(Sub() If FrmLoginNideSkin IsNot Nothing AndAlso FrmLoginNideSkin.Skin IsNot Nothing Then FrmLoginNideSkin.Skin.Clear())
'获取 Url '获取 Url
Dim UserName As String = Data.Input(0) Dim UserName As String = Data.Input.Item1
Dim Uuid As String = Data.Input(1) Dim Uuid As String = Data.Input.Item2
If UserName = "" Then If UserName = "" Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取统一通行证皮肤失败，ID 为空") Logger.Info("获取统一通行证皮肤失败，ID 为空")
GoTo Finish GoTo Finish
End If End If
Try Try
@@ -505,15 +505,15 @@ UseDefault:
Data.Output = "" Data.Output = ""
Return Return
Catch ex As Exception Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then If ex.GetDisplay(False).Contains("(429)") Then
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取统一通行证皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", NotifyLevel.AllUsers) Logger.Error($"获取统一通行证皮肤失败（{UserName}）：获取皮肤太过频繁，请 5 分钟后再试！", LogBehavior.Toast)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then ElseIf ex.GetDisplay(False).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载") Logger.Info("用户未设置自定义皮肤，跳过皮肤加载")
Else Else
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Log(ex, "获取统一通行证皮肤失败（" & UserName & "）", NotifyLevel.AllUsers) Logger.Error(ex, $"获取统一通行证皮肤失败（{UserName}）", LogBehavior.Toast)
End If End If
End Try End Try
Finish: Finish:
@@ -526,21 +526,21 @@ Finish:
End Sub End Sub
'Authlib-Injector 皮肤 'Authlib-Injector 皮肤
Public Shared SkinAuth As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Auth", AddressOf SkinAuthLoad, AddressOf SkinAuthInput, ThreadPriority.AboveNormal) Public Shared SkinAuth As New LoaderTask(Of (String, String), String)("Loader Skin Auth", AddressOf SkinAuthLoad, AddressOf SkinAuthInput, ThreadPriority.AboveNormal)
Private Shared Function SkinAuthInput() As EqualableList(Of String) Private Shared Function SkinAuthInput() As (String, String)
'获取名称 '获取名称
Return New EqualableList(Of String) From {Settings.Get("CacheAuthName"), Settings.Get("CacheAuthUuid")} Return (Settings.Get(Of String)("CacheAuthName"), Settings.Get(Of String)("CacheAuthUuid"))
End Function End Function
Private Shared Sub SkinAuthLoad(Data As LoaderTask(Of EqualableList(Of String), String)) Private Shared Sub SkinAuthLoad(Data As LoaderTask(Of (String, String), String))
'清空已有皮肤 '清空已有皮肤
'如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载 '如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载
RunInUi(Sub() If FrmLoginAuthSkin IsNot Nothing AndAlso FrmLoginAuthSkin.Skin IsNot Nothing Then FrmLoginAuthSkin.Skin.Clear()) RunInUi(Sub() If FrmLoginAuthSkin IsNot Nothing AndAlso FrmLoginAuthSkin.Skin IsNot Nothing Then FrmLoginAuthSkin.Skin.Clear())
'获取 Url '获取 Url
Dim UserName As String = Data.Input(0) Dim UserName As String = Data.Input.Item1
Dim UUID As String = Data.Input(1) Dim UUID As String = Data.Input.Item2
If UserName = "" Then If UserName = "" Then
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取 Authlib-Injector 皮肤失败，ID 为空") Logger.Info("获取 Authlib-Injector 皮肤失败，ID 为空")
GoTo Finish GoTo Finish
End If End If
Try Try
@@ -553,15 +553,15 @@ Finish:
Data.Output = "" Data.Output = ""
Return Return
Catch ex As Exception Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then If ex.GetDisplay(False).Contains("(429)") Then
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取 Authlib-Injector 皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", NotifyLevel.AllUsers) Logger.Error($"获取 Authlib-Injector 皮肤失败（{UserName}）：获取皮肤太过频繁，请 5 分钟后再试！", LogBehavior.Toast)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then ElseIf ex.GetDisplay(False).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载") Logger.Info("用户未设置自定义皮肤，跳过皮肤加载")
Else Else
Data.Output = PathImage & "Skins/Steve.png" Data.Output = PathImage & "Skins/Steve.png"
Log(ex, "获取 Authlib-Injector 皮肤失败（" & UserName & "）", NotifyLevel.AllUsers) Logger.Error(ex, $"获取 Authlib-Injector 皮肤失败（{UserName}）", LogBehavior.Toast)
End If End If
End Try End Try
Finish: Finish:
@@ -575,7 +575,7 @@ Finish:
'全部皮肤加载器 '全部皮肤加载器
'需要放在其中元素的后面，否则会因为它提前被加载而莫名其妙变成 Nothing '需要放在其中元素的后面，否则会因为它提前被加载而莫名其妙变成 Nothing
Public Shared SkinLoaders As New List(Of LoaderTask(Of EqualableList(Of String), String)) From {SkinMs, SkinLegacy, SkinNide, SkinAuth} Public Shared SkinLoaders As New List(Of LoaderTask(Of (String, String), String)) From {SkinMs, SkinLegacy, SkinNide, SkinAuth}
#End Region #End Region
@@ -616,7 +616,7 @@ Finish:
CurrentState = 0 CurrentState = 0
Else Else
If McInstanceSelected Is Nothing Then If McInstanceSelected Is Nothing Then
If Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow Then If Settings.Get(Of Boolean)("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow Then
CurrentState = 1 CurrentState = 1
Else Else
CurrentState = 2 CurrentState = 2
@@ -632,28 +632,28 @@ Finish:
BtnLaunchState = CurrentState BtnLaunchState = CurrentState
Select Case CurrentState Select Case CurrentState
Case 0 Case 0
Log("[Minecraft] 启动按钮：正在加载 Minecraft 版本") Logger.Info("启动按钮：正在加载 Minecraft 版本")
FrmLaunchLeft.BtnLaunch.Text = "正在加载" FrmLaunchLeft.BtnLaunch.Text = "正在加载"
FrmLaunchLeft.BtnLaunch.IsEnabled = False FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "正在加载中，请稍候" FrmLaunchLeft.LabVersion.Text = "正在加载中，请稍候"
FrmLaunchLeft.BtnVersion.IsEnabled = False FrmLaunchLeft.BtnVersion.IsEnabled = False
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 1 Case 1
Log("[Minecraft] 启动按钮：无 Minecraft 版本，下载已禁用") Logger.Info("启动按钮：无 Minecraft 版本，下载已禁用")
FrmLaunchLeft.BtnLaunch.Text = "启动游戏" FrmLaunchLeft.BtnLaunch.Text = "启动游戏"
FrmLaunchLeft.BtnLaunch.IsEnabled = False FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "未找到可用的游戏版本" FrmLaunchLeft.LabVersion.Text = "未找到可用的游戏版本"
FrmLaunchLeft.BtnVersion.IsEnabled = True FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 2 Case 2
Log("[Minecraft] 启动按钮：无 Minecraft 版本，要求下载") Logger.Info("启动按钮：无 Minecraft 版本，要求下载")
FrmLaunchLeft.BtnLaunch.Text = "下载游戏" FrmLaunchLeft.BtnLaunch.Text = "下载游戏"
FrmLaunchLeft.BtnLaunch.IsEnabled = True FrmLaunchLeft.BtnLaunch.IsEnabled = True
FrmLaunchLeft.LabVersion.Text = "未找到可用的游戏版本" FrmLaunchLeft.LabVersion.Text = "未找到可用的游戏版本"
FrmLaunchLeft.BtnVersion.IsEnabled = True FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 3 Case 3
Log("[Minecraft] 启动按钮：Minecraft 版本：" & McInstanceSelected.PathVersion) Logger.Info($"启动按钮：Minecraft 版本：{McInstanceSelected.PathVersion}")
FrmLaunchLeft.BtnLaunch.Text = "启动游戏" FrmLaunchLeft.BtnLaunch.Text = "启动游戏"
FrmLaunchLeft.BtnVersion.IsEnabled = True FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnLaunch.IsEnabled = True FrmLaunchLeft.BtnLaunch.IsEnabled = True
@@ -662,7 +662,7 @@ Finish:
End Select End Select
ExitRefresh: ExitRefresh:
'功能隐藏 '功能隐藏
FrmLaunchLeft.BtnVersion.Visibility = If(Not PageSetupUI.HiddenForceShow AndAlso Settings.Get("UiHiddenFunctionSelect"), Visibility.Collapsed, Visibility.Visible) FrmLaunchLeft.BtnVersion.Visibility = If(Not PageSetupUI.HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenFunctionSelect"), Visibility.Collapsed, Visibility.Visible)
If CurrentState = 3 Then If CurrentState = 3 Then
FrmLaunchLeft.BtnMore.Visibility = FrmLaunchLeft.BtnVersion.Visibility FrmLaunchLeft.BtnMore.Visibility = FrmLaunchLeft.BtnVersion.Visibility
End If End If
@@ -679,7 +679,7 @@ ExitRefresh:
If Not McLaunchProcess.HasExited Then McLaunchProcess.Kill() If Not McLaunchProcess.HasExited Then McLaunchProcess.Kill()
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "取消启动结束进程失败", NotifyLevel.AllUsers) Logger.Error(ex, "取消启动结束进程失败", LogBehavior.Toast)
End Try End Try
End If End If
End Sub End Sub
@@ -708,7 +708,7 @@ ExitRefresh:
Next Next
LabLaunchingStage.Text = "已完成" LabLaunchingStage.Text = "已完成"
Catch ex As Exception Catch ex As Exception
Log(ex, "获取是否启动完成失败，可能是由于启动状态改变导致集合已修改") Logger.Warn(ex, "获取是否启动完成失败，可能是由于启动状态改变导致集合已修改")
Return Return
End Try End Try
LabLaunchingTitle.Text = If(IsLaunched OrElse McLaunchLoaderReal.State = LoadState.Finished, LabLaunchingTitle.Text = If(IsLaunched OrElse McLaunchLoaderReal.State = LoadState.Finished,
@@ -733,7 +733,7 @@ ExitRefresh:
Next Next
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "获取 Minecraft 启动下载器失败，可能是因为启动被取消") Logger.Warn(ex, "获取 Minecraft 启动下载器失败，可能是因为启动被取消")
HasLaunchDownloader = False HasLaunchDownloader = False
End Try End Try
LabLaunchingDownload.Text = FormatFileSize(NetManager.Speed) & "/s" LabLaunchingDownload.Text = FormatFileSize(NetManager.Speed) & "/s"
@@ -769,7 +769,7 @@ ExitRefresh:
End If End If
AniStart(AnimList, "Launching Progress") AniStart(AnimList, "Launching Progress")
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新启动信息失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "刷新启动信息失败")
End Try End Try
End Sub End Sub
Private ShowProgress As Double = 0 Private ShowProgress As Double = 0
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb
+56 -53
View File
@@ -9,7 +9,7 @@ Public Class PageLaunchRight
'快照版提示 '快照版提示
PanHint.Visibility = PanHint.Visibility =
(BuildType <> BuildTypes.Release AndAlso VersionBranchMain = "Official" AndAlso (BuildType <> BuildTypes.Release AndAlso VersionBranchMain = "Official" AndAlso
DonationRank < DonationRanks.Rank23 AndAlso Not CType(Settings.Get("HintSnapshot"), Boolean)).ToVisibility CurrentRank < DonationRank.Rank23 AndAlso Not Settings.Get(Of Boolean)("HintSnapshot")).ToVisibility
End Sub End Sub
#Region "主页" #Region "主页"
@@ -25,25 +25,25 @@ Public Class PageLaunchRight
RefreshReal() RefreshReal()
End SyncLock End SyncLock
Catch ex As Exception Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", If(ModeDebug, NotifyLevel.MsgBox, NotifyLevel.AllUsers)) Logger.Error(ex, "加载 PCL 主页自定义信息失败", If(ModeDebug, LogBehavior.Alert, LogBehavior.Toast))
End Try End Try
End Sub) End Sub)
End Sub End Sub
Private Sub RefreshReal() Private Sub RefreshReal()
Dim Content As String = Nothing, Url As String = Nothing Dim Content As String = Nothing, Url As String = Nothing
Select Case Settings.Get("UiCustomType") Select Case Settings.Get(Of Integer)("UiCustomType")
Case 1 Case 1
'加载本地文件 '加载本地文件
Log("[Page] 主页自定义数据来源：本地文件") Logger.Info("主页自定义数据来源：本地文件")
Content = ReadFile(PathExeFolder & "PCL\Custom.xaml") 'ReadFile 会进行存在检测 Content = FileUtils.TryReadAsString(PathExeFolder & "PCL\Custom.xaml")
Case 2 Case 2
'联网下载 '联网下载
Url = Settings.Get("UiCustomNet") Url = Settings.Get(Of String)("UiCustomNet")
Case 3 Case 3
'预设 '预设
Select Case Settings.Get("UiCustomPreset") Select Case Settings.Get(Of Integer)("UiCustomPreset")
Case 0 Case 0
Log("[Page] 主页预设：你知道吗") Logger.Info("主页预设：你知道吗")
Content = " Content = "
<local:MyCard Title=""你知道吗？"" Margin=""0,0,0,15""> <local:MyCard Title=""你知道吗？"" Margin=""0,0,0,15"">
<TextBlock Margin=""25,38,23,15"" FontSize=""13.5"" IsHitTestVisible=""False"" Text=""{hint}"" TextWrapping=""Wrap"" Foreground=""{DynamicResource ColorBrush1}"" /> <TextBlock Margin=""25,38,23,15"" FontSize=""13.5"" IsHitTestVisible=""False"" Text=""{hint}"" TextWrapping=""Wrap"" Foreground=""{DynamicResource ColorBrush1}"" />
@@ -52,7 +52,7 @@ Public Class PageLaunchRight
Logo=""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"" /> Logo=""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"" />
</local:MyCard>" </local:MyCard>"
Case 1 Case 1
Log("[Page] 主页预设：回声洞") Logger.Info("主页预设：回声洞")
Content = " Content = "
<local:MyCard Title=""回声洞"" Margin=""0,0,0,15""> <local:MyCard Title=""回声洞"" Margin=""0,0,0,15"">
<TextBlock Margin=""25,38,23,15"" FontSize=""13.5"" IsHitTestVisible=""False"" Text=""{cave}"" TextWrapping=""Wrap"" Foreground=""{DynamicResource ColorBrush1}"" /> <TextBlock Margin=""25,38,23,15"" FontSize=""13.5"" IsHitTestVisible=""False"" Text=""{cave}"" TextWrapping=""Wrap"" Foreground=""{DynamicResource ColorBrush1}"" />
@@ -61,64 +61,67 @@ Public Class PageLaunchRight
Logo=""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"" /> Logo=""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"" />
</local:MyCard>" </local:MyCard>"
Case 2 Case 2
Log("[Page] 主页预设：Minecraft 新闻") Logger.Info("主页预设：Minecraft 新闻")
Url = "https://mcnews.meloong.com" Url = "https://mcnews.meloong.com"
Case 3 Case 3
Log("[Page] 主页预设：简单主页") Logger.Info("主页预设：简单主页")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/MFn233/Custom.xaml" Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/MFn233/Custom.xaml"
Case 4 Case 4
Log("[Page] 主页预设：每日整合包推荐") Logger.Info("主页预设：每日整合包推荐")
Url = "https://pclsub.sodamc.com/" Url = "https://pclsub.sodamc.com/"
Case 5 Case 5
Log("[Page] 主页预设：Minecraft 皮肤推荐") Logger.Info("主页预设：Minecraft 皮肤推荐")
Url = "https://forgepixel.com/pcl_sub_file" Url = "https://forgepixel.com/pcl_sub_file"
Case 6 Case 6
Log("[Page] 主页预设：OpenBMCLAPI 仪表盘 Lite") Logger.Info("主页预设：OpenBMCLAPI 仪表盘 Lite")
Url = "https://pcl-bmcl.milu.ink/" Url = "https://pcl-bmcl.milu.ink/"
Case 7 Case 7
Log("[Page] 主页预设：主页市场") Logger.Info("主页预设：主页市场")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/p/Homepages/Homepage.Market/Custom.xaml" Url = "https://pclhomeplazaoss.lingyunawa.top:26994/p/Homepages/Homepage.Market/Custom.xaml"
Case 8 Case 8
Log("[Page] 主页预设：更新日志") Logger.Info("主页预设：更新日志")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/Joker2184/UpdateHomepage.xaml" Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/Joker2184/UpdateHomepage.xaml"
Case 9 Case 9
Log("[Page] 主页预设：PCL 新功能说明书") Logger.Info("主页预设：PCL 新功能说明书")
Url = "https://raw.gitcode.com/WForst-Breeze/WhatsNewPCL/raw/main/Custom.xaml" Url = "https://raw.gitcode.com/WForst-Breeze/WhatsNewPCL/raw/main/Custom.xaml"
Case 10 Case 10
Log("[Page] 主页预设：OpenMCIM Dashboard") Logger.Info("主页预设：OpenMCIM Dashboard")
Url = "https://files.mcimirror.top/PCL" Url = "https://files.mcimirror.top/PCL"
Case 11 Case 11
Log("[Page] 主页预设：杂志主页") Logger.Info("主页预设：杂志主页")
Url = "http://118.195.192.193:26995/d/magazine-homepage-pcl/Custom.xaml" Url = "http://118.195.192.193:26995/d/magazine-homepage-pcl/Custom.xaml"
Case 12 Case 12
Log("[Page] 主页预设：PCL GitHub 仪表盘") Logger.Info("主页预设：PCL GitHub 仪表盘")
Url = "https://ddf.pcl-community.org/Custom.xaml" Url = "https://ddf.pcl-community.top/Custom.xaml"
Case 13 Case 13
Log("[Page] 主页预设：PCL 更新摘要") Logger.Info("主页预设：PCL 更新摘要")
Url = "https://raw.gitcode.com/ENC_Euphony/PCL-AI-Summary-HomePage/raw/master/Custom.xaml" Url = "https://raw.gitcode.com/ENC_Euphony/PCL-AI-Summary-HomePage/raw/master/Custom.xaml"
Case 14 Case 14
Log("[Page] 主页预设：今日新闻热点") Logger.Info("主页预设：今日新闻热点")
Url = "https://pcl.wyc-w.top/index.xaml" Url = "https://pcl.wyc-w.top/index.xaml"
Case 15 Case 15
Log("[Page] 主页预设：Minecraft 芝士站") Logger.Info("主页预设：Minecraft 芝士站")
Url = "https://www.xxag.top/mkss" Url = "https://www.xxag.top/mkss"
Case 16
Logger.Info("主页预设：整合包推荐引擎")
Url = "https://qawsedrftgyhujiko.fun/pcl2/Custom.xaml"
End Select End Select
End Select End Select
'联网下载 '联网下载
If Not String.IsNullOrWhiteSpace(Url) Then If Not String.IsNullOrWhiteSpace(Url) Then
If Url = Settings.Get("CacheSavedPageUrl") AndAlso File.Exists(PathTemp & "Cache\Custom.xaml") Then If Url = Settings.Get(Of String)("CacheSavedPageUrl") AndAlso FileUtils.Exists(PathTemp & "Cache\Custom.xaml") Then
'缓存可用 '缓存可用
Log("[Page] 主页自定义数据来源：联网缓存文件") Logger.Info("主页自定义数据来源：联网缓存文件")
Content = ReadFile(PathTemp & "Cache\Custom.xaml") Content = FileUtils.TryReadAsString(PathTemp & "Cache\Custom.xaml")
'后台更新缓存 '后台更新缓存
OnlineLoader.Start(New Tuple(Of String, Boolean)(Url, False)) OnlineLoader.Start((Url, False))
Else Else
'缓存不可用 '缓存不可用
Log("[Page] 主页自定义数据来源：联网全新下载") Logger.Info("主页自定义数据来源：联网全新下载")
Hint("正在加载主页……") Hint("正在加载主页……")
RunInUiWait(Sub() LoadContent(Nothing)) '在加载结束前清空页面 RunInUiWait(Sub() LoadContent(Nothing)) '在加载结束前清空页面
Settings.Set("CacheSavedPageVersion", "") Settings.Set("CacheSavedPageVersion", "")
OnlineLoader.Start(New Tuple(Of String, Boolean)(Url, True)) '下载完成后将会再次触发更新 OnlineLoader.Start((Url, True)) '下载完成后将会再次触发更新
Return Return
End If End If
End If End If
@@ -128,10 +131,10 @@ Public Class PageLaunchRight
Private RefreshLock As New Object Private RefreshLock As New Object
'联网获取主页文件 '联网获取主页文件
Private OnlineLoader As New LoaderTask(Of Tuple(Of String, Boolean), Integer)("下载主页", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000} Private OnlineLoader As New LoaderTask(Of (Address As String, ShouldRefresh As Boolean), Integer)("下载主页", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
Private Sub OnlineLoaderSub(Task As LoaderTask(Of Tuple(Of String, Boolean), Integer)) Private Sub OnlineLoaderSub(Task As LoaderTask(Of (Address As String, ShouldRefresh As Boolean), Integer))
Dim Address As String = Task.Input.Item1 '#3721 中连续触发两次导致内容变化 Dim Address As String = Task.Input.Address '#3721 中连续触发两次导致内容变化
Dim ShouldRefresh As Boolean = Task.Input.Item2 Dim ShouldRefresh As Boolean = Task.Input.ShouldRefresh
Try Try
'替换自定义变量与设置 '替换自定义变量与设置
Address = ArgumentReplace(Address, AddressOf WebUtility.HtmlEncode) Address = ArgumentReplace(Address, AddressOf WebUtility.HtmlEncode)
@@ -150,26 +153,26 @@ Public Class PageLaunchRight
Try Try
Version = NetRequestByClientRetry(VersionAddress) Version = NetRequestByClientRetry(VersionAddress)
If Version.Length > 1000 Then Throw New Exception($"获取的主页版本过长（{Version.Length} 字符）") If Version.Length > 1000 Then Throw New Exception($"获取的主页版本过长（{Version.Length} 字符）")
Dim CurrentVersion As String = Settings.Get("CacheSavedPageVersion") Dim CurrentVersion As String = Settings.Get(Of String)("CacheSavedPageVersion")
If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then
Log($"[Page] 当前缓存的主页已为最新，当前版本：{Version}，检查源：{VersionAddress}") Logger.Info($"当前缓存的主页已为最新，当前版本：{Version}，检查源：{VersionAddress}")
Return Return
End If End If
Log($"[Page] 需要下载联网主页，当前版本：{Version}，检查源：{VersionAddress}") Logger.Info($"需要下载联网主页，当前版本：{Version}，检查源：{VersionAddress}")
Catch exx As Exception Catch exx As Exception
Log(exx, $"联网获取主页版本失败", NotifyLevel.DevelopOnly) Logger.Warn(exx, $"联网获取主页版本失败")
Log($"[Page] 无法检查联网主页版本，将直接下载，检查源：{VersionAddress}") Logger.Info($"无法检查联网主页版本，将直接下载，检查源：{VersionAddress}")
End Try End Try
'实际下载 '实际下载
Dim FileContent As String = NetRequestByClientRetry(Address) Dim FileContent As String = NetRequestByClientRetry(Address)
Log($"[Page] 已联网下载主页，内容长度：{FileContent.Length}，来源：{Address}") Logger.Info($"已联网下载主页，内容长度：{FileContent.Length}，来源：{Address}")
Settings.Set("CacheSavedPageUrl", Address) Settings.Set("CacheSavedPageUrl", Address)
Settings.Set("CacheSavedPageVersion", Version) Settings.Set("CacheSavedPageVersion", Version)
FileUtils.Write(PathTemp & "Cache\Custom.xaml", FileContent) FileUtils.Write(PathTemp & "Cache\Custom.xaml", FileContent)
'若内容变更则要求刷新 '若内容变更则要求刷新
If LoadedContentHash <> FileContent.GetHashCode() AndAlso ShouldRefresh Then Refresh() If LoadedContentHash <> FileContent.GetHashCode() AndAlso ShouldRefresh Then Refresh()
Catch ex As Exception Catch ex As Exception
Log(ex, $"下载主页失败（{Address}）", If(ModeDebug, NotifyLevel.MsgBox, NotifyLevel.AllUsers)) Logger.Error(ex, $"下载主页失败（{Address}）", If(ModeDebug, LogBehavior.Alert, LogBehavior.Toast))
End Try End Try
End Sub End Sub
@@ -178,7 +181,7 @@ Public Class PageLaunchRight
''' 必须在 UI 线程调用。 ''' 必须在 UI 线程调用。
''' </summary> ''' </summary>
Public Sub ForceRefresh() Implements IRefreshable.Refresh Public Sub ForceRefresh() Implements IRefreshable.Refresh
Log("[Page] 要求强制刷新主页") Logger.Info("要求强制刷新主页")
ClearCache() ClearCache()
'实际的刷新 '实际的刷新
If FrmMain.PageCurrent.Page = FormMain.PageType.Launch Then If FrmMain.PageCurrent.Page = FormMain.PageType.Launch Then
@@ -194,10 +197,10 @@ Public Class PageLaunchRight
''' </summary> ''' </summary>
Private Sub ClearCache() Private Sub ClearCache()
LoadedContentHash = -1 LoadedContentHash = -1
OnlineLoader.Input = New Tuple(Of String, Boolean)("", True) OnlineLoader.Input = ("", True)
Settings.Set("CacheSavedPageUrl", "") Settings.Set("CacheSavedPageUrl", "")
Settings.Set("CacheSavedPageVersion", "") Settings.Set("CacheSavedPageVersion", "")
Log("[Page] 已清空主页缓存") Logger.Info("已清空主页缓存")
End Sub End Sub
''' <summary> ''' <summary>
@@ -214,7 +217,7 @@ Public Class PageLaunchRight
'实际加载内容 '实际加载内容
PanCustom.Children.Clear() PanCustom.Children.Clear()
If String.IsNullOrWhiteSpace(Content) Then If String.IsNullOrWhiteSpace(Content) Then
Log($"[Page] 实例化：清空主页 UI，来源为空") Logger.Info($"实例化：清空主页 UI，来源为空")
Return Return
End If End If
Dim LoadStartTime As Date = Date.Now Dim LoadStartTime As Date = Date.Now
@@ -223,16 +226,16 @@ Public Class PageLaunchRight
Do While Content.Contains("xmlns") Do While Content.Contains("xmlns")
Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间 Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Loop Loop
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>" Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"" xmlns:core=""clr-namespace:MeloongCore;assembly=MeloongCore"" xmlns:corewpf=""clr-namespace:MeloongCore.Wpf;assembly=MeloongCore.Wpf"">" & Content & "</StackPanel>"
Log($"[Page] 实例化：加载主页 UI 开始，最终内容长度：{Content.Count}") Logger.Info($"实例化：加载主页 UI 开始，最终内容长度：{Content.Count}")
PanCustom.Children.Add(GetObjectFromXML(Content)) PanCustom.Children.Add(GetObjectFromXML(Content))
'加载计时 '加载计时
Dim LoadCostTime = (Date.Now - LoadStartTime).Milliseconds Dim LoadCostTime = (Date.Now - LoadStartTime).Milliseconds
Log($"[Page] 实例化：加载主页 UI 完成，耗时 {LoadCostTime}ms") Logger.Info($"实例化：加载主页 UI 完成，耗时 {LoadCostTime}ms")
If LoadCostTime > 3000 Then Hint($"主页加载过于缓慢（花费了 {Math.Round(LoadCostTime / 1000, 1)} 秒），请向主页作者反馈此问题，或暂时停止使用该主页") If LoadCostTime > 3000 Then Hint($"主页加载过于缓慢（花费了 {Math.Round(LoadCostTime / 1000, 1)} 秒），请向主页作者反馈此问题，或暂时停止使用该主页")
End SyncLock End SyncLock
Catch ex As Exception Catch ex As Exception
Log(ex, "加载失败的主页内容：" & vbCrLf & Content) Logger.Warn(ex, $"加载失败的主页内容：{vbCrLf}{Content}")
OnLoadContentFailed(ex) OnLoadContentFailed(ex)
End Try End Try
End Sub End Sub
@@ -240,12 +243,12 @@ Public Class PageLaunchRight
''' 加载主页失败时调用。 ''' 加载主页失败时调用。
''' </summary> ''' </summary>
Private Sub OnLoadContentFailed(ex As Exception) Private Sub OnLoadContentFailed(ex As Exception)
If ModeDebug OrElse Settings.Get("UiCustomType") = 1 Then If ModeDebug OrElse Settings.Get(Of Integer)("UiCustomType") = 1 Then
Log(ex, "加载主页失败") Logger.Warn(ex, "加载主页失败")
If MyMsgBox(If(TypeOf ex Is UnauthorizedAccessException, ex.Message, $"主页内容编写有误，请根据下列错误信息进行检查：{vbCrLf}{ex.GetBrief}"), If MyMsgBox(If(TypeOf ex Is UnauthorizedAccessException, ex.Message, $"主页内容编写有误，请根据下列错误信息进行检查：{vbCrLf}{ex.GetDisplay(False)}"),
"加载主页失败", "重试", "取消") = 1 Then ForceRefresh() "加载主页失败", "重试", "取消") = 1 Then ForceRefresh()
Else Else
Log(ex, "加载主页失败", NotifyLevel.AllUsers) Logger.Error(ex, "加载主页失败", LogBehavior.Toast)
End If End If
End Sub End Sub
''' <summary> ''' <summary>
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb
+12 -12
View File
@@ -5,20 +5,20 @@
''' </summary> ''' </summary>
Public Sub Reload(KeepInput As Boolean) Public Sub Reload(KeepInput As Boolean)
'记住密码 '记住密码
CheckRemember.Checked = Settings.Get("LoginRemember") CheckRemember.Checked = Settings.Get(Of Boolean)("LoginRemember")
If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载，导致文本框里没东西 If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载，导致文本框里没东西
'保留输入，只刷新下拉框列表 '保留输入，只刷新下拉框列表
Dim Input As String = ComboName.Text Dim Input As String = ComboName.Text
ComboName.ItemsSource = If(Settings.Get("LoginAuthEmail") = "", Nothing, Settings.Get("LoginAuthEmail").ToString.Split("¨")) ComboName.ItemsSource = If(Settings.Get(Of String)("LoginAuthEmail") = "", Nothing, Settings.Get(Of String)("LoginAuthEmail").Split("¨"))
ComboName.Text = Input ComboName.Text = Input
Else Else
'不保留输入，刷新列表后自动选择第一项 '不保留输入，刷新列表后自动选择第一项
If Settings.Get("LoginAuthEmail") = "" Then If Settings.Get(Of String)("LoginAuthEmail") = "" Then
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Settings.Get("LoginAuthEmail").ToString.Split("¨") ComboName.ItemsSource = Settings.Get(Of String)("LoginAuthEmail").Split("¨")
ComboName.Text = Settings.Get("LoginAuthEmail").ToString.BeforeFirst("¨") ComboName.Text = Settings.Get(Of String)("LoginAuthEmail").BeforeFirst("¨")
If Settings.Get("LoginRemember") Then TextPass.Password = Settings.Get("LoginAuthPass").ToString.BeforeFirst("¨").Trim If Settings.Get(Of Boolean)("LoginRemember") Then TextPass.Password = Settings.Get(Of String)("LoginAuthPass").BeforeFirst("¨").Trim
End If End If
End If End If
IsFirstLoad = False IsFirstLoad = False
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheAuthServerServer"), Settings.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver" Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get(Of String)("CacheAuthServerServer"), Settings.Get(Of String)("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver"
If FrmLoginAuth Is Nothing Then If FrmLoginAuth Is Nothing Then
Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = "", .Password = "", .Description = "Authlib-Injector", .Type = McLoginType.Auth} Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = "", .Password = "", .Description = "Authlib-Injector", .Type = McLoginType.Auth}
Else Else
@@ -55,10 +55,10 @@
If AniControlEnabled = 0 Then Settings.Set("CacheAuthAccess", "") If AniControlEnabled = 0 Then Settings.Set("CacheAuthAccess", "")
End Sub End Sub
Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged
If sender.SelectedIndex = -1 OrElse Not Settings.Get("LoginRemember") Then If sender.SelectedIndex = -1 OrElse Not Settings.Get(Of Boolean)("LoginRemember") Then
TextPass.Password = "" TextPass.Password = ""
Else Else
TextPass.Password = Settings.Get("LoginAuthPass").ToString.Split("¨")(sender.SelectedIndex).Trim TextPass.Password = Settings.Get(Of String)("LoginAuthPass").ToString.Split("¨")(sender.SelectedIndex).Trim
End If End If
End Sub End Sub
Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change
@@ -71,15 +71,15 @@
End Sub End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then If BtnLink.Content = "注册账号" Then
OpenWebsite(If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister"))) OpenWebsite(If(McInstanceSelected IsNot Nothing, Settings.Get(Of String)("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get(Of String)("CacheAuthServerRegister")))
Else Else
Dim Website As String = If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister")) Dim Website As String = If(McInstanceSelected IsNot Nothing, Settings.Get(Of String)("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get(Of String)("CacheAuthServerRegister"))
OpenWebsite(Website.Replace("/auth/register", "/auth/forgot")) OpenWebsite(Website.Replace("/auth/register", "/auth/forgot"))
End If End If
End Sub End Sub
'切换注册按钮可见性 '切换注册按钮可见性
Private Sub ReloadRegisterButton() Handles Me.Loaded Private Sub ReloadRegisterButton() Handles Me.Loaded
Dim Address As String = If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister")) Dim Address As String = If(McInstanceSelected IsNot Nothing, Settings.Get(Of String)("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get(Of String)("CacheAuthServerRegister"))
BtnLink.Visibility = If(String.IsNullOrEmpty(New ValidateHttp().Validate(Address)), Visibility.Visible, Visibility.Collapsed) BtnLink.Visibility = If(String.IsNullOrEmpty(New ValidateHttp().Validate(Address)), Visibility.Visible, Visibility.Collapsed)
End Sub End Sub
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml.vb
+8 -8
View File
@@ -12,17 +12,17 @@
''' 刷新页面显示的所有信息。 ''' 刷新页面显示的所有信息。
''' </summary> ''' </summary>
Public Sub Reload(KeepInput As Boolean) Public Sub Reload(KeepInput As Boolean)
TextName.Text = Settings.Get("CacheAuthName") TextName.Text = Settings.Get(Of String)("CacheAuthName")
TextEmail.Text = Settings.Get("CacheAuthUsername") TextEmail.Text = Settings.Get(Of String)("CacheAuthUsername")
TextEmail.Visibility = If(Settings.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible) TextEmail.Visibility = If(Settings.Get(Of Boolean)("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible)
PageLoginLegacy_Loaded() PageLoginLegacy_Loaded()
End Sub End Sub
''' <summary> ''' <summary>
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheAuthServerServer"), Settings.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver" Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get(Of String)("CacheAuthServerServer"), Settings.Get(Of String)("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver"
Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = Settings.Get("CacheAuthUsername"), .Password = Settings.Get("CacheAuthPass"), .Description = "Authlib-Injector", .Type = McLoginType.Auth} Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = Settings.Get(Of String)("CacheAuthUsername"), .Password = Settings.Get(Of String)("CacheAuthPass"), .Description = "Authlib-Injector", .Type = McLoginType.Auth}
End Function End Function
Private Sub PageLoginAuthSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter Private Sub PageLoginAuthSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter
@@ -46,7 +46,7 @@
Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click
If McLoginLoader.State = LoadState.Loading Then If McLoginLoader.State = LoadState.Loading Then
Log("[Launch] 要求更换角色，但登录加载器繁忙", NotifyLevel.DebugModeOnly) Logger.Warn("要求更换角色，但登录加载器繁忙")
If TypeOf McLoginLoader.Input Is McLoginServer AndAlso CType(McLoginLoader.Input, McLoginServer).ForceReselectProfile Then If TypeOf McLoginLoader.Input Is McLoginServer AndAlso CType(McLoginLoader.Input, McLoginServer).ForceReselectProfile Then
Hint("正在尝试更换，请稍候！") Hint("正在尝试更换，请稍候！")
Else Else
@@ -65,7 +65,7 @@
McLoginLoader.WaitForExit(Data, IsForceRestart:=True) McLoginLoader.WaitForExit(Data, IsForceRestart:=True)
RunInUi(Sub() Reload(True)) RunInUi(Sub() Reload(True))
Catch ex As Exception Catch ex As Exception
Log(ex, "更换角色失败", NotifyLevel.AllUsers) Logger.Error(ex, "更换角色失败", LogBehavior.Toast)
End Try End Try
End Sub) End Sub)
End Sub End Sub
@@ -78,7 +78,7 @@
End Sub End Sub
Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click
Dim Address As String = If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister")) Dim Address As String = If(McInstanceSelected IsNot Nothing, Settings.Get(Of String)("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get(Of String)("CacheAuthServerRegister"))
If String.IsNullOrEmpty(New ValidateHttp().Validate(Address)) Then OpenWebsite(Address.Replace("/auth/register", "/user/closet")) If String.IsNullOrEmpty(New ValidateHttp().Validate(Address)) Then OpenWebsite(Address.Replace("/auth/register", "/user/closet"))
End Sub End Sub
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb
+8 -8
View File
@@ -18,15 +18,15 @@ Public Class PageLoginLegacy
If KeepInput AndAlso IsReloaded Then '避免第一次就以 KeepInput 的方式加载，导致文本框里没东西 If KeepInput AndAlso IsReloaded Then '避免第一次就以 KeepInput 的方式加载，导致文本框里没东西
'保留输入，只刷新下拉框列表 '保留输入，只刷新下拉框列表
Dim Input As String = ComboName.Text.Trim Dim Input As String = ComboName.Text.Trim
ComboName.ItemsSource = If(Settings.Get("LoginLegacyName") = "", Nothing, Settings.Get("LoginLegacyName").ToString.Split("¨")) ComboName.ItemsSource = If(Settings.Get(Of String)("LoginLegacyName") = "", Nothing, Settings.Get(Of String)("LoginLegacyName").Split("¨"))
ComboName.Text = Input ComboName.Text = Input
Else Else
'不保留输入，刷新列表后自动选择第一项 '不保留输入，刷新列表后自动选择第一项
If Settings.Get("LoginLegacyName") = "" Then If Settings.Get(Of String)("LoginLegacyName") = "" Then
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Settings.Get("LoginLegacyName").ToString.Split("¨") ComboName.ItemsSource = Settings.Get(Of String)("LoginLegacyName").ToString.Split("¨")
ComboName.Text = Settings.Get("LoginLegacyName").ToString.BeforeFirst("¨").Trim ComboName.Text = Settings.Get(Of String)("LoginLegacyName").ToString.BeforeFirst("¨").Trim
End If End If
End If End If
IsReloaded = True IsReloaded = True
@@ -36,7 +36,7 @@ Public Class PageLoginLegacy
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginData Public Shared Function GetLoginData() As McLoginData
Dim UserName As String = If(FrmLoginLegacy Is Nothing, "", FrmLoginLegacy.ComboName.Text.Replace("¨", "").Trim) Dim UserName As String = If(FrmLoginLegacy Is Nothing, "", FrmLoginLegacy.ComboName.Text.Replace("¨", "").Trim)
Return New McLoginLegacy With {.UserName = UserName, .SkinType = Settings.Get("LaunchSkinType"), .SkinName = Settings.Get("LaunchSkinID")} Return New McLoginLegacy With {.UserName = UserName, .SkinType = Settings.Get(Of Integer)("LaunchSkinType"), .SkinName = Settings.Get(Of String)("LaunchSkinID")}
End Function End Function
''' <summary> ''' <summary>
''' 当前页面的登录信息是否有效。 ''' 当前页面的登录信息是否有效。
@@ -62,12 +62,12 @@ Public Class PageLoginLegacy
End If End If
End Sub End Sub
Private Sub ComboLegacy_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged Private Sub ComboLegacy_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged
If Settings.Get("LaunchSkinType") = 0 Then PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True) If Settings.Get(Of Integer)("LaunchSkinType") = 0 Then PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
HintChinese.Visibility = If(RegexCheck(ComboName.Text, "^[0-9A-Za-z_]*$"), Visibility.Collapsed, Visibility.Visible) HintChinese.Visibility = If(ComboName.Text.RegexCheck("^[0-9A-Za-z_]*$"), Visibility.Collapsed, Visibility.Visible)
RunInUi(Sub() PanMain.InvalidateMeasure(), True) '由于 WPF 的 Bug，它不一定会自动更新 HintChinese 的大小（#6627） RunInUi(Sub() PanMain.InvalidateMeasure(), True) '由于 WPF 的 Bug，它不一定会自动更新 HintChinese 的大小（#6627）
End Sub End Sub
Private Sub Skin_Click() Handles Skin.Click Private Sub Skin_Click() Handles Skin.Click
If (Settings.Get("UiHiddenPageSetup") OrElse Settings.Get("UiHiddenSetupLaunch")) AndAlso Not PageSetupUI.HiddenForceShow Then If (Settings.Get(Of Boolean)("UiHiddenPageSetup") OrElse Settings.Get(Of Boolean)("UiHiddenSetupLaunch")) AndAlso Not PageSetupUI.HiddenForceShow Then
Hint("启动设置已被禁用！", HintType.Red) Hint("启动设置已被禁用！", HintType.Red)
Else Else
FrmMain.PageChange(FormMain.PageType.Setup, FormMain.PageSubType.SetupLaunch) '切换到皮肤设置页面 FrmMain.PageChange(FormMain.PageType.Setup, FormMain.PageSubType.SetupLaunch) '切换到皮肤设置页面
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb
+5 -5
View File
@@ -9,7 +9,7 @@
ComboAccounts.Items.Clear() ComboAccounts.Items.Clear()
ComboAccounts.Items.Add(New MyComboBoxItem With {.Content = "添加新账号"}) ComboAccounts.Items.Add(New MyComboBoxItem With {.Content = "添加新账号"})
Try Try
Dim MsJson As JObject = GetJson(Settings.Get("LoginMsJson")) Dim MsJson As JObject = GetJson(Settings.Get(Of String)("LoginMsJson"))
For Each Account In MsJson For Each Account In MsJson
Dim Item As MyListItem = CType(FindResource("ComboBoxItemTemplateWithDelete"), DataTemplate).LoadContent() Dim Item As MyListItem = CType(FindResource("ComboBoxItemTemplateWithDelete"), DataTemplate).LoadContent()
Item.Tag = Account.Value.ToString Item.Tag = Account.Value.ToString
@@ -18,7 +18,7 @@
ComboAccounts.Items.Add(Item) ComboAccounts.Items.Add(Item)
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, $"微软登录信息出错，登录信息已被重置（{Settings.Get("LoginMsJson")}）", NotifyLevel.AllUsers) Logger.Error(ex, $"微软登录信息出错，登录信息已被重置（{Settings.Get(Of String)("LoginMsJson")}）", LogBehavior.Toast)
Settings.Set("LoginMsJson", "{}") Settings.Set("LoginMsJson", "{}")
End Try End Try
'如果不保留输入，刷新列表后自动选择第一项 '如果不保留输入，刷新列表后自动选择第一项
@@ -37,7 +37,7 @@
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginMs Public Shared Function GetLoginData() As McLoginMs
If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Settings.Get("CacheMsV2OAuthRefresh"), .UserName = Settings.Get("CacheMsV2Name")} If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Settings.Get(Of String)("CacheMsV2OAuthRefresh"), .UserName = Settings.Get(Of String)("CacheMsV2Name")}
Dim Result As McLoginMs = Nothing Dim Result As McLoginMs = Nothing
RunInUiWait( RunInUiWait(
Sub() Sub()
@@ -92,9 +92,9 @@
ElseIf ex.Message.StartsWithF("$") Then ElseIf ex.Message.StartsWithF("$") Then
Hint(ex.Message.TrimStart("$"), HintType.Red) Hint(ex.Message.TrimStart("$"), HintType.Red)
ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.Contains("SSL/TLS") Then ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.Contains("SSL/TLS") Then
Log(ex, "正版登录验证失败，请考虑在 [设置 → 其他] 中关闭 [在正版登录时验证 SSL 证书]，然后再试。" & vbCrLf & vbCrLf & "原始错误信息：", NotifyLevel.MsgBox) Logger.Error(ex, $"正版登录验证失败，请考虑在 [设置 → 其他] 中关闭 [在正版登录时验证 SSL 证书]，然后再试。{vbCrLf}{vbCrLf}原始错误信息：", LogBehavior.Alert)
Else Else
Log(ex, "正版登录尝试失败", NotifyLevel.MsgBox) Logger.Error(ex, "正版登录尝试失败", LogBehavior.Alert)
End If End If
Finally Finally
RunInUi( RunInUi(
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb
+21 -16
View File
@@ -12,7 +12,7 @@
''' 刷新页面显示的所有信息。 ''' 刷新页面显示的所有信息。
''' </summary> ''' </summary>
Public Sub Reload(KeepInput As Boolean) Public Sub Reload(KeepInput As Boolean)
TextName.Text = Settings.Get("CacheMsV2Name") TextName.Text = Settings.Get(Of String)("CacheMsV2Name")
'皮肤在 Loaded 加载 '皮肤在 Loaded 加载
End Sub End Sub
''' <summary> ''' <summary>
@@ -20,9 +20,9 @@
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginMs Public Shared Function GetLoginData() As McLoginMs
If McLoginMsLoader.State = LoadState.Finished Then If McLoginMsLoader.State = LoadState.Finished Then
Return New McLoginMs With {.OAuthRefreshToken = Settings.Get("CacheMsV2OAuthRefresh"), .UserName = Settings.Get("CacheMsV2Name"), .AccessToken = Settings.Get("CacheMsV2Access"), .Uuid = Settings.Get("CacheMsV2Uuid"), .ProfileJson = Settings.Get("CacheMsV2ProfileJson")} Return New McLoginMs With {.OAuthRefreshToken = Settings.Get(Of String)("CacheMsV2OAuthRefresh"), .UserName = Settings.Get(Of String)("CacheMsV2Name"), .AccessToken = Settings.Get(Of String)("CacheMsV2Access"), .Uuid = Settings.Get(Of String)("CacheMsV2Uuid"), .ProfileJson = Settings.Get(Of String)("CacheMsV2ProfileJson")}
Else Else
Return New McLoginMs With {.OAuthRefreshToken = Settings.Get("CacheMsV2OAuthRefresh"), .UserName = Settings.Get("CacheMsV2Name")} Return New McLoginMs With {.OAuthRefreshToken = Settings.Get(Of String)("CacheMsV2OAuthRefresh"), .UserName = Settings.Get(Of String)("CacheMsV2Name")}
End If End If
End Function End Function
@@ -49,6 +49,7 @@
Settings.Set("CacheMsV2ProfileJson", "") Settings.Set("CacheMsV2ProfileJson", "")
Settings.Set("CacheMsV2Uuid", "") Settings.Set("CacheMsV2Uuid", "")
Settings.Set("CacheMsV2Name", "") Settings.Set("CacheMsV2Name", "")
Settings.Set("CacheMsV2Expires", 0L)
McLoginMsLoader.Interrupt() McLoginMsLoader.Interrupt()
FrmLaunchLeft.RefreshPage(False, True) FrmLaunchLeft.RefreshPage(False, True)
End Sub End Sub
@@ -88,14 +89,18 @@ Retry:
Thread.Sleep(10) Thread.Sleep(10)
Loop Loop
If McLoginMsLoader.State = LoadState.Failed Then Throw New Exception("登录失败", McLoginMsLoader.Error) If McLoginMsLoader.State = LoadState.Failed Then Throw New Exception("登录失败", McLoginMsLoader.Error)
Dim AccessToken As String = Settings.Get("CacheMsV2Access") Dim AccessToken As String = Settings.Get(Of String)("CacheMsV2Access")
Dim Uuid As String = Settings.Get("CacheMsV2Uuid") Dim Uuid As String = Settings.Get(Of String)("CacheMsV2Uuid")
Dim Result As String = NetRequestByClientRetry("https://api.minecraftservices.com/minecraft/profile/skins", HttpMethod.Post, Dim Result As String = Nothing
Content:=New Net.Http.MultipartFormDataContent From { ResilientUtils.Retry( 'MultipartFormDataContent 在一次请求后就会被 Dispose，所以不能直接 Retry（#8397）
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"}, Sub()
{New Net.Http.ByteArrayContent(ReadFileBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)} Result = NetRequestByClient("https://api.minecraftservices.com/minecraft/profile/skins", HttpMethod.Post,
}, Content:=New Net.Http.MultipartFormDataContent From {
Headers:={{"Authorization", "Bearer " & AccessToken}, {"Accept", "*/*"}, {"User-Agent", "MojangSharp/0.1"}}) {New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
{New Net.Http.ByteArrayContent(FileUtils.ReadAsBytes(SkinInfo.LocalFile)), "file", PathUtils.GetLastPart(SkinInfo.LocalFile)}
},
Headers:={{"Authorization", "Bearer " & AccessToken}, {"Accept", "*/*"}, {"User-Agent", "MojangSharp/0.1"}})
End Sub, 3)
If Result.Contains("request requires user authentication") Then If Result.Contains("request requires user authentication") Then
Hint("正在重新登录，将在登录后自动更改皮肤……") Hint("正在重新登录，将在登录后自动更改皮肤……")
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True) McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
@@ -105,7 +110,7 @@ Retry:
Return Return
End If End If
'获取新皮肤地址 '获取新皮肤地址
Log("[Skin] 皮肤修改返回值：" & vbCrLf & Result) Logger.Info($"皮肤修改返回值：{vbCrLf}{Result}")
Dim ResultJson As JObject = GetJson(Result) Dim ResultJson As JObject = GetJson(Result)
If ResultJson.ContainsKey("errorMessage") Then Throw New Exception(ResultJson("errorMessage").ToString) '#5309 If ResultJson.ContainsKey("errorMessage") Then Throw New Exception(ResultJson("errorMessage").ToString) '#5309
For Each Skin As JObject In ResultJson("skins") For Each Skin As JObject In ResultJson("skins")
@@ -116,15 +121,15 @@ Retry:
Next Next
Throw New Exception("未知错误（" & Result & "）") Throw New Exception("未知错误（" & Result & "）")
Catch ex As Exception Catch ex As Exception
If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then If ex.IsBadNetwork Then
Hint("更改皮肤失败：连接皮肤服务器超时，请稍后再试，或使用 VPN 改善网络环境", HintType.Red) Hint("更改皮肤失败：连接皮肤服务器超时，请稍后再试，或使用 VPN 改善网络环境", HintType.Red)
ElseIf TypeOf ex Is ResponsedWebException AndAlso CType(ex, ResponsedWebException).StatusCode = HttpStatusCode.Unauthorized Then ElseIf TypeOf ex Is HttpRequestCodeException AndAlso CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.Unauthorized Then
Log(ex, "更改皮肤时遭遇 401 错误", NotifyLevel.DevelopOnly) Logger.Warn(ex, "更改皮肤时遭遇 401 错误")
Hint("正在重新登录，将在登录后自动更改皮肤……") Hint("正在重新登录，将在登录后自动更改皮肤……")
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True) McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
GoTo Retry GoTo Retry
Else Else
Log(ex, "更改皮肤失败", NotifyLevel.AllUsers) Logger.Error(ex, "更改皮肤失败", LogBehavior.Toast)
End If End If
Finally Finally
IsChanging = False IsChanging = False
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb
+10 -10
View File
@@ -5,20 +5,20 @@
''' </summary> ''' </summary>
Public Sub Reload(KeepInput As Boolean) Public Sub Reload(KeepInput As Boolean)
'记住密码 '记住密码
CheckRemember.Checked = Settings.Get("LoginRemember") CheckRemember.Checked = Settings.Get(Of Boolean)("LoginRemember")
If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载，导致文本框里没东西 If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载，导致文本框里没东西
'保留输入，只刷新下拉框列表 '保留输入，只刷新下拉框列表
Dim Input As String = ComboName.Text Dim Input As String = ComboName.Text
ComboName.ItemsSource = If(Settings.Get("LoginNideEmail") = "", Nothing, Settings.Get("LoginNideEmail").ToString.Split("¨")) ComboName.ItemsSource = If(Settings.Get(Of String)("LoginNideEmail") = "", Nothing, Settings.Get(Of String)("LoginNideEmail").ToString.Split("¨"))
ComboName.Text = Input ComboName.Text = Input
Else Else
'不保留输入，刷新列表后自动选择第一项 '不保留输入，刷新列表后自动选择第一项
If Settings.Get("LoginNideEmail") = "" Then If Settings.Get(Of String)("LoginNideEmail") = "" Then
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Settings.Get("LoginNideEmail").ToString.Split("¨") ComboName.ItemsSource = Settings.Get(Of String)("LoginNideEmail").Split("¨")
ComboName.Text = Settings.Get("LoginNideEmail").ToString.BeforeFirst("¨") ComboName.Text = Settings.Get(Of String)("LoginNideEmail").BeforeFirst("¨")
If Settings.Get("LoginRemember") Then TextPass.Password = Settings.Get("LoginNidePass").ToString.BeforeFirst("¨").Trim If Settings.Get(Of Boolean)("LoginRemember") Then TextPass.Password = Settings.Get(Of String)("LoginNidePass").BeforeFirst("¨").Trim
End If End If
End If End If
IsFirstLoad = False IsFirstLoad = False
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheNideServer"), Settings.Get("VersionServerNide", Instance:=McInstanceSelected)) Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get(Of String)("CacheNideServer"), Settings.Get(Of String)("VersionServerNide", Instance:=McInstanceSelected))
If FrmLoginNide Is Nothing Then If FrmLoginNide Is Nothing Then
Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = "", .Password = "", .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"} Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = "", .Password = "", .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
Else Else
@@ -55,10 +55,10 @@
If AniControlEnabled = 0 Then Settings.Set("CacheNideAccess", "") If AniControlEnabled = 0 Then Settings.Set("CacheNideAccess", "")
End Sub End Sub
Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged
If sender.SelectedIndex = -1 OrElse Not Settings.Get("LoginRemember") Then If sender.SelectedIndex = -1 OrElse Not Settings.Get(Of Boolean)("LoginRemember") Then
TextPass.Password = "" TextPass.Password = ""
Else Else
TextPass.Password = Settings.Get("LoginNidePass").ToString.Split("¨")(sender.SelectedIndex).Trim TextPass.Password = Settings.Get(Of String)("LoginNidePass").Split("¨")(sender.SelectedIndex).Trim
End If End If
End Sub End Sub
Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change
@@ -71,7 +71,7 @@
End Sub End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then If BtnLink.Content = "注册账号" Then
OpenWebsite("https://login.mc-user.com:233/" & Settings.Get("VersionServerNide", Instance:=McInstanceSelected) & "/register") OpenWebsite("https://login.mc-user.com:233/" & Settings.Get(Of String)("VersionServerNide", Instance:=McInstanceSelected) & "/register")
Else Else
OpenWebsite("https://login.mc-user.com:233/account/login") OpenWebsite("https://login.mc-user.com:233/account/login")
End If End If
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml.vb
+6 -6
View File
@@ -12,17 +12,17 @@
''' 刷新页面显示的所有信息。 ''' 刷新页面显示的所有信息。
''' </summary> ''' </summary>
Public Sub Reload(KeepInput As Boolean) Public Sub Reload(KeepInput As Boolean)
TextName.Text = Settings.Get("CacheNideName") TextName.Text = Settings.Get(Of String)("CacheNideName")
TextEmail.Text = Settings.Get("CacheNideUsername") TextEmail.Text = Settings.Get(Of String)("CacheNideUsername")
TextEmail.Visibility = If(Settings.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible) TextEmail.Visibility = (Not Settings.Get(Of Boolean)("UiLauncherEmail")).ToVisibility
'皮肤在 Loaded 加载 '皮肤在 Loaded 加载
End Sub End Sub
''' <summary> ''' <summary>
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheNideServer"), Settings.Get("VersionServerNide", Instance:=McInstanceSelected)) Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get(Of String)("CacheNideServer"), Settings.Get(Of String)("VersionServerNide", Instance:=McInstanceSelected))
Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = Settings.Get("CacheNideUsername"), .Password = Settings.Get("CacheNidePass"), .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"} Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = Settings.Get(Of String)("CacheNideUsername"), .Password = Settings.Get(Of String)("CacheNidePass"), .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
End Function End Function
Private Sub PageLoginNideSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter Private Sub PageLoginNideSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter
@@ -51,7 +51,7 @@
End Sub End Sub
Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click
OpenWebsite("https://login.mc-user.com:233/" & If(IsNothing(McInstanceSelected), Settings.Get("CacheNideServer"), Settings.Get("VersionServerNide", Instance:=McInstanceSelected)) & "/skin") OpenWebsite("https://login.mc-user.com:233/" & If(IsNothing(McInstanceSelected), Settings.Get(Of String)("CacheNideServer"), Settings.Get(Of String)("VersionServerNide", Instance:=McInstanceSelected)) & "/skin")
End Sub End Sub
End Class End Class
Plain Craft Launcher 2/Pages/PageLink/PageLinkMain.xaml.vb
+48 -50
View File
@@ -25,7 +25,7 @@ Public Class PageLinkMain
If LinkState = NewState Then Return If LinkState = NewState Then Return
Dim OldState = LinkState Dim OldState = LinkState
LinkState = NewState LinkState = NewState
Log($"[Link] 主状态由 {GetStringFromEnum(OldState)} 变更为 {GetStringFromEnum(NewState)}") Logger.Info($"主状态由 {OldState} 变更为 {NewState}")
'触发状态切换 '触发状态切换
RunInUi( RunInUi(
Sub() Sub()
@@ -51,7 +51,7 @@ Public Class PageLinkMain
Case LoadState.Finished Case LoadState.Finished
ChangeState(LinkStates.Finished) ChangeState(LinkStates.Finished)
Case LoadState.Failed Case LoadState.Failed
Telemetry("联机失败", "Exception", FilterUserName(Loader.Error.GetDetail, "*")) Telemetry("联机失败", "Exception", FilterUserName(Loader.Error.GetDisplay(True), "*"))
ChangeState(LinkStates.Failed) ChangeState(LinkStates.Failed)
End Select End Select
End Sub End Sub
@@ -109,7 +109,7 @@ Public Class PageLinkMain
NetworkName = $"P{ServerPort.ConvertRadix(16).PadLeft(4, "0"c)}-{GenerateRandomCode()}" NetworkName = $"P{ServerPort.ConvertRadix(16).PadLeft(4, "0"c)}-{GenerateRandomCode()}"
NetworkSecret = GenerateRandomCode() NetworkSecret = GenerateRandomCode()
DiscoverNodeID = -1 DiscoverNodeID = -1
Log($"[Link] 尝试创建房间，网络名 {NetworkName}，网络密码 {NetworkSecret}，端口 {ServerPort}") Logger.Info($"尝试创建房间，网络名 {NetworkName}，网络密码 {NetworkSecret}，端口 {ServerPort}")
'启动 '启动
ChangeState(LinkStates.Loading) ChangeState(LinkStates.Loading)
End Sub End Sub
@@ -135,7 +135,7 @@ Public Class PageLinkMain
Return Return
End If End If
Code = FixCodeFormat(Code) Code = FixCodeFormat(Code)
Log($"[Link] 实际使用的邀请码：{Code}") Logger.Info($"实际使用的邀请码：{Code}")
'基础信息 '基础信息
IsServerSide = False IsServerSide = False
ServerPort = Code.Substring(1, 4).Upper.ConvertRadix(16, 10) ServerPort = Code.Substring(1, 4).Upper.ConvertRadix(16, 10)
@@ -146,7 +146,7 @@ Public Class PageLinkMain
Else Else
DiscoverNodeID = Code.Substring(20, 3).Upper.ConvertRadix(16, 10) DiscoverNodeID = Code.Substring(20, 3).Upper.ConvertRadix(16, 10)
End If End If
Log($"[Link] 尝试加入房间，网络名 {NetworkName}，网络密码 {NetworkSecret}，端口 {ServerPort}，发现节点 {DiscoverNodeID}") Logger.Info($"尝试加入房间，网络名 {NetworkName}，网络密码 {NetworkSecret}，端口 {ServerPort}，发现节点 {DiscoverNodeID}")
'启动 '启动
LastCode = Code LastCode = Code
ChangeState(LinkStates.Loading) ChangeState(LinkStates.Loading)
@@ -229,15 +229,15 @@ Public Class PageLinkMain
UpdateProgressBar(1) UpdateProgressBar(1)
'显示错误信息 '显示错误信息
LabLoadTitle.Text = FailReason LabLoadTitle.Text = FailReason
Dim Brief As String = LinkLoader.Error.GetBrief Dim Brief As String = LinkLoader.Error.GetDisplay(False)
Dim InnerEx As Exception = LinkLoader.Error Dim InnerEx As Exception = LinkLoader.Error
If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message
Do Until InnerEx.InnerException Is Nothing Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException InnerEx = InnerEx.InnerException
If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message
Loop Loop
LabLoadDesc.Text = If(Brief.StartsWithF("$"), Brief.TrimStart("$"), LinkLoader.Error.GetDetail) LabLoadDesc.Text = If(Brief.StartsWithF("$"), Brief.TrimStart("$"), LinkLoader.Error.GetDisplay(True))
Log(LinkLoader.Error, LabLoadTitle.Text) Logger.Warn(LinkLoader.Error, LabLoadTitle.Text)
End Sub End Sub
'=============================== '===============================
@@ -247,7 +247,7 @@ Public Class PageLinkMain
Private Sub UpdateLoadingPage(Title As String, FailBrief As String) Private Sub UpdateLoadingPage(Title As String, FailBrief As String)
If FailReason = FailBrief & "失败" Then Return If FailReason = FailBrief & "失败" Then Return
FailReason = FailBrief & "失败" FailReason = FailBrief & "失败"
Log("[Link] 开始步骤：" & Title) Logger.Info($"开始步骤：{Title}")
RunInUiWait( RunInUiWait(
Sub() Sub()
If FrmLinkMain Is Nothing OrElse Not FrmLinkMain.LabLoadDesc.IsLoaded Then Return If FrmLinkMain Is Nothing OrElse Not FrmLinkMain.LabLoadDesc.IsLoaded Then Return
@@ -451,21 +451,21 @@ Public Class PageLinkMain
Case Reflection.ProcessorArchitecture.Arm Case Reflection.ProcessorArchitecture.Arm
Architecture = "arm64" Architecture = "arm64"
Case Else Case Else
Log($"[Link] CPU 是不支持的 {Architecture} 架构，这可能会导致联机模块无法启动！", NotifyLevel.DebugModeOnly) Logger.Warn($"CPU 是不支持的 {Architecture} 架构，这可能会导致联机模块无法启动！")
Architecture = "arm64" Architecture = "arm64"
End Select End Select
Log("[Link] CPU 架构：" & Architecture) Logger.Info($"CPU 架构：{Architecture}")
Telemetry("联机开始") Telemetry("联机开始")
'检查 EasyTier 版本 '检查 EasyTier 版本
UpdateLoadingPage("正在检查联机模块版本……", "检查联机模块版本") UpdateLoadingPage("正在检查联机模块版本……", "检查联机模块版本")
If Not (File.Exists(PathEasyTier & "联机模块 CLI.exe") AndAlso File.Exists(PathEasyTier & "联机模块.exe") AndAlso If Not (FileUtils.Exists(PathEasyTier & "联机模块 CLI.exe") AndAlso FileUtils.Exists(PathEasyTier & "联机模块.exe") AndAlso
File.Exists(PathEasyTier & "Packet.dll")) Then FileUtils.Exists(PathEasyTier & "Packet.dll")) Then
Settings.Set("LinkEasyTierVersion", -1) Settings.Set("LinkEasyTierVersion", -1)
End If End If
Dim LocalVersion As Integer = Settings.Get("LinkEasyTierVersion") Dim LocalVersion As Integer = Settings.Get(Of Integer)("LinkEasyTierVersion")
ServerVersion = ServerConfig("Link")("EasyTierVersion") ServerVersion = ServerConfig("Link")("EasyTierVersion")
Dim RequiredFiles As New List(Of NetFile) Dim RequiredFiles As New List(Of NetFile)
Log($"[Link] EasyTier 本地版本：{LocalVersion}，需求版本：{ServerVersion}") Logger.Info($"EasyTier 本地版本：{LocalVersion}，需求版本：{ServerVersion}")
If LocalVersion < ServerVersion Then If LocalVersion < ServerVersion Then
RequiredFiles.Add(New NetFile( RequiredFiles.Add(New NetFile(
ServerConfig("Link")("Downloads").Select(Function(UrlEntry) UrlEntry.ToString.Replace("{arch}", Architecture)), ServerConfig("Link")("Downloads").Select(Function(UrlEntry) UrlEntry.ToString.Replace("{arch}", Architecture)),
@@ -481,28 +481,26 @@ Public Class PageLinkMain
Private Sub InitLaunch(Task As LoaderTask(Of Integer, Integer)) Private Sub InitLaunch(Task As LoaderTask(Of Integer, Integer))
'解压文件 '解压文件
UpdateLoadingPage("正在解压联机模块……", "解压联机模块") UpdateLoadingPage("正在解压联机模块……", "解压联机模块")
If File.Exists(PathEasyTier & "EasyTier.zip") Then If FileUtils.Exists(PathEasyTier & "EasyTier.zip") Then
'解压 '解压
Dim ExtractPath As String = RequestTaskTempFolder() Dim ExtractPath As String = RequestTaskTempFolder()
ExtractCompressedFile(PathEasyTier & "EasyTier.zip", ExtractPath, FileUtils.ExtractToDirectory(PathEasyTier & "EasyTier.zip", ExtractPath,
ProgressIncrementHandler:=Sub(Progress) Task.Progress += Progress * 0.05) progressHandler:=Sub(Percentage) Task.Progress = Percentage * 0.05)
Dim ExtractedPath As String = New DirectoryInfo(ExtractPath).EnumerateDirectories.FirstOrDefault?.FullName DirectoryUtils.Copy(DirectoryUtils.GetDirectories(ExtractPath).First, PathEasyTier)
Log("[Link] 联机模块解压时的临时路径：" & ExtractedPath)
CopyDirectory(ExtractedPath, PathEasyTier)
'重命名 '重命名
File.Delete(PathEasyTier & "联机模块.exe") FileUtils.Delete(PathEasyTier & "联机模块.exe")
File.Move(PathEasyTier & "easytier-core.exe", PathEasyTier & "联机模块.exe") FileUtils.Move(PathEasyTier & "easytier-core.exe", PathEasyTier & "联机模块.exe")
File.Delete(PathEasyTier & "联机模块 CLI.exe") FileUtils.Delete(PathEasyTier & "联机模块 CLI.exe")
File.Move(PathEasyTier & "easytier-cli.exe", PathEasyTier & "联机模块 CLI.exe") FileUtils.Move(PathEasyTier & "easytier-cli.exe", PathEasyTier & "联机模块 CLI.exe")
'清理 '清理
File.Delete(PathEasyTier & "EasyTier.zip") FileUtils.Delete(PathEasyTier & "EasyTier.zip")
Settings.Set("LinkEasyTierVersion", ServerVersion) Settings.Set("LinkEasyTierVersion", ServerVersion)
End If End If
Task.Progress = 0.07 Task.Progress = 0.07
'获取节点列表 '获取节点列表
UpdateLoadingPage("正在获取节点列表……", "获取节点列表") UpdateLoadingPage("正在获取节点列表……", "获取节点列表")
Dim RawPeers As List(Of String) Dim RawPeers As List(Of String)
Dim CustomPeers As String = Settings.Get("LinkCustomPeer") Dim CustomPeers As String = Settings.Get(Of String)("LinkCustomPeer")
If String.IsNullOrWhiteSpace(CustomPeers) Then If String.IsNullOrWhiteSpace(CustomPeers) Then
If DiscoverNodeID = -2 AndAlso Not IsServerSide Then If DiscoverNodeID = -2 AndAlso Not IsServerSide Then
Panic("未填写自定义节点设置", $"$你必须在 {vbLQ}自定义节点{vbRQ} 设置中填写与房主相同的内容，{vbCrLf}才能进入该房间！") Panic("未填写自定义节点设置", $"$你必须在 {vbLQ}自定义节点{vbRQ} 设置中填写与房主相同的内容，{vbCrLf}才能进入该房间！")
@@ -512,7 +510,7 @@ Public Class PageLinkMain
Else Else
If DiscoverNodeID <> -2 AndAlso Not IsServerSide Then Hint("房主可能没有使用自定义节点设置，请确认你们的自定义节点设置是否一致！") If DiscoverNodeID <> -2 AndAlso Not IsServerSide Then Hint("房主可能没有使用自定义节点设置，请确认你们的自定义节点设置是否一致！")
RawPeers = CustomPeers.Split("，,".ToCharArray).Select(Function(p) p.Trim).Where(Function(p) Not String.IsNullOrEmpty(p)).ToList() RawPeers = CustomPeers.Split("，,".ToCharArray).Select(Function(p) p.Trim).Where(Function(p) Not String.IsNullOrEmpty(p)).ToList()
Log("[Link] 使用自定义节点：" & CustomPeers) Logger.Info($"使用自定义节点：{CustomPeers}")
End If End If
Task.Progress = 0.13 Task.Progress = 0.13
'获取空闲端口 '获取空闲端口
@@ -539,7 +537,7 @@ Public Class PageLinkMain
For Each Peer As String In RawPeers For Each Peer As String In RawPeers
Arguments += $" -p=""{Peer}""" Arguments += $" -p=""{Peer}"""
Next Next
If Settings.Get("LinkLatencyMode") = 1 Then Arguments += " --latency-first" If Settings.Get(Of Integer)("LinkLatencyMode") = 1 Then Arguments += " --latency-first"
'启动进程 '启动进程
ProcessStart(Arguments) ProcessStart(Arguments)
Task.Progress = 0.15 Task.Progress = 0.15
@@ -553,7 +551,7 @@ Public Class PageLinkMain
'查找目标节点 '查找目标节点
Dim Ping = GetPeerPing() Dim Ping = GetPeerPing()
If Ping > 0 Then If Ping > 0 Then
Log($"[Link] 已与目标建立连接，当前 Ping 为 {Ping:0.0}ms") Logger.Info($"已与目标建立连接，当前 Ping 为 {Ping:0.0}ms")
Telemetry("联机成功", "Server", IsServerSide, "NAT", NATType) Telemetry("联机成功", "Server", IsServerSide, "NAT", NATType)
Exit Do '退出循环 Exit Do '退出循环
End If End If
@@ -616,7 +614,7 @@ Public Class PageLinkMain
Try Try
RawNodes = GetJson(NetRequestByClient("https://uptime.easytier.cn/api/nodes?page=1&per_page=1000", RequireJson:=True)) RawNodes = GetJson(NetRequestByClient("https://uptime.easytier.cn/api/nodes?page=1&per_page=1000", RequireJson:=True))
Catch exx As Exception Catch exx As Exception
Log(exx, "从源站获取节点列表失败，将使用 CDN 缓存") Logger.Warn(exx, "从源站获取节点列表失败，将使用 CDN 缓存")
RawNodes = GetJson(NetRequestByClientRetry("https://easytier.meloong.com/?page=1&per_page=1000", RequireJson:=True)) RawNodes = GetJson(NetRequestByClientRetry("https://easytier.meloong.com/?page=1&per_page=1000", RequireJson:=True))
IsFallbackRawList = True IsFallbackRawList = True
End Try End Try
@@ -654,18 +652,18 @@ ForcedPass:
ElseIf DiscoverNodeID > 0 Then '>0：作为加入者，根据 ID 选择对应的发现节点；如果没有，使用回退发现节点 ElseIf DiscoverNodeID > 0 Then '>0：作为加入者，根据 ID 选择对应的发现节点；如果没有，使用回退发现节点
SelectedDiscoverNode = Nodes.FirstOrDefault(Function(n) n("id").ToObject(Of Integer) = DiscoverNodeID) SelectedDiscoverNode = Nodes.FirstOrDefault(Function(n) n("id").ToObject(Of Integer) = DiscoverNodeID)
If SelectedDiscoverNode Is Nothing Then If SelectedDiscoverNode Is Nothing Then
Log($"[Link] 未找到 ID {DiscoverNodeID} 的发现节点", NotifyLevel.DebugModeOnly) Logger.Warn($"未找到 ID {DiscoverNodeID} 的发现节点")
Panic("房间已过期", "请让房主重新创建房间！") Panic("房间已过期", "请让房主重新创建房间！")
Throw New ThreadInterruptedException Throw New ThreadInterruptedException
End If End If
End If End If
If SelectedDiscoverNode Is Nothing Then '使用回退发现节点 If SelectedDiscoverNode Is Nothing Then '使用回退发现节点
SelectedDiscoverNode = New JObject From {{"address", FallbackDiscoverAddress}, {"id", FallbackDiscoverID}} SelectedDiscoverNode = New JObject From {{"address", FallbackDiscoverAddress}, {"id", FallbackDiscoverID}}
Log("[Link] 将使用回退发现节点", NotifyLevel.DebugModeOnly) Logger.Warn("将使用回退发现节点")
End If End If
FinalPeers.Add(SelectedDiscoverNode("address").ToString()) FinalPeers.Add(SelectedDiscoverNode("address").ToString())
FinalDiscoverID = SelectedDiscoverNode("id").ToObject(Of Integer) FinalDiscoverID = SelectedDiscoverNode("id").ToObject(Of Integer)
Log($"[Link] 发现节点：{SelectedDiscoverNode("address")} (ID: {FinalDiscoverID})") Logger.Info($"发现节点：{SelectedDiscoverNode("address")} (ID: {FinalDiscoverID})")
'选取中继节点 '选取中继节点
If ModeDebug OrElse Not IsServerSide Then '房主只连接发现节点，不连接中继节点 If ModeDebug OrElse Not IsServerSide Then '房主只连接发现节点，不连接中继节点
Dim RelayCount As Integer = ServerConfig("Link")("RandomPeer").ToObject(Of Integer) Dim RelayCount As Integer = ServerConfig("Link")("RandomPeer").ToObject(Of Integer)
@@ -676,7 +674,7 @@ ForcedPass:
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As Exception Catch ex As Exception
Log(ex, "获取节点列表失败，联机质量可能受到影响", NotifyLevel.AllUsers) Logger.Error(ex, "获取节点列表失败，联机质量可能受到影响", LogBehavior.Toast)
FinalPeers.AddRange(ServerConfig("Link")("Peers").Select(Function(p) p.ToString)) FinalPeers.AddRange(ServerConfig("Link")("Peers").Select(Function(p) p.ToString))
If FinalDiscoverID <= 0 Then If FinalDiscoverID <= 0 Then
FinalPeers.Add(FallbackDiscoverAddress) FinalPeers.Add(FallbackDiscoverAddress)
@@ -716,16 +714,16 @@ ForcedPass:
If ProcessObject.Id = ProcessCore?.Id Then Continue For If ProcessObject.Id = ProcessCore?.Id Then Continue For
If ProcessObject.ProcessName <> "联机模块" AndAlso ProcessObject.ProcessName <> "联机模块 CLI" Then Continue For If ProcessObject.ProcessName <> "联机模块" AndAlso ProcessObject.ProcessName <> "联机模块 CLI" Then Continue For
Try Try
Log("[Link] 停止残留的联机模块，PID：" & ProcessObject.Id & "，进程名：" & ProcessObject.ProcessName) Logger.Info($"停止残留的联机模块，PID：{ProcessObject.Id}，进程名：{ProcessObject.ProcessName}")
ProcessObject.Kill() ProcessObject.Kill()
ProcessObject.Close() ProcessObject.Close()
Catch exx As Exception Catch exx As Exception
Log(exx, $"结束进程失败（{ProcessObject.ProcessName}，PID {ProcessObject.Id}）") Logger.Warn(exx, $"结束进程失败（{ProcessObject.ProcessName}，PID {ProcessObject.Id}）")
End Try End Try
Next Next
'关闭由自身启动的进程 '关闭由自身启动的进程
If ProcessCore IsNot Nothing AndAlso Not ProcessCore.HasExited Then If ProcessCore IsNot Nothing AndAlso Not ProcessCore.HasExited Then
Log("[Link] 停止所启动的联机模块，PID：" & ProcessCore.Id) Logger.Info($"停止所启动的联机模块，PID：{ProcessCore.Id}")
ProcessCore.Kill() ProcessCore.Kill()
ProcessCore.Close() ProcessCore.Close()
ProcessCore = Nothing ProcessCore = Nothing
@@ -734,7 +732,7 @@ ForcedPass:
ProcessOutputHandle?.Dispose() ProcessOutputHandle?.Dispose()
ProcessErrorHandle?.Dispose() ProcessErrorHandle?.Dispose()
Catch ex As Exception Catch ex As Exception
Log(ex, "停止联机模块失败") Logger.Warn(ex, "停止联机模块失败")
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -770,7 +768,7 @@ ForcedPass:
.StandardOutputEncoding = Encoding.UTF8, .StandardOutputEncoding = Encoding.UTF8,
.StandardErrorEncoding = Encoding.UTF8 .StandardErrorEncoding = Encoding.UTF8
} }
Log("[Link] 正在启动 EasyTier：" & Arguments) Logger.Info($"正在启动 EasyTier：{Arguments}")
ProcessCore = New Process With {.StartInfo = Info} ProcessCore = New Process With {.StartInfo = Info}
Dim LogLineHandler = Dim LogLineHandler =
Function(sender As Object, e As DataReceivedEventArgs, Handle As AutoResetEvent) Function(sender As Object, e As DataReceivedEventArgs, Handle As AutoResetEvent)
@@ -782,7 +780,7 @@ ForcedPass:
ProcessLogLine(e.Data) ProcessLogLine(e.Data)
Catch unused As ObjectDisposedException Catch unused As ObjectDisposedException
Catch ex As Exception Catch ex As Exception
Log(ex, "读取 EasyTier 信息失败") Logger.Warn(ex, "读取 EasyTier 信息失败")
End Try End Try
Return Nothing Return Nothing
End Function End Function
@@ -796,15 +794,15 @@ ForcedPass:
End Sub End Sub
Private Sub ProcessLogLine(Line As String) Private Sub ProcessLogLine(Line As String)
'记录日志 '记录日志
Log("[EasyTier] " & Line) Logger.Info(Line)
LogHistory.Enqueue(Line) LogHistory.Enqueue(Line)
If LogHistory.Count >= 10 Then LogHistory.Dequeue() If LogHistory.Count >= 10 Then LogHistory.Dequeue()
'检查日志内容 '检查日志内容
If Line.ContainsIgnoreCase("new peer connection added") Then If Line.ContainsIgnoreCase("new peer connection added") Then
Log("[Link] 已建立连接：" & If(RegexSeek(Line, "(?<=remote_addr.+?"")[^""}]{3,}"), Line), NotifyLevel.DebugModeOnly) Logger.Warn($"已建立连接：{If(Line.RegexSeek("(?<=remote_addr.+?"")[^""}]{3,}"), Line)}")
Update() Update()
ElseIf Line.ContainsIgnoreCase("peer connection removed") Then ElseIf Line.ContainsIgnoreCase("peer connection removed") Then
Log("[Link] 已断开连接：" & If(RegexSeek(Line, "(?<=remote_addr.+?"")[^""}]{3,}"), Line), NotifyLevel.DebugModeOnly) Logger.Warn($"已断开连接：{If(Line.RegexSeek("(?<=remote_addr.+?"")[^""}]{3,}"), Line)}")
Update() Update()
End If End If
End Sub End Sub
@@ -919,7 +917,7 @@ ForcedPass:
Dim CliResult = StartProcessAndGetOutput(PathEasyTier & "联机模块 CLI.exe", $"-o json -p 127.0.0.1:{RPCPort} peer", 2000, Encoding:=Encoding.UTF8, PrintLog:=False) Dim CliResult = StartProcessAndGetOutput(PathEasyTier & "联机模块 CLI.exe", $"-o json -p 127.0.0.1:{RPCPort} peer", 2000, Encoding:=Encoding.UTF8, PrintLog:=False)
'解析 '解析
If Not CliResult.Contains("lat_ms") Then Throw New Exception("CLI 调用失败：" & vbCrLf & CliResult) If Not CliResult.Contains("lat_ms") Then Throw New Exception("CLI 调用失败：" & vbCrLf & CliResult)
If GetUuid() Mod If(ModeDebug, 23, 103) = 0 Then Log("[EasyTier] CLI 输出抽样：" & vbCrLf & CliResult) If GetUuid() Mod If(ModeDebug, 23, 103) = 0 Then Logger.Info($"CLI 输出抽样：{vbCrLf}{CliResult}")
Dim NewPeers As New List(Of Peer) Dim NewPeers As New List(Of Peer)
For Each Line As JObject In CType(GetJson(CliResult), JArray) For Each Line As JObject In CType(GetJson(CliResult), JArray)
Try Try
@@ -930,14 +928,14 @@ ForcedPass:
NewPeers.Add(Peer) NewPeers.Add(Peer)
End If End If
Catch exx As Exception Catch exx As Exception
Log(exx, $"错误的信息（{Line}）") Logger.Warn(exx, $"错误的信息（{Line}）")
End Try End Try
Next Next
'完成 '完成
Peers = NewPeers Peers = NewPeers
FailCount = 0 FailCount = 0
Catch ex As Exception Catch ex As Exception
Log(ex, "获取节点信息失败") Logger.Warn(ex, "获取节点信息失败")
If LinkState = LinkStates.Finished Then If LinkState = LinkStates.Finished Then
FailCount += 1 FailCount += 1
If FailCount >= 4 Then Panic("获取节点信息失败", ex.Message) If FailCount >= 4 Then Panic("获取节点信息失败", ex.Message)
@@ -1011,7 +1009,7 @@ ForcedPass:
'每 200ms 更新进度条 '每 200ms 更新进度条
If LinkState = LinkStates.Loading Then RunInUi(AddressOf UpdateProgressBar) If LinkState = LinkStates.Loading Then RunInUi(AddressOf UpdateProgressBar)
Catch ex As Exception Catch ex As Exception
Log(ex, "联机模块主时钟出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "联机模块主时钟出错")
Thread.Sleep(10000) Thread.Sleep(10000)
End Try End Try
Loop Loop
@@ -1060,7 +1058,7 @@ ForcedPass:
Else Else
HintFinish.Text = "你或者房主的网络环境不太好，" HintFinish.Text = "你或者房主的网络环境不太好，"
End If End If
If String.IsNullOrWhiteSpace(Settings.Get("LinkCustomPeer")) Then If String.IsNullOrWhiteSpace(Settings.Get(Of String)("LinkCustomPeer")) Then
HintFinish.Text &= "正使用社区节点进行中继。" HintFinish.Text &= "正使用社区节点进行中继。"
Else Else
HintFinish.Text &= "正通过自定义节点进行中继。" HintFinish.Text &= "正通过自定义节点进行中继。"
@@ -1102,7 +1100,7 @@ ForcedPass:
SocketFlags.None, SocketFlags.None,
New IPEndPoint(IPAddress.Loopback, 4445)) New IPEndPoint(IPAddress.Loopback, 4445))
Catch ex As Exception Catch ex As Exception
Log(ex, "广播联机房间端口失败") Logger.Warn(ex, "广播联机房间端口失败")
End Try End Try
End If End If
End Sub End Sub
Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml
+156 -342
View File
@@ -117,30 +117,16 @@
<StackPanel Margin="25,40,19,20"> <StackPanel Margin="25,40,19,20">
<TextBlock HorizontalAlignment="Left" Text="以下是近期的高级赞助者们！感谢大家对 PCL 的支持！！！" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" /> <TextBlock HorizontalAlignment="Left" Text="以下是近期的高级赞助者们！感谢大家对 PCL 的支持！！！" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" />
<WrapPanel Margin="0,0,0,10"> <TextBlock Margin="0,1.5,6,0" Text="." /> <WrapPanel Margin="0,0,0,10"> <TextBlock Margin="0,1.5,6,0" Text="." />
<TextBlock Margin="0,1.5,6,0" Text="." /> <TextBlock Margin="0,1.5,6,0" Text="L" />
<TextBlock Margin="0,1.5,6,0" Text="X" />
<TextBlock Margin="0,1.5,6,0" Text="..." />
<TextBlock Margin="0,1.5,6,0" Text="R" />
<TextBlock Margin="0,1.5,6,0" Text="X" /> <TextBlock Margin="0,1.5,6,0" Text="X" />
<TextBlock Margin="0,1.5,6,0" Text="D" /> <TextBlock Margin="0,1.5,6,0" Text="D" />
<TextBlock Margin="0,1.5,6,0" Text="le" /> <TextBlock Margin="0,1.5,6,0" Text="IT" />
<TextBlock Margin="0,1.5,6,0" Text="vv" />
<TextBlock Margin="0,1.5,6,0" Text="卓" /> <TextBlock Margin="0,1.5,6,0" Text="卓" />
<TextBlock Margin="0,1.5,6,0" Text="玖" /> <TextBlock Margin="0,1.5,6,0" Text="玖" />
<TextBlock Margin="0,1.5,6,0" Text="雨" />
<TextBlock Margin="0,1.5,6,0" Text="辰" /> <TextBlock Margin="0,1.5,6,0" Text="辰" />
<TextBlock Margin="0,1.5,6,0" Text="李" /> <TextBlock Margin="0,1.5,6,0" Text="顺" />
<TextBlock Margin="0,1.5,6,0" Text="茧" /> <TextBlock Margin="0,1.5,6,0" Text="茧" />
<TextBlock Margin="0,1.5,6,0" Text="烬" /> <TextBlock Margin="0,1.5,6,0" Text="烬" />
<TextBlock Margin="0,1.5,6,0" Text="莫" />
<TextBlock Margin="0,1.5,6,0" Text="尊" />
<TextBlock Margin="0,1.5,6,0" Text="埃" />
<TextBlock Margin="0,1.5,6,0" Text="灷" />
<TextBlock Margin="0,1.5,6,0" Text="蒙" />
<TextBlock Margin="0,1.5,6,0" Text="鸢" />
<TextBlock Margin="0,1.5,6,0" Text="羽" />
<TextBlock Margin="0,1.5,6,0" Text="梦" />
<TextBlock Margin="0,1.5,6,0" Text="零" />
<TextBlock Margin="0,1.5,6,0" Text="笕" /> <TextBlock Margin="0,1.5,6,0" Text="笕" />
<TextBlock Margin="0,1.5,6,0" Text="枫" /> <TextBlock Margin="0,1.5,6,0" Text="枫" />
<TextBlock Margin="0,1.5,6,0" Text="W" /> <TextBlock Margin="0,1.5,6,0" Text="W" />
@@ -154,104 +140,45 @@
<TextBlock Margin="0,1.5,6,0" Text="谷" /> <TextBlock Margin="0,1.5,6,0" Text="谷" />
<TextBlock Margin="0,1.5,6,0" Text="泽" /> <TextBlock Margin="0,1.5,6,0" Text="泽" />
<TextBlock Margin="0,1.5,6,0" Text="林" /> <TextBlock Margin="0,1.5,6,0" Text="林" />
<TextBlock Margin="0,1.5,6,0" Text="TT" /> <TextBlock Margin="0,1.5,6,0" Text="粥" />
<TextBlock Margin="0,1.5,6,0" Text="。" />
<TextBlock Margin="0,1.5,6,0" Text="泠" />
<TextBlock Margin="0,1.5,6,0" Text="白" />
<TextBlock Margin="0,1.5,6,0" Text="唯" />
<TextBlock Margin="0,1.5,6,0" Text="棠" />
<TextBlock Margin="0,1.5,6,0" Text="沐" />
<TextBlock Margin="0,1.5,6,0" Text="柒ᝰ" />
<TextBlock Margin="0,1.5,6,0" Text="廖" />
<TextBlock Margin="0,1.5,6,0" Text="烨" />
<TextBlock Margin="0,1.5,6,0" Text="yu" /> <TextBlock Margin="0,1.5,6,0" Text="yu" />
<TextBlock Margin="0,1.5,6,0" Text="......" />
<TextBlock Margin="0,1.5,6,0" Text="zjx" />
<TextBlock Margin="0,1.5,6,0" Text="up" />
<TextBlock Margin="0,1.5,6,0" Text="XX" />
<TextBlock Margin="0,1.5,6,0" Text="sjg" />
<TextBlock Margin="0,1.5,6,0" Text="yfx" />
<TextBlock Margin="0,1.5,6,0" Text="💬" /> <TextBlock Margin="0,1.5,6,0" Text="💬" />
<TextBlock Margin="0,1.5,6,0" Text="7%" /> <TextBlock Margin="0,1.5,6,0" Text="7%" />
<TextBlock Margin="0,1.5,6,0" Text="UU" /> <TextBlock Margin="0,1.5,6,0" Text="UU" />
<TextBlock Margin="0,1.5,6,0" Text="PQ" /> <TextBlock Margin="0,1.5,6,0" Text="^^" />
<TextBlock Margin="0,1.5,6,0" Text="tkx" />
<TextBlock Margin="0,1.5,6,0" Text="Siri" /> <TextBlock Margin="0,1.5,6,0" Text="Siri" />
<TextBlock Margin="0,1.5,6,0" Text="bre" /> <TextBlock Margin="0,1.5,6,0" Text="xtq" />
<TextBlock Margin="0,1.5,6,0" Text="qin" /> <TextBlock Margin="0,1.5,6,0" Text="qin" />
<TextBlock Margin="0,1.5,6,0" Text="ZJL" /> <TextBlock Margin="0,1.5,6,0" Text="ZJL" />
<TextBlock Margin="0,1.5,6,0" Text="汐a" /> <TextBlock Margin="0,1.5,6,0" Text="汐a" />
<TextBlock Margin="0,1.5,6,0" Text="PFF" /> <TextBlock Margin="0,1.5,6,0" Text="PFF" />
<TextBlock Margin="0,1.5,6,0" Text="ZYL" /> <TextBlock Margin="0,1.5,6,0" Text="ZYL" />
<TextBlock Margin="0,1.5,6,0" Text="ZYL" />
<TextBlock Margin="0,1.5,6,0" Text="555" />
<TextBlock Margin="0,1.5,6,0" Text="661" />
<TextBlock Margin="0,1.5,6,0" Text="LSP" /> <TextBlock Margin="0,1.5,6,0" Text="LSP" />
<TextBlock Margin="0,1.5,6,0" Text="轩₩" /> <TextBlock Margin="0,1.5,6,0" Text="Van" />
<TextBlock Margin="0,1.5,6,0" Text="zzw" />
<TextBlock Margin="0,1.5,6,0" Text="ybb" />
<TextBlock Margin="0,1.5,6,0" Text="JJJT" />
<TextBlock Margin="0,1.5,6,0" Text="ZCY" />
<TextBlock Margin="0,1.5,6,0" Text="Kiro" />
<TextBlock Margin="0,1.5,6,0" Text="Win" />
<TextBlock Margin="0,1.5,6,0" Text="hhh" /> <TextBlock Margin="0,1.5,6,0" Text="hhh" />
<TextBlock Margin="0,1.5,6,0" Text="bbb" /> <TextBlock Margin="0,1.5,6,0" Text="bbb" />
<TextBlock Margin="0,1.5,6,0" Text="沙轻" /> <TextBlock Margin="0,1.5,6,0" Text="阿宅" />
<TextBlock Margin="0,1.5,6,0" Text="缤语" />
<TextBlock Margin="0,1.5,6,0" Text="xsqs" />
<TextBlock Margin="0,1.5,6,0" Text="空青" />
<TextBlock Margin="0,1.5,6,0" Text="奇才" />
<TextBlock Margin="0,1.5,6,0" Text="聆溪" /> <TextBlock Margin="0,1.5,6,0" Text="聆溪" />
<TextBlock Margin="0,1.5,6,0" Text="柒安" /> <TextBlock Margin="0,1.5,6,0" Text="池木" />
<TextBlock Margin="0,1.5,6,0" Text="君猫" /> <TextBlock Margin="0,1.5,6,0" Text="君猫" />
<TextBlock Margin="0,1.5,6,0" Text="離鬯" />
<TextBlock Margin="0,1.5,6,0" Text="yihe" /> <TextBlock Margin="0,1.5,6,0" Text="yihe" />
<TextBlock Margin="0,1.5,6,0" Text="泽涛" /> <TextBlock Margin="0,1.5,6,0" Text="泽涛" />
<TextBlock Margin="0,1.5,6,0" Text="习页" /> <TextBlock Margin="0,1.5,6,0" Text="习页" />
<TextBlock Margin="0,1.5,6,0" Text="旋叶" />
<TextBlock Margin="0,1.5,6,0" Text="方十" /> <TextBlock Margin="0,1.5,6,0" Text="方十" />
<TextBlock Margin="0,1.5,6,0" Text="苑煜" />
<TextBlock Margin="0,1.5,6,0" Text="沐清" /> <TextBlock Margin="0,1.5,6,0" Text="沐清" />
<TextBlock Margin="0,1.5,6,0" Text="阿杰" /> <TextBlock Margin="0,1.5,6,0" Text="阳仔" />
<TextBlock Margin="0,1.5,6,0" Text="吸管" /> <TextBlock Margin="0,1.5,6,0" Text="吸管" />
<TextBlock Margin="0,1.5,6,0" Text="夜幕" />
<TextBlock Margin="0,1.5,6,0" Text="夜墨" />
<TextBlock Margin="0,1.5,6,0" Text="芥裔" />
<TextBlock Margin="0,1.5,6,0" Text="冯睿" />
<TextBlock Margin="0,1.5,6,0" Text="夜昼" />
<TextBlock Margin="0,1.5,6,0" Text="鎔謙" />
<TextBlock Margin="0,1.5,6,0" Text="三木" />
<TextBlock Margin="0,1.5,6,0" Text="太二" />
<TextBlock Margin="0,1.5,6,0" Text="墨染" />
<TextBlock Margin="0,1.5,6,0" Text="晚点" />
<TextBlock Margin="0,1.5,6,0" Text="景文" />
<TextBlock Margin="0,1.5,6,0" Text="天火" />
<TextBlock Margin="0,1.5,6,0" Text="迟涵" />
<TextBlock Margin="0,1.5,6,0" Text="冬莫" />
<TextBlock Margin="0,1.5,6,0" Text="羽嵩" />
<TextBlock Margin="0,1.5,6,0" Text="湙泽" />
<TextBlock Margin="0,1.5,6,0" Text="梦幻" />
<TextBlock Margin="0,1.5,6,0" Text="嘿嘿" />
<TextBlock Margin="0,1.5,6,0" Text="枫叶" />
<TextBlock Margin="0,1.5,6,0" Text="赤阳" />
<TextBlock Margin="0,1.5,6,0" Text="画猫" />
<TextBlock Margin="0,1.5,6,0" Text="UTA" />
<TextBlock Margin="0,1.5,6,0" Text="柠凉" />
<TextBlock Margin="0,1.5,6,0" Text="本來" />
<TextBlock Margin="0,1.5,6,0" Text="：）" />
<TextBlock Margin="0,1.5,6,0" Text="朔辉" />
<TextBlock Margin="0,1.5,6,0" Text="秋骑" />
<TextBlock Margin="0,1.5,6,0" Text="无一" />
<TextBlock Margin="0,1.5,6,0" Text="老八" />
<TextBlock Margin="0,1.5,6,0" Text="胖子" />
<TextBlock Margin="0,1.5,6,0" Text="御翰" />
<TextBlock Margin="0,1.5,6,0" Text="烛火" />
<TextBlock Margin="0,1.5,6,0" Text="笨挽" />
<TextBlock Margin="0,1.5,6,0" Text="悦木" />
<TextBlock Margin="0,1.5,6,0" Text="林霖" />
<TextBlock Margin="0,1.5,6,0" Text="谷雨" />
<TextBlock Margin="0,1.5,6,0" Text="辞七" />
<TextBlock Margin="0,1.5,6,0" Text="血狐" />
<TextBlock Margin="0,1.5,6,0" Text="君泽" />
<TextBlock Margin="0,1.5,6,0" Text="歧辰" />
<TextBlock Margin="0,1.5,6,0" Text="嗷嗷" />
<TextBlock Margin="0,1.5,6,0" Text="陌陌" />
<TextBlock Margin="0,1.5,6,0" Text="小王" />
<TextBlock Margin="0,1.5,6,0" Text="小龙" />
<TextBlock Margin="0,1.5,6,0" Text="月桂" />
<TextBlock Margin="0,1.5,6,0" Text="沐槿" />
<TextBlock Margin="0,1.5,6,0" Text="雨润" />
<TextBlock Margin="0,1.5,6,0" Text="颜峰" />
<TextBlock Margin="0,1.5,6,0" Text="符符" />
<TextBlock Margin="0,1.5,6,0" Text="冰块" /> <TextBlock Margin="0,1.5,6,0" Text="冰块" />
<TextBlock Margin="0,1.5,6,0" Text="莫林" /> <TextBlock Margin="0,1.5,6,0" Text="莫林" />
<TextBlock Margin="0,1.5,6,0" Text="Gun" /> <TextBlock Margin="0,1.5,6,0" Text="Gun" />
@@ -286,99 +213,72 @@
<TextBlock Margin="0,1.5,6,0" Text="稚苕" /> <TextBlock Margin="0,1.5,6,0" Text="稚苕" />
<TextBlock Margin="0,1.5,6,0" Text="白龙" /> <TextBlock Margin="0,1.5,6,0" Text="白龙" />
<TextBlock Margin="0,1.5,6,0" Text="影杀" /> <TextBlock Margin="0,1.5,6,0" Text="影杀" />
<TextBlock Margin="0,1.5,6,0" Text="惊蛰" />
<TextBlock Margin="0,1.5,6,0" Text="诺兮" />
<TextBlock Margin="0,1.5,6,0" Text="哎哟" />
<TextBlock Margin="0,1.5,6,0" Text="博弈" />
<TextBlock Margin="0,1.5,6,0" Text="白渊" />
<TextBlock Margin="0,1.5,6,0" Text="喃喃" />
<TextBlock Margin="0,1.5,6,0" Text="再说" />
<TextBlock Margin="0,1.5,6,0" Text="愛執" />
<TextBlock Margin="0,1.5,6,0" Text="浮誇" />
<TextBlock Margin="0,1.5,6,0" Text="菜猫" />
<TextBlock Margin="0,1.5,6,0" Text="雪柳" />
<TextBlock Margin="0,1.5,6,0" Text="吉刻" />
<TextBlock Margin="0,1.5,6,0" Text="幻天" />
<TextBlock Margin="0,1.5,6,0" Text="西窗" />
<TextBlock Margin="0,1.5,6,0" Text="赵駉" />
<TextBlock Margin="0,1.5,6,0" Text="三伏" />
<TextBlock Margin="0,1.5,6,0" Text="阿哲" />
<TextBlock Margin="0,1.5,6,0" Text="耄耋" />
<TextBlock Margin="0,1.5,6,0" Text="梦羽" />
<TextBlock Margin="0,1.5,6,0" Text="墨汐" />
<TextBlock Margin="0,1.5,6,0" Text="玄狐" />
<TextBlock Margin="0,1.5,6,0" Text="tusk" />
<TextBlock Margin="0,1.5,6,0" Text="星甲" />
<TextBlock Margin="0,1.5,6,0" Text="YmY" /> <TextBlock Margin="0,1.5,6,0" Text="YmY" />
<TextBlock Margin="0,1.5,6,0" Text="time" />
<TextBlock Margin="0,1.5,6,0" Text="sadv" />
<TextBlock Margin="0,1.5,6,0" Text="gate" />
<TextBlock Margin="0,1.5,6,0" Text="king" />
<TextBlock Margin="0,1.5,6,0" Text="ZHH" /> <TextBlock Margin="0,1.5,6,0" Text="ZHH" />
<TextBlock Margin="0,1.5,6,0" Text="Ezzo" /> <TextBlock Margin="0,1.5,6,0" Text="GUO" />
<TextBlock Margin="0,1.5,6,0" Text="^O^" />
<TextBlock Margin="0,1.5,6,0" Text="gino" /> <TextBlock Margin="0,1.5,6,0" Text="gino" />
<TextBlock Margin="0,1.5,6,0" Text="luoo" />
<TextBlock Margin="0,1.5,6,0" Text="9787" /> <TextBlock Margin="0,1.5,6,0" Text="9787" />
<TextBlock Margin="0,1.5,6,0" Text="HJYz" /> <TextBlock Margin="0,1.5,6,0" Text="Ilyen" />
<TextBlock Margin="0,1.5,6,0" Text="0216" /> <TextBlock Margin="0,1.5,6,0" Text="1950" />
<TextBlock Margin="0,1.5,6,0" Text="DOA" />
<TextBlock Margin="0,1.5,6,0" Text="1001" />
<TextBlock Margin="0,1.5,6,0" Text="Qing" />
<TextBlock Margin="0,1.5,6,0" Text="TOM" />
<TextBlock Margin="0,1.5,6,0" Text="Gaze" />
<TextBlock Margin="0,1.5,6,0" Text="Cella" />
<TextBlock Margin="0,1.5,6,0" Text="Keyn" />
<TextBlock Margin="0,1.5,6,0" Text="AL76" /> <TextBlock Margin="0,1.5,6,0" Text="AL76" />
<TextBlock Margin="0,1.5,6,0" Text="4Ghz" /> <TextBlock Margin="0,1.5,6,0" Text="WAR" />
<TextBlock Margin="0,1.5,6,0" Text="cong" />
<TextBlock Margin="0,1.5,6,0" Text="。_。" /> <TextBlock Margin="0,1.5,6,0" Text="。_。" />
<TextBlock Margin="0,1.5,6,0" Text="lucky" /> <TextBlock Margin="0,1.5,6,0" Text="vbird" />
<TextBlock Margin="0,1.5,6,0" Text="Gd64" />
<TextBlock Margin="0,1.5,6,0" Text="空调c" /> <TextBlock Margin="0,1.5,6,0" Text="空调c" />
<TextBlock Margin="0,1.5,6,0" Text="gugu" />
<TextBlock Margin="0,1.5,6,0" Text="Brant" /> <TextBlock Margin="0,1.5,6,0" Text="Brant" />
<TextBlock Margin="0,1.5,6,0" Text="⁣ 　 　​" /> <TextBlock Margin="0,1.5,6,0" Text="⁣ 　 　​" />
<TextBlock Margin="0,1.5,6,0" Text="RKRK" /> <TextBlock Margin="0,1.5,6,0" Text="RKRK" />
<TextBlock Margin="0,1.5,6,0" Text="verge" />
<TextBlock Margin="0,1.5,6,0" Text="Tarka" /> <TextBlock Margin="0,1.5,6,0" Text="Tarka" />
<TextBlock Margin="0,1.5,6,0" Text="cHEn." /> <TextBlock Margin="0,1.5,6,0" Text="Elysia" />
<TextBlock Margin="0,1.5,6,0" Text="Eiligo" /> <TextBlock Margin="0,1.5,6,0" Text="Eiligo" />
<TextBlock Margin="0,1.5,6,0" Text="友人A" />
<TextBlock Margin="0,1.5,6,0" Text="jiagar" />
<TextBlock Margin="0,1.5,6,0" Text="RANX" /> <TextBlock Margin="0,1.5,6,0" Text="RANX" />
<TextBlock Margin="0,1.5,6,0" Text="hanm" /> <TextBlock Margin="0,1.5,6,0" Text="hanm" />
<TextBlock Margin="0,1.5,6,0" Text="Akula" />
<TextBlock Margin="0,1.5,6,0" Text="54188" /> <TextBlock Margin="0,1.5,6,0" Text="54188" />
<TextBlock Margin="0,1.5,6,0" Text="&amp;#39;" />
<TextBlock Margin="0,1.5,6,0" Text="Cx330" /> <TextBlock Margin="0,1.5,6,0" Text="Cx330" />
<TextBlock Margin="0,1.5,6,0" Text="ZDHK" />
<TextBlock Margin="0,1.5,6,0" Text="ToTxT" /> <TextBlock Margin="0,1.5,6,0" Text="ToTxT" />
<TextBlock Margin="0,1.5,6,0" Text="HzzzT" /> <TextBlock Margin="0,1.5,6,0" Text="HzzzT" />
<TextBlock Margin="0,1.5,6,0" Text="EAger" />
<TextBlock Margin="0,1.5,6,0" Text="ziqian" /> <TextBlock Margin="0,1.5,6,0" Text="ziqian" />
<TextBlock Margin="0,1.5,6,0" Text="kunsir" />
<TextBlock Margin="0,1.5,6,0" Text="LiarCT" />
<TextBlock Margin="0,1.5,6,0" Text="rg_gfc" />
<TextBlock Margin="0,1.5,6,0" Text="Lloora" /> <TextBlock Margin="0,1.5,6,0" Text="Lloora" />
<TextBlock Margin="0,1.5,6,0" Text="调试器" /> <TextBlock Margin="0,1.5,6,0" Text="咕咕柒" />
<TextBlock Margin="0,1.5,6,0" Text="xuque" /> <TextBlock Margin="0,1.5,6,0" Text="xuque" />
<TextBlock Margin="0,1.5,6,0" Text="希希希" />
<TextBlock Margin="0,1.5,6,0" Text="飞猪侠" /> <TextBlock Margin="0,1.5,6,0" Text="飞猪侠" />
<TextBlock Margin="0,1.5,6,0" Text="张卿予" /> <TextBlock Margin="0,1.5,6,0" Text="狐猫喵" />
<TextBlock Margin="0,1.5,6,0" Text="剑骨头" />
<TextBlock Margin="0,1.5,6,0" Text="栀熙阳" />
<TextBlock Margin="0,1.5,6,0" Text="晚雾鹤" />
<TextBlock Margin="0,1.5,6,0" Text="祤之锌" /> <TextBlock Margin="0,1.5,6,0" Text="祤之锌" />
<TextBlock Margin="0,1.5,6,0" Text="金苹果" />
<TextBlock Margin="0,1.5,6,0" Text="云野寂" />
<TextBlock Margin="0,1.5,6,0" Text="金木研" />
<TextBlock Margin="0,1.5,6,0" Text="Scoop" />
<TextBlock Margin="0,1.5,6,0" Text="绘梨衣" />
<TextBlock Margin="0,1.5,6,0" Text="夜小辞" />
<TextBlock Margin="0,1.5,6,0" Text="明月奴" />
<TextBlock Margin="0,1.5,6,0" Text="光和热" />
<TextBlock Margin="0,1.5,6,0" Text="柳贯一" /> <TextBlock Margin="0,1.5,6,0" Text="柳贯一" />
<TextBlock Margin="0,1.5,6,0" Text="湫某辞" />
<TextBlock Margin="0,1.5,6,0" Text="大哈操" />
<TextBlock Margin="0,1.5,6,0" Text="顾東凡" />
<TextBlock Margin="0,1.5,6,0" Text="云之梦" />
<TextBlock Margin="0,1.5,6,0" Text="叶云翳" />
<TextBlock Margin="0,1.5,6,0" Text="爱钱钱" />
<TextBlock Margin="0,1.5,6,0" Text="oaken" />
<TextBlock Margin="0,1.5,6,0" Text="小小球" />
<TextBlock Margin="0,1.5,6,0" Text="徐炳文" /> <TextBlock Margin="0,1.5,6,0" Text="徐炳文" />
<TextBlock Margin="0,1.5,6,0" Text="天羽煜" />
<TextBlock Margin="0,1.5,6,0" Text="小牛马" />
<TextBlock Margin="0,1.5,6,0" Text="折尾猫" />
<TextBlock Margin="0,1.5,6,0" Text="橘雨恋" />
<TextBlock Margin="0,1.5,6,0" Text="耿大壮" />
<TextBlock Margin="0,1.5,6,0" Text="无头像" />
<TextBlock Margin="0,1.5,6,0" Text="格洛芬" />
<TextBlock Margin="0,1.5,6,0" Text="史迪威" />
<TextBlock Margin="0,1.5,6,0" Text="小苏子" />
<TextBlock Margin="0,1.5,6,0" Text="塔塔开" />
<TextBlock Margin="0,1.5,6,0" Text="七代风" />
<TextBlock Margin="0,1.5,6,0" Text="狐狸喵" />
<TextBlock Margin="0,1.5,6,0" Text="俥仔面" />
<TextBlock Margin="0,1.5,6,0" Text="英仙座" />
<TextBlock Margin="0,1.5,6,0" Text="小零子" />
<TextBlock Margin="0,1.5,6,0" Text="白清河" />
<TextBlock Margin="0,1.5,6,0" Text="晚江诗" />
<TextBlock Margin="0,1.5,6,0" Text="諸星洋" />
<TextBlock Margin="0,1.5,6,0" Text="哦哦哦" />
<TextBlock Margin="0,1.5,6,0" Text="咕谷谷" />
<TextBlock Margin="0,1.5,6,0" Text="长白山" />
<TextBlock Margin="0,1.5,6,0" Text="杨某某" />
<TextBlock Margin="0,1.5,6,0" Text="云尘眠" />
<TextBlock Margin="0,1.5,6,0" Text="腐目cx" />
<TextBlock Margin="0,1.5,6,0" Text="大鱻鱼" /> <TextBlock Margin="0,1.5,6,0" Text="大鱻鱼" />
<TextBlock Margin="0,1.5,6,0" Text="颠修钩" /> <TextBlock Margin="0,1.5,6,0" Text="颠修钩" />
<TextBlock Margin="0,1.5,6,0" Text="拉罗克" /> <TextBlock Margin="0,1.5,6,0" Text="拉罗克" />
@@ -411,126 +311,77 @@
<TextBlock Margin="0,1.5,6,0" Text="哒哒哒" /> <TextBlock Margin="0,1.5,6,0" Text="哒哒哒" />
<TextBlock Margin="0,1.5,6,0" Text="咕咕咕" /> <TextBlock Margin="0,1.5,6,0" Text="咕咕咕" />
<TextBlock Margin="0,1.5,6,0" Text="TROLL" /> <TextBlock Margin="0,1.5,6,0" Text="TROLL" />
<TextBlock Margin="0,1.5,6,0" Text="yoyal8" /> <TextBlock Margin="0,1.5,6,0" Text="苦不迭" />
<TextBlock Margin="0,1.5,6,0" Text="童瑞林" />
<TextBlock Margin="0,1.5,6,0" Text="派大鑫" />
<TextBlock Margin="0,1.5,6,0" Text="小年糕" />
<TextBlock Margin="0,1.5,6,0" Text="卡骆儿" />
<TextBlock Margin="0,1.5,6,0" Text="范海辛" />
<TextBlock Margin="0,1.5,6,0" Text="风吹语" />
<TextBlock Margin="0,1.5,6,0" Text="辞熙语" />
<TextBlock Margin="0,1.5,6,0" Text="鸿小运" />
<TextBlock Margin="0,1.5,6,0" Text="陈两仪" />
<TextBlock Margin="0,1.5,6,0" Text="叶辛梓" />
<TextBlock Margin="0,1.5,6,0" Text="窗锁昼" />
<TextBlock Margin="0,1.5,6,0" Text="ITMTX" /> <TextBlock Margin="0,1.5,6,0" Text="ITMTX" />
<TextBlock Margin="0,1.5,6,0" Text="Zh11h" />
<TextBlock Margin="0,1.5,6,0" Text="SEKGY" /> <TextBlock Margin="0,1.5,6,0" Text="SEKGY" />
<TextBlock Margin="0,1.5,6,0" Text="111sui" /> <TextBlock Margin="0,1.5,6,0" Text="111sui" />
<TextBlock Margin="0,1.5,6,0" Text="aKALA" /> <TextBlock Margin="0,1.5,6,0" Text="0fore0" />
<TextBlock Margin="0,1.5,6,0" Text="gyj120" /> <TextBlock Margin="0,1.5,6,0" Text="zkmz4" />
<TextBlock Margin="0,1.5,6,0" Text="Young" /> <TextBlock Margin="0,1.5,6,0" Text="Du1yn" />
<TextBlock Margin="0,1.5,6,0" Text="凌·秋烨" />
<TextBlock Margin="0,1.5,6,0" Text="wujian" />
<TextBlock Margin="0,1.5,6,0" Text="Dshiya" /> <TextBlock Margin="0,1.5,6,0" Text="Dshiya" />
<TextBlock Margin="0,1.5,6,0" Text="G-next" /> <TextBlock Margin="0,1.5,6,0" Text="G-next" />
<TextBlock Margin="0,1.5,6,0" Text="N0rdiK" /> <TextBlock Margin="0,1.5,6,0" Text="张jin浩" />
<TextBlock Margin="0,1.5,6,0" Text="Sphinx" /> <TextBlock Margin="0,1.5,6,0" Text="Duomi" />
<TextBlock Margin="0,1.5,6,0" Text="kimma" />
<TextBlock Margin="0,1.5,6,0" Text="Jupiter" />
<TextBlock Margin="0,1.5,6,0" Text="TINTIN" /> <TextBlock Margin="0,1.5,6,0" Text="TINTIN" />
<TextBlock Margin="0,1.5,6,0" Text="Sakura" />
<TextBlock Margin="0,1.5,6,0" Text="Corpus" /> <TextBlock Margin="0,1.5,6,0" Text="Corpus" />
<TextBlock Margin="0,1.5,6,0" Text="Thgink" /> <TextBlock Margin="0,1.5,6,0" Text="Zemira" />
<TextBlock Margin="0,1.5,6,0" Text="forever" />
<TextBlock Margin="0,1.5,6,0" Text="一哥3.0" /> <TextBlock Margin="0,1.5,6,0" Text="一哥3.0" />
<TextBlock Margin="0,1.5,6,0" Text="PanBIS" /> <TextBlock Margin="0,1.5,6,0" Text="PanBIS" />
<TextBlock Margin="0,1.5,6,0" Text="e1apse" /> <TextBlock Margin="0,1.5,6,0" Text="e1apse" />
<TextBlock Margin="0,1.5,6,0" Text="cmly03" /> <TextBlock Margin="0,1.5,6,0" Text="cmly03" />
<TextBlock Margin="0,1.5,6,0" Text="114514" />
<TextBlock Margin="0,1.5,6,0" Text="YEYEYE" />
<TextBlock Margin="0,1.5,6,0" Text="Phuket" />
<TextBlock Margin="0,1.5,6,0" Text="Atomic" />
<TextBlock Margin="0,1.5,6,0" Text="jiduhui" /> <TextBlock Margin="0,1.5,6,0" Text="jiduhui" />
<TextBlock Margin="0,1.5,6,0" Text="Snowill" /> <TextBlock Margin="0,1.5,6,0" Text="424241" />
<TextBlock Margin="0,1.5,6,0" Text="kvmvvx" />
<TextBlock Margin="0,1.5,6,0" Text="sabrina" />
<TextBlock Margin="0,1.5,6,0" Text="XIruotE" /> <TextBlock Margin="0,1.5,6,0" Text="XIruotE" />
<TextBlock Margin="0,1.5,6,0" Text="Dr.Ayin" /> <TextBlock Margin="0,1.5,6,0" Text="Dr.Ayin" />
<TextBlock Margin="0,1.5,6,0" Text="onlong" /> <TextBlock Margin="0,1.5,6,0" Text="onlong" />
<TextBlock Margin="0,1.5,6,0" Text="zuozhe" /> <TextBlock Margin="0,1.5,6,0" Text="zuozhe" />
<TextBlock Margin="0,1.5,6,0" Text="ling141" /> <TextBlock Margin="0,1.5,6,0" Text="Secular" />
<TextBlock Margin="0,1.5,6,0" Text="zxxxfan" /> <TextBlock Margin="0,1.5,6,0" Text="zxxxfan" />
<TextBlock Margin="0,1.5,6,0" Text="MY17IT" /> <TextBlock Margin="0,1.5,6,0" Text="MY17IT" />
<TextBlock Margin="0,1.5,6,0" Text="張 懙 李" /> <TextBlock Margin="0,1.5,6,0" Text="張 懙 李" />
<TextBlock Margin="0,1.5,6,0" Text="TNT285" /> <TextBlock Margin="0,1.5,6,0" Text="TNT285" />
<TextBlock Margin="0,1.5,6,0" Text="Decade" />
<TextBlock Margin="0,1.5,6,0" Text="laobide" />
<TextBlock Margin="0,1.5,6,0" Text="ccb大神" />
<TextBlock Margin="0,1.5,6,0" Text="plastick" />
<TextBlock Margin="0,1.5,6,0" Text="loouse_" />
<TextBlock Margin="0,1.5,6,0" Text="饺子MC" /> <TextBlock Margin="0,1.5,6,0" Text="饺子MC" />
<TextBlock Margin="0,1.5,6,0" Text="杰 NI 龟" /> <TextBlock Margin="0,1.5,6,0" Text="杰 NI 龟" />
<TextBlock Margin="0,1.5,6,0" Text="kill1122" /> <TextBlock Margin="0,1.5,6,0" Text="Axetere" />
<TextBlock Margin="0,1.5,6,0" Text="super9y" /> <TextBlock Margin="0,1.5,6,0" Text="super9y" />
<TextBlock Margin="0,1.5,6,0" Text="DUANG" />
<TextBlock Margin="0,1.5,6,0" Text="Foxman" /> <TextBlock Margin="0,1.5,6,0" Text="Foxman" />
<TextBlock Margin="0,1.5,6,0" Text="猫yi巴草" />
<TextBlock Margin="0,1.5,6,0" Text="goblind" /> <TextBlock Margin="0,1.5,6,0" Text="goblind" />
<TextBlock Margin="0,1.5,6,0" Text="NeroicX" /> <TextBlock Margin="0,1.5,6,0" Text="NeroicX" />
<TextBlock Margin="0,1.5,6,0" Text="章鱼B26" /> <TextBlock Margin="0,1.5,6,0" Text="章鱼B26" />
<TextBlock Margin="0,1.5,6,0" Text="秦爅QIN" /> <TextBlock Margin="0,1.5,6,0" Text="李領link" />
<TextBlock Margin="0,1.5,6,0" Text="weather" /> <TextBlock Margin="0,1.5,6,0" Text="^－_－^" />
<TextBlock Margin="0,1.5,6,0" Text="qwptpw" />
<TextBlock Margin="0,1.5,6,0" Text="RedLink" />
<TextBlock Margin="0,1.5,6,0" Text="SkyArea" />
<TextBlock Margin="0,1.5,6,0" Text="奶酪Jzy_" />
<TextBlock Margin="0,1.5,6,0" Text="筱星辰⭐" /> <TextBlock Margin="0,1.5,6,0" Text="筱星辰⭐" />
<TextBlock Margin="0,1.5,6,0" Text="Starying" /> <TextBlock Margin="0,1.5,6,0" Text="Flawless" />
<TextBlock Margin="0,1.5,6,0" Text="wwwww" />
<TextBlock Margin="0,1.5,6,0" Text="Buyihan" /> <TextBlock Margin="0,1.5,6,0" Text="Buyihan" />
<TextBlock Margin="0,1.5,6,0" Text="疾驰火车" /> <TextBlock Margin="0,1.5,6,0" Text="我不在线" />
<TextBlock Margin="0,1.5,6,0" Text="鸿星天帝" />
<TextBlock Margin="0,1.5,6,0" Text="跳水的鱼" /> <TextBlock Margin="0,1.5,6,0" Text="跳水的鱼" />
<TextBlock Margin="0,1.5,6,0" Text="咸鱼雷音" /> <TextBlock Margin="0,1.5,6,0" Text="咸鱼雷音" />
<TextBlock Margin="0,1.5,6,0" Text="云映鹤影" /> <TextBlock Margin="0,1.5,6,0" Text="云映鹤影" />
<TextBlock Margin="0,1.5,6,0" Text="金禾向暖" /> <TextBlock Margin="0,1.5,6,0" Text="驿路梨花" />
<TextBlock Margin="0,1.5,6,0" Text="气息荒古" /> <TextBlock Margin="0,1.5,6,0" Text="气息荒古" />
<TextBlock Margin="0,1.5,6,0" Text="milenter" />
<TextBlock Margin="0,1.5,6,0" Text="霜木翔凤" /> <TextBlock Margin="0,1.5,6,0" Text="霜木翔凤" />
<TextBlock Margin="0,1.5,6,0" Text="只见伊人" /> <TextBlock Margin="0,1.5,6,0" Text="唐吉課德" />
<TextBlock Margin="0,1.5,6,0" Text="苏家阿辰" /> <TextBlock Margin="0,1.5,6,0" Text="童年的梦" />
<TextBlock Margin="0,1.5,6,0" Text="未知用户" />
<TextBlock Margin="0,1.5,6,0" Text="时灵风逝" /> <TextBlock Margin="0,1.5,6,0" Text="时灵风逝" />
<TextBlock Margin="0,1.5,6,0" Text="二十四誓" /> <TextBlock Margin="0,1.5,6,0" Text="望月悠月" />
<TextBlock Margin="0,1.5,6,0" Text="英白拉多" /> <TextBlock Margin="0,1.5,6,0" Text="有事掘坟" />
<TextBlock Margin="0,1.5,6,0" Text="红袖添香" />
<TextBlock Margin="0,1.5,6,0" Text="氮气炸锅" />
<TextBlock Margin="0,1.5,6,0" Text="爱源神！" /> <TextBlock Margin="0,1.5,6,0" Text="爱源神！" />
<TextBlock Margin="0,1.5,6,0" Text="小小小马" />
<TextBlock Margin="0,1.5,6,0" Text="未梦领来" />
<TextBlock Margin="0,1.5,6,0" Text="鸡鸡鸡鸡" /> <TextBlock Margin="0,1.5,6,0" Text="鸡鸡鸡鸡" />
<TextBlock Margin="0,1.5,6,0" Text="村里村夫" />
<TextBlock Margin="0,1.5,6,0" Text="阿元颜月" /> <TextBlock Margin="0,1.5,6,0" Text="阿元颜月" />
<TextBlock Margin="0,1.5,6,0" Text="竹林提酒" />
<TextBlock Margin="0,1.5,6,0" Text="黎月红夕" />
<TextBlock Margin="0,1.5,6,0" Text="天下无双" />
<TextBlock Margin="0,1.5,6,0" Text="四月喝茶" />
<TextBlock Margin="0,1.5,6,0" Text="vx：久念" />
<TextBlock Margin="0,1.5,6,0" Text="咫尺之遥" />
<TextBlock Margin="0,1.5,6,0" Text="谁知道喽" />
<TextBlock Margin="0,1.5,6,0" Text="和光同尘" />
<TextBlock Margin="0,1.5,6,0" Text="琉璃柏影" />
<TextBlock Margin="0,1.5,6,0" Text="白鸢鲸落" />
<TextBlock Margin="0,1.5,6,0" Text="陌刀云一" />
<TextBlock Margin="0,1.5,6,0" Text="柠岫汐峪" />
<TextBlock Margin="0,1.5,6,0" Text="敷衍了事" />
<TextBlock Margin="0,1.5,6,0" Text="天穹流星" />
<TextBlock Margin="0,1.5,6,0" Text="歪嘴战神" />
<TextBlock Margin="0,1.5,6,0" Text="南荒北愚" />
<TextBlock Margin="0,1.5,6,0" Text="青衫故人" />
<TextBlock Margin="0,1.5,6,0" Text="幽烛漠鸢" />
<TextBlock Margin="0,1.5,6,0" Text="煎饼硌牙" />
<TextBlock Margin="0,1.5,6,0" Text="无铭芝式" />
<TextBlock Margin="0,1.5,6,0" Text="殷野猫音" />
<TextBlock Margin="0,1.5,6,0" Text="龙门朔辰" />
<TextBlock Margin="0,1.5,6,0" Text="null_000" />
<TextBlock Margin="0,1.5,6,0" Text="霜寒千星" />
<TextBlock Margin="0,1.5,6,0" Text="虫草絮语" />
<TextBlock Margin="0,1.5,6,0" Text="咸鱼冻肉" />
<TextBlock Margin="0,1.5,6,0" Text="六六六折" />
<TextBlock Margin="0,1.5,6,0" Text="摆烂大帝" />
<TextBlock Margin="0,1.5,6,0" Text="念念不忘" />
<TextBlock Margin="0,1.5,6,0" Text="万权之星" />
<TextBlock Margin="0,1.5,6,0" Text="西风所见" />
<TextBlock Margin="0,1.5,6,0" Text="猫猫七子" />
<TextBlock Margin="0,1.5,6,0" Text="雾散別离" />
<TextBlock Margin="0,1.5,6,0" Text="不想社交" /> <TextBlock Margin="0,1.5,6,0" Text="不想社交" />
<TextBlock Margin="0,1.5,6,0" Text="匿迹誊纳" /> <TextBlock Margin="0,1.5,6,0" Text="匿迹誊纳" />
<TextBlock Margin="0,1.5,6,0" Text="城南旧事" /> <TextBlock Margin="0,1.5,6,0" Text="城南旧事" />
@@ -565,80 +416,60 @@
<TextBlock Margin="0,1.5,6,0" Text="空井里蛙" /> <TextBlock Margin="0,1.5,6,0" Text="空井里蛙" />
<TextBlock Margin="0,1.5,6,0" Text="空乐白夜" /> <TextBlock Margin="0,1.5,6,0" Text="空乐白夜" />
<TextBlock Margin="0,1.5,6,0" Text="白色按钮" /> <TextBlock Margin="0,1.5,6,0" Text="白色按钮" />
<TextBlock Margin="0,1.5,6,0" Text="环境更加" />
<TextBlock Margin="0,1.5,6,0" Text="ZOIOML" />
<TextBlock Margin="0,1.5,6,0" Text="泽兰白芷" />
<TextBlock Margin="0,1.5,6,0" Text="春野甘兰" />
<TextBlock Margin="0,1.5,6,0" Text="南音之钧" />
<TextBlock Margin="0,1.5,6,0" Text="川泽于耐" />
<TextBlock Margin="0,1.5,6,0" Text="青木暖火" />
<TextBlock Margin="0,1.5,6,0" Text="天天快乐" />
<TextBlock Margin="0,1.5,6,0" Text="阿克华孜" />
<TextBlock Margin="0,1.5,6,0" Text="yunwuyi" />
<TextBlock Margin="0,1.5,6,0" Text="落幕星空" />
<TextBlock Margin="0,1.5,6,0" Text="muming" /> <TextBlock Margin="0,1.5,6,0" Text="muming" />
<TextBlock Margin="0,1.5,6,0" Text="纸币ORZ" /> <TextBlock Margin="0,1.5,6,0" Text="纸币ORZ" />
<TextBlock Margin="0,1.5,6,0" Text="西蛮qwq" /> <TextBlock Margin="0,1.5,6,0" Text="西蛮qwq" />
<TextBlock Margin="0,1.5,6,0" Text="nyanmjc" /> <TextBlock Margin="0,1.5,6,0" Text="nyanmjc" />
<TextBlock Margin="0,1.5,6,0" Text="J_danzai" />
<TextBlock Margin="0,1.5,6,0" Text="CO2_996" />
<TextBlock Margin="0,1.5,6,0" Text="houteng" /> <TextBlock Margin="0,1.5,6,0" Text="houteng" />
<TextBlock Margin="0,1.5,6,0" Text="無WuAD" />
<TextBlock Margin="0,1.5,6,0" Text="Lioncute" /> <TextBlock Margin="0,1.5,6,0" Text="Lioncute" />
<TextBlock Margin="0,1.5,6,0" Text="MoonSir" />
<TextBlock Margin="0,1.5,6,0" Text="情殇·瑕疵" /> <TextBlock Margin="0,1.5,6,0" Text="情殇·瑕疵" />
<TextBlock Margin="0,1.5,6,0" Text="捌月·拾伍" />
<TextBlock Margin="0,1.5,6,0" Text="CityHaze" /> <TextBlock Margin="0,1.5,6,0" Text="CityHaze" />
<TextBlock Margin="0,1.5,6,0" Text="wdy9527" /> <TextBlock Margin="0,1.5,6,0" Text="wdy9527" />
<TextBlock Margin="0,1.5,6,0" Text="xiaoyuya" />
<TextBlock Margin="0,1.5,6,0" Text="N3W04H" /> <TextBlock Margin="0,1.5,6,0" Text="N3W04H" />
<TextBlock Margin="0,1.5,6,0" Text="久遠 蓮華" /> <TextBlock Margin="0,1.5,6,0" Text="久遠 蓮華" />
<TextBlock Margin="0,1.5,6,0" Text="777seese" />
<TextBlock Margin="0,1.5,6,0" Text=" 脖子右拧" />
<TextBlock Margin="0,1.5,6,0" Text="NicoACG" />
<TextBlock Margin="0,1.5,6,0" Text="许和0331" />
<TextBlock Margin="0,1.5,6,0" Text="HHHbbb" /> <TextBlock Margin="0,1.5,6,0" Text="HHHbbb" />
<TextBlock Margin="0,1.5,6,0" Text="Whelone" /> <TextBlock Margin="0,1.5,6,0" Text="Whelone" />
<TextBlock Margin="0,1.5,6,0" Text="Vergilius." /> <TextBlock Margin="0,1.5,6,0" Text="Beholder" />
<TextBlock Margin="0,1.5,6,0" Text="筱墨OwO" />
<TextBlock Margin="0,1.5,6,0" Text="虫虫OwO" /> <TextBlock Margin="0,1.5,6,0" Text="虫虫OwO" />
<TextBlock Margin="0,1.5,6,0" Text="3355411²" /> <TextBlock Margin="0,1.5,6,0" Text="loveryder" />
<TextBlock Margin="0,1.5,6,0" Text="Sevenfan" />
<TextBlock Margin="0,1.5,6,0" Text="PierceShi" /> <TextBlock Margin="0,1.5,6,0" Text="PierceShi" />
<TextBlock Margin="0,1.5,6,0" Text="Bu1e_Cat" />
<TextBlock Margin="0,1.5,6,0" Text="NuoMi_Z" />
<TextBlock Margin="0,1.5,6,0" Text="Zikyeung" /> <TextBlock Margin="0,1.5,6,0" Text="Zikyeung" />
<TextBlock Margin="0,1.5,6,0" Text="小沉Chen" />
<TextBlock Margin="0,1.5,6,0" Text="QILUOVO" />
<TextBlock Margin="0,1.5,6,0" Text="有鱼sama" />
<TextBlock Margin="0,1.5,6,0" Text="EXcloudZ" />
<TextBlock Margin="0,1.5,6,0" Text="想rua狐狸" />
<TextBlock Margin="0,1.5,6,0" Text="AmorSick" />
<TextBlock Margin="0,1.5,6,0" Text="添加剂ing" /> <TextBlock Margin="0,1.5,6,0" Text="添加剂ing" />
<TextBlock Margin="0,1.5,6,0" Text="Luangum" /> <TextBlock Margin="0,1.5,6,0" Text="Luangum" />
<TextBlock Margin="0,1.5,6,0" Text="CHLSama" /> <TextBlock Margin="0,1.5,6,0" Text="CHLSama" />
<TextBlock Margin="0,1.5,6,0" Text="666abcba" />
<TextBlock Margin="0,1.5,6,0" Text="Sariel小懒" />
<TextBlock Margin="0,1.5,6,0" Text="wanglizhi" /> <TextBlock Margin="0,1.5,6,0" Text="wanglizhi" />
<TextBlock Margin="0,1.5,6,0" Text="chen0701" /> <TextBlock Margin="0,1.5,6,0" Text="chen0701" />
<TextBlock Margin="0,1.5,6,0" Text="androidhi" /> <TextBlock Margin="0,1.5,6,0" Text="江寒_John" />
<TextBlock Margin="0,1.5,6,0" Text="gggg1234" />
<TextBlock Margin="0,1.5,6,0" Text="bentianjia" /> <TextBlock Margin="0,1.5,6,0" Text="bentianjia" />
<TextBlock Margin="0,1.5,6,0" Text="shiroNeko" /> <TextBlock Margin="0,1.5,6,0" Text="yukihomu" />
<TextBlock Margin="0,1.5,6,0" Text="祈愿之星☆" />
<TextBlock Margin="0,1.5,6,0" Text="IIINNNeilII" /> <TextBlock Margin="0,1.5,6,0" Text="IIINNNeilII" />
<TextBlock Margin="0,1.5,6,0" Text="爱游戏的狼" /> <TextBlock Margin="0,1.5,6,0" Text="Morkonce" />
<TextBlock Margin="0,1.5,6,0" Text="大臣的二红" />
<TextBlock Margin="0,1.5,6,0" Text="孤影赴星河" /> <TextBlock Margin="0,1.5,6,0" Text="孤影赴星河" />
<TextBlock Margin="0,1.5,6,0" Text="清闲挺自在" /> <TextBlock Margin="0,1.5,6,0" Text="清闲挺自在" />
<TextBlock Margin="0,1.5,6,0" Text="欢呼与果糖" />
<TextBlock Margin="0,1.5,6,0" Text="飞天大锅饭" /> <TextBlock Margin="0,1.5,6,0" Text="飞天大锅饭" />
<TextBlock Margin="0,1.5,6,0" Text="烟熏秋刀鱼" /> <TextBlock Margin="0,1.5,6,0" Text="烟熏秋刀鱼" />
<TextBlock Margin="0,1.5,6,0" Text="人海不可爱" /> <TextBlock Margin="0,1.5,6,0" Text="人海不可爱" />
<TextBlock Margin="0,1.5,6,0" Text="希希爱睡觉" />
<TextBlock Margin="0,1.5,6,0" Text="六面三倍速" />
<TextBlock Margin="0,1.5,6,0" Text="orangexixi" />
<TextBlock Margin="0,1.5,6,0" Text="gugugaga" />
<TextBlock Margin="0,1.5,6,0" Text="月下如墨黑" />
<TextBlock Margin="0,1.5,6,0" Text="此心无一事" />
<TextBlock Margin="0,1.5,6,0" Text="烂鱼一条线" />
<TextBlock Margin="0,1.5,6,0" Text="欲买桂花酒" />
<TextBlock Margin="0,1.5,6,0" Text="慢悠悠报表" />
<TextBlock Margin="0,1.5,6,0" Text="蓝莓要健康" />
<TextBlock Margin="0,1.5,6,0" Text="Salted fish" />
<TextBlock Margin="0,1.5,6,0" Text="深根地缚灵" />
<TextBlock Margin="0,1.5,6,0" Text="群管机器人" />
<TextBlock Margin="0,1.5,6,0" Text="鱼儿爱上猫" />
<TextBlock Margin="0,1.5,6,0" Text="Anhydride" />
<TextBlock Margin="0,1.5,6,0" Text="帕秋莉~go" />
<TextBlock Margin="0,1.5,6,0" Text="废材狐阿桔" />
<TextBlock Margin="0,1.5,6,0" Text="玉玉小南娘" />
<TextBlock Margin="0,1.5,6,0" Text="欣喜的掌声" />
<TextBlock Margin="0,1.5,6,0" Text="小云爱中国" />
<TextBlock Margin="0,1.5,6,0" Text="内存漫游者" />
<TextBlock Margin="0,1.5,6,0" Text="压力暴大了" />
<TextBlock Margin="0,1.5,6,0" Text="摆地摊的王" /> <TextBlock Margin="0,1.5,6,0" Text="摆地摊的王" />
<TextBlock Margin="0,1.5,6,0" Text="鲜花女男爵" />
<TextBlock Margin="0,1.5,6,0" Text="团结起来！" /> <TextBlock Margin="0,1.5,6,0" Text="团结起来！" />
<TextBlock Margin="0,1.5,6,0" Text="BeiWu_CN" /> <TextBlock Margin="0,1.5,6,0" Text="BeiWu_CN" />
<TextBlock Margin="0,1.5,6,0" Text="渔船制造师" /> <TextBlock Margin="0,1.5,6,0" Text="渔船制造师" />
@@ -654,49 +485,40 @@
<TextBlock Margin="0,1.5,6,0" Text="洒水车之歌" /> <TextBlock Margin="0,1.5,6,0" Text="洒水车之歌" />
<TextBlock Margin="0,1.5,6,0" Text="已被静心了" /> <TextBlock Margin="0,1.5,6,0" Text="已被静心了" />
<TextBlock Margin="0,1.5,6,0" Text="茉莉千百羽" /> <TextBlock Margin="0,1.5,6,0" Text="茉莉千百羽" />
<TextBlock Margin="0,1.5,6,0" Text="289775340" /> <TextBlock Margin="0,1.5,6,0" Text="橘子味笙笙" />
<TextBlock Margin="0,1.5,6,0" Text="baicai1339" /> <TextBlock Margin="0,1.5,6,0" Text="厨师哥布林" />
<TextBlock Margin="0,1.5,6,0" Text="飘逸的花猫" />
<TextBlock Margin="0,1.5,6,0" Text="爱的救赎者" />
<TextBlock Margin="0,1.5,6,0" Text="清墨咕咕咕" />
<TextBlock Margin="0,1.5,6,0" Text="红色枫树叶" />
<TextBlock Margin="0,1.5,6,0" Text="空气避难所" />
<TextBlock Margin="0,1.5,6,0" Text="神秘人的哥" />
<TextBlock Margin="0,1.5,6,0" Text="落雨乄北辰" />
<TextBlock Margin="0,1.5,6,0" Text="一条闲鲨鱼" />
<TextBlock Margin="0,1.5,6,0" Text="一只木元鸽" />
<TextBlock Margin="0,1.5,6,0" Text="W.D.gaster" /> <TextBlock Margin="0,1.5,6,0" Text="W.D.gaster" />
<TextBlock Margin="0,1.5,6,0" Text="星野源.小毅" /> <TextBlock Margin="0,1.5,6,0" Text="星野源.小毅" />
<TextBlock Margin="0,1.5,6,0" Text="mreaaaaay" />
<TextBlock Margin="0,1.5,6,0" Text="Swampday" />
<TextBlock Margin="0,1.5,6,0" Text="Kimonomc" /> <TextBlock Margin="0,1.5,6,0" Text="Kimonomc" />
<TextBlock Margin="0,1.5,6,0" Text="翎安Lingan" /> <TextBlock Margin="0,1.5,6,0" Text="翎安Lingan" />
<TextBlock Margin="0,1.5,6,0" Text="Kizuner630" />
<TextBlock Margin="0,1.5,6,0" Text="Stevens520" /> <TextBlock Margin="0,1.5,6,0" Text="Stevens520" />
<TextBlock Margin="0,1.5,6,0" Text="123456。？" /> <TextBlock Margin="0,1.5,6,0" Text="123456。？" />
<TextBlock Margin="0,1.5,6,0" Text="loading182" /> <TextBlock Margin="0,1.5,6,0" Text="蛋白质_变质" />
<TextBlock Margin="0,1.5,6,0" Text="hhhjtqdydz" />
<TextBlock Margin="0,1.5,6,0" Text="LMY666888" /> <TextBlock Margin="0,1.5,6,0" Text="LMY666888" />
<TextBlock Margin="0,1.5,6,0" Text="DeathHunk" />
<TextBlock Margin="0,1.5,6,0" Text="sheng_1062" /> <TextBlock Margin="0,1.5,6,0" Text="sheng_1062" />
<TextBlock Margin="0,1.5,6,0" Text="Frankie_233" /> <TextBlock Margin="0,1.5,6,0" Text="Zerovaluelh" />
<TextBlock Margin="0,1.5,6,0" Text="izmash0449" />
<TextBlock Margin="0,1.5,6,0" Text="Hashtag233" />
<TextBlock Margin="0,1.5,6,0" Text="Chucky_Luo" />
<TextBlock Margin="0,1.5,6,0" Text="JUST LIKE IT" /> <TextBlock Margin="0,1.5,6,0" Text="JUST LIKE IT" />
<TextBlock Margin="0,1.5,6,0" Text="      极光明落" /> <TextBlock Margin="0,1.5,6,0" Text="      极光明落" />
<TextBlock Margin="0,1.5,6,0" Text="一叶，知秋~" /> <TextBlock Margin="0,1.5,6,0" Text="一叶，知秋~" />
<TextBlock Margin="0,1.5,6,0" Text="joinwick789" />
<TextBlock Margin="0,1.5,6,0" Text="250的敌敌畏" />
<TextBlock Margin="0,1.5,6,0" Text="forever_晨风" /> <TextBlock Margin="0,1.5,6,0" Text="forever_晨风" />
<TextBlock Margin="0,1.5,6,0" Text="Fakecaptain" /> <TextBlock Margin="0,1.5,6,0" Text="Fakecaptain" />
<TextBlock Margin="0,1.5,6,0" Text="C.肥宅快乐水" /> <TextBlock Margin="0,1.5,6,0" Text="C.肥宅快乐水" />
<TextBlock Margin="0,1.5,6,0" Text="QingYiLiang" />
<TextBlock Margin="0,1.5,6,0" Text="arcueid1023" />
<TextBlock Margin="0,1.5,6,0" Text="Mr. Narrator" /> <TextBlock Margin="0,1.5,6,0" Text="Mr. Narrator" />
<TextBlock Margin="0,1.5,6,0" Text="while(true){}" /> <TextBlock Margin="0,1.5,6,0" Text="while(true){}" />
<TextBlock Margin="0,1.5,6,0" Text="Haobot2026" /> <TextBlock Margin="0,1.5,6,0" Text="Haobot2026" />
<TextBlock Margin="0,1.5,6,0" Text="粉色妖精小姐" /> <TextBlock Margin="0,1.5,6,0" Text="粉色妖精小姐" />
<TextBlock Margin="0,1.5,6,0" Text="十六枚铜币丶" />
<TextBlock Margin="0,1.5,6,0" Text="Romarunner" /> <TextBlock Margin="0,1.5,6,0" Text="Romarunner" />
<TextBlock Margin="0,1.5,6,0" Text="凯文卡斯兰娜" />
<TextBlock Margin="0,1.5,6,0" Text="殷殷殷！！！" />
<TextBlock Margin="0,1.5,6,0" Text="打泡泡SAMA" />
<TextBlock Margin="0,1.5,6,0" Text="猫的龙车吸引" />
<TextBlock Margin="0,1.5,6,0" Text="谁念桥边红药" />
<TextBlock Margin="0,1.5,6,0" Text="酱汁饼大可爱" />
<TextBlock Margin="0,1.5,6,0" Text="下水道的鼠鼠" />
<TextBlock Margin="0,1.5,6,0" Text="萨卡兹大蟑螂" />
<TextBlock Margin="0,1.5,6,0" Text="吃麦片的老鼠" />
<TextBlock Margin="0,1.5,6,0" Text="双狼天下第一" /> <TextBlock Margin="0,1.5,6,0" Text="双狼天下第一" />
<TextBlock Margin="0,1.5,6,0" Text="丿地狱天使丿" /> <TextBlock Margin="0,1.5,6,0" Text="丿地狱天使丿" />
<TextBlock Margin="0,1.5,6,0" Text="回忆随缘而起" /> <TextBlock Margin="0,1.5,6,0" Text="回忆随缘而起" />
@@ -704,63 +526,55 @@
<TextBlock Margin="0,1.5,6,0" Text="想不到丶名字" /> <TextBlock Margin="0,1.5,6,0" Text="想不到丶名字" />
<TextBlock Margin="0,1.5,6,0" Text="叙事的第一周" /> <TextBlock Margin="0,1.5,6,0" Text="叙事的第一周" />
<TextBlock Margin="0,1.5,6,0" Text="这位是非人类" /> <TextBlock Margin="0,1.5,6,0" Text="这位是非人类" />
<TextBlock Margin="0,1.5,6,0" Text="小石潭记qwq" /> <TextBlock Margin="0,1.5,6,0" Text="红白巫女です" />
<TextBlock Margin="0,1.5,6,0" Text="吃满保底之人" />
<TextBlock Margin="0,1.5,6,0" Text="Sylph_茜尔芙" /> <TextBlock Margin="0,1.5,6,0" Text="Sylph_茜尔芙" />
<TextBlock Margin="0,1.5,6,0" Text="dadadadada" /> <TextBlock Margin="0,1.5,6,0" Text="dadadadada" />
<TextBlock Margin="0,1.5,6,0" Text="longmao666" />
<TextBlock Margin="0,1.5,6,0" Text="Awolfofcolor" /> <TextBlock Margin="0,1.5,6,0" Text="Awolfofcolor" />
<TextBlock Margin="0,1.5,6,0" Text="Omori_sunny" />
<TextBlock Margin="0,1.5,6,0" Text="请不要打luosi" /> <TextBlock Margin="0,1.5,6,0" Text="请不要打luosi" />
<TextBlock Margin="0,1.5,6,0" Text="qingtian4135" /> <TextBlock Margin="0,1.5,6,0" Text="ン黑色幽默🏮" />
<TextBlock Margin="0,1.5,6,0" Text="xiaolong_492" />
<TextBlock Margin="0,1.5,6,0" Text="guduzihaoge" />
<TextBlock Margin="0,1.5,6,0" Text="Rinshonagon" /> <TextBlock Margin="0,1.5,6,0" Text="Rinshonagon" />
<TextBlock Margin="0,1.5,6,0" Text="Tincyclopedia" /> <TextBlock Margin="0,1.5,6,0" Text="esj554611445" />
<TextBlock Margin="0,1.5,6,0" Text="minecraftac11" /> <TextBlock Margin="0,1.5,6,0" Text="Chara＆Chara" />
<TextBlock Margin="0,1.5,6,0" Text="lightning_bolt" />
<TextBlock Margin="0,1.5,6,0" Text="123456789000" /> <TextBlock Margin="0,1.5,6,0" Text="123456789000" />
<TextBlock Margin="0,1.5,6,0" Text="zishuijing2021" /> <TextBlock Margin="0,1.5,6,0" Text="捞猴子的月亮呐" />
<TextBlock Margin="0,1.5,6,0" Text="qq1967131327" /> <TextBlock Margin="0,1.5,6,0" Text="躁郁钢管大魅魔" />
<TextBlock Margin="0,1.5,6,0" Text="智慧树下铭记我" /> <TextBlock Margin="0,1.5,6,0" Text="智慧树下铭记我" />
<TextBlock Margin="0,1.5,6,0" Text="无垠回荡克雷松" /> <TextBlock Margin="0,1.5,6,0" Text="无垠回荡克雷松" />
<TextBlock Margin="0,1.5,6,0" Text="泪水打湿泪水湿" />
<TextBlock Margin="0,1.5,6,0" Text="みやぐにあかり" />
<TextBlock Margin="0,1.5,6,0" Text="苇名剑圣有地绫" />
<TextBlock Margin="0,1.5,6,0" Text="搔首弄姿那些年" />
<TextBlock Margin="0,1.5,6,0" Text="逐梦青年当自强" />
<TextBlock Margin="0,1.5,6,0" Text="哈基米南北路多" />
<TextBlock Margin="0,1.5,6,0" Text="休伯利安养老院" />
<TextBlock Margin="0,1.5,6,0" Text="名为咸鱼的渣子" /> <TextBlock Margin="0,1.5,6,0" Text="名为咸鱼的渣子" />
<TextBlock Margin="0,1.5,6,0" Text="零落不知猫寻海" /> <TextBlock Margin="0,1.5,6,0" Text="零落不知猫寻海" />
<TextBlock Margin="0,1.5,6,0" Text="大脑斧和哒老虎" /> <TextBlock Margin="0,1.5,6,0" Text="大脑斧和哒老虎" />
<TextBlock Margin="0,1.5,6,0" Text="再来一笼小笼包" />
<TextBlock Margin="0,1.5,6,0" Text="玩魔术的暗杀者" />
<TextBlock Margin="0,1.5,6,0" Text="只留清白在人间" />
<TextBlock Margin="0,1.5,6,0" Text="maboyuaneasy" /> <TextBlock Margin="0,1.5,6,0" Text="maboyuaneasy" />
<TextBlock Margin="0,1.5,6,0" Text="照井黎Terui_Rei" /> <TextBlock Margin="0,1.5,6,0" Text="Kiana Kasiana" />
<TextBlock Margin="0,1.5,6,0" Text="约翰·冯·海格力斯" />
<TextBlock Margin="0,1.5,6,0" Text="南ིྀ熙ིྀ寒ིྀ笙ིྀ" /> <TextBlock Margin="0,1.5,6,0" Text="南ིྀ熙ིྀ寒ིྀ笙ིྀ" />
<TextBlock Margin="0,1.5,6,0" Text="18949212459aa" /> <TextBlock Margin="0,1.5,6,0" Text="18949212459aa" />
<TextBlock Margin="0,1.5,6,0" Text="M3GALOVANIA" /> <TextBlock Margin="0,1.5,6,0" Text="M3GALOVANIA" />
<TextBlock Margin="0,1.5,6,0" Text="星之梦Hoshino_" />
<TextBlock Margin="0,1.5,6,0" Text="某不知名的GWM" />
<TextBlock Margin="0,1.5,6,0" Text="MrFudgeSquare" />
<TextBlock Margin="0,1.5,6,0" Text="WeimingFanzhe" /> <TextBlock Margin="0,1.5,6,0" Text="WeimingFanzhe" />
<TextBlock Margin="0,1.5,6,0" Text="筱筱雨吖_Official" /> <TextBlock Margin="0,1.5,6,0" Text="筱筱雨吖_Official" />
<TextBlock Margin="0,1.5,6,0" Text="PolarPanda2333" />
<TextBlock Margin="0,1.5,6,0" Text="大笨蛋你在里面吗" /> <TextBlock Margin="0,1.5,6,0" Text="大笨蛋你在里面吗" />
<TextBlock Margin="0,1.5,6,0" Text="斯卡里茨皇家铁匠" /> <TextBlock Margin="0,1.5,6,0" Text="斯卡里茨皇家铁匠" />
<TextBlock Margin="0,1.5,6,0" Text="憧憬成为冲系战狼" /> <TextBlock Margin="0,1.5,6,0" Text="憧憬成为冲系战狼" />
<TextBlock Margin="0,1.5,6,0" Text="把烦恼丢进云海里" /> <TextBlock Margin="0,1.5,6,0" Text="把烦恼丢进云海里" />
<TextBlock Margin="0,1.5,6,0" Text="记得零食分我一半" />
<TextBlock Margin="0,1.5,6,0" Text="好好吃饭好好睡觉" />
<TextBlock Margin="0,1.5,6,0" Text="六月に舞う雪の鳶" />
<TextBlock Margin="0,1.5,6,0" Text="AAALLLAAANNN" />
<TextBlock Margin="0,1.5,6,0" Text="Minecraft_DeBug" /> <TextBlock Margin="0,1.5,6,0" Text="Minecraft_DeBug" />
<TextBlock Margin="0,1.5,6,0" Text="Black_Banana_Cat" />
<TextBlock Margin="0,1.5,6,0" Text="祖国未来的狗尾巴草" /> <TextBlock Margin="0,1.5,6,0" Text="祖国未来的狗尾巴草" />
<TextBlock Margin="0,1.5,6,0" Text="山有扶苏，隰有荷华" />
<TextBlock Margin="0,1.5,6,0" Text="月亮呼了星星一巴掌" />
<TextBlock Margin="0,1.5,6,0" Text="窝绰承保拾憶闪富拉" />
<TextBlock Margin="0,1.5,6,0" Text="化权埵萨柯摩，隆奎" /> <TextBlock Margin="0,1.5,6,0" Text="化权埵萨柯摩，隆奎" />
<TextBlock Margin="0,1.5,6,0" Text="AAA今州耙耙柑批发" /> <TextBlock Margin="0,1.5,6,0" Text="AAA今州耙耙柑批发" />
<TextBlock Margin="0,1.5,6,0" Text="Mercuryearedrabbit" /> <TextBlock Margin="0,1.5,6,0" Text="W0nd3rfu1 H34v3n" />
<TextBlock Margin="0,1.5,6,0" Text="So Sweet Bitter Days" /> <TextBlock Margin="0,1.5,6,0" Text="So Sweet Bitter Days" />
<TextBlock Margin="0,1.5,6,0" Text="没有翅膀却想飞上天空" /> <TextBlock Margin="0,1.5,6,0" Text="没有翅膀却想飞上天空" />
<TextBlock Margin="0,1.5,6,0" Text="Exeller（没钱的腐竹）" /> <TextBlock Margin="0,1.5,6,0" Text="牛至涂芥末越冲越上头" />
<TextBlock Margin="0,1.5,6,0" Text="正电荷PositiveCharge" /> <TextBlock Margin="0,1.5,6,0" Text="正电荷PositiveCharge" />
<TextBlock Margin="0,1.5,6,0" Text="沒錢點UberEats也不會變有錢" /> <TextBlock Margin="0,1.5,6,0" Text="(ꐦ°᷄д°᷅)咱也不敢问啊" />
<TextBlock Margin="0,1.5,6,0" Text="去撞南墙再撞北墙然后西墙最后东墙" />
</WrapPanel> </WrapPanel>
<Grid Height="35"> <Grid Height="35">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb
+4 -13
View File
@@ -61,7 +61,7 @@
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "加载帮助列表 UI 失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "加载帮助列表 UI 失败")
End Try End Try
End Sub End Sub
@@ -76,7 +76,7 @@
EnterHelpPage(Entry) EnterHelpPage(Entry)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "处理帮助项目点击时发生意外错误", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "处理帮助项目点击时发生意外错误")
End Try End Try
End Sub End Sub
Public Shared Sub EnterHelpPage(Location As String) Public Shared Sub EnterHelpPage(Location As String)
@@ -90,7 +90,7 @@
If FrmHelpDetail.Init(Entry) Then If FrmHelpDetail.Init(Entry) Then
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}}) FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}})
Else Else
Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", NotifyLevel.DebugModeOnly) Logger.Warn("已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃")
End If End If
End Sub) End Sub)
End Sub) End Sub)
@@ -105,20 +105,11 @@
If FrmHelpDetail.Init(Entry) Then If FrmHelpDetail.Init(Entry) Then
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}}) FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}})
Else Else
Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", NotifyLevel.DebugModeOnly) Logger.Warn("已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃")
End If End If
End Sub) End Sub)
End Sub) End Sub)
End Sub End Sub
Public Shared Function GetHelpPage(Location As String) As PageOtherHelpDetail
If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid)
Dim FrmHelpDetail As New PageOtherHelpDetail
If FrmHelpDetail.Init(New HelpEntry(Location)) Then
Return FrmHelpDetail
Else
Throw New Exception("已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃")
End If
End Function
''' <summary> ''' <summary>
''' 搜索帮助。 ''' 搜索帮助。
Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb
+3 -3
View File
@@ -22,14 +22,14 @@
Do While Content.Contains("xmlns") Do While Content.Contains("xmlns")
Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间 Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Loop Loop
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>" Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"" xmlns:core=""clr-namespace:MeloongCore;assembly=MeloongCore"" xmlns:corewpf=""clr-namespace:MeloongCore.Wpf;assembly=MeloongCore.Wpf"">" & Content & "</StackPanel>"
Me.Entry = Entry Me.Entry = Entry
PanCustom.Children.Clear() PanCustom.Children.Clear()
PanCustom.Children.Add(GetObjectFromXML(Content)) PanCustom.Children.Add(GetObjectFromXML(Content))
Return True Return True
Catch ex As Exception Catch ex As Exception
Log("[System] 自定义信息内容：" & vbCrLf & Content) Logger.Info($"自定义信息内容：{vbCrLf}{Content}")
Log(ex, "加载帮助 XAML 文件失败", NotifyLevel.MsgBox) Logger.Error(ex, "加载帮助 XAML 文件失败", LogBehavior.Alert)
Return False Return False
End Try End Try
End Function End Function
Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb
+14 -9
View File
@@ -5,9 +5,9 @@
Private Sub PageOtherLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub PageOtherLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
'是否处于隐藏的子页面 '是否处于隐藏的子页面
Dim IsHiddenPage As Boolean = False Dim IsHiddenPage As Boolean = False
If ItemHelp.Checked AndAlso Settings.Get("UiHiddenOtherHelp") Then IsHiddenPage = True If ItemHelp.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then IsHiddenPage = True
If ItemAbout.Checked AndAlso Settings.Get("UiHiddenOtherAbout") Then IsHiddenPage = True If ItemAbout.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then IsHiddenPage = True
If ItemTest.Checked AndAlso Settings.Get("UiHiddenOtherTest") Then IsHiddenPage = True If ItemTest.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest") Then IsHiddenPage = True
If PageSetupUI.HiddenForceShow Then IsHiddenPage = False If PageSetupUI.HiddenForceShow Then IsHiddenPage = False
'若页面错误，或尚未加载，则继续 '若页面错误，或尚未加载，则继续
If IsLoad AndAlso Not IsHiddenPage Then Return If IsLoad AndAlso Not IsHiddenPage Then Return
@@ -16,9 +16,9 @@
PageSetupUI.HiddenRefresh() PageSetupUI.HiddenRefresh()
'选择第一个未被禁用的子页面 '选择第一个未被禁用的子页面
If IsPageSwitched Then Return If IsPageSwitched Then Return
If Not Settings.Get("UiHiddenOtherHelp") Then If Not Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then
ItemHelp.SetChecked(True, False, False) ItemHelp.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenOtherAbout") Then ElseIf Not Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then
ItemAbout.SetChecked(True, False, False) ItemAbout.SetChecked(True, False, False)
Else Else
ItemTest.SetChecked(True, False, False) ItemTest.SetChecked(True, False, False)
@@ -37,9 +37,9 @@
Public Sub New() Public Sub New()
InitializeComponent() InitializeComponent()
'选择第一个未被禁用的子页面 '选择第一个未被禁用的子页面
If Not Settings.Get("UiHiddenOtherHelp") Then If Not Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then
PageID = FormMain.PageSubType.OtherHelp PageID = FormMain.PageSubType.OtherHelp
ElseIf Not Settings.Get("UiHiddenOtherAbout") Then ElseIf Not Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then
PageID = FormMain.PageSubType.OtherAbout PageID = FormMain.PageSubType.OtherAbout
Else Else
PageID = FormMain.PageSubType.OtherTest PageID = FormMain.PageSubType.OtherTest
@@ -83,7 +83,7 @@
PageChangeRun(PageGet(ID)) PageChangeRun(PageGet(ID))
PageID = ID PageID = ID
Catch ex As Exception Catch ex As Exception
Log(ex, "切换分页面失败（ID " & ID & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"切换分页面失败（ID {ID}）")
Finally Finally
AniControlEnabled -= 1 AniControlEnabled -= 1
End Try End Try
@@ -131,7 +131,12 @@
e.Handled = True e.Handled = True
End Sub End Sub
Public Shared Sub TryFeedback() Public Shared Sub TryFeedback()
If Not CanFeedback(True) Then Return If False.Equals(PageSetupSystem.IsLauncherNewest) Then
If MyMsgBox($"你的 PCL 不是最新版，因此无法提交反馈。{vbCrLf}请在更新后，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
UpdateCheckByButton()
End If
Return
End If
Select Case MyMsgBox("在提交新反馈前，建议先搜索反馈列表，以避免重复提交。" & vbCrLf & "如果无法打开该网页，请使用 VPN 改善网络环境。", Select Case MyMsgBox("在提交新反馈前，建议先搜索反馈列表，以避免重复提交。" & vbCrLf & "如果无法打开该网页，请使用 VPN 改善网络环境。",
"反馈", "提交新反馈", "查看反馈列表", "取消") "反馈", "提交新反馈", "查看反馈列表", "取消")
Case 1 Case 1
Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb
+27 -29
View File
@@ -81,14 +81,14 @@
End Sub End Sub
NewItem.Buttons = {NewIconButton} NewItem.Buttons = {NewIconButton}
FrmSelectLeft.PanList.Children.Add(NewItem) FrmSelectLeft.PanList.Children.Add(NewItem)
Log("[Minecraft] 有效的 Minecraft 文件夹：" & Folder.Name & " > " & Folder.Location) Logger.Info($"有效的 Minecraft 文件夹：{Folder.Name} > {Folder.Location}")
Next Next
'标题文本 '标题文本
FrmSelectLeft.PanList.Children.Add(New TextBlock With {.Text = "添加或导入", .Margin = New Thickness(13, 18, 5, 4), .Opacity = 0.6, .FontSize = 12}) FrmSelectLeft.PanList.Children.Add(New TextBlock With {.Text = "添加或导入", .Margin = New Thickness(13, 18, 5, 4), .Opacity = 0.6, .FontSize = 12})
'确认创建按钮状态 '确认创建按钮状态
If Not Directory.Exists(PathExeFolder & ".minecraft\") Then If Not DirectoryUtils.Exists(PathExeFolder & ".minecraft\") Then
Dim ItemCreate As New MyListItem With {.IsScaleAnimationEnabled = False, .Type = MyListItem.CheckType.Clickable, .Title = "新建 .minecraft 文件夹", .Height = 34, Dim ItemCreate As New MyListItem With {.IsScaleAnimationEnabled = False, .Type = MyListItem.CheckType.Clickable, .Title = "新建 .minecraft 文件夹", .Height = 34,
.ToolTip = "在 PCL 当前所在文件夹下创建新的 .minecraft 文件夹", .ToolTip = "在 PCL 当前所在文件夹下创建新的 .minecraft 文件夹",
.LogoScale = 0.9, .LogoScale = 0.9,
@@ -138,7 +138,7 @@
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "构建 Minecraft 文件夹列表 UI 出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "构建 Minecraft 文件夹列表 UI 出错")
Finally Finally
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表 LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表
End Try End Try
@@ -155,8 +155,8 @@
End If End If
Try Try
'获取输入 '获取输入
NewFolder = SelectFolder() NewFolder = Dialogs.SelectFolder("选择 Minecraft 文件夹", False).FirstOrDefault
If NewFolder = "" Then Return If NewFolder Is Nothing Then Return
If NewFolder.Contains("!") OrElse NewFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Return If NewFolder.Contains("!") OrElse NewFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Return
'要求输入显示名称 '要求输入显示名称
Dim SplitedNames As String() = NewFolder.TrimEnd("\").Split("\") Dim SplitedNames As String() = NewFolder.TrimEnd("\").Split("\")
@@ -168,7 +168,7 @@
'添加文件夹 '添加文件夹
AddFolder(NewFolder, NewName, True) AddFolder(NewFolder, NewName, True)
Catch ex As Exception Catch ex As Exception
Log(ex, "添加文件夹失败（" & NewFolder & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"添加文件夹失败（{NewFolder}）")
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -190,15 +190,15 @@
End If End If
'检查实际的 Minecraft 文件夹位置（没有问题，或是在子文件夹中） '检查实际的 Minecraft 文件夹位置（没有问题，或是在子文件夹中）
If Not CheckPermission(FolderPath & "versions\") Then If Not CheckPermission(FolderPath & "versions\") Then
For Each Folder As DirectoryInfo In New DirectoryInfo(FolderPath).GetDirectories For Each Folder In DirectoryUtils.GetDirectories(FolderPath)
If CheckPermission(Folder.FullName & "\versions\") Then If CheckPermission(Folder & "\versions\") Then
FolderPath = Folder.FullName & "\" FolderPath = Folder & "\"
Exit For Exit For
End If End If
Next Next
End If End If
'判断是否已经添加过，若添加过则直接修改自定义名 '判断是否已经添加过，若添加过则直接修改自定义名
Dim Folders As New List(Of String)(Settings.Get("LaunchFolders").ToString.Split("|")) Dim Folders As New List(Of String)(Settings.Get(Of String)("LaunchFolders").Split("|"))
Dim IsAdded As Boolean = False Dim IsAdded As Boolean = False
Dim IsReplace As Boolean = False Dim IsReplace As Boolean = False
For i = 0 To Folders.Count - 1 For i = 0 To Folders.Count - 1
@@ -229,10 +229,10 @@
If ShowHint Then Hint("文件夹 " & DisplayName & " 已添加！", HintType.Green) If ShowHint Then Hint("文件夹 " & DisplayName & " 已添加！", HintType.Green)
'检查是否为根目录整合包，自动关闭版本隔离 '检查是否为根目录整合包，自动关闭版本隔离
'1. 根目录中存在数个 Mod '1. 根目录中存在数个 Mod
Dim ModFolder As New DirectoryInfo(FolderPath & "mods\") Dim ModFolder = DirectoryUtils.GetInfo(FolderPath & "mods\")
If Not (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count >= 3) Then Return If Not (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count >= 3) Then Return
'2. 版本数较少，可能为整合包 '2. 版本数较少，可能为整合包
Dim VersionFolderInfo As New DirectoryInfo(FolderPath & "versions\") Dim VersionFolderInfo = DirectoryUtils.GetInfo(FolderPath & "versions\")
If Not (VersionFolderInfo.Exists AndAlso VersionFolderInfo.EnumerateDirectories.Count <= 3) Then Return If Not (VersionFolderInfo.Exists AndAlso VersionFolderInfo.EnumerateDirectories.Count <= 3) Then Return
'3. 能够找到可安装 Mod 的版本 '3. 能够找到可安装 Mod 的版本
For Each VersionFolder In VersionFolderInfo.EnumerateDirectories For Each VersionFolder In VersionFolderInfo.EnumerateDirectories
@@ -240,15 +240,15 @@
Instance.Load() Instance.Load()
If Not Instance.Modable Then Continue For If Not Instance.Modable Then Continue For
'4. 该版本的隔离文件夹下不存在 mods '4. 该版本的隔离文件夹下不存在 mods
Dim ModIndieFolder As New DirectoryInfo(Instance.PathVersion & "mods\") Dim ModIndieFolder = DirectoryUtils.GetInfo(Instance.PathVersion & "mods\")
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Return If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Return
'满足以上全部条件则视为根目录整合包 '满足以上全部条件则视为根目录整合包
Settings.Set("VersionArgumentIndie", 2, Instance:=Instance) Settings.Set("VersionArgumentIndie", 2, Instance:=Instance)
Settings.Set("VersionArgumentIndieV2", False, Instance:=Instance) Settings.Set("VersionArgumentIndieV2", False, Instance:=Instance)
Log("[Setup] 已自动关闭单版本隔离：" & Instance.Name, NotifyLevel.DebugModeOnly) Logger.Warn($"已自动关闭单版本隔离：{Instance.Name}")
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "向文件夹列表中添加新文件夹失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "向文件夹列表中添加新文件夹失败")
End Try End Try
End Sub) End Sub)
End Sub End Sub
@@ -265,11 +265,11 @@
End Sub End Sub
Public Shared Sub CreateMcFolderInCurrentPath() Public Shared Sub CreateMcFolderInCurrentPath()
McFolderSelected = PathExeFolder & ".minecraft\" McFolderSelected = PathExeFolder & ".minecraft\"
If Not Directory.Exists(McFolderSelected) Then If Not DirectoryUtils.Exists(McFolderSelected) Then
DirectoryUtils.Create(McFolderSelected & "versions\") DirectoryUtils.Create(McFolderSelected & "versions\")
McFolderLauncherProfilesJsonCreate(McFolderSelected) McFolderLauncherProfilesJsonCreate(McFolderSelected)
End If End If
AddFolder(McFolderSelected, GetFolderNameFromPath(PathExeFolder), False) AddFolder(McFolderSelected, PathUtils.GetLastPart(PathExeFolder), False)
End Sub End Sub
'右键菜单 '右键菜单
@@ -282,12 +282,10 @@
Select Case MyMsgBox("是否需要清理 PCL 在该文件夹中的配置文件？" & vbCrLf & "这包括各个版本的独立设置（如自定义图标、第三方登录配置）等，对游戏本身没有影响。", "配置文件清理", "删除", "保留", "取消") Select Case MyMsgBox("是否需要清理 PCL 在该文件夹中的配置文件？" & vbCrLf & "这包括各个版本的独立设置（如自定义图标、第三方登录配置）等，对游戏本身没有影响。", "配置文件清理", "删除", "保留", "取消")
Case 1 Case 1
'删除配置文件 '删除配置文件
If File.Exists(Target.Location & "PCL.ini") Then File.Delete(Target.Location & "PCL.ini") FileUtils.Delete(Target.Location & "PCL.ini")
If Directory.Exists(Target.Location & "versions\") Then For Each Instance In DirectoryUtils.GetDirectories(Target.Location & "versions\", True)
For Each InstanceInfo In New DirectoryInfo(Target.Location & "versions\").EnumerateDirectories DirectoryUtils.Delete(Path.Combine(Instance, "PCL"), True)
If Directory.Exists(InstanceInfo.FullName & "\PCL\") Then DeleteDirectory(InstanceInfo.FullName & "\PCL\", True) Next
Next
End If
Case 2 Case 2
'不删除 '不删除
Case 3 Case 3
@@ -299,7 +297,7 @@
Hint(If(Target.Type = McFolder.Types.Custom, "文件夹 " & DeletedName & " 已从列表中移除！", "文件夹名称已复原！"), HintType.Green) Hint(If(Target.Type = McFolder.Types.Custom, "文件夹 " & DeletedName & " 已从列表中移除！", "文件夹名称已复原！"), HintType.Green)
McFolderListLoader.Start(IsForceRestart:=True) McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception Catch ex As Exception
Log(ex, "从列表中移除游戏文件夹失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "从列表中移除游戏文件夹失败")
End Try End Try
End Sub End Sub
Public Sub Delete_Click(sender As Object, e As RoutedEventArgs) Public Sub Delete_Click(sender As Object, e As RoutedEventArgs)
@@ -320,11 +318,11 @@
'删除文件夹 '删除文件夹
Try Try
Hint("正在" & DeleteText & "文件夹 " & Target.Name & "！", HintType.Blue) Hint("正在" & DeleteText & "文件夹 " & Target.Name & "！", HintType.Blue)
DeleteDirectory(Target.Location) DirectoryUtils.Delete(Target.Location)
If DeleteText = "清空" Then DirectoryUtils.Create(Target.Location) If DeleteText = "清空" Then DirectoryUtils.Create(Target.Location)
Hint("已" & DeleteText & "文件夹 " & Target.Name & "！", HintType.Green) Hint("已" & DeleteText & "文件夹 " & Target.Name & "！", HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, DeleteText & "文件夹 " & Target.Name & " 失败", NotifyLevel.AllUsers) Logger.Error(ex, $"{DeleteText}文件夹 {Target.Name} 失败", LogBehavior.Toast)
Finally Finally
'刷新列表 '刷新列表
McFolderListLoader.Start(IsForceRestart:=True) McFolderListLoader.Start(IsForceRestart:=True)
@@ -337,7 +335,7 @@
''' </summary> ''' </summary>
Private Shared Function RemoveFolderFromSetup(Target As McFolder) As String Private Shared Function RemoveFolderFromSetup(Target As McFolder) As String
Dim DeletedName As String = Nothing Dim DeletedName As String = Nothing
Dim Folders = Settings.Get("LaunchFolders").ToString.Split({"|"c}, StringSplitOptions.RemoveEmptyEntries).ToList Dim Folders = Settings.Get(Of String)("LaunchFolders").Split("|"c, True).ToList
For Each Folder In Folders.ToList For Each Folder In Folders.ToList
If Not Folder.EndsWithF(Target.Location) Then Continue For If Not Folder.EndsWithF(Target.Location) Then Continue For
DeletedName = Folder.BeforeFirst(">") DeletedName = Folder.BeforeFirst(">")
@@ -371,7 +369,7 @@
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})}) New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
If String.IsNullOrWhiteSpace(NewName) Then Return If String.IsNullOrWhiteSpace(NewName) Then Return
'修改自定义名 '修改自定义名
Dim Folders As New List(Of String)(Settings.Get("LaunchFolders").ToString.Split("|")) Dim Folders As New List(Of String)(Settings.Get(Of String)("LaunchFolders").Split("|"))
Dim IsAdded As Boolean = False Dim IsAdded As Boolean = False
For i = 0 To Folders.Count - 1 For i = 0 To Folders.Count - 1
Dim FolderCurrent As String = Folders(i) Dim FolderCurrent As String = Folders(i)
@@ -394,7 +392,7 @@
Settings.Set("LaunchFolders", Folders.Join("|")) Settings.Set("LaunchFolders", Folders.Join("|"))
McFolderListLoader.Start(IsForceRestart:=True) McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception Catch ex As Exception
Log(ex, "重命名文件夹失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "重命名文件夹失败")
End Try End Try
End Sub End Sub
Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb
+7 -12
View File
@@ -102,7 +102,7 @@
Else Else
LabEmptyTitle.Text = "无可用版本" LabEmptyTitle.Text = "无可用版本"
LabEmptyContent.Text = "未找到任何版本的游戏，请先下载任意版本的游戏。" & vbCrLf & "若有已存在的游戏，请在左边的列表中选择添加文件夹，选择 .minecraft 文件夹将其导入。" LabEmptyContent.Text = "未找到任何版本的游戏，请先下载任意版本的游戏。" & vbCrLf & "若有已存在的游戏，请在左边的列表中选择添加文件夹，选择 .minecraft 文件夹将其导入。"
BtnEmptyDownload.Visibility = If(Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow, Visibility.Collapsed, Visibility.Visible) BtnEmptyDownload.Visibility = If(Settings.Get(Of Boolean)("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If End If
Else Else
PanBack.Visibility = Visibility.Visible PanBack.Visibility = Visibility.Visible
@@ -110,7 +110,7 @@
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "将版本列表转换显示时失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "将版本列表转换显示时失败")
End Try End Try
End Sub End Sub
Public Shared Sub McInstanceListContent(sender As MyListItem, e As EventArgs) Public Shared Sub McInstanceListContent(sender As MyListItem, e As EventArgs)
@@ -204,13 +204,8 @@
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""), If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""),
"版本删除确认", , "取消",, True) "版本删除确认", , "取消",, True)
Case 1 Case 1
IniClearCache(Instance.PathIndie & "options.txt") Instance.ResetIniCache()
IniClearCache(Instance.PathVersion & "PCL\Setup.ini") DirectoryUtils.Delete(Instance.PathVersion, Not IsShiftPressed)
If IsShiftPressed Then
DeleteDirectory(Instance.PathVersion)
Else
FileIO.FileSystem.DeleteDirectory(Instance.PathVersion, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
Hint("版本 " & Instance.Name & " 已删除！", HintType.Green) Hint("版本 " & Instance.Name & " 已删除！", HintType.Green)
Case 2 Case 2
Return Return
@@ -238,14 +233,14 @@
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End If End If
Catch ex As OperationCanceledException Catch ex As OperationCanceledException
Log(ex, "删除版本 " & Instance.Name & " 被主动取消") Logger.Warn(ex, $"删除版本 {Instance.Name} 被主动取消")
Catch ex As Exception Catch ex As Exception
Log(ex, "删除版本 " & Instance.Name & " 失败", NotifyLevel.MsgBox) Logger.Error(ex, $"删除版本 {Instance.Name} 失败", LogBehavior.Alert)
End Try End Try
End Sub End Sub
Public Sub BtnEmptyDownload_Loaded() Handles BtnEmptyDownload.Loaded Public Sub BtnEmptyDownload_Loaded() Handles BtnEmptyDownload.Loaded
Dim NewVisibility = If((Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse ShowHidden, Visibility.Collapsed, Visibility.Visible) Dim NewVisibility = If((Settings.Get(Of Boolean)("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse ShowHidden, Visibility.Collapsed, Visibility.Visible)
If BtnEmptyDownload.Visibility <> NewVisibility Then If BtnEmptyDownload.Visibility <> NewVisibility Then
BtnEmptyDownload.Visibility = NewVisibility BtnEmptyDownload.Visibility = NewVisibility
PanLoad.TriggerForceResize() PanLoad.TriggerForceResize()
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml
+17 -15
View File
@@ -8,7 +8,7 @@
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,25,25,10"> <StackPanel x:Name="PanMain" Margin="25,25,25,10">
<local:MyCard x:Name="CardArgument" Margin="0,0,0,15" Title="启动选项"> <local:MyCard x:Name="CardArgument" Margin="0,0,0,15" Title="启动选项">
<StackPanel Margin="25,40,25,15"> <StackPanel Margin="25,40,25,25">
<Grid> <Grid>
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
@@ -29,7 +29,6 @@
<RowDefinition Height="28" /> <RowDefinition Height="28" />
<RowDefinition Height="9" /> <RowDefinition Height="9" />
<RowDefinition Height="28" /> <RowDefinition Height="28" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="默认版本隔离" Margin="0,0,25,0" /> <TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="默认版本隔离" Margin="0,0,25,0" />
<local:MyComboBox local:SettingService.Key="LaunchArgumentIndieV2" x:Name="ComboArgumentIndieV2" <local:MyComboBox local:SettingService.Key="LaunchArgumentIndieV2" x:Name="ComboArgumentIndieV2"
@@ -50,7 +49,7 @@
Grid.Row="2" Grid.ColumnSpan="2" Grid.Column="1" ToolTip="自定义游戏窗口的标题，若留空则不进行更改。&#xa;你可以用替换标记来动态改变其内容，在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="默认" MaxLength="100" /> Grid.Row="2" Grid.ColumnSpan="2" Grid.Column="1" ToolTip="自定义游戏窗口的标题，若留空则不进行更改。&#xa;你可以用替换标记来动态改变其内容，在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="默认" MaxLength="100" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" /> <TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
<local:MyTextBox local:SettingService.Key="LaunchArgumentInfo" <local:MyTextBox local:SettingService.Key="LaunchArgumentInfo"
Grid.Row="4" Grid.ColumnSpan="2" Text="PCL" Grid.Column="1" ToolTip="该信息会显示在游戏主界面的左下角，与 F3 调试页面的左上角。&#xa;你可以用替换标记来动态改变其内容，在 更多 → 帮助 中搜索 “替换标记” 以了解用法。"> Grid.Row="4" Grid.ColumnSpan="2" Text="PCL" Grid.Column="1" ToolTip="注意：Mojang 于 Minecraft 26.1 移除了该设置，因此该设置在新版本中无效。&#xa;&#xa;该信息会显示在游戏主界面的左下角，与 F3 调试页面的左上角。&#xa;你可以用替换标记来动态改变其内容，在 更多 → 帮助 中搜索 “替换标记” 以了解用法。">
<local:MyTextBox.ValidateRules> <local:MyTextBox.ValidateRules>
<local:ValidateExcept> <local:ValidateExcept>
<local:ValidateExcept.Excepts> <local:ValidateExcept.Excepts>
@@ -106,21 +105,24 @@
</local:MyTextBox.ValidateRules> </local:MyTextBox.ValidateRules>
</local:MyTextBox> </local:MyTextBox>
</Grid> </Grid>
<TextBlock VerticalAlignment="Center" Grid.Row="12" HorizontalAlignment="Left" Text="游戏 Java" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="12" HorizontalAlignment="Left" Text="Java" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboArgumentJava" Grid.ColumnSpan="2" Grid.Row="12" Grid.Column="1" <Grid Grid.ColumnSpan="2" Grid.Row="12" Grid.Column="1" HorizontalAlignment="Stretch">
ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹，在进行自动选择时 PCL 会尽量优先选择它">
<ComboBoxItem Content="加载中……" IsSelected="True" />
<!--<local:MyComboBoxItem Content="Java 8 (1.8.0_171)，64 位：C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" IsSelected="True" ToolTip="C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" />-->
</local:MyComboBox>
<Grid Grid.Row="13" Grid.Column="1">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" /> <ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" /> <ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<Path Height="16" HorizontalAlignment="Left" Stretch="Uniform" Margin="6,10.5,0,0" Data="F1 M 20,17L 43.25,17L 56,29.75L 56,40L 52,37.5L 52,34L 39,34L 39,21L 24,21L 24,55L 36,55L 32,59L 20,59L 20,17 Z M 43,22.25L 43,30L 50.75,30L 43,22.25 Z M 48,38C 53.5228,38 58,42.4772 58,48C 58,53.5229 53.5228,58 48,58C 46.1455,58 44.4089,57.4952 42.9201,56.6155L 36.1213,63.4142C 35.3403,64.1953 34.0739,64.1953 33.2929,63.4142L 32.5858,62.7071C 31.8047,61.9261 31.8047,60.6597 32.5858,59.8787L 39.3845,53.0799C 38.5048,51.5911 38,49.8545 38,48C 38,42.4772 42.4771,38 48,38 Z M 48,42C 44.6863,42 42,44.6863 42,48C 42,51.3137 44.6863,54 48,54C 51.3137,54 54,51.3137 54,48C 54,44.6863 51.3137,42 48,42 Z" VerticalAlignment="Top" Fill="{Binding Foreground, ElementName=BtnArgumentJavaSearch}" /> <local:MyComboBox
<local:MyTextButton HorizontalAlignment="Left" x:Name="BtnArgumentJavaSearch" Text="自动搜索" Padding="25,10,5,5" Grid.Row="5" VerticalContentAlignment="Top" /> x:Name="ComboArgumentJava" Grid.Column="0" ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹，在进行自动选择时 PCL 会尽量优先选择它">
<Path Height="16" VerticalAlignment="Top" HorizontalAlignment="Left" Stretch="Uniform" Margin="22,10.5,0,0" Grid.Column="1" StrokeThickness="0.5" Data="M827.4 589.1l-30.7-50.7V151.3c0-29.9-25.2-54.3-56.1-54.3h-527c-9.9 0-24.8 6.3-24.8 24.8v700.5c0 20.2 12.1 37 31.7 43.8l169.1 58.6c4.4 1.5 9.1 2.3 13.8 2.3 10.2 0 20.7-3.4 29.9-10 12.9-9.2 20.3-22.4 20.3-36.2l-0.1-16.6h325.7c30.9 0 56.1-24.3 56.1-54.3v-193c0-9.8-2.7-19.4-7.9-27.8z m-423.5 288l-165.6-54.8V153.8l201.5 51.4v439.2c-0.1 0.5-0.8 2.6-3.2 5.3l-20.9 23.4c-7.6 8.4-11.7 18.7-11.7 28.9v175.1zM785.7 810c0 2.2-2.6 4.6-6.4 4.6h-326l-0.6-108.4 20.9-23.4c10.2-11.4 15.9-25 15.9-38.2V205.2c0-21.6-14-39.3-35.7-45.1l-50.4-13.4h337.3c3.8 0 6.4 2.4 6.4 4.6v387.1c0 9.7 2.7 19.4 8 27.9l30.7 50.7v193z" Stroke="{Binding Foreground, ElementName=BtnArgumentJavaSelect}" Fill="{Binding Foreground, ElementName=BtnArgumentJavaSelect}" /> <ComboBoxItem Content="加载中……" IsSelected="True" />
<local:MyTextButton x:Name="BtnArgumentJavaSelect" Margin="17,0,0,0" Padding="24.5,10,5,5" Text="手动导入" Grid.Row="5" Grid.Column="1" VerticalContentAlignment="Top" HorizontalAlignment="Left" /> <!--<local:MyComboBoxItem Content="Java 8 (1.8.0_171)，64 位：C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" IsSelected="True" ToolTip="C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" />-->
</local:MyComboBox>
<local:MyIconTextButton Margin="5,0,0,0"
x:Name="BtnArgumentJavaSearch" Text="搜索" Grid.Column="1"
Logo="F1 M 20,17L 43.25,17L 56,29.75L 56,40L 52,37.5L 52,34L 39,34L 39,21L 24,21L 24,55L 36,55L 32,59L 20,59L 20,17 Z M 43,22.25L 43,30L 50.75,30L 43,22.25 Z M 48,38C 53.5228,38 58,42.4772 58,48C 58,53.5229 53.5228,58 48,58C 46.1455,58 44.4089,57.4952 42.9201,56.6155L 36.1213,63.4142C 35.3403,64.1953 34.0739,64.1953 33.2929,63.4142L 32.5858,62.7071C 31.8047,61.9261 31.8047,60.6597 32.5858,59.8787L 39.3845,53.0799C 38.5048,51.5911 38,49.8545 38,48C 38,42.4772 42.4771,38 48,38 Z M 48,42C 44.6863,42 42,44.6863 42,48C 42,51.3137 44.6863,54 48,54C 51.3137,54 54,51.3137 54,48C 54,44.6863 51.3137,42 48,42 Z" />
<local:MyIconTextButton
x:Name="BtnArgumentJavaSelect" Text="导入" Grid.Column="2"
Logo="M827.4 589.1l-30.7-50.7V151.3c0-29.9-25.2-54.3-56.1-54.3h-527c-9.9 0-24.8 6.3-24.8 24.8v700.5c0 20.2 12.1 37 31.7 43.8l169.1 58.6c4.4 1.5 9.1 2.3 13.8 2.3 10.2 0 20.7-3.4 29.9-10 12.9-9.2 20.3-22.4 20.3-36.2l-0.1-16.6h325.7c30.9 0 56.1-24.3 56.1-54.3v-193c0-9.8-2.7-19.4-7.9-27.8z m-423.5 288l-165.6-54.8V153.8l201.5 51.4v439.2c-0.1 0.5-0.8 2.6-3.2 5.3l-20.9 23.4c-7.6 8.4-11.7 18.7-11.7 28.9v175.1zM785.7 810c0 2.2-2.6 4.6-6.4 4.6h-326l-0.6-108.4 20.9-23.4c10.2-11.4 15.9-25 15.9-38.2V205.2c0-21.6-14-39.3-35.7-45.1l-50.4-13.4h337.3c3.8 0 6.4 2.4 6.4 4.6v387.1c0 9.7 2.7 19.4 8 27.9l30.7 50.7v193z" />
</Grid> </Grid>
</Grid> </Grid>
</StackPanel> </StackPanel>
@@ -291,7 +293,7 @@
<local:MyCheckBox Height="28" Text="禁用 Java Launch Wrapper" local:SettingService.Key="LaunchAdvanceDisableJLW" <local:MyCheckBox Height="28" Text="禁用 Java Launch Wrapper" local:SettingService.Key="LaunchAdvanceDisableJLW"
ToolTipService.Placement="Right" ToolTip="是否使用 Java Launch Wrapper 修复 Java 18- 在中文路径下可能无法正常启动的问题。&#xa;详见：https://github.com/00ll00/java_launch_wrapper" /> ToolTipService.Placement="Right" ToolTip="是否使用 Java Launch Wrapper 修复 Java 18- 在中文路径下可能无法正常启动的问题。&#xa;详见：https://github.com/00ll00/java_launch_wrapper" />
<local:MyCheckBox Height="28" Text="禁用 LWJGL Unsafe Agent" local:SettingService.Key="LaunchAdvanceDisableLUA" <local:MyCheckBox Height="28" Text="禁用 LWJGL Unsafe Agent" local:SettingService.Key="LaunchAdvanceDisableLUA"
ToolTipService.Placement="Right" ToolTip="是否使用 LWJGL Unsafe Agent 修复 Java 25+ 的一个性能问题。&#xa;详见：https://github.com/HMCL-dev/lwjgl-unsafe-agent" /> ToolTipService.Placement="Right" ToolTip="是否使用 LWJGL Unsafe Agent 修复 LWJGL 3.4.1 的一个性能问题。&#xa;详见：https://github.com/HMCL-dev/lwjgl-unsafe-agent" />
<local:MyCheckBox Height="28" Text="使用高性能显卡" local:SettingService.Key="LaunchAdvanceGraphicCard" <local:MyCheckBox Height="28" Text="使用高性能显卡" local:SettingService.Key="LaunchAdvanceGraphicCard"
ToolTipService.Placement="Right" ToolTip="自动在 Windows 设置 → 系统 → 屏幕 → 显示卡 中将 PCL 和 Java 改为使用高性能显卡。&#xa;如果同时有集成显卡和独立显卡，这能确保 MC 使用独立显卡进行渲染，以大幅提高帧率。" /> ToolTipService.Placement="Right" ToolTip="自动在 Windows 设置 → 系统 → 屏幕 → 显示卡 中将 PCL 和 Java 改为使用高性能显卡。&#xa;如果同时有集成显卡和独立显卡，这能确保 MC 使用独立显卡进行渲染，以大幅提高帧率。" />
</StackPanel> </StackPanel>
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb
+28 -29
View File
@@ -27,10 +27,10 @@
UpdateRamType() UpdateRamType()
UpdateJavaComboBox() UpdateJavaComboBox()
Catch ex As NullReferenceException Catch ex As NullReferenceException
Log(ex, "启动设置项存在异常，已被自动重置", NotifyLevel.MsgBox) Logger.Error(ex, "启动设置项存在异常，已被自动重置", LogBehavior.Alert)
Reset() Reset()
Catch ex As Exception Catch ex As Exception
Log(ex, "重载启动设置时出错", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "重载启动设置时出错")
End Try End Try
End Sub End Sub
Public Sub Reset() Public Sub Reset()
@@ -42,7 +42,7 @@
JavaSearchLoader.Start(IsForceRestart:=True) JavaSearchLoader.Start(IsForceRestart:=True)
Hint("已初始化启动设置！", HintType.Green) Hint("已初始化启动设置！", HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化启动设置失败", NotifyLevel.MsgBox) Logger.Error(ex, "初始化启动设置失败", LogBehavior.Alert)
End Try End Try
Refresh() Refresh()
End Sub End Sub
@@ -57,7 +57,7 @@
Private Sub RadioSkinType3_Check(sender As Object, e As RouteEventArgs) Handles RadioSkinType4.PreviewCheck Private Sub RadioSkinType3_Check(sender As Object, e As RouteEventArgs) Handles RadioSkinType4.PreviewCheck
If Not (AniControlEnabled = 0 AndAlso e.RaiseByMouse) Then Return If Not (AniControlEnabled = 0 AndAlso e.RaiseByMouse) Then Return
'已有图片则不再选择 '已有图片则不再选择
If File.Exists(PathAppdata & "CustomSkin.png") Then Return If FileUtils.Exists(PathAppdata & "CustomSkin.png") Then Return
'没有图片则要求选择 '没有图片则要求选择
Dim SkinInfo As McSkinInfo = McSkinSelect() Dim SkinInfo As McSkinInfo = McSkinSelect()
If Not SkinInfo.IsVaild Then If Not SkinInfo.IsVaild Then
@@ -70,9 +70,8 @@
'返回是否成功改变 '返回是否成功改变
Private Function ChangeSkin(SkinInfo As McSkinInfo) As Boolean Private Function ChangeSkin(SkinInfo As McSkinInfo) As Boolean
Try Try
'拷贝文件 '复制文件
File.Delete(PathAppdata & "CustomSkin.png") FileUtils.Copy(SkinInfo.LocalFile, PathAppdata & "CustomSkin.png")
CopyFile(SkinInfo.LocalFile, PathAppdata & "CustomSkin.png")
'将单层皮肤扩展到双层 '将单层皮肤扩展到双层
Dim Bitmap As New MyBitmap(PathAppdata & "CustomSkin.png") Dim Bitmap As New MyBitmap(PathAppdata & "CustomSkin.png")
If Bitmap.Pic.Width = 64 AndAlso Bitmap.Pic.Height = 32 Then If Bitmap.Pic.Width = 64 AndAlso Bitmap.Pic.Height = 32 Then
@@ -81,15 +80,15 @@
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(NewBitmap) Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(NewBitmap)
g.DrawImageUnscaled(Img, New System.Drawing.Point(0, 0)) g.DrawImageUnscaled(Img, New System.Drawing.Point(0, 0))
End Using End Using
File.Delete(PathAppdata & "CustomSkin.png") FileUtils.Delete(PathAppdata & "CustomSkin.png")
NewBitmap.Save(PathAppdata & "CustomSkin.png") NewBitmap.Save(PathAppdata & "CustomSkin.png")
End If End If
'更新设置 '更新设置
Settings.Set("LaunchSkinSlim", SkinInfo.IsSlim) Settings.Set("LaunchSkinSlim", SkinInfo.IsSlim)
ChangeSkin = True Return True
Catch ex As Exception Catch ex As Exception
Log(ex, "改变离线皮肤失败", NotifyLevel.MsgBox) Logger.Error(ex, "改变离线皮肤失败", LogBehavior.Alert)
ChangeSkin = False Return False
Finally Finally
'设置当前显示 '设置当前显示
PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True) PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
@@ -97,11 +96,11 @@
End Function End Function
Private Sub BtnSkinDelete_Click(sender As Object, e As EventArgs) Handles BtnSkinDelete.Click Private Sub BtnSkinDelete_Click(sender As Object, e As EventArgs) Handles BtnSkinDelete.Click
Try Try
File.Delete(PathAppdata & "CustomSkin.png") FileUtils.Delete(PathAppdata & "CustomSkin.png")
RadioSkinType0.SetChecked(True, True) RadioSkinType0.SetChecked(True, True)
Hint("离线皮肤已清空！", HintType.Green) Hint("离线皮肤已清空！", HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, "清空离线皮肤失败", NotifyLevel.MsgBox) Logger.Error(ex, "清空离线皮肤失败", LogBehavior.Alert)
End Try End Try
End Sub End Sub
Private Sub BtnSkinSave_Click(sender As Object, e As EventArgs) Handles BtnSkinSave.Click Private Sub BtnSkinSave_Click(sender As Object, e As EventArgs) Handles BtnSkinSave.Click
@@ -115,7 +114,7 @@
PageLaunchLeft.SkinLegacy.Start() PageLaunchLeft.SkinLegacy.Start()
'设置 UI 改变 '设置 UI 改变
If FrmSetupLaunch Is Nothing Then Return If FrmSetupLaunch Is Nothing Then Return
Select Case Settings.Get("LaunchSkinType") Select Case Settings.Get(Of Integer)("LaunchSkinType")
Case 0, 1, 2 '默认 Case 0, 1, 2 '默认
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Collapsed FrmSetupLaunch.PanSkinID.Visibility = Visibility.Collapsed
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Collapsed FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Collapsed
@@ -135,7 +134,7 @@
Public Shared Sub UpdateRamType() Public Shared Sub UpdateRamType()
If FrmSetupLaunch?.SliderRamCustom Is Nothing Then Return If FrmSetupLaunch?.SliderRamCustom Is Nothing Then Return
FrmSetupLaunch.SliderRamCustom.IsEnabled = Settings.Get("LaunchRamType") = 1 FrmSetupLaunch.SliderRamCustom.IsEnabled = Settings.Get(Of Integer)("LaunchRamType") = 1
End Sub End Sub
''' <summary> ''' <summary>
@@ -278,7 +277,7 @@
'------------------------------------------ '------------------------------------------
Dim RamGive As Double Dim RamGive As Double
If Settings.Get("LaunchRamType") = 0 Then If Settings.Get(Of Integer)("LaunchRamType") = 0 Then
'自动配置 '自动配置
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
'确定需求的内存值 '确定需求的内存值
@@ -289,7 +288,7 @@
If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load() If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load()
If Instance IsNot Nothing AndAlso Instance.Modable Then If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 Mod 的版本 '可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Instance.PathIndie & "mods\") Dim ModDir = DirectoryUtils.GetInfo(Instance.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Count(Function(f) {".jar", ".zip", ".litemod"}.Contains(f.Extension.Lower)), 0) Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Count(Function(f) {".jar", ".zip", ".litemod"}.Contains(f.Extension.Lower)), 0)
RamMininum = 0.5 + ModCount / 150 RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90 RamTarget1 = 1.5 + ModCount / 90
@@ -334,7 +333,7 @@ PreFin:
RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1) RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1)
Else Else
'手动配置 '手动配置
Dim Value As Integer = Settings.Get("LaunchRamCustom") Dim Value = Settings.Get(Of Integer)("LaunchRamCustom")
If Value <= 12 Then If Value <= 12 Then
RamGive = Value * 0.1 + 0.3 RamGive = Value * 0.1 + 0.3
ElseIf Value <= 25 Then ElseIf Value <= 25 Then
@@ -359,10 +358,10 @@ PreFin:
If ComboArgumentJava Is Nothing Then Return If ComboArgumentJava Is Nothing Then Return
'初始化列表 '初始化列表
ComboArgumentJava.Items.Clear() ComboArgumentJava.Items.Clear()
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"}) ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择（推荐）", .Tag = "自动选择"})
'更新列表 '更新列表
Dim SelectedItem As MyComboBoxItem = Nothing Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Settings.Get("LaunchArgumentJavaSelect") Dim SelectedBySetup As String = Settings.Get(Of String)("LaunchArgumentJavaSelect")
Try Try
For Each Java In JavaList.ToList().OrderByDescending(Function(v) v.MajorVersion) For Each Java In JavaList.ToList().OrderByDescending(Function(v) v.MajorVersion)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java} Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
@@ -374,7 +373,7 @@ PreFin:
Next Next
Catch ex As Exception Catch ex As Exception
Settings.Set("LaunchArgumentJavaSelect", "") Settings.Set("LaunchArgumentJavaSelect", "")
Log(ex, "更新设置 Java 下拉框失败", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, "更新设置 Java 下拉框失败")
End Try End Try
'更新选择项 '更新选择项
If SelectedItem Is Nothing AndAlso JavaList.Any Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择” If SelectedItem Is Nothing AndAlso JavaList.Any Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择”
@@ -403,11 +402,11 @@ PreFin:
If "自动选择".Equals(SelectedJava) Then If "自动选择".Equals(SelectedJava) Then
'选择 “自动” '选择 “自动”
Settings.Set("LaunchArgumentJavaSelect", "") Settings.Set("LaunchArgumentJavaSelect", "")
Log("[Java] 修改 Java 选择设置：自动选择") Logger.Info("修改 Java 选择设置：自动选择")
Else Else
'选择指定项 '选择指定项
Settings.Set("LaunchArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None)) Settings.Set("LaunchArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None))
Log("[Java] 修改 Java 选择设置：" & SelectedJava.ToString) Logger.Info($"修改 Java 选择设置：{SelectedJava}")
End If End If
RefreshRam(True) RefreshRam(True)
End Sub End Sub
@@ -419,16 +418,16 @@ PreFin:
Return Return
End If End If
'选择 Java '选择 Java
Dim JavaSelected As String = SelectFile("javaw.exe|javaw.exe", "选择 bin 文件夹中的 javaw.exe 文件") Dim JavaSelected As String = Dialogs.SelectFile("选择 bin 文件夹中的 javaw.exe 文件", False, filter:={({"exe"}, "javaw.exe")}).FirstOrDefault()
If JavaSelected = "" Then Return If String.IsNullOrEmpty(JavaSelected) Then Return
JavaSelected = GetPathFromFullPath(JavaSelected) JavaSelected = PathUtils.AddSlashSuffix(PathUtils.RemoveLastPart(JavaSelected))
Try Try
'验证 Java 可用 '验证 Java 可用
Dim NewEntry As New JavaEntry(JavaSelected, True) Dim NewEntry As New JavaEntry(JavaSelected, True)
NewEntry.Check() NewEntry.Check()
'加入列表 '加入列表
Dim JavaNewList As New JArray From {NewEntry.ToJson} Dim JavaNewList As New JArray From {NewEntry.ToJson}
For Each JsonEntry In GetJson(Settings.Get("LaunchArgumentJavaAll")) For Each JsonEntry In GetJson(Settings.Get(Of String)("LaunchArgumentJavaAll"))
Dim Entry = JavaEntry.FromJson(JsonEntry) Dim Entry = JavaEntry.FromJson(JsonEntry)
If Entry.PathFolder = NewEntry.PathFolder Then Continue For If Entry.PathFolder = NewEntry.PathFolder Then Continue For
JavaNewList.Add(JsonEntry) JavaNewList.Add(JsonEntry)
@@ -438,7 +437,7 @@ PreFin:
JavaSearchLoader.Start(IsForceRestart:=True) JavaSearchLoader.Start(IsForceRestart:=True)
Hint("已将该 Java 加入 Java 列表！", HintType.Green) Hint("已将该 Java 加入 Java 列表！", HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, "该 Java 存在异常，无法使用", NotifyLevel.MsgBox, "异常的 Java") Logger.Error(ex, "该 Java 存在异常，无法使用", LogBehavior.Alert)
Return Return
End Try End Try
End Sub End Sub
@@ -488,7 +487,7 @@ PreFin:
If Not CheckArgumentRam.Checked Then Return If Not CheckArgumentRam.Checked Then Return
If MyMsgBox("内存优化会显著延长启动耗时，建议仅在内存不足时开启。" & vbCrLf & If MyMsgBox("内存优化会显著延长启动耗时，建议仅在内存不足时开启。" & vbCrLf &
"如果你在使用机械硬盘，这还可能导致一小段时间的严重卡顿。" & "如果你在使用机械硬盘，这还可能导致一小段时间的严重卡顿。" &
If(IsAdmin(), "", $"{vbCrLf}{vbCrLf}每次启动游戏，PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限，可以右键 PCL，打开 属性 → 兼容性 → 以管理员身份运行此程序。"), If(SystemUtils.HasAdminRole(), "", $"{vbCrLf}{vbCrLf}每次启动游戏，PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限，可以右键 PCL，打开 属性 → 兼容性 → 以管理员身份运行此程序。"),
"提醒", "确定", "取消") = 2 Then "提醒", "确定", "取消") = 2 Then
CheckArgumentRam.Checked = False CheckArgumentRam.Checked = False
End If End If
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml.vb
+13 -13
View File
@@ -5,10 +5,10 @@
Private Sub PageSetupLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub PageSetupLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
'是否处于隐藏的子页面 '是否处于隐藏的子页面
Dim IsHiddenPage As Boolean = False Dim IsHiddenPage As Boolean = False
If ItemLaunch.Checked AndAlso Settings.Get("UiHiddenSetupLaunch") Then IsHiddenPage = True If ItemLaunch.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLaunch") Then IsHiddenPage = True
If ItemUI.Checked AndAlso Settings.Get("UiHiddenSetupUi") Then IsHiddenPage = True If ItemUI.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupUi") Then IsHiddenPage = True
If ItemSystem.Checked AndAlso Settings.Get("UiHiddenSetupSystem") Then IsHiddenPage = True If ItemSystem.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupSystem") Then IsHiddenPage = True
If ItemLink.Checked AndAlso Settings.Get("UiHiddenSetupLink") Then IsHiddenPage = True If ItemLink.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLink") Then IsHiddenPage = True
If PageSetupUI.HiddenForceShow Then IsHiddenPage = False If PageSetupUI.HiddenForceShow Then IsHiddenPage = False
'若页面错误，或尚未加载，则继续 '若页面错误，或尚未加载，则继续
If IsLoad AndAlso Not IsHiddenPage Then Return If IsLoad AndAlso Not IsHiddenPage Then Return
@@ -17,13 +17,13 @@
PageSetupUI.HiddenRefresh() PageSetupUI.HiddenRefresh()
'选择第一个未被禁用的子页面 '选择第一个未被禁用的子页面
If IsPageSwitched Then Return If IsPageSwitched Then Return
If Not Settings.Get("UiHiddenSetupLaunch") Then If Not Settings.Get(Of Boolean)("UiHiddenSetupLaunch") Then
ItemLaunch.SetChecked(True, False, False) ItemLaunch.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenSetupUi") Then ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupUi") Then
ItemUI.SetChecked(True, False, False) ItemUI.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenSetupSystem") Then ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupSystem") Then
ItemSystem.SetChecked(True, False, False) ItemSystem.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenSetupLink") Then ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupLink") Then
ItemLink.SetChecked(True, False, False) ItemLink.SetChecked(True, False, False)
Else Else
ItemLaunch.SetChecked(True, False, False) ItemLaunch.SetChecked(True, False, False)
@@ -42,13 +42,13 @@
Public Sub New() Public Sub New()
InitializeComponent() InitializeComponent()
'选择第一个未被禁用的子页面 '选择第一个未被禁用的子页面
If Not Settings.Get("UiHiddenSetupLaunch") Then If Not Settings.Get(Of Boolean)("UiHiddenSetupLaunch") Then
PageID = FormMain.PageSubType.SetupLaunch PageID = FormMain.PageSubType.SetupLaunch
ElseIf Not Settings.Get("UiHiddenSetupUi") Then ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupUi") Then
PageID = FormMain.PageSubType.SetupUI PageID = FormMain.PageSubType.SetupUI
ElseIf Not Settings.Get("UiHiddenSetupSystem") Then ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupSystem") Then
PageID = FormMain.PageSubType.SetupSystem PageID = FormMain.PageSubType.SetupSystem
ElseIf Not Settings.Get("UiHiddenSetupLink") Then ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupLink") Then
PageID = FormMain.PageSubType.SetupLink PageID = FormMain.PageSubType.SetupLink
Else Else
PageID = FormMain.PageSubType.SetupLaunch PageID = FormMain.PageSubType.SetupLaunch
@@ -115,7 +115,7 @@
PageID = ID PageID = ID
Catch ex As Exception Catch ex As Exception
Log(ex, "切换分页面失败（ID " & ID & "）", NotifyLevel.MsgBoxAndFeedback) Logger.Error(ex, $"切换分页面失败（ID {ID}）")
Finally Finally
AniControlEnabled -= 1 AniControlEnabled -= 1
End Try End Try
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLink.xaml.vb
+2 -2
View File
@@ -23,10 +23,10 @@
Public Sub Reset() Public Sub Reset()
Try Try
SettingService.ResetSettings(Me) SettingService.ResetSettings(Me)
Log("[Setup] 已初始化联机页设置") Logger.Info("已初始化联机页设置")
Hint("已初始化联机页设置！", HintType.Green, False) Hint("已初始化联机页设置！", HintType.Green, False)
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化联机页设置失败", NotifyLevel.MsgBox) Logger.Error(ex, "初始化联机页设置失败", LogBehavior.Alert)
End Try End Try
Reload() Reload()
End Sub End Sub

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