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
Plain Craft Launcher 2/App.config
+2 -9
View File
@@ -5,13 +5,10 @@
<httpWebRequest useUnsafeHeaderParsing="true"/>
</settings>
</system.net>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
</startup>
<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"/>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly>
@@ -25,10 +22,6 @@
<dependentAssembly>
<assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<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>
<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:behaviors="clr-namespace:PCL.Controls.Behaviors"
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"
StartupUri="FormMain.xaml"
ShutdownMode="OnExplicitShutdown">
@@ -10,10 +12,10 @@
<ResourceDictionary>
<!-- Converter -->
<local:AdditionConverter x:Key="AdditionConverter"/>
<local:MultiplicationConverter x:Key="MultiplicationConverter"/>
<local:InverseBooleanToVisibilityConverter x:Key="InverseBooleanToVisibilityConverter"/>
<local:InverseBooleanConverter x:Key="InverseBooleanConverter"/>
<corewpf:AdditionConverter x:Key="AdditionConverter"/>
<corewpf:MultiplicationConverter x:Key="MultiplicationConverter"/>
<corewpf:InverseBooleanToVisibilityConverter x:Key="InverseBooleanToVisibilityConverter"/>
<corewpf:InverseBooleanConverter x:Key="InverseBooleanConverter"/>
<BooleanToVisibilityConverter x:Key="BooleanToVisibilityConverter"/>
<!-- 颜色表 -->
@@ -366,6 +368,7 @@
<Setter Property="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="FontSize" Value="13" />
<Setter Property="MaxDropDownHeight" Value="320" />
<Setter Property="Cursor" Value="Hand" />
<Setter Property="Template">
<Setter.Value>
<ControlTemplate TargetType="ComboBox">
Plain Craft Launcher 2/Application.xaml.vb
+72 -66
View File
@@ -1,47 +1,37 @@
Imports System.Reflection
Imports System.Windows.Threading
Imports Microsoft.Win32
Public Class Application
'开始
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
Try
'提升主线程优先级
Thread.CurrentThread.Priority = ThreadPriority.Highest
'执行开发版测试
If BuildType = BuildTypes.Debug Then
Try
ModDevelop.Start()
Catch ex As Exception
Log(ex, "开发者模式测试出错", NotifyLevel.MsgBox)
Logger.Error(ex, "开发者模式测试出错", LogBehavior.Alert)
End Try
End If
'提升主线程优先级
Thread.CurrentThread.Priority = ThreadPriority.Highest
'确保 .NET Framework 版本
'检查 .NET Framework 版本
Try
Dim VersionTest As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
Catch ex As UriFormatException '修复 #3555
Environment.SetEnvironmentVariable("windir", Environment.GetEnvironmentVariable("SystemRoot"), EnvironmentVariableTarget.User)
Dim VersionTest As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
End Try
'检测当前文件夹权限
Try
DirectoryUtils.Create(PathExeFolder & "PCL\")
Using ndpKey As RegistryKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry32).OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\v4\Full\")
If ndpKey?.GetValue("Release") IsNot Nothing AndAlso CInt(ndpKey.GetValue("Release")) < 528040 Then OldEnvironmentAssert()
End Using
Catch ex As Exception
MsgBox($"PCL 无法创建 PCL 文件夹（{PathExeFolder & "PCL"}），请尝试：" & vbCrLf &
"1. 将 PCL 移动到其他文件夹" & If(PathExeFolder.StartsWithF("C:", True), "，例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
"2. 删除当前目录中的 PCL 文件夹，然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性，打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误")
Environment.[Exit](ProcessReturnValues.Cancel)
Logger.Warn(ex, "检查 .NET Framework 版本失败")
End Try
'修复 WPF 字体加载（#3467）
Try
Dim _unused As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
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
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(0) = "--update" Then
@@ -73,18 +63,30 @@ Public Class Application
End If
End If
'初始化文件结构
DirectoryUtils.Create(PathExeFolder & "PCL\Pictures\")
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\")
Try
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
DirectoryUtils.Create(PathTemp)
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限")
CheckPermissionWithException(PathTemp)
Catch ex As Exception
If PathTemp = Path.GetTempPath() & "PCL\" Then
MyMsgBox("PCL 无法访问缓存文件夹，可能导致程序出错或无法正常使用！" & vbCrLf & vbCrLf & "错误原因：" & ex.GetDetail(), "缓存文件夹不可用")
MyMsgBox("PCL 无法访问缓存文件夹，可能导致程序出错或无法正常使用！" & vbCrLf & vbCrLf & "错误原因：" & ex.GetDisplay(True), "缓存文件夹不可用")
Else
MyMsgBox("手动设置的缓存文件夹不可用，PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因：" & ex.GetDetail(), "缓存文件夹不可用")
MyMsgBox("手动设置的缓存文件夹不可用，PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因：" & ex.GetDisplay(True), "缓存文件夹不可用")
Settings.Set("SystemSystemCache", "")
PathTemp = Path.GetTempPath() & "PCL\"
GoTo RetryCacheCheck
End If
End Try
DirectoryUtils.Create(PathTemp & "Cache\")
@@ -123,22 +125,21 @@ WaitRetry:
ServicePointManager.EnableDnsRoundRobin = True
ServicePointManager.ReusePort = True
'设置初始窗口
If Settings.Get("UiLauncherLogo") Then
If Settings.Get(Of Boolean)("UiLauncherLogo") Then
FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True)
End If
'日志初始化
LogStart()
'添加日志
Log($"[Start] 程序版本：{VersionDisplay} ({VersionCode}{If(CommitHash = "", "", $"，#{CommitHash}")})")
MeloongCore.Main.Init(New PclLogger With {.logFolder = PathUtils.CurrentFolder & "PCL", .MinLevel = If(ModeDebug, LogLevel.Trace, LogLevel.Info)})
Logger.Info($"程序版本：{VersionDisplay} ({VersionCode}{If(CommitHash = "", "", $"，#{CommitHash}")})")
If BuildType = BuildTypes.Snapshot Then
Log($"[Start] 识别码：{Identify}{If(ThemeCheckOne(9), "，已解锁反馈主题", "，未解锁反馈主题")}")
Logger.Info($"识别码：{Identify}{If(ThemeCheckOne(9), "，已解锁反馈主题", "，未解锁反馈主题")}")
Else
Log($"[Start] 识别码：{Identify}")
Logger.Info($"识别码：{Identify}")
End If
Log($"[Start] 程序路径：{PathExe}")
Log($"[Start] 系统编码：{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Log($"[Start] 管理员权限：{IsAdmin()}")
Logger.Info($"程序路径：{PathExe}")
Logger.Info($"系统编码：{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Logger.Info($"管理员权限：{SystemUtils.HasAdminRole()}")
'检测异常环境
If PathExeFolder.Contains(Path.GetTempPath()) OrElse PathExeFolder.Contains("AppData\Local\Temp\") Then
MyMsgBox("请将 PCL 从压缩包中解压后再使用！" & vbCrLf & "如果不会解压，可以在网上寻找教程。", "需要解压！", "我知道了", IsWarn:=True, ForceWait:=True)
@@ -148,7 +149,7 @@ WaitRetry:
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统，部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏！", "环境警告", "我知道了", IsWarn:=True)
End If
'计时
Log("[Start] 第一阶段加载用时：" & GetTimeMs() - ApplicationStartTick & " ms")
Logger.Info($"第一阶段加载用时：{GetTimeMs() - ApplicationStartTick} ms")
ApplicationStartTick = GetTimeMs()
AniControlEnabled += 1
Catch ex As Exception
@@ -157,7 +158,7 @@ WaitRetry:
FilePath = PathExe
Catch
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)
End Try
End Sub
@@ -181,43 +182,48 @@ WaitRetry:
End If
'正常处理
e.Handled = True
If IsProgramEnded Then Return
If IsProgramEnding Then Return
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
Detail.Contains(".NET Framework") Then ' “自动错误判断” 的结果分析
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
Log(e.Exception, "你的 .NET Framework 版本过低或损坏，请下载并重新安装 .NET Framework 4.6.2！" & vbCrLf & "若无法安装，可在卸载高版本的 .NET Framework 后再试。", NotifyLevel.Critical, "运行环境错误")
OldEnvironmentAssert(e.Exception)
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 Sub
'动态 DLL 加载
Private Sub New() '这里必须尽早调用，且不能使用任何库，否则加载 MeloongCore 就会导致崩溃
Static Prefixes As String() = {"NAudio", "Newtonsoft.Json", "Ookii.Dialogs.Wpf", "Imazen.WebP", "CacheCow.Common", "CacheCow.Client.FileStore", "CacheCow.Client", "System.Net.Http.Formatting", "System.ValueTuple", "PCLCS", "MeloongCore.Wpf", "MeloongCore"}
Static Locks As New Dictionary(Of String, Object)(StringComparer.Ordinal)
Static LoadedAssembly As New Dictionary(Of String, Assembly)(StringComparer.Ordinal) '缓存
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 LoadedAssemblies As New ConcurrentDictionary(Of String, Lazy(Of Assembly))(StringComparer.Ordinal) '缓存
AddHandler AppDomain.CurrentDomain.AssemblyResolve,
Function(sender As Object, Args As ResolveEventArgs) As Assembly
Dim Prefix As String = Prefixes.FirstOrDefault(Function(p) Args.Name.StartsWith(p, StringComparison.Ordinal))
If Prefix Is Nothing Then Return Nothing
If Not Locks.ContainsKey(Prefix) Then Locks(Prefix) = New Object()
SyncLock Locks(Prefix)
If Not LoadedAssembly.ContainsKey(Prefix) Then
LoadedAssembly(Prefix) = Assembly.Load(My.Resources.ResourceManager.GetObject(Prefix))
If Prefix = "Imazen.WebP" Then ExtractLibwebp() 'WebP 特判
End If
Return LoadedAssembly(Prefix)
End SyncLock
Dim LazyAssembly = LoadedAssemblies.GetOrAdd(Prefix, Function(p) New Lazy(Of Assembly)(
Function()
Dim LoadedAssembly = Assembly.Load(DirectCast(My.Resources.ResourceManager.GetObject(p), Byte()))
If p = "Imazen.WebP" Then ExtractLibwebp() 'WebP 特判
Return LoadedAssembly
End Function, LazyThreadSafetyMode.ExecutionAndPublication))
Return LazyAssembly.Value
End Function
End Sub
Private Shared Sub ExtractLibwebp() '这个方法会调用 ModBase，进而调用 MeloongCore，所以不能放在 New 里
SetDllDirectory(PathPure.TrimEnd("\"c))
Try
FileUtils.Write(PathPure & "libwebp.dll", GetResources("libwebp64"))
ExtractResources(PathPure & "libwebp.dll", "libwebp64")
Catch ex As Exception
Log(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时，同时写入文件导致文件占用，进而导致崩溃
Logger.Warn(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时，同时写入文件导致文件占用，进而导致崩溃
End Try
End Sub
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)
Select Case Settings.Get("LoginType")
Select Case Settings.Get(Of McLoginType)("LoginType")
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)
Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0
@@ -237,19 +243,19 @@ WaitRetry:
Case McLoginType.Legacy
'离线
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)
Settings.Set("LoginLegacyName", Names.Join("¨"c))
FrmLoginLegacy.ComboName.ItemsSource = Names
FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
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 Names 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("Login" & Token & "Pass") = "" Then Passs.AddRange(Settings.Get("Login" & Token & "Pass").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(Of String)("Login" & Token & "Pass") = "" Then Passs.AddRange(Settings.Get(Of String)("Login" & Token & "Pass").Split("¨"))
For i = 0 To Names.Count - 1
Dict.Add(Names(i), Passs(i))
Next
Plain Craft Launcher 2/Controls/MyButton.xaml.vb
+2 -2
View File
@@ -136,7 +136,7 @@ Public Class MyButton
End If
Catch ex As Exception
Log(ex, "刷新按钮颜色出错")
Logger.Warn(ex, "刷新按钮颜色出错")
End Try
End Sub
@@ -144,7 +144,7 @@ Public Class MyButton
Private IsMouseDown As Boolean = False
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return
Log("[Control] 按下按钮：" & Text)
Logger.Info($"按下按钮：{Text}")
RaiseEvent Click(sender, e)
RaiseCustomEvent() '自定义事件
End Sub
Plain Craft Launcher 2/Controls/MyCard.vb
+10 -3
View File
@@ -164,7 +164,7 @@
Case 13
Stack.Children.Add(NeoForgeDownloadListItem(Data, AddressOf NeoForgeSave_Click, True))
Case Else
Log("未知的虚拟化种类：" & Type, NotifyLevel.MsgBoxAndFeedback)
Logger.Error($"未知的虚拟化种类：{Type}")
End Select
Next
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)
'若尚未加载，会在 Loaded 事件中触发无动画的折叠，不需要在这里进行
If Not IsLoaded Then Return
'更新高度
'更新样式
SwapControl.Visibility = Visibility.Visible
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)
End Set
@@ -351,12 +352,18 @@
End If
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)
End Sub
Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
IsSwapMouseDown = False
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
Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb
+2 -2
View File
@@ -59,7 +59,7 @@ Public Class MyCheckBox
SyncUI()
RaiseCustomEvent()
Catch ex As Exception
Log(ex, "设置 Checked 失败")
Logger.Warn(ex, "设置 Checked 失败")
End Try
End Sub
Private Sub SyncUI()
@@ -133,7 +133,7 @@ Public Class MyCheckBox
Private AllowMouseDown As Boolean = True
Private Sub Checkbox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Return
Log("[Control] 按下复选框（" & (Not Checked).ToString & "）：" & Text)
Logger.Info($"按下复选框（{(Not Checked)}）：{Text}")
MouseDowned = False
SetChecked(Not Checked, True)
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
If HintText.Length > 0 Then TextBox.HintText = HintText
Catch ex As Exception
Log(ex, "初始化可编辑文本框失败（" & If(Name, "") & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"初始化可编辑文本框失败（{If(Name, "")}）")
End Try
End Sub
Private _Text As String = SelectedItem
@@ -107,7 +107,7 @@
Try
CType(Template.FindName("PanPopup", Me), Grid).Opacity = FrmMain.Opacity
Catch ex As Exception
Log(ex, "设置下拉框透明度失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "设置下拉框透明度失败")
End Try
End Sub
Private Sub MyComboBox_DropDownClosed(sender As Object, e As EventArgs) Handles Me.DropDownClosed
@@ -147,7 +147,7 @@
ElseIf Items.Count > NewValue Then
SelectedIndex = NewValue
Else
Log($"[Setting] 尝试显示设置 {SettingService.GetKey(Me)}，但没有找到设置值 {NewValue} 的对应项", NotifyLevel.DebugModeOnly)
Logger.Warn($"尝试显示设置 {SettingService.GetKey(Me)}，但没有找到设置值 {NewValue} 的对应项")
SelectedIndex = -1
SelectedItem = Nothing
End If
Plain Craft Launcher 2/Controls/MyComboBoxItem.vb
+1 -1
View File
@@ -61,7 +61,7 @@
End Operator
Private Sub MyComboBoxItem_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
Log("[Control] 选择下拉列表项：" & Tostring())
Logger.Info($"选择下拉列表项：{Tostring()}")
End Sub
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
If IsLeftMouseHeld Then
Log("[Control] 按下附加按钮" & If(ToolTip = "", "", "：" & ToolTip.ToString))
Logger.Info($"按下附加按钮{If(ToolTip = "", "", "：" & ToolTip)}")
RaiseEvent Click(sender, e)
e.Handled = True
Button_LeftMouseUp()
@@ -92,7 +92,7 @@
End Sub
Private Sub Button_RightMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonUp
If IsRightMouseHeld Then
Log("[Control] 右键按下附加按钮" & If(ToolTip = "", "", "：" & ToolTip.ToString))
Logger.Info($"右键按下附加按钮{If(ToolTip = "", "", "：" & ToolTip)}")
RaiseEvent RightClick(sender, e)
e.Handled = True
Button_RightMouseUp()
@@ -193,7 +193,7 @@
End If
Catch ex As Exception
Log(ex, "刷新图标按钮颜色出错")
Logger.Warn(ex, "刷新图标按钮颜色出错")
End Try
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
If Not IsLeftMouseHeld Then Return
Log("[Control] 按下附加图标按钮：" & Text)
Logger.Info($"按下附加图标按钮：{Text}")
RaiseEvent Click(sender, e)
e.Handled = True
RaiseCustomEvent()
@@ -156,7 +156,7 @@ Public Class MyExtraTextButton
End If
Catch ex As Exception
Log(ex, "刷新附加图标按钮颜色出错")
Logger.Warn(ex, "刷新附加图标按钮颜色出错")
End Try
End Sub
Plain Craft Launcher 2/Controls/MyHint.xaml.vb
+2 -2
View File
@@ -99,7 +99,7 @@ Public Class MyHint
End Property
Public Property RelativeSetup As String = ""
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
Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
Settings.SetSafe(RelativeSetup, True)
@@ -112,7 +112,7 @@ Public Class MyHint
Private Sub MyHint_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return
IsMouseDown = False
Log("[Control] 按下提示条" & If(String.IsNullOrEmpty(Name), "", "：" & Name))
Logger.Info($"按下提示条{If(String.IsNullOrEmpty(Name), "", "：" & Name)}")
RaiseEvent Click(sender, e)
If e.Handled Then Return
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 Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return
Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", "：" & Name))
Logger.Info($"按下图标按钮{If(String.IsNullOrEmpty(Name), "", "：" & Name)}")
RaiseEvent Click(sender, e)
e.Handled = True
Button_MouseUp()
@@ -160,7 +160,7 @@ Public Class MyIconButton
End If
Catch ex As Exception
Log(ex, "刷新图标按钮动画状态出错")
Logger.Warn(ex, "刷新图标按钮动画状态出错")
End Try
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 Sub MyIconTextButton_MouseUp() Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return
Log("[Control] 按下带图标按钮：" & Text)
Logger.Info($"按下带图标按钮：{Text}")
IsMouseDown = False
RaiseEvent Click(Me, New RouteEventArgs(True))
RaiseCustomEvent() '自定义事件
@@ -166,7 +166,7 @@ Public Class MyIconTextButton
End If
Catch ex As Exception
Log(ex, "刷新带图标按钮颜色出错")
Logger.Warn(ex, "刷新带图标按钮颜色出错")
End Try
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 线程中读取文件
RunInUi(Sub() MyBase.Source = Bitmap)
Catch ex As Exception
Log(ex, $"加载图片失败（{value}）")
Logger.Warn(ex, $"加载图片失败（{value}）")
Try
If value.StartsWithF(PathTemp) AndAlso File.Exists(value) Then File.Delete(value)
If value.StartsWithF(PathTemp) Then FileUtils.Delete(value)
Catch
End Try
End Try
@@ -113,7 +113,7 @@
'从缓存加载网络图片
Dim EnableCache As Boolean = Me.EnableCache
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
ActualSource = TempPath '显示缓存的图片
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
@@ -130,24 +130,24 @@
{Source, FallbackSource}, {Source}),
TempPath, SimulateBrowserHeaders:=True)
ActualSource = TempPath
If Not EnableCache Then File.Delete(TempPath)
If Not EnableCache Then FileUtils.Delete(TempPath)
Catch ex As Exception
Try
If TempPath IsNot Nothing Then File.Delete(TempPath)
If TempPath IsNot Nothing Then FileUtils.Delete(TempPath)
Catch
End Try
'加载本地备用图片
If IsLocalFallback Then
Try
ActualSource = FallbackSource
Log(ex, $"下载图片失败，使用本地备用图片（{Source}）")
Logger.Warn(ex, $"下载图片失败，使用本地备用图片（{Source}）")
Return
Catch exx As Exception
Log(ex, $"下载图片失败（{Source}）", NotifyLevel.AllUsers)
Log(exx, $"加载备用图片失败（{FallbackSource}）", NotifyLevel.AllUsers)
Logger.Error(ex, $"下载图片失败（{Source}）", LogBehavior.Toast)
Logger.Error(exx, $"加载备用图片失败（{FallbackSource}）", LogBehavior.Toast)
End Try
Else
Log(ex, $"下载图片失败（{Source}，备用：{FallbackSource}）", NotifyLevel.AllUsers)
Logger.Error(ex, $"下载图片失败（{Source}，备用：{FallbackSource}）", LogBehavior.Toast)
End If
End Try
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
Catch ex As Exception
Log(ex, "设置 Checked 失败")
Logger.Warn(ex, "设置 Checked 失败")
End Try
End Sub
@@ -515,12 +515,12 @@ Public Class MyListItem
'实际的单击处理
Select Case Type
Case CheckType.Clickable
Log("[Control] 按下单击列表项：" & Title)
Logger.Info($"按下单击列表项：{Title}")
Case CheckType.RadioBox
Log("[Control] 按下单选列表项：" & Title)
Logger.Info($"按下单选列表项：{Title}")
If Not Checked Then SetChecked(True, True, True)
Case CheckType.CheckBox
Log("[Control] 按下复选列表项（" & (Not Checked).ToString & "）：" & Title)
Logger.Info($"按下复选列表项（{Not Checked}）：{Title}")
SetChecked(Not Checked, True, True)
End Select
End Sub
@@ -643,7 +643,7 @@ Public Class MyListItem
Dim Entry As New HelpEntry(CustomEvent.GetAbsoluteUrls(CustomEventService.GetEventData(Me), CustomEventService.GetEventType(Me))(0))
Entry.SetToListItem(Me)
Catch ex As Exception
Log(ex, "设置帮助 MyListItem 失败", NotifyLevel.MsgBox)
Logger.Error(ex, "设置帮助 MyListItem 失败", LogBehavior.Alert)
CustomEventService.SetEventType(Me, CustomEvent.EventType.None)
CustomEventService.SetEventData(Me, "")
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
LabText.Text = "未知错误"
Else
Do While Ex.InnerException IsNot Nothing
Ex = Ex.InnerException
Loop
LabText.Text = If(Ex.IsNetworkRelated(), "网络环境不佳，请稍后再试，或使用 VPN 改善网络环境", Ex.Message)
Ex = Ex.RootException()
LabText.Text = If(Ex.IsBadNetwork(), "网络环境不佳，请稍后再试，或使用 VPN 改善网络环境", Ex.Message)
End If
Else
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)
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
'基础
Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb
+3 -3
View File
@@ -26,7 +26,7 @@
ShapeLine.StrokeThickness = GetWPFSize(1)
Catch ex As Exception
Log(ex, "输入弹窗初始化失败", NotifyLevel.AllUsers)
Logger.Error(ex, "输入弹窗初始化失败", LogBehavior.Toast)
End Try
End Sub
@@ -46,10 +46,10 @@
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyMsgBox " & Uuid)
'记录日志
Log("[Control] 输入弹窗：" & LabTitle.Text)
Logger.Info($"输入弹窗：{LabTitle.Text}")
Catch ex As Exception
Log(ex, "输入弹窗加载失败", NotifyLevel.AllUsers)
Logger.Error(ex, "输入弹窗加载失败", LogBehavior.Toast)
End Try
End Sub
Private Sub Close()
Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb
+3 -3
View File
@@ -35,7 +35,7 @@
Next
Catch ex As Exception
Log(ex, "选择弹窗初始化失败", NotifyLevel.AllUsers)
Logger.Error(ex, "选择弹窗初始化失败", LogBehavior.Toast)
End Try
End Sub
@@ -53,10 +53,10 @@
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyMsgBox " & Uuid)
'记录日志
Log("[Control] 选择弹窗：" & LabTitle.Text)
Logger.Info($"选择弹窗：{LabTitle.Text}")
Catch ex As Exception
Log(ex, "选择弹窗加载失败", NotifyLevel.AllUsers)
Logger.Error(ex, "选择弹窗加载失败", LogBehavior.Toast)
End Try
End Sub
Private Sub Close()
Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb
+3 -3
View File
@@ -25,7 +25,7 @@
ShapeLine.StrokeThickness = GetWPFSize(1)
Catch ex As Exception
Log(ex, "普通弹窗初始化失败", NotifyLevel.AllUsers)
Logger.Error(ex, "普通弹窗初始化失败", LogBehavior.Toast)
End Try
End Sub
@@ -44,10 +44,10 @@
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyMsgBox " & Uuid)
'记录日志
Log("[Control] 普通弹窗：" & LabTitle.Text & vbCrLf & LabCaption.Text)
Logger.Info($"普通弹窗：{LabTitle.Text}{vbCrLf}{LabCaption.Text}")
Catch ex As Exception
Log(ex, "普通弹窗加载失败", NotifyLevel.AllUsers)
Logger.Error(ex, "普通弹窗加载失败", LogBehavior.Toast)
End Try
End Sub
Private Sub Close()
Plain Craft Launcher 2/Controls/MyPageRight.vb
+72 -26
View File
@@ -35,7 +35,7 @@
Set(value As PageStates)
If _PageState = value Then Return
_PageState = value
If ModeDebug Then Log("[UI] 页面状态切换为 " & GetStringFromEnum(value))
Logger.Trace($"页面状态切换为 {value}")
End Set
End Property
@@ -59,9 +59,9 @@
''' <param name="PanAlways">无论是否在加载总是要显示的容器。可以为 Nothing。</param>
''' <param name="RealLoader">在工作线程执行的加载器。</param>
''' <param name="FinishedInvoke">当加载器执行完成，在 UI 线程触发的 UI 初始化事件。</param>
Public Sub PageLoaderInit(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement,
RealLoader As LoaderBase,
Optional FinishedInvoke As Action(Of LoaderBase) = Nothing, Optional InputInvoke As Func(Of Object) = Nothing,
Public Sub PageLoaderInit(Of TIn, TOut)(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement,
RealLoader As LoaderTask(Of TIn, TOut),
Optional FinishedInvoke As Action(Of LoaderTask(Of TIn, TOut)) = Nothing, Optional InputInvoke As Func(Of TIn) = Nothing,
Optional AutoRun As Boolean = True)
'初始化参数
Me.PanLoader = PanLoader
@@ -89,13 +89,59 @@
If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
'初次运行加载器
If PageLoaderAutoRun Then
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Nothing, PageLoaderInputInvoke))
Else
Dim Input = Nothing
If PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
PageLoader.Start(Input)
End If
'上下两个重载只有这里不一样
PageLoader.Start(RealLoader.StartGetInput(Nothing, PageLoaderInputInvoke))
End If
If PageLoader.State = LoadState.Finished AndAlso FinishedInvoke IsNot Nothing Then
RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成，直接触发事件
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
If PageLoader.State = LoadState.Finished AndAlso FinishedInvoke IsNot Nothing Then
RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成，直接触发事件
@@ -125,7 +171,7 @@
''' 需要根据加载器状态，从 Empty 切换到 ContentEnter、LoaderWait、LoaderEnter。
''' </summary>
Public Sub PageOnEnter()
If ModeDebug Then Log("[UI] 已触发 PageOnEnter")
Logger.Trace("已触发 PageOnEnter")
RaiseEvent PageEnter()
Select Case PageState
Case PageStates.Empty
@@ -155,7 +201,7 @@
Case PageStates.ContentEnter
'重复调用 PageOnEnter，直接忽略
Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnter 事件。")
Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnEnter 事件。")
End Select
End Sub
Public Event PageEnter()
@@ -164,7 +210,7 @@
''' 需要立即切换至 PageExit 或 Empty。
''' </summary>
Public Sub PageOnExit()
If ModeDebug Then Log("[UI] 已触发 PageOnExit")
Logger.Trace("已触发 PageOnExit")
RaiseEvent PageExit()
Select Case PageState
Case PageStates.ContentEnter, PageStates.ContentStay
@@ -189,7 +235,7 @@
''' </summary>
Public Sub PageOnForceExit()
If PageState = PageStates.Empty Then Return
If ModeDebug Then Log("[UI] 已触发 PageOnForceExit")
Logger.Trace("已触发 PageOnForceExit")
PageState = PageStates.Empty
AniStop("PageRight PageChange " & PageUuid)
'由于动画会被强制中止，所以需要手动进行隐藏
@@ -206,7 +252,7 @@
''' 需要在 PageEnter 事件确认要显示的子页面有哪些。
''' </summary>
Public Sub PageOnContentExit()
If ModeDebug Then Log("[UI] 已触发 PageOnContentExit")
Logger.Trace("已触发 PageOnContentExit")
If PageLoader IsNot Nothing AndAlso PageLoader.State = LoadState.Loading Then
'Loading 的加载器可能触发进一步变化，难以预测会触发子页面的动画还是加载器完成的动画
Throw New Exception("在调用 PageOnContentExit 时，加载器不能为 Loading 状态")
@@ -235,7 +281,7 @@
''' 需要根据目前状态，从 ContentEnter 切换到 ContentStay，或从 LoaderEnter 切换到 LoaderStayForce。
''' </summary>
Private Sub PageOnEnterAnimationFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnEnterAnimationFinished")
Logger.Trace("已触发 PageOnEnterAnimationFinished")
Select Case PageState
Case PageStates.ContentEnter
PageState = PageStates.ContentStay
@@ -243,7 +289,7 @@
PageState = PageStates.LoaderStayForce
AniStart(AaCode(AddressOf PageOnLoaderStayFinished, 400), "PageRight PageChange " & PageUuid)
Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnterAnimationFinished 事件。")
Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnEnterAnimationFinished 事件。")
End Select
End Sub
''' <summary>
@@ -251,7 +297,7 @@
''' 需要根据目前状态，从 AllExit 切换到 Empty，或从 LoaderExit 切换到 ContentEnter，或从 ContentExit 重新触发 PageOnEnter。
''' </summary>
Private Sub PageOnExitAnimationFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnExitAnimationFinished")
Logger.Trace("已触发 PageOnExitAnimationFinished")
Select Case PageState
Case PageStates.PageExit
PageState = PageStates.Empty
@@ -261,7 +307,7 @@
PageState = PageStates.ContentEnter
TriggerEnterAnimation(PanContent)
Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnExitAnimationFinished 事件。")
Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnExitAnimationFinished 事件。")
End Select
End Sub
''' <summary>
@@ -269,7 +315,7 @@
''' 需要从 LoaderWait 切换到 LoaderEnter。
''' </summary>
Private Sub PageOnLoaderWaitFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnLoaderWaitFinished")
Logger.Trace("已触发 PageOnLoaderWaitFinished")
Select Case PageState
Case PageStates.LoaderWait
PageState = PageStates.LoaderEnter
@@ -279,7 +325,7 @@
TriggerEnterAnimation(PanLoader)
End If
Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。")
Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnLoaderWaitFinished 事件。")
End Select
End Sub
''' <summary>
@@ -287,7 +333,7 @@
''' 需要从 LoaderStayForce 切换到 LoaderStay 或 LoaderExit。
''' </summary>
Private Sub PageOnLoaderStayFinished()
If ModeDebug Then Log("[UI] 已触发 PageOnLoaderStayFinished")
Logger.Trace("已触发 PageOnLoaderStayFinished")
Select Case PageState
Case PageStates.LoaderStayForce
If PageLoader.State = LoadState.Finished Then
@@ -297,7 +343,7 @@
PageState = PageStates.LoaderStay
End If
Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。")
Throw New Exception("在状态为 " & PageState.ToString() & " 时触发了 PageOnLoaderWaitFinished 事件。")
End Select
End Sub
@@ -308,7 +354,7 @@
Select Case NewState
Case LoadState.Failed, LoadState.Loading
If OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Return
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Start/Refresh)")
Logger.Trace("已触发 PageLoaderState (Start/Refresh)")
'（重新）开始运行
'需要从部分状态切换到 ReloadExit
Select Case PageState
@@ -320,7 +366,7 @@
End Select
Case LoadState.Finished, LoadState.Interrupted, LoadState.Waiting
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
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
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)
IsChanged = True
End If
'保证只有一个单选框选中
'保证最多只有一个单选框选中
If Parent Is Nothing Then Return
Dim RadioboxList As New List(Of MyRadioBox)
Dim CheckedCount As Integer = 0
@@ -64,31 +64,26 @@ Public Class MyRadioBox
If Control.Checked Then CheckedCount += 1
End If
Next
Select Case CheckedCount '判断选中情况
Case 0
'没有任何单选框被选中，选择第一个
RadioboxList(0).Checked = True
Case Is > 1
'选中项目多于 1 个
If Checked Then
'如果本控件选中，则取消其他所有控件的选中
For Each Control As MyRadioBox In RadioboxList
If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False
Next
Else
'如果本控件未选中，则只保留第一个选中的控件
Dim FirstChecked = False
For Each Control As MyRadioBox In RadioboxList
If Control.Checked Then
If FirstChecked Then
Control.Checked = False '修改 Checked 会自动触发 Change 事件，所以不用额外触发
Else
FirstChecked = True
End If
If CheckedCount > 1 Then
If Checked Then
'如果本控件选中，则取消其他所有控件的选中
For Each Control As MyRadioBox In RadioboxList
If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False
Next
Else
'如果本控件未选中，则只保留第一个选中的控件
Dim FirstChecked = False
For Each Control As MyRadioBox In RadioboxList
If Control.Checked Then
If FirstChecked Then
Control.Checked = False '修改 Checked 会自动触发 Change 事件，所以不用额外触发
Else
FirstChecked = True
End If
Next
End If
End Select
End If
Next
End If
End If
If IsChanged Then
'触发事件
@@ -100,10 +95,11 @@ Public Class MyRadioBox
End If
Catch ex As Exception
Log(ex, "单选框勾选改变错误", NotifyLevel.AllUsers)
Logger.Error(ex, "单选框勾选改变错误", LogBehavior.Toast)
End Try
End Sub
Private Sub SyncUI()
Cursor = If(Checked, Nothing, Cursors.Hand)
If AniControlEnabled = 0 AndAlso IsLoaded Then '防止默认属性变更触发动画
If Checked Then
'由无变有
@@ -175,7 +171,7 @@ Public Class MyRadioBox
Private AllowMouseDown As Boolean = True
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Return
Log("[Control] 按下单选框：" & Text)
Logger.Info($"按下单选框：{Text}")
SetChecked(True, True)
MouseDowned = False
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 AnimationTimeOfMouseOut As Integer = 200 '鼠标指向动画长度
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
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()
Catch ex As Exception
Log(ex, "单选按钮勾选改变错误", NotifyLevel.AllUsers)
Logger.Error(ex, "单选按钮勾选改变错误", LogBehavior.Toast)
End Try
End Sub
@@ -145,7 +145,7 @@ Public Class MyRadioButton
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Checked Then Return
If Not IsMouseDown Then Return
Log("[Control] 按下单选按钮：" & Text)
Logger.Info($"按下单选按钮：{Text}")
IsMouseDown = False
Dim e As New RouteEventArgs(True)
RaiseEvent PreviewClick(Me, e)
@@ -167,6 +167,7 @@ Public Class MyRadioButton
Private Const AnimationTimeOfMouseOut As Integer = 150 '鼠标移出动画长度
Private Const AnimationTimeOfCheck As Integer = 120 '勾选状态变更动画长度
Private Sub RefreshColor(Optional obj = Nothing, Optional e = Nothing) Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded
Cursor = If(Checked, Nothing, Cursors.Hand)
Try
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not False.Equals(e) Then '防止默认属性变更触发动画，若强制不执行动画，则 e 为 False
@@ -255,7 +256,7 @@ Public Class MyRadioButton
End If
Catch ex As Exception
Log(ex, "刷新单选按钮颜色出错")
Logger.Warn(ex, "刷新单选按钮颜色出错")
End Try
End Sub
Plain Craft Launcher 2/Controls/MyScrollBar.vb
+1 -1
View File
@@ -44,7 +44,7 @@
End If
Catch ex As Exception
Log(ex, "滚动条颜色改变出错")
Logger.Warn(ex, "滚动条颜色改变出错")
End Try
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)
Catch ex As Exception
Log(ex, "滑动条进度改变出错", NotifyLevel.AllUsers)
Logger.Error(ex, "滑动条进度改变出错", LogBehavior.Toast)
End Try
End Set
End Property
@@ -156,7 +156,7 @@ Public Class MySlider
End If
Catch ex As Exception
Log(ex, "滑动条颜色改变出错")
Logger.Warn(ex, "滑动条颜色改变出错")
End Try
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)
Catch ex As Exception
Log(ex, "滑动条进度改变出错", LogLevel.Hint)
Logger.Warning(ex, "滑动条进度改变出错", LogLevel.Hint)
End Try
End Set
End Property
Plain Craft Launcher 2/Controls/MyTextBox.vb
+2 -2
View File
@@ -228,7 +228,7 @@
'改变文本
RaiseEvent ValidatedTextChanged(sender, e)
Catch ex As Exception
Log(ex, "进行输入验证时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "进行输入验证时出错")
End Try
End Sub
@@ -282,7 +282,7 @@
End If
Catch ex As Exception
Log(ex, "文本框颜色改变出错")
Logger.Warn(ex, "文本框颜色改变出错")
End Try
End Sub
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
If Not IsMouseDown Then Return
IsMouseDown = False
Log("[Control] 按下文本按钮：" & Text)
Logger.Info($"按下文本按钮：{Text}")
RaiseEvent Click(Me, Nothing)
RaiseCustomEvent()
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))
'统计更新日志条目
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
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：下载游戏、整合包的稳定性"))
FeatureCount += 1
@@ -63,58 +68,17 @@ Public Class FormMain
FeatureCount += 32
BugCount += 21
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
'5： FEAT+
'4： IMP+ FEAT*
'3：BUG+ IMP* FEAT-
'2：BUG* IMP-
'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 >= 393 AndAlso LastVersion < 397 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法使用自定义隐藏主题"))
End If
@@ -212,68 +176,6 @@ Public Class FormMain
FeatureCount += 7
BugCount += 10
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
'整理更新日志文本
Dim ContentList As New List(Of String)
@@ -308,7 +210,7 @@ Public Class FormMain
FrmLaunchLeft = New PageLaunchLeft
FrmLaunchRight = New PageLaunchRight
'版本号改变
Dim LastVersion As Integer = Settings.Get("SystemLastVersionReg")
Dim LastVersion As Integer = Settings.Get(Of Integer)("SystemLastVersionReg")
If LastVersion < VersionCode Then
'触发升级
UpgradeSub(LastVersion)
@@ -319,19 +221,19 @@ Public Class FormMain
'版本隔离设置迁移
If Not Settings.HasSaved("LaunchArgumentIndieV2") Then
If Settings.HasSaved("LaunchArgumentIndie") Then
Log("[Start] 从老 PCL 迁移版本隔离")
Settings.Set("LaunchArgumentIndieV2", Settings.Get("LaunchArgumentIndie"))
Logger.Info("从老 PCL 迁移版本隔离")
Settings.Set("LaunchArgumentIndieV2", Settings.Get(Of Integer)("LaunchArgumentIndie"))
ElseIf HasIniKey("Setup", "LaunchVersionSelect") Then
Log("[Start] 从老 PCL 升级，但此前未调整版本隔离，使用老的版本隔离默认值")
Logger.Info("从老 PCL 升级，但此前未调整版本隔离，使用老的版本隔离默认值")
Settings.Set("LaunchArgumentIndieV2", Settings.GetDefault("LaunchArgumentIndie"))
Else
Log("[Start] 全新的 PCL，使用新的版本隔离默认值")
Logger.Info("全新的 PCL，使用新的版本隔离默认值")
Settings.Set("LaunchArgumentIndieV2", Settings.GetDefault("LaunchArgumentIndieV2"))
End If
End If
'刷新主题
ThemeCheckAll(False)
ThemeRefresh(Settings.Get("UiLauncherTheme"))
ThemeRefresh(Settings.Get(Of Integer)("UiLauncherTheme"))
'注册拖拽事件（不能直接加 Handles，否则没用；#6340）
[AddHandler](DragDrop.DragEnterEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True)
[AddHandler](DragDrop.DragOverEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True)
@@ -339,7 +241,7 @@ Public Class FormMain
InitializeComponent()
Opacity = 0
'开启管理员权限下的文件拖拽
If IsAdmin() Then
If SystemUtils.HasAdminRole() Then
Static Helper As New DragHelper
AddHandler SourceInitialized,
Sub()
@@ -364,7 +266,7 @@ Public Class FormMain
'尽早执行的加载池
McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行，必须跑一次；为了让启动按钮尽快可用，需要尽早执行；为了与 PageLaunchLeft 联动，需要为 0 而不是 GetUuid
Log("[Start] 第二阶段加载用时：" & GetTimeMs() - ApplicationStartTick & " ms")
Logger.Info($"第二阶段加载用时：{GetTimeMs() - ApplicationStartTick} ms")
End Sub
Private Sub FormMain_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
ApplicationStartTick = GetTimeMs()
@@ -397,10 +299,10 @@ Public Class FormMain
'加载窗口
ThemeRefreshMain()
Try
Height = Settings.Get("WindowHeight")
Width = Settings.Get("WindowWidth")
Height = Settings.Get(Of Integer)("WindowHeight")
Width = Settings.Get(Of Integer)("WindowWidth")
Catch ex As Exception '修复 #2019
Log(ex, "读取窗口默认大小失败", NotifyLevel.AllUsers)
Logger.Error(ex, "读取窗口默认大小失败", LogBehavior.Toast)
Height = MinHeight + 100
Width = MinWidth + 100
End Try
@@ -417,14 +319,14 @@ Public Class FormMain
HwndSource.AddHook(New Interop.HwndSourceHook(AddressOf WndProc))
AniStart({
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) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)),
AaCode(
Sub()
PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True
Log($"[System] DPI：{DPI}，系统版本：{Environment.OSVersion.VersionString}，PCL 位置：{PathExe}")
Logger.Info($"DPI：{DPI}，系统版本：{Environment.OSVersion.VersionString}，PCL 位置：{PathExe}")
End Sub, , True)
}, "Form Show")
'Timer 启动
@@ -435,9 +337,9 @@ Public Class FormMain
Sub()
'EULA 提示
Const EulaVersion As Integer = 2
If Settings.Get("SystemEulaVersion") < EulaVersion Then
If Settings.Get(Of Integer)("SystemEulaVersion") < EulaVersion Then
Select Case MyMsgBox(
If(Settings.Get("SystemEulaVersion") = 0,
If(Settings.Get(Of Integer)("SystemEulaVersion") = 0,
"在使用 PCL 前，请先阅读用户协议与免责声明。",
$"PCL 的用户协议与免责声明已更新。{vbCrLf}请阅读更新后的用户协议与免责声明。"),
"协议授权", "同意", "拒绝", "查看用户协议与免责声明",
@@ -457,13 +359,13 @@ Public Class FormMain
ServerLoader.Start()
RunInNewThread(AddressOf TryClearTaskTemp, "TryClearTaskTemp", ThreadPriority.BelowNormal)
Catch ex As Exception
Log(ex, "初始化加载池运行失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "初始化加载池运行失败")
End Try
'清理自动更新文件
Try
File.Delete(PathExeFolder & "PCL\Plain Craft Launcher 2.exe")
FileUtils.Delete(PathExeFolder & "PCL\Plain Craft Launcher 2.exe")
Catch ex As Exception
Log(ex, "清理自动更新文件失败")
Logger.Warn(ex, "清理自动更新文件失败")
End Try
'上报
Telemetry("启动")
@@ -473,19 +375,19 @@ Public Class FormMain
End If
End Sub, "初始化", ThreadPriority.Lowest)
Log("[Start] 第三阶段加载用时：" & GetTimeMs() - ApplicationStartTick & " ms")
Logger.Info($"第三阶段加载用时：{GetTimeMs() - ApplicationStartTick} ms")
End Sub
'根据打开次数触发的事件
Private Sub RunCountSub()
Settings.Set("SystemCount", Settings.Get("SystemCount") + 1)
Settings.Set("SystemCount", Settings.Get(Of Integer)("SystemCount") + 1)
If BuildType = BuildTypes.Snapshot Then
Select Case Settings.Get("SystemCount")
Select Case Settings.Get(Of Integer)("SystemCount")
Case 1
MyMsgBox("欢迎使用 PCL 快照版！" & vbCrLf &
"快照版包含尚未在正式版发布的测试性功能，仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦！" & vbCrLf &
"如果你并非通过赞助或赞助者本人邀请进群获得的本程序，那么可能是有人在违规传播，记得提醒他一下啦。", "快照版使用说明")
End Select
If Settings.Get("SystemCount") >= 99 Then
If Settings.Get(Of Integer)("SystemCount") >= 99 Then
If ThemeUnlock(6, False) Then
MyMsgBox("你已经使用了 99 次 PCL 啦，感谢你长期以来的支持！" & vbCrLf &
"隐藏主题 铁杆粉 已解锁！", "提示")
@@ -495,75 +397,75 @@ Public Class FormMain
End Sub
'升级与降级事件
Private Sub UpgradeSub(LastVersionCode As Integer)
Log("[Start] 版本号从 " & LastVersionCode & " 升高到 " & VersionCode)
Logger.Info($"版本号从 {LastVersionCode} 升高到 {VersionCode}")
Settings.Set("SystemLastVersionReg", VersionCode)
'检查有记录的最高版本号
Dim LowerVersionCode As Integer
Dim SettingKey = If(BuildType = BuildTypes.Snapshot, "SystemHighestAlphaVersionReg", "SystemHighestBetaVersionReg")
LowerVersionCode = Settings.Get("SystemHighestAlphaVersionReg")
Const SettingKey = If(BuildType = BuildTypes.Snapshot, "SystemHighestAlphaVersionReg", "SystemHighestBetaVersionReg")
LowerVersionCode = Settings.Get(Of Integer)("SystemHighestAlphaVersionReg")
If LowerVersionCode < VersionCode Then
Settings.Set("SystemHighestAlphaVersionReg", VersionCode)
Log($"[Start] 最高版本号从 {LowerVersionCode} 升高到 {VersionCode}")
Settings.Set(SettingKey, VersionCode)
Logger.Info($"最高版本号从 {LowerVersionCode} 升高到 {VersionCode}")
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
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("UiLauncherThemeHide2").ToString.Split("|")))
UnlockedTheme.AddRange(New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide").ToString.Split("|")))
UnlockedTheme.AddRange(New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|")))
Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Distinct.ToList.Join("|"c))
End If
'重置欧皇彩
If LastVersionCode <= 115 AndAlso Settings.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("13") Then
Dim UnlockedTheme As New List(Of String)(Settings.Get("UiLauncherThemeHide2").ToString.Split("|"))
If LastVersionCode <= 115 AndAlso Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|").Contains("13") Then
Dim UnlockedTheme As New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|"))
UnlockedTheme.Remove("13")
Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Join("|"c))
MyMsgBox("由于新版 PCL 修改了欧皇彩的解锁方式，你需要重新解锁欧皇彩。" & vbCrLf &
"多谢各位的理解啦！", "重新解锁提醒")
End If
'重置滑稽彩
If LastVersionCode <= 152 AndAlso Settings.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("12") Then
Dim UnlockedTheme As New List(Of String)(Settings.Get("UiLauncherThemeHide2").ToString.Split("|"))
If LastVersionCode <= 152 AndAlso Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|").Contains("12") Then
Dim UnlockedTheme As New List(Of String)(Settings.Get(Of String)("UiLauncherThemeHide2").ToString.Split("|"))
UnlockedTheme.Remove("12")
Settings.Set("UiLauncherThemeHide2", UnlockedTheme.Join("|"c))
MyMsgBox("由于新版 PCL 修改了滑稽彩的解锁方式，你需要重新解锁滑稽彩。" & vbCrLf &
"多谢各位的理解啦！", "重新解锁提醒")
End If
'移动自定义皮肤
If LastVersionCode <= 161 AndAlso File.Exists(PathExeFolder & "PCL\CustomSkin.png") AndAlso Not File.Exists(PathAppdata & "CustomSkin.png") Then
CopyFile(PathExeFolder & "PCL\CustomSkin.png", PathAppdata & "CustomSkin.png")
Log("[Start] 已移动离线自定义皮肤 (162)")
If LastVersionCode <= 161 AndAlso FileUtils.Exists(PathExeFolder & "PCL\CustomSkin.png") AndAlso Not FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
FileUtils.Copy(PathExeFolder & "PCL\CustomSkin.png", PathAppdata & "CustomSkin.png")
Logger.Info("已移动离线自定义皮肤 (162)")
End If
If LastVersionCode <= 263 AndAlso File.Exists(PathTemp & "CustomSkin.png") AndAlso Not File.Exists(PathAppdata & "CustomSkin.png") Then
CopyFile(PathTemp & "CustomSkin.png", PathAppdata & "CustomSkin.png")
Log("[Start] 已移动离线自定义皮肤 (264)")
If LastVersionCode <= 263 AndAlso FileUtils.Exists(PathTemp & "CustomSkin.png") AndAlso Not FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
FileUtils.Copy(PathTemp & "CustomSkin.png", PathAppdata & "CustomSkin.png")
Logger.Info("已移动离线自定义皮肤 (264)")
End If
'解除帮助页面的隐藏
If LastVersionCode <= 205 Then
Settings.Set("UiHiddenOtherHelp", False)
Log("[Start] 已解除帮助页面的隐藏")
Logger.Info("已解除帮助页面的隐藏")
End If
'单向迁移微软登录结果（#4836）
If Not Settings.Get("CacheMsV2Migrated") Then
If Not Settings.Get(Of Boolean)("CacheMsV2Migrated") Then
Settings.Set("CacheMsV2Migrated", True)
Settings.Set("CacheMsV2OAuthRefresh", Settings.Get("CacheMsOAuthRefresh"))
Settings.Set("CacheMsV2Access", Settings.Get("CacheMsAccess"))
Settings.Set("CacheMsV2ProfileJson", Settings.Get("CacheMsProfileJson"))
Settings.Set("CacheMsV2Uuid", Settings.Get("CacheMsUuid"))
Settings.Set("CacheMsV2Name", Settings.Get("CacheMsName"))
Log("[Start] 已从老版本迁移微软登录结果")
Settings.Set("CacheMsV2OAuthRefresh", Settings.Get(Of String)("CacheMsOAuthRefresh"))
Settings.Set("CacheMsV2Access", Settings.Get(Of String)("CacheMsAccess"))
Settings.Set("CacheMsV2ProfileJson", Settings.Get(Of String)("CacheMsProfileJson"))
Settings.Set("CacheMsV2Uuid", Settings.Get(Of String)("CacheMsUuid"))
Settings.Set("CacheMsV2Name", Settings.Get(Of String)("CacheMsName"))
Logger.Info("已从老版本迁移微软登录结果")
End If
'Mod 命名设置迁移
If Settings.HasSaved("ToolDownloadTranslate") AndAlso Not Settings.HasSaved("ToolDownloadTranslateV2") Then
Settings.Set("ToolDownloadTranslateV2", Settings.Get("ToolDownloadTranslate") + 1)
Log("[Start] 已从老版本迁移 Mod 命名设置")
Settings.Set("ToolDownloadTranslateV2", Settings.Get(Of Integer)("ToolDownloadTranslate") + 1)
Logger.Info("已从老版本迁移 Mod 命名设置")
End If
'重置 JVM 参数设置
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")
Log("[Start] 已重置 JVM 参数设置")
Logger.Info("已重置 JVM 参数设置")
End If
'输出更新日志
If LastVersionCode <= 0 Then Return
@@ -571,7 +473,7 @@ Public Class FormMain
ShowUpdateLog(LowerVersionCode)
End Sub
Private Sub DowngradeSub(LastVersionCode As Integer)
Log("[Start] 版本号从 " & LastVersionCode & " 降低到 " & VersionCode)
Logger.Info($"版本号从 {LastVersionCode} 降低到 {VersionCode}")
Settings.Set("SystemLastVersionReg", VersionCode)
End Sub
@@ -594,7 +496,7 @@ Public Class FormMain
If SendWarning AndAlso MyMsgBox("还有下载任务尚未完成，是否确定退出？", "提示", "确定", "取消") = 2 Then Return
RunInNewThread(
Sub()
Log("[System] 正在强行停止任务")
Logger.Info("正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Interrupt()
Next
@@ -631,26 +533,26 @@ Public Class FormMain
Else
EndProgramForce()
End If
Log("[System] 收到关闭指令")
Logger.Info("收到关闭指令")
End Sub)
End Sub
Private Shared IsLogShown As Boolean = False
Public Shared Sub EndProgramForce(Optional ReturnCode As ProcessReturnValues = ProcessReturnValues.Success)
On Error Resume Next
IsProgramEnded = True
IsProgramEnding = True
AniControlEnabled += 1
If IsUpdateWaitingRestart Then UpdateRestart(False)
If ReturnCode = ProcessReturnValues.Exception Then
If Not IsLogShown Then
FeedbackInfo()
Log("请在 https://github.com/Meloong-Git/PCL/issues 提交错误报告，以便于作者解决此问题！")
Logger.Info("请在 https://github.com/Meloong-Git/PCL/issues 提交错误报告，以便于作者解决此问题！")
IsLogShown = True
StartProcess(PathExeFolder & "PCL\Log1.txt")
End If
Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉
End If
Log("[System] 程序已退出，返回值：" & GetStringFromEnum(ReturnCode))
LogFlush()
Logger.Info($"程序已退出，返回值：{ReturnCode}")
Logger.Instance.Flush()
If ReturnCode <> ProcessReturnValues.Success Then Environment.Exit(ReturnCode)
Process.GetCurrentProcess.Kill()
End Sub
@@ -693,11 +595,11 @@ Public Class FormMain
FrmMain.UpdateBackgroundAndTitleBar()
End Sub
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
ImgBack.Effect = Nothing
Else
@@ -705,7 +607,7 @@ Public Class FormMain
End If
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
Dim Brush As ImageBrush = CType(ImgBack.Background, ImageBrush)
If BackgroundType = 0 Then
@@ -761,7 +663,7 @@ Public Class FormMain
End Select
End If
'标题栏显示类型
Select Case Settings.Get("UiLogoType")
Select Case Settings.Get(Of Integer)("UiLogoType")
Case 0 '无
ShapeTitleLogo.Visibility = Visibility.Collapsed
LabTitleLogo.Visibility = Visibility.Collapsed
@@ -802,14 +704,14 @@ Public Class FormMain
ImageTitleLogo.Source = PathExeFolder & "PCL\Logo.png"
Catch ex As Exception
ImageTitleLogo.Source = Nothing
Log(ex, "显示标题栏图片失败", NotifyLevel.MsgBox)
Logger.Error(ex, "显示标题栏图片失败", LogBehavior.Alert)
End Try
End Select
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 Region
@@ -900,14 +802,14 @@ Public Class FormMain
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
End If
Catch ex As Exception
Log(ex, "切回窗口时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "切回窗口时出错")
End Try
'读取剪贴板，自动加入联机房间
Return 'TODO: 联机复活赛
If PageLinkMain.LinkState <> PageLinkMain.LinkStates.Waiting Then Return '已启动联机
If PageCurrent = PageType.Link 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 '不是邀请码
Settings.Set("LinkLastAutoJoinInviteCode", Code)
RunInThread(
@@ -949,9 +851,9 @@ Public Class FormMain
End If
PrevData = e.Data
PrevEffects = e.Effects
Log("[System] 设置拖放类型：" & GetStringFromEnum(e.Effects))
Logger.Info($"设置拖放类型：{e.Effects}")
Catch ex As Exception
Log(ex, "处理拖放时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "处理拖放时出错")
End Try
End Sub
Private Sub FrmMain_Drop(sender As Object, e As DragEventArgs) Handles Me.Drop
@@ -961,13 +863,13 @@ Public Class FormMain
'获取文本
Try
Dim Str As String = e.Data.GetData(DataFormats.Text)
Log("[System] 接受文本拖拽：" & Str)
Logger.Info($"接受文本拖拽：{Str}")
If Str.StartsWithF("authlib-injector:yggdrasil-server:") Then
'Authlib 拖拽
e.Handled = True
e.Effects = DragDropEffects.Copy
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
Hint($"输入的 Authlib 验证服务器不符合网址格式（{AuthlibServer}）！", HintType.Red)
Return
@@ -1014,7 +916,7 @@ Public Class FormMain
FileDrag(New List(Of String) From {FilePath})
End If
Catch ex As Exception
Log(ex, "无法接取文本拖拽事件", NotifyLevel.DevelopOnly)
Logger.Warn(ex, "无法接取文本拖拽事件")
Return
End Try
ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then
@@ -1029,26 +931,27 @@ Public Class FormMain
FileDrag(CType(FilePathRaw, IEnumerable(Of String)))
End If
Catch ex As Exception
Log(ex, "接取拖拽事件失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "接取拖拽事件失败")
End Try
End Sub
Private Sub FileDrag(FilePathList As IEnumerable(Of String))
RunInNewThread(
Sub()
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)
Return
ElseIf Not File.Exists(FilePathList.First) Then
ElseIf Not FileUtils.Exists(FilePathList.First) Then
Hint("拖入的文件不存在：" & FilePathList.First, HintType.Red)
Return
End If
'多文件拖拽
Dim PathList As List(Of String) = FilePathList.ToList()
If FilePathList.Count > 1 Then
'必须要求全部为 jar 文件
For Each File In FilePathList
For Each File In PathList
If Not {"jar", "litemod", "disabled", "old"}.Contains(File.AfterLast(".").Lower) Then
Hint("一次请只拖入一个文件！", HintType.Red)
Return
@@ -1058,13 +961,13 @@ Public Class FormMain
'主页
Dim Extension As String = FilePath.AfterLast(".").Lower
If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML，作为主页加载")
If File.Exists(PathExeFolder & "PCL\Custom.xaml") Then
Logger.Info("文件后缀为 XAML，作为主页加载")
If FileUtils.Exists(PathExeFolder & "PCL\Custom.xaml") Then
If MyMsgBox("已存在一个主页文件，是否要将它覆盖？", "覆盖确认", "覆盖", "取消") = 2 Then
Return
End If
End If
CopyFile(FilePath, PathExeFolder & "PCL\Custom.xaml")
FileUtils.Copy(FilePath, PathExeFolder & "PCL\Custom.xaml")
RunInUi(
Sub()
Settings.Set("UiCustomType", 1)
@@ -1074,10 +977,10 @@ Public Class FormMain
Return
End If
'安装 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，总之试一试
Log("[System] 文件为压缩包，尝试作为整合包安装")
Logger.Info("文件为压缩包，尝试作为整合包安装")
Try
ModpackInstall(FilePath)
Return
@@ -1094,7 +997,7 @@ Public Class FormMain
End If
'错误报告分析
Try
Log("[System] 尝试进行错误报告分析")
Logger.Info("尝试进行错误报告分析")
Dim Analyzer As New CrashAnalyzer
Analyzer.Import(FilePath)
If Not Analyzer.Prepare() Then Exit Try
@@ -1102,7 +1005,7 @@ Public Class FormMain
Analyzer.Output(True, New List(Of String))
Return
Catch ex As Exception
Log(ex, "自主错误报告分析失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "自主错误报告分析失败")
End Try
'未知操作
Hint("PCL 无法确定应当执行的文件拖拽操作……")
@@ -1115,16 +1018,16 @@ Public Class FormMain
If msg = 30 Then
Dim NowDate = Date.Now
If NowDate.Date = ApplicationOpenTime.Date Then
Log("[System] 系统时间微调为：" & NowDate.ToLongDateString & " " & NowDate.ToLongTimeString)
Logger.Info($"系统时间微调为：{NowDate.ToLongDateString} {NowDate.ToLongTimeString}")
IsSystemTimeChanged = False
Else
Log("[System] 系统时间修改为：" & NowDate.ToLongDateString & " " & NowDate.ToLongTimeString)
Logger.Info($"系统时间修改为：{NowDate.ToLongDateString} {NowDate.ToLongTimeString}")
IsSystemTimeChanged = True
End If
ElseIf msg = 400 * 16 + 2 Then
Log("[System] 收到置顶信息：" & hwnd.ToInt64)
Logger.Info($"收到置顶信息：{hwnd.ToInt64}")
If Not IsWindowLoadFinished Then
Log("[System] 窗口尚未加载完成，忽略置顶请求")
Logger.Info("窗口尚未加载完成，忽略置顶请求")
Return IntPtr.Zero
End If
ShowWindowToTop()
@@ -1147,7 +1050,7 @@ Public Class FormMain
Left -= 10000
ShowInTaskbar = False
Visibility = Visibility.Hidden
Log("[System] 窗口已隐藏，位置：(" & Left & "," & Top & ")")
Logger.Info($"窗口已隐藏，位置：({Left},{Top})")
Else
'取消隐藏
If Left < -2000 Then Left += 10000
@@ -1170,7 +1073,7 @@ Public Class FormMain
Topmost = False
SetForegroundWindow(Handle)
Focus()
Log($"[System] 窗口已置顶，位置：({Left}, {Top}), {Width} x {Height}")
Logger.Info($"窗口已置顶，位置：({Left}, {Top}), {Width} x {Height}")
End Sub)
End Sub
@@ -1501,9 +1404,9 @@ Public Class FormMain
BtnExtraApril.ShowRefresh()
#End Region
Log("[Control] 切换主要页面：" & GetStringFromEnum(Stack) & ", " & SubType)
Logger.Info($"切换主要页面：{Stack}, {SubType}")
Catch ex As Exception
Log(ex, "切换主要页面失败（ID " & PageCurrent.Page & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换主要页面失败（ID {PageCurrent.Page}）")
Finally
AniControlEnabled -= 1
End Try
@@ -1686,7 +1589,7 @@ Public Class FormMain
Next
Hint("已关闭运行中的 Minecraft！", HintType.Green)
Catch ex As Exception
Log(ex, "强制关闭所有 Minecraft 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "强制关闭所有 Minecraft 失败")
End Try
End Sub
Public Function BtnExtraShutdown_ShowCheck() As Boolean
@@ -1701,7 +1604,7 @@ Public Class FormMain
If RealScroll IsNot Nothing Then
RealScroll.PerformVerticalOffsetDelta(-RealScroll.VerticalOffset)
Else
Log("[UI] 无法返回顶部，未找到合适的 RealScroll", NotifyLevel.AllUsers)
Logger.Error("无法返回顶部，未找到合适的 RealScroll", LogBehavior.Toast)
End If
End Sub
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>
Public ReadOnly Property AniSpeed As Double
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))
End Get
End Property
@@ -114,7 +114,7 @@ Public Module ModAnimation
Public ValueLast As Object
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 Structure
@@ -521,13 +521,14 @@ Public Module ModAnimation
''' </summary>
''' <remarks></remarks>
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
For Each Item In Stack.Children
Item.Opacity = 0
AaStack.Add(AaOpacity(Item, 1, Time, AniDelay))
Result.Add(AaOpacity(Item, 1, Time, AniDelay))
AniDelay += Delay
Next
Return Result
End Function
#End Region
@@ -810,7 +811,7 @@ Public Module ModAnimation
RunInNewThread(
Sub()
Try
Log("[Animation] 动画线程开始")
Logger.Info("动画线程开始")
Do While True
'两帧之间的间隔时间
Dim DeltaTime As Long = (GetTimeMs() - AniLastTick).Clamp(0, 100000)
@@ -831,7 +832,7 @@ Public Module ModAnimation
AniCount = 0
AniTimer(DeltaTime * AniSpeed)
If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then
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 Sub)
Sleeper:
@@ -839,7 +840,7 @@ Sleeper:
Thread.Sleep(1)
Loop
Catch ex As Exception
Log(ex, "动画帧执行失败", NotifyLevel.Critical)
Logger.Error(ex, "动画帧执行失败", LogBehavior.AlertThenCrash)
End Try
End Sub, "Animation", ThreadPriority.AboveNormal)
End Sub
@@ -850,7 +851,7 @@ Sleeper:
Public Sub AniTimer(DeltaTick As Integer)
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
'循环每个动画组
Do While i + 1 < AniGroups.Count
@@ -915,7 +916,7 @@ NextAni:
Loop
Catch ex As Exception
Log(ex, "动画刻执行失败", NotifyLevel.AllUsers)
Logger.Error(ex, "动画刻执行失败", LogBehavior.Toast)
End Try
End Sub
@@ -1052,7 +1053,7 @@ NextAni:
End Select
Ani.TimePercent = Ani.TimeFinished / Ani.TimeTotal '修改执行百分比
Catch ex As Exception
Log(ex, "执行动画失败：" & Ani.ToString, NotifyLevel.AllUsers)
Logger.Error(ex, $"执行动画失败：{Ani}", LogBehavior.Toast)
End Try
Return Ani
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
End While
Catch ex As Exception
Log(ex, "获取父加载器失败（" & Name & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"获取父加载器失败（{Name}）")
Return Nothing
End Try
End Get
@@ -88,9 +88,9 @@
Set(value As LoadState)
If _State = value Then Return
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
If Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载器 {Name} 状态改变：{GetStringFromEnum(value)}")
If Not LogBlackList.Contains(Name) Then Logger.Info($"加载器 {Name} 状态改变：{value}")
'实现 ILoadingTrigger 接口与 OnStateChanged 回调
RunInUi(
Sub()
@@ -229,13 +229,13 @@
''' <summary>
''' 用于异步执行并监控单一函数的加载器。
''' </summary>
Public Class LoaderTask(Of InputType, OutputType)
Public Class LoaderTask(Of TIn, TOut)
Inherits LoaderBase
'线程设定
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)
'状态指示
''' <summary>
@@ -265,25 +265,25 @@
''' </summary>
Public LastRunningThread As Thread = Nothing
'输入输出
Public Input As InputType = Nothing
Public Output As OutputType = Nothing
Public Input As TIn = 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
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
RunInUiWait(Sub() Input = InputDelegate())
End If
Return Input
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
Input = StartGetInput(Input)
Catch ex As Exception
Log(ex, "加载输入获取失败（" & Name & "）", NotifyLevel.AllUsers)
Logger.Error(ex, $"加载输入获取失败（{Name}）", LogBehavior.Toast)
[Error] = ex
SyncLock LockState
State = LoadState.Failed
@@ -319,21 +319,21 @@
Sub()
Try
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)
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
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()
State = LoadState.Finished
LastFinishedTime = GetTimeMs() '未中断，本次输出有效
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
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 时手动引发了 ThreadInterruptedException，则代表没有重启线程，这通常代表用户手动取消，应当改为 Interrupted
If Not IsInterrupted Then State = LoadState.Interrupted
@@ -354,7 +354,7 @@
If IsInterrupted OrElse State >= LoadState.Finished Then Return
State = LoadState.Failed
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()
End Sub
Public Overrides Sub Interrupt()
@@ -368,7 +368,7 @@
If LastRunningThread Is Nothing Then Return
If LastRunningThread.IsAlive Then
LastRunningThread.Interrupt()
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
Logger.Trace(Function() $"加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
End If
LastRunningThread = Nothing
End Sub
@@ -376,7 +376,7 @@
Public Sub New()
'仅仅是为了避免一些智障报错（继承类必须重写 New 的情况）
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.LoadDelegate = LoadDelegate
Me.InputDelegate = InputDelegate
@@ -515,7 +515,7 @@
'检查是否需要重启
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
Log("[Loader] 由于输入条件变更，重启已完成的加载器 " & Loader.Name)
Logger.Info($"由于输入条件变更，重启已完成的加载器 {Loader.Name}")
GoTo Restart
End If
'更新下一个加载器的输入
@@ -527,7 +527,7 @@
'检查是否需要重启
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
Log("[Loader] 由于输入条件变更，重启进行中的加载器 " & Loader.Name, NotifyLevel.DevelopOnly)
Logger.Warn($"由于输入条件变更，重启进行中的加载器 {Loader.Name}")
GoTo Restart
End If
End If
@@ -598,7 +598,7 @@ Restart:
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
LoaderTaskbar.Add(Loader)
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
Logger.Info($"{Loader.Name} 已加入任务列表")
End Sub
Public Sub LoaderTaskbarProgressRefresh()
Try
@@ -610,7 +610,7 @@ Restart:
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Interrupted) Then
FrmSpeedLeft?.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
Logger.Info($"{Task.Name} 已移出任务列表")
End If
Next
'更新平滑后的进度
@@ -635,7 +635,7 @@ Restart:
FrmMain.BtnExtraDownload.ShowRefresh()
End If
Catch ex As Exception
Log(ex, "刷新任务栏进度显示失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新任务栏进度显示失败")
End Try
End Sub
Public Function LoaderTaskbarProgressGet() As Double
@@ -643,7 +643,7 @@ Restart:
If Not LoaderTaskbar.Any Then Return 1
Return LoaderTaskbar.Select(Function(l) l.Progress).Average().Clamp(0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "获取任务栏进度出错")
Return 0.5
End Try
End Function
@@ -671,11 +671,10 @@ Restart:
''' </summary>
''' <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
Dim FolderInfo As DirectoryInfo
Dim Value As New LoaderFolderDictionaryEntry With {.FolderPath = FolderPath & ExtraPath, .LastCheckTime = Nothing}
Try
'获取数据
FolderInfo = New DirectoryInfo(FolderPath & ExtraPath)
Dim FolderInfo = DirectoryUtils.GetInfo(FolderPath & ExtraPath)
Value.LastCheckTime = If(FolderInfo.Exists, GetActualLastWriteTimeUtc(FolderInfo, MaxDepth), DirectCast(Nothing, Date?))
'如果已经检查过，则跳过
If Type = LoaderFolderRunType.RunOnUpdated AndAlso LoaderFolderDictionary.ContainsKey(Loader) Then
@@ -687,7 +686,7 @@ Restart:
End If
End If
Catch ex As Exception
Log(ex, "文件夹加载器启动检测出错")
Logger.Warn(ex, "文件夹加载器启动检测出错")
End Try
'写入检查数据
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.Runtime.CompilerServices
Imports System.Threading.Tasks
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 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 MakeLog Then Log("[Net] 发起网络请求（" & Method.Method & "，" & Url & "），最大超时 " & Timeout)
If MakeLog Then Logger.Info($"发起网络请求（{Method.Method}，{Url}），最大超时 {Timeout}")
Try
Dim HeaderDictionary = If(Headers, {}).ToDictionary
If ContentType IsNot Nothing Then HeaderDictionary("Content-Type") = ContentType
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 截断时可能不完整）
'在此处检查并报错，可以让 NetRequestByClientRetry 等方法进行重试
If RequireJson Then
@@ -36,7 +35,7 @@ Public Module ModNet
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If MakeLog Then Log(ex, "网络请求失败", NotifyLevel.DevelopOnly)
If MakeLog Then Logger.Warn(ex, "网络请求失败")
Throw
End Try
End Function
@@ -72,9 +71,10 @@ Retry:
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If TypeOf ex Is ResponsedWebException Then
If CType(ex, ResponsedWebException).StatusCode = HttpStatusCode.Forbidden Then Throw
If CType(ex, ResponsedWebException).StatusCode = 429 Then Thread.Sleep(10000) 'Too Many Requests
If TypeOf ex Is HttpRequestCodeException Then
If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.Forbidden Then Throw
If CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.NotFound Then Throw
If CType(ex, HttpRequestCodeException).StatusCode = 429 Then Thread.Sleep(10000) 'Too Many Requests
End If
'重试
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)})
Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls.First & "）")
NetRequestByLoader = ReadFile(Temp)
File.Delete(Temp)
Dim Result = FileUtils.ReadAsString(Temp)
FileUtils.Delete(Temp)
Return Result
Finally
NewTask.Interrupt()
End Try
@@ -173,29 +174,21 @@ RequestFinished:
''' 不建议用于下载大文件。
''' </summary>
Public Sub NetDownloadByClient(Url As String, LocalPath As String, Optional SimulateBrowserHeaders As Boolean = False)
Log($"[Net] 通过网络请求直接下载小文件：{Url} → {LocalPath}")
'初始化文件路径
Try
DirectoryUtils.Create(LocalPath, isFilePath:=True)
File.Delete(LocalPath)
Catch ex As Exception
Throw New Exception($"预处理下载文件路径失败（{LocalPath}）", ex)
End Try
'下载
Logger.Info($"通过网络请求直接下载小文件：{Url} → {LocalPath}")
Dim RetryCount As Integer = 0
Retry:
Try
File.WriteAllBytes(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders))
FileUtils.Write(LocalPath, SendRequest(Url, HttpMethod.Get, SimulateBrowserHeaders:=SimulateBrowserHeaders))
Catch ex As ThreadInterruptedException
File.Delete(LocalPath)
FileUtils.Delete(LocalPath)
Throw
Catch ex As Exception
File.Delete(LocalPath)
FileUtils.Delete(LocalPath)
If RetryCount < 2 Then
RetryCount += 1
GoTo Retry
End If
Throw New WebException($"通过网络请求直接下载小文件失败（{LocalPath}）", ex)
Throw New HttpRequestException($"通过网络请求直接下载小文件失败（{LocalPath}）", ex)
End Try
End Sub
@@ -259,6 +252,7 @@ Retry:
HostIp = DNSLookup(Request, CancelToken.Token)
If HostIp IsNot Nothing Then IPReliability.GetOrAdd(HostIp, -0.01) '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率
'发送请求
Directory.CreateDirectory(PathTemp & "Cache\Http\")
SyncLock RequestClientLock
If RequestClient Is Nothing Then '延迟初始化，以避免在程序启动前加载 CacheCow 导致 DLL 加载失败
RequestClient = CacheCow.Client.ClientExtensions.CreateClient(New CacheCow.Client.FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With {
@@ -283,14 +277,14 @@ Retry:
Return ResponseBytes
Else
RecordIPReliability(HostIp, -0.7)
Dim ResponseMessage = If(Encoding, Encoding.UTF8).GetString(ResponseBytes)
Throw New ResponsedWebException(
Dim ResponseMessage = ResponseBytes.GetString(Encoding)
Throw New HttpRequestCodeException(
$"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Method}，{Url}，{HostIp}" &
If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), Response.StatusCode, ResponseMessage)
End If
Catch ex As ThreadInterruptedException
Throw
Catch ex As ResponsedWebException
Catch ex As HttpRequestException
Throw
Catch ex As FileNotFoundException
'由于 CacheCow 读取缓存失败，然后系统调用不存在的 System.Net.Http.Formatting.resources 抛出（#8150）
@@ -299,7 +293,7 @@ Retry:
RecordIPReliability(HostIp, -1)
If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then 'CancellationToken 超时
Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
ElseIf ex.IsNetworkRelated Then
ElseIf ex.IsBadNetwork Then
Throw New WebException($"网络请求失败，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout)
Else
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 解析超时")
Candidates = Dns.EndGetHostAddresses(AsyncResult).Distinct.ToArray
Catch ex As Exception
Log(ex, $"DNS 解析失败（{Host}）")
Logger.Warn(ex, $"DNS 解析失败（{Host}）")
DNSFailureRecord(Host) = Date.Now
Return Nothing
End Try
If Not Candidates.Any Then
Log($"[Net] DNS 解析无结果（{Host}）")
Logger.Info($"DNS 解析无结果（{Host}）")
Return Nothing
End If
'若同时存在 IPv4 和 IPv6 地址，仅选择其中一类（因为 GFW 可能只屏蔽了 IPv4 或 IPv6）
@@ -353,7 +347,7 @@ Retry:
Dim IPv4Reliability = IPv4Targets.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 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)
End If
'选择可靠度最高的 IP
@@ -379,27 +373,6 @@ Retry:
)
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
#Region "多线程下载引擎"
@@ -413,7 +386,7 @@ Retry:
''' </summary>
Public ReadOnly Property NetTaskThreadLimit As Integer
Get
Return Settings.Get("ToolDownloadThread") + 1
Return Settings.Get(Of Integer)("ToolDownloadThread") + 1
End Get
End Property
''' <summary>
@@ -426,7 +399,7 @@ Retry:
Public ReadOnly Property NetTaskSpeedLimitHigh As Long
Get
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
_NetTaskSpeedLimitHigh = (Setting + 1) * 0.1 * 1024 * 1024L
ElseIf Setting <= 31 Then
@@ -822,7 +795,7 @@ Retry:
Private _Speed As Long = 0
''' <summary>
''' 该文件是否由本地文件直接拷贝完成。
''' 该文件是否由本地文件直接复制完成。
''' </summary>
Public IsCopy As Boolean = False
''' <summary>
@@ -901,7 +874,7 @@ Retry:
Me.LocalPath = LocalPath
Me.Check = Checker
Me.SimulateBrowserHeaders = SimulateBrowserHeaders
Me.LocalName = GetFileNameFromPath(LocalPath)
Me.LocalName = PathUtils.GetLastPart(LocalPath)
End Sub
''' <summary>
@@ -1003,7 +976,7 @@ StartThread:
''' 每个下载线程执行的代码。
''' </summary>
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,
Response As HttpResponseMessage = Nothing, ResponseStream As Stream = 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)
Dim ContentLength As Long = 0
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 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)
If ContentLength < 0 Then
If FileSize > 1 Then
If Th.DownloadStart = 0 Then
Log($"[Download] {LocalName}：文件大小未知，但已从其他下载源获取，不作处理")
Logger.Info($"{LocalName}：文件大小未知，但已从其他下载源获取，不作处理")
Else
Log($"[Download] {LocalName}：ContentLength 返回了 {ContentLength}，无法确定是否支持分段下载，视作不支持")
Logger.Info($"{LocalName}：ContentLength 返回了 {ContentLength}，无法确定是否支持分段下载，视作不支持")
GoTo NotSupportRange
End If
Else
FileSize = -1 : IsUnknownSize = True
Log($"[Download] {LocalName}：文件大小未知")
Logger.Info($"{LocalName}：文件大小未知")
End If
ElseIf Th.IsFirstThread Then
If Check IsNot Nothing Then
@@ -1048,7 +1023,7 @@ StartThread:
End If
End If
FileSize = ContentLength : IsUnknownSize = False
Log($"[Download] {LocalName}：文件大小 {ContentLength}（{FormatFileSize(ContentLength)}）")
Logger.Info($"{LocalName}：文件大小 {ContentLength}（{FormatFileSize(ContentLength)}）")
'若文件大小大于 50 M，进行剩余磁盘空间校验
If ContentLength > 50 * 1024 * 1024 Then
For Each Drive As DriveInfo In DriveInfo.GetDrives
@@ -1084,17 +1059,16 @@ NotSupportRange:
ResultStream = Cache
Else
Th.Temp = $"{PathTemp}Download\{Uuid}_{Th.Uuid}_{RandomInteger(0, 999999)}.tmp"
DirectoryUtils.Create(Th.Temp, isFilePath:=True)
ResultStream = New FileStream(Th.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
ResultStream = FileUtils.CreateAsStream(Th.Temp)
End If
'开始下载
CancelToken.Dispose() : CancelToken = New CancellationTokenSource() '重置超时，不再让 CancellationToken 在固定时间后触发（#8488）
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) {}
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
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
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
'被外部中断
Th.State = NetState.Interrupted
Log($"[Download] {LocalName}：中断")
Logger.Info($"{LocalName}：中断")
ElseIf HttpDataCount = 0 AndAlso Th.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
'服务器无返回数据
Throw New Exception($"返回的 ContentLength 过多：ContentLength 为 {ContentLength}，但获取到的总数据量仅为 {Th.DownloadDone}（全文件总数据量 {DownloadDone}）")
Else
'本线程完成
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)
End If
Catch ex As Exception
Log($"[Download] {LocalName}：出错，{If(TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException,
$"已超时（{Timeout}ms）", ex.GetDetail())}，IP：{HostIp}")
If ex.IsBadNetwork OrElse TypeOf ex Is TaskCanceledException Then
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)
SourceFail(Th, ex, False)
Finally
@@ -1194,9 +1171,8 @@ SourceBreak:
End SyncLock
'……后续处理
If IsThisFail Then
Log($"[Download] {LocalName}：下载源被禁用（{Th.Source.Id}，Range 问题：{IsRangeNotSupported}）：{Th.Source.Url}")
Log(ex, $"{If(SourcesOnce.FirstOrDefault?.SingleThread Is Nothing, "", "单线程")}下载源 {Th.Source.Id} 已被禁用",
If(IsRangeNotSupported OrElse ex.Message.Contains("(404)"), NotifyLevel.DevelopOnly, NotifyLevel.DebugModeOnly))
Logger.Info($"{LocalName}：下载源被禁用（{Th.Source.Id}，Range 问题：{IsRangeNotSupported}）：{Th.Source.Url}")
Logger.Warn(ex, $"{If(SourcesOnce.FirstOrDefault?.SingleThread Is Nothing, "", "单线程")}下载源 {Th.Source.Id} 已被禁用")
SyncLock LockSource
SourcesOnce.Remove(Th.Source)
End SyncLock
@@ -1208,7 +1184,7 @@ SourceBreak:
ElseIf Not Retried Then
'合并失败或首次下载失败，未重试：将所有下载源重新标记为不允许断点续传的下载源，逐个重新尝试下载
'若所有源均不支持 Range，也会走到这里重试
If Not IsRangeNotSupported Then Log($"[Download] {LocalName}：文件下载失败，正在自动重试……", NotifyLevel.DebugModeOnly)
If Not IsRangeNotSupported Then Logger.Warn($"{LocalName}：文件下载失败，正在自动重试……")
Retried = True
SyncLock LockSource
SourcesOnce.Clear()
@@ -1229,14 +1205,14 @@ SourceBreak:
End SyncLock
Else
'失败
Log($"[Download] {LocalName}：已无可用下载源，下载失败")
Logger.Info($"{LocalName}：已无可用下载源，下载失败")
Dim ExampleEx As Exception = Nothing
SyncLock LockSource
For Each Source As NetSource In Sources
Log("[Download] 已禁用的下载源：" & Source.Url)
Logger.Info($"已禁用的下载源：{Source.Url}")
If Source.Ex IsNot Nothing Then
ExampleEx = Source.Ex
Log(Source.Ex, "下载源禁用原因", NotifyLevel.DevelopOnly)
Logger.Warn(Source.Ex, "下载源禁用原因")
End If
Next
End SyncLock
@@ -1276,26 +1252,26 @@ SourceBreak:
Try
Retry:
'创建文件夹
DirectoryUtils.Create(LocalPath, isFilePath:=True)
If File.Exists(LocalPath) Then File.Delete(LocalPath)
DirectoryUtils.Create(PathUtils.RemoveLastPart(LocalPath))
FileUtils.Delete(LocalPath)
SyncLock LockChain
'合并文件
If IsNoSplit Then
'仅有一个线程，从内存中输出
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，从内存输出文件")
Logger.Trace(Function() $"{LocalName}：下载结束，从内存输出文件")
FileUtils.Write(LocalPath, Cache)
ElseIf Threads.DownloadDone = DownloadDone AndAlso Threads.Temp IsNot Nothing Then
'仅有一个文件，直接复制
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，仅有一个文件，无需合并")
CopyFile(Threads.Temp, LocalPath)
Logger.Trace(Function() $"{LocalName}：下载结束，仅有一个文件，无需合并")
FileUtils.Copy(Threads.Temp, LocalPath)
Else
'有多个线程，合并
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，开始合并文件")
Using MergeFile As New FileStream(LocalPath, FileMode.Create)
Logger.Trace(Function() $"{LocalName}：下载结束，开始合并文件")
Using MergeFile = FileUtils.CreateAsStream(LocalPath)
Using AddWriter As New BinaryWriter(MergeFile)
For Each Thread As NetThread In Threads
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)
AddWriter.Write(TempReader.ReadBytes(Thread.DownloadDone))
End Using
@@ -1314,16 +1290,16 @@ Retry:
End If
End If
If CheckResult IsNot Nothing Then
Log($"[Download] {LocalName} 文件校验失败，下载线程细节：")
Logger.Info($"{LocalName} 文件校验失败，下载线程细节：")
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
Throw New Exception(CheckResult)
End If
'后处理
If Not IsNoSplit Then
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
End If
Finish()
@@ -1331,7 +1307,7 @@ Retry:
Catch ex As Exception
RetryCount += 1
If State > NetState.Merging Then Return '通常是因为在合并时被中断了
Log(ex, $"合并文件出错，第 {RetryCount} 次尝试（{LocalName}）")
Logger.Warn(ex, $"合并文件出错，第 {RetryCount} 次尝试（{LocalName}）")
'重新尝试合并
If RetryCount < 3 Then
Threading.Thread.Sleep(500 * RetryCount)
@@ -1339,9 +1315,9 @@ Retry:
End If
'失败，禁用当前下载源并重启下载
Try
If File.Exists(LocalPath) Then File.Delete(LocalPath)
FileUtils.Delete(LocalPath)
Catch exx As Exception
Log(ex, $"删除合并失败的文件出错（{LocalPath}）")
Logger.Warn(ex, $"删除合并失败的文件出错（{LocalPath}）")
End Try
SourceFail(Th, ex, True)
Finally
@@ -1356,7 +1332,7 @@ Retry:
If State >= NetState.Finished Then Return
If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
'凉凉
Log($"[Download] {LocalName}：已失败，当前状态 {State}")
Logger.Info($"{LocalName}：已失败，当前状态 {State}")
State = NetState.Interrupted
End SyncLock
InterruptInternal()
@@ -1374,7 +1350,7 @@ Retry:
'确认中断
SyncLock LockState
If State >= NetState.Finished Then Return
Log($"[Download] {LocalName}：已中断，当前状态 {State}")
Logger.Info($"{LocalName}：已中断，当前状态 {State}")
State = NetState.Interrupted
End SyncLock
InterruptInternal()
@@ -1395,7 +1371,7 @@ Retry:
State = NetState.Finished
End SyncLock
Interlocked.Decrement(NetManager.FileRemain)
If PrintLog Then Log($"[Download] {LocalName}：已完成")
If PrintLog Then Logger.Info($"{LocalName}：已完成")
For Each Task In Tasks
Task.OnFileFinish(Me)
Next
@@ -1403,7 +1379,7 @@ Retry:
End Class
Private Class RangeNotSupportedException
Inherits WebException
Inherits HttpRequestException
Public Sub New(Message As String)
MyBase.New(Message)
End Sub
@@ -1451,7 +1427,7 @@ Retry:
Set(value As Integer)
_FailCount = value
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
Dim ExList As New List(Of Exception)
For Each File In Files
@@ -1492,7 +1468,7 @@ FinishExCatch:
_Progress = NewProgress
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
Files = New ConcurrentList(Of NetFile)(FileTasks)
End Sub
@@ -1526,7 +1502,7 @@ FinishExCatch:
File.LocalPath = File.LocalPath.Replace("/", "\")
If Not File.LocalPath.Lower.Contains(":\") 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
'接入下载管理器，获取新开始下载的文件列表
Dim NewFiles = NetManager.Start(Me)
@@ -1552,7 +1528,7 @@ FinishExCatch:
Dim Folders As New List(Of String)
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里
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 线程
If ThreadCount = 1 Then '只有一个线程，直接执行
@@ -1575,43 +1551,27 @@ FinishExCatch:
End Sub
Private Sub CheckExistingFiles(Files As List(Of NetFile), FolderList As List(Of String))
Try
If ModeDebug Then Log($"[Download] 文件检查开始，本线程负责的文件数：{Files.Count}")
Logger.Trace(Function() $"文件检查开始，本线程负责 {Files.Count} 个文件，首个文件为 {Files.FirstOrDefault?.LocalName}")
'列出 MC 文件夹中的各个版本文件夹
Dim VersionFolders As New List(Of String)
For Each McFolder In FolderList
Dim VersionsFolder As New DirectoryInfo(McFolder & "versions\")
If VersionsFolder.Exists() Then
For Each VersionFolder In VersionsFolder.GetDirectories
VersionFolders.Add(VersionFolder.FullName & "\")
Next
End If
For Each VersionFolder In DirectoryUtils.GetDirectories(McFolder & "versions\", True)
VersionFolders.Add(PathUtils.AddSlashSuffix(VersionFolder))
Next
Next
'处理每个文件
For Each File As NetFile In Files
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 Target IsNot Nothing Then
File.IsCopy = True
Dim RetryCount As Integer = 0
Retry:
Try
If Target <> File.LocalPath Then
Log($"[Download] 复制已存在的文件：{Target} → {File.LocalPath}")
CopyFile(Target, File.LocalPath)
Else
If ModeDebug Then Log($"[Download] 需要下载的文件已存在，并通过校验：{Target}")
End If
FileUtils.Copy(Target, File.LocalPath)
File.Finish(False)
Continue For
Catch ex As Exception
RetryCount += 1
Log(ex, $"复制已存在的文件失败，第 {RetryCount} 次重试（{Target} → {File.LocalPath}）")
If RetryCount < 3 Then
Thread.Sleep(2000)
GoTo Retry
End If
Catch
End Try
End If
'回退到下载
@@ -1628,7 +1588,7 @@ Retry:
'目标文件已存在
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
'大致判断文件类别
@@ -1646,37 +1606,35 @@ Retry:
Dim Type = TypeIndexes.MaxBy(Function(kv) kv.Item2).FolderName.TrimStart("\"c)
'根据类别进行查找
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
Case "assets\", "libraries\"
'assets/libraries：查找 MC 文件夹下的相同路径
For Each Folder In FolderList
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
Return Nothing
Case "versions\"
'版本 jar 或 json：查找 MC 文件夹下的各个版本文件夹
For Each VersionFolder In VersionFolders
For Each Candidate In Directory.GetFiles(VersionFolder,
"*." & GetFileNameFromPath(File.LocalPath).AfterLast(".").Lower, SearchOption.TopDirectoryOnly)
'快速进行大小校验
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
For Each Candidate In DirectoryUtils.GetFiles(VersionFolder, True, "*." & PathUtils.GetLastPart(File.LocalPath).AfterLast(".").Lower)
If CheckCandidate(Candidate, File.Check) Then Return Candidate
Next
Next
Case Else
'社区资源
If File.Check.ActualSize < 0 OrElse File.Check.Hash Is Nothing Then Return Nothing '必须要求指定了文件大小和 Hash
For Each Folder In FolderList.Concat(VersionFolders)
Dim TargetFolder = Folder & Type
If Not Directory.Exists(TargetFolder) Then Continue For
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
For Each Candidate In DirectoryUtils.GetFiles(Folder & Type, True)
If CheckCandidate(Candidate, File.Check) Then Return Candidate
Next
Next
End Select
@@ -1719,7 +1677,7 @@ Retry:
For Each File In Files
If File.State <> NetState.Interrupted Then Continue For
If File.Sources.All(Function(s) TypeOf s.Ex Is OperationCanceledException OrElse TypeOf s.Ex Is TimeoutException OrElse TypeOf s.Ex Is ThreadInterruptedException) Then Continue For
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 &
"各下载源的错误如下：" & vbCrLf & Detail, [Error])
'上报
@@ -1736,18 +1694,14 @@ Retry:
TaskFile.Interrupt(Me)
Next
'在退出同步锁后再进行日志输出
Dim ErrOutput As New List(Of String)
For Each Ex As Exception In ExList
ErrOutput.Add(Ex.GetDetail())
Next
Log("[Download] " & ErrOutput.Distinct.Join(vbCrLf))
Logger.Error(New AggregateException(ExList), "下载加载器失败", LogBehavior.None)
End Sub
Public Overrides Sub Interrupt()
SyncLock LockState
If State >= LoadState.Finished Then Return
State = LoadState.Interrupted
End SyncLock
Log("[Download] " & Name & " 已取消！")
Logger.Info($"{Name} 已取消！")
'中断所有文件
For Each TaskFile In Files
TaskFile.Interrupt(Me)
@@ -1823,7 +1777,7 @@ Retry:
If SpeedLast.Count >= 10 Then Limit = SpeedLast.Take(10).Average * 0.85 '取近 1 秒的平均速度的 85%
If Limit > NetTaskSpeedLimitLow Then
NetTaskSpeedLimitLow = Limit
Log("[Download] " & "速度下限已提升到 " & FormatFileSize(Limit))
Logger.Info($"速度下限已提升到 {FormatFileSize(Limit)}")
End If
#End Region
#Region "刷新下载任务属性"
@@ -1832,7 +1786,7 @@ Retry:
Next
#End Region
Catch ex As Exception
Log(ex, "刷新下载公开属性失败")
Logger.Warn(ex, "刷新下载公开属性失败")
End Try
End Sub
Private RefreshStatLast As Long
@@ -1889,7 +1843,7 @@ Retry:
Next
End While
Catch ex As Exception
Log(ex, $"下载管理启动线程 {Id} 出错", NotifyLevel.Critical)
Logger.Error(ex, $"下载管理启动线程 {Id} 出错", LogBehavior.AlertThenCrash)
End Try
End Sub
RunInNewThread(Sub() ThreadStarter(0), "NetManager ThreadStarter 0")
@@ -1913,7 +1867,7 @@ Retry:
End If
End While
Catch ex As Exception
Log(ex, "下载管理刷新线程出错", NotifyLevel.Critical)
Logger.Error(ex, "下载管理刷新线程出错", LogBehavior.AlertThenCrash)
End Try
End Sub, "NetManager StatRefresher")
End Sub
@@ -1929,11 +1883,11 @@ Retry:
SyncLock DownloadCacheLock '防止同时开启多个下载任务时重复清理
If Not IsDownloadCacheCleared Then
Try
Log("[Net] 开始清理下载缓存")
DeleteDirectory(PathTemp & "Download")
Log("[Net] 下载缓存已清理")
Logger.Info("开始清理下载缓存")
DirectoryUtils.Delete(PathTemp & "Download")
Logger.Info("下载缓存已清理")
Catch ex As Exception
Log(ex, "清理下载缓存失败")
Logger.Warn(ex, "清理下载缓存失败")
End Try
IsDownloadCacheCleared = True
End If
@@ -1945,12 +1899,12 @@ Retry:
Dim OngoingFile As NetFile = Nothing
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 对象
Task.Files(i) = File
Else
'常规情况（该文件可能已在其他任务中下载完成，但这并不影响）
If ModeDebug Then Log($"[Download] {File.LocalName}：开始，目标 {File.LocalPath}")
Logger.Trace(Function() $"{File.LocalName}：开始，目标 {File.LocalPath}")
AllFiles(File.LocalPath) = File
NewFiles.Add(File)
Interlocked.Increment(FileRemain)
@@ -2021,38 +1975,18 @@ Retry:
Try
PingResult = (New NetworkInformation.Ping).Send(Ip)
Catch ex As Exception
If MakeLog Then Log("[Net] Ping " & Ip & " 失败：" & ex.Message)
If MakeLog Then Logger.Info($"Ping {Ip} 失败：{ex.Message}")
Return -1
End Try
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
Else
If MakeLog Then Log("[Net] Ping " & Ip & " 失败")
If MakeLog Then Logger.Info($"Ping {Ip} 失败")
Return -1
End If
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>
''' 设置是否应当在正版登录时校验 SSL 证书。
''' </summary>
@@ -2062,7 +1996,7 @@ Retry:
Dim Request As HttpWebRequest = TryCast(Sender, HttpWebRequest)
If Failure = Net.Security.SslPolicyErrors.None Then Return True '已通过验证
'基于 #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
Return Not Enabled
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
End Sub
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 ""
End Function
End Class
@@ -94,7 +94,7 @@ Public Class ValidateHttp
End Sub '用于 XAML 初始化
Public Overrides Function Validate(Str As String) As String
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 ""
End Function
End Class
@@ -247,7 +247,7 @@ Public Class ValidateFolderName
Public Property Folder As String
Public Property UseMinecraftCharCheck 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()
End Sub
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.UseMinecraftCharCheck = UseMinecraftCharCheck
On Error Resume Next
PathIgnore = New DirectoryInfo(Folder).EnumerateDirectories
PathIgnore = DirectoryUtils.GetDirectories(Folder, True)
End Sub
Public Overrides Function Validate(Str As String) As String
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)
If InvalidStrCheck <> "" Then Return InvalidStrCheck
'检查 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)
If PathIgnore IsNot Nothing Then
For Each Folder As DirectoryInfo In PathIgnore
Arr.Add(Folder.Name)
For Each FolderPath In PathIgnore
Arr.Add(PathUtils.GetLastPart(FolderPath))
Next
End If
Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名！", IgnoreCase).Validate(Str)
If Not SameNameCheck = "" Then Return SameNameCheck
Return ""
Catch ex As Exception
Log(ex, "检查文件夹名出错")
Logger.Warn(ex, "检查文件夹名出错")
Return "错误：" & ex.Message
End Try
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)
If InvalidStrCheck <> "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名（#4505）
If RegexCheck(Str, ".{2,}~\d") Then Return "文件名不能包含这一特殊格式！"
If Str.RegexCheck(".{2,}~\d") Then Return "文件名不能包含这一特殊格式！"
'检查文件重名
If ParentFolder IsNot Nothing Then
Dim DirInfo As New DirectoryInfo(ParentFolder)
Dim DirInfo = DirectoryUtils.GetInfo(ParentFolder)
If DirInfo.Exists Then
Dim SameNameCheck = New ValidateExceptSame(DirInfo.EnumerateFiles("*").Select(Function(f) f.Name),
"不可与现有文件重名！", IgnoreCase).Validate(Str)
@@ -346,7 +346,7 @@ Public Class ValidateFileName
End If
Return ""
Catch ex As Exception
Log(ex, "检查文件名出错")
Logger.Warn(ex, "检查文件名出错")
Return "错误：" & ex.Message
End Try
End Function
@@ -375,9 +375,10 @@ Public Class ValidateFolderPath
If LengthCheck <> "" Then Return LengthCheck
'检查开头
If Str.StartsWithF("\\Mac\") Then GoTo Fin
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
If Str.Upper = Drive.Name Then Return ""
If Str.StartsWithF(Drive.Name, True) Then GoTo Fin
For Each Drive In Environment.GetLogicalDrives().Where(Function(p) DirectoryUtils.Exists(p))
Dim DriveName As String = Drive.Upper.First & ":\"
If Str.Upper = DriveName Then Return ""
If Str.StartsWithF(DriveName, True) Then GoTo Fin
Next
Return "文件夹路径头存在错误！"
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)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名（#4505）
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
If Str.RegexCheck(".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
Next
Return ""
End Function
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
+3 -3
View File
@@ -72,7 +72,7 @@ Public Class MyBitmap
End If
Else
'使用这种自己接管 FileStream 的方法加载才能解除文件占用
Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open, FileAccess.Read, FileShare.Read)
Using InputStream = FileUtils.ReadAsStream(FilePathOrResourceName)
'判断是否为 WebP 文件头
Dim Header(1) As Byte
InputStream.Read(Header, 0, 2)
@@ -97,7 +97,7 @@ Public Class MyBitmap
Throw New Exception($"加载 MyBitmap 意外失败（{FilePathOrResourceName}）", ex)
End If
Else
Log(ex, $"指定类型有误的 MyBitmap 加载（{FilePathOrResourceName}）", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"指定类型有误的 MyBitmap 加载（{FilePathOrResourceName}）")
Exit Try
End If
End Try
@@ -162,7 +162,7 @@ Public Class MyBitmap
Public Sub Save(FilePath As String)
Dim encoder As BitmapEncoder = New PngBitmapEncoder()
encoder.Frames.Add(BitmapFrame.Create(Me))
Using fileStream As New FileStream(FilePath, FileMode.Create)
Using fileStream = FileUtils.CreateAsStream(FilePath)
encoder.Save(fileStream)
End Using
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()
DirectoryUtils.Create(TempFolder & "Temp\")
DirectoryUtils.Create(TempFolder & "Report\")
Log("[Crash] 崩溃分析暂存文件夹：" & TempFolder)
Logger.Info($"崩溃分析暂存文件夹：{TempFolder}")
End Sub
'1：准备用于分析的 Log 文件
@@ -19,35 +19,30 @@
''' </summary>
''' <param name="LatestLog">从 PCL 捕获到的最后 200 行程序输出。</param>
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)
Try
Dim DirInfo As New DirectoryInfo(VersionPathIndie & "crash-reports\")
If DirInfo.Exists Then
For Each File In DirInfo.EnumerateFiles
PossibleLogs.Add(File.FullName)
Next
End If
PossibleLogs.AddRange(DirectoryUtils.GetFiles(VersionPathIndie & "crash-reports\"))
Catch ex As Exception
Log(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败")
Logger.Warn(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败")
End 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
PossibleLogs.Add(File.FullName)
PossibleLogs.Add(PathUtils.RemoveExtendedPrefix(File.FullName))
Next
Catch ex As Exception
Log(ex, "收集 Minecraft 主文件夹下的日志失败")
Logger.Warn(ex, "收集 Minecraft 主文件夹下的日志失败")
End 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
PossibleLogs.Add(File.FullName)
PossibleLogs.Add(PathUtils.RemoveExtendedPrefix(File.FullName))
Next
Catch ex As Exception
Log(ex, "收集 Minecraft 隔离文件夹下的日志失败")
Logger.Warn(ex, "收集 Minecraft 隔离文件夹下的日志失败")
End Try
PossibleLogs.Add(VersionPathIndie & "logs\latest.log") 'Minecraft 日志
PossibleLogs.Add(VersionPathIndie & "logs\debug.log") 'Minecraft Debug 日志
@@ -57,74 +52,75 @@
Dim RightLogs As New List(Of String)
For Each LogFile In PossibleLogs
Try
Dim Info As New FileInfo(LogFile)
Dim Info = FileUtils.GetInfo(LogFile)
If Not Info.Exists Then Continue For
Dim Time = Math.Abs((Info.LastWriteTime - Date.Now).TotalMinutes)
If Time < 3 AndAlso Info.Length > 0 Then
RightLogs.Add(LogFile)
Log("[Crash] 可能可用的日志文件：" & LogFile & "（" & Math.Round(Time, 1) & " 分钟）")
Logger.Info($"可能可用的日志文件：{LogFile}（{Math.Round(Time, 1)} 分钟）")
End If
Catch ex As Exception
Log(ex, "确认崩溃日志时间失败（" & LogFile & "）")
Logger.Warn(ex, $"确认崩溃日志时间失败（{LogFile}）")
End Try
Next
If Not RightLogs.Any() Then Log("[Crash] 未发现可能可用的日志文件")
If Not RightLogs.Any() Then Logger.Info("未发现可能可用的日志文件")
'将可能可用的日志文件导出
For Each FilePath In RightLogs
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
Log(ex, "读取可能的崩溃日志文件失败（" & FilePath & "）")
Logger.Warn(ex, $"读取可能的崩溃日志文件失败（{FilePath}）")
End Try
Next
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
Dim RawOutput As String = LatestLog.Join(vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容：" & vbCrLf & RawOutput)
Logger.Info($"以下为游戏输出的最后一段内容：{vbCrLf}{RawOutput}")
FileUtils.Write(TempFolder & "RawOutput.log", RawOutput)
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray))
LatestLog.Clear()
End If
Log("[Crash] 步骤 1：收集日志文件完成，收集到 " & AnalyzeRawFiles.Count & " 个文件")
Logger.Info($"步骤 1：收集日志文件完成，收集到 {AnalyzeRawFiles.Count} 个文件")
End Sub
''' <summary>
''' 从文件路径直接导入日志文件或崩溃报告压缩包。
''' </summary>
Public Sub Import(FilePath As String)
Log("[Crash] 步骤 1：自主导入日志文件")
Logger.Info("步骤 1：自主导入日志文件")
'尝试视作压缩包解压
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
ExtractCompressedFile(FilePath, TempFolder & "Temp\")
Log("[Crash] 已解压导入的日志文件：" & FilePath)
FileUtils.ExtractToDirectory(FilePath, TempFolder & "Temp\")
Logger.Info($"已解压导入的日志文件：{FilePath}")
GoTo Extracted
End If
Catch
End Try
'并非压缩包
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
Log("[Crash] 已复制导入的日志文件：" & FilePath)
FileUtils.Copy(FilePath, TempFolder & "Temp\" & PathUtils.GetLastPart(FilePath))
Logger.Info($"已复制导入的日志文件：{FilePath}")
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
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.Lower
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
File.Delete(TargetFile.FullName)
FileUtils.Delete(TargetFile.FullName)
End If
Catch ex As Exception
Log(ex, "导入单个日志文件失败")
Logger.Warn(ex, "导入单个日志文件失败")
End Try
Next
Log("[Crash] 步骤 1：自主导入日志文件，收集到 " & AnalyzeRawFiles.Count & " 个文件")
Logger.Info($"步骤 1：自主导入日志文件，收集到 {AnalyzeRawFiles.Count} 个文件")
End Sub
'2：确认实际用于分析的 Log 文本
@@ -141,25 +137,25 @@ Extracted:
''' 返回是否有足够信息可用于分析。
''' </summary>
Public Function Prepare() As Boolean
Log("[Crash] 步骤 2：准备日志文本")
Logger.Info("步骤 2：准备日志文本")
'对日志文件进行分类
DirectFile = Nothing
Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
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
If MatchName.StartsWithF("hs_err") Then
TargetType = AnalyzeFileType.HsErr
DirectFile = LogFile
If DirectFile Is Nothing Then DirectFile = LogFile
ElseIf MatchName.StartsWithF("crash-") Then
TargetType = AnalyzeFileType.CrashReport
DirectFile = LogFile
If DirectFile Is Nothing Then DirectFile = LogFile
ElseIf MatchName = "latest.log" OrElse MatchName = "latest log.txt" OrElse
MatchName = "debug.log" OrElse MatchName = "debug log.txt" OrElse
MatchName = "游戏崩溃前的输出.txt" OrElse MatchName = "rawoutput.log" Then
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
If LogFile.Value.Any(Function(s) s.Contains("以下为游戏输出的最后一段内容")) Then
TargetType = AnalyzeFileType.MinecraftLog
@@ -172,20 +168,20 @@ Extracted:
ElseIf MatchName.EndsWithF(".txt", True) Then
TargetType = AnalyzeFileType.ExtraReportFile
Else
Log("[Crash] " & MatchName & " 分类为 Ignore")
Logger.Info($"{MatchName} 分类为 Ignore")
Continue For
End If
If LogFile.Value.Any Then
AllFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
Log("[Crash] " & MatchName & " 分类为 " & GetStringFromEnum(TargetType))
Logger.Info($"{MatchName} 分类为 {TargetType}")
Else
Log("[Crash] " & MatchName & " 由于内容为空跳过")
Logger.Info($"{MatchName} 由于内容为空跳过")
End If
Next
'若只有额外日志，则将它们视作 Minecraft 日志
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
End If
@@ -205,9 +201,9 @@ Extracted:
Dim DatedFiles As New SortedList(Of Date, KeyValuePair(Of String, String()))()
For Each File In SelectedFiles
Try
DatedFiles.Add(New FileInfo(File.Key).LastWriteTime, File)
DatedFiles.Add(FileUtils.GetInfo(File.Key).LastWriteTime, File)
Catch ex As Exception
Log(ex, "获取日志文件修改时间失败")
Logger.Warn(ex, "获取日志文件修改时间失败")
DatedFiles.Add(New Date(1900, 1, 1), File)
End Try
Next
@@ -216,12 +212,12 @@ Extracted:
OutputFiles.Add(NewestFile.Key)
If SelectType = AnalyzeFileType.HsErr Then
LogHs = GetHeadTailLines(NewestFile.Value, 200, 100)
Log("[Crash] 输出报告：" & NewestFile.Key & "，作为虚拟机错误信息")
Log("[Crash] 导入分析：" & NewestFile.Key & "，作为虚拟机错误信息")
Logger.Info($"输出报告：{NewestFile.Key}，作为虚拟机错误信息")
Logger.Info($"导入分析：{NewestFile.Key}，作为虚拟机错误信息")
Else
LogCrash = GetHeadTailLines(NewestFile.Value, 300, 700)
Log("[Crash] 输出报告：" & NewestFile.Key & "，作为 Minecraft 崩溃报告")
Log("[Crash] 导入分析：" & NewestFile.Key & "，作为 Minecraft 崩溃报告")
Logger.Info($"输出报告：{NewestFile.Key}，作为 Minecraft 崩溃报告")
Logger.Info($"导入分析：{NewestFile.Key}，作为 Minecraft 崩溃报告")
End If
Case AnalyzeFileType.MinecraftLog
LogMc = ""
@@ -229,9 +225,9 @@ Extracted:
'创建文件名词典
Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String()))
For Each SelectedFile In SelectedFiles
FileNameDict(GetFileNameFromPath(SelectedFile.Key).Lower) = SelectedFile
FileNameDict(PathUtils.GetLastPart(SelectedFile.Key).Lower) = SelectedFile
OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告：" & SelectedFile.Key & "，作为 Minecraft 或启动器日志")
Logger.Info($"输出报告：{SelectedFile.Key}，作为 Minecraft 或启动器日志")
Next
'选择一份最佳的来自启动器的游戏日志
For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt", "PCL 启动器日志.txt"}
@@ -244,13 +240,13 @@ Extracted:
LogMc += Line & vbLf
ElseIf Line.Contains("以下为游戏输出的最后一段内容") Then
HasLauncherMark = True
Log("[Crash] 找到 PCL 输出的游戏实时日志头")
Logger.Info("找到 PCL 输出的游戏实时日志头")
End If
Next
'导入后 500 行
If Not HasLauncherMark Then LogMc += GetHeadTailLines(CurrentLog.Value, 0, 500)
LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为启动器日志")
Logger.Info($"导入分析：{CurrentLog.Key}，作为启动器日志")
Exit For
Next
'选择一份最佳的 Minecraft Log
@@ -258,7 +254,7 @@ Extracted:
If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName)
LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为 Minecraft 日志")
Logger.Info($"导入分析：{CurrentLog.Key}，作为 Minecraft 日志")
Exit For
Next
'查找 Debug Log
@@ -266,7 +262,7 @@ Extracted:
If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName)
LogMcDebug += GetHeadTailLines(CurrentLog.Value, 1000, 0)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为 Minecraft Debug 日志")
Logger.Info($"导入分析：{CurrentLog.Key}，作为 Minecraft Debug 日志")
Exit For
Next
'兜底
@@ -276,7 +272,7 @@ Extracted:
ElseIf FileNameDict.Any() Then '如果都没有找到，则使用第一个文件
Dim CurrentLog = FileNameDict.First.Value
LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500)
Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为兜底日志")
Logger.Info($"导入分析：{CurrentLog.Key}，作为兜底日志")
Else
LogMc = Nothing
Throw New Exception("无法找到匹配的 Minecraft Log")
@@ -287,21 +283,22 @@ Extracted:
'全部丢过去
For Each SelectedFile In SelectedFiles
OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告：" & SelectedFile.Key & "，不用作分析")
Logger.Info($"输出报告：{SelectedFile.Key}，不用作分析")
Next
End Select
Catch ex As Exception
Log(ex, "分类处理日志文件时出错")
Logger.Warn(ex, "分类处理日志文件时出错")
End Try
Next
'结束
Prepare = LogMc IsNot Nothing OrElse LogHs IsNot Nothing OrElse LogCrash IsNot Nothing
If Prepare Then
Log(("[Crash] 步骤 2：准备日志文本完成，找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogMcDebug Is Nothing, "", "游戏 Debug 日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、") & "用作分析")
Dim Result = LogMc IsNot Nothing OrElse LogHs IsNot Nothing OrElse LogCrash IsNot Nothing
If Result Then
Logger.Info($"{("[Crash] 步骤 2：准备日志文本完成，找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogMcDebug Is Nothing, "", "游戏 Debug 日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、")}用作分析")
Else
Log("[Crash] 步骤 2：准备日志文本完成，没有任何可供分析的日志")
Logger.Info("步骤 2：准备日志文本完成，没有任何可供分析的日志")
End If
Return Result
End Function
''' <summary>
''' 输出字符串的前后某些行，并统一行尾为 vbLf (正则 \n)、删除空行和重复行。
@@ -392,7 +389,7 @@ Extracted:
''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。
''' </summary>
Public Sub Analyze()
Log("[Crash] 步骤 3：分析崩溃原因")
Logger.Info("步骤 3：分析崩溃原因")
LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "")
'1. 精准日志匹配，中/高优先级
@@ -406,21 +403,21 @@ Extracted:
Dim Keywords As New List(Of String)
'崩溃日志
If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析")
Logger.Info("开始进行崩溃日志堆栈分析")
Keywords.AddRange(AnalyzeStackKeyword(LogCrash.BeforeFirst("System Details")))
End If
'Minecraft 日志
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"))
Log("[Crash] 开始进行 Minecraft 日志堆栈分析，发现 " & Fatals.Count & " 个报错项")
Logger.Info($"开始进行 Minecraft 日志堆栈分析，发现 {Fatals.Count} 个报错项")
For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next
End If
'虚拟机日志
If LogHs IsNot Nothing Then
Log("[Crash] 开始进行虚拟机堆栈分析")
Logger.Info("开始进行虚拟机堆栈分析")
Dim StackLogs As String = LogHs.Between("T H R E A D", "Registers:")
Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
End If
@@ -435,7 +432,7 @@ Extracted:
GoTo Done
End If
Else
Log("[Crash] 可能并未安装 Mod，不进行堆栈分析")
Logger.Info("可能并未安装 Mod，不进行堆栈分析")
End If
'3. 精准日志匹配，低优先级
@@ -444,27 +441,27 @@ Extracted:
'输出到日志
Done:
If Not CrashReasons.Any() Then
Log("[Crash] 步骤 3：分析崩溃原因完成，未找到可能的原因")
Logger.Info("步骤 3：分析崩溃原因完成，未找到可能的原因")
Else
Log("[Crash] 步骤 3：分析崩溃原因完成，找到 " & CrashReasons.Count & " 条可能的原因")
Logger.Info($"步骤 3：分析崩溃原因完成，找到 {CrashReasons.Count} 条可能的原因")
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
End If
End Sub
''' <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 Additional IsNot Nothing Then
CrashReasons(Reason).AddRange(Additional)
CrashReasons(Reason) = CrashReasons(Reason).Distinct.ToList
End If
Else
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {}).ToList))
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
Private Sub AppendReason(Reason As CrashReason, Additional As String)
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.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
'游戏日志分析
@@ -495,7 +492,6 @@ Done:
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: 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: '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不兼容)
@@ -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.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("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("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版本不兼容)
@@ -536,18 +532,18 @@ Done:
End If
End If
'确定的 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 重复 / 前置问题
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\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 duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=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("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重复安装, If(LogMc.RegexSeek("Found a duplicate mod[^\n]+"), "").RegexSearch("[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
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重复安装, If(LogMc.RegexSeek("ModResolutionException: Duplicate[^\n]+"), "").RegexSearch("[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
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
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
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())
End If
End If
@@ -569,19 +565,19 @@ Done:
If LogCrash.Contains("java.lang.OutOfMemoryError") 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("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 导致的崩溃
If LogCrash.Contains("-- MOD ") Then
Dim LogCrashMod As String = LogCrash.Between("-- MOD ", "Failure message:")
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
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
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("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=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("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(LogCrash.RegexSeek("(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
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 Sub
@@ -600,14 +596,14 @@ Done:
LogText.Contains("mixin.injection.throwables.") OrElse LogText.Contains(".json] FAILED during )")
If Not IsMixin Then Return False
'Mod 名称匹配
Dim ModName As String = RegexSeek(LogText, "(?<=from mod )[^.\/ ]+(?=\] from)")
If ModName Is Nothing Then ModName = RegexSeek(LogText, "(?<=for mod )[^.\/ ]+(?= failed)")
Dim ModName As String = LogText.RegexSeek("(?<=from mod )[^.\/ ]+(?=\] from)")
If ModName Is Nothing Then ModName = LogText.RegexSeek("(?<=for mod )[^.\/ ]+(?= failed)")
If ModName IsNot Nothing Then
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(ModName.TrimEnd((vbCrLf & " ").ToCharArray)))
Return True
End If
'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失败,
TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
Return True
@@ -622,12 +618,12 @@ Done:
'Mixin 崩溃
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("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, 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("确定了一种可能的解决方法，这样做可能会解决你的问题：") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法，这样做可能会解决你的问题：\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
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报错并给出解决方案, 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报错并给出解决方案, 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报错并给出解决方案, 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 加载失败
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
@@ -639,7 +635,7 @@ Done:
If LogCrash.Contains("Suspected Mod") Then
Dim SuspectsRaw As String = LogCrash.Between("Suspected Mod", "Stacktrace")
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))
End If
End If
@@ -660,14 +656,14 @@ Done:
'Mod 解析错误（常见于 Fabric 前置校验失败）
If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.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! 不一定是崩溃原因，它可能是单纯的警报
End If
'崩溃报告分析
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 & "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 & "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(LogCrash.RegexSeek("(?<=\tEntity Type: )[^\n]+(?= \()"), "") & " (" & If(LogCrash.RegexSeek("(?<=\tEntity's Exact location: )[^\n]+"), "").TrimEnd(vbCrLf.ToCharArray) & ")")
End If
End Sub
@@ -679,8 +675,8 @@ Done:
'进行正则匹配
Dim StackSearchResults As New List(Of String)
StackSearchResults.AddRange(RegexSearch(ErrorStack, "(?<=\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("(?<=\n[^{]+)[a-zA-Z_]+\w+\.[a-zA-Z_]+[\w\.]+(?=\.[\w\.$]+\.)"))
StackSearchResults.AddRange(ErrorStack.RegexSearch("(?<=at [^(]+?\.\w+\$\w+\$)[\w\$]+?(?=\$\w+\()").Select(Function(s) s.Replace("$", "."))) 'Mixin 堆栈：xxx.xxx.xxxx$xxxx$xxx
StackSearchResults = StackSearchResults.Distinct.ToList
'检查堆栈开头
@@ -698,10 +694,10 @@ Done:
NextStack:
Next
PossibleStacks = PossibleStacks.Distinct.ToList
Log("[Crash] 找到 " & PossibleStacks.Count & " 条可能的堆栈信息")
Logger.Info($"找到 {PossibleStacks.Count} 条可能的堆栈信息")
If Not PossibleStacks.Any() Then Return New List(Of String)
For Each Stack As String In PossibleStacks
Log("[Crash] - " & Stack)
Logger.Info($"- {Stack}")
Next
'检查堆栈关键词
@@ -724,10 +720,10 @@ NextStack:
Next
Next
PossibleWords = PossibleWords.Distinct.ToList
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
If PossibleWords.Any Then Log("[Crash] - " & PossibleWords.Join(", "))
Logger.Info($"从堆栈信息中找到 {PossibleWords.Count} 个可能的 Mod ID 关键词")
If PossibleWords.Any Then Logger.Info($"- {PossibleWords.Join(", ")}")
If PossibleWords.Count > 10 Then
Log("[Crash] 关键词过多，考虑匹配出错，不纳入考虑")
Logger.Info("关键词过多，考虑匹配出错，不纳入考虑")
Return New List(Of String)
Else
Return PossibleWords
@@ -738,7 +734,7 @@ NextStack:
''' 根据 Mod 关键词尝试获取实际的 Mod 名称。
''' 若失败则返回 Nothing。
''' </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)
'预处理关键词（分割括号）
@@ -756,7 +752,7 @@ NextStack:
Dim IsFabricDetail As Boolean = Details.Contains("Fabric Mods") '是否为 Fabric 信息格式
If IsFabricDetail Then
Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式")
Logger.Info("崩溃报告中检测到 Fabric Mod 信息格式")
End If
Details = Details.AfterLast("¨")
@@ -765,9 +761,9 @@ NextStack:
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
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
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
Logger.Info($"崩溃报告中找到 {ModNameLines.Count} 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String)
@@ -781,18 +777,18 @@ NextStack:
Next
Next
HintLines = HintLines.Distinct.ToList
Log("[Crash] 崩溃报告中找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
Logger.Info($"崩溃报告中找到 {HintLines.Count} 个可能的崩溃 Mod 匹配行")
For Each ModLine As String In HintLines
Log("[Crash] - " & ModLine)
Logger.Info($"- {ModLine}")
Next
'从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines
Dim Name As String
If IsFabricDetail Then
Name = RegexSeek(Line, "(?<=: )[^\n]+(?= [^\n]+)")
Name = Line.RegexSeek("(?<=: )[^\n]+(?= [^\n]+)")
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
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
@@ -803,8 +799,8 @@ NextStack:
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}
Dim ModNameLines As List(Of String) = RegexSearch(LogMcDebug, "(?<=valid mod file ).*", RegularExpressions.RegexOptions.Multiline)
Log("[Crash] Debug 信息中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
Dim ModNameLines = LogMcDebug.RegexSearch("(?<=valid mod file ).*", RegularExpressions.RegexOptions.Multiline)
Logger.Info($"Debug 信息中找到 {ModNameLines.Count} 个可能的 Mod 项目行")
'获取 Mod ID 与关键词的匹配行
Dim HintLines As New List(Of String)
@@ -814,15 +810,15 @@ NextStack:
Next
Next
HintLines = HintLines.Distinct.ToList
Log("[Crash] Debug 信息中找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行")
Logger.Info($"Debug 信息中找到 {HintLines.Count} 个可能的崩溃 Mod 匹配行")
For Each ModLine As String In HintLines
Log("[Crash] - " & ModLine)
Logger.Info($"- {ModLine}")
Next
'从 Mod 匹配行中提取 .jar 文件的名称
For Each Line As String In HintLines
Dim Name As String
Name = RegexSeek(Line, ".*(?= with)")
Name = Line.RegexSeek(".*(?= with)")
If Name IsNot Nothing Then ModFileNames.Add(Name)
Next
@@ -833,9 +829,9 @@ NextStack:
If Not ModFileNames.Any() Then
Return Nothing
Else
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
Logger.Info($"找到 {ModFileNames.Count} 个可能的崩溃 Mod 文件名")
For Each ModFileName As String In ModFileNames
Log("[Crash] - " & ModFileName)
Logger.Info($"- {ModFileName}")
Next
Return ModFileNames
End If
@@ -851,9 +847,9 @@ NextStack:
''' <summary>
''' 尝试从关键字获取 Mod 名称，若失败则返回原关键字。
''' </summary>
Private Function TryAnalyzeModName(Keywords As List(Of String)) As List(Of String)
If Not Keywords.Any Then Return Keywords
Return If(AnalyzeModName(Keywords), Keywords)
Private Function TryAnalyzeModName(Keywords As IEnumerable(Of String)) As List(Of String)
If Not Keywords.Any Then Return Keywords.ToList
Return If(AnalyzeModName(Keywords), Keywords.ToList)
End Function
'4：根据原因输出信息
@@ -866,11 +862,11 @@ NextStack:
FrmMain.ShowWindowToTop()
Dim Detail As String = GetAnalyzeResult(IsManualAnalyze)
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,
Sub()
'弹窗选择：查看日志
If File.Exists(DirectFile.Value.Key) Then
'弹窗选择：查看输出
If FileUtils.Exists(DirectFile.Value.Key) Then
StartProcess(DirectFile.Value.Key)
Else
Dim FilePath As String = PathTemp & "Crash.txt"
@@ -883,17 +879,16 @@ NextStack:
Dim FileAddress As String = Nothing
Try
'获取文件路径
RunInUiWait(Sub() FileAddress = SelectSaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
If String.IsNullOrEmpty(FileAddress) Then Return
If File.Exists(FileAddress) Then File.Delete(FileAddress)
DirectoryUtils.Create(FileAddress, isFilePath:=True)
RunInUiWait(Sub() FileAddress = Dialogs.SaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", filter:={("zip", "Minecraft 错误报告")}))
If FileAddress Is Nothing Then Return
FileUtils.Delete(FileAddress)
'输出诊断信息
FeedbackInfo()
LogFlush()
Logger.Instance.Flush()
'复制文件
If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles)
For Each OutputFile In OutputFiles
Dim FileName As String = GetFileNameFromPath(OutputFile)
Dim FileName As String = PathUtils.GetLastPart(OutputFile)
Dim FileEncoding As Encoding = Nothing
Select Case FileName
Case "LatestLaunch.bat"
@@ -905,23 +900,21 @@ NextStack:
FileName = "游戏崩溃前的输出.txt"
FileEncoding = Encoding.UTF8
End Select
If File.Exists(OutputFile) Then
If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
Dim FileContent As String = ReadFile(OutputFile, FileEncoding)
FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
FileUtils.Write(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
Log($"[Crash] 导出文件：{FileName}，编码：{FileEncoding.HeaderName}")
End If
If Not FileUtils.Exists(OutputFile) Then Continue For
Dim FileContent As String = FileUtils.ReadAsString(OutputFile, FileEncoding)
FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
FileUtils.Write(TempFolder & "Report\" & FileName, FileContent, FileEncoding)
Logger.Info($"导出错误报告文件：{FileName}")
Next
'导出报告
Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress)
DeleteDirectory(TempFolder & "Report\")
FileUtils.CreateZipFromDirectory(FileAddress, TempFolder & "Report\")
DirectoryUtils.Delete(TempFolder & "Report\")
Hint("错误报告已导出！", HintType.Green)
OpenExplorer(FileAddress)
Catch ex As Exception
Log(ex, "导出错误报告失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "导出错误报告失败")
Return
End Try
OpenExplorer(FileAddress)
End Select
'上报
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)
Loop
Catch ex As Exception
Log(ex, "获取底层继承版本失败")
Logger.Warn(ex, "获取底层继承版本失败")
End Try
'检查 Json 是否标准
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 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"), "")
If IndexUrl = "" Then
Return Nothing
@@ -65,7 +65,7 @@
#Region "下载资源文件"
If ShouldIgnoreFileCheck(Instance) Then
Log("[Download] 已跳过所有 Assets 检查")
Logger.Info("已跳过所有 Assets 检查")
Else
Dim LoadersAssets As New List(Of LoaderBase)
'获取资源文件索引地址
@@ -75,7 +75,7 @@
Dim IndexFile = DlClientAssetIndexGet(Instance)
If IndexFile Is Nothing Then
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
Task.Output = New List(Of NetFile)
Else
@@ -96,7 +96,7 @@
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
If BackAssetsFile Is Nothing Then
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", NotifyLevel.DebugModeOnly)
Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
Task.Interrupt()
Throw New ThreadInterruptedException
End If
@@ -105,19 +105,19 @@
BackAssetsFile.LocalPath = TempAddress
Task.Output = New List(Of NetFile) From {BackAssetsFile}
'检查是否需要更新：每天只更新一次
If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then
Log("[Download] 无需更新资源文件索引，取消")
If FileUtils.Exists(RealAddress) AndAlso Math.Abs((FileUtils.GetInfo(RealAddress).LastWriteTime.Date - Now.Date).TotalDays) < 1 Then
Logger.Info("无需更新资源文件索引，取消")
Task.Interrupt()
End If
End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
Sub(Task As LoaderTask(Of List(Of NetFile), String))
CopyFile(TempAddress, RealAddress)
FileUtils.Copy(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功：" & TempAddress)
End Sub))
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
Log("[Download] 开始后台检查资源文件索引")
Logger.Info("开始后台检查资源文件索引")
Updater.Start()
End If
'获取资源文件地址
@@ -158,8 +158,8 @@
Public Property AllDrops As List(Of Integer)
Get
If _AllDrops Is Nothing Then
_AllDrops = Settings.Get("CacheDrops").ToString.
Split(",".ToCharArray, StringSplitOptions.RemoveEmptyEntries).Select(Function(d) CInt(Val(d))).ToList()
_AllDrops = Settings.Get(Of String)("CacheDrops").ToString.
Split(",", True).Select(Function(d) CInt(Val(d))).ToList()
End If
Return If(_AllDrops.Any, _AllDrops, Nothing) '不要将 _AllDrops 再设为 Nothing，以防止反复获取设置尝试初始化
End Get
@@ -191,7 +191,7 @@
''' </summary>
Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
@@ -211,7 +211,9 @@
'提取所有 Drop 序数
Dim Drops As New List(Of Integer)
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
Drops.Add(Drop)
Next
@@ -233,10 +235,10 @@
If Not DlPreferMojang Then
Dim DeltaTime = GetTimeMs() - StartTime
DlPreferMojang = DeltaTime < 4000
Log($"[Download] Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
Logger.Info($"Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
End If
'添加 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}
'MC 更新提示
@@ -244,16 +246,16 @@
Dim Version As String
'快照版
Version = Json("latest")("snapshot")
If Settings.Get("ToolUpdateSnapshot") AndAlso Not Settings.Get("ToolUpdateSnapshotLast") = "" AndAlso
Settings.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
If Settings.Get(Of Boolean)("ToolUpdateSnapshot") AndAlso Not Settings.Get(Of String)("ToolUpdateSnapshotLast") = "" AndAlso
Settings.Get(Of String)("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json)
End If
Settings.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
'正式版
Version = Json("latest")("release")
If Settings.Get("ToolUpdateRelease") AndAlso Not Settings.Get("ToolUpdateReleaseLast") = "" AndAlso
Settings.Get("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
If Settings.Get(Of Boolean)("ToolUpdateRelease") AndAlso Not Settings.Get(Of String)("ToolUpdateReleaseLast") = "" AndAlso
Settings.Get(Of String)("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json)
End If
@@ -272,7 +274,7 @@
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
'添加 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）
If Not String.IsNullOrEmpty(Loader.Input) Then
Dim Id = Loader.Input
@@ -313,10 +315,10 @@
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then Return Version("url").ToString
Next
Log($"未发现版本 {Id} 的 json 下载地址，版本列表返回为：{vbCrLf}{DlClientListLoader.Output.Value.ToString}", NotifyLevel.DebugModeOnly)
Logger.Warn($"未发现版本 {Id} 的 json 下载地址，版本列表返回为：{vbCrLf}{DlClientListLoader.Output.Value}")
Return Nothing
Catch ex As Exception
Log(ex, $"获取版本 {Id} 的 json 下载地址失败")
Logger.Warn(ex, $"获取版本 {Id} 的 json 下载地址失败")
Return Nothing
End Try
End Function
@@ -385,7 +387,7 @@
''' </summary>
Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain)
Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30),
@@ -413,9 +415,9 @@
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）")
Try
'获取所有版本信息
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
Dim Forge As List(Of String) = Result.RegexSearch("(?<=colForge'>)[^<]*").ToList
Dim ReleaseTime As List(Of String) = Result.RegexSearch("(?<=colDate'>)[^<]+").ToList
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 Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）")
@@ -491,7 +493,7 @@
''' </summary>
Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain)
Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
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)
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 不会被匹配上
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）")
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)))
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)
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
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),
@@ -669,7 +671,7 @@
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4，#4057
".html", SimulateBrowserHeaders:=True)
Catch ex As Exception
If ex.GetBrief().Contains("(404)") Then
If ex.GetDisplay(False).Contains("(404)") Then
Throw New Exception("无")
Else
Throw
@@ -685,14 +687,14 @@
Dim VersionCode = VersionCodes(i)
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 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
'发布时间获取
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 ReleaseDate As New Date(ReleaseTimeSplit(0), ReleaseTimeSplit(1), ReleaseTimeSplit(2), '年月日
ReleaseTimeSplit(3), ReleaseTimeSplit(4), ReleaseTimeSplit(5), '时分秒
@@ -703,17 +705,17 @@
If VersionCode.Contains("classifier-installer""") Then
'类型为 installer.jar，支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部)
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("installer.jar"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
MD5 = VersionCode.RegexSeek("(?<=MD5:</strong> )[^<]+")
Category = "installer"
ElseIf VersionCode.Contains("classifier-universal""") Then
'类型为 universal.zip，支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分)
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("universal.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
MD5 = VersionCode.RegexSeek("(?<=MD5:</strong> )[^<]+")
Category = "universal"
ElseIf VersionCode.Contains("client.zip") Then
'类型为 client.zip，支持范围 182~ (1.3.2 部分 ~)
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("client.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
MD5 = VersionCode.RegexSeek("(?<=MD5:</strong> )[^<]+")
Category = "client"
Else
'没有任何下载（1.6.4 有一部分这种情况）
@@ -875,7 +877,7 @@
''' </summary>
Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain)
Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
@@ -931,7 +933,7 @@
End Sub
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+)?(?="")")
Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中，但不能下载
@@ -1000,7 +1002,7 @@
''' </summary>
Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain)
Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30),
@@ -1099,7 +1101,7 @@
''' </summary>
Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain)
Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Select Case Settings.Get("ToolDownloadVersion")
Select Case Settings.Get(Of Integer)("ToolDownloadVersion")
Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30),
@@ -1170,32 +1172,32 @@
''' </summary>
Public Function DlModRequest(Url As String, Optional Method As HttpMethod = Nothing,
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)
If McimUrl <> Url Then
Select Case Settings.Get("ToolDownloadMod")
Select Case Settings.Get(Of Integer)("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add((McimUrl, 10))
Urls.Add((McimUrl, 10))
Urls.Add((Url, 30))
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10))) '至少 20s，要不然 Modrinth 返回不过来
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add((Url, If(Url.Contains("modrinth"), 20, 10))) '至少 20s，要不然 Modrinth 返回不过来
Urls.Add((McimUrl, 10))
Urls.Add((Url, 30))
Urls.Add((McimUrl, 30))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10)))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add((Url, If(Url.Contains("modrinth"), 20, 10)))
Urls.Add((Url, 30))
Urls.Add((McimUrl, 30))
End Select
Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10)))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add((Url, If(Url.Contains("modrinth"), 20, 10)))
Urls.Add((Url, 30))
End If
Dim Exs As String = ""
For Each Source In Urls
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
Exs += ex.Message + vbCrLf
End Try
@@ -1213,7 +1215,7 @@
''' </summary>
Public ReadOnly Property DlSourcePreferMojang As Boolean
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 Property
''' <summary>
@@ -1227,7 +1229,7 @@
''' </summary>
Public ReadOnly Property DlVersionListPreferMojang As Boolean
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 Property
''' <summary>
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+79 -80
View File
@@ -79,8 +79,7 @@
''' 输入 javaw.exe 文件所在文件夹的路径，不限制结尾。
''' </summary>
Public Sub New(Folder As String, IsUserImport As Boolean)
If Not Folder.EndsWithF("\") Then Folder += "\"
PathFolder = Folder.Replace("/", "\")
PathFolder = PathUtils.AddSlashSuffix(PathUtils.ForCompare(Folder))
Me.IsUserImport = IsUserImport
End Sub
@@ -94,18 +93,18 @@
Dim Output As String = Nothing
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 File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
IsJre = Not File.Exists(PathFolder & "javac.exe")
If FileUtils.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
IsJre = Not FileUtils.Exists(PathFolder & "javac.exe")
'运行 -version
Output = StartProcessAndGetOutput(PathJava, "-version", 15000).Lower
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("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"
Do While VersionString.Split(".").Count < 4
If VersionString.StartsWithF("1.") Then
@@ -117,7 +116,7 @@
If VersionString = "" Then Throw New ApplicationException($"未找到该 Java 的版本号{If(Output.Length < 500, $"{vbCrLf}输出为：{vbCrLf}{Output}", "")}")
Version = New Version(VersionString)
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)
End If
Is64Bit = Output.Contains("64-bit")
@@ -129,7 +128,7 @@
Catch ex As ThreadInterruptedException
Throw ex
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)
End Try
IsChecked = True
@@ -165,25 +164,25 @@
Public Sub JavaListInit()
JavaList = New List(Of JavaEntry)
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)
Else
'使用缓存
For Each JsonEntry In GetJson(Settings.Get("LaunchArgumentJavaAll"))
For Each JsonEntry In GetJson(Settings.Get(Of String)("LaunchArgumentJavaAll"))
JavaList.Add(JavaEntry.FromJson(JsonEntry))
Next
End If
If Not JavaList.Any() Then
Log("[Java] 初始化未找到可用的 Java，将自动触发搜索", NotifyLevel.DevelopOnly)
Logger.Warn("初始化未找到可用的 Java，将自动触发搜索")
JavaSearchLoader.Start(0)
Else
Log("[Java] 缓存中有 " & JavaList.Count & " 个可用的 Java：")
JavaList.ForEach(Sub(j) Log($"[Java] - {j}"))
Logger.Info($"缓存中有 {JavaList.Count} 个可用的 Java：")
JavaList.ForEach(Sub(j) Logger.Info($"- {j}"))
End If
Catch ex As Exception
Log(ex, "初始化 Java 列表失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "初始化 Java 列表失败")
Settings.Set("LaunchArgumentJavaAll", "[]")
End Try
End Sub
@@ -205,7 +204,7 @@
'添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean)
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
JavaSearchFolder(McFolderSelected, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
@@ -219,9 +218,9 @@
'检查特定的 Java
If TargetJavaList.Any Then
TargetJavaList = JavaCheckList(TargetJavaList)
Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定路径下的 Java：")
Logger.Info($"检查后找到 {TargetJavaList.Count} 个特定路径下的 Java：")
For Each Java In TargetJavaList
Log($"[Java] - {Java}")
Logger.Info($"- {Java}")
Next
End If
@@ -232,7 +231,7 @@
'获取版本独立设置中指定的 Java
Dim VersionSelect As String = ""
If GameInstance IsNot Nothing Then
VersionSelect = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
VersionSelect = Settings.Get(Of String)("VersionArgumentJavaSelect", Instance:=GameInstance)
If VersionSelect.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
@@ -242,28 +241,28 @@
Catch ex As Exception
UserJava = Nothing
Settings.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Log(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", NotifyLevel.AllUsers)
Logger.Error(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", LogBehavior.Toast)
End Try
End If
End If
'获取全局设置中指定的 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
UserJava = JavaEntry.FromJson(GetJson(Settings.Get("LaunchArgumentJavaSelect")))
UserJava = JavaEntry.FromJson(GetJson(Settings.Get(Of String)("LaunchArgumentJavaSelect")))
UserJava.Check()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
UserJava = Nothing
Settings.Reset("LaunchArgumentJavaSelect")
Log(ex, "全局设置中指定的 Java 已无法使用，此设置已重置", NotifyLevel.AllUsers)
Logger.Error(ex, "全局设置中指定的 Java 已无法使用，此设置已重置", LogBehavior.Toast)
End Try
End If
'添加到特定 Java 列表
If UserJava IsNot Nothing Then
Log($"[Java] 用户指定的 Java：{UserJava}")
Logger.Info($"用户指定的 Java：{UserJava}")
TargetJavaList.Add(UserJava)
End If
@@ -294,7 +293,7 @@ RetryGet:
'若未找到适合的 Java，尝试触发搜索
If Not AllowedJavaList.Any() AndAlso JavaSearchLoader.State = LoadState.Waiting Then
Log("[Java] 未找到满足条件的 Java，尝试进行搜索")
Logger.Info("未找到满足条件的 Java，尝试进行搜索")
JavaSearchLoader.Start(IsForceRestart:=True)
GoTo RetryGet
End If
@@ -304,16 +303,16 @@ RetryGet:
'确保指定的 Java 可用
If UserJava Is Nothing Then GoTo ExitUserJavaCheck
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}
GoTo UserPass
End If
'指定的 Java 不可用，弹窗要求选择
Log("[Java] 发现用户指定的不兼容 Java：" & UserJava.ToString)
Log($"[Java] 目前实际可用的 Java 列表：")
Logger.Info($"发现用户指定的不兼容 Java：{UserJava}")
Logger.Info($"目前实际可用的 Java 列表：")
For Each Java In AllowedJavaList
Log($"[Java] - {Java}")
Logger.Info($"- {Java}")
Next
Dim Requirement As String = ""
Dim ShowRevision As Boolean = False
@@ -330,20 +329,20 @@ RetryGet:
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If
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}
Else
Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & "，但当前" & Requirement & "。" & vbCrLf &
"如果强制使用该 Java，可能导致游戏崩溃。" & vbCrLf &
"你也可以将 游戏 Java 设置修改为 自动选择合适的 Java。" & vbCrLf &
"你也可以将 游戏 Java 设置修改为 自动选择。" & vbCrLf &
vbCrLf &
" - 指定的 Java：" & UserJava.ToString,
"Java 兼容性警告", "让 PCL 自动选择", "强制使用该 Java", "取消")
Case 1 '让 PCL 自动选择
Case 2 '强制使用指定的 Java
Log("[Java] 已强制使用用户指定的不兼容 Java")
Logger.Info("已强制使用用户指定的不兼容 Java")
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
Case 3 '取消启动
Throw New Exception(CancelException)
@@ -364,7 +363,7 @@ ExitUserJavaCheck:
If TargetJavaList.Contains(Java) Then
'直接使用指定的 Java
AllowedJavaList = New List(Of JavaEntry) From {Java}
Log("[Java] 优先使用特定路径下的 Java：" & Java.ToString)
Logger.Info($"优先使用特定路径下的 Java：{Java}")
GoTo UserPass
End If
Next
@@ -372,9 +371,9 @@ UserPass:
'对适合的 Java 进行排序
AllowedJavaList = AllowedJavaList.SortByComparison(AddressOf JavaSorter)
Log($"[Java] 排序后的 Java 优先顺序：")
Logger.Info($"排序后的 Java 优先顺序：")
For Each Java In AllowedJavaList
Log($"[Java] - {Java}")
Logger.Info($"- {Java}")
Next
'检查选定的 Java，若测试失败则尝试进行搜索
@@ -384,23 +383,23 @@ UserPass:
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If ex.InnerException IsNot Nothing AndAlso TypeOf (ex.InnerException) Is ThreadInterruptedException Then Throw ex.InnerException
Log(ex, "最终选定的 Java 已无法使用，尝试进行搜索")
If ex.InnerException IsNot Nothing AndAlso TypeOf ex.InnerException Is ThreadInterruptedException Then Throw ex.InnerException
Logger.Warn(ex, "最终选定的 Java 已无法使用，尝试进行搜索")
AllowedJavaList = New List(Of JavaEntry)
JavaSearchLoader.Start(IsForceRestart:=True)
GoTo RetryGet
End Try
'返回
Log("[Java] 最终选定的 Java：" & AllowedJavaList.First.ToString)
Logger.Info($"最终选定的 Java：{AllowedJavaList.First}")
Return SelectedJava
Catch ex As ThreadInterruptedException
Log(ex, "查找符合条件的 Java 时出现加载器中断")
Logger.Warn(ex, "查找符合条件的 Java 时出现加载器中断")
Return Nothing
Catch ex As Exception
If ex.Message = "$$" Then Throw ex
Log(ex, "查找符合条件的 Java 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "查找符合条件的 Java 失败")
Return Nothing
End Try
End Function
@@ -410,9 +409,9 @@ UserPass:
Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean
Try
'检查强制指定
Dim UserSetup As String = Settings.Get("LaunchArgumentJavaSelect")
Dim UserSetup As String = Settings.Get(Of String)("LaunchArgumentJavaSelect")
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
End If
If UserSetup <> "" Then
@@ -420,7 +419,7 @@ UserPass:
Try
UserJava = JavaEntry.FromJson(GetJson(UserSetup))
Catch ex As Exception
Log(ex, "版本指定的 Java 信息已损坏，已重置版本设置中指定的 Java")
Logger.Warn(ex, "版本指定的 Java 信息已损坏，已重置版本设置中指定的 Java")
Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance)
GoTo NoUserJava
End Try
@@ -435,7 +434,7 @@ NoUserJava:
Next
Return False
Catch ex As Exception
Log(ex, "检查 Java 类别时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "检查 Java 类别时出错")
Settings.Set("LaunchArgumentJavaSelect", "")
Return True
End Try
@@ -444,12 +443,12 @@ NoUserJava:
''' 将 Java 按照适用性排序。
''' </summary>
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 文件夹
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName
If McFolderSelected <> "" Then MinecraftPathParent = If(PathMcInfo.Parent, PathMcInfo).FullName
Dim PathInfo = DirectoryUtils.GetInfo(PathExeFolder)
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 Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
If McFolderSelected <> "" Then
@@ -505,12 +504,12 @@ NoUserJava:
#Region "模糊查找可能可用的 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())
If PathInEnv = "" Then Continue For
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
'查找磁盘中的 Java
For Each Disk As DriveInfo In DriveInfo.GetDrives()
@@ -530,15 +529,15 @@ NoUserJava:
Dim JavaWithoutReparse As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList
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
If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then
Log("[Java] 位于 " & Folder & " 的 Java 包含符号链接")
Logger.Info($"位于 {Folder} 的 Java 包含符号链接")
Continue For
End If
Info = If(TypeOf Info Is FileInfo, CType(Info, FileInfo).Directory, CType(Info, DirectoryInfo).Parent)
Loop While Info IsNot Nothing
Log("[Java] 位于 " & Folder & " 的 Java 不含符号链接")
Logger.Info($"位于 {Folder} 的 Java 不含符号链接")
JavaWithoutReparse.Add(Pair.Key, Pair.Value)
Next
If JavaWithoutReparse.Any Then JavaPreList = JavaWithoutReparse
@@ -547,7 +546,7 @@ NoUserJava:
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
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
Log("[Java] 位于 " & Pair.Key & " 的 Java 位于特殊路径，不应优先使用")
Logger.Info($"位于 {Pair.Key} 的 Java 位于特殊路径，不应优先使用")
Else
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
End If
@@ -558,14 +557,14 @@ NoUserJava:
#Region "添加玩家手动导入的 Java"
Dim ImportedJava As String = Settings.Get("LaunchArgumentJavaAll")
Dim ImportedJava As String = Settings.Get(Of String)("LaunchArgumentJavaAll")
Try
For Each JavaJsonObject In GetJson(ImportedJava)
Dim Entry = JavaEntry.FromJson(JavaJsonObject)
If Entry.IsUserImport Then JavaPreList(Entry.PathFolder) = True
Next
Catch ex As Exception
Log(ex, "Java 列表已损坏", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "Java 列表已损坏")
Settings.Set("LaunchArgumentJavaAll", "[]")
End Try
@@ -587,11 +586,11 @@ NoUserJava:
JavaList = NewJavaList
Catch ex As Exception
Log(ex, "搜索 Java 时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "搜索 Java 时出错")
JavaList = New List(Of JavaEntry)
End Try
Log("[Java] Java 搜索完成，发现 " & JavaList.Count & " 个 Java")
Logger.Info($"Java 搜索完成，发现 {JavaList.Count} 个 Java")
If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.UpdateJavaComboBox())
If FrmInstanceSetup IsNot Nothing Then RunInUi(Sub() FrmInstanceSetup.RefreshJavaComboBox())
End Sub
@@ -600,8 +599,8 @@ NoUserJava:
''' 多线程检查列表中的所有 Java 项。
''' </summary>
Private Function JavaCheckList(JavaEntries As List(Of JavaEntry)) As List(Of JavaEntry)
Log("[Java] 开始确认列表 Java 状态，共 " & JavaEntries.Count & " 项")
JavaCheckList = New List(Of JavaEntry)
Logger.Info($"开始确认列表 Java 状态，共 {JavaEntries.Count} 项")
Dim Result = New List(Of JavaEntry)
Dim ListLock As New Object
'启动检查线程
@@ -611,16 +610,16 @@ NoUserJava:
Sub()
Try
Entry.Check()
If ModeDebug Then Log("[Java] - " & Entry.ToString)
Logger.Trace($"- {Entry}")
SyncLock ListLock
JavaCheckList.Add(Entry)
Result.Add(Entry)
End SyncLock
Catch ex As ThreadInterruptedException
Catch ex As Exception
If Entry.IsUserImport Then
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常，将被自动移除", NotifyLevel.AllUsers)
Logger.Error(ex, $"位于 {Entry.PathFolder} 的 Java 存在异常，将被自动移除", LogBehavior.Toast)
Else
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常")
Logger.Warn(ex, $"位于 {Entry.PathFolder} 的 Java 存在异常")
End If
End Try
End Sub)
@@ -634,6 +633,7 @@ Wait:
For Each CheckThread In CheckThreads
If CheckThread.IsAlive Then GoTo Wait
Next
Return Result
End Function
''' <summary>
''' 模糊搜索指定文件夹下的 Java，并只进行粗略的检查。这不会搜索全部路径。
@@ -642,12 +642,12 @@ Wait:
''' <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)
Try
Log("[Java] 开始" & If(IsFullSearch, "完全", "部分") & "遍历查找：" & OriginalPath)
JavaSearchFolder(New DirectoryInfo(OriginalPath), Results, Source, IsFullSearch)
Logger.Info($"开始{If(IsFullSearch, "完全", "部分")}遍历查找：{OriginalPath}")
JavaSearchFolder(DirectoryUtils.GetInfo(OriginalPath), Results, Source, IsFullSearch)
Catch ex As UnauthorizedAccessException
Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath)
Logger.Info($"遍历查找 Java 时遭遇无权限的文件夹：{OriginalPath}")
Catch ex As Exception
Log(ex, "遍历查找 Java 时出错（" & OriginalPath & "）")
Logger.Warn(ex, $"遍历查找 Java 时出错（{OriginalPath}）")
End Try
End Sub
''' <summary>
@@ -659,10 +659,9 @@ Wait:
Try
'确认目录存在
If Not OriginalPath.Exists Then Return
Dim Folder As String = OriginalPath.FullName.Replace("\\", "\")
If Not Folder.EndsWithF("\") Then Folder += "\"
Dim Folder As String = PathUtils.AddSlashSuffix(PathUtils.ForCompare(OriginalPath.FullName))
'若该目录有 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
Static Keywords As String() = {
@@ -674,16 +673,16 @@ Wait:
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages", "4297127d64ec6", "1.", "启动", "jbr"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
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
OriginalPath.Name.Lower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
JavaSearchFolder(FolderInfo, Results, Source)
End If
Next
Catch ex As UnauthorizedAccessException
Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath.FullName)
Logger.Trace(Function() $"遍历查找 Java 时遭遇无权限的文件夹（{OriginalPath.FullName}）：{ex.GetDisplay(False)}")
Catch ex As Exception
Log(ex, "遍历查找 Java 时出错（" & OriginalPath.FullName & "）")
Logger.Warn(ex, $"遍历查找 Java 时出错（{OriginalPath.FullName}）")
End Try
End Sub
@@ -704,8 +703,8 @@ Wait:
AddHandler JavaDownloadLoader.OnStateChangedThread,
Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState)
If (NewState = LoadState.Failed OrElse NewState = LoadState.Interrupted) AndAlso LastJavaBaseDir IsNot Nothing Then
Log($"[Java] 由于下载未完成，清理未下载完成的 Java 文件：{LastJavaBaseDir}", NotifyLevel.DebugModeOnly)
DeleteDirectory(LastJavaBaseDir)
Logger.Warn($"由于下载未完成，清理未下载完成的 Java 文件：{LastJavaBaseDir}")
DirectoryUtils.Delete(LastJavaBaseDir)
ElseIf NewState = LoadState.Finished Then
LastJavaBaseDir = Nothing
End If
@@ -715,7 +714,7 @@ Wait:
End Function
Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹，防止残留只下了一半但 -version 能跑的 Java
Private Sub JavaFileList(Loader As LoaderTask(Of String, List(Of NetFile)))
Log("[Java] 开始获取 Java 下载信息")
Logger.Info("开始获取 Java 下载信息")
Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder(
{"https://piston-meta.mojang.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))
Next
Loader.Output = Results
Log($"[Java] 需要下载 {Results.Count} 个文件，目标文件夹：{LastJavaBaseDir}")
Logger.Info($"需要下载 {Results.Count} 个文件，目标文件夹：{LastJavaBaseDir}")
End Sub
#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>
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
RunInThread(
Sub()
@@ -13,7 +13,7 @@
ModpackInstall(File)
Catch ex As CancelledException
Catch ex As Exception
Log(ex, "手动安装整合包失败", NotifyLevel.MsgBox)
Logger.Error(ex, "手动安装整合包失败", LogBehavior.Alert)
End Try
End Sub)
End Sub
@@ -23,7 +23,7 @@
''' </summary>
''' <exception cref="CancelledException" />
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 ArchiveBaseFolder As String = ""
Try
@@ -33,13 +33,13 @@
'获取整合包种类与关键 Json
Dim PackType As Integer = -1
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("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
If Archive.GetEntry("manifest.json") IsNot Nothing Then
Dim Json As JObject = GetJson(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
PackType = 0 : Exit Try 'CurseForge 整合包
Else
@@ -50,27 +50,27 @@
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
Dim FullNames As String() = Entry.FullName.Split("/")
ArchiveBaseFolder = FullNames(0) & "/"
Dim PathSplits As String() = Entry.FullName.Split("/")
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 FullNames(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 FullNames(1) = "manifest.json" Then
Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
If PathSplits(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断）
If PathSplits(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
If PathSplits(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If PathSplits(1) = "manifest.json" Then
Dim Json As JObject = GetJson(Entry.Open().ReadString(Encoding.UTF8))
If Json("addons") Is Nothing Then
PackType = 0 : Exit Try 'CurseForge 整合包
Else
PackType = 3 : ArchiveBaseFolder = "overrides/" : Exit Try 'MCBBS 整合包
End If
End If
If FullNames(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.json" Then PackType = 1 : Exit Try 'HMCL 整合包
If PathSplits(1) = "modpack.zip" OrElse PathSplits(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
Next
Catch ex As Exception
If ex.GetDetail(True).Contains("Error.WinIOError") Then
If ex.GetDisplay(True).Contains("Error.WinIOError") Then
Throw New Exception("打开整合包文件失败", ex)
ElseIf File.EndsWithF(".rar", True) Then
Throw New Exception("PCL 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", ex)
@@ -81,25 +81,25 @@
'执行对应的安装方法
Select Case PackType
Case 0
Log("[ModPack] 整合包种类：CurseForge")
Logger.Info("整合包种类：CurseForge")
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 1
Log("[ModPack] 整合包种类：HMCL")
Logger.Info("整合包种类：HMCL")
Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
Case 2
Log("[ModPack] 整合包种类：MMC")
Logger.Info("整合包种类：MMC")
Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
Case 3
Log("[ModPack] 整合包种类：MCBBS")
Logger.Info("整合包种类：MCBBS")
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, InstanceName)
Case 4
Log("[ModPack] 整合包种类：Modrinth")
Logger.Info("整合包种类：Modrinth")
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 9
Log("[ModPack] 整合包种类：带启动器的压缩包")
Logger.Info("整合包种类：带启动器的压缩包")
Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
Case Else
Log("[ModPack] 整合包种类：未能识别，假定为压缩包")
Logger.Info("整合包种类：未能识别，假定为压缩包")
Return InstallPackCompress(File, Archive)
End Select
Finally
@@ -111,13 +111,14 @@
'解压文件
Dim RetryCount As Integer = 1
Dim InitialProgress = Loader.Progress
Try
Retry:
Try
Loader.Progress = InitialProgress
DeleteDirectory(InstallTemp)
ExtractCompressedFile(FileAddress, InstallTemp, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * ProgressIncrement)
DirectoryUtils.Delete(InstallTemp)
Dim RawProgress As Double = Loader.Progress
FileUtils.ExtractToDirectory(FileAddress, InstallTemp, progressHandler:=Sub(Percentage) Loader.Progress = RawProgress + Percentage * ProgressIncrement)
Catch ex As Exception
Log(ex, "第 " & RetryCount & " 次解压尝试失败")
Logger.Warn(ex, $"第 {RetryCount} 次解压尝试失败")
'完全不知道为啥会出现文件正在被另一进程使用的问题，总之加个重试
If RetryCount < 5 Then
Thread.Sleep(RetryCount * 2000)
@@ -134,25 +135,24 @@ Retry:
''' 从整合包的 override 目录复制文件，同时设置 PCL 的配置文件与版本隔离。
''' 对路径末尾是否为 \ 没有要求。
''' </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 VersionFolder.EndsWithF("\") Then VersionFolder += "\"
'复制文件
If Directory.Exists(OverridesFolder) Then
Log($"[ModPack] 处理整合包覆写文件夹：{OverridesFolder} → {VersionFolder}")
CopyDirectory(OverridesFolder, VersionFolder, Sub(Delta) Loader.Progress += Delta * ProgressIncrement)
If DirectoryUtils.Exists(OverridesFolder) Then
Logger.Info($"处理整合包覆写文件夹：{OverridesFolder} → {VersionFolder}")
DirectoryUtils.Copy(OverridesFolder, VersionFolder)
Else
Log($"[ModPack] 整合包中没有覆写文件夹：{OverridesFolder}")
Loader.Progress += ProgressIncrement
Logger.Info($"整合包中没有覆写文件夹：{OverridesFolder}")
End If
'设置 ini
Dim OverridesIni As String = $"{OverridesFolder}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, "VersionArgumentIndieV2", True)
WriteIni(OverridesIni, "IsStar", False)
CopyFile(OverridesIni, VersionIni) '覆写已有的 ini
FileUtils.Copy(OverridesIni, VersionIni) '覆写已有的 ini
Else
WriteIni(VersionIni, "VersionArgumentIndie", 1) '开启版本隔离
WriteIni(VersionIni, "VersionArgumentIndieV2", True)
@@ -178,7 +178,7 @@ Retry:
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString)
Catch ex As Exception
Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
End Try
@@ -194,24 +194,23 @@ Retry:
End If
'获取 Mod API 版本信息
Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
Dim TargetVersion As New McVersion
TargetVersion.VanillaName = Json("minecraft")("version").ToString
For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.Lower
If Id.StartsWithF("forge-") Then
'Forge 指定
If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老，已不支持进行安装！")
Log("[ModPack] 整合包 Forge 版本：" & Id)
ForgeVersion = Id.Replace("forge-", "")
Logger.Info($"整合包 Forge 版本：{Id}")
TargetVersion.Forge = Id.Replace("forge-", "")
ElseIf Id.StartsWithF("neoforge-") Then
'NeoForge 指定
Log("[ModPack] 整合包 NeoForge 版本：" & Id)
NeoForgeVersion = Id.Replace("neoforge-", "")
Logger.Info($"整合包 NeoForge 版本：{Id}")
TargetVersion.NeoForge = Id.Replace("neoforge-", "")
ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定
Log("[ModPack] 整合包 Fabric 版本：" & Id)
FabricVersion = Id.Replace("fabric-", "")
Logger.Info($"整合包 Fabric 版本：{Id}")
TargetVersion.Fabric = Id.Replace("fabric-", "")
Else
'ElseIf Id.StartsWithF("quilt-") Then
NotifyIncompatibleLoader(Id)
@@ -227,10 +226,9 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
$"{McFolderSelected}versions\{InstanceName}",
Task, 0.4)
$"{McFolderSelected}versions\{InstanceName}", Task)
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
'获取 Mod 列表
Dim ModList As New List(Of Integer)
@@ -253,17 +251,17 @@ Retry:
'如果文件已被删除，则 API 会跳过那一项，导致返回的列表数量小于请求的数量。后面的都是对此的错误处理。
'获取缺失的 fileId 列表
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
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
Log("[Modpack] 缺失项：" & Missings.Join("、"))
Logger.Info($"缺失项：{Missings.Join("、")}")
'尝试获取对应的工程信息
Dim Projects As New List(Of ResourceProject)
Try
Projects = ResourceProject.FromProjectIds(Missings.Select(Function(e) e.ProjectId.ToString), ResourcePlatforms.CurseForge).ToList
Catch ex As Exception
Log(ex, "获取缺失的工程信息失败")
Logger.Warn(ex, "获取缺失的工程信息失败")
End Try
Dim MissingDesc As New List(Of String)
For Each Missing In Missings
@@ -312,7 +310,8 @@ Retry:
Dim File = ResourceVersion.FromPlatformJson(ModJson, Type)
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)
Next
Task.Output = FileList.Values.ToList
@@ -328,10 +327,10 @@ Retry:
Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("minecraft")("version").ToString,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
.MinecraftName = TargetVersion.VanillaName,
.ForgeVersion = TargetVersion.Forge,
.NeoForgeVersion = TargetVersion.NeoForge,
.FabricVersion = TargetVersion.Fabric
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
'构造总加载器
@@ -342,22 +341,22 @@ Retry:
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
If Logo IsNot Nothing AndAlso FileUtils.Exists(Logo) Then
FileUtils.Copy(Logo, VersionFolder & "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo：" & Logo)
Logger.Info($"已设置整合包 Logo：{Logo}")
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If File.Exists(Target) Then
Log("[ModPack] 删除原始整合包文件：" & Target)
File.Delete(Target)
If FileUtils.Exists(Target) Then
Logger.Info($"删除原始整合包文件：{Target}")
FileUtils.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件：" & FileAddress)
File.Delete(FileAddress)
If FileUtils.Exists(FileAddress) AndAlso PathUtils.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Logger.Info($"删除安装整合包文件：{FileAddress}")
FileUtils.Delete(FileAddress)
End If
End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -383,29 +382,26 @@ Retry:
'读取 Json 文件
Dim Json As JObject
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
Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
End Try
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息")
'获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing
Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
Dim TargetVersion As New McVersion
For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.Lower
Case "minecraft"
MinecraftVersion = Entry.Value.ToString
TargetVersion.VanillaName = Entry.Value.ToString
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
ForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Forge 版本：" & ForgeVersion)
TargetVersion.Forge = Entry.Value.ToString
Logger.Info($"整合包 Forge 版本：{TargetVersion.Forge}")
Case "neoforge", "neo-forge" 'eg. 20.6.98-beta
NeoForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 NeoForge 版本：" & NeoForgeVersion)
TargetVersion.NeoForge = Entry.Value.ToString
Logger.Info($"整合包 NeoForge 版本：{TargetVersion.NeoForge}")
Case "fabric-loader" 'eg. 0.14.14
FabricVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Fabric 版本：" & FabricVersion)
TargetVersion.Fabric = Entry.Value.ToString
Logger.Info($"整合包 Fabric 版本：{TargetVersion.Fabric}")
Case Else
'Case "quilt-loader" 'eg. 1.0.0
NotifyIncompatibleLoader(Entry.Name)
@@ -427,13 +423,11 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
McFolderSelected & "versions\" & InstanceName, Task)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "client-overrides",
McFolderSelected & "versions\" & InstanceName,
Task, 0.1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
McFolderSelected & "versions\" & InstanceName, Task)
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表
Dim FileList As New List(Of NetFile)
For Each File In If(Json("files"), {})
@@ -441,7 +435,7 @@ Retry:
If File("env") IsNot Nothing Then
Select Case File("env")("client").ToString
Case "optional"
If MyMsgBox("是否要下载可选文件 " & GetFileNameFromPath(File("path").ToString) & "？",
If MyMsgBox("是否要下载可选文件 " & PathUtils.GetLastPart(File("path").ToString) & "？",
"下载可选文件", "是", "否") = 2 Then
Continue For
End If
@@ -452,10 +446,12 @@ Retry:
'添加下载文件
Dim Urls = File("downloads").SelectMany(Function(t) ResourceVersion.ParseCurseForgeDownloadUrls(t.ToString)).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()
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！" & vbCrLf & "错误的文件：" & TargetPath, "文件路径校验失败", IsWarn:=True)
If Not Path.GetFullPath(TargetPath).StartsWithF(Path.GetFullPath($"{McFolderSelected}versions\{InstanceName}\")) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！{vbCrLf}目标：{Path.GetFullPath(TargetPath)}{vbCrLf}错误的文件：{TargetPath}", "文件路径校验失败", IsWarn:=True)
Throw New CancelledException
End If
FileList.Add(New NetFile(Urls, TargetPath,
@@ -469,10 +465,10 @@ Retry:
Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
.MinecraftName = TargetVersion.VanillaName,
.ForgeVersion = TargetVersion.Forge,
.NeoForgeVersion = TargetVersion.NeoForge,
.FabricVersion = TargetVersion.Fabric
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
'构造总加载器
@@ -483,22 +479,22 @@ Retry:
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
If Logo IsNot Nothing AndAlso FileUtils.Exists(Logo) Then
FileUtils.Copy(Logo, VersionFolder & "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo：" & Logo)
Logger.Info($"已设置整合包 Logo：{Logo}")
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If File.Exists(Target) Then
Log("[ModPack] 删除原始整合包文件：" & Target)
File.Delete(Target)
If FileUtils.Exists(Target) Then
Logger.Info($"删除原始整合包文件：{Target}")
FileUtils.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件：" & FileAddress)
File.Delete(FileAddress)
If FileUtils.Exists(FileAddress) AndAlso PathUtils.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Logger.Info($"删除安装整合包文件：{FileAddress}")
FileUtils.Delete(FileAddress)
End If
End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -523,7 +519,7 @@ Retry:
'读取 Json 文件
Dim Json As JObject
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
Throw New Exception("HMCL 整合包安装信息存在问题", ex)
End Try
@@ -541,9 +537,8 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "minecraft",
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
McFolderSelected & "versions\" & InstanceName, Task)
End Sub) With {.ProgressWeight = FileUtils.GetInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造游戏本体安装加载器
If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With {
@@ -577,13 +572,13 @@ Retry:
'读取 Json 文件
Dim PackJson As JObject, PackInstance As String
Try
PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8))
PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
PackJson = GetJson(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open().ReadString(Encoding.UTF8))
PackInstance = Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open().ReadString(Encoding.UTF8)
Catch ex As Exception
Throw New Exception("MMC 整合包安装信息存在问题", ex)
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")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
@@ -597,15 +592,14 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & ".minecraft",
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
McFolderSelected & "versions\" & InstanceName, Task)
'读取 MMC 设置文件（#2655）
Try
Dim MmcSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
If File.Exists(MmcSetupFile) Then
If FileUtils.Exists(MmcSetupFile) Then
'将其中的等号替换为冒号，以符合 ini 文件格式
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
Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
Next
@@ -620,42 +614,42 @@ Retry:
Replace("$INST_DIR\", "{verpath}").Replace("$INST_DIR", "{verpath}").
Replace("$INST_ID", "{name}").Replace("$INST_NAME", "{name}")
WriteIni(SetupFile, "VersionAdvanceRun", PreLaunchCommand)
Log("[ModPack] 迁移 MultiMC 版本独立设置：启动前执行命令：" & PreLaunchCommand)
Logger.Info($"迁移 MultiMC 版本独立设置：启动前执行命令：{PreLaunchCommand}")
End If
End If
If ReadIni(MmcSetupFile, "JoinServerOnLaunch", False) Then
Dim ServerAddress As String = ReadIni(MmcSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """")
WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
Log("[ModPack] 迁移 MultiMC 版本独立设置：自动进入服务器：" & ServerAddress)
Logger.Info($"迁移 MultiMC 版本独立设置：自动进入服务器：{ServerAddress}")
End If
If ReadIni(MmcSetupFile, "IgnoreJavaCompatibility", False) Then
WriteIni(SetupFile, "VersionAdvanceJava", True)
Log("[ModPack] 迁移 MultiMC 版本独立设置：忽略 Java 兼容性警告")
Logger.Info("迁移 MultiMC 版本独立设置：忽略 Java 兼容性警告")
End If
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, "Logo", "PCL\Logo.png")
CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png")
Log($"[ModPack] 迁移 MultiMC 版本独立设置：版本图标（{Logo}.png）")
FileUtils.Copy($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png")
Logger.Info($"迁移 MultiMC 版本独立设置：版本图标（{Logo}.png）")
End If
'JVM 参数
Dim JvmArgs As String = ReadIni(MmcSetupFile, "JvmArgs", "")
If JvmArgs <> "" Then
If ReadIni(MmcSetupFile, "OverrideJavaArgs", False) Then
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数（覆盖）：" & JvmArgs)
Logger.Info($"迁移 MultiMC 版本独立设置：JVM 参数（覆盖）：{JvmArgs}")
Else
JvmArgs += " " & Settings.Get("LaunchAdvanceJvm")
JvmArgs += " " & Settings.Get(Of String)("LaunchAdvanceJvm")
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置：JVM 参数（追加）：" & JvmArgs)
Logger.Info($"迁移 MultiMC 版本独立设置：JVM 参数（追加）：{JvmArgs}")
End If
End If
End If
Catch ex As Exception
Log(ex, $"读取 MMC 配置文件失败（{InstallTemp}{ArchiveBaseFolder}instance.cfg）")
Logger.Warn(ex, $"读取 MMC 配置文件失败（{InstallTemp}{ArchiveBaseFolder}instance.cfg）")
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 整合包未提供游戏版本信息，无法安装！")
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 Else
If UID.StartsWithF("org.lwjgl") Then '#8210
Log("[ModPack] 已跳过 LWJGL 项：" & UID)
Logger.Info($"已跳过 LWJGL 项：{UID}")
Else
NotifyIncompatibleLoader(UID)
End If
@@ -710,7 +704,7 @@ Retry:
Dim Json As JObject
Try
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
Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
End Try
@@ -731,15 +725,14 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
McFolderSelected & "versions\" & InstanceName, Task)
'JVM 参数
If Json("launchInfo") IsNot Nothing Then
Dim LaunchInfo As JObject = Json("launchInfo")
If LaunchInfo.ContainsKey("javaArgument") Then WriteIni(SetupFile, "VersionAdvanceJvm", String.Join(" ", LaunchInfo("javaArgument")))
If LaunchInfo.ContainsKey("launchArgument") Then WriteIni(SetupFile, "VersionAdvanceGame", String.Join(" ", LaunchInfo("launchArgument")))
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 整合包未提供游戏版本附加信息，无法安装！")
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)
'获取解压路径
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
If TargetFolder Is Nothing Then Throw New CancelledException
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
@@ -799,42 +792,42 @@ Retry:
Thread.Sleep(400) '避免文件争用
'查找解压后的 exe 文件
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)
Log($"[Modpack] 文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
Logger.Info($"文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
If Info.ProductName = "Plain Craft Launcher" Then
Launcher = ExeFile
Log($"[Modpack] 发现整合包附带的 PCL 启动器：{ExeFile}")
Logger.Info($"发现整合包附带的 PCL 启动器：{ExeFile}")
ElseIf (Info.ProductName.ContainsIgnoreCase("Launcher") OrElse Info.ProductName.Contains("启动")) AndAlso
Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then
If Launcher Is Nothing Then
Launcher = ExeFile
Log($"[Modpack] 发现整合包附带的疑似第三方启动器：{ExeFile}")
Logger.Info($"发现整合包附带的疑似第三方启动器：{ExeFile}")
End If
End If
Next
Task.Progress = 0.95
'尝试使用附带的启动器打开
If Launcher IsNot Nothing Then
Log("[Modpack] 找到压缩包中附带的启动器：" & Launcher)
Logger.Info($"找到压缩包中附带的启动器：{Launcher}")
If MyMsgBox($"整合包里似乎自带了启动器，是否换用它继续安装？{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "换用", "不换用") = 1 Then
StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出
Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序")
Logger.Info("为换用整合包中的启动器启动，强制结束程序")
FrmMain.EndProgram(False)
Return
End If
Else
Log("[Modpack] 未找到压缩包中附带的启动器")
Logger.Info("未找到压缩包中附带的启动器")
End If
'加入文件夹列表
Dim InstanceName As String = GetFolderNameFromPath(TargetFolder)
Dim InstanceName As String = PathUtils.GetLastPart(TargetFolder)
DirectoryUtils.Create(TargetFolder & ".minecraft\")
PageSelectLeft.AddFolder(
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
InstanceName, False)
'调用 modpack 文件进行安装
Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
Log("[Modpack] 调用 modpack 文件继续安装：" & ModpackFile)
Dim ModpackFile = DirectoryUtils.GetFiles(TargetFolder, "modpack.*").First
Logger.Info($"调用 modpack 文件继续安装：{ModpackFile}")
ModpackInstall(ModpackFile)
End Sub)
})
@@ -859,20 +852,20 @@ Retry:
Next
If Match Is Nothing Then Throw New Exception("文件结构不匹配，这可能不是 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)
Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
If TargetFolder Is Nothing Then Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Throw New CancelledException
If 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)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.95)
'加入文件夹列表
PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, PathUtils.GetLastPart(TargetFolder), False)
Thread.Sleep(400) '避免文件争用
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.InstanceSelect))
End Sub)
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+19 -18
View File
@@ -33,13 +33,13 @@
HasRunningMinecraft = False
FrmMain.BtnExtraShutdown.ShowRefresh()
'音乐播放
If Settings.Get("UiMusicStop") Then
RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置，在结束后开始音乐播放"))
ElseIf Settings.Get("UiMusicStart") Then
RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置，在结束后暂停音乐播放"))
If Settings.Get(Of Boolean)("UiMusicStop") Then
RunInUi(Sub() If MusicResume() Then Logger.Info("已根据设置，在结束后开始音乐播放"))
ElseIf Settings.Get(Of Boolean)("UiMusicStart") Then
RunInUi(Sub() If MusicPause() Then Logger.Info("已根据设置，在结束后暂停音乐播放"))
End If
'启动器可见性
Select Case Settings.Get("LaunchArgumentVisible")
Select Case Settings.Get(Of Integer)("LaunchArgumentVisible")
Case 2
'直接关闭
If TriggerLauncherShutdown Then
@@ -105,7 +105,7 @@
Loop
WatcherLog("Minecraft 日志监控已退出")
Catch ex As Exception
Log(ex, "Minecraft 日志监控主循环出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "Minecraft 日志监控主循环出错")
State = MinecraftState.Ended
End Try
End Sub, "Minecraft Watcher PID " & PID)
@@ -174,7 +174,7 @@
End If
End If
Catch ex As Exception
Log(ex, "输出 Minecraft 日志失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "输出 Minecraft 日志失败")
End Try
End Sub
Public LatestLog As New Queue(Of String)
@@ -186,6 +186,7 @@
'加入预存储
LatestLog.Enqueue(Text)
If LatestLog.Count >= 501 Then LatestLog.Dequeue()
Logger.Trace(Text)
'进度处理
If LogProgress < 1 Then
WatcherLog("日志 1/5：已出现日志输出")
@@ -265,7 +266,7 @@
MinecraftWindow = TryGetMinecraftWindow()
Catch ex As ComponentModel.Win32Exception
'拒绝访问（#1062）
Log(ex, "由于反作弊或安全软件拦截，PCL 无法操作游戏窗口", NotifyLevel.AllUsers)
Logger.Error(ex, "由于反作弊或安全软件拦截，PCL 无法操作游戏窗口", LogBehavior.Toast)
IsWindowFinished = True
End Try
If MinecraftWindow Is Nothing Then Return
@@ -277,7 +278,7 @@
WatcherLog($"Minecraft 窗口已加载：{MinecraftWindowName}（{MinecraftWindowHandle.ToInt64}）")
IsWindowFinished = True
'最大化
If Settings.Get("LaunchArgumentWindowType") = 4 Then
If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 4 Then
RunInNewThread(
Sub()
Try
@@ -287,7 +288,7 @@
ShowWindow(WindowHandle, 3)
WatcherLog($"已最大化 Minecraft 窗口：{MinecraftWindowHandle.ToInt64}")
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
Logger.Warn(ex, "最大化 Minecraft 窗口时出现错误")
End Try
End Sub, "MinecraftWindowMaximize")
End If
@@ -297,7 +298,7 @@
End If
IsWindowAppeared = True
Catch ex As Exception
Log(ex, "检查 Minecraft 窗口失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "检查 Minecraft 窗口失败")
End Try
End Sub
''' <summary>
@@ -305,10 +306,10 @@
''' Nothing 代表未找到。
''' </summary>
Private Function TryGetMinecraftWindow() As KeyValuePair(Of IntPtr, String)?
TryGetMinecraftWindow = Nothing
Dim Result = Nothing
EnumWindows(
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)
GetClassName(hwnd, str, str.Capacity)
@@ -327,13 +328,13 @@
Try
If Process.GetProcessById(ProcessId).StartTime < GameProcess.StartTime Then Return '需要是此后启动的进程
Catch ex As Exception
Log(ex, "枚举 Minecraft 窗口进程失败")
Logger.Warn(ex, "枚举 Minecraft 窗口进程失败")
Return
End Try
'返回
TryGetMinecraftWindow = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText)
Result = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText)
End Sub, 0)
Return TryGetMinecraftWindow
Return Result
End Function
Private Delegate Sub EnumWindowsSub(hwnd As IntPtr, lParam As Integer)
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
{Instance.PathVersion & Instance.Name & ".json", PathExeFolder & "PCL\Log1.txt", PathExeFolder & "PCL\LatestLaunch.bat"})
Catch ex As Exception
Log(ex, "崩溃分析失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "崩溃分析失败")
End Try
End Sub, "Crash Analyzer")
End Sub
@@ -376,7 +377,7 @@
If Not GameProcess.HasExited Then GameProcess.Kill()
WatcherLog("已强制结束 Minecraft 进程")
Catch ex As Exception
Log(ex, "强制结束 Minecraft 进程失败", NotifyLevel.AllUsers)
Logger.Error(ex, "强制结束 Minecraft 进程失败", LogBehavior.Toast)
End Try
End Sub
Plain Craft Launcher 2/Modules/ModEvent.vb
+16 -16
View File
@@ -175,7 +175,7 @@ Public Class CustomEvent
''' </summary>
Public Shared Sub Raise(Type As EventType, Arg As String)
If Type = EventType.None Then Return
Log($"[Control] 执行自定义事件：{Type}, {Arg}")
Logger.Info($"执行自定义事件：{Type}, {Arg}")
If Arg Is Nothing Then Arg = ""
Dim Args As String() = Arg.Split("|")
Try
@@ -196,7 +196,7 @@ Public Class CustomEvent
'确认实际路径
Dim ActualPaths = GetAbsoluteUrls(Args(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
Log($"[Control] 打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}")
Logger.Info($"打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}")
'执行
If Type = EventType.打开帮助 Then
PageOtherHelp.EnterHelpPage(Location)
@@ -210,7 +210,7 @@ Public Class CustomEvent
StartProcess(Info)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", NotifyLevel.MsgBox)
Logger.Error(ex, "执行打开类自定义事件失败", LogBehavior.Alert)
End Try
End Sub)
@@ -289,7 +289,7 @@ Public Class CustomEvent
Try
Select Case Args.Length
Case 1
PageOtherTest.StartCustomDownload(Args(0), GetFileNameFromPath(Args(0)))
PageOtherTest.StartCustomDownload(Args(0), PathUtils.GetLastPart(Args(0)))
Case 2
PageOtherTest.StartCustomDownload(Args(0), Args(1))
Case Else
@@ -328,7 +328,7 @@ Public Class CustomEvent
MyMsgBox("未知的事件类型：" & Type & vbCrLf & "请检查事件类型填写是否正确，或者 PCL 是否为最新版本。", "事件执行失败")
End Select
Catch ex As Exception
Log(ex, $"事件执行失败（{Type}, {Arg}）", NotifyLevel.MsgBox)
Logger.Error(ex, $"事件执行失败（{Type}, {Arg}）", LogBehavior.Alert)
End Try
End Sub
@@ -346,7 +346,7 @@ Public Class CustomEvent
'获取文件名
Dim RawFileName As String
Try
RawFileName = GetFileNameFromPath(RelativeUrl)
RawFileName = PathUtils.GetLastPart(RelativeUrl)
If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件")
Catch ex As Exception
Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件，并在同路径下包含相应 XAML 文件！" & vbCrLf &
@@ -356,7 +356,7 @@ Public Class CustomEvent
End Try
'下载文件
Dim LocalTemp As String = RequestTaskTempFolder() & RawFileName
Log("[Event] 转换网络资源：" & RelativeUrl & " -> " & LocalTemp)
Logger.Info($"转换网络资源：{RelativeUrl} -> {LocalTemp}")
Try
NetDownloadByClient(RelativeUrl, LocalTemp)
NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp.Replace(".json", ".xaml"))
@@ -377,25 +377,25 @@ Public Class CustomEvent
If RelativeUrl.Contains(":\") Then
'绝对路径
Location = RelativeUrl
Log("[Control] 自定义事件中由绝对路径" & Type & "：" & Location)
ElseIf File.Exists(PathExeFolder & "PCL\" & RelativeUrl) Then
Logger.Info($"自定义事件中由绝对路径{Type}：{Location}")
ElseIf FileUtils.Exists(PathExeFolder & "PCL\" & RelativeUrl) Then
'相对 PCL 文件夹的路径
Location = PathExeFolder & "PCL\" & RelativeUrl
Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & Type & "：" & Location)
ElseIf File.Exists(PathExeFolder & "PCL\Help\" & RelativeUrl) Then
Logger.Info($"自定义事件中由相对 PCL 文件夹的路径{Type}：{Location}")
ElseIf FileUtils.Exists(PathExeFolder & "PCL\Help\" & RelativeUrl) Then
'相对 PCL 本地帮助文件夹的路径
Location = PathExeFolder & "PCL\Help\" & RelativeUrl
WorkingDir = PathExeFolder & "PCL\Help\"
Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & Type & "：" & Location)
ElseIf Type = EventType.打开帮助 AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
Logger.Info($"自定义事件中由相对 PCL 本地帮助文件夹的路径{Type}：{Location}")
ElseIf Type = EventType.打开帮助 AndAlso FileUtils.Exists(PathTemp & "Help\" & RelativeUrl) Then
'相对 PCL 自带帮助文件夹的路径
Location = PathTemp & "Help\" & RelativeUrl
WorkingDir = PathTemp & "Help\"
Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & Type & "：" & Location)
Logger.Info($"自定义事件中由相对 PCL 自带帮助文件夹的路径{Type}：{Location}")
ElseIf Type = EventType.打开文件 OrElse Type = EventType.执行命令 Then
'直接使用原有路径启动程序
Location = RelativeUrl
Log("[Control] 自定义事件中直接" & Type & "：" & Location)
Logger.Info($"自定义事件中直接{Type}：{Location}")
Else
'打开帮助，但是格式不对劲
Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件：" & RelativeUrl, RelativeUrl)
@@ -408,7 +408,7 @@ Public Class CustomEvent
''' 弹出安全确认弹窗。返回是否继续执行。
''' </summary>
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 & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
Case 1
Return True
Plain Craft Launcher 2/Modules/ModMain.vb
+108 -59
View File
@@ -133,11 +133,11 @@ Public Module ModMain
End If
'结束处理
EndHint:
If CurrentHint.Log Then Log("[UI] 弹出提示：" & CurrentHint.Text)
If CurrentHint.Log Then Logger.Info($"弹出提示：{CurrentHint.Text}")
HintWaiting.RemoveAt(0)
Loop
Catch ex As Exception
Log(ex, "显示弹出提示失败", NotifyLevel.Silent)
Logger.Info(ex, "显示弹出提示失败")
End Try
End Sub
Private Sub HideAllHint()
@@ -256,7 +256,7 @@ EndHint:
MsgBox(Caption, MsgBoxStyle.OkOnly + If(IsWarn, MsgBoxStyle.Critical, MsgBoxStyle.Question), Title)
Converter.Result = 1
End If
Log("[Control] 主窗体加载完成前出现意料外的等待弹窗：" & Button1 & "," & Button2 & "," & Button3, NotifyLevel.DebugModeOnly)
Logger.Warn($"主窗体加载完成前出现意料外的等待弹窗：{Button1},{Button2},{Button3}")
Else
Try
FrmMain.DragStop()
@@ -267,7 +267,7 @@ EndHint:
ComponentDispatcher.PopModal()
End Try
End If
Log("[Control] 普通弹框返回：" & If(Converter.Result, "null"))
Logger.Info($"普通弹框返回：{If(Converter.Result, "null")}")
Return Converter.Result
Else
'不进行等待，直接返回
@@ -298,7 +298,7 @@ EndHint:
Finally
ComponentDispatcher.PopModal()
End Try
Log("[Control] 输入弹框返回：" & If(Converter.Result, "null"))
Logger.Info($"输入弹框返回：{If(Converter.Result, "null")}")
Return Converter.Result
End Function
''' <summary>
@@ -321,7 +321,7 @@ EndHint:
Finally
ComponentDispatcher.PopModal()
End Try
Log("[Control] 选择弹框返回：" & If(Converter.Result, "null"))
Logger.Info($"选择弹框返回：{If(Converter.Result, "null")}")
Return Converter.Result
End Function
@@ -354,7 +354,7 @@ EndHint:
If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
End If
Catch ex As Exception
Log(ex, "处理等待中的弹窗失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "处理等待中的弹窗失败")
End Try
End Sub
@@ -488,8 +488,8 @@ EndHint:
''' </summary>
Public Sub New(FilePath As String)
RawPath = FilePath
Dim JsonData As JObject = GetJson(ArgumentReplace(ReadFile(FilePath), AddressOf EscapeUtils.XmlEscape))
If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件：" & FilePath, FilePath)
If Not FileUtils.Exists(FilePath) Then Throw New FileNotFoundException("未找到帮助文件：" & FilePath, FilePath)
Dim JsonData As JObject = GetJson(ArgumentReplace(FileUtils.ReadAsString(FilePath), AddressOf EscapeUtils.XmlEscape))
'加载常规信息
If JsonData("Title") IsNot Nothing Then
Title = JsonData("Title")
@@ -508,13 +508,13 @@ EndHint:
Next
'加载事件信息
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"), "")
IsEvent = True
Else
Dim XamlAddress As String = FilePath.Lower.Replace(".json", ".xaml")
If File.Exists(XamlAddress) Then
XamlContent = ReadFile(XamlAddress)
If FileUtils.Exists(XamlAddress) Then
XamlContent = FileUtils.ReadAsString(XamlAddress)
IsEvent = False
Else
Throw New FileNotFoundException("未找到帮助条目 .json 对应的 .xaml 文件（" & XamlAddress & "）")
@@ -577,42 +577,42 @@ EndHint:
Try
Dim IgnoreList As New List(Of String)
'读取自定义文件
If Directory.Exists(PathExeFolder & "PCL\Help\") Then
For Each File In EnumerateFiles(PathExeFolder & "PCL\Help\")
Select Case File.Extension.Lower
Case ".helpignore"
If DirectoryUtils.Exists(PathExeFolder & "PCL\Help\") Then
For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Help\")
Select Case PathUtils.GetExtension(File)
Case "helpignore"
'加载忽略列表
Log("[Help] 发现 .helpignore 文件：" & File.FullName)
For Each Line In ReadFile(File.FullName).Split(vbCrLf.ToCharArray)
Logger.Info($"发现 .helpignore 文件：{File}")
For Each Line In FileUtils.ReadAsLines(File, True)
Dim RealString As String = Line.BeforeFirst("#").Trim
If String.IsNullOrWhiteSpace(RealString) Then Continue For
IgnoreList.Add(RealString)
If ModeDebug Then Log("[Help] > " & RealString)
Logger.Trace($"> {RealString}")
Next
Case ".json"
FileList.Add(File.FullName)
Case "json"
FileList.Add(File)
End Select
Next
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 文件与以 . 开头的文件夹
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
If RegexCheck(RealPath, Ignore) Then
If ModeDebug Then Log("[Help] 已忽略 " & RealPath & "：" & Ignore)
If RealPath.RegexCheck(Ignore) Then
Logger.Trace($"已忽略 {RealPath}：{Ignore}")
GoTo NextFile
End If
Next
FileList.Add(File.FullName)
FileList.Add(File)
NextFile:
Next
Log("[Help] 已扫描缓存文件夹下的帮助文件，目前总计 " & FileList.Count & " 条")
Logger.Info($"已扫描缓存文件夹下的帮助文件，目前总计 {FileList.Count} 条")
Catch ex As Exception
Log(ex, "检查帮助文件夹失败", NotifyLevel.MsgBox)
Logger.Error(ex, "检查帮助文件夹失败", LogBehavior.Alert)
End Try
If Loader.IsInterrupted Then Return
@@ -622,9 +622,9 @@ NextFile:
Try
Dim Entry As New HelpEntry(FilePath)
Dict.Add(Entry)
If ModeDebug Then Log("[Help] 已加载的帮助条目：" & Entry.Title & " ← " & FilePath)
Logger.Trace($"已加载的帮助条目：{Entry.Title} ← {FilePath}")
Catch ex As Exception
Log(ex, "初始化帮助条目失败（" & FilePath & "）", NotifyLevel.MsgBox)
Logger.Error(ex, $"初始化帮助条目失败（{FilePath}）", LogBehavior.Alert)
End Try
Next
@@ -634,7 +634,7 @@ NextFile:
Loader.Output = Dict
Catch ex As Exception
Log(ex, "帮助列表初始化失败")
Logger.Warn(ex, "帮助列表初始化失败")
Throw
End Try
End SyncLock
@@ -643,13 +643,12 @@ NextFile:
''' 尝试解压内置帮助文件。
''' </summary>
Public Sub HelpTryExtract()
If Settings.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
DeleteDirectory(PathTemp & "Help")
DirectoryUtils.Create(PathTemp & "Help")
FileUtils.Write(PathTemp & "Cache\Help.zip", GetResources("Help"))
ExtractCompressedFile(PathTemp & "Cache\Help.zip", PathTemp & "Help")
If Settings.Get(Of Integer)("SystemHelpVersion") <> VersionCode OrElse Not FileUtils.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
DirectoryUtils.Delete(PathTemp & "Help")
ExtractResources(PathTemp & "Cache\Help.zip", "Help")
FileUtils.ExtractToDirectory(PathTemp & "Cache\Help.zip", PathTemp & "Help")
Settings.Set("SystemHelpVersion", VersionCode)
Log("[Help] 已解压内置帮助文件，目前状态：" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), NotifyLevel.DebugModeOnly)
Logger.Warn($"已解压内置帮助文件，目前状态：{FileUtils.Exists(PathTemp & "Help\启动器\备份设置.xaml")}")
End If
End Sub
@@ -663,7 +662,7 @@ NextFile:
If _IsAprilEnabled Is Nothing Then
_IsAprilEnabled =
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
Return _IsAprilEnabled.Value
End Get
@@ -774,7 +773,7 @@ NextFile:
End If
Catch ex As Exception
Log(ex, "愚人节移动出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "愚人节移动出错")
End Try
End Sub
@@ -790,7 +789,7 @@ NextFile:
PostMessage(Handle, 400 * 16 + 2, 0, 0)
SetForegroundWindow(Handle) '不在这里放不行，神秘 WinAPI，建议别动
Catch ex As Exception
Log(ex, "设置窗口置顶失败", NotifyLevel.AllUsers)
Logger.Error(ex, "设置窗口置顶失败", LogBehavior.Toast)
End Try
End Sub
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)
If ReadOnlyKey IsNot Nothing Then
If REG_VALUE = ReadOnlyKey.GetValue(Executeable)?.ToString() Then
Log($"[System] 无需调整显卡设置：{Executeable}")
Logger.Info($"无需调整显卡设置：{Executeable}")
Return
End If
Else
'创建父级键
Log($"[System] 需要创建显卡设置的父级键")
Logger.Info($"需要创建显卡设置的父级键")
My.Computer.Registry.CurrentUser.CreateSubKey(REG_KEY)
End If
End Using
'写入新设置
Using WriteKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, True)
WriteKey.SetValue(Executeable, REG_VALUE)
Log($"[System] 已调整显卡设置：{Executeable}")
Logger.Info($"已调整显卡设置：{Executeable}")
End Using
End Sub
@@ -829,12 +828,16 @@ NextFile:
''' </summary>
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
'预处理
'预处理（注意，文件夹必须以 \ 结尾）
Static Replacer As Func(Of String, String) =
Function(s As String) As String
If s Is Nothing Then Return ""
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)
End Function
'基础
@@ -844,10 +847,10 @@ NextFile:
Text = Text.Replace("{pcl_build_type}", Replacer(BuildType.ToString))
Text = Text.Replace("{pcl_branch}", Replacer(VersionBranchMain))
Text = Text.Replace("{identify}", Replacer(Identify))
Text = Text.Replace("{path}", Replacer(PathExeFolder))
Text = Text.Replace("{path}", Replacer(PathUtils.CurrentFolder))
Text = Text.Replace("{path_with_name}", Replacer(PathExe))
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 '在窗口标题中，时间会被后续动态替换，所以此时不应该替换
Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy'/'M'/'d")))
@@ -915,12 +918,12 @@ NextFile:
IsTaskTempCleared = True
IsTaskTempClearing = True
Try
Log("[System] 开始清理任务缓存文件夹")
DeleteDirectory($"{OsDrive}ProgramData\PCL\TaskTemp\")
DeleteDirectory($"{PathTemp}TaskTemp\")
Log("[System] 已清理任务缓存文件夹")
Logger.Info("开始清理任务缓存文件夹")
DirectoryUtils.Delete($"{OsDrive}ProgramData\PCL\TaskTemp\")
DirectoryUtils.Delete($"{PathTemp}TaskTemp\")
Logger.Info("已清理任务缓存文件夹")
Catch ex As Exception
Log(ex, "清理任务缓存文件夹失败")
Logger.Warn(ex, "清理任务缓存文件夹失败")
Finally
IsTaskTempClearing = False
End Try
@@ -955,6 +958,52 @@ NextFile:
Return ResultFolder
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
Public DragControl = Nothing
@@ -970,7 +1019,7 @@ NextFile:
If ThemeDontClick = 2 Then ThemeRefresh()
#End Region
Catch ex As Exception
Log(ex, "短程主时钟执行异常", NotifyLevel.Critical)
Logger.Error(ex, "短程主时钟执行异常", LogBehavior.AlertThenCrash)
End Try
Timer4Count += 1
If Timer4Count = 4 Then
@@ -980,7 +1029,7 @@ NextFile:
If ThemeNow = 12 Then ThemeRefresh()
#End Region
Catch ex As Exception
Log(ex, "中程主时钟执行异常", NotifyLevel.DebugModeOnly)
Logger.Warn(ex, "中程主时钟执行异常")
End Try
End If
Timer150Count += 1
@@ -999,7 +1048,7 @@ NextFile:
End Sub)
#End Region
Catch ex As Exception
Log(ex, "长程主时钟执行异常", NotifyLevel.Critical)
Logger.Error(ex, "长程主时钟执行异常", LogBehavior.AlertThenCrash)
End Try
End If
End Sub
@@ -1012,7 +1061,7 @@ NextFile:
Thread.Sleep(50 * 0.98)
Loop
Catch ex As Exception
Log(ex, "程序主时钟出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "程序主时钟出错")
End Try
End Sub, "Timer Main")
If Not IsAprilEnabled Then Return
@@ -1028,7 +1077,7 @@ NextFile:
Thread.Sleep(1)
Loop
Catch ex As Exception
Log(ex, "愚人节主时钟出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "愚人节主时钟出错")
End Try
End Sub, "Timer Main Fool")
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
MusicAllList = New List(Of String)
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\")
For Each File In EnumerateFiles(PathExeFolder & "PCL\Musics\")
For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Musics\")
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
Dim Ext As String = File.Extension.Lower
If {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(Ext) Then Continue For
MusicAllList.Add(File.FullName)
If {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(PathUtils.GetExtension(File)) Then Continue For
MusicAllList.Add(File)
Next
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
'若需要避免成为第一项的为第一项，则将它放在最后
MusicWaitingList.RemoveAt(0)
MusicWaitingList.Add(PreventFirst)
End If
Catch ex As Exception
Log(ex, "初始化音乐列表失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "初始化音乐列表失败")
End Try
End Sub
''' <summary>
@@ -47,16 +46,18 @@ Public Module ModMusic
''' 如果没有，可能会返回 Nothing。
''' </summary>
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 MusicWaitingList.Any() Then
DequeueNextMusicAddress = MusicWaitingList(0)
Result = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
Else
DequeueNextMusicAddress = Nothing
Result = Nothing
End If
If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress)
If Not MusicWaitingList.Any() Then MusicListInit(False, Result)
Return Result
End Function
#End Region
@@ -81,7 +82,7 @@ Public Module ModMusic
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
ToolTipText = "已暂停：" & Path.GetFileNameWithoutExtension(MusicCurrent)
ToolTipText = "已暂停：" & PathUtils.GetFileNameWithoutExtension(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。"
Else
@@ -90,7 +91,7 @@ Public Module ModMusic
Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
ToolTipText = "正在播放：" & Path.GetFileNameWithoutExtension(MusicCurrent)
ToolTipText = "正在播放：" & PathUtils.GetFileNameWithoutExtension(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。"
Else
@@ -103,7 +104,7 @@ Public Module ModMusic
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
Catch ex As Exception
Log(ex, "刷新背景音乐 UI 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新背景音乐 UI 失败")
End Try
End Sub)
End Sub
@@ -121,7 +122,7 @@ Public Module ModMusic
Case MusicStates.Play
MusicPause()
Case Else
Log("[Music] 音乐目前为停止状态，已强制尝试开始播放", NotifyLevel.DebugModeOnly)
Logger.Warn("音乐目前为停止状态，已强制尝试开始播放")
MusicRefreshPlay(False)
End Select
End If
@@ -133,14 +134,14 @@ Public Module ModMusic
Public Sub MusicControlNext()
If MusicAllList.IsSingle Then
MusicStartPlay(MusicCurrent)
Hint("重新播放：" & GetFileNameFromPath(MusicCurrent), HintType.Green)
Hint("重新播放：" & PathUtils.GetLastPart(MusicCurrent), HintType.Green)
Else
Dim Address As String = DequeueNextMusicAddress()
If Address Is Nothing Then
Hint("没有可以播放的音乐！", HintType.Red)
Else
MusicStartPlay(Address)
Hint("正在播放：" & GetFileNameFromPath(Address), HintType.Green)
Hint("正在播放：" & PathUtils.GetLastPart(Address), HintType.Green)
End If
End If
MusicRefreshUI()
@@ -196,7 +197,7 @@ Public Module ModMusic
Else
Try
MusicStartPlay(Address, IsFirstLoad)
If ShowHint Then Hint("背景音乐已刷新：" & GetFileNameFromPath(Address), HintType.Green, False)
If ShowHint Then Hint("背景音乐已刷新：" & PathUtils.GetLastPart(Address), HintType.Green, False)
Catch
End Try
End If
@@ -204,7 +205,7 @@ Public Module ModMusic
MusicRefreshUI()
Catch ex As Exception
Log(ex, "刷新背景音乐播放失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新背景音乐播放失败")
End Try
End Sub
''' <summary>
@@ -212,7 +213,7 @@ Public Module ModMusic
''' </summary>
Private Sub MusicStartPlay(Address As String, Optional IsFirstLoad As Boolean = False)
If Address Is Nothing Then Return
Log("[Music] 播放开始：" & Address)
Logger.Info($"播放开始：{Address}")
MusicCurrent = Address
RunInNewThread(Sub() MusicLoop(IsFirstLoad), "Music", ThreadPriority.BelowNormal)
End Sub
@@ -226,13 +227,13 @@ Public Module ModMusic
If MusicState = MusicStates.Play Then
RunInThread(
Sub()
Log("[Music] 已暂停播放")
Logger.Info("已暂停播放")
MusicNAudio?.Pause()
MusicRefreshUI()
End Sub)
Return True
Else
Log($"[Music] 无需暂停播放，当前状态为 {MusicState}")
Logger.Info($"无需暂停播放，当前状态为 {MusicState}")
Return False
End If
End Function
@@ -241,12 +242,12 @@ Public Module ModMusic
''' </summary>
Public Function MusicResume() As Boolean
If MusicState = MusicStates.Play OrElse Not MusicAllList.Any() Then
Log($"[Music] 无需继续播放，当前状态为 {MusicState}")
Logger.Info($"无需继续播放，当前状态为 {MusicState}")
Return False
Else
RunInThread(
Sub()
Log("[Music] 已恢复播放")
Logger.Info("已恢复播放")
Try
MusicNAudio?.Play()
Catch 'https://github.com/Meloong-Git/PCL/pull/5415#issuecomment-2751135223
@@ -285,20 +286,20 @@ Public Module ModMusic
Try
Reader = New AudioFileReader(MusicCurrent)
Catch ex As Exception
Log(ex, "使用 AudioFileReader 加载音频文件失败，换用 MediaFoundationReader 重试", NotifyLevel.DevelopOnly)
Logger.Warn(ex, "使用 AudioFileReader 加载音频文件失败，换用 MediaFoundationReader 重试")
Reader = New MediaFoundationReader(MusicCurrent)
End Try
CurrentWave.Init(Reader)
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()
'停止条件：播放完毕或变化
Dim PreviousVolume = 0
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 '类型或成员已过时
CurrentWave.Volume = PreviousVolume / 1000
#Enable Warning BC40008 '类型或成员已过时
@@ -311,7 +312,7 @@ Public Module ModMusic
'当前音乐已播放结束，继续下一曲
If CurrentWave.PlaybackState = PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
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
Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL，才能恢复音乐播放功能！", HintType.Red)
Thread.Sleep(1000000000)
@@ -322,9 +323,9 @@ Public Module ModMusic
End If
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)
Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Red)
Hint("播放音乐失败（" & PathUtils.GetLastPart(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Red)
Else
Log(ex, "播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）", NotifyLevel.AllUsers)
Logger.Error(ex, $"播放音乐失败（{PathUtils.GetLastPart(MusicCurrent)}）", LogBehavior.Toast)
End If
'将播放错误的音乐从列表中移除
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)
ThemeRefreshMain()
Catch ex As Exception
Log(ex, "刷新主题颜色失败", NotifyLevel.AllUsers)
Logger.Warn(ex, "刷新主题颜色失败", NotifyLevel.AllUsers)
End Try
End Sub
Public Sub ThemeRefreshMain()
@@ -166,7 +166,7 @@ Friend Module ModSecret
FrmMain.PanTitle.Background = Brush
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.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)})
@@ -219,16 +219,16 @@ Friend Module ModSecret
''' </summary>
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 小时
#End Region
#Region "赞助等级"
Public ReadOnly Property DonationRank As DonationRanks
Public ReadOnly Property CurrentRank As DonationRank
Get
Return DonationRanks.None
Return DonationRank.None
End Get
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>
Public Class ResourceFile
Public Class LocalResourceFile
#Region "文件信息"
@@ -13,7 +13,7 @@ Public Class ResourceFile
Me.File = FileInfo
End Sub
Public Sub New(FullName As String)
Me.New(New FileInfo(FullName))
Me.New(FileUtils.GetInfo(FullName))
End Sub
''' <summary>
@@ -48,7 +48,7 @@ Public Class ResourceFile
''' <summary>
''' 在初始化结束之后，任何信息被后续更新时触发此事件。
''' </summary>
Public Event OnUpdate(sender As ResourceFile)
Public Event OnUpdate(sender As LocalResourceFile)
''' <summary>
''' 可读名称。
@@ -57,7 +57,7 @@ Public Class ResourceFile
Public Property Display As String
Get
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
End Get
Set(value As String)
@@ -97,7 +97,7 @@ Public Class ResourceFile
Return _Version
End Get
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" '需要修改的标识
_Version = value
End Set
@@ -118,16 +118,15 @@ Public Class ResourceFile
Dim Jar As ZipArchive = Nothing
Try
'基础可用性检查
If File.FullName.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径（" & If(File.FullName, "null") & "）")
If Not IO.File.Exists(File.FullName) Then Throw New FileNotFoundException("未找到 Mod 文件（" & File.FullName & "）")
If Not FileUtils.Exists(File.FullName) Then Throw New FileNotFoundException("未找到 Mod 文件（" & File.FullName & "）")
'打开 Jar 文件
Jar = New ZipArchive(New FileStream(File.FullName, FileMode.Open, FileAccess.Read, FileShare.Read))
Jar = FileUtils.OpenZip(File.FullName)
'信息获取
LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException
Log(ex, $"Mod 文件由于无权限无法打开（{File.FullName}）", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"Mod 文件由于无权限无法打开（{File.FullName}）")
Catch ex As Exception
Log(ex, $"Mod 文件无法打开（{File.FullName}）", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"Mod 文件无法打开（{File.FullName}）")
Finally
If Jar IsNot Nothing Then Jar.Dispose()
End Try
@@ -140,7 +139,7 @@ Public Class ResourceFile
Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info")
Dim InfoString As String = Nothing
If InfoEntry IsNot Nothing Then
InfoString = ReadFile(InfoEntry.Open())
InfoString = InfoEntry.Open().ReadString()
If InfoString.Length < 15 Then InfoString = Nothing
End If
If InfoString Is Nothing Then Exit Try
@@ -157,7 +156,7 @@ Public Class ResourceFile
Description = InfoObject("description")
Version = InfoObject("version")
Catch ex As Exception
Log(ex, $"读取 mcmod.info 时出现未知错误（{File.FullName}）", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"读取 mcmod.info 时出现未知错误（{File.FullName}）")
End Try
#End Region
#Region "尝试使用 fabric.mod.json"
@@ -166,7 +165,7 @@ Public Class ResourceFile
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
Dim FabricText As String = Nothing
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
End If
If FabricText Is Nothing Then Exit Try
@@ -179,7 +178,7 @@ GotFabric:
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fabric.mod.json 时出现未知错误（" & File.FullName & "）", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"读取 fabric.mod.json 时出现未知错误（{File.FullName}）")
End Try
#End Region
#Region "尝试使用 mods.toml"
@@ -188,13 +187,13 @@ GotFabric:
Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml")
Dim TomlText As String = Nothing
If TomlEntry IsNot Nothing Then
TomlText = ReadFile(TomlEntry.Open())
TomlText = TomlEntry.Open().ReadString()
If TomlText.Length < 15 Then TomlText = Nothing
End If
If TomlText Is Nothing Then Exit Try
'文件标准化：统一换行符为 vbLf，去除注释、头尾的空格、空行
Dim Lines As New List(Of String)
For Each Line In TomlText.ReplaceLineEndings(vbLf).Split(vbLf) '统一换行符
For Each Line In TomlText.SplitLines(True)
If Line.StartsWithF("#") Then '去除注释
Continue For
ElseIf Line.Contains("#") Then
@@ -268,7 +267,7 @@ GotFabric:
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, $"读取 mods.toml 时出现未知错误（{File.FullName}）", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"读取 mods.toml 时出现未知错误（{File.FullName}）")
End Try
#End Region
#Region "尝试使用 fml_cache_annotation.json"
@@ -277,7 +276,7 @@ GotFabric:
Dim FmlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/fml_cache_annotation.json")
Dim FmlText As String = Nothing
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
End If
If FmlText Is Nothing Then Exit Try
@@ -305,7 +304,7 @@ Got:
'加载成功
GoTo Finished
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 Region
Return '没能成功获取任何信息
@@ -316,7 +315,7 @@ Finished:
Try
Dim MetaEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/MANIFEST.MF")
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
MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
@@ -324,7 +323,7 @@ Finished:
End If
End If
Catch ex As Exception
Log($"获取 META-INF 中的版本信息失败（{File.FullName}）", NotifyLevel.DevelopOnly)
Logger.Warn($"获取 META-INF 中的版本信息失败（{File.FullName}）")
Version = Nothing
End Try
End If
@@ -408,7 +407,7 @@ Finished:
''' </summary>
Public ReadOnly Property HasUpdate As Boolean
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 Property
@@ -421,13 +420,13 @@ Finished:
'读取缓存
Dim CacheKey As String = GetHash($"{EnabledFullName}-{File.LastWriteTime.ToLongTimeString}-{File.Length}-C")
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
Return _CurseForgeHash
End If
'读取文件
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
data.Add(b)
Next
@@ -481,7 +480,7 @@ Finished:
Return _ModrinthHash
End If
'计算 SHA1
_ModrinthHash = GetFileSHA1(File.FullName)
_ModrinthHash = HashUtils.ComputeFromFile(File.FullName, HashUtils.HashMethod.Sha1)
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
End If
@@ -498,7 +497,7 @@ Finished:
Return File.FullName
End Function
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
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
Private Const ResourceFileCacheVersion As Integer = 16
Public Module LocalResourceLoaders
'加载 Mod 列表
Public McModLoader As New LoaderTask(Of String, List(Of ResourceFile))("Mod List Loader", AddressOf McModLoad)
Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of ResourceFile)))
Public LocalResourceLoader As New LoaderTask(Of String, List(Of LocalResourceFile))("LocalResourceLoader", AddressOf LocalResourceFileLoad)
Private Sub LocalResourceFileLoad(Loader As LoaderTask(Of String, List(Of LocalResourceFile)))
Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.ShowProgress = False)
'等待 Mod 更新完成
If PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表：" & Loader.Input)
Logger.Info($"等待 Mod 更新完成后才能继续加载 Mod 列表：{Loader.Input}")
Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
@@ -23,15 +22,15 @@
End If
'获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo)
If Directory.Exists(Loader.Input) Then
Dim ModFileList As New List(Of String)
If DirectoryUtils.Exists(Loader.Input) Then
Dim RawName As String = Loader.Input.Lower
For Each File As FileInfo In EnumerateFiles(Loader.Input)
If File.DirectoryName.Lower & "\" <> RawName Then
For Each File In DirectoryUtils.GetFiles(Loader.Input)
If File.BeforeLast("\").Lower & "\" <> RawName Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时，才加载该子文件夹下的 Mod
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge 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
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
Return False
End Function
If IsModFile(File.FullName) Then ModFileList.Add(File)
If IsModFile(File) Then ModFileList.Add(File)
Next
End If
@@ -52,29 +51,29 @@
Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
Dim Cache As New JObject
Try
Dim CacheContent As String = ReadFile(CachePath)
Dim CacheContent As String = FileUtils.TryReadAsString(CachePath)
If Not String.IsNullOrWhiteSpace(CacheContent) Then
Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> ResourceFileCacheVersion Then
Log($"[Mod] 本地 Mod 信息缓存版本已过期，将弃用这些缓存信息", NotifyLevel.DebugModeOnly)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> Versions.LOCAL_MOD_CACHE_VERSION Then
Logger.Warn($"本地 Mod 信息缓存版本已过期，将弃用这些缓存信息")
Cache = New JObject
End If
End If
Catch ex As Exception
Log(ex, "读取本地 Mod 信息缓存失败，已重置")
Logger.Warn(ex, "读取本地 Mod 信息缓存失败，已重置")
Cache = New JObject
End Try
Cache("version") = ResourceFileCacheVersion
Cache("version") = Versions.LOCAL_MOD_CACHE_VERSION
'加载 Mod 列表
Dim ModList As New List(Of ResourceFile)
For Each ModFile As FileInfo In ModFileList
Dim ModList As New List(Of LocalResourceFile)
For Each ModFile In ModFileList
If Loader.IsInterrupted Then Return
Dim ModEntry As New ResourceFile(ModFile)
Dim DumpMod As ResourceFile = ModList.FirstOrDefault(Function(m) m.EnabledName = ModEntry.EnabledName) '存在两个文件，名称相同，但一个启用一个禁用
Dim ModEntry As New LocalResourceFile(ModFile)
Dim DumpMod As LocalResourceFile = ModList.FirstOrDefault(Function(m) m.EnabledName = ModEntry.EnabledName) '存在两个文件，名称相同，但一个启用一个禁用
If DumpMod IsNot Nothing Then
Dim DisabledMod As ResourceFile = If(DumpMod.IsEnabled, ModEntry, DumpMod)
Log($"[Mod] 重复的 Mod 文件：{DumpMod.File.Name} 与 {ModEntry.File.Name}，已忽略 {DisabledMod.File.Name}", NotifyLevel.DebugModeOnly)
Dim DisabledMod As LocalResourceFile = If(DumpMod.IsEnabled, ModEntry, DumpMod)
Logger.Warn($"重复的 Mod 文件：{DumpMod.File.Name} 与 {ModEntry.File.Name}，已忽略 {DisabledMod.File.Name}")
If DisabledMod Is ModEntry Then
Continue For
Else
@@ -83,7 +82,7 @@
End If
ModList.Add(ModEntry)
Next
Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
Logger.Info($"共发现 {ModList.Count} 个 Mod")
'排序
ModList = ModList.OrderBy(Function(m) m.File.Name).ToList
@@ -94,33 +93,24 @@
'开始联网加载
'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
Log(ex, "Mod 列表加载失败", NotifyLevel.DebugModeOnly)
Logger.Warn(ex, "Mod 列表加载失败")
Throw
End Try
End Sub
'联网加载 Mod 详情
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of ResourceFile), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of ResourceFile), JObject), Integer))
Dim Mods As New List(Of ResourceFile)
Dim Cache As JObject = Loader.Input.Value
Static GetTargetModLoaders As Func(Of List(Of ModLoaderTypes)) =
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
Public LocalResourceOnlineLoader As New LoaderTask(Of (ModList As List(Of LocalResourceFile), Cache As JObject, Target As McVersion), Integer)("LocalResourceOnlineLoader", AddressOf LocalResourceOnlineLoad)
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 LocalResourceFile)
Dim Cache As JObject = Loader.Input.Cache
Dim ModLoaders = Loader.Input.Target.ModLoaders
'读取缓存，获取需要更新的 Mod 列表
For Each ModEntry As ResourceFile In Loader.Input.Key
For Each ModEntry As LocalResourceFile In Loader.Input.ModList
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
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过，则无需重新获取
@@ -128,18 +118,17 @@
End If
Mods.Add(ModEntry)
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
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
End If
'获取作为检查目标的加载器和版本
'此处不应向下扩展检查的 MC 小版本，例如 Mod 在更新 1.16.5 后，对早期的 1.16.2 版本发布了修补补丁，这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
Dim TargetMcVersion As McVersion = PageInstanceLeft.Instance.Version
Dim ModLoaders = GetTargetModLoaders()
Dim TargetMcVersion As McVersion = Loader.Input.Target
Dim VanillaVersion = TargetMcVersion.VanillaName
'开始网络获取
Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{VanillaVersion}")
Logger.Info($"目标加载器：{ModLoaders}，版本：{VanillaVersion}")
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim CurrentTaskThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
@@ -150,16 +139,16 @@
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthVersion As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
Logger.Info($"从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
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
If Not ModrinthVersion.ContainsKey(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
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)
'记录对应的 ProjectVersion
Dim File = ResourceVersion.FromPlatformJson(ModrinthVersion(Entry.ModrinthHash), ResourceTypes.Mod)
@@ -170,7 +159,7 @@
End If
Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
Logger.Info($"需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3：获取工程信息
If Not ModrinthMapping.Any() Then Return
Dim ModrinthProject As JArray = DlModRequest(
@@ -181,16 +170,20 @@
Entry.Project = Project
Next
Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息，继续获取更新信息")
Logger.Info($"已从 Modrinth 获取本地 Mod 信息，继续获取更新信息")
'步骤 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,
$"{{""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
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.ProjectVersion Is Nothing Then Continue For
Dim UpdateFile = ResourceVersion.FromPlatformJson(ModrinthUpdate(Entry.ModrinthHash), ResourceTypes.Mod)
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.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
@@ -202,9 +195,9 @@
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
Logger.Info($"从 Modrinth 获取本地 Mod 信息结束")
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
Logger.Warn(ex, "从 Modrinth 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
@@ -215,90 +208,92 @@
Sub()
Try
'步骤 1：获取 Hash 与对应的工程 ID
Dim CurseForgeHashes As New List(Of UInteger)
Dim Hashes As New List(Of UInteger)
For Each Entry In Mods
CurseForgeHashes.Add(Entry.CurseForgeHash)
Hashes.Add(Entry.CurseForgeHash)
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Next
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系
$"{{""fingerprints"": [{Hashes.Join(",")}]}}", "application/json")("data")("exactMatches")
Logger.Info($"从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
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
Dim ProjectId = Project("id").ToString
Dim Hash As UInteger = Project("file")("fileFingerprint")
For Each Entry In Mods
If Entry.CurseForgeHash <> Hash Then Continue For
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)
CurseForgeMapping(ProjectId).Add(Entry)
ProjectIdToLocalFiles.AddIntoValueCollection(ProjectId, Entry)
'记录对应的 ProjectVersion
Dim File = ResourceVersion.FromPlatformJson(Project("file"), ResourceTypes.Mod)
If Entry.ProjectVersion Is Nothing OrElse Entry.ProjectVersion.ReleaseDate < File.ReleaseDate Then Entry.ProjectVersion = File
Next
Next
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：获取工程信息
If Not CurseForgeMapping.Any() Then Return
Dim CurseForgeProject = DlModRequest("https://api.curseforge.com/v1/mods", HttpMethod.Post,
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of ResourceFile)) 'FileId -> 本地 Mod 文件列表
$"{{""modIds"": [{ProjectIdToLocalFiles.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of LocalResourceFile)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject
If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息
Dim Project As New ResourceProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Project IsNot Nothing AndAlso Entry.Project.Platform = ResourcePlatforms.Modrinth Then
Entry.Project = Entry.Project '再次触发修改事件
Continue For
Dim TargetLoaders As ModLoaders = ModLoaders.None
For Each LocalFile In ProjectIdToLocalFiles(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If LocalFile.Project?.Platform = ResourcePlatforms.Modrinth Then
LocalFile.Project = LocalFile.Project '再次触发修改事件
Else
LocalFile.Project = Project
TargetLoaders = TargetLoaders Or LocalFile.Project.ModLoaders
End If
Entry.Project = Project
Next
TargetLoaders = TargetLoaders And ModLoaders '与目标 MC 版本的加载器取交集
'查找或许版本更新的文件列表
If ModLoaders.IsSingle Then
Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes")
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion")
If IndexVersion <> VanillaVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的，所以只需取第一个；如果需要检查多个 releaseType 下的文件，将 > -1 改为 = 1，但这应当并不会获取到更新的文件
If NewestVersion IsNot Nothing AndAlso CompareVersion(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then
NewestVersion = IndexVersion
NewestFileIds.Clear()
End If
NewestFileIds.Add(IndexEntry("fileId").ToObject(Of Integer))
Next
For Each FileId In NewestFileIds
If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of ResourceFile)
UpdateFileIds(FileId).AddRange(CurseForgeMapping(Project.Id))
FileIdToProjectSlug(FileId) = Project.Slug
Next
End If
If ModLoaders = ModLoaders.None Then Continue For '无法判断 MC 版本使用的加载器，跳过更新检查
Dim LatestFiles = ProjectJson("latestFilesIndexes").Where(
Function(Entry)
'Mod Loader 匹配
If Entry("modLoader") Is Nothing Then Return False
Dim EntryLoader As ModLoaders = Resource.FromCurseForgeModLoaderType(Entry("modLoader").ToObject(Of Integer))
If Not TargetLoaders.HasFlag(EntryLoader) Then Return False
'MC 版本匹配
Dim EntryVersion As String = Entry("gameVersion")
Return EntryVersion IsNot Nothing AndAlso EntryVersion = VanillaVersion
End Function).
MaxByAll(Function(Entry) Entry("gameVersion").ToString, New VersionComparer) '只保留最新的 MC 版本
For Each Entry In LatestFiles
Dim FileId = Entry("fileId").ToObject(Of Integer)
If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of LocalResourceFile)
UpdateFileIds(FileId).AddRange(ProjectIdToLocalFiles(Project.Id))
FileIdToProjectSlug(FileId) = Project.Slug
Next
Next
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息，需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4：获取更新文件信息
Logger.Info($"已从 CurseForge 获取本地 Mod 信息，需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
If Not UpdateFileIds.Any() Then Return
'步骤 4：获取更新文件信息
Dim CurseForgeFiles = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post,
$"{{""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
Dim File = ResourceVersion.FromPlatformJson(FileJson, ResourceTypes.Mod)
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
UpdateFiles(Entry) = File
Next
Next
For Each Pair In UpdateFiles
Dim Entry As ResourceFile = Pair.Key
Dim Entry As LocalResourceFile = Pair.Key
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.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
@@ -309,16 +304,17 @@
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
Logger.Info($"从 CurseForge 获取 Mod 更新信息结束")
Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
Logger.Warn(ex, "从 CurseForge 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader CurseForge")
'从 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
Thread.Sleep(10)
@@ -326,11 +322,12 @@
Loop
'保存缓存
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 Loader.IsInterrupted Then Return
For Each Entry In Mods
Entry.OnlineDataLoaded = Not IsFailed
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = Entry.ToJson()
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders) = Entry.ToJson()
Next
FileUtils.Write(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
@@ -342,4 +339,4 @@
End If
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>
Public ReadOnly DownloadCount As Integer
''' <summary>
''' 支持的 Mod 加载器列表。可能为空。
''' 所有支持的 Mod 加载器。可能为 <see cref="ModLoaders.None"/>。
''' </summary>
Public ReadOnly Loaders As List(Of ModLoaderTypes)
Public ReadOnly ModLoaders As ModLoaders = ModLoaders.None
''' <summary>
''' 描述性标签的内容。已转换为中文。
''' </summary>
@@ -133,11 +133,7 @@ Public Class ResourceProject
Website = Data("Website")
LastUpdate = Data("LastUpdate")
DownloadCount = Data("DownloadCount")
If Data.ContainsKey("ModLoaders") Then
Loaders = CType(Data("ModLoaders"), JArray).Select(Function(t) CType(t.ToObject(Of Integer), ModLoaderTypes)).ToList
Else
Loaders = New List(Of ModLoaderTypes)
End If
If Data.ContainsKey("ModLoaders") Then ModLoaders = Data("ModLoaders").ToObject(Of Integer)
Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList
If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl")
If Data.ContainsKey("Drops") Then
@@ -181,12 +177,12 @@ Public Class ResourceProject
Types = ResourceTypes.DataPack
End If
'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
For Each File In If(Data("latestFiles"), New JArray)
Dim NewFile = ResourceVersion.FromPlatformJson(File, Types)
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))
If Not GameVersions.Any(Function(v) McVersion.IsFormatFit(v)) Then Continue For
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
Drops = Files.SelectMany(Function(f) f.Value).
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 = New List(Of String)
For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段 (4267#issuecomment-2254590831)
@@ -303,24 +298,17 @@ Public Class ResourceProject
End Select
'Tags & ModLoaders
Tags = New List(Of String)
Loaders = New List(Of ModLoaderTypes)
If Data.ContainsKey("loaders") Then
For Each Category In Data("loaders").Select(Function(t) t.ToString)
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)
End Select
ModLoaders = ModLoaders.None
For Each Category In If(Data("loaders")?.Select(Function(t) t.ToString), {}).Concat(Data("categories").Select(Function(t) t.ToString))
For Each Loader In EnumUtils.GetAllFlags(Of ModLoaders)()
If Category = Loader.ToString.Lower Then
ModLoaders = ModLoaders Or Loader
Exit For
End If
Next
End If
Next
For Each Category In Data("categories").Select(Function(t) t.ToString)
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 "technology" : Tags.Add("科技")
@@ -388,12 +376,11 @@ Public Class ResourceProject
Case "vanilla" : Tags.Add("原版可用")
End Select
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 If
If Not Tags.Any() Then Tags.Add("其他")
Tags.Sort()
Loaders.Sort()
End If
'保存缓存
Cache(Id) = Me
@@ -454,7 +441,7 @@ Public Class ResourceProject
Json("Website") = Website
Json("LastUpdate") = LastUpdate
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)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If Drops.Any Then Json("Drops") = New JArray(Drops)
@@ -514,13 +501,13 @@ Public Class ResourceProject
End If
'获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
Dim ModLoadersForDesc As New List(Of ModLoaderTypes)(Loaders)
If Settings.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(ModLoaderTypes.Quilt)
Dim ModLoadersForDesc = ModLoaders.Flags().ToList()
If Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(ModLoaders.Quilt)
Select Case ModLoadersForDesc.Count
Case 0
If Loaders.IsSingle Then
ModLoaderDescriptionFull = "仅 " & Loaders.Single.ToString
ModLoaderDescriptionPart = Loaders.Single.ToString
If ModLoadersForDesc.IsSingle Then
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
Else
ModLoaderDescriptionFull = "未知"
ModLoaderDescriptionPart = ""
@@ -530,10 +517,10 @@ Public Class ResourceProject
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
Case Else
Dim NewestDrop As Integer = If(Drops.Any, Drops.First, 9999)
If Loaders.Contains(ModLoaderTypes.Forge) AndAlso
(NewestDrop < 140 OrElse Loaders.Contains(ModLoaderTypes.Fabric)) AndAlso
(NewestDrop < 200 OrElse Loaders.Contains(ModLoaderTypes.NeoForge)) AndAlso
(NewestDrop < 140 OrElse Loaders.Contains(ModLoaderTypes.Quilt) OrElse Settings.Get("ToolDownloadIgnoreQuilt")) Then
If ModLoadersForDesc.Contains(ModLoaders.Forge) AndAlso
(NewestDrop < 140 OrElse ModLoadersForDesc.Contains(ModLoaders.Fabric)) AndAlso
(NewestDrop < 200 OrElse ModLoadersForDesc.Contains(ModLoaders.NeoForge)) AndAlso
(NewestDrop < 140 OrElse ModLoadersForDesc.Contains(ModLoaders.Quilt) OrElse Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt")) Then
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
Else
@@ -596,7 +583,7 @@ Public Class ResourceProject
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))
If NameLists.IsSingle Then GoTo NoSubtitle
'查找其中的缩写、Forge/Fabric 等版本标记
@@ -608,7 +595,7 @@ Public Class ResourceProject
'缩写
SubtitleList.Add(Name)
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 等版本标记
SubtitleList.Add(Name)
Else
@@ -631,7 +618,7 @@ Public Class ResourceProject
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
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
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 版
@@ -690,16 +677,16 @@ NoSubtitle:
'来自不同的网站
If Platform = Project.Platform Then Return False
'Mod 加载器一致
If Loaders.Count <> Project.Loaders.Count OrElse Loaders.Except(Project.Loaders).Any() Then Return False
If ModLoaders <> Project.ModLoaders Then Return False
'若不为光影，则要求 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
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse
GetRaw(Slug) = GetRaw(Project.Slug) Then
Log($"[Resource] 将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程")
Logger.Info($"将 {RawName} ({Slug}) 与 {Project.RawName} ({Project.Slug}) 认定为相似工程")
'如果只有一个有 DatabaseEntry，设置给另外一个
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
Plain Craft Launcher 2/Modules/Resource/ResourceSearcher.vb
+39 -34
View File
@@ -40,8 +40,10 @@
Public Tag As String = ""
''' <summary>
''' 筛选 Mod 加载器类别。
''' <see cref="ModLoaders.None"/> 代表不筛选。
''' 对于 Modrinth 请求，支持多个枚举值。
''' </summary>
Public ModLoader As ModLoaderTypes = ModLoaderTypes.Any
Public ModLoaders As ModLoaders = ModLoaders.None
''' <summary>
''' 筛选 MC 版本。
''' </summary>
@@ -82,7 +84,7 @@
Address += "&classId=12"
End Select
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(SearchText) Then Address += "&searchFilter=" & EscapeUtils.UrlEscape(SearchText)
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"
If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & EscapeUtils.UrlEscape(SearchText)
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)
Facets.Add($"[""project_type:{Type.ToString.Lower}""]")
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}'""]")
Address += "&facets=[" & String.Join(",", Facets) & "]"
Return Address
@@ -112,7 +116,7 @@
Dim request = TryCast(obj, SearchRequest)
Return request IsNot Nothing 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
End Function
Public Shared Operator =(left As SearchRequest, right As SearchRequest) As Boolean
@@ -122,7 +126,7 @@
Return Not left = right
End Operator
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 Class
@@ -164,19 +168,19 @@
#Region "前置检查"
If Storage.Results.Count >= Request.TargetResultCount Then
Log($"[Resource] 已有 {Storage.Results.Count} 个结果，多于所需的 {Request.TargetResultCount} 个结果，结束处理")
Logger.Info($"已有 {Storage.Results.Count} 个结果，多于所需的 {Request.TargetResultCount} 个结果，结束处理")
Return
ElseIf Not Request.CanContinue Then
If Not Storage.Results.Any() Then
Throw New Exception("没有符合条件的结果")
Else
Log($"[Resource] 已有 {Storage.Results.Count} 个结果，少于所需的 {Request.TargetResultCount} 个结果，但无法继续获取，结束处理")
Logger.Info($"已有 {Storage.Results.Count} 个结果，少于所需的 {Request.TargetResultCount} 个结果，但无法继续获取，结束处理")
Return
End If
End If
'拒绝 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)
End If
@@ -186,10 +190,10 @@
Dim RawSearchText As String = If(Request.SearchText, "").Trim
RawSearchText = RawSearchText.Lower
Log("[Resource] 工程列表搜索原始文本：" & RawSearchText)
Logger.Info($"工程列表搜索原始文本：{RawSearchText}")
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 和数据包进行中文搜索，注意整合包的名称可能已经有中文了
Dim CurseForgeAltSearchText As String = Nothing, ModrinthAltSearchText As String = Nothing, ModrinthSlugs As New List(Of String) '从中文转为英文的替代搜索内容
If IsChineseSearch Then
@@ -231,7 +235,7 @@
Function(Entry) New SearchEntry(Of WikiEntry) With {
.Item = Entry,
.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)}
}).ToList
Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25)
@@ -244,7 +248,7 @@
MaxBy(Function(s) s.Item.Popularity) '然后从中选择最受欢迎的那一个
'后处理
CurseForgeAltSearchText = ExtractWords(CurseForgeTarget, ResourcePlatforms.CurseForge).Join(" ")
Log("[Resource] 中文搜索关键词（CurseForge）：" & CurseForgeAltSearchText, NotifyLevel.DebugModeOnly)
Logger.Warn($"中文搜索关键词（CurseForge）：{CurseForgeAltSearchText}")
End If
End If
'Modrinth
@@ -255,7 +259,7 @@
Function(Entry) New SearchEntry(Of WikiEntry) With {
.Item = Entry,
.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)}
}).ToList
Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25)
@@ -270,7 +274,7 @@
Next
Next
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
End If
@@ -295,7 +299,7 @@ NextPage:
'在 1.14-，部分老 Mod 没有设置支持的加载器，因此添加 Forge 筛选就会出现遗漏
'所以，在发起请求时不筛选加载器，然后在返回的结果中自行筛除不是 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
'CurseForge 搜索
@@ -307,21 +311,22 @@ NextPage:
Try
'获取工程列表
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 ProjectList As New List(Of ResourceProject)
For Each JsonEntry As JObject In RequestResult("data")
Dim Project As New ResourceProject(JsonEntry)
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)
Next
'更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p))
Storage.CurseForgeOffset += RequestResult("data").Count
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
Log(ex, "CurseForge 搜索失败")
Logger.Warn(ex, "CurseForge 搜索失败")
Storage.CurseForgeTotal = -1
Errors.Add((ex, ResourcePlatforms.CurseForge))
End Try
@@ -337,7 +342,7 @@ NextPage:
Sub()
Try
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 ProjectList As New List(Of ResourceProject)
For Each JsonEntry As JObject In RequestResult("hits")
@@ -347,9 +352,9 @@ NextPage:
ProjectList.ForEach(Sub(p) RawResults.Add(p))
Storage.ModrinthOffset += RequestResult("hits").Count
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
Log(ex, "Modrinth 搜索失败")
Logger.Warn(ex, "Modrinth 搜索失败")
Storage.ModrinthTotal = -1
Errors.Add((ex, ResourcePlatforms.Modrinth))
End Try
@@ -365,7 +370,7 @@ NextPage:
Sub()
Try
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)
For Each JsonEntry As JObject In DlModRequest(ModrinthUrl)
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 Not String.IsNullOrEmpty(Request.Tag) AndAlso
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
Not Project.Loaders.Any(Function(m) m = Request.ModLoader) Then Continue For
If Request.ModLoaders <> ModLoaders.None AndAlso Not IgnoreModLoaderFilter AndAlso
Not Project.ModLoaders.Flags.Intersect(Request.ModLoaders.Flags).Any() Then Continue For
If Not String.IsNullOrEmpty(Request.GameVersion) AndAlso
Not Project.UnsafeGameVersions.Any(Function(d) d = Request.GameVersion) Then Continue For
ProjectList.Add(Project)
Next
'更新结果
ProjectList.ForEach(Sub(p) RawResults.Add(p))
Log($"[Resource] 从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
Logger.Info($"从 Modrinth 直接获取到了 {ProjectList.Count} 个工程")
ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
Catch ex As Exception
Log(ex, "Modrinth 直接获取失败")
Logger.Warn(ex, "Modrinth 直接获取失败")
Errors.Add((ex, ResourcePlatforms.Modrinth))
End Try
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页，所以不能直接给够
@@ -397,9 +402,9 @@ NextPage:
If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程
Next
'筛除不是 Forge 的 Mod
'仅保留兼容 Forge 的 Mod，或老版本中没有标注任何 Mod Loader 的 Mod
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
'确保存在结果
@@ -446,19 +451,19 @@ NextPage:
Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList
'加入列表
RealResults.AddRange(RawResults)
Log($"[Resource] 去重、筛选后累计新增结果 {RealResults.Count} 个（目前已有结果 {Storage.Results.Count} 个）")
Logger.Info($"去重、筛选后累计新增结果 {RealResults.Count} 个（目前已有结果 {Storage.Results.Count} 个）")
#End Region
#Region "检查结果数量，如果不足且可继续，会继续加载下一页"
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 '如果有某个源失败则不再重试，这时候重试可能导致无限循环
Log("[Resource] 将继续尝试加载下一页")
Logger.Info("将继续尝试加载下一页")
GoTo NextPage
Else
Log("[Resource] 无法继续加载，将强制结束")
Logger.Info("无法继续加载，将强制结束")
End If
End If
@@ -493,7 +498,7 @@ NextPage:
Scores(Result) = If(Result.WikiId > 0, 0.2, 0) +
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 {
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)}})
Next
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>
Public Version As String
''' <summary>
''' 支持的 Mod 加载器列表。
''' 可能为空列表，不为 Nothing。
''' 所有支持的 Mod 加载器列表。可能为 <see cref="ModLoaders.None"/>。
''' </summary>
Public Loaders As List(Of ModLoaderTypes)
Public ModLoaders As ModLoaders = ModLoaders.None
''' <summary>
''' 支持的游戏版本列表。类型包括："26.1.5"，"26.1"，"26.1 预览版"，"1.18.5"，"1.18"，"1.18 预览版"，"21w15a"，"未知版本"。
''' </summary>
@@ -158,11 +157,10 @@ Public Class ResourceVersion
.GameVersions = New List(Of String) From {"未知版本"}
End If
'ModLoaders
.Loaders = New List(Of ModLoaderTypes)
If RawVersions.Contains("forge") Then .Loaders.Add(ModLoaderTypes.Forge)
If RawVersions.Contains("fabric") Then .Loaders.Add(ModLoaderTypes.Fabric)
If RawVersions.Contains("quilt") Then .Loaders.Add(ModLoaderTypes.Quilt)
If RawVersions.Contains("neoforge") Then .Loaders.Add(ModLoaderTypes.NeoForge)
.ModLoaders = ModLoaders.None
For Each Loader In EnumUtils.GetAllFlags(Of ModLoaders)()
If RawVersions.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader
Next
#End Region
Else
#Region "Modrinth"
@@ -183,14 +181,13 @@ Public Class ResourceVersion
'Loaders
'结果可能混杂着 Mod、数据包和服务端插件
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 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("forge") Then .Loaders.Add(ModLoaderTypes.Forge) : .ResourceType = ResourceTypes.Mod
If RawLoaders.Contains("neoforge") Then .Loaders.Add(ModLoaderTypes.NeoForge) : .ResourceType = ResourceTypes.Mod
If RawLoaders.Contains("fabric") Then .Loaders.Add(ModLoaderTypes.Fabric) : .ResourceType = ResourceTypes.Mod
If RawLoaders.Contains("quilt") Then .Loaders.Add(ModLoaderTypes.Quilt) : .ResourceType = ResourceTypes.Mod
For Each Loader As ModLoaders In EnumUtils.GetAllFlags(Of ModLoaders)()
If RawLoaders.Contains(Loader.ToString.Lower) Then .ModLoaders = .ModLoaders Or Loader : .ResourceType = ResourceTypes.Mod
Next
Else
'使用传入的类别，不作修改（#8377）
End If
@@ -212,8 +209,8 @@ Public Class ResourceVersion
ElseIf .GameVersions.Count > 1 Then
.GameVersions = .GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
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
.GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")).ToList
ElseIf RawVersions.Any(Function(v) v.RegexCheck("[0-9]{2}w[0-9]{2}[a-z]")) Then
.GameVersions = RawVersions.Where(Function(v) v.RegexCheck("[0-9]{2}w[0-9]{2}[a-z]")).ToList
Else
.GameVersions = New List(Of String) From {"未知版本"}
End If
@@ -230,7 +227,7 @@ Public Class ResourceVersion
Dim TargetProject = ResourceProject.FromProjectId(ProjectId, Platform)
'获取项目对象的文件列表
If Not ProjectFilesCache.ContainsKey(ProjectId) Then
Log("[Resource] 开始获取项目版本列表：" & ProjectId)
Logger.Info($"开始获取项目版本列表：{ProjectId}")
Dim ResultJsonArray As JArray = Nothing
If Platform = ResourcePlatforms.CurseForge Then
For RetryCount As Integer = 0 To 2
@@ -247,10 +244,10 @@ Public Class ResourceVersion
ResultJsonArray = ResultJson("data")
Exit For
ElseIf RetryCount < 2 Then
Log($"[Resource] CurseForge 返回的资源版本列表存在缺失，即将进行第 {RetryCount + 1} 次重试", NotifyLevel.DebugModeOnly) '#6224
Log($"[Resource] 返回的原始内容如下：{vbCrLf}{ResultJson}")
Logger.Warn($"CurseForge 返回的资源版本列表存在缺失，即将进行第 {RetryCount + 1} 次重试") '#6224
Logger.Info($"返回的原始内容如下：{vbCrLf}{ResultJson}")
Else
Log($"[Resource] CurseForge 返回的资源版本列表存在缺失，返回的原始内容如下：{vbCrLf}{ResultJson}")
Logger.Info($"CurseForge 返回的资源版本列表存在缺失，返回的原始内容如下：{vbCrLf}{ResultJson}")
Throw New Exception("CurseForge 返回的资源版本列表存在缺失")
End If
Next
@@ -266,7 +263,7 @@ Public Class ResourceVersion
'加载前置信息
Dim Dependencies As List(Of String) = Result.SelectMany(Function(f) f.RawDependencies).Distinct().ToList
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 File In Result
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
Dim Result As New ResourceVersion
With Result
.ResourceType = CType(Data("ResourceType").ToObject(Of Integer), ResourceTypes)
.ResourceType = Data("ResourceType").ToObject(Of ResourceTypes)
.Id = Data("Id").ToString
.Display = Data("DisplayName").ToString
If Data.ContainsKey("Version") Then .Version = Data("Version").ToString
.ReleaseDate = Data("ReleaseDate").ToObject(Of Date)
.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("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("Hash") Then .Hash = Data("Hash").ToString
If Data.ContainsKey("GameVersions") Then .GameVersions = Data("GameVersions").ToObject(Of List(Of String))
@@ -320,7 +317,7 @@ Public Class ResourceVersion
.Add("DisplayName", Display)
.Add("ReleaseDate", ReleaseDate)
.Add("DownloadCount", DownloadCount)
.Add("ModLoaders", New JArray(Loaders.Select(Function(m) CInt(m))))
.Add("ModLoaders", ModLoaders)
.Add("GameVersions", New JArray(GameVersions))
.Add("ReleaseType", CInt(ReleaseType))
If FileName IsNot Nothing Then .Add("FileName", FileName)
@@ -383,10 +380,35 @@ Public Class ResourceVersion
''' 获取下载信息。
''' </summary>
''' <param name="LocalFileOrFolder">目标本地文件夹，或完整的文件路径。会自动判断类型。</param>
Public Function ToNetFile(LocalFileOrFolder As String) As NetFile
Return New NetFile(DownloadUrls, LocalFileOrFolder & If(LocalFileOrFolder.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash, ActualSize:=Size), SimulateBrowserHeaders:=True)
Public Function ToNetFile(LocalFileOrFolder As String,
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
''' <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 的下载地址。
''' </summary>
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
'实际加载
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
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
If Line = "" Then Continue For
For Each EntryData As String In Line.Split("¨")
Dim Entry = New WikiEntry
Dim Splited = EntryData.Split("|")
Entry.Popularity = Val(Splited(0))
If Splited(1).StartsWithF("@") Then
If Splited(0).StartsWithF("@") Then
Entry.CurseForgeSlug = Nothing
Entry.ModrinthSlug = Splited(1).Replace("@", "")
ElseIf Splited(1).EndsWithF("@") Then
Entry.CurseForgeSlug = Splited(1).TrimEnd("@")
Entry.ModrinthSlug = Splited(0).Replace("@", "")
ElseIf Splited(0).EndsWithF("@") Then
Entry.CurseForgeSlug = Splited(0).TrimEnd("@")
Entry.ModrinthSlug = Entry.CurseForgeSlug
ElseIf Splited(1).Contains("@") Then
Entry.CurseForgeSlug = Splited(1).Split("@")(0)
Entry.ModrinthSlug = Splited(1).Split("@")(1)
ElseIf Splited(0).Contains("@") Then
Entry.CurseForgeSlug = Splited(0).Split("@")(0)
Entry.ModrinthSlug = Splited(0).Split("@")(1)
Else
Entry.CurseForgeSlug = Splited(1)
Entry.CurseForgeSlug = Splited(0)
Entry.ModrinthSlug = Nothing
End If
Entry.Id = i
If Splited.Count >= 3 Then
Entry.Popularity = Val(Ranks(i - 1))
If Splited.Count >= 2 Then
Entry.ChineseName = Splited.Last
If Entry.ChineseName.Contains("*") Then '处理 *
Entry.ChineseName = Entry.ChineseName.Replace("*",
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: AssemblyFileVersion("2.12.7.3")>
<Assembly: AssemblyVersion("2.12.8.0")>
<Assembly: AssemblyFileVersion("2.12.8.0")>
<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
'''<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>
Friend ReadOnly Property ModData() As Byte()
Friend ReadOnly Property ModData() As String
Get
Dim obj As Object = ResourceManager.GetObject("ModData", resourceCulture)
Return CType(obj,Byte())
Return ResourceManager.GetString("ModData", resourceCulture)
End Get
End Property
@@ -240,16 +253,6 @@ Namespace My.Resources
End Get
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>
''' 查找 System.Byte[] 类型的本地化资源。
'''</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>
</data>
<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 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>
@@ -172,9 +172,6 @@
<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>
</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">
<value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</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))("分析原版支持库文件（副加载器）",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Thread.Sleep(50) '等待 JSON 文件实际写入硬盘（#3710）
Log("[Download] 开始分析原版支持库文件：" & VersionFolder)
Logger.Info($"开始分析原版支持库文件：{VersionFolder}")
Task.Output = McLibNetFilesFromInstance(New McInstance(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载原版支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False})
@@ -47,7 +47,7 @@
End Try
'顺手添加 Json 项目
Try
Dim InstanceJson As JObject = GetJson(ReadFile(VersionFolder & InstanceName & ".json"))
Dim InstanceJson As JObject = GetJson(FileUtils.ReadAsString(VersionFolder & InstanceName & ".json"))
InstanceJson.Add("clientVersion", Id)
FileUtils.Write($"{VersionFolder}{InstanceName}.json", InstanceJson.ToString)
Catch ex As Exception
@@ -158,8 +158,8 @@
Try
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Return
Dim VersionFolder As String = Dialogs.SelectFolder("选择目标文件夹", False).FirstOrDefault
If VersionFolder Is Nothing Then Return
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
@@ -180,8 +180,8 @@
'分析服务端 JAR 文件下载地址
Dim Instance As New McInstance(VersionFolder)
If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("server") Is Nothing OrElse Instance.JsonObject("downloads")("server")("url") Is Nothing Then
File.Delete(VersionFolder & Id & ".json")
If Not New DirectoryInfo(VersionFolder).GetFileSystemInfos.Any() Then DeleteDirectory(VersionFolder)
FileUtils.Delete(VersionFolder & Id & ".json")
If Not DirectoryUtils.GetInfo(VersionFolder).GetFileSystemInfos.Any() Then DirectoryUtils.Delete(VersionFolder)
Task.Output = New List(Of NetFile)
Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载，没法下，撤退！", HintType.Red)
Thread.Sleep(2000) '等玩家把上一个提示看完
@@ -207,7 +207,7 @@ pause"
FileUtils.Write(VersionFolder & "Launch Server.bat", Bat,
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
'删除版本 JSON
File.Delete(VersionFolder & Id & ".json")
FileUtils.Delete(VersionFolder & Id & ".json")
End Sub) With {.ProgressWeight = 0.5, .Show = False})
'下载服务端文件
Loaders.Add(New LoaderDownload("下载服务端文件", New List(Of NetFile)) With {.ProgressWeight = 5})
@@ -219,7 +219,7 @@ pause"
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 服务端下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 Minecraft 服务端下载失败")
End Try
End Sub
Public Sub McDownloadMenuSave(sender As Object, e As RoutedEventArgs)
@@ -234,8 +234,8 @@ pause"
Try
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Return
Dim VersionFolder As String = Dialogs.SelectFolder("选择目标文件夹", False).FirstOrDefault
If VersionFolder Is Nothing Then Return
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
@@ -264,7 +264,7 @@ pause"
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 Minecraft 下载失败")
End Try
End Sub
''' <summary>
@@ -323,7 +323,7 @@ pause"
ElseIf Id.StartsWithF("rd-") Then
WikiName = "Java版Pre-classic_" & Id
Else
Log("[Error] 未知的版本格式：" & Id & "。", NotifyLevel.MsgBoxAndFeedback)
Logger.Error($"未知的版本格式：{Id}。")
Return
End If
OpenWebsite("https://zh.minecraft.wiki/w/" & WikiName.Replace("_experimental-snapshot-", "-exp"))
@@ -336,8 +336,8 @@ pause"
Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry)
Try
Dim Id As String = DownloadInfo.InstanceName
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName, "OptiFine Jar (*.jar)|*.jar")
If Not Target.Contains("\") Then Return
Dim Target As String = Dialogs.SaveFile("选择保存位置", DownloadInfo.FileName, filter:={("jar", "OptiFine Jar")})
If Target Is Nothing Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -353,7 +353,7 @@ pause"
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 OptiFine 下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 OptiFine 下载失败")
End Try
End Sub
Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean), UseJavaWrapper As Boolean)
@@ -380,7 +380,7 @@ pause"
End SyncLock
'添加 Java Wrapper 作为主 Jar
Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get("LaunchAdvanceDisableJLW") Then
If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" -jar ""{ExtractPatch("JavaWrapper")}"" optifine.Installer"
Else
Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer"
@@ -395,14 +395,14 @@ pause"
.CreateNoWindow = True,
.RedirectStandardError = True,
.RedirectStandardOutput = True,
.WorkingDirectory = FileUtils.ShortenPath(BaseMcFolderHome)
.WorkingDirectory = PathUtils.ToShortPath(BaseMcFolderHome)
}
If Info.EnvironmentVariables.ContainsKey("appdata") Then
Info.EnvironmentVariables("appdata") = BaseMcFolderHome
Else
Info.EnvironmentVariables.Add("appdata", BaseMcFolderHome)
End If
Log("[Download] 开始安装 OptiFine：" & Target)
Logger.Info($"开始安装 OptiFine：{Target}")
Dim TotalLength As Integer = 0
Dim process As New Process With {.StartInfo = Info}
Dim LastResult As String = ""
@@ -415,17 +415,17 @@ pause"
outputWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
Logger.Trace(LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器信息失败")
Logger.Warn(ex, "读取 OptiFine 安装器信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消，已中止 OptiFine 安装")
Logger.Info("由于任务取消，已中止 OptiFine 安装")
process.Kill()
End If
Catch
@@ -439,17 +439,17 @@ pause"
errorWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
Logger.Trace(LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器错误信息失败")
Logger.Warn(ex, "读取 OptiFine 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消，已中止 OptiFine 安装")
Logger.Info("由于任务取消，已中止 OptiFine 安装")
process.Kill()
End If
Catch
@@ -507,10 +507,10 @@ pause"
PageData = NetRequestByClientRetry("https://optifine.net/adloadx?f=" & DownloadInfo.FileName,
Encoding:=New UTF8Encoding(False), Accept:="text/html", SimulateBrowserHeaders:=True)
Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.DisplayName & " 官方下载地址：" & Sources.Last)
Sources.Add("https://optifine.net/" & PageData.RegexSearch("downloadx\?f=[^""']+").First)
Logger.Info($"OptiFine {DownloadInfo.DisplayName} 官方下载地址：{Sources.Last}")
Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.DisplayName & " 官方下载地址失败")
Logger.Warn(ex, $"获取 OptiFine {DownloadInfo.DisplayName} 官方下载地址失败")
End Try
'构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))}
@@ -522,43 +522,43 @@ pause"
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Any Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
If TargetLoaders.Any Then Logger.Info("OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsInterrupted Then Return
'拷贝原版文件
'复制原版文件
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Dim ClientName As String = PathUtils.GetLastPart(ClientFolder)
DirectoryUtils.Create(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json")
If Not FileUtils.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
FileUtils.Copy($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json")
End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar")
If Not FileUtils.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
FileUtils.Copy($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar")
End If
End SyncLock
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'安装（新旧方式均需要原版 Jar 和 Json）
If IsNewerVersion Then
Log("[Download] 检测为新版 OptiFine：" & DownloadInfo.Inherit)
Logger.Info($"检测为新版 OptiFine：{DownloadInfo.Inherit}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine（方式 A）",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim BaseMcFolderHome As String = RequestTaskTempFolder()
Dim BaseMcFolder As String = BaseMcFolderHome & ".minecraft\"
Try
'准备安装环境
If Directory.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then
DeleteDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit)
If DirectoryUtils.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then
DirectoryUtils.Delete(BaseMcFolder & "versions\" & DownloadInfo.Inherit)
End If
DirectoryUtils.Create(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\")
McFolderLauncherProfilesJsonCreate(BaseMcFolder)
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json",
FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar",
FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
Task.Progress = 0.06
'进行安装
@@ -568,7 +568,7 @@ Retry:
McDownloadOptiFineInstall(BaseMcFolderHome, Target, Task, UseJavaWrapper)
Catch ex As Exception
If UseJavaWrapper Then
Log(ex, "使用 JavaWrapper 安装 OptiFine 失败，将不使用 JavaWrapper 并重试")
Logger.Warn(ex, "使用 JavaWrapper 安装 OptiFine 失败，将不使用 JavaWrapper 并重试")
UseJavaWrapper = False
GoTo Retry
Else
@@ -577,27 +577,23 @@ Retry:
End Try
Task.Progress = 0.96
'复制文件
File.Delete(BaseMcFolder & "launcher_profiles.json")
CopyDirectory(BaseMcFolder, McFolder)
FileUtils.Delete(BaseMcFolder & "launcher_profiles.json")
DirectoryUtils.Copy(BaseMcFolder, McFolder)
Task.Progress = 0.98
'清理文件
File.Delete(Target)
DeleteDirectory(BaseMcFolderHome)
FileUtils.Delete(Target)
DirectoryUtils.Delete(BaseMcFolderHome)
Catch ex As Exception
Throw New Exception("安装 OptiFine（方式 A）失败", ex)
End Try
End Sub) With {.ProgressWeight = 8})
Else
Log("[Download] 检测为旧版 OptiFine：" & DownloadInfo.Inherit)
Logger.Info($"检测为旧版 OptiFine：{DownloadInfo.Inherit}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine（方式 B）",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Try
'新建版本文件夹
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.1
'复制 Jar 文件
If File.Exists(VersionFolder & Id & ".jar") Then File.Delete(VersionFolder & Id & ".jar")
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar")
FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar")
Task.Progress = 0.7
'建立 Json 文件
Dim InheritInstance As New McInstance(McFolder & "versions\" & DownloadInfo.Inherit)
@@ -663,10 +659,10 @@ Retry:
PageData = NetRequestByClientRetry("https://optifine.net/adloadx?f=" & DownloadInfo.FileName,
Encoding:=New UTF8Encoding(False), Accept:="text/html", SimulateBrowserHeaders:=True)
Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.DisplayName & " 官方下载地址：" & Sources.Last)
Sources.Add("https://optifine.net/" & PageData.RegexSearch("downloadx\?f=[^""']+").First)
Logger.Info($"OptiFine {DownloadInfo.DisplayName} 官方下载地址：{Sources.Last}")
Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.DisplayName & " 官方下载地址失败")
Logger.Warn(ex, $"获取 OptiFine {DownloadInfo.DisplayName} 官方下载地址失败")
End Try
Task.Progress = 0.9
'构造文件请求
@@ -753,8 +749,8 @@ Retry:
Private Sub McDownloadLiteLoaderSave(DownloadInfo As DlLiteLoaderListEntry)
Try
Dim Id As String = DownloadInfo.Inherit
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), "LiteLoader 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Return
Dim Target As String = Dialogs.SaveFile("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), filter:={("jar", "LiteLoader 安装器")})
If Target Is Nothing Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -796,7 +792,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 LiteLoader 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 LiteLoader 安装器下载失败")
End Try
End Sub
@@ -920,10 +916,10 @@ Retry:
Public Sub McDownloadForgelikeSave(Info As DlForgelikeEntry)
Try
Dim Target As String = SelectSaveFile("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
$"{Info.LoaderName} 安装器 (*.{Info.FileExtension})|*.{Info.FileExtension}")
Dim Target As String = Dialogs.SaveFile("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
filter:={(Info.FileExtension, $"{Info.LoaderName} 安装器")})
If Target Is Nothing Then Return
Dim DisplayName As String = $"{Info.LoaderName} {Info.Inherit} - {Info.VersionName}"
If Not Target.Contains("\") Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -962,7 +958,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, $"开始 {Info.LoaderName} 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"开始 {Info.LoaderName} 安装器下载失败")
End Try
End Sub
@@ -990,7 +986,7 @@ Retry:
End SyncLock
'添加 Java Wrapper 作为主 Jar
Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get("LaunchAdvanceDisableJLW") Then
If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractPatch("JavaWrapper")}"" com.bangbang93.ForgeInstaller ""{McFolder}"
Else
Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}"
@@ -1007,7 +1003,7 @@ Retry:
.RedirectStandardOutput = True
}
Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge")
Log($"[Download] 开始安装 {LoaderName}：" & Arguments)
Logger.Info($"开始安装 {LoaderName}：{Arguments}")
Dim process As New Process With {.StartInfo = Info}
Dim LastResults As New Queue(Of String)
Using outputWaitHandle As New AutoResetEvent(False)
@@ -1024,11 +1020,11 @@ Retry:
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, $"读取 {LoaderName} 安装器信息失败")
Logger.Warn(ex, $"读取 {LoaderName} 安装器信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log($"[Installer] 由于任务取消，已中止 {LoaderName} 安装")
Logger.Info($"由于任务取消，已中止 {LoaderName} 安装")
process.Kill()
End If
Catch
@@ -1047,11 +1043,11 @@ Retry:
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, $"读取 {LoaderName} 安装器错误信息失败")
Logger.Warn(ex, $"读取 {LoaderName} 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log($"[Installer] 由于任务取消，已中止 {LoaderName} 安装")
Logger.Info($"由于任务取消，已中止 {LoaderName} 安装")
process.Kill()
End If
Catch
@@ -1071,7 +1067,7 @@ Retry:
process.Dispose()
'检查是否安装成功：最后 5 行中是否有 true（true 可能在倒数数行，见 #832）
If LastResults.Reverse().Take(5).Any(Function(l) l = "true") Then Return
Log(LastResults.Join(vbCrLf))
Logger.Warn(LastResults.Join(vbCrLf))
Dim LastLines As String = ""
For i As Integer = Math.Max(0, LastResults.Count - 5) To LastResults.Count - 1 '最后 5 行
LastLines &= vbCrLf & LastResults(i)
@@ -1084,13 +1080,10 @@ Retry:
Private Sub ForgelikeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean))
Select Case Content
Case "Extracting json"
Log("[Installer] " & Content)
Task.Progress = 0.07
Case "Downloading libraries"
Log("[Installer] " & Content)
Task.Progress = 0.08
Case " File exists: Checksum validated."
If ModeDebug Then Log("[Installer] " & Content)
Task.Progress += 0.003
Case "Building Processors"
Task.Progress = 0.18
@@ -1117,10 +1110,10 @@ Retry:
Case "Injecting profile"
Task.Progress = 0.91
Case Else
If ModeDebug Then Log("[Installer] " & Content)
Logger.Trace(Content)
Return
End Select
Log("[Installer] " & Content)
Logger.Info(Content)
End Sub
''' <summary>
@@ -1197,18 +1190,18 @@ Retry:
'安装（仅在新版安装时需要原版 Jar）
If IsNeoForge OrElse LoaderVersion.BeforeFirst(".") >= 20 Then
Log($"[Download] 检测为{If(IsNeoForge, " Neo", "新版 ")}Forge：" & LoaderVersion)
Dim Libs As List(Of McLibToken) = Nothing
Logger.Info($"检测为{If(IsNeoForge, " Neo", "新版 ")}Forge：{LoaderVersion}")
Dim Libs As List(Of McLibEntry) = Nothing
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = New List(Of NetFile)
Dim Installer As ZipArchive = Nothing
Try
'解压并获取、合并两个 Json 的信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Installer = FileUtils.OpenZip(InstallerAddress)
Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open))
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
Dim Json2 As JObject = GetJson(Installer.GetEntry("version.json").Open().ReadString)
Json.Merge(Json2)
'获取 Lib 下载信息
Libs = McLibListGetWithJson(Json, True)
@@ -1221,17 +1214,17 @@ Retry:
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).BeforeFirst("@")
Dim Address = McLibGet(OriginalName).Replace(".jar", "." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Dim ClientMappings As JToken = RawJson("downloads")("client_mappings")
Libs.Add(New McLibToken With {
Libs.Add(New McLibEntry With {
.IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.Url = ClientMappings("url"), .Size = ClientMappings("size"), .SHA1 = ClientMappings("sha1")})
Log($"[Download] 需要下载 Mappings：{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})")
Logger.Info($"需要下载 Mappings：{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})")
End If
Task.Progress = 0.8
'去除其中的原始 Forgelike 项
For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}.jar") OrElse
Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}-client.jar") Then
Log($"[Download] 已从待下载 {LoaderName} 支持库中移除：" & Libs(i).LocalPath, NotifyLevel.DebugModeOnly)
Logger.Warn($"已从待下载 {LoaderName} 支持库中移除：{Libs(i).LocalPath}")
Libs.RemoveAt(i)
Exit For
End If
@@ -1240,7 +1233,6 @@ Retry:
Catch ex As Exception
Throw New Exception($"获取{If(IsNeoForge, " Neo", "新版 ")}Forge 支持库列表失败", ex)
Finally
'释放文件
If Installer IsNot Nothing Then Installer.Dispose()
End Try
End Sub) With {.ProgressWeight = 1})
@@ -1249,13 +1241,10 @@ Retry:
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
#Region "Forgelike 文件"
If IsCustomFolder Then
For Each LibFile As McLibToken In Libs
For Each LibFile As McLibEntry In Libs
Dim RealPath As String = LibFile.LocalPath.Replace(McFolderSelected, McFolder)
If Not File.Exists(RealPath) Then
DirectoryUtils.Create(RealPath, isFilePath:=True)
CopyFile(LibFile.LocalPath, RealPath)
End If
If ModeDebug Then Log($"[Download] 复制的 {LoaderName} 支持库文件：" & LibFile.LocalPath)
If Not FileUtils.Exists(RealPath) Then FileUtils.Copy(LibFile.LocalPath, RealPath)
Logger.Trace($"复制的 {LoaderName} 支持库文件：{LibFile.LocalPath}")
Next
End If
#End Region
@@ -1264,22 +1253,22 @@ Retry:
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList()
If TargetLoaders.Any Then Log($"[Download] {LoaderName} 安装正在等待原版文件下载完成")
If TargetLoaders.Any Then Logger.Info($"{LoaderName} 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsInterrupted Then Return
'拷贝原版文件
'复制原版文件
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Dim ClientName As String = PathUtils.GetLastPart(ClientFolder)
DirectoryUtils.Create(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
If Not FileUtils.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
FileUtils.Copy(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
CopyFile(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
If Not FileUtils.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
FileUtils.Copy(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
End If
End SyncLock
#End Region
@@ -1288,12 +1277,12 @@ Retry:
Sub(Task As LoaderTask(Of Boolean, Boolean))
Dim Installer As ZipArchive = Nothing
Try
Log($"[Download] 开始进行 Forgelike 安装：" & InstallerAddress)
Logger.Info($"开始进行 Forgelike 安装：{InstallerAddress}")
'记录当前文件夹列表（在新建目标文件夹之前）
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(i) i.FullName).ToList()
Dim OldList = DirectoryUtils.GetDirectories(McFolder & "versions\", True).ToList()
'解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Installer = FileUtils.OpenZip(InstallerAddress)
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
'新建目标版本文件夹
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.04
@@ -1305,23 +1294,23 @@ Retry:
Retry:
Try
'释放 Forge 注入器
FileUtils.Write(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
ExtractResources(PathTemp & "Cache\forge_installer.jar", "ForgeInstaller")
Task.Progress = 0.06
'运行注入器
ForgelikeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper, IsNeoForge)
Task.Progress = 0.97
Catch ex As Exception
If UseJavaWrapper Then
Log(ex, $"使用 JavaWrapper 安装 {LoaderName} 失败，将不使用 JavaWrapper 并重试")
Logger.Warn(ex, $"使用 JavaWrapper 安装 {LoaderName} 失败，将不使用 JavaWrapper 并重试")
UseJavaWrapper = False
GoTo Retry
Else
Throw New Exception($"运行 {LoaderName} 安装器失败", ex)
End If
End Try
'拷贝新增的版本 Json
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
'复制新增的版本 Json
Dim DeltaList = DirectoryUtils.GetDirectories(McFolder & "versions\", True).
SkipWhile(Function(i) OldList.Contains(i)).Select(Function(f) DirectoryUtils.GetInfo(f)).ToList()
If DeltaList.Count > 1 Then
'它可能和 OptiFine 安装同时运行，导致增加的文件不止一个（这导致了 #151）
'也可能是因为 Forge 安装器的 Bug，生成了一个名字错误的文件夹，所以需要检查文件夹是否为空
@@ -1329,62 +1318,61 @@ Retry:
End If
If DeltaList.Count = 1 Then
'如果没有新增文件夹，那么预测的文件夹名就是正确的
'如果只新增 1 个文件夹，那么拷贝 json 文件
'如果只新增 1 个文件夹，那么复制 json 文件
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
FileUtils.Write(VersionFolder & NewInstanceName & ".json", ReadFile(JsonFile.FullName))
Log($"[Download] 已拷贝新增的版本 JSON 文件：{JsonFile.FullName} -> {VersionFolder}{NewInstanceName}.json")
FileUtils.Copy(JsonFile.FullName, VersionFolder & NewInstanceName & ".json")
Logger.Info($"已复制新增的版本 JSON 文件：{JsonFile.FullName} -> {VersionFolder}{NewInstanceName}.json")
ElseIf DeltaList.Count > 1 Then
'新增了多个文件夹
Log($"[Download] 有多个疑似的新增版本，无法确定：{DeltaList.Select(Function(d) d.Name).Join(";")}")
Logger.Info($"有多个疑似的新增版本，无法确定：{DeltaList.Select(Function(d) d.Name).Join(";")}")
Else
'没有新增文件夹
Log("[Download] 未找到新增的版本文件夹")
Logger.Info("未找到新增的版本文件夹")
End If
Catch ex As Exception
Throw New Exception($"安装新 {LoaderName} 版本失败", ex)
Finally
'清理文件
Try
If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
Installer?.Dispose()
FileUtils.Delete(InstallerAddress)
Catch ex As Exception
Log(ex, $"安装 {LoaderName} 清理文件时出错")
Logger.Warn(ex, $"安装 {LoaderName} 清理文件时出错")
End Try
End Try
End Sub) With {.ProgressWeight = 10})
Else
Log("[Download] 检测为非新版 Forge：" & LoaderVersion)
Logger.Info($"检测为非新版 Forge：{LoaderVersion}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"安装 {LoaderName}（方式 B）",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim Installer As ZipArchive = Nothing
Try
'解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Installer = FileUtils.OpenZip(InstallerAddress)
Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
Task.Progress = 0.4
'新建版本文件夹
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.5
If Json("install") Is Nothing Then
'中版：Legacy 方式 1
Log("[Download] 开始进行 Forge 安装，Legacy 方式 1：" & InstallerAddress)
Logger.Info($"开始进行 Forge 安装，Legacy 方式 1：{InstallerAddress}")
'建立 Json 文件
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
Dim JsonVersion As JObject = GetJson(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open().ReadString)
JsonVersion("id") = NewInstanceName
FileUtils.Write(VersionFolder & NewInstanceName & ".json", JsonVersion.ToString)
Task.Progress = 0.6
'解压支持库文件
Installer.Dispose()
ExtractCompressedFile(InstallerAddress, InstallerAddress & "_unrar\")
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DeleteDirectory(InstallerAddress & "_unrar\")
FileUtils.ExtractToDirectory(InstallerAddress, InstallerAddress & "_unrar\")
If DirectoryUtils.Exists(InstallerAddress & "_unrar\maven\") Then DirectoryUtils.Copy(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DirectoryUtils.Delete(InstallerAddress & "_unrar\")
Else
'旧版：Legacy 方式 2
Log("[Download] 开始进行 Forge 安装，Legacy 方式 2：" & InstallerAddress)
Logger.Info($"开始进行 Forge 安装，Legacy 方式 2：{InstallerAddress}")
'解压 Jar 文件
Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
If File.Exists(JarAddress) Then File.Delete(JarAddress)
FileUtils.Write(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
Task.Progress = 0.9
'建立 Json 文件
@@ -1398,10 +1386,10 @@ Retry:
Try
'清理文件
If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
FileUtils.Delete(InstallerAddress)
DirectoryUtils.Delete(InstallerAddress & "_unrar\")
Catch ex As Exception
Log(ex, "非新版方式安装 Forge 清理文件时出错")
Logger.Warn(ex, "非新版方式安装 Forge 清理文件时出错")
End Try
End Try
End Sub) With {.ProgressWeight = 1})
@@ -1422,7 +1410,7 @@ Retry:
If Entries.Any Then
FreshVersion = Entries(0)
Else
Log("[System] 未找到可用的 Forge 版本")
Logger.Info("未找到可用的 Forge 版本")
End If
Dim RecommendedVersion As DlForgeVersionEntry = Nothing
For Each Entry In Entries
@@ -1522,7 +1510,7 @@ Retry:
RunInNewThread(
Sub()
Try
Log("[Download] 刷新 Forge 推荐版本缓存开始")
Logger.Info("刷新 Forge 推荐版本缓存开始")
Dim Result As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/promos", RequireJson:=True)
If Result.Length < 1000 Then Throw New Exception("获取的结果过短（" & Result & "）")
Dim ResultJson As JContainer = GetJson(Result)
@@ -1539,9 +1527,9 @@ Retry:
'保存
Dim CacheJson As String = "{" & RecommendedList.Join(",") & "}"
FileUtils.Write(PathTemp & "Cache\ForgeRecommendedList.json", CacheJson)
Log("[Download] 刷新 Forge 推荐版本缓存成功")
Logger.Info("刷新 Forge 推荐版本缓存成功")
Catch ex As Exception
Log(ex, "刷新 Forge 推荐版本缓存失败")
Logger.Warn(ex, "刷新 Forge 推荐版本缓存失败")
End Try
End Sub, "ForgeRecommendedRefresh")
End Sub
@@ -1553,16 +1541,16 @@ Retry:
Public Function McDownloadForgeRecommendedGet(McVersion As String) As String
Try
If McVersion Is Nothing Then Return Nothing
Dim List As String = ReadFile(PathTemp & "Cache\ForgeRecommendedList.json")
If List Is Nothing OrElse List = "" Then
Log("[Download] 没有 Forge 推荐版本缓存文件")
Dim List As String = FileUtils.TryReadAsString(PathTemp & "Cache\ForgeRecommendedList.json")
If String.IsNullOrEmpty(List) Then
Logger.Info("没有 Forge 推荐版本缓存文件")
Return Nothing
End If
Dim Json As JObject = GetJson(List)
If Json Is Nothing OrElse (Not If(McVersion, "").Contains(".")) OrElse Not Json.ContainsKey(McVersion) Then Return Nothing
Return If(Json(McVersion), "").ToString
Catch ex As Exception
Log(ex, "获取 Forge 推荐版本失败（" & If(McVersion, "null") & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"获取 Forge 推荐版本失败（{If(McVersion, "null")}）")
Return Nothing
End Try
End Function
@@ -1587,7 +1575,7 @@ Retry:
End If
Next
Else
Log("[System] 未找到可用的 NeoForge 版本", NotifyLevel.DebugModeOnly)
Logger.Warn("未找到可用的 NeoForge 版本")
End If
'显示各个版本
If FreshStableVersion IsNot Nothing Then
@@ -1674,10 +1662,10 @@ Retry:
Public Sub McDownloadFabricLoaderSave(DownloadInfo As JObject)
Try
Dim Url As String = DownloadInfo("url").ToString
Dim FileName As String = GetFileNameFromPath(Url)
Dim Version As String = GetFileNameFromPath(DownloadInfo("version").ToString)
Dim Target As String = SelectSaveFile("选择保存位置", FileName, "Fabric 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Return
Dim FileName As String = PathUtils.GetLastPart(Url)
Dim Version As String = PathUtils.GetLastPart(DownloadInfo("version").ToString)
Dim Target As String = Dialogs.SaveFile("选择保存位置", FileName, filter:={("jar", "Fabric 安装器")})
If Target Is Nothing Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -1701,7 +1689,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Fabric 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 Fabric 安装器下载失败")
End Try
End Sub
@@ -1860,7 +1848,7 @@ Retry:
Case LoadState.Finished
Hint(Loader.Name & "成功！", HintType.Green)
Case LoadState.Failed
Hint(Loader.Name & "失败：" & Loader.Error.GetBrief(), HintType.Red)
Hint(Loader.Name & "失败：" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted
Hint(Loader.Name & "已取消！", HintType.Blue)
End Select
@@ -1875,7 +1863,7 @@ Retry:
Hint(Loader.Name & "成功！", HintType.Green)
'TODO: 自动选择安装成功的版本
Case LoadState.Failed
MyMsgBox(Loader.Error.GetDetail, Loader.Name & "失败", IsWarn:=True)
MyMsgBox(Loader.Error.GetDisplay(True), Loader.Name & "失败", IsWarn:=True)
Case LoadState.Interrupted
Hint(Loader.Name & "已取消！", HintType.Blue)
Case LoadState.Loading
@@ -1889,15 +1877,15 @@ Retry:
Thread.Sleep(1000) '防止存在尚未完全释放的文件，导致清理失败（例如整合包安装）
If Loader.State = LoadState.Failed OrElse Loader.State = LoadState.Interrupted Then
'删除版本文件夹
If Directory.Exists(Loader.Input & "saves\") OrElse Directory.Exists(Loader.Input & "versions\") Then
Log("[Download] 由于版本已被独立启动，不清理版本文件夹：" & Loader.Input, NotifyLevel.DevelopOnly)
If DirectoryUtils.Exists(Loader.Input & "saves\") OrElse DirectoryUtils.Exists(Loader.Input & "versions\") Then
Logger.Warn($"由于版本已被独立启动，不清理版本文件夹：{Loader.Input}")
Else
Log("[Download] 由于下载失败或取消，清理版本文件夹：" & Loader.Input, NotifyLevel.DevelopOnly)
DeleteDirectory(Loader.Input)
Logger.Warn($"由于下载失败或取消，清理版本文件夹：{Loader.Input}")
DirectoryUtils.Delete(Loader.Input)
End If
End If
Catch ex As Exception
Log(ex, "下载失败或取消后清理版本文件夹失败")
Logger.Warn(ex, "下载失败或取消后清理版本文件夹失败")
End Try
End Sub
@@ -1920,7 +1908,7 @@ Retry:
Catch ex As CancelledException
Return False
Catch ex As Exception
Log(ex, "开始合并安装失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始合并安装失败")
Return False
End Try
End Function
@@ -1934,7 +1922,7 @@ Retry:
'获取参数
Dim VersionFolder As String = McFolderSelected & "versions\" & Request.NewInstanceName & "\"
If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder)
If DirectoryUtils.Exists(TempMcFolder) Then DirectoryUtils.Delete(TempMcFolder)
Dim OptiFineFolder As String = Nothing
If Request.OptiFineVersion IsNot Nothing Then
If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.AfterLast("_HD_U_") '#735
@@ -1964,7 +1952,7 @@ Retry:
Dim ModsTempFolder As String = TempMcFolder & "mods\"
Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso Modable '选择了 OptiFine 与任意 Mod 加载器
If OptiFineAsMod Then
Log("[Download] OptiFine 将作为 Mod 进行下载")
Logger.Info("OptiFine 将作为 Mod 进行下载")
If Request.LiteLoaderEntry IsNot Nothing Then
OptiFineFolder = ModsTempFolder & Request.MinecraftName & "\" '#8147
Else
@@ -1973,15 +1961,15 @@ Retry:
End If
'记录日志
If OptiFineFolder IsNot Nothing Then Log("[Download] OptiFine 缓存：" & OptiFineFolder)
If ForgeFolder IsNot Nothing Then Log("[Download] Forge 缓存：" & ForgeFolder)
If NeoForgeFolder IsNot Nothing Then Log("[Download] NeoForge 缓存：" & NeoForgeFolder)
If FabricFolder IsNot Nothing Then Log("[Download] Fabric 缓存：" & FabricFolder)
If LiteLoaderFolder IsNot Nothing Then Log("[Download] LiteLoader 缓存：" & LiteLoaderFolder)
Log("[Download] 对应的原版版本：" & Request.MinecraftName)
If OptiFineFolder IsNot Nothing Then Logger.Info($"OptiFine 缓存：{OptiFineFolder}")
If ForgeFolder IsNot Nothing Then Logger.Info($"Forge 缓存：{ForgeFolder}")
If NeoForgeFolder IsNot Nothing Then Logger.Info($"NeoForge 缓存：{NeoForgeFolder}")
If FabricFolder IsNot Nothing Then Logger.Info($"Fabric 缓存：{FabricFolder}")
If LiteLoaderFolder IsNot Nothing Then Logger.Info($"LiteLoader 缓存：{LiteLoaderFolder}")
Logger.Info($"对应的原版版本：{Request.MinecraftName}")
'重复版本检查
If File.Exists($"{VersionFolder}{Request.NewInstanceName}.json") Then
If FileUtils.Exists($"{VersionFolder}{Request.NewInstanceName}.json") Then
Hint("版本 " & Request.NewInstanceName & " 已经存在！", HintType.Red)
Throw New CancelledException
End If
@@ -1991,11 +1979,11 @@ Retry:
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() FileUtils.Write(VersionFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
'Fabric API
If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsTempFolder, ResourceVersion.DownloadReason.Dependency, Request.MinecraftName, ModLoaders.Fabric)}) With {.ProgressWeight = 3, .Block = False})
End If
'OptiFabric
If Request.OptiFabric IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsTempFolder, ResourceVersion.DownloadReason.Dependency, Request.MinecraftName, ModLoaders.Fabric)}) With {.ProgressWeight = 3, .Block = False})
End If
'原版
Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.NewInstanceName)) With {.Show = False, .ProgressWeight = 39,
@@ -2038,19 +2026,19 @@ Retry:
MergeJson(VersionFolder, VersionFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.2
'迁移文件
If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", McFolderSelected & "libraries")
DirectoryUtils.Copy(TempMcFolder & "libraries", McFolderSelected & "libraries")
Task.Progress = 0.8
'创建 Mod 和资源包文件夹
Dim ModsFolder = New McInstance(VersionFolder).PathIndie & "mods\" '版本隔离信息在此时被决定
If Directory.Exists(ModsTempFolder) Then
CopyDirectory(ModsTempFolder, ModsFolder)
If DirectoryUtils.Exists(ModsTempFolder) Then
DirectoryUtils.Copy(ModsTempFolder, ModsFolder)
ElseIf Modable Then
DirectoryUtils.Create(ModsFolder)
Log("[Download] 自动创建 Mod 文件夹：" & ModsFolder)
Logger.Info($"自动创建 Mod 文件夹：{ModsFolder}")
End If
Dim ResourcepacksFolder = New McInstance(VersionFolder).PathIndie & "resourcepacks\"
DirectoryUtils.Create(ResourcepacksFolder)
Log("[Download] 自动创建资源包文件夹：" & ResourcepacksFolder)
Logger.Info($"自动创建资源包文件夹：{ResourcepacksFolder}")
End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件
If Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then
@@ -2060,7 +2048,7 @@ Retry:
LoaderList.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
End If
'删除忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() File.Delete(VersionFolder & ".pclignore")) With {.Show = False})
LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() FileUtils.Delete(VersionFolder & ".pclignore")) With {.Show = False})
'总加载器
Return LoaderList
End Function
@@ -2069,7 +2057,7 @@ Retry:
''' 将多个版本 JSON 进行合并，如果目标已存在则直接覆盖。失败会抛出异常。
''' </summary>
Private Sub MergeJson(OutputFolder As String, MinecraftFolder As String, Optional OptiFineFolder As String = Nothing, Optional OptiFineAsMod As Boolean = False, Optional ForgeFolder As String = Nothing, Optional ForgeVersion As String = Nothing, Optional NeoForgeFolder As String = Nothing, Optional NeoForgeVersion As String = Nothing, Optional FabricFolder As String = Nothing, Optional LiteLoaderFolder As String = Nothing)
Log("[Download] 开始进行版本合并，输出：" & OutputFolder & "，Minecraft：" & MinecraftFolder &
Logger.Info($"开始进行版本合并，输出：{OutputFolder}，Minecraft：{MinecraftFolder}" &
If(OptiFineFolder IsNot Nothing, "，OptiFine：" & OptiFineFolder, "") &
If(ForgeFolder IsNot Nothing, "，Forge：" & ForgeFolder, "") &
If(NeoForgeFolder IsNot Nothing, "，NeoForge：" & NeoForgeFolder, "") &
@@ -2083,78 +2071,78 @@ Retry:
Dim OutputJar As String, MinecraftJar As String
#Region "初始化路径信息"
If Not OutputFolder.EndsWithF("\") Then OutputFolder += "\"
OutputName = GetFolderNameFromPath(OutputFolder)
OutputName = PathUtils.GetLastPart(OutputFolder)
OutputJsonPath = OutputFolder & OutputName & ".json"
OutputJar = OutputFolder & OutputName & ".jar"
If Not MinecraftFolder.EndsWithF("\") Then MinecraftFolder += "\"
MinecraftName = GetFolderNameFromPath(MinecraftFolder)
MinecraftName = PathUtils.GetLastPart(MinecraftFolder)
MinecraftJsonPath = MinecraftFolder & MinecraftName & ".json"
MinecraftJar = MinecraftFolder & MinecraftName & ".jar"
If HasOptiFine Then
If Not OptiFineFolder.EndsWithF("\") Then OptiFineFolder += "\"
OptiFineName = GetFolderNameFromPath(OptiFineFolder)
OptiFineName = PathUtils.GetLastPart(OptiFineFolder)
OptiFineJsonPath = OptiFineFolder & OptiFineName & ".json"
End If
If HasForge Then
If Not ForgeFolder.EndsWithF("\") Then ForgeFolder += "\"
ForgeName = GetFolderNameFromPath(ForgeFolder)
ForgeName = PathUtils.GetLastPart(ForgeFolder)
ForgeJsonPath = ForgeFolder & ForgeName & ".json"
End If
If HasNeoForge Then
If Not NeoForgeFolder.EndsWithF("\") Then NeoForgeFolder += "\"
NeoForgeName = GetFolderNameFromPath(NeoForgeFolder)
NeoForgeName = PathUtils.GetLastPart(NeoForgeFolder)
NeoForgeJsonPath = NeoForgeFolder & NeoForgeName & ".json"
End If
If HasLiteLoader Then
If Not LiteLoaderFolder.EndsWithF("\") Then LiteLoaderFolder += "\"
LiteLoaderName = GetFolderNameFromPath(LiteLoaderFolder)
LiteLoaderName = PathUtils.GetLastPart(LiteLoaderFolder)
LiteLoaderJsonPath = LiteLoaderFolder & LiteLoaderName & ".json"
End If
If HasFabric Then
If Not FabricFolder.EndsWithF("\") Then FabricFolder += "\"
FabricName = GetFolderNameFromPath(FabricFolder)
FabricName = PathUtils.GetLastPart(FabricFolder)
FabricJsonPath = FabricFolder & FabricName & ".json"
End If
#End Region
Dim OutputJson As JObject, MinecraftJson As JObject, OptiFineJson As JObject = Nothing, ForgeJson As JObject = Nothing, NeoForgeJson As JObject = Nothing, LiteLoaderJson As JObject = Nothing, FabricJson As JObject = Nothing
#Region "读取文件并检查文件是否合规"
Dim MinecraftJsonText As String = ReadFile(MinecraftJsonPath)
Dim MinecraftJsonText As String = If(FileUtils.TryReadAsString(MinecraftJsonPath), "")
If Not MinecraftJsonText.StartsWithF("{") Then Throw New Exception("Minecraft json 有误，地址：" & MinecraftJsonPath & "，前段内容：" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000)))
MinecraftJson = GetJson(MinecraftJsonText)
If HasOptiFine Then
Dim OptiFineJsonText As String = ReadFile(OptiFineJsonPath)
Dim OptiFineJsonText As String = If(FileUtils.TryReadAsString(OptiFineJsonPath), "")
If Not OptiFineJsonText.StartsWithF("{") Then Throw New Exception("OptiFine json 有误，地址：" & OptiFineJsonPath & "，前段内容：" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000)))
OptiFineJson = GetJson(OptiFineJsonText)
End If
If HasForge Then
Dim ForgeJsonText As String = ReadFile(ForgeJsonPath)
Dim ForgeJsonText As String = If(FileUtils.TryReadAsString(ForgeJsonPath), "")
If Not ForgeJsonText.StartsWithF("{") Then Throw New Exception("Forge json 有误，地址：" & ForgeJsonPath & "，前段内容：" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000)))
ForgeJson = GetJson(ForgeJsonText)
End If
If HasNeoForge Then
Dim NeoForgeJsonText As String = ReadFile(NeoForgeJsonPath)
Dim NeoForgeJsonText As String = If(FileUtils.TryReadAsString(NeoForgeJsonPath), "")
If Not NeoForgeJsonText.StartsWithF("{") Then Throw New Exception("NeoForge json 有误，地址：" & NeoForgeJsonPath & "，前段内容：" & NeoForgeJsonText.Substring(0, Math.Min(NeoForgeJsonText.Length, 1000)))
NeoForgeJson = GetJson(NeoForgeJsonText)
End If
If HasLiteLoader Then
Dim LiteLoaderJsonText As String = ReadFile(LiteLoaderJsonPath)
Dim LiteLoaderJsonText As String = If(FileUtils.TryReadAsString(LiteLoaderJsonPath), "")
If Not LiteLoaderJsonText.StartsWithF("{") Then Throw New Exception("LiteLoader json 有误，地址：" & LiteLoaderJsonPath & "，前段内容：" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000)))
LiteLoaderJson = GetJson(LiteLoaderJsonText)
End If
If HasFabric Then
Dim FabricJsonText As String = ReadFile(FabricJsonPath)
Dim FabricJsonText As String = If(FileUtils.TryReadAsString(FabricJsonPath), "")
If Not FabricJsonText.StartsWithF("{") Then Throw New Exception("Fabric json 有误，地址：" & FabricJsonPath & "，前段内容：" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000)))
FabricJson = GetJson(FabricJsonText)
End If
@@ -2169,7 +2157,7 @@ Retry:
If(NeoForgeJson IsNot Nothing, If(NeoForgeJson("minecraftArguments"), " ").ToString, " ") & " " &
If(LiteLoaderJson IsNot Nothing, If(LiteLoaderJson("minecraftArguments"), " ").ToString, " ")
'分割参数字符串
Dim RawArguments As List(Of String) = AllArguments.Split(" ").Where(Function(l) l <> "").Select(Function(l) l.Trim).ToList
Dim RawArguments As List(Of String) = AllArguments.Split(" ", True).Select(Function(l) l.Trim).ToList
Dim SplitArguments As New List(Of String)
For i = 0 To RawArguments.Count - 1
If RawArguments(i).StartsWithF("-") Then
@@ -2224,11 +2212,8 @@ Retry:
#Region "保存"
FileUtils.Write(OutputJsonPath, OutputJson.ToString)
If MinecraftJar <> OutputJar Then '可能是同一个文件
If File.Exists(OutputJar) Then File.Delete(OutputJar)
CopyFile(MinecraftJar, OutputJar)
End If
Log("[Download] 版本合并 " & OutputName & " 完成")
FileUtils.Copy(MinecraftJar, OutputJar)
Logger.Info($"版本合并 {OutputName} 完成")
#End Region
End Sub
@@ -2250,23 +2235,23 @@ Retry:
''' <param name="Patch">"LUA" 或 "JavaWrapper"。</param>
Public Function ExtractPatch(Patch As String) As String
Dim PatchPath As String = $"{PathPure}{Patch}.jar"
Log($"[Java] 选定的 {Patch} 路径：{PatchPath}")
Logger.Info($"选定的 {Patch} 路径：{PatchPath}")
Static Lock As New Object
SyncLock Lock '避免 OptiFine 和 Forge 安装时同时释放导致冲突
Try
FileUtils.Write(PatchPath, GetResources(Patch))
ExtractResources(PatchPath, Patch)
Catch ex As Exception
If File.Exists(PatchPath) Then
If FileUtils.Exists(PatchPath) Then
'因为未知原因可能变为只读文件（#4243）
Log(ex, $"{Patch} 文件释放失败，但文件已存在，将在删除后尝试重新生成", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"{Patch} 文件释放失败，但文件已存在，将在删除后尝试重新生成")
Try
File.Delete(PatchPath)
FileUtils.Write(PatchPath, GetResources(Patch))
FileUtils.Delete(PatchPath)
ExtractResources(PatchPath, Patch)
Catch ex2 As Exception
Log(ex2, $"{Patch} 文件重新释放失败，将尝试更换文件名重新生成", NotifyLevel.DevelopOnly)
Logger.Warn(ex2, $"{Patch} 文件重新释放失败，将尝试更换文件名重新生成")
PatchPath = $"{PathPure}{Patch}2.jar"
Try
FileUtils.Write(PatchPath, GetResources(Patch))
ExtractResources(PatchPath, Patch)
Catch ex3 As Exception
Throw New FileNotFoundException($"释放 {Patch} 最终尝试失败", ex3)
End Try
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
+17 -17
View File
@@ -525,7 +525,7 @@
Next
'自动选择版本
If VersionWaitingSelect Is Nothing Then Exit Try
Log("[Download] 自动选择 MC 版本：" & VersionWaitingSelect)
Logger.Info($"自动选择 MC 版本：{VersionWaitingSelect}")
For Each Version As JObject In Versions
If Version("id").ToString <> VersionWaitingSelect Then Continue For
Dim Item = McDownloadListItem(Version, Sub()
@@ -535,7 +535,7 @@
Return
Next
Catch ex As Exception
Log(ex, "可视化安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化安装版本列表出错")
End Try
End Sub
''' <summary>
@@ -627,7 +627,7 @@
PanOptiFine.Children.Add(OptiFineDownloadListItem(Version, AddressOf OptiFine_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 OptiFine 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 OptiFine 安装版本列表出错")
End Try
End Sub
@@ -689,7 +689,7 @@
PanLiteLoader.Children.Add(LiteLoaderDownloadListItem(Version, AddressOf LiteLoader_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 LiteLoader 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 LiteLoader 安装版本列表出错")
End Try
End Sub
@@ -763,7 +763,7 @@
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 Forge 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 Forge 安装版本列表出错")
End Try
End Sub
@@ -821,7 +821,7 @@
PanNeoForge.Children.Add(NeoForgeDownloadListItem(Version, AddressOf NeoForge_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 NeoForge 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 NeoForge 安装版本列表出错")
End Try
End Sub
@@ -883,7 +883,7 @@
CardFabric.SwapControl = PanFabric
CardFabric.SwapType = 12
Catch ex As Exception
Log(ex, "可视化 Fabric 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 Fabric 安装版本列表出错")
End Try
End Sub
@@ -926,8 +926,8 @@
If Part = TargetName Then Return True
Next
'将版本名分割语素（例如 1.16.4/5）
Dim Lefts = RegexSearch(FabricApiName.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
Dim Rights = RegexSearch(TargetName.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
Dim Lefts = FabricApiName.BeforeFirst("]").RegexSearch("[a-z/]+|[0-9/]+").ToList
Dim Rights = TargetName.BeforeFirst("]").RegexSearch("[a-z/]+|[0-9/]+").ToList
'对每段进行判断
Dim i As Integer = 0
While True
@@ -946,7 +946,7 @@
End While
Return True
Catch ex As Exception
Log(ex, "判断 Fabric API 版本适配性出错（" & FabricApiName & ", " & VanillaName & "）")
Logger.Warn(ex, $"判断 Fabric API 版本适配性出错（{FabricApiName}, {VanillaName}）")
Return False
End Try
End Function
@@ -984,7 +984,7 @@
For Each Version In DlFabricApiLoader.Output
If IsFabricApiCompatible(Version) Then
If Not Version.Display.StartsWithF("[") Then
Log("[Download] 已特判修改 Fabric API 显示名：" & Version.Display, NotifyLevel.DebugModeOnly)
Logger.Warn($"已特判修改 Fabric API 显示名：{Version.Display}")
Version.Display = "[" & VanillaName & "] " & Version.Display
End If
Versions.Add(Version)
@@ -1002,11 +1002,11 @@
If Not AutoSelectedFabricApi Then
AutoSelectedFabricApi = True
Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanFabricApi.Children(0))
Log($"[Download] 已自动选择 Fabric API：{Item.Title}")
Logger.Info($"已自动选择 Fabric API：{Item.Title}")
FabricApi_Selected(Item, Nothing)
End If
Catch ex As Exception
Log(ex, "可视化 Fabric API 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 Fabric API 安装版本列表出错")
End Try
End Sub
@@ -1035,7 +1035,7 @@
If VanillaName Is Nothing Then Return False
Return ModFile.GameVersions.Contains(VanillaName)
Catch ex As Exception
Log(ex, "判断 OptiFabric 版本适配性出错（" & VanillaName & "）")
Logger.Warn(ex, $"判断 OptiFabric 版本适配性出错（{VanillaName}）")
Return False
End Try
End Function
@@ -1095,10 +1095,10 @@
If AutoSelectedOptiFabric OrElse VanillaDrop >= 140 AndAlso VanillaDrop <= 150 Then Return '1.14~15 不自动选择
AutoSelectedOptiFabric = True
Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanOptiFabric.Children(0))
Log($"[Download] 已自动选择 OptiFabric：{Item.Title}")
Logger.Info($"已自动选择 OptiFabric：{Item.Title}")
OptiFabric_Selected(Item, Nothing)
Catch ex As Exception
Log(ex, "可视化 OptiFabric 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 OptiFabric 安装版本列表出错")
End Try
End Sub
@@ -1125,7 +1125,7 @@
Private Sub BtnStart_Click() Handles BtnStart.Click
'确认版本隔离
If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
(Settings.Get("LaunchArgumentIndieV2") = 0 OrElse Settings.Get("LaunchArgumentIndieV2") = 2) Then
(Settings.Get(Of Integer)("LaunchArgumentIndieV2") = 0 OrElse Settings.Get(Of Integer)("LaunchArgumentIndieV2") = 2) Then
If MyMsgBox("你尚未开启版本隔离，多个 MC 版本会共用同一个 Mod 文件夹。" & vbCrLf &
"因此，游戏可能会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
"推荐先在 设置 → 启动选项 → 默认版本隔离 中开启版本隔离！", "版本隔离提示", "取消下载", "继续") = 1 Then
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb
+1 -1
View File
@@ -53,7 +53,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败（ID " & ID & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换分页面失败（ID {ID}）")
Finally
AniControlEnabled -= 1
End Try
Plain Craft Launcher 2/Pages/PageDownload/Resource/MyResourceItem.xaml.vb
+4 -4
View File
@@ -79,7 +79,7 @@
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Return
Log("[Control] 按下资源工程列表项：" & LabTitle.Text)
Logger.Info($"按下资源工程列表项：{LabTitle.Text}")
End If
End Sub
Private Sub MyResourceItem_Click(sender As MyResourceItem, e As EventArgs) Handles Me.Click
@@ -89,20 +89,20 @@
For Each Card As MyCard In FrmDownloadResourceDetail.PanResults.Children
If Card.Title <> "" AndAlso Not Card.IsSwapped Then Titles.Add(Card.Title)
Next
Log("[Resource] 记录当前已展开的卡片：" & String.Join("、", Titles))
Logger.Info($"记录当前已展开的卡片：{String.Join("、", Titles)}")
FrmMain.PageCurrent.Additional(1) = Titles
End If
'打开详情页
Dim TargetType As ResourceTypes
Dim TargetInstance As String = Nothing
Dim TargetLoader As ModLoaderTypes = ModLoaderTypes.Any
Dim TargetLoader As ModLoaders = ModLoaders.None
If FrmMain.PageCurrent.Page = FormMain.PageType.Download Then
'从下载页进入
Select Case FrmMain.PageCurrentSub
Case FormMain.PageSubType.DownloadMod
TargetType = ResourceTypes.Mod
TargetInstance = FrmDownloadMod.Content.Loader.Input.GameVersion
TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoader
TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoaders
Case FormMain.PageSubType.DownloadPack
TargetType = ResourceTypes.ModPack
TargetInstance = FrmDownloadPack.Content.Loader.Input.GameVersion
Plain Craft Launcher 2/Pages/PageDownload/Resource/PageDownloadCompDetail.xaml.vb
+73 -73
View File
@@ -1,12 +1,28 @@
Public Class PageDownloadResourceDetail
Private ResourceItem As MyResourceItem = Nothing
''' <summary>
''' 当前页面应展示的内容类别。
''' 若当前页面是在查看前置时进入，则为 Any；这也能用于指示当前是否在查看前置。
''' </summary>
Private TargetResourceType As ResourceTypes
Private Project As ResourceProject
Private TargetVersion As String
Private TargetLoaders As ModLoaders
Public Sub LoadPageArguments() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoaders = CType(FrmMain.PageCurrent.Additional(3), ModLoaders)
If TargetLoaders <> ModLoaders.None AndAlso Not TargetLoaders.Flags.IsSingle Then TargetLoaders = TargetLoaders.Flags.First() '强制取第一个
TargetResourceType = FrmMain.PageCurrent.Additional(4)
End Sub
#Region "加载器"
Private ResourceFileLoader As New LoaderTask(Of Integer, List(Of ResourceVersion))(
"Resource File",
Sub(Task)
LoadTargetFromAdditional()
LoadPageArguments()
Dim Result = ResourceVersion.FromProjectId(Project.Id, Project.Platform)
If Task.IsInterrupted Then Return
Task.Output = Result
@@ -14,22 +30,9 @@
'初始化加载器信息
Private Sub PageDownloadResourceDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
LoadTargetFromAdditional()
LoadPageArguments()
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, ResourceFileLoader, AddressOf Load_OnFinish)
End Sub
Public Sub LoadTargetFromAdditional() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
TargetInstance = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
TargetType = FrmMain.PageCurrent.Additional(4)
End Sub
Private Project As ResourceProject
Private TargetInstance As String, TargetLoader As ModLoaderTypes
''' <summary>
''' 当前页面应展示的内容类别。
''' 若当前页面是在查看前置时进入，则也可能为 Any。
''' </summary>
Private TargetType As ResourceTypes
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case ResourceFileLoader.State
@@ -37,7 +40,7 @@
Dim ErrorMessage As String = ""
If ResourceFileLoader.Error IsNot Nothing Then ErrorMessage = ResourceFileLoader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Resource] 下载的文件 json 列表损坏，已自动重试", NotifyLevel.DebugModeOnly)
Logger.Warn("下载的文件 json 列表损坏，已自动重试")
PageLoaderRestart()
End If
End Select
@@ -75,13 +78,13 @@
'筛选类型相同的结果（Modrinth 会返回 Mod、服务端插件、数据包混合的列表）
Private Function GetResults() As List(Of ResourceVersion)
Dim Results As List(Of ResourceVersion) = ResourceFileLoader.Output
Select Case TargetType
Select Case TargetResourceType
Case ResourceTypes.Any
Results = Results.Where(Function(r) r.ResourceType <> ResourceTypes.Plugin).ToList
Case ResourceTypes.Shader, ResourceTypes.ResourcePack
'不筛选光影和资源包，否则原版光影会因为是资源包格式而被过滤（#6473）
Case Else
Results = Results.Where(Function(r) r.ResourceType = TargetType).ToList
Results = Results.Where(Function(r) r.ResourceType = TargetResourceType).ToList
End Select
Return Results
End Function
@@ -132,10 +135,10 @@ GroupDone:
Next
'自动选择
Dim ToCheck As MyRadioButton = Nothing
If TargetInstance <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetInstance))
If TargetVersion <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
If TargetFile IsNot Nothing Then
Dim TargetGroup = GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld)
Dim TargetGroup = GetGroupedVersionName(TargetVersion, GroupedDrop, GroupedOld)
For Each Button As MyRadioButton In PanFilter.Children
If Button.Text <> TargetGroup Then Continue For
ToCheck = Button
@@ -153,12 +156,11 @@ GroupDone:
Private Sub UpdateFilterResult()
Dim Results = GetResults()
Dim TargetCardName As String = If(TargetInstance <> "" OrElse TargetLoader <> ModLoaderTypes.Any,
$"{If(TargetLoader <> ModLoaderTypes.Any, TargetLoader.ToString & " ", "")}{TargetInstance}（所选版本）", "")
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoaders <> ModLoaders.None,
$"{If(TargetLoaders <> ModLoaders.None, TargetLoaders.ToString & " ", "")}{TargetVersion}（所选版本）", "")
'归类到卡片下
Dim Dict As New SortedDictionary(Of String, List(Of ResourceVersion))(New CardSorter(TargetCardName))
Dict.Add("其他", New List(Of ResourceVersion))
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(ModLoaderTypes)))
For Each Version As ResourceVersion In Results
For Each GameVersion In Version.GameVersions
'检查是否符合版本筛选器
@@ -168,12 +170,12 @@ GroupDone:
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
'遍历加入的加载器列表
Dim Loaders As New List(Of String)
If Project.Loaders.Count > 1 AndAlso '工程至少有两个加载器
If Project.ModLoaders.Flags.Count > 1 AndAlso '工程至少有两个加载器
Version.ResourceType = ResourceTypes.Mod AndAlso '是 Mod
McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的
For Each Loader In Version.Loaders
If Loader = ModLoaderTypes.Quilt AndAlso Settings.Get("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
For Each Loader In Version.ModLoaders.Flags
If Loader = ModLoaders.Quilt AndAlso Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt") Then Continue For
Loaders.Add(Loader.ToString & " ")
Next
End If
If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的，确保它在一张卡片里
@@ -186,11 +188,11 @@ GroupDone:
Next
Next
'添加筛选的版本的卡片
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetVersion, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then
Dict.Add(TargetCardName, New List(Of ResourceVersion))
For Each Version As ResourceVersion In Results
If Version.GameVersions.Contains(TargetInstance) AndAlso
(TargetLoader = ModLoaderTypes.Any OrElse Version.Loaders.Contains(TargetLoader)) Then
If Version.GameVersions.Contains(TargetVersion) AndAlso
(TargetLoaders = ModLoaders.None OrElse TargetLoaders.Flags.Intersect(Version.ModLoaders.Flags).Any) Then
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld) = VersionFilter) Then Continue For
@@ -205,16 +207,16 @@ GroupDone:
If Not Pair.Value.Any() Then Continue For
If Pair.Key = TargetCardName.Replace("（所选版本）", "") Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(TargetType = ResourceTypes.ModPack, 9, 8)} '9 是安装，8 是另存为
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(TargetResourceType = ResourceTypes.ModPack, 9, 8)} '9 是安装，8 是另存为
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
PanResults.Children.Add(NewCard)
'确定卡片是否展开
'确定卡片是否默认展开
If Pair.Key = TargetCardName OrElse
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
MyCard.StackInstall(NewStack, If(TargetType = ResourceTypes.ModPack, 9, 8), Pair.Key) '9 是安装，8 是另存为
MyCard.StackInstall(NewStack, If(TargetResourceType = ResourceTypes.ModPack, 9, 8), Pair.Key) '9 是安装，8 是另存为
Else
NewCard.IsSwapped = True
End If
@@ -228,15 +230,15 @@ GroupDone:
CType(PanResults.Children(0), MyCard).IsSwapped = False
End If
'替代提示
If Project.Types = ResourceTypes.ModOrDataPack AndAlso (TargetType = ResourceTypes.Mod OrElse TargetType = ResourceTypes.DataPack) Then
If Project.Types = ResourceTypes.ModOrDataPack AndAlso (TargetResourceType = ResourceTypes.Mod OrElse TargetResourceType = ResourceTypes.DataPack) Then
HintAlternative.Visibility = Visibility.Visible
HintAlternative.Text = If(TargetType = ResourceTypes.Mod,
HintAlternative.Text = If(TargetResourceType = ResourceTypes.Mod,
"以下是该项目的 Mod 版本。点击这里查看其数据包版本。", "以下是该项目的数据包版本。点击这里查看其 Mod 版本。")
Else
HintAlternative.Visibility = Visibility.Collapsed
End If
Catch ex As Exception
Log(ex, "可视化工程下载列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化工程下载列表出错")
End Try
End Sub
Private Function GetGroupedVersionName(Name As String, GroupedByDrop As Boolean, FoldOld As Boolean) As String
@@ -303,16 +305,18 @@ GroupDone:
Dim Loaders As New List(Of LoaderBase)
Dim Target As String = $"{McFolderSelected}versions\{InstanceName}\原始整合包.{If(Project.Platform = ResourcePlatforms.CurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = ResourceItem.PathLogo.ActualSource
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderDownload("下载整合包文件", {
File.ToNetFile(Target, ResourceVersion.DownloadReason.Standalone, File.GameVersions.FirstOrDefault, File.ModLoaders)
}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() ModpackInstall(Target, InstanceName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
Sub() ModpackInstall(Target, InstanceName, If(FileUtils.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
Sub(MyLoader)
Select Case MyLoader.State
Case LoadState.Failed
Hint(MyLoader.Name & "失败：" & MyLoader.Error.GetBrief(), HintType.Red)
Hint(MyLoader.Name & "失败：" & MyLoader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted
Hint(MyLoader.Name & "已取消！", HintType.Blue)
Case LoadState.Loading
@@ -326,7 +330,7 @@ GroupDone:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "下载资源整合包失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "下载资源整合包失败")
End Try
End Sub
'资源下载；整合包另存为
@@ -356,13 +360,13 @@ GroupDone:
End Select
Dim IsInstanceSuitable As Func(Of McInstance, Boolean) = Nothing
'获取资源所需的加载器
Dim AllowedLoaders As New List(Of ModLoaderTypes)
If File.Loaders.Any Then
AllowedLoaders = File.Loaders
ElseIf Project.Loaders.Any Then
AllowedLoaders = Project.Loaders
Dim AllowedLoaders As ModLoaders = ModLoaders.None
If File.ModLoaders <> ModLoaders.None Then
AllowedLoaders = File.ModLoaders
ElseIf Project.ModLoaders <> ModLoaders.None Then
AllowedLoaders = Project.ModLoaders
End If
Log($"[Resource] {Desc}要求的加载器种类：" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
Logger.Info($"{Desc}要求的加载器种类：{AllowedLoaders}")
'判断某个版本是否符合资源要求
IsInstanceSuitable =
Function(Instance As McInstance)
@@ -403,21 +407,16 @@ GroupDone:
End Function) Then Return False
End If
'加载器
If Not AllowedLoaders.Any() Then Return True '无要求
If AllowedLoaders.Contains(ModLoaderTypes.Forge) AndAlso Instance.Version.HasForge Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.Fabric) AndAlso Instance.Version.HasFabric Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.NeoForge) AndAlso Instance.Version.HasNeoForge Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.LiteLoader) AndAlso Instance.Version.HasLiteLoader Then Return True
Return False
Return AllowedLoaders = ModLoaders.None OrElse AllowedLoaders.Flags.Intersect(Instance.Version.ModLoaders.Flags).Any
End Function
'获取常规资源默认下载位置
If CachedFolder.ContainsKey(File.ResourceType) Then
DefaultFolder = CachedFolder(File.ResourceType)
Log($"[Resource] 使用上次下载时的文件夹作为默认下载位置：{DefaultFolder}")
Logger.Info($"使用上次下载时的文件夹作为默认下载位置：{DefaultFolder}")
ElseIf McInstanceSelected IsNot Nothing AndAlso IsInstanceSuitable(McInstanceSelected) Then
DefaultFolder = $"{McInstanceSelected.PathIndie}{SubFolder}"
DirectoryUtils.Create(DefaultFolder)
Log($"[Resource] 使用当前版本作为默认下载位置：{DefaultFolder}")
Logger.Info($"使用当前版本作为默认下载位置：{DefaultFolder}")
Else
'查找所有可能的版本
Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished
@@ -426,21 +425,21 @@ GroupDone:
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
End If
Dim SuitableInstanceList = McInstanceList.Values.SelectMany(Function(l) l).Where(Function(v) IsInstanceSuitable(v)).
Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}"))
Select(Function(v) DirectoryUtils.GetInfo($"{v.PathIndie}{SubFolder}"))
If SuitableInstanceList.Any Then
Dim SelectedInstance = SuitableInstanceList.
OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
First()
DefaultFolder = SelectedInstance.FullName
DefaultFolder = PathUtils.RemoveExtendedPrefix(SelectedInstance.FullName)
DirectoryUtils.Create(DefaultFolder)
Log($"[Resource] 使用适合的游戏版本作为默认下载位置：{DefaultFolder}")
Logger.Info($"使用适合的游戏版本作为默认下载位置：{DefaultFolder}")
Else
DefaultFolder = McFolderSelected
If NeedLoad Then
Hint($"当前 MC 文件夹中没有找到合适的版本！")
Else
Log("[Resource] 由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置")
Logger.Info("由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置")
End If
End If
End If
@@ -452,7 +451,7 @@ GroupDone:
Else
Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - ").
Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：")
Select Case Settings.Get("ToolDownloadTranslateV2")
Select Case Settings.Get(Of Integer)("ToolDownloadTranslateV2")
Case 0
FileName = $"【{ChineseName}】{File.FileName}"
Case 1
@@ -470,17 +469,18 @@ GroupDone:
Sub()
'弹窗要求选择保存位置
Dim Target As String
Target = SelectSaveFile("选择保存位置", FileName,
Desc & "文件|" &
If(File.ResourceType = ResourceTypes.Mod,
If(File.FileName.EndsWithF(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWithF(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Return
Dim Ext As String = If(File.ResourceType = ResourceTypes.Mod,
If(File.FileName.EndsWithF(".litemod"), "litemod", "jar"),
If(File.FileName.EndsWithF(".mrpack"), "mrpack", "zip"))
Target = Dialogs.SaveFile("选择保存位置", FileName, DefaultFolder, {(Ext, Desc & "文件")})
If Target Is Nothing Then Return
'构造步骤加载器
Dim LoaderName As String = Desc & "下载：" & Path.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder Then CachedFolder(File.ResourceType) = GetPathFromFullPath(Target)
Dim LoaderName As String = Desc & "下载：" & PathUtils.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder Then CachedFolder(File.ResourceType) = PathUtils.RemoveLastPart(Target)
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
Loaders.Add(New LoaderDownload("下载文件", {
File.ToNetFile(Target, If(TargetResourceType = ResourceTypes.Any, ResourceVersion.DownloadReason.Dependency, ResourceVersion.DownloadReason.Standalone))
}) With {.ProgressWeight = 6, .Block = True})
'启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(1)
@@ -489,7 +489,7 @@ GroupDone:
FrmMain.BtnExtraDownload.Ribble()
End Sub)
Catch ex As Exception
Log(ex, "保存资源文件失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "保存资源文件失败")
End Try
End Sub, "Download Resource Detail Save")
End Sub
@@ -506,8 +506,8 @@ GroupDone:
'Mod / 数据包 互相跳转
Private Sub HintAlternative_Click() Handles HintAlternative.Click
TargetType = If(TargetType = ResourceTypes.Mod, ResourceTypes.DataPack, ResourceTypes.Mod)
FrmMain.PageCurrent.Additional(4) = TargetType '加载器会从这里重新拿数据
TargetResourceType = If(TargetResourceType = ResourceTypes.Mod, ResourceTypes.DataPack, ResourceTypes.Mod)
FrmMain.PageCurrent.Additional(4) = TargetResourceType '加载器会从这里重新拿数据
PageLoaderRestart(IsForceRestart:=True)
End Sub
@@ -522,7 +522,7 @@ GroupDone:
If Not Deps.Any() Then Return
Deps = Deps.Where(
Function(dep)
If Not ResourceProject.Cache.ContainsKey(dep) Then Log($"[Resource] 未找到 ID {dep} 的前置信息", NotifyLevel.DebugModeOnly)
If Not ResourceProject.Cache.ContainsKey(dep) Then Logger.Warn($"未找到 ID {dep} 的前置信息")
Return ResourceProject.Cache.ContainsKey(dep)
End Function).ToList
'添加开头间隔
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:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="NeoForge" Tag="6" />
<local:MyComboBoxItem Content="NeoForge" Tag="16" />
<local:MyComboBoxItem Content="Fabric" Tag="4" />
<local:MyComboBoxItem Content="Quilt" Tag="5" />
<local:MyComboBoxItem Content="Quilt" Tag="8" />
<local:MyComboBoxItem Content="LiteLoader" Tag="2" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" />
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
'在点击 MyResourceItem 时会获取 Loader 的输入，以使资源详情页面可以应用相同的筛选项
Public Loader = ResourceSearcher.GetLoader(AddressOf LoaderInput)
Public Loader As LoaderTask(Of ResourceSearcher.SearchRequest, Integer) = ResourceSearcher.GetLoader(AddressOf LoaderInput)
Private Sub PageResource_Loaded(sender As Object, e As EventArgs) Handles Me.Loaded
Static IsFirstLoaded As Boolean = False
@@ -126,7 +126,7 @@ Public Class PageResource
.SearchText = TextSearchName.Text
.GameVersion = GameVersion
.Tag = ComboSearchTag.SelectedItem.Tag
.ModLoader = If(PageType = ResourceTypes.Mod, Val(ComboSearchLoader.SelectedItem.Tag), ModLoaderTypes.Any)
.ModLoaders = If(PageType = ResourceTypes.Mod, Val(ComboSearchLoader.SelectedItem.Tag), ModLoaders.None)
.Sources = CType(Val(ComboSearchSource.SelectedItem.Tag), ResourcePlatforms)
End With
Return Request
@@ -144,14 +144,14 @@ Public Class PageResource
'结果 UI 化
Private Sub Load_OnFinish()
Try
Log($"[Resource] 开始可视化{TypeNameSpaced}列表，已储藏 {Storage.Results.Count} 个结果，当前在第 {Page + 1} 页")
Logger.Info($"开始可视化{TypeNameSpaced}列表，已储藏 {Storage.Results.Count} 个结果，当前在第 {Page + 1} 页")
'列表项
PanProjects.Children.Clear()
Dim Index As Integer = Math.Min(Page * PAGE_SIZE, Storage.Results.Count - 1)
For Each Result In Storage.Results.GetRange(Index, Math.Min(Storage.Results.Count - Index, PAGE_SIZE))
PanProjects.Children.Add(Result.ToResourceItem(
ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing,
ShowLoaderDesc:=Loader.Input.ModLoader = ModLoaderTypes.Any AndAlso (PageType = ResourceTypes.Mod OrElse PageType = ResourceTypes.ModPack)))
ShowLoaderDesc:=Loader.Input.ModLoaders = ModLoaders.None AndAlso (PageType = ResourceTypes.Mod OrElse PageType = ResourceTypes.ModPack)))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
@@ -177,7 +177,7 @@ Public Class PageResource
'强制返回顶部
ScrollToTop()
Catch ex As Exception
Log(ex, $"可视化{TypeNameSpaced}列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"可视化{TypeNameSpaced}列表出错")
End Try
End Sub
@@ -188,7 +188,7 @@ Public Class PageResource
Dim ErrorMessage As String = ""
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log($"[Download] 下载的{TypeNameSpaced}列表 json 文件损坏，已自动重试", NotifyLevel.DebugModeOnly)
Logger.Warn($"下载的{TypeNameSpaced}列表 json 文件损坏，已自动重试")
CType(Parent, MyPageRight).PageLoaderRestart()
End If
End Select
@@ -208,7 +208,7 @@ Public Class PageResource
CardPages.IsEnabled = False
Page = NewPage
FrmMain.BackToTop()
Log($"[Download] {TypeName}：切换到第 {Page + 1} 页")
Logger.Info($"{TypeName}：切换到第 {Page + 1} 页")
RunInThread(
Sub()
Thread.Sleep(100) '等待向上滚的动画结束
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:local="clr-namespace:PCL;assembly="
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>
<ColumnDefinition Width="6" />
<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
'相关联的 Mod
Public Property Entry As ResourceFile
Public Property Entry As LocalResourceFile
Get
Return Tag
End Get
Set(value As ResourceFile)
Set(value As LocalResourceFile)
Tag = value
End Set
End Property
@@ -80,7 +80,7 @@ Public Class MyLocalModItem
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Return
Log("[Control] 按下本地 Mod 列表项：" & LabTitle.Text)
Logger.Info($"按下本地 Mod 列表项：{LabTitle.Text}")
End If
End Sub
@@ -203,7 +203,7 @@ Public Class MyLocalModItem
AniStop("MyLocalModItem Checked " & Uuid)
End If
Catch ex As Exception
Log(ex, "设置 Checked 失败")
Logger.Warn(ex, "设置 Checked 失败")
End Try
End Set
End Property
@@ -335,9 +335,9 @@ Public Class MyLocalModItem
BtnUpdate.Visibility = Visibility.Collapsed
End If
'标题与描述
Dim DescFileName As String = Path.GetFileNameWithoutExtension(Entry.File.FullName)
Dim DescFileName As String = Entry.File.Name.BeforeLast(".")
Dim NewDescription As String
If Settings.Get("ToolModLocalNameStyle") = 1 Then
If Settings.Get(Of Integer)("ToolModLocalNameStyle") = 1 Then
'标题显示文件名，详情显示译名
'标题
Title = DescFileName
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceExport.xaml.vb
+72 -75
View File
@@ -25,7 +25,7 @@ Public Class PageInstanceExport
AniControlEnabled -= 1
End Sub
Public Sub RefreshAll() Implements IRefreshable.Refresh
Log($"[Export] 刷新导出页面")
Logger.Info($"刷新导出页面")
HintOptiFine.Visibility = If(PageInstanceLeft.Instance.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
CurrentInstance = PageInstanceLeft.Instance.PathVersion
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())
Panel.Children.Clear()
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 AcceptCompressedFile Then
@@ -98,14 +98,14 @@ Public Class PageInstanceExport
Return False
End Try
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))
For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory)
AllEntries.Add($"{SubFolder.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}\"))
Next
Log($"[Export] 共发现 {AllEntries.Count} 个可行的二级文件/文件夹")
Logger.Info($"共发现 {AllEntries.Count} 个可行的二级文件/文件夹")
'确认选项是否应该被显示
Dim IsVisible =
Function(TargetOption As ExportOption) As Boolean
@@ -121,16 +121,16 @@ Public Class PageInstanceExport
Try
If AllEntries.Any(Function(Entry) Entry Like Rule) Then Return True
Catch ex As Exception
Log(ex, $"错误的规则：{Rule}", NotifyLevel.AllUsers)
Logger.Error(ex, $"错误的规则：{Rule}", LogBehavior.Toast)
Return False
End Try
'粗略检查所有级
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
Return IsValidDirectory(New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Rule)) '文件夹有效
Return IsValidDirectory(DirectoryUtils.GetInfo(PageInstanceLeft.Instance.PathIndie & Rule)) '文件夹有效
Else
Return File.Exists(PageInstanceLeft.Instance.PathIndie & Rule) '文件有效
Return FileUtils.Exists(PageInstanceLeft.Instance.PathIndie & Rule) '文件有效
End If
Else
Return False
@@ -303,8 +303,8 @@ Public Class PageInstanceExport
'保存配置文件
Private Sub ExportConfig() Handles BtnAdvancedExport.Click
Try
Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Settings.Get("CacheExportConfig"))
If String.IsNullOrEmpty(ConfigPath) Then Return
Dim ConfigPath As String = Dialogs.SaveFile("选择文件位置", "export_config.txt", Settings.Get(Of String)("CacheExportConfig"), {("txt", "整合包导出配置")})
If ConfigPath Is Nothing Then Return
Settings.Set("CacheExportConfig", ConfigPath)
Dim ConfigLines As New List(Of String)
'ini 段
@@ -343,19 +343,19 @@ Public Class PageInstanceExport
Hint("已保存配置文件：" & ConfigPath, HintType.Green)
OpenExplorer(ConfigPath)
Catch ex As Exception
Log(ex, "保存配置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "保存配置失败", LogBehavior.Alert)
End Try
End Sub
'读取配置文件
Private Sub ImportConfig() Handles BtnAdvancedImport.Click
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
Settings.Set("CacheExportConfig", ConfigPath)
Dim Segments As String() = ReadFile(ConfigPath).Split(Sperator)
Dim Segments As String() = FileUtils.ReadAsString(ConfigPath).Split(Sperator)
'ini 段
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
If Line = "" OrElse Line.StartsWithF("#") OrElse Line.StartsWithF("=") Then Continue For
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，加个特判
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
ExtraFiles = Segments(2).ReplaceLineEndings(vbLf, mergeMultiple:=True).Split(vbLf).ToList
ExtraFiles = Segments(2).SplitLines(True).ToList
Else
ExtraFiles = Nothing
End If
'结束
Hint("已读取配置文件：" & ConfigPath, HintType.Green)
Catch ex As Exception
Log(ex, "读取配置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "读取配置失败", LogBehavior.Alert)
End Try
End Sub
@@ -412,23 +412,23 @@ Public Class PageInstanceExport
If Not String.IsNullOrWhiteSpace(ConfigPackPath) AndAlso
(Not ConfigPackPath.EndsWithF("\") AndAlso Not ConfigPackPath.EndsWithF("/")) Then
Try
DirectoryUtils.Create(ConfigPackPath, isFilePath:=True)
DirectoryUtils.Create(PathUtils.RemoveLastPart(ConfigPackPath))
PackPath = ConfigPackPath
Log($"[Export] 使用配置文件中指定的导出路径：{ConfigPackPath}")
Logger.Info($"使用配置文件中指定的导出路径：{ConfigPackPath}")
Catch ex As Exception
Log(ex, $"无法使用配置文件中指定的导出路径（{ConfigPackPath}）", NotifyLevel.DebugModeOnly)
If MyMsgBox($"指定的路径：{ConfigPackPath}{vbCrLf}{vbCrLf}{ex.GetDetail}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
Logger.Warn(ex, $"无法使用配置文件中指定的导出路径（{ConfigPackPath}）")
If MyMsgBox($"指定的路径：{ConfigPackPath}{vbCrLf}{vbCrLf}{ex.GetDisplay(True)}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
End Try
End If
If PackPath Is Nothing Then
Dim Extensions As New List(Of String)
Extensions.Add("压缩文件(*.zip)|*.zip")
If Not CheckOptionsPcl.Checked Then Extensions.Add("Modrinth 整合包文件(*.mrpack)|*.mrpack")
PackPath = SelectSaveFile("选择导出位置",
PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), Extensions.Join("|"))
Log($"[Export] 手动指定的导出路径：{PackPath}")
Dim Extensions As New List(Of (Extension As String, Display As String))
Extensions.Add(("zip", "压缩文件"))
If Not CheckOptionsPcl.Checked Then Extensions.Add(("mrpack", "Modrinth 整合包文件"))
PackPath = Dialogs.SaveFile("选择导出位置",
PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), filter:=Extensions)
Logger.Info($"手动指定的导出路径：{PackPath}")
End If
If String.IsNullOrEmpty(PackPath) Then Return
If PackPath Is Nothing Then Return
'缓存所需参数
Dim CacheFolder = RequestTaskTempFolder()
@@ -441,7 +441,7 @@ Public Class PageInstanceExport
Dim IncludePCLCustom As Boolean = IncludePCL AndAlso CheckOptionsPclCustom.Checked
Dim AllRules = StandardizeLines(GetAllRules(), True).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)
@@ -452,7 +452,7 @@ Public Class PageInstanceExport
Loaders.Add(New LoaderTask(Of Integer, Integer)("下载 PCL 正式版",
Sub(Loader As LoaderTask(Of Integer, Integer))
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 If
@@ -460,9 +460,9 @@ Public Class PageInstanceExport
#Region "复制文件"
Loaders.Add(New LoaderTask(Of Integer, List(Of ResourceFile))("复制导出内容",
Sub(Loader As LoaderTask(Of Integer, List(Of ResourceFile)))
Loader.Output = New List(Of ResourceFile)
Loaders.Add(New LoaderTask(Of Integer, List(Of LocalResourceFile))("复制导出内容",
Sub(Loader As LoaderTask(Of Integer, List(Of LocalResourceFile)))
Loader.Output = New List(Of LocalResourceFile)
'复制版本文件
Dim Progress As Integer = 0
Dim SearchFolder As Action(Of DirectoryInfo)
@@ -471,7 +471,7 @@ Public Class PageInstanceExport
'文件夹：进一步搜索
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
SearchFolder(SubFolder)
Next
@@ -486,12 +486,12 @@ Public Class PageInstanceExport
Next
If Not ShouldKeep Then Continue For
Dim TargetPath As String = OverridesFolder & RelativePath
CopyFile(Entry.FullName, TargetPath)
FileUtils.Copy(Entry.FullName, TargetPath)
'若为压缩包，考虑联网获取路径
If CheckHostedAssets AndAlso
{".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.Lower) AndAlso
{"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
Unused = ModFile.CurseForgeHash
Loader.Output.Add(ModFile)
@@ -504,21 +504,21 @@ Public Class PageInstanceExport
End If
Next
End Sub
SearchFolder(New DirectoryInfo(PathIndie))
Log($"[Export] 复制 overrides 文件完成，有 {Loader.Output.Count} 个文件需要联网检查")
SearchFolder(DirectoryUtils.GetInfo(PathIndie))
Logger.Info($"复制 overrides 文件完成，有 {Loader.Output.Count} 个文件需要联网检查")
Loader.Progress = 0.95
'复制追加内容到根目录
Dim BaseFolder As String = If(IncludePCL, CacheFolder, CacheFolder & "modpack\")
For Each Line In AllExtraFiles
If Line.EndsWithF("\") OrElse Line.EndsWithF("/") Then
If Directory.Exists(Line) Then
CopyDirectory(Line, BaseFolder & GetFolderNameFromPath(Line) & "\")
If DirectoryUtils.Exists(Line) Then
DirectoryUtils.Copy(Line, BaseFolder & PathUtils.GetLastPart(Line) & "\")
Else
Hint($"未找到配置文件中指定的文件夹：{Line}", HintType.Red)
End If
Else
If File.Exists(Line) Then
CopyFile(Line, BaseFolder & GetFileNameFromPath(Line))
If FileUtils.Exists(Line) Then
FileUtils.Copy(Line, BaseFolder & PathUtils.GetLastPart(Line))
Else
Hint($"未找到配置文件中指定的单个文件：{Line}", HintType.Red)
End If
@@ -526,19 +526,19 @@ Public Class PageInstanceExport
Next
Loader.Progress = 0.97
'复制 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)
'复制 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 个性化内容
If IncludePCLCustom Then
If Directory.Exists(PathExeFolder & "PCL\Pictures\") Then CopyDirectory(PathExeFolder & "PCL\Pictures\", CacheFolder & "PCL\Pictures\")
If Directory.Exists(PathExeFolder & "PCL\Musics\") Then CopyDirectory(PathExeFolder & "PCL\Musics\", CacheFolder & "PCL\Musics\")
If Directory.Exists(PathExeFolder & "PCL\Help\") Then CopyDirectory(PathExeFolder & "PCL\Help\", CacheFolder & "PCL\Help\")
If File.Exists(PathExeFolder & "PCL\Custom.xaml") Then CopyFile(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 File.Exists(PathExeFolder & "PCL\hints.txt") Then CopyFile(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 DirectoryUtils.Exists(PathExeFolder & "PCL\Pictures\") Then DirectoryUtils.Copy(PathExeFolder & "PCL\Pictures\", CacheFolder & "PCL\Pictures\")
If DirectoryUtils.Exists(PathExeFolder & "PCL\Musics\") Then DirectoryUtils.Copy(PathExeFolder & "PCL\Musics\", CacheFolder & "PCL\Musics\")
If DirectoryUtils.Exists(PathExeFolder & "PCL\Help\") Then DirectoryUtils.Copy(PathExeFolder & "PCL\Help\", CacheFolder & "PCL\Help\")
If FileUtils.Exists(PathExeFolder & "PCL\Custom.xaml") Then FileUtils.Copy(PathExeFolder & "PCL\Custom.xaml", CacheFolder & "PCL\Custom.xaml")
If FileUtils.Exists(PathExeFolder & "PCL\Setup.ini") Then FileUtils.Copy(PathExeFolder & "PCL\Setup.ini", CacheFolder & "PCL\Setup.ini")
If FileUtils.Exists(PathExeFolder & "PCL\hints.txt") Then FileUtils.Copy(PathExeFolder & "PCL\hints.txt", CacheFolder & "PCL\hints.txt")
If FileUtils.Exists(PathExeFolder & "PCL\Logo.png") Then FileUtils.Copy(PathExeFolder & "PCL\Logo.png", CacheFolder & "PCL\Logo.png")
End If
End Sub) With {.ProgressWeight = 5})
@@ -546,11 +546,11 @@ Public Class PageInstanceExport
#Region "联网检查"
Loaders.Add(New LoaderTask(Of List(Of ResourceFile), Dictionary(Of ResourceFile, List(Of String)))("联网获取文件信息",
Sub(Loader As LoaderTask(Of List(Of ResourceFile), Dictionary(Of ResourceFile, List(Of String))))
Loader.Output = New Dictionary(Of ResourceFile, List(Of String))
If Not CheckHostedAssets Then Log($"[Export] 要求跳过联网获取步骤") : Return
If Not Loader.Input.Any Then Log($"[Export] 没有需要联网检查的文件，跳过联网获取步骤") : Return
Loaders.Add(New LoaderTask(Of List(Of LocalResourceFile), Dictionary(Of LocalResourceFile, List(Of String)))("联网获取文件信息",
Sub(Loader As LoaderTask(Of List(Of LocalResourceFile), Dictionary(Of LocalResourceFile, List(Of String))))
Loader.Output = New Dictionary(Of LocalResourceFile, List(Of String))
If Not CheckHostedAssets Then Logger.Info($"要求跳过联网获取步骤") : Return
If Not Loader.Input.Any Then Logger.Info($"没有需要联网检查的文件，跳过联网获取步骤") : Return
'分平台获取下载地址
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"))
Next
Log($"[Export] 从 Modrinth 获取到 {ModrinthRaw.Count} 个本地资源项的对应信息")
Logger.Info($"从 Modrinth 获取到 {ModrinthRaw.Count} 个本地资源项的对应信息")
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
Logger.Warn(ex, "从 Modrinth 获取本地 Mod 信息失败")
FailedExceptions.Add(ex)
Finally
EndedThreadCount += 1
@@ -592,16 +592,16 @@ Public Class PageInstanceExport
Dim File As JObject = ResultJson("file")
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
'写入下载地址
For Each Address In ResourceVersion.ParseCurseForgeDownloadUrls(File("downloadUrl").ToString)
Loader.Output.AddIntoValueCollection(ModFile, Address)
Next
Next
Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地资源项的对应信息")
Logger.Info($"从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地资源项的对应信息")
Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
Logger.Warn(ex, "从 CurseForge 获取本地 Mod 信息失败")
FailedExceptions.Add(ex)
Finally
EndedThreadCount += 1
@@ -633,17 +633,17 @@ Public Class PageInstanceExport
#Region "生成压缩包"
Loaders.Add(New LoaderTask(Of Dictionary(Of ResourceFile, List(Of String)), Integer)("生成压缩包",
Sub(Loader As 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 LocalResourceFile, List(Of String)), Integer))
'整理文件列表
Dim Files As New JArray
For Each Pair In Loader.Input
Dim ModFile As ResourceFile = Pair.Key
Dim ModFile As LocalResourceFile = Pair.Key
Files.Add(New JObject From {
{"path", ModFile.File.FullName.AfterFirst(OverridesFolder).Replace("\", "/")},
{"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.File.FullName)}}},
{"path", PathUtils.RemoveExtendedPrefix(ModFile.File.FullName).AfterFirst(OverridesFolder).Replace("\", "/")},
{"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
{"fileSize", New FileInfo(ModFile.File.FullName).Length}
{"fileSize", ModFile.File.Length}
})
ModFile.File.Delete()
Next
@@ -662,25 +662,22 @@ Public Class PageInstanceExport
{"files", Files},
{"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
'首次压缩整合包
ZipFile.CreateFromDirectory(CacheFolder & "modpack\", CacheFolder & "modpack.mrpack")
FileUtils.CreateZipFromDirectory(CacheFolder & "modpack.mrpack", CacheFolder & "modpack\")
Loader.Progress = 0.5
DeleteDirectory(CacheFolder & "modpack\")
DirectoryUtils.Delete(CacheFolder & "modpack\")
Loader.Progress = 0.6
'二次压缩整合包
ZipFile.CreateFromDirectory(CacheFolder, PackPath)
FileUtils.CreateZipFromDirectory(PackPath, CacheFolder)
Loader.Progress = 0.9
Else
'直接压缩整合包
ZipFile.CreateFromDirectory(CacheFolder & "modpack\", PackPath)
FileUtils.CreateZipFromDirectory(PackPath, CacheFolder & "modpack\")
Loader.Progress = 0.8
End If
DeleteDirectory(CacheFolder, True)
OpenExplorer(PackPath)
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))
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败（ID " & ID & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换分页面失败（ID {ID}）")
Finally
AniControlEnabled -= 1
End Try
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceMod.xaml.vb
+86 -96
View File
@@ -29,7 +29,7 @@
''' </summary>
Public Sub ReloadModList(Optional ForceReload As Boolean = False)
If Not LoaderRun(If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then Return
Log("[System] 已刷新 Mod 列表")
Logger.Info("已刷新 Mod 列表")
Filter = FilterType.All
PanBack.ScrollToHome()
SearchBox.Text = ""
@@ -42,10 +42,10 @@
Try
ResourceProject.Cache.Clear()
ResourceVersion.ProjectFilesCache.Clear()
File.Delete(PathTemp & "Cache\LocalMod.json")
Log("[Mod] 由于点击刷新按钮，清理本地 Mod 信息缓存")
FileUtils.Delete(PathTemp & "Cache\LocalMod.json")
Logger.Info("由于点击刷新按钮，清理本地 Mod 信息缓存")
Catch ex As Exception
Log(ex, "强制刷新时清理本地 Mod 信息缓存失败")
Logger.Warn(ex, "强制刷新时清理本地 Mod 信息缓存失败")
End Try
If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.ReloadModList(True) '无需 Else，还没加载刷个鬼的新
FrmInstanceLeft.ItemMod.Checked = True
@@ -53,15 +53,13 @@
End Sub
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
Private Sub Load_Click(sender As Object, e As MouseButtonEventArgs) Handles Load.Click
If McModLoader.State = LoadState.Failed Then
LoaderRun(LoaderFolderRunType.ForceRun)
End If
If LocalResourceLoader.State = LoadState.Failed Then LoaderRun(LoaderFolderRunType.ForceRun)
End Sub
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 Region
@@ -78,7 +76,7 @@
Private Sub LoadUIFromLoaderOutput()
Try
'判断应该显示哪一个页面
If McModLoader.Output.Any() Then
If LocalResourceLoader.Output.Any() Then
PanBack.Visibility = Visibility.Visible
PanEmpty.Visibility = Visibility.Collapsed
Else
@@ -88,7 +86,7 @@
End If
'修改缓存
ModItems.Clear()
For Each ModEntity As ResourceFile In McModLoader.Output
For Each ModEntity As LocalResourceFile In LocalResourceLoader.Output
ModItems(ModEntity.EnabledName) = McModListItem(ModEntity)
Next
'显示结果
@@ -96,10 +94,10 @@
SearchBox.Text = "" '这会触发结果刷新，所以需要在 ModItems 更新之后，详见 #3124 的视频
RefreshUI()
Catch ex As Exception
Log(ex, "加载 Mod 列表 UI 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "加载 Mod 列表 UI 失败")
End Try
End Sub
Private Function McModListItem(Entry As ResourceFile) As MyLocalModItem
Private Function McModListItem(Entry As LocalResourceFile) As MyLocalModItem
AniControlEnabled += 1
Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry,
.ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.EnabledName)}
@@ -145,7 +143,7 @@
''' </summary>
Public Sub RefreshUI()
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
If ShowingMods.Any() Then
@@ -178,7 +176,7 @@
Dim AnyCount As Integer = 0
Dim EnabledCount 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
If ModItem.HasUpdate Then UpdateCount += 1
If ModItem.IsEnabled Then EnabledCount += 1
@@ -206,7 +204,7 @@
Dim HasUpdate As Boolean = False
Dim HasEnabled 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 ModEntity.HasUpdate Then HasUpdate = True
If ModEntity.IsEnabled Then HasEnabled = True
@@ -274,7 +272,7 @@
DirectoryUtils.Create(PageInstanceLeft.Instance.PathIndie & "mods\")
OpenExplorer(PageInstanceLeft.Instance.PathIndie & "mods\")
Catch ex As Exception
Log(ex, "打开 Mods 文件夹失败", NotifyLevel.MsgBox)
Logger.Error(ex, "打开 Mods 文件夹失败", LogBehavior.Alert)
End Try
End Sub
@@ -289,7 +287,7 @@
''' 安装 Mod。
''' </summary>
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
InstallMods(FileList)
End Sub
@@ -301,7 +299,7 @@
Dim Extension As String = FilePathList.First.AfterLast(".").Lower
'检查文件扩展名
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
Hint("请先将文件从回收站还原，再尝试安装！", HintType.Red)
@@ -321,21 +319,21 @@
Install:
Try
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
CopyFile(ModFile, Instance.PathIndie & "mods\" & NewFileName)
FileUtils.Copy(ModFile, Instance.PathIndie & "mods\" & NewFileName)
Next
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
Hint($"已安装 {FilePathList.Count} 个 Mod！", HintType.Green)
End If
'刷新列表
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
Catch ex As Exception
Log(ex, "复制 Mod 文件失败", NotifyLevel.MsgBox)
Logger.Error(ex, "复制 Mod 文件失败", LogBehavior.Alert)
End Try
End If
Return True
@@ -435,7 +433,7 @@ Install:
''' <summary>
''' 检查该 Mod 项是否符合当前筛选的类别。
''' </summary>
Private Function CanPassFilter(CheckingMod As ResourceFile) As Boolean
Private Function CanPassFilter(CheckingMod As LocalResourceFile) As Boolean
Select Case Filter
Case FilterType.All
Return True
@@ -462,18 +460,18 @@ Install:
'启用 / 禁用
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))
ChangeAllSelected(False)
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
For Each ModE In ModList.ToList
Dim ModEntity = ModE '仅用于去除迭代变量无法修改的限制
Dim NewPath As String = Nothing
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
'启用
NewPath = ModEntity.EnabledFullName
@@ -482,36 +480,36 @@ Install:
End If
'重命名
Try
If File.Exists(NewPath) Then
If File.Exists(ModEntity.File.FullName) Then
If FileUtils.Exists(NewPath) Then
If FileUtils.Exists(ModEntity.File.FullName) Then
'同时存在两个名称的 Mod
If GetFileMD5(ModEntity.File.FullName) <> GetFileMD5(NewPath) Then
MyMsgBox($"目前同时存在启用和禁用的两个 Mod 文件：{vbCrLf} - {NewPath}{vbCrLf} - {ModEntity.File.FullName}{vbCrLf}{vbCrLf}注意，这两个文件的内容并不相同。{vbCrLf}在手动删除或重命名其中一个文件后，才能继续操作。", "存在文件冲突")
If HashUtils.ComputeFromFile(ModEntity.File.FullName, HashUtils.HashMethod.Md5) <> HashUtils.ComputeFromFile(NewPath, HashUtils.HashMethod.Md5) Then
MyMsgBox($"目前同时存在启用和禁用的两个 Mod 文件：{vbCrLf} - {PathUtils.GetLastPart(NewPath)}{vbCrLf} - {ModEntity.File.Name}{vbCrLf}{vbCrLf}注意，这两个文件的内容并不相同。{vbCrLf}在手动删除或重命名其中一个文件后，才能继续操作。", "存在文件冲突")
Continue For
End If
Else
'已经重命名过了
Log("[Mod] Mod 的状态已被切换", NotifyLevel.DebugModeOnly)
Logger.Warn("Mod 的状态已被切换")
Continue For
End If
End If
File.Delete(NewPath)
File.Move(ModEntity.File.FullName, NewPath)
FileUtils.Delete(NewPath)
FileUtils.Move(ModEntity.File.FullName, NewPath)
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)
Return
Catch ex As Exception
Log(ex, $"重命名 Mod 失败（{If(ModEntity.File.FullName, "null")}）")
Logger.Warn(ex, $"重命名 Mod 失败（{If(ModEntity.File.FullName, "null")}）")
IsSuccessful = False
End Try
'更改 Loader 中的列表
Dim NewModEntity As New ResourceFile(NewPath)
Dim NewModEntity As New LocalResourceFile(NewPath)
NewModEntity.FromJson(ModEntity.ToJson)
If McModLoader.Output.Contains(ModEntity) Then
Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity)
McModLoader.Output.RemoveAt(IndexOfLoader)
McModLoader.Output.Insert(IndexOfLoader, NewModEntity)
If LocalResourceLoader.Output.Contains(ModEntity) Then
Dim IndexOfLoader As Integer = LocalResourceLoader.Output.IndexOf(ModEntity)
LocalResourceLoader.Output.RemoveAt(IndexOfLoader)
LocalResourceLoader.Output.Insert(IndexOfLoader, NewModEntity)
End If
If SearchResult IsNot Nothing AndAlso SearchResult.Contains(ModEntity) Then '#4862
Dim IndexOfResult As Integer = SearchResult.IndexOf(ModEntity)
@@ -538,7 +536,7 @@ Install:
'更新
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
UpdateMods(UpdateList)
ChangeAllSelected(False)
@@ -547,9 +545,9 @@ Install:
''' 记录正在进行 Mod 更新的 mods 文件夹路径。
''' </summary>
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
Settings.Set("HintUpdateMod", True)
Else
@@ -561,7 +559,7 @@ Install:
ModList = ModList.ToList() '防止刷新影响迭代器
Dim FileList As New List(Of NetFile)
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
If Not File.DownloadAvailable Then Continue For
'确认更新后的文件名
@@ -590,8 +588,8 @@ Install:
End If
'添加到下载列表
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)
FileList.Add(File.ToNetFile(TempAddress))
Dim RealAddress As String = Path.Combine(PathUtils.RemoveLastPart(Entry.File.FullName), Entry.File.Name.Replace(CurrentReplaceName, NewestReplaceName))
FileList.Add(File.ToNetFile(TempAddress, ResourceVersion.DownloadReason.Update, PageInstanceLeft.Instance.Version.VanillaName, PageInstanceLeft.Instance.Version.ModLoaders))
FileCopyList(TempAddress) = RealAddress
Next
'构造加载器
@@ -601,31 +599,31 @@ Install:
InstallLoaders.Add(New LoaderTask(Of Integer, Integer)("替换旧版 Mod 文件",
Sub()
Try
For Each Entry As ResourceFile In ModList
If File.Exists(Entry.File.FullName) Then
My.Computer.FileSystem.DeleteFile(Entry.File.FullName, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
For Each Entry As LocalResourceFile In ModList
If FileUtils.Exists(Entry.File.FullName) Then
FileUtils.Delete(Entry.File.FullName, True)
Else
Log($"[Mod] 未找到更新前的 Mod 文件，跳过对它的删除：{Entry.File.FullName}", NotifyLevel.DebugModeOnly)
Logger.Warn($"未找到更新前的 Mod 文件，跳过对它的删除：{Entry.File.FullName}")
End If
Next
For Each Entry As KeyValuePair(Of String, String) In FileCopyList
If File.Exists(Entry.Value) Then
My.Computer.FileSystem.DeleteFile(Entry.Value, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
Log($"[Mod] 更新后的 Mod 文件已存在，将会把它放入回收站：{Entry.Value}", NotifyLevel.DebugModeOnly)
If FileUtils.Exists(Entry.Value) Then
FileUtils.Delete(Entry.Value, True)
Logger.Warn($"更新后的 Mod 文件已存在，将会把它放入回收站：{Entry.Value}")
End If
If Directory.Exists(GetPathFromFullPath(Entry.Value)) Then
File.Move(Entry.Key, Entry.Value)
FinishedFileNames.Add(GetFileNameFromPath(Entry.Value))
If DirectoryUtils.Exists(PathUtils.RemoveLastPart(Entry.Value)) Then
FileUtils.Move(Entry.Key, Entry.Value)
FinishedFileNames.Add(PathUtils.GetLastPart(Entry.Value))
Else
Log($"[Mod] 更新后的目标文件夹已被删除：{Entry.Value}", NotifyLevel.DebugModeOnly)
Logger.Warn($"更新后的目标文件夹已被删除：{Entry.Value}")
End If
Next
Catch ex As OperationCanceledException
Log(ex, "替换旧版 Mod 文件时被主动取消")
Logger.Warn(ex, "替换旧版 Mod 文件时被主动取消")
End Try
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\"
Loader.OnStateChanged =
Sub()
@@ -634,35 +632,35 @@ Install:
Case LoadState.Finished
Select Case FinishedFileNames.Count
Case 0 '一般是由于 Mod 文件被占用，然后玩家主动取消
Log($"[Mod] 没有 Mod 被成功更新")
Logger.Info($"没有 Mod 被成功更新")
Case 1
Hint($"已成功更新 {FinishedFileNames.Single}！", HintType.Green)
Case Else
Hint($"已成功更新 {FinishedFileNames.Count} 个 Mod！", HintType.Green)
End Select
Case LoadState.Failed
Hint("Mod 更新失败：" & Loader.Error.GetBrief(), HintType.Red)
Hint("Mod 更新失败：" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted
Hint("Mod 更新已中止！", HintType.Blue)
Case Else
Return
End Select
Log($"[Mod] 已从正在进行 Mod 更新的文件夹列表移除：{PathMods}")
Logger.Info($"已从正在进行 Mod 更新的文件夹列表移除：{PathMods}")
UpdatingInstanceModFolders.Remove(PathMods)
'清理缓存
RunInNewThread(
Sub()
Try
For Each TempFile In FileCopyList.Keys
If File.Exists(TempFile) Then File.Delete(TempFile)
FileUtils.Delete(TempFile)
Next
Catch ex As Exception
Log(ex, "清理 Mod 更新缓存失败")
Logger.Warn(ex, "清理 Mod 更新缓存失败")
End Try
End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal)
End Sub
'启动加载器
Log($"[Mod] 开始更新 {ModList.Count} 个 Mod：{PathMods}")
Logger.Info($"开始更新 {ModList.Count} 个 Mod：{PathMods}")
UpdatingInstanceModFolders.Add(PathMods)
Loader.Start()
LoaderTaskbarAdd(Loader)
@@ -670,49 +668,45 @@ Install:
FrmMain.BtnExtraDownload.Ribble()
ReloadModList(True)
Catch ex As Exception
Log(ex, "初始化 Mod 更新失败")
Logger.Warn(ex, "初始化 Mod 更新失败")
End Try
End Sub
'删除
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)
End Sub
Private Sub DeleteMods(ModList As IEnumerable(Of ResourceFile))
Private Sub DeleteMods(ModsToDelete As IEnumerable(Of LocalResourceFile))
Try
Dim IsSuccessful As Boolean = True
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
'确认需要删除的文件
ModList = ModList.SelectMany(
Function(Target As ResourceFile)
Dim ModList = ModsToDelete.SelectMany(
Function(Target As LocalResourceFile)
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
Return {Target.File.FullName, Target.EnabledFullName}
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
'删除
Try
If IsShiftPressed Then
ModEntity.File.Delete()
Else
My.Computer.FileSystem.DeleteFile(ModEntity.File.FullName, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
FileUtils.Delete(ModEntity.File.FullName, Not IsShiftPressed)
Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消")
Logger.Warn(ex, "删除 Mod 被主动取消")
ReloadModList(True)
Return
Catch ex As Exception
Log(ex, $"删除 Mod 失败（{ModEntity.File.FullName}）", NotifyLevel.MsgBox)
Logger.Error(ex, $"删除 Mod 失败（{ModEntity.File.FullName}）", LogBehavior.Alert)
IsSuccessful = False
End Try
'取消选中
SelectedMods.Remove(ModEntity.EnabledName)
'更改 Loader 和 UI 中的列表
McModLoader.Output.Remove(ModEntity)
LocalResourceLoader.Output.Remove(ModEntity)
SearchResult?.Remove(ModEntity)
ModItems.Remove(ModEntity.EnabledName)
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
Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消")
Logger.Warn(ex, "删除 Mod 被主动取消")
ReloadModList(True)
Catch ex As Exception
Log(ex, "删除 Mod 出现未知错误", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "删除 Mod 出现未知错误")
ReloadModList(True)
End Try
LoaderRun(LoaderFolderRunType.UpdateOnly)
@@ -765,16 +759,12 @@ Install:
Public Sub Info_Click(sender As Object, e As EventArgs)
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
'跳转到 Mod 下载页面
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.ResourceDetail,
.Additional = {ModEntry.Project, New List(Of String), PageInstanceLeft.Instance.Version.VanillaName,
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}})
.Additional = {ModEntry.Project, New List(Of String), PageInstanceLeft.Instance.Version.VanillaName, PageInstanceLeft.Instance.Version.ModLoaders, ResourceTypes.Mod}})
Else
'获取信息
Dim ContentLines As New List(Of String)
@@ -805,7 +795,7 @@ Install:
End If
End If
Catch ex As Exception
Log(ex, "获取 Mod 详情失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "获取 Mod 详情失败")
End Try
End Sub
'打开文件所在的位置
@@ -814,7 +804,7 @@ Install:
Dim ListItem As MyLocalModItem = sender.Tag
OpenExplorer(ListItem.Entry.File.FullName)
Catch ex As Exception
Log(ex, "打开 Mod 文件位置失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "打开 Mod 文件位置失败")
End Try
End Sub
'删除
@@ -837,12 +827,12 @@ Install:
Return Not String.IsNullOrWhiteSpace(SearchBox.Text)
End Get
End Property
Private SearchResult As List(Of ResourceFile)
Private SearchResult As List(Of LocalResourceFile)
Public Sub SearchRun() Handles SearchBox.TextChanged
If IsSearching Then
'构造请求
Dim QueryList As New List(Of SearchEntry(Of ResourceFile))
For Each Entry As ResourceFile In McModLoader.Output
Dim QueryList As New List(Of SearchEntry(Of LocalResourceFile))
For Each Entry As LocalResourceFile In LocalResourceLoader.Output
Dim SearchSources As New List(Of SearchSource)
SearchSources.Add(New SearchSource(Entry.Display, 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))
SearchSources.Add(New SearchSource(String.Join("", Entry.Project.Tags), 0.2))
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
'进行搜索
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
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
BtnDownload.Visibility = NewVisibility
PanMain.TriggerForceResize()
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceOverall.xaml.vb
+33 -60
View File
@@ -65,13 +65,13 @@
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "修改版本分类失败（" & PageInstanceLeft.Instance.Name & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"修改版本分类失败（{PageInstanceLeft.Instance.Name}）")
End Try
Reload() '更新 “打开 Mod 文件夹” 按钮
Else
'改为隐藏
Try
If Not Settings.Get("HintHide") Then
If Not Settings.Get(Of Boolean)("HintHide") Then
If MyMsgBox("确认要从版本列表中隐藏该版本吗？隐藏该版本后，它将不再出现于 PCL 显示的版本列表中。" & vbCrLf & "此后，在版本列表页面按下 F11 才可以查看被隐藏的版本。", "隐藏版本提示",, "取消") <> 1 Then
ComboDisplayType.SelectedIndex = 0
Return
@@ -82,7 +82,7 @@
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "隐藏版本 " & PageInstanceLeft.Instance.Name & " 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"隐藏版本 {PageInstanceLeft.Instance.Name} 失败")
End Try
End If
End Sub
@@ -97,7 +97,7 @@
Reload()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 描述更改失败", NotifyLevel.MsgBox)
Logger.Error(ex, $"版本 {PageInstanceLeft.Instance.Name} 描述更改失败", LogBehavior.Alert)
End Try
End Sub
@@ -109,51 +109,29 @@
Dim OldPath As String = PageInstanceLeft.Instance.PathVersion
'修改此部分的同时修改快速安装的版本名检测*
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
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 中已被合并的项被重新存储
Dim JsonObject As JObject
Dim OldJsonPath As String = PageInstanceLeft.Instance.GetJsonPath()
Try
JsonObject = GetJson(ReadFile(OldJsonPath))
JsonObject = GetJson(FileUtils.ReadAsString(OldJsonPath))
Catch ex As Exception
Log(ex, "在重命名读取 json 时失败")
Logger.Warn(ex, "在重命名读取 json 时失败")
JsonObject = PageInstanceLeft.Instance.JsonObject
End Try
'重命名主文件夹
Directory.Move(OldPath, TempPath)
Directory.Move(TempPath, NewPath)
DirectoryUtils.Move(OldPath, NewPath)
'清理 ini 缓存
IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt")
IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini")
PageInstanceLeft.Instance.ResetIniCache()
'重命名 jar 文件与 natives 文件夹
'不能进行遍历重命名，否则在版本名很短的时候容易误伤其他文件（#6443）
If Directory.Exists($"{NewPath}{OldName}-natives") Then
If OnlyChangedCase Then
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 DirectoryUtils.Exists($"{NewPath}{OldName}-natives") Then DirectoryUtils.Move($"{NewPath}{OldName}-natives", $"{NewPath}{NewName}-natives")
If FileUtils.Exists($"{NewPath}{OldName}.jar") Then FileUtils.Move($"{NewPath}{OldName}.jar", $"{NewPath}{NewName}.jar")
'替换版本设置文件中的路径
If File.Exists(NewPath & "PCL\Setup.ini") Then
FileUtils.Write(NewPath & "PCL\Setup.ini", ReadFile(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath))
If FileUtils.Exists(NewPath & "PCL\Setup.ini") Then
FileUtils.Write(NewPath & "PCL\Setup.ini", FileUtils.ReadAsString(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath))
End If
'更改已选中的版本
If ReadIni(McFolderSelected & "PCL.ini", "Version") = OldName Then
@@ -162,10 +140,10 @@
'更新版本 Json
Try
JsonObject("id") = NewName
FileUtils.Delete(NewPath & PathUtils.GetLastPart(OldJsonPath))
FileUtils.Write(NewPath & NewName & ".json", JsonObject.ToString)
File.Delete(NewPath & GetFileNameFromPath(OldJsonPath))
Catch ex As Exception
Log(ex, "重命名版本 json 失败")
Logger.Warn(ex, "重命名版本 json 失败")
End Try
'刷新与提示
Hint("重命名成功！", HintType.Green)
@@ -174,7 +152,7 @@
Reload()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "重命名版本失败", NotifyLevel.MsgBox)
Logger.Error(ex, "重命名版本失败", LogBehavior.Alert)
End Try
End Sub
@@ -184,17 +162,17 @@
'选择 自定义 时修改图片
Try
If ComboDisplayLogo.SelectedItem Is ItemDisplayLogoCustom Then
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpeg;*.jpg;*.gif;*.webp)|*.png;*.jpeg;*.jpg;*.gif;*.webp", "选择图片")
If FileName = "" Then
Dim FileName As String = Dialogs.SelectFile("选择图片", False, filter:={({"png", "jpeg", "jpg", "gif", "webp"}, "常用图片文件")}).FirstOrDefault()
If String.IsNullOrEmpty(FileName) Then
Reload() '还原选项
Return
End If
CopyFile(FileName, PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
FileUtils.Copy(FileName, PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
Else
File.Delete(PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
FileUtils.Delete(PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
End If
Catch ex As Exception
Log(ex, "更改自定义版本图标失败（" & PageInstanceLeft.Instance.Name & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"更改自定义版本图标失败（{PageInstanceLeft.Instance.Name}）")
End Try
'进行更改
Try
@@ -207,7 +185,7 @@
Reload()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "更改版本图标失败（" & PageInstanceLeft.Instance.Name & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"更改版本图标失败（{PageInstanceLeft.Instance.Name}）")
End Try
End Sub
@@ -220,7 +198,7 @@
McInstanceListForceRefresh = True
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 收藏状态更改失败", NotifyLevel.MsgBox)
Logger.Error(ex, $"版本 {PageInstanceLeft.Instance.Name} 收藏状态更改失败", LogBehavior.Alert)
End Try
End Sub
@@ -258,8 +236,8 @@
Private Sub BtnManageScript_Click() Handles BtnManageScript.Click
Try
'弹窗要求指定脚本的保存位置
Dim SavePath As String = SelectSaveFile("选择脚本保存位置", "启动 " & PageInstanceLeft.Instance.Name & ".bat", "批处理文件(*.bat)|*.bat")
If SavePath = "" Then Return
Dim SavePath As String = Dialogs.SaveFile("选择脚本保存位置", "启动 " & PageInstanceLeft.Instance.Name & ".bat", filter:={("bat", "批处理文件")})
If SavePath Is Nothing Then Return
'检查中断（等玩家选完弹窗指不定任务就结束了呢……）
If McLaunchLoader.State = LoadState.Loading Then
Hint("请在当前启动任务结束后再试！", HintType.Red)
@@ -267,14 +245,14 @@
End If
'生成脚本
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("正在导出启动脚本……")
Else
Hint("正在导出启动脚本……（注意，使用脚本启动可能会导致登录失效！）")
End If
End If
Catch ex As Exception
Log(ex, "导出启动脚本失败（" & PageInstanceLeft.Instance.Name & "）", NotifyLevel.MsgBox)
Logger.Error(ex, $"导出启动脚本失败（{PageInstanceLeft.Instance.Name}）", LogBehavior.Alert)
End Try
End Sub
@@ -300,7 +278,7 @@
Case LoadState.Finished
Hint(Loader.Name & "成功！", HintType.Green)
Case LoadState.Failed
Hint(Loader.Name & "失败：" & Loader.Error.GetBrief(), HintType.Red)
Hint(Loader.Name & "失败：" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted
Hint(Loader.Name & "已取消！", HintType.Blue)
End Select
@@ -310,7 +288,7 @@
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "尝试补全文件失败（" & PageInstanceLeft.Instance.Name & "）", NotifyLevel.MsgBox)
Logger.Error(ex, $"尝试补全文件失败（{PageInstanceLeft.Instance.Name}）", LogBehavior.Alert)
End Try
End Sub
@@ -324,13 +302,8 @@
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""),
"版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed)
Case 1
IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt")
IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(PageInstanceLeft.Instance.PathVersion)
Else
FileIO.FileSystem.DeleteDirectory(PageInstanceLeft.Instance.PathVersion, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
PageInstanceLeft.Instance.ResetIniCache()
DirectoryUtils.Delete(PageInstanceLeft.Instance.PathVersion, Not IsShiftPressed)
Hint("已删除版本 " & PageInstanceLeft.Instance.Name & "！", HintType.Green)
Case 2
Return
@@ -338,9 +311,9 @@
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
FrmMain.PageBack()
Catch ex As OperationCanceledException
Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 被主动取消")
Logger.Warn(ex, $"删除版本 {PageInstanceLeft.Instance.Name} 被主动取消")
Catch ex As Exception
Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 失败", NotifyLevel.MsgBox)
Logger.Error(ex, $"删除版本 {PageInstanceLeft.Instance.Name} 失败", LogBehavior.Alert)
End Try
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" />
<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" />
<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:ValidateExcept>
<local:ValidateExcept.Excepts>
@@ -250,7 +250,7 @@
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"
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>
</Grid>
</local:MyCard>
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceSetup.xaml.vb
+18 -18
View File
@@ -28,17 +28,17 @@
'启动参数
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()
'服务器
ComboServerLogin.SelectedIndex = Settings.Get("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
ComboServerLogin.SelectedIndex = Settings.Get(Of Integer)("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
ComboServerLoginLast = ComboServerLogin.SelectedIndex
UpdateServerLoginUI()
'高级设置
If Settings.Get("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) = 2 Then
Log("[Setup] 已迁移老版本的关闭文件校验设置")
If Settings.Get(Of Integer)("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) = 2 Then
Logger.Info("已迁移老版本的关闭文件校验设置")
Settings.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance)
Settings.Set("VersionAdvanceAssetsV2", True, Instance:=PageInstanceLeft.Instance)
End If
@@ -46,10 +46,10 @@
SettingService.RefreshSettings(Me)
'游戏内存
OnVersionRamTypeChanged(Settings.Get("VersionRamType", Instance:=PageInstanceLeft.Instance))
OnVersionRamTypeChanged(Settings.Get(Of Integer)("VersionRamType", Instance:=PageInstanceLeft.Instance))
Catch ex As Exception
Log(ex, "重载版本独立设置时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "重载版本独立设置时出错")
End Try
End Sub
@@ -65,10 +65,10 @@
Settings.Reset("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
JavaSearchLoader.Start(IsForceRestart:=True)
Log("[Setup] 已初始化版本独立设置")
Logger.Info("已初始化版本独立设置")
Hint("已初始化版本独立设置！", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化版本独立设置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "初始化版本独立设置失败", LogBehavior.Alert)
End Try
Reload()
@@ -219,7 +219,7 @@
''' </summary>
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)
End If
@@ -229,7 +229,7 @@
'使用当前版本的设置
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
'确定需求的内存值
@@ -240,7 +240,7 @@
If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load()
If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 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)
RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90
@@ -285,7 +285,7 @@ PreFin:
RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1)
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
RamGive = Value * 0.1 + 0.3
ElseIf Value <= 25 Then
@@ -374,10 +374,10 @@ PreFin:
'初始化列表
ComboArgumentJava.Items.Clear()
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 SelectedBySetup As String = Settings.Get("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
Dim SelectedBySetup As String = Settings.Get(Of String)("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
Try
For Each Java In JavaList.ToList().OrderByDescending(Function(v) v.MajorVersion)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
@@ -389,7 +389,7 @@ PreFin:
Next
Catch ex As Exception
Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log(ex, "更新版本设置 Java 下拉框失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "更新版本设置 Java 下拉框失败")
End Try
'更新选择项
If SelectedItem Is Nothing AndAlso JavaList.Any Then
@@ -424,15 +424,15 @@ PreFin:
If "使用全局设置".Equals(SelectedJava) Then
'选择 “自动”
Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置：跟随全局设置")
Logger.Info("修改版本 Java 选择设置：跟随全局设置")
ElseIf "自动选择".Equals(SelectedJava) Then
'选择 “自动”
Settings.Set("VersionArgumentJavaSelect", "", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置：自动选择")
Logger.Info("修改版本 Java 选择设置：自动选择")
Else
'选择指定项
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
RefreshRam(True)
End Sub
Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml.vb
+6 -6
View File
@@ -20,7 +20,7 @@
Data = Converter.Content
Init()
Catch ex As Exception
Log(ex, "登录弹窗初始化失败", NotifyLevel.AllUsers)
Logger.Error(ex, "登录弹窗初始化失败", LogBehavior.Toast)
End Try
End Sub
@@ -35,9 +35,9 @@
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyMsgBox " & Uuid)
'记录日志
Log("[Control] 登录弹窗：" & LabTitle.Text & vbCrLf & LabCaption.Text)
Logger.Info($"登录弹窗：{LabTitle.Text}{vbCrLf}{LabCaption.Text}")
Catch ex As Exception
Log(ex, "登录弹窗加载失败", NotifyLevel.AllUsers)
Logger.Error(ex, "登录弹窗加载失败", LogBehavior.Toast)
End Try
End Sub
Private Sub Close()
@@ -123,8 +123,8 @@
Return
Catch ex As Exception
'修改错误列表时，同时修改 ModLaunch.MsLoginStep1Refresh 中的对应代码
If TypeOf ex Is ResponsedWebException Then
Dim Response = CType(ex, ResponsedWebException).Response
If TypeOf ex Is HttpRequestCodeException Then
Dim Response = CType(ex, HttpRequestCodeException).Response
If Response.Contains("authorization_declined") Then
Finished(New Exception("$你拒绝了 PCL 申请的权限……"))
Return
@@ -147,7 +147,7 @@
End If
If UnknownFailureCount <= 2 Then
UnknownFailureCount += 1
Log(ex, $"登录轮询第 {UnknownFailureCount} 次失败")
Logger.Warn(ex, $"登录轮询第 {UnknownFailureCount} 次失败")
Thread.Sleep(2000)
Else
Finished(New Exception("登录轮询失败", ex))
Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb
+22 -21
View File
@@ -14,7 +14,7 @@
ToolTip = If(_Address = "", "加载中", "点击更换皮肤（右键查看更多选项）")
End Set
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
@@ -44,7 +44,7 @@
Public Sub BtnSkinSave_Click() Handles BtnSkinSave.Click
Save(Loader)
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
If Not Loader.State = LoadState.Finished Then
Hint("皮肤正在获取中，请稍候！", HintType.Red)
@@ -52,19 +52,20 @@
Return
End If
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
File.Delete(FileAddress)
FileUtils.Delete(FileAddress)
If Address.StartsWithF(PathImage) Then
Dim Image As New MyBitmap(Address)
Image.Save(FileAddress)
Else
CopyFile(Address, FileAddress)
FileUtils.Copy(Address, FileAddress)
End If
Hint("皮肤保存成功！", HintType.Green)
End If
Catch ex As Exception
Log(ex, "保存皮肤失败", NotifyLevel.AllUsers)
Logger.Error(ex, "保存皮肤失败", LogBehavior.Toast)
End Try
End Sub
Private Sub BtnSkinSave_Checked(sender As MyMenuItem, e As RoutedEventArgs) Handles BtnSkinSave.Checked
@@ -79,14 +80,14 @@
'检查文件存在
Address = Loader.Output
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
Try
Image = New MyBitmap(Address)
Catch ex As Exception '#2272
Log(ex, $"皮肤文件已损坏：{Address}", NotifyLevel.AllUsers)
File.Delete(Address)
Logger.Error(ex, $"皮肤文件已损坏：{Address}", LogBehavior.Toast)
FileUtils.Delete(Address)
Return
End Try
ImgBack.Tag = Address
@@ -113,9 +114,9 @@
End If
'脸层
ImgBack.Source = Image.Clip(Scale * 8, Scale * 8, Scale * 8, Scale * 8)
Log("[Skin] 载入头像成功：" & Loader.Name)
Logger.Info($"载入头像成功：{Loader.Name}")
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 Sub
''' <summary>
@@ -134,7 +135,7 @@
''' <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
For Each SkinLoader In PageLaunchLeft.SkinLoaders
If SkinLoader.State = LoadState.Loading Then
@@ -150,9 +151,9 @@
Try
Hint("正在刷新头像……")
'清空缓存
Log("[Skin] 正在清空皮肤缓存")
If Directory.Exists(PathTemp & "Cache\Skin") Then DeleteDirectory(PathTemp & "Cache\Skin")
If Directory.Exists(PathTemp & "Cache\Uuid") Then DeleteDirectory(PathTemp & "Cache\Uuid")
Logger.Info("正在清空皮肤缓存")
If DirectoryUtils.Exists(PathTemp & "Cache\Skin") Then DirectoryUtils.Delete(PathTemp & "Cache\Skin")
If DirectoryUtils.Exists(PathTemp & "Cache\Uuid") Then DirectoryUtils.Delete(PathTemp & "Cache\Uuid")
IniClearCache(PathTemp & "Cache\Skin\IndexMs.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexNide.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexAuth.ini")
@@ -163,7 +164,7 @@
Next
Hint("已刷新头像！", HintType.Green)
Catch ex As Exception
Log(ex, "刷新皮肤缓存失败", NotifyLevel.MsgBox)
Logger.Error(ex, "刷新皮肤缓存失败", LogBehavior.Alert)
End Try
End Sub)
End If
@@ -177,8 +178,8 @@
Sub()
Try
'更新缓存
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Settings.Get("CacheMsV2Uuid"), SkinAddress)
Log($"[Skin] 已写入皮肤地址缓存 {Settings.Get("CacheMsV2Uuid")} -> {SkinAddress}")
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Settings.Get(Of String)("CacheMsV2Uuid"), SkinAddress)
Logger.Info($"已写入皮肤地址缓存 {Settings.Get(Of String)("CacheMsV2Uuid")} -> {SkinAddress}")
'刷新控件
For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}
SkinLoader.WaitForExit(IsForceRestart:=True)
@@ -186,7 +187,7 @@
'完成提示
Hint("更改皮肤成功！", HintType.Green)
Catch ex As Exception
Log(ex, "更改正版皮肤后刷新皮肤失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "更改正版皮肤后刷新皮肤失败")
End Try
End Sub)
End Sub
@@ -255,7 +256,7 @@ Retry:
Next
SelectedIndex = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception
Log(ex, "获取玩家皮肤列表失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "获取玩家皮肤列表失败")
End Try
End Sub)
If SelectedIndex Is Nothing Then Return
@@ -278,7 +279,7 @@ Retry:
McLoginMsLoader.Output.ProfileJson = SkinData.ToString()
End If
Catch ex As Exception
Log(ex, "更改披风失败", NotifyLevel.AllUsers)
Logger.Error(ex, "更改披风失败", LogBehavior.Toast)
Finally
IsChanging = False
End Try
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb
+92 -92
View File
@@ -23,39 +23,39 @@
Sub()
'自动整合包安装：准备
Dim PackInstallPath As String = Nothing
If File.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.zip") Then PackInstallPath = PathExeFolder & "modpack.zip"
If FileUtils.Exists(PathExeFolder & "modpack.mrpack") Then PackInstallPath = PathExeFolder & "modpack.mrpack"
If PackInstallPath IsNot Nothing Then
Log("[Launch] 需自动安装整合包：" & PackInstallPath, NotifyLevel.DebugModeOnly)
Logger.Warn($"需自动安装整合包：{PackInstallPath}")
PageSelectLeft.CreateMcFolderInCurrentPath()
McFolderListLoader.WaitForExit()
End If
'确认 Minecraft 文件夹存在
If McFolderSelected = "" OrElse Not Directory.Exists(McFolderSelected) Then
If McFolderSelected = "" OrElse Not DirectoryUtils.Exists(McFolderSelected) Then
'无效的文件夹
If McFolderSelected = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹")
Logger.Info("没有已储存的 Minecraft 文件夹")
Else
Log("[Launch] Minecraft 文件夹无效，该文件夹已不存在：" & McFolderSelected, NotifyLevel.DebugModeOnly)
Logger.Warn($"Minecraft 文件夹无效，该文件夹已不存在：{McFolderSelected}")
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
McFolderSelected = McFolderList.First.Location
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
Try
Dim InstallLoader = ModpackInstall(PackInstallPath)
Log("[Launch] 自动安装整合包已开始：" & PackInstallPath)
Logger.Info($"自动安装整合包已开始：{PackInstallPath}")
InstallLoader.WaitForExit()
If InstallLoader.State = LoadState.Finished Then
Log("[Launch] 自动安装整合包成功，清理安装包：" & PackInstallPath)
If File.Exists(PackInstallPath) Then File.Delete(PackInstallPath)
Logger.Info($"自动安装整合包成功，清理安装包：{PackInstallPath}")
FileUtils.Delete(PackInstallPath)
End If
Catch ex As CancelledException
Log(ex, "自动安装整合包被用户取消：" & PackInstallPath)
Logger.Warn(ex, $"自动安装整合包被用户取消：{PackInstallPath}")
Catch ex As Exception
Log(ex, "自动安装整合包失败：" & PackInstallPath, NotifyLevel.MsgBox)
Logger.Error(ex, $"自动安装整合包失败：{PackInstallPath}", LogBehavior.Alert)
End Try
End If
'确认 Minecraft 版本存在
@@ -63,14 +63,14 @@
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
'无效的版本
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 McInstanceList.Any() OrElse McInstanceList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Instance = Nothing
Log("[Launch] 无可用 Minecraft 版本")
Logger.Info("无可用 Minecraft 版本")
Else
Instance = McInstanceList.First.Value(0)
Log("[Launch] 自动选择 Minecraft 版本：" & Instance.PathVersion)
Logger.Info($"自动选择 Minecraft 版本：{Instance.PathVersion}")
End If
End If
RunInUi(
@@ -85,7 +85,7 @@
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
RefreshPage(False, False)
@@ -99,7 +99,7 @@
''' </summary>
Public Sub PageChangeToLaunching()
'修改登陆方式
Select Case Settings.Get("LoginType")
Select Case Settings.Get(Of McLoginType)("LoginType")
Case McLoginType.Legacy
LabLaunchingMethod.Text = "离线登录"
Case McLoginType.Ms
@@ -257,7 +257,7 @@
PageCurrent = Type
Return PageNew
Catch ex As Exception
Log(ex, "切换登录分页失败（" & GetStringFromEnum(CType(Type, [Enum])) & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换登录分页失败（{Type}）")
Return PageNew
End Try
End Function
@@ -270,17 +270,17 @@
Dim Type As PageType
Dim LoginPageType As Integer
If McInstanceSelected IsNot Nothing Then
LoginPageType = Settings.Get("VersionServerLogin", Instance:=McInstanceSelected)
LoginPageType = Settings.Get(Of Integer)("VersionServerLogin", Instance:=McInstanceSelected)
'缓存当前版本的页面种类，下一次打开 McInstanceSelected 为空时才能加载出正确的页面
Settings.Set("LoginPageType", LoginPageType)
Else
LoginPageType = Settings.Get("LoginPageType")
LoginPageType = Settings.Get(Of Integer)("LoginPageType")
End If
Select Case LoginPageType
Case 0 '正版或离线
UnknownType:
If RadioLoginType5.Checked Then
If Settings.Get("CacheMsV2Access") = "" Then
If Settings.Get(Of String)("CacheMsV2Access") = "" Then
Type = PageType.Ms
Else
Type = PageType.MsSkin
@@ -295,7 +295,7 @@ UnknownType:
RadioLoginType5.Visibility = Visibility.Visible
RadioLoginType0.Visibility = Visibility.Visible
Case 1 '仅正版
If Settings.Get("CacheMsV2Access") = "" Then
If Settings.Get(Of String)("CacheMsV2Access") = "" Then
Type = PageType.Ms
Else
Type = PageType.MsSkin
@@ -315,7 +315,7 @@ UnknownType:
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonOffline)
LabTypeOne.Text = "离线登录"
Case 3 '统一通行证
If Settings.Get("CacheNideAccess") = "" Then
If Settings.Get(Of String)("CacheNideAccess") = "" Then
Type = PageType.Nide
Else
Type = PageType.NideSkin
@@ -326,7 +326,7 @@ UnknownType:
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard)
LabTypeOne.Text = "统一通行证登录"
Case 4 'Authlib-Injector
If Settings.Get("CacheAuthAccess") = "" Then
If Settings.Get(Of String)("CacheAuthAccess") = "" Then
Type = PageType.Auth
Else
Type = PageType.AuthSkin
@@ -335,16 +335,16 @@ UnknownType:
PanType.Visibility = Visibility.Collapsed
PanTypeOne.Visibility = Visibility.Visible
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 = "第三方登录"
Case Else
Log("[Control] 未知的登录页面：" & LoginPageType, NotifyLevel.AllUsers)
Logger.Error($"未知的登录页面：{LoginPageType}", LogBehavior.Toast)
GoTo UnknownType
End Select
'刷新页面
If PageCurrent = Type Then Return
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
End Sub
Private Sub RadioLoginType_Change(sender As Object, raiseByMouse As Boolean) Handles RadioLoginType0.Check, RadioLoginType5.Check
@@ -356,21 +356,21 @@ UnknownType:
#Region "皮肤"
'微软正版皮肤
Public Shared SkinMs As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal)
Private Shared Function SkinMsInput() As EqualableList(Of String)
Public Shared SkinMs As New LoaderTask(Of (String, String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal)
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
Private Shared Sub SkinMsLoad(Data As LoaderTask(Of EqualableList(Of String), String))
Private Shared Sub SkinMsLoad(Data As LoaderTask(Of (String, String), String))
'清空已有皮肤
'如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载
RunInUi(Sub() If FrmLoginMsSkin IsNot Nothing AndAlso FrmLoginMsSkin.Skin IsNot Nothing Then FrmLoginMsSkin.Skin.Clear())
'获取 Url
Dim UserName As String = Data.Input(0)
Dim Uuid As String = Data.Input(1)
Dim UserName As String = Data.Input.Item1
Dim Uuid As String = Data.Input.Item2
If UserName = "" Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取微软正版皮肤失败，ID 为空")
Logger.Info("获取微软正版皮肤失败，ID 为空")
GoTo Finish
End If
Try
@@ -383,15 +383,15 @@ UnknownType:
Data.Output = ""
Return
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"
Log("[Minecraft] 获取正版皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", NotifyLevel.AllUsers)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then
Logger.Error($"获取正版皮肤失败（{UserName}）：获取皮肤太过频繁，请 5 分钟后再试！", LogBehavior.Toast)
ElseIf ex.GetDisplay(False).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载")
Logger.Info("用户未设置自定义皮肤，跳过皮肤加载")
Else
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log(ex, "获取微软正版皮肤失败（" & UserName & "）", NotifyLevel.AllUsers)
Logger.Error(ex, $"获取微软正版皮肤失败（{UserName}）", LogBehavior.Toast)
End If
End Try
Finish:
@@ -404,39 +404,39 @@ Finish:
End Sub
'离线皮肤
Public Shared SkinLegacy As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Legacy", AddressOf SkinLegacyLoad, AddressOf SkinLegacyInput, ThreadPriority.AboveNormal)
Private Shared Function SkinLegacyInput() As EqualableList(Of String)
Public Shared SkinLegacy As New LoaderTask(Of (String, String), String)("Loader Skin Legacy", AddressOf SkinLegacyLoad, AddressOf SkinLegacyInput, ThreadPriority.AboveNormal)
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
Case 0
If FrmLoginLegacy IsNot Nothing AndAlso FrmLoginLegacy.IsReloaded Then
Return New EqualableList(Of String) From {0, If(FrmLoginLegacy.ComboName.Text.Trim, "")}
ElseIf Settings.Get("LoginLegacyName") = "" Then
Return New EqualableList(Of String) From {0, ""}
If FrmLoginLegacy?.IsReloaded Then
Return ("0", If(FrmLoginLegacy.ComboName.Text.Trim, ""))
ElseIf Settings.Get(Of String)("LoginLegacyName") = "" Then
Return ("0", "")
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
Case 3
Return New EqualableList(Of String) From {3, Settings.Get("LaunchSkinID")}
Return ("3", Settings.Get(Of String)("LaunchSkinID"))
Case Else
Return New EqualableList(Of String) From {Type}
Return (Type.ToString, "")
End Select
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())
'获取 Url
Select Case Data.Input(0)
Select Case CInt(Data.Input.Item1)
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
UseDefault:
Data.Output = PathImage & "Skins/Steve.png"
Case 2 'Alex
Data.Output = PathImage & "Skins/Alex.png"
Case 3 '正版
Dim ID As String = Data.Input(1)
Dim ID As String = Data.Input.Item2
Try
If ID.Count < 2 Then
Data.Output = PathImage & "Skins/Steve.png"
@@ -453,16 +453,16 @@ UseDefault:
Data.Output = ""
Return
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"
Log("获取离线登录使用的正版皮肤失败（" & ID & "）：获取皮肤太过频繁，请 5 分钟后再试！")
Logger.Info($"获取离线登录使用的正版皮肤失败（{ID}）：获取皮肤太过频繁，请 5 分钟后再试！")
Else
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png"
Log(ex, "获取离线登录使用的正版皮肤失败（" & ID & "）")
Logger.Warn(ex, $"获取离线登录使用的正版皮肤失败（{ID}）")
End If
End Try
Case 4 '自定义
If Not File.Exists(PathAppdata & "CustomSkin.png") Then
If Not FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
Hint("未找到离线皮肤自定义文件，可能它已被删除。PCL 将使用默认的 Steve 皮肤！")
Settings.Set("LaunchSkinType", 1)
GoTo UseDefault
@@ -478,21 +478,21 @@ UseDefault:
End Sub
'统一通行证皮肤
Public Shared SkinNide As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Nide", AddressOf SkinNideLoad, AddressOf SkinNideInput, ThreadPriority.AboveNormal)
Private Shared Function SkinNideInput() As EqualableList(Of String)
Public Shared SkinNide As New LoaderTask(Of (String, String), String)("Loader Skin Nide", AddressOf SkinNideLoad, AddressOf SkinNideInput, ThreadPriority.AboveNormal)
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
Private Shared Sub SkinNideLoad(Data As LoaderTask(Of EqualableList(Of String), String))
Private Shared Sub SkinNideLoad(Data As LoaderTask(Of (String, String), String))
'清空已有皮肤
'如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载
RunInUi(Sub() If FrmLoginNideSkin IsNot Nothing AndAlso FrmLoginNideSkin.Skin IsNot Nothing Then FrmLoginNideSkin.Skin.Clear())
'获取 Url
Dim UserName As String = Data.Input(0)
Dim Uuid As String = Data.Input(1)
Dim UserName As String = Data.Input.Item1
Dim Uuid As String = Data.Input.Item2
If UserName = "" Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取统一通行证皮肤失败，ID 为空")
Logger.Info("获取统一通行证皮肤失败，ID 为空")
GoTo Finish
End If
Try
@@ -505,15 +505,15 @@ UseDefault:
Data.Output = ""
Return
Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then
If ex.GetDisplay(False).Contains("(429)") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取统一通行证皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", NotifyLevel.AllUsers)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then
Logger.Error($"获取统一通行证皮肤失败（{UserName}）：获取皮肤太过频繁，请 5 分钟后再试！", LogBehavior.Toast)
ElseIf ex.GetDisplay(False).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载")
Logger.Info("用户未设置自定义皮肤，跳过皮肤加载")
Else
Data.Output = PathImage & "Skins/Steve.png"
Log(ex, "获取统一通行证皮肤失败（" & UserName & "）", NotifyLevel.AllUsers)
Logger.Error(ex, $"获取统一通行证皮肤失败（{UserName}）", LogBehavior.Toast)
End If
End Try
Finish:
@@ -526,21 +526,21 @@ Finish:
End Sub
'Authlib-Injector 皮肤
Public Shared SkinAuth As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Auth", AddressOf SkinAuthLoad, AddressOf SkinAuthInput, ThreadPriority.AboveNormal)
Private Shared Function SkinAuthInput() As EqualableList(Of String)
Public Shared SkinAuth As New LoaderTask(Of (String, String), String)("Loader Skin Auth", AddressOf SkinAuthLoad, AddressOf SkinAuthInput, ThreadPriority.AboveNormal)
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
Private Shared Sub SkinAuthLoad(Data As LoaderTask(Of EqualableList(Of String), String))
Private Shared Sub SkinAuthLoad(Data As LoaderTask(Of (String, String), String))
'清空已有皮肤
'如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载
RunInUi(Sub() If FrmLoginAuthSkin IsNot Nothing AndAlso FrmLoginAuthSkin.Skin IsNot Nothing Then FrmLoginAuthSkin.Skin.Clear())
'获取 Url
Dim UserName As String = Data.Input(0)
Dim UUID As String = Data.Input(1)
Dim UserName As String = Data.Input.Item1
Dim UUID As String = Data.Input.Item2
If UserName = "" Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取 Authlib-Injector 皮肤失败，ID 为空")
Logger.Info("获取 Authlib-Injector 皮肤失败，ID 为空")
GoTo Finish
End If
Try
@@ -553,15 +553,15 @@ Finish:
Data.Output = ""
Return
Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then
If ex.GetDisplay(False).Contains("(429)") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取 Authlib-Injector 皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", NotifyLevel.AllUsers)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then
Logger.Error($"获取 Authlib-Injector 皮肤失败（{UserName}）：获取皮肤太过频繁，请 5 分钟后再试！", LogBehavior.Toast)
ElseIf ex.GetDisplay(False).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载")
Logger.Info("用户未设置自定义皮肤，跳过皮肤加载")
Else
Data.Output = PathImage & "Skins/Steve.png"
Log(ex, "获取 Authlib-Injector 皮肤失败（" & UserName & "）", NotifyLevel.AllUsers)
Logger.Error(ex, $"获取 Authlib-Injector 皮肤失败（{UserName}）", LogBehavior.Toast)
End If
End Try
Finish:
@@ -575,7 +575,7 @@ Finish:
'全部皮肤加载器
'需要放在其中元素的后面，否则会因为它提前被加载而莫名其妙变成 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
@@ -616,7 +616,7 @@ Finish:
CurrentState = 0
Else
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
Else
CurrentState = 2
@@ -632,28 +632,28 @@ Finish:
BtnLaunchState = CurrentState
Select Case CurrentState
Case 0
Log("[Minecraft] 启动按钮：正在加载 Minecraft 版本")
Logger.Info("启动按钮：正在加载 Minecraft 版本")
FrmLaunchLeft.BtnLaunch.Text = "正在加载"
FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "正在加载中，请稍候"
FrmLaunchLeft.BtnVersion.IsEnabled = False
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 1
Log("[Minecraft] 启动按钮：无 Minecraft 版本，下载已禁用")
Logger.Info("启动按钮：无 Minecraft 版本，下载已禁用")
FrmLaunchLeft.BtnLaunch.Text = "启动游戏"
FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "未找到可用的游戏版本"
FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 2
Log("[Minecraft] 启动按钮：无 Minecraft 版本，要求下载")
Logger.Info("启动按钮：无 Minecraft 版本，要求下载")
FrmLaunchLeft.BtnLaunch.Text = "下载游戏"
FrmLaunchLeft.BtnLaunch.IsEnabled = True
FrmLaunchLeft.LabVersion.Text = "未找到可用的游戏版本"
FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 3
Log("[Minecraft] 启动按钮：Minecraft 版本：" & McInstanceSelected.PathVersion)
Logger.Info($"启动按钮：Minecraft 版本：{McInstanceSelected.PathVersion}")
FrmLaunchLeft.BtnLaunch.Text = "启动游戏"
FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnLaunch.IsEnabled = True
@@ -662,7 +662,7 @@ Finish:
End Select
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
FrmLaunchLeft.BtnMore.Visibility = FrmLaunchLeft.BtnVersion.Visibility
End If
@@ -679,7 +679,7 @@ ExitRefresh:
If Not McLaunchProcess.HasExited Then McLaunchProcess.Kill()
End If
Catch ex As Exception
Log(ex, "取消启动结束进程失败", NotifyLevel.AllUsers)
Logger.Error(ex, "取消启动结束进程失败", LogBehavior.Toast)
End Try
End If
End Sub
@@ -708,7 +708,7 @@ ExitRefresh:
Next
LabLaunchingStage.Text = "已完成"
Catch ex As Exception
Log(ex, "获取是否启动完成失败，可能是由于启动状态改变导致集合已修改")
Logger.Warn(ex, "获取是否启动完成失败，可能是由于启动状态改变导致集合已修改")
Return
End Try
LabLaunchingTitle.Text = If(IsLaunched OrElse McLaunchLoaderReal.State = LoadState.Finished,
@@ -733,7 +733,7 @@ ExitRefresh:
Next
End If
Catch ex As Exception
Log(ex, "获取 Minecraft 启动下载器失败，可能是因为启动被取消")
Logger.Warn(ex, "获取 Minecraft 启动下载器失败，可能是因为启动被取消")
HasLaunchDownloader = False
End Try
LabLaunchingDownload.Text = FormatFileSize(NetManager.Speed) & "/s"
@@ -769,7 +769,7 @@ ExitRefresh:
End If
AniStart(AnimList, "Launching Progress")
Catch ex As Exception
Log(ex, "刷新启动信息失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新启动信息失败")
End Try
End Sub
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 =
(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
#Region "主页"
@@ -25,25 +25,25 @@ Public Class PageLaunchRight
RefreshReal()
End SyncLock
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 Sub)
End Sub
Private Sub RefreshReal()
Dim Content As String = Nothing, Url As String = Nothing
Select Case Settings.Get("UiCustomType")
Select Case Settings.Get(Of Integer)("UiCustomType")
Case 1
'加载本地文件
Log("[Page] 主页自定义数据来源：本地文件")
Content = ReadFile(PathExeFolder & "PCL\Custom.xaml") 'ReadFile 会进行存在检测
Logger.Info("主页自定义数据来源：本地文件")
Content = FileUtils.TryReadAsString(PathExeFolder & "PCL\Custom.xaml")
Case 2
'联网下载
Url = Settings.Get("UiCustomNet")
Url = Settings.Get(Of String)("UiCustomNet")
Case 3
'预设
Select Case Settings.Get("UiCustomPreset")
Select Case Settings.Get(Of Integer)("UiCustomPreset")
Case 0
Log("[Page] 主页预设：你知道吗")
Logger.Info("主页预设：你知道吗")
Content = "
<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}"" />
@@ -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"" />
</local:MyCard>"
Case 1
Log("[Page] 主页预设：回声洞")
Logger.Info("主页预设：回声洞")
Content = "
<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}"" />
@@ -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"" />
</local:MyCard>"
Case 2
Log("[Page] 主页预设：Minecraft 新闻")
Logger.Info("主页预设：Minecraft 新闻")
Url = "https://mcnews.meloong.com"
Case 3
Log("[Page] 主页预设：简单主页")
Logger.Info("主页预设：简单主页")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/MFn233/Custom.xaml"
Case 4
Log("[Page] 主页预设：每日整合包推荐")
Logger.Info("主页预设：每日整合包推荐")
Url = "https://pclsub.sodamc.com/"
Case 5
Log("[Page] 主页预设：Minecraft 皮肤推荐")
Logger.Info("主页预设：Minecraft 皮肤推荐")
Url = "https://forgepixel.com/pcl_sub_file"
Case 6
Log("[Page] 主页预设：OpenBMCLAPI 仪表盘 Lite")
Logger.Info("主页预设：OpenBMCLAPI 仪表盘 Lite")
Url = "https://pcl-bmcl.milu.ink/"
Case 7
Log("[Page] 主页预设：主页市场")
Logger.Info("主页预设：主页市场")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/p/Homepages/Homepage.Market/Custom.xaml"
Case 8
Log("[Page] 主页预设：更新日志")
Logger.Info("主页预设：更新日志")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/Joker2184/UpdateHomepage.xaml"
Case 9
Log("[Page] 主页预设：PCL 新功能说明书")
Logger.Info("主页预设：PCL 新功能说明书")
Url = "https://raw.gitcode.com/WForst-Breeze/WhatsNewPCL/raw/main/Custom.xaml"
Case 10
Log("[Page] 主页预设：OpenMCIM Dashboard")
Logger.Info("主页预设：OpenMCIM Dashboard")
Url = "https://files.mcimirror.top/PCL"
Case 11
Log("[Page] 主页预设：杂志主页")
Logger.Info("主页预设：杂志主页")
Url = "http://118.195.192.193:26995/d/magazine-homepage-pcl/Custom.xaml"
Case 12
Log("[Page] 主页预设：PCL GitHub 仪表盘")
Url = "https://ddf.pcl-community.org/Custom.xaml"
Logger.Info("主页预设：PCL GitHub 仪表盘")
Url = "https://ddf.pcl-community.top/Custom.xaml"
Case 13
Log("[Page] 主页预设：PCL 更新摘要")
Logger.Info("主页预设：PCL 更新摘要")
Url = "https://raw.gitcode.com/ENC_Euphony/PCL-AI-Summary-HomePage/raw/master/Custom.xaml"
Case 14
Log("[Page] 主页预设：今日新闻热点")
Logger.Info("主页预设：今日新闻热点")
Url = "https://pcl.wyc-w.top/index.xaml"
Case 15
Log("[Page] 主页预设：Minecraft 芝士站")
Logger.Info("主页预设：Minecraft 芝士站")
Url = "https://www.xxag.top/mkss"
Case 16
Logger.Info("主页预设：整合包推荐引擎")
Url = "https://qawsedrftgyhujiko.fun/pcl2/Custom.xaml"
End Select
End Select
'联网下载
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] 主页自定义数据来源：联网缓存文件")
Content = ReadFile(PathTemp & "Cache\Custom.xaml")
Logger.Info("主页自定义数据来源：联网缓存文件")
Content = FileUtils.TryReadAsString(PathTemp & "Cache\Custom.xaml")
'后台更新缓存
OnlineLoader.Start(New Tuple(Of String, Boolean)(Url, False))
OnlineLoader.Start((Url, False))
Else
'缓存不可用
Log("[Page] 主页自定义数据来源：联网全新下载")
Logger.Info("主页自定义数据来源：联网全新下载")
Hint("正在加载主页……")
RunInUiWait(Sub() LoadContent(Nothing)) '在加载结束前清空页面
Settings.Set("CacheSavedPageVersion", "")
OnlineLoader.Start(New Tuple(Of String, Boolean)(Url, True)) '下载完成后将会再次触发更新
OnlineLoader.Start((Url, True)) '下载完成后将会再次触发更新
Return
End If
End If
@@ -128,10 +131,10 @@ Public Class PageLaunchRight
Private RefreshLock As New Object
'联网获取主页文件
Private OnlineLoader As New LoaderTask(Of Tuple(Of String, Boolean), Integer)("下载主页", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
Private Sub OnlineLoaderSub(Task As LoaderTask(Of Tuple(Of String, Boolean), Integer))
Dim Address As String = Task.Input.Item1 '#3721 中连续触发两次导致内容变化
Dim ShouldRefresh As Boolean = Task.Input.Item2
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 (Address As String, ShouldRefresh As Boolean), Integer))
Dim Address As String = Task.Input.Address '#3721 中连续触发两次导致内容变化
Dim ShouldRefresh As Boolean = Task.Input.ShouldRefresh
Try
'替换自定义变量与设置
Address = ArgumentReplace(Address, AddressOf WebUtility.HtmlEncode)
@@ -150,26 +153,26 @@ Public Class PageLaunchRight
Try
Version = NetRequestByClientRetry(VersionAddress)
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
Log($"[Page] 当前缓存的主页已为最新，当前版本：{Version}，检查源：{VersionAddress}")
Logger.Info($"当前缓存的主页已为最新，当前版本：{Version}，检查源：{VersionAddress}")
Return
End If
Log($"[Page] 需要下载联网主页，当前版本：{Version}，检查源：{VersionAddress}")
Logger.Info($"需要下载联网主页，当前版本：{Version}，检查源：{VersionAddress}")
Catch exx As Exception
Log(exx, $"联网获取主页版本失败", NotifyLevel.DevelopOnly)
Log($"[Page] 无法检查联网主页版本，将直接下载，检查源：{VersionAddress}")
Logger.Warn(exx, $"联网获取主页版本失败")
Logger.Info($"无法检查联网主页版本，将直接下载，检查源：{VersionAddress}")
End Try
'实际下载
Dim FileContent As String = NetRequestByClientRetry(Address)
Log($"[Page] 已联网下载主页，内容长度：{FileContent.Length}，来源：{Address}")
Logger.Info($"已联网下载主页，内容长度：{FileContent.Length}，来源：{Address}")
Settings.Set("CacheSavedPageUrl", Address)
Settings.Set("CacheSavedPageVersion", Version)
FileUtils.Write(PathTemp & "Cache\Custom.xaml", FileContent)
'若内容变更则要求刷新
If LoadedContentHash <> FileContent.GetHashCode() AndAlso ShouldRefresh Then Refresh()
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 Sub
@@ -178,7 +181,7 @@ Public Class PageLaunchRight
''' 必须在 UI 线程调用。
''' </summary>
Public Sub ForceRefresh() Implements IRefreshable.Refresh
Log("[Page] 要求强制刷新主页")
Logger.Info("要求强制刷新主页")
ClearCache()
'实际的刷新
If FrmMain.PageCurrent.Page = FormMain.PageType.Launch Then
@@ -194,10 +197,10 @@ Public Class PageLaunchRight
''' </summary>
Private Sub ClearCache()
LoadedContentHash = -1
OnlineLoader.Input = New Tuple(Of String, Boolean)("", True)
OnlineLoader.Input = ("", True)
Settings.Set("CacheSavedPageUrl", "")
Settings.Set("CacheSavedPageVersion", "")
Log("[Page] 已清空主页缓存")
Logger.Info("已清空主页缓存")
End Sub
''' <summary>
@@ -214,7 +217,7 @@ Public Class PageLaunchRight
'实际加载内容
PanCustom.Children.Clear()
If String.IsNullOrWhiteSpace(Content) Then
Log($"[Page] 实例化：清空主页 UI，来源为空")
Logger.Info($"实例化：清空主页 UI，来源为空")
Return
End If
Dim LoadStartTime As Date = Date.Now
@@ -223,16 +226,16 @@ Public Class PageLaunchRight
Do While Content.Contains("xmlns")
Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
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>"
Log($"[Page] 实例化：加载主页 UI 开始，最终内容长度：{Content.Count}")
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>"
Logger.Info($"实例化：加载主页 UI 开始，最终内容长度：{Content.Count}")
PanCustom.Children.Add(GetObjectFromXML(Content))
'加载计时
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)} 秒），请向主页作者反馈此问题，或暂时停止使用该主页")
End SyncLock
Catch ex As Exception
Log(ex, "加载失败的主页内容：" & vbCrLf & Content)
Logger.Warn(ex, $"加载失败的主页内容：{vbCrLf}{Content}")
OnLoadContentFailed(ex)
End Try
End Sub
@@ -240,12 +243,12 @@ Public Class PageLaunchRight
''' 加载主页失败时调用。
''' </summary>
Private Sub OnLoadContentFailed(ex As Exception)
If ModeDebug OrElse Settings.Get("UiCustomType") = 1 Then
Log(ex, "加载主页失败")
If MyMsgBox(If(TypeOf ex Is UnauthorizedAccessException, ex.Message, $"主页内容编写有误，请根据下列错误信息进行检查：{vbCrLf}{ex.GetBrief}"),
If ModeDebug OrElse Settings.Get(Of Integer)("UiCustomType") = 1 Then
Logger.Warn(ex, "加载主页失败")
If MyMsgBox(If(TypeOf ex Is UnauthorizedAccessException, ex.Message, $"主页内容编写有误，请根据下列错误信息进行检查：{vbCrLf}{ex.GetDisplay(False)}"),
"加载主页失败", "重试", "取消") = 1 Then ForceRefresh()
Else
Log(ex, "加载主页失败", NotifyLevel.AllUsers)
Logger.Error(ex, "加载主页失败", LogBehavior.Toast)
End If
End Sub
''' <summary>
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb
+12 -12
View File
@@ -5,20 +5,20 @@
''' </summary>
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 的方式加载，导致文本框里没东西
'保留输入，只刷新下拉框列表
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
Else
'不保留输入，刷新列表后自动选择第一项
If Settings.Get("LoginAuthEmail") = "" Then
If Settings.Get(Of String)("LoginAuthEmail") = "" Then
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Settings.Get("LoginAuthEmail").ToString.Split("¨")
ComboName.Text = Settings.Get("LoginAuthEmail").ToString.BeforeFirst("¨")
If Settings.Get("LoginRemember") Then TextPass.Password = Settings.Get("LoginAuthPass").ToString.BeforeFirst("¨").Trim
ComboName.ItemsSource = Settings.Get(Of String)("LoginAuthEmail").Split("¨")
ComboName.Text = Settings.Get(Of String)("LoginAuthEmail").BeforeFirst("¨")
If Settings.Get(Of Boolean)("LoginRemember") Then TextPass.Password = Settings.Get(Of String)("LoginAuthPass").BeforeFirst("¨").Trim
End If
End If
IsFirstLoad = False
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。
''' </summary>
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
Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = "", .Password = "", .Description = "Authlib-Injector", .Type = McLoginType.Auth}
Else
@@ -55,10 +55,10 @@
If AniControlEnabled = 0 Then Settings.Set("CacheAuthAccess", "")
End Sub
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 = ""
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 Sub
Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change
@@ -71,15 +71,15 @@
End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
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
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"))
End If
End Sub
'切换注册按钮可见性
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)
End Sub
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml.vb
+8 -8
View File
@@ -12,17 +12,17 @@
''' 刷新页面显示的所有信息。
''' </summary>
Public Sub Reload(KeepInput As Boolean)
TextName.Text = Settings.Get("CacheAuthName")
TextEmail.Text = Settings.Get("CacheAuthUsername")
TextEmail.Visibility = If(Settings.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible)
TextName.Text = Settings.Get(Of String)("CacheAuthName")
TextEmail.Text = Settings.Get(Of String)("CacheAuthUsername")
TextEmail.Visibility = If(Settings.Get(Of Boolean)("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible)
PageLoginLegacy_Loaded()
End Sub
''' <summary>
''' 获取当前页面的登录信息。
''' </summary>
Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheAuthServerServer"), Settings.Get("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}
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(Of String)("CacheAuthUsername"), .Password = Settings.Get(Of String)("CacheAuthPass"), .Description = "Authlib-Injector", .Type = McLoginType.Auth}
End Function
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
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
Hint("正在尝试更换，请稍候！")
Else
@@ -65,7 +65,7 @@
McLoginLoader.WaitForExit(Data, IsForceRestart:=True)
RunInUi(Sub() Reload(True))
Catch ex As Exception
Log(ex, "更换角色失败", NotifyLevel.AllUsers)
Logger.Error(ex, "更换角色失败", LogBehavior.Toast)
End Try
End Sub)
End Sub
@@ -78,7 +78,7 @@
End Sub
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"))
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 的方式加载，导致文本框里没东西
'保留输入，只刷新下拉框列表
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
Else
'不保留输入，刷新列表后自动选择第一项
If Settings.Get("LoginLegacyName") = "" Then
If Settings.Get(Of String)("LoginLegacyName") = "" Then
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Settings.Get("LoginLegacyName").ToString.Split("¨")
ComboName.Text = Settings.Get("LoginLegacyName").ToString.BeforeFirst("¨").Trim
ComboName.ItemsSource = Settings.Get(Of String)("LoginLegacyName").ToString.Split("¨")
ComboName.Text = Settings.Get(Of String)("LoginLegacyName").ToString.BeforeFirst("¨").Trim
End If
End If
IsReloaded = True
@@ -36,7 +36,7 @@ Public Class PageLoginLegacy
''' </summary>
Public Shared Function GetLoginData() As McLoginData
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
''' <summary>
''' 当前页面的登录信息是否有效。
@@ -62,12 +62,12 @@ Public Class PageLoginLegacy
End If
End Sub
Private Sub ComboLegacy_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged
If Settings.Get("LaunchSkinType") = 0 Then PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
HintChinese.Visibility = If(RegexCheck(ComboName.Text, "^[0-9A-Za-z_]*$"), Visibility.Collapsed, Visibility.Visible)
If Settings.Get(Of Integer)("LaunchSkinType") = 0 Then PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
HintChinese.Visibility = If(ComboName.Text.RegexCheck("^[0-9A-Za-z_]*$"), Visibility.Collapsed, Visibility.Visible)
RunInUi(Sub() PanMain.InvalidateMeasure(), True) '由于 WPF 的 Bug，它不一定会自动更新 HintChinese 的大小（#6627）
End Sub
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)
Else
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.Add(New MyComboBoxItem With {.Content = "添加新账号"})
Try
Dim MsJson As JObject = GetJson(Settings.Get("LoginMsJson"))
Dim MsJson As JObject = GetJson(Settings.Get(Of String)("LoginMsJson"))
For Each Account In MsJson
Dim Item As MyListItem = CType(FindResource("ComboBoxItemTemplateWithDelete"), DataTemplate).LoadContent()
Item.Tag = Account.Value.ToString
@@ -18,7 +18,7 @@
ComboAccounts.Items.Add(Item)
Next
Catch ex As Exception
Log(ex, $"微软登录信息出错，登录信息已被重置（{Settings.Get("LoginMsJson")}）", NotifyLevel.AllUsers)
Logger.Error(ex, $"微软登录信息出错，登录信息已被重置（{Settings.Get(Of String)("LoginMsJson")}）", LogBehavior.Toast)
Settings.Set("LoginMsJson", "{}")
End Try
'如果不保留输入，刷新列表后自动选择第一项
@@ -37,7 +37,7 @@
''' 获取当前页面的登录信息。
''' </summary>
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
RunInUiWait(
Sub()
@@ -92,9 +92,9 @@
ElseIf ex.Message.StartsWithF("$") Then
Hint(ex.Message.TrimStart("$"), HintType.Red)
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
Log(ex, "正版登录尝试失败", NotifyLevel.MsgBox)
Logger.Error(ex, "正版登录尝试失败", LogBehavior.Alert)
End If
Finally
RunInUi(
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb
+21 -16
View File
@@ -12,7 +12,7 @@
''' 刷新页面显示的所有信息。
''' </summary>
Public Sub Reload(KeepInput As Boolean)
TextName.Text = Settings.Get("CacheMsV2Name")
TextName.Text = Settings.Get(Of String)("CacheMsV2Name")
'皮肤在 Loaded 加载
End Sub
''' <summary>
@@ -20,9 +20,9 @@
''' </summary>
Public Shared Function GetLoginData() As McLoginMs
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
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 Function
@@ -49,6 +49,7 @@
Settings.Set("CacheMsV2ProfileJson", "")
Settings.Set("CacheMsV2Uuid", "")
Settings.Set("CacheMsV2Name", "")
Settings.Set("CacheMsV2Expires", 0L)
McLoginMsLoader.Interrupt()
FrmLaunchLeft.RefreshPage(False, True)
End Sub
@@ -88,14 +89,18 @@ Retry:
Thread.Sleep(10)
Loop
If McLoginMsLoader.State = LoadState.Failed Then Throw New Exception("登录失败", McLoginMsLoader.Error)
Dim AccessToken As String = Settings.Get("CacheMsV2Access")
Dim Uuid As String = Settings.Get("CacheMsV2Uuid")
Dim Result As String = NetRequestByClientRetry("https://api.minecraftservices.com/minecraft/profile/skins", HttpMethod.Post,
Content:=New Net.Http.MultipartFormDataContent From {
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
{New Net.Http.ByteArrayContent(ReadFileBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)}
},
Headers:={{"Authorization", "Bearer " & AccessToken}, {"Accept", "*/*"}, {"User-Agent", "MojangSharp/0.1"}})
Dim AccessToken As String = Settings.Get(Of String)("CacheMsV2Access")
Dim Uuid As String = Settings.Get(Of String)("CacheMsV2Uuid")
Dim Result As String = Nothing
ResilientUtils.Retry( 'MultipartFormDataContent 在一次请求后就会被 Dispose，所以不能直接 Retry（#8397）
Sub()
Result = NetRequestByClient("https://api.minecraftservices.com/minecraft/profile/skins", HttpMethod.Post,
Content:=New Net.Http.MultipartFormDataContent From {
{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
Hint("正在重新登录，将在登录后自动更改皮肤……")
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
@@ -105,7 +110,7 @@ Retry:
Return
End If
'获取新皮肤地址
Log("[Skin] 皮肤修改返回值：" & vbCrLf & Result)
Logger.Info($"皮肤修改返回值：{vbCrLf}{Result}")
Dim ResultJson As JObject = GetJson(Result)
If ResultJson.ContainsKey("errorMessage") Then Throw New Exception(ResultJson("errorMessage").ToString) '#5309
For Each Skin As JObject In ResultJson("skins")
@@ -116,15 +121,15 @@ Retry:
Next
Throw New Exception("未知错误（" & Result & "）")
Catch ex As Exception
If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then
If ex.IsBadNetwork Then
Hint("更改皮肤失败：连接皮肤服务器超时，请稍后再试，或使用 VPN 改善网络环境", HintType.Red)
ElseIf TypeOf ex Is ResponsedWebException AndAlso CType(ex, ResponsedWebException).StatusCode = HttpStatusCode.Unauthorized Then
Log(ex, "更改皮肤时遭遇 401 错误", NotifyLevel.DevelopOnly)
ElseIf TypeOf ex Is HttpRequestCodeException AndAlso CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.Unauthorized Then
Logger.Warn(ex, "更改皮肤时遭遇 401 错误")
Hint("正在重新登录，将在登录后自动更改皮肤……")
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
GoTo Retry
Else
Log(ex, "更改皮肤失败", NotifyLevel.AllUsers)
Logger.Error(ex, "更改皮肤失败", LogBehavior.Toast)
End If
Finally
IsChanging = False
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb
+10 -10
View File
@@ -5,20 +5,20 @@
''' </summary>
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 的方式加载，导致文本框里没东西
'保留输入，只刷新下拉框列表
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
Else
'不保留输入，刷新列表后自动选择第一项
If Settings.Get("LoginNideEmail") = "" Then
If Settings.Get(Of String)("LoginNideEmail") = "" Then
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Settings.Get("LoginNideEmail").ToString.Split("¨")
ComboName.Text = Settings.Get("LoginNideEmail").ToString.BeforeFirst("¨")
If Settings.Get("LoginRemember") Then TextPass.Password = Settings.Get("LoginNidePass").ToString.BeforeFirst("¨").Trim
ComboName.ItemsSource = Settings.Get(Of String)("LoginNideEmail").Split("¨")
ComboName.Text = Settings.Get(Of String)("LoginNideEmail").BeforeFirst("¨")
If Settings.Get(Of Boolean)("LoginRemember") Then TextPass.Password = Settings.Get(Of String)("LoginNidePass").BeforeFirst("¨").Trim
End If
End If
IsFirstLoad = False
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。
''' </summary>
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
Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = "", .Password = "", .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
Else
@@ -55,10 +55,10 @@
If AniControlEnabled = 0 Then Settings.Set("CacheNideAccess", "")
End Sub
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 = ""
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 Sub
Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change
@@ -71,7 +71,7 @@
End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
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
OpenWebsite("https://login.mc-user.com:233/account/login")
End If
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml.vb
+6 -6
View File
@@ -12,17 +12,17 @@
''' 刷新页面显示的所有信息。
''' </summary>
Public Sub Reload(KeepInput As Boolean)
TextName.Text = Settings.Get("CacheNideName")
TextEmail.Text = Settings.Get("CacheNideUsername")
TextEmail.Visibility = If(Settings.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible)
TextName.Text = Settings.Get(Of String)("CacheNideName")
TextEmail.Text = Settings.Get(Of String)("CacheNideUsername")
TextEmail.Visibility = (Not Settings.Get(Of Boolean)("UiLauncherEmail")).ToVisibility
'皮肤在 Loaded 加载
End Sub
''' <summary>
''' 获取当前页面的登录信息。
''' </summary>
Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheNideServer"), Settings.Get("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"}
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(Of String)("CacheNideUsername"), .Password = Settings.Get(Of String)("CacheNidePass"), .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
End Function
Private Sub PageLoginNideSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter
@@ -51,7 +51,7 @@
End Sub
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 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
Dim OldState = LinkState
LinkState = NewState
Log($"[Link] 主状态由 {GetStringFromEnum(OldState)} 变更为 {GetStringFromEnum(NewState)}")
Logger.Info($"主状态由 {OldState} 变更为 {NewState}")
'触发状态切换
RunInUi(
Sub()
@@ -51,7 +51,7 @@ Public Class PageLinkMain
Case LoadState.Finished
ChangeState(LinkStates.Finished)
Case LoadState.Failed
Telemetry("联机失败", "Exception", FilterUserName(Loader.Error.GetDetail, "*"))
Telemetry("联机失败", "Exception", FilterUserName(Loader.Error.GetDisplay(True), "*"))
ChangeState(LinkStates.Failed)
End Select
End Sub
@@ -109,7 +109,7 @@ Public Class PageLinkMain
NetworkName = $"P{ServerPort.ConvertRadix(16).PadLeft(4, "0"c)}-{GenerateRandomCode()}"
NetworkSecret = GenerateRandomCode()
DiscoverNodeID = -1
Log($"[Link] 尝试创建房间，网络名 {NetworkName}，网络密码 {NetworkSecret}，端口 {ServerPort}")
Logger.Info($"尝试创建房间，网络名 {NetworkName}，网络密码 {NetworkSecret}，端口 {ServerPort}")
'启动
ChangeState(LinkStates.Loading)
End Sub
@@ -135,7 +135,7 @@ Public Class PageLinkMain
Return
End If
Code = FixCodeFormat(Code)
Log($"[Link] 实际使用的邀请码：{Code}")
Logger.Info($"实际使用的邀请码：{Code}")
'基础信息
IsServerSide = False
ServerPort = Code.Substring(1, 4).Upper.ConvertRadix(16, 10)
@@ -146,7 +146,7 @@ Public Class PageLinkMain
Else
DiscoverNodeID = Code.Substring(20, 3).Upper.ConvertRadix(16, 10)
End If
Log($"[Link] 尝试加入房间，网络名 {NetworkName}，网络密码 {NetworkSecret}，端口 {ServerPort}，发现节点 {DiscoverNodeID}")
Logger.Info($"尝试加入房间，网络名 {NetworkName}，网络密码 {NetworkSecret}，端口 {ServerPort}，发现节点 {DiscoverNodeID}")
'启动
LastCode = Code
ChangeState(LinkStates.Loading)
@@ -229,15 +229,15 @@ Public Class PageLinkMain
UpdateProgressBar(1)
'显示错误信息
LabLoadTitle.Text = FailReason
Dim Brief As String = LinkLoader.Error.GetBrief
Dim Brief As String = LinkLoader.Error.GetDisplay(False)
Dim InnerEx As Exception = LinkLoader.Error
If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message
Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException
If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message
Loop
LabLoadDesc.Text = If(Brief.StartsWithF("$"), Brief.TrimStart("$"), LinkLoader.Error.GetDetail)
Log(LinkLoader.Error, LabLoadTitle.Text)
LabLoadDesc.Text = If(Brief.StartsWithF("$"), Brief.TrimStart("$"), LinkLoader.Error.GetDisplay(True))
Logger.Warn(LinkLoader.Error, LabLoadTitle.Text)
End Sub
'===============================
@@ -247,7 +247,7 @@ Public Class PageLinkMain
Private Sub UpdateLoadingPage(Title As String, FailBrief As String)
If FailReason = FailBrief & "失败" Then Return
FailReason = FailBrief & "失败"
Log("[Link] 开始步骤：" & Title)
Logger.Info($"开始步骤：{Title}")
RunInUiWait(
Sub()
If FrmLinkMain Is Nothing OrElse Not FrmLinkMain.LabLoadDesc.IsLoaded Then Return
@@ -451,21 +451,21 @@ Public Class PageLinkMain
Case Reflection.ProcessorArchitecture.Arm
Architecture = "arm64"
Case Else
Log($"[Link] CPU 是不支持的 {Architecture} 架构，这可能会导致联机模块无法启动！", NotifyLevel.DebugModeOnly)
Logger.Warn($"CPU 是不支持的 {Architecture} 架构，这可能会导致联机模块无法启动！")
Architecture = "arm64"
End Select
Log("[Link] CPU 架构：" & Architecture)
Logger.Info($"CPU 架构：{Architecture}")
Telemetry("联机开始")
'检查 EasyTier 版本
UpdateLoadingPage("正在检查联机模块版本……", "检查联机模块版本")
If Not (File.Exists(PathEasyTier & "联机模块 CLI.exe") AndAlso File.Exists(PathEasyTier & "联机模块.exe") AndAlso
File.Exists(PathEasyTier & "Packet.dll")) Then
If Not (FileUtils.Exists(PathEasyTier & "联机模块 CLI.exe") AndAlso FileUtils.Exists(PathEasyTier & "联机模块.exe") AndAlso
FileUtils.Exists(PathEasyTier & "Packet.dll")) Then
Settings.Set("LinkEasyTierVersion", -1)
End If
Dim LocalVersion As Integer = Settings.Get("LinkEasyTierVersion")
Dim LocalVersion As Integer = Settings.Get(Of Integer)("LinkEasyTierVersion")
ServerVersion = ServerConfig("Link")("EasyTierVersion")
Dim RequiredFiles As New List(Of NetFile)
Log($"[Link] EasyTier 本地版本：{LocalVersion}，需求版本：{ServerVersion}")
Logger.Info($"EasyTier 本地版本：{LocalVersion}，需求版本：{ServerVersion}")
If LocalVersion < ServerVersion Then
RequiredFiles.Add(New NetFile(
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))
'解压文件
UpdateLoadingPage("正在解压联机模块……", "解压联机模块")
If File.Exists(PathEasyTier & "EasyTier.zip") Then
If FileUtils.Exists(PathEasyTier & "EasyTier.zip") Then
'解压
Dim ExtractPath As String = RequestTaskTempFolder()
ExtractCompressedFile(PathEasyTier & "EasyTier.zip", ExtractPath,
ProgressIncrementHandler:=Sub(Progress) Task.Progress += Progress * 0.05)
Dim ExtractedPath As String = New DirectoryInfo(ExtractPath).EnumerateDirectories.FirstOrDefault?.FullName
Log("[Link] 联机模块解压时的临时路径：" & ExtractedPath)
CopyDirectory(ExtractedPath, PathEasyTier)
FileUtils.ExtractToDirectory(PathEasyTier & "EasyTier.zip", ExtractPath,
progressHandler:=Sub(Percentage) Task.Progress = Percentage * 0.05)
DirectoryUtils.Copy(DirectoryUtils.GetDirectories(ExtractPath).First, PathEasyTier)
'重命名
File.Delete(PathEasyTier & "联机模块.exe")
File.Move(PathEasyTier & "easytier-core.exe", PathEasyTier & "联机模块.exe")
File.Delete(PathEasyTier & "联机模块 CLI.exe")
File.Move(PathEasyTier & "easytier-cli.exe", PathEasyTier & "联机模块 CLI.exe")
FileUtils.Delete(PathEasyTier & "联机模块.exe")
FileUtils.Move(PathEasyTier & "easytier-core.exe", PathEasyTier & "联机模块.exe")
FileUtils.Delete(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)
End If
Task.Progress = 0.07
'获取节点列表
UpdateLoadingPage("正在获取节点列表……", "获取节点列表")
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 DiscoverNodeID = -2 AndAlso Not IsServerSide Then
Panic("未填写自定义节点设置", $"$你必须在 {vbLQ}自定义节点{vbRQ} 设置中填写与房主相同的内容，{vbCrLf}才能进入该房间！")
@@ -512,7 +510,7 @@ Public Class PageLinkMain
Else
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()
Log("[Link] 使用自定义节点：" & CustomPeers)
Logger.Info($"使用自定义节点：{CustomPeers}")
End If
Task.Progress = 0.13
'获取空闲端口
@@ -539,7 +537,7 @@ Public Class PageLinkMain
For Each Peer As String In RawPeers
Arguments += $" -p=""{Peer}"""
Next
If Settings.Get("LinkLatencyMode") = 1 Then Arguments += " --latency-first"
If Settings.Get(Of Integer)("LinkLatencyMode") = 1 Then Arguments += " --latency-first"
'启动进程
ProcessStart(Arguments)
Task.Progress = 0.15
@@ -553,7 +551,7 @@ Public Class PageLinkMain
'查找目标节点
Dim Ping = GetPeerPing()
If Ping > 0 Then
Log($"[Link] 已与目标建立连接，当前 Ping 为 {Ping:0.0}ms")
Logger.Info($"已与目标建立连接，当前 Ping 为 {Ping:0.0}ms")
Telemetry("联机成功", "Server", IsServerSide, "NAT", NATType)
Exit Do '退出循环
End If
@@ -616,7 +614,7 @@ Public Class PageLinkMain
Try
RawNodes = GetJson(NetRequestByClient("https://uptime.easytier.cn/api/nodes?page=1&per_page=1000", RequireJson:=True))
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))
IsFallbackRawList = True
End Try
@@ -654,18 +652,18 @@ ForcedPass:
ElseIf DiscoverNodeID > 0 Then '>0：作为加入者，根据 ID 选择对应的发现节点；如果没有，使用回退发现节点
SelectedDiscoverNode = Nodes.FirstOrDefault(Function(n) n("id").ToObject(Of Integer) = DiscoverNodeID)
If SelectedDiscoverNode Is Nothing Then
Log($"[Link] 未找到 ID {DiscoverNodeID} 的发现节点", NotifyLevel.DebugModeOnly)
Logger.Warn($"未找到 ID {DiscoverNodeID} 的发现节点")
Panic("房间已过期", "请让房主重新创建房间！")
Throw New ThreadInterruptedException
End If
End If
If SelectedDiscoverNode Is Nothing Then '使用回退发现节点
SelectedDiscoverNode = New JObject From {{"address", FallbackDiscoverAddress}, {"id", FallbackDiscoverID}}
Log("[Link] 将使用回退发现节点", NotifyLevel.DebugModeOnly)
Logger.Warn("将使用回退发现节点")
End If
FinalPeers.Add(SelectedDiscoverNode("address").ToString())
FinalDiscoverID = SelectedDiscoverNode("id").ToObject(Of Integer)
Log($"[Link] 发现节点：{SelectedDiscoverNode("address")} (ID: {FinalDiscoverID})")
Logger.Info($"发现节点：{SelectedDiscoverNode("address")} (ID: {FinalDiscoverID})")
'选取中继节点
If ModeDebug OrElse Not IsServerSide Then '房主只连接发现节点，不连接中继节点
Dim RelayCount As Integer = ServerConfig("Link")("RandomPeer").ToObject(Of Integer)
@@ -676,7 +674,7 @@ ForcedPass:
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
Log(ex, "获取节点列表失败，联机质量可能受到影响", NotifyLevel.AllUsers)
Logger.Error(ex, "获取节点列表失败，联机质量可能受到影响", LogBehavior.Toast)
FinalPeers.AddRange(ServerConfig("Link")("Peers").Select(Function(p) p.ToString))
If FinalDiscoverID <= 0 Then
FinalPeers.Add(FallbackDiscoverAddress)
@@ -716,16 +714,16 @@ ForcedPass:
If ProcessObject.Id = ProcessCore?.Id Then Continue For
If ProcessObject.ProcessName <> "联机模块" AndAlso ProcessObject.ProcessName <> "联机模块 CLI" Then Continue For
Try
Log("[Link] 停止残留的联机模块，PID：" & ProcessObject.Id & "，进程名：" & ProcessObject.ProcessName)
Logger.Info($"停止残留的联机模块，PID：{ProcessObject.Id}，进程名：{ProcessObject.ProcessName}")
ProcessObject.Kill()
ProcessObject.Close()
Catch exx As Exception
Log(exx, $"结束进程失败（{ProcessObject.ProcessName}，PID {ProcessObject.Id}）")
Logger.Warn(exx, $"结束进程失败（{ProcessObject.ProcessName}，PID {ProcessObject.Id}）")
End Try
Next
'关闭由自身启动的进程
If ProcessCore IsNot Nothing AndAlso Not ProcessCore.HasExited Then
Log("[Link] 停止所启动的联机模块，PID：" & ProcessCore.Id)
Logger.Info($"停止所启动的联机模块，PID：{ProcessCore.Id}")
ProcessCore.Kill()
ProcessCore.Close()
ProcessCore = Nothing
@@ -734,7 +732,7 @@ ForcedPass:
ProcessOutputHandle?.Dispose()
ProcessErrorHandle?.Dispose()
Catch ex As Exception
Log(ex, "停止联机模块失败")
Logger.Warn(ex, "停止联机模块失败")
End Try
End Sub
''' <summary>
@@ -770,7 +768,7 @@ ForcedPass:
.StandardOutputEncoding = Encoding.UTF8,
.StandardErrorEncoding = Encoding.UTF8
}
Log("[Link] 正在启动 EasyTier：" & Arguments)
Logger.Info($"正在启动 EasyTier：{Arguments}")
ProcessCore = New Process With {.StartInfo = Info}
Dim LogLineHandler =
Function(sender As Object, e As DataReceivedEventArgs, Handle As AutoResetEvent)
@@ -782,7 +780,7 @@ ForcedPass:
ProcessLogLine(e.Data)
Catch unused As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 EasyTier 信息失败")
Logger.Warn(ex, "读取 EasyTier 信息失败")
End Try
Return Nothing
End Function
@@ -796,15 +794,15 @@ ForcedPass:
End Sub
Private Sub ProcessLogLine(Line As String)
'记录日志
Log("[EasyTier] " & Line)
Logger.Info(Line)
LogHistory.Enqueue(Line)
If LogHistory.Count >= 10 Then LogHistory.Dequeue()
'检查日志内容
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()
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()
End If
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)
'解析
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)
For Each Line As JObject In CType(GetJson(CliResult), JArray)
Try
@@ -930,14 +928,14 @@ ForcedPass:
NewPeers.Add(Peer)
End If
Catch exx As Exception
Log(exx, $"错误的信息（{Line}）")
Logger.Warn(exx, $"错误的信息（{Line}）")
End Try
Next
'完成
Peers = NewPeers
FailCount = 0
Catch ex As Exception
Log(ex, "获取节点信息失败")
Logger.Warn(ex, "获取节点信息失败")
If LinkState = LinkStates.Finished Then
FailCount += 1
If FailCount >= 4 Then Panic("获取节点信息失败", ex.Message)
@@ -1011,7 +1009,7 @@ ForcedPass:
'每 200ms 更新进度条
If LinkState = LinkStates.Loading Then RunInUi(AddressOf UpdateProgressBar)
Catch ex As Exception
Log(ex, "联机模块主时钟出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "联机模块主时钟出错")
Thread.Sleep(10000)
End Try
Loop
@@ -1060,7 +1058,7 @@ ForcedPass:
Else
HintFinish.Text = "你或者房主的网络环境不太好，"
End If
If String.IsNullOrWhiteSpace(Settings.Get("LinkCustomPeer")) Then
If String.IsNullOrWhiteSpace(Settings.Get(Of String)("LinkCustomPeer")) Then
HintFinish.Text &= "正使用社区节点进行中继。"
Else
HintFinish.Text &= "正通过自定义节点进行中继。"
@@ -1102,7 +1100,7 @@ ForcedPass:
SocketFlags.None,
New IPEndPoint(IPAddress.Loopback, 4445))
Catch ex As Exception
Log(ex, "广播联机房间端口失败")
Logger.Warn(ex, "广播联机房间端口失败")
End Try
End If
End Sub
Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml
+156 -342
View File
@@ -117,30 +117,16 @@
<StackPanel Margin="25,40,19,20">
<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="." />
<TextBlock Margin="0,1.5,6,0" Text="." />
<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="L" />
<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="le" />
<TextBlock Margin="0,1.5,6,0" Text="vv" />
<TextBlock Margin="0,1.5,6,0" Text="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="李" />
<TextBlock Margin="0,1.5,6,0" Text="顺" />
<TextBlock Margin="0,1.5,6,0" Text="茧" />
<TextBlock Margin="0,1.5,6,0" Text="烬" />
<TextBlock Margin="0,1.5,6,0" Text="莫" />
<TextBlock Margin="0,1.5,6,0" Text="尊" />
<TextBlock Margin="0,1.5,6,0" Text="埃" />
<TextBlock Margin="0,1.5,6,0" Text="灷" />
<TextBlock Margin="0,1.5,6,0" Text="蒙" />
<TextBlock Margin="0,1.5,6,0" Text="鸢" />
<TextBlock Margin="0,1.5,6,0" Text="羽" />
<TextBlock Margin="0,1.5,6,0" Text="梦" />
<TextBlock Margin="0,1.5,6,0" Text="零" />
<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" />
@@ -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="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="......" />
<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="7%" />
<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="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="ZJL" />
<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="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="轩₩" />
<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="Van" />
<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="沙轻" />
<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="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="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="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="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="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="Ezzo" />
<TextBlock Margin="0,1.5,6,0" Text="^O^" />
<TextBlock Margin="0,1.5,6,0" Text="GUO" />
<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="HJYz" />
<TextBlock Margin="0,1.5,6,0" Text="0216" />
<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="Ilyen" />
<TextBlock Margin="0,1.5,6,0" Text="1950" />
<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="cong" />
<TextBlock Margin="0,1.5,6,0" Text="WAR" />
<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="Gd64" />
<TextBlock Margin="0,1.5,6,0" Text="vbird" />
<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="⁣ 　 　​" />
<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="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="友人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="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="&amp;#39;" />
<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="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="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="调试器" />
<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="希希希" />
<TextBlock Margin="0,1.5,6,0" Text="飞猪侠" />
<TextBlock Margin="0,1.5,6,0" Text="张卿予" />
<TextBlock Margin="0,1.5,6,0" Text="剑骨头" />
<TextBlock Margin="0,1.5,6,0" Text="栀熙阳" />
<TextBlock Margin="0,1.5,6,0" Text="晚雾鹤" />
<TextBlock Margin="0,1.5,6,0" Text="狐猫喵" />
<TextBlock Margin="0,1.5,6,0" Text="祤之锌" />
<TextBlock Margin="0,1.5,6,0" Text="金苹果" />
<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="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="腐目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="拉罗克" />
@@ -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="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="Zh11h" />
<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="aKALA" />
<TextBlock Margin="0,1.5,6,0" Text="gyj120" />
<TextBlock Margin="0,1.5,6,0" Text="Young" />
<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="0fore0" />
<TextBlock Margin="0,1.5,6,0" Text="zkmz4" />
<TextBlock Margin="0,1.5,6,0" Text="Du1yn" />
<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="N0rdiK" />
<TextBlock Margin="0,1.5,6,0" Text="Sphinx" />
<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="张jin浩" />
<TextBlock Margin="0,1.5,6,0" Text="Duomi" />
<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="Thgink" />
<TextBlock Margin="0,1.5,6,0" Text="forever" />
<TextBlock Margin="0,1.5,6,0" Text="Zemira" />
<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="e1apse" />
<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="Snowill" />
<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="424241" />
<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="onlong" />
<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="MY17IT" />
<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="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="杰 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="DUANG" />
<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="NeroicX" />
<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="weather" />
<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="李領link" />
<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="wwwww" />
<TextBlock Margin="0,1.5,6,0" Text="Flawless" />
<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="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="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="城南旧事" />
@@ -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="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="纸币ORZ" />
<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="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="無WuAD" />
<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="CityHaze" />
<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="久遠 蓮華" />
<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="Whelone" />
<TextBlock Margin="0,1.5,6,0" Text="Vergilius." />
<TextBlock Margin="0,1.5,6,0" Text="筱墨OwO" />
<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="3355411²" />
<TextBlock Margin="0,1.5,6,0" Text="Sevenfan" />
<TextBlock Margin="0,1.5,6,0" Text="loveryder" />
<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="小沉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="Luangum" />
<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="chen0701" />
<TextBlock Margin="0,1.5,6,0" Text="androidhi" />
<TextBlock Margin="0,1.5,6,0" Text="gggg1234" />
<TextBlock Margin="0,1.5,6,0" Text="江寒_John" />
<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="爱游戏的狼" />
<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="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="BeiWu_CN" />
<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="289775340" />
<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="一只木元鸽" />
<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="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="翎安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="123456。？" />
<TextBlock Margin="0,1.5,6,0" Text="loading182" />
<TextBlock Margin="0,1.5,6,0" Text="hhhjtqdydz" />
<TextBlock Margin="0,1.5,6,0" Text="蛋白质_变质" />
<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="Frankie_233" />
<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="Zerovaluelh" />
<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="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="Fakecaptain" />
<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="while(true){}" />
<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="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="回忆随缘而起" />
@@ -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="小石潭记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="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="Omori_sunny" />
<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="xiaolong_492" />
<TextBlock Margin="0,1.5,6,0" Text="guduzihaoge" />
<TextBlock Margin="0,1.5,6,0" Text="ン黑色幽默🏮" />
<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="minecraftac11" />
<TextBlock Margin="0,1.5,6,0" Text="esj554611445" />
<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="zishuijing2021" />
<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="maboyuaneasy" />
<TextBlock Margin="0,1.5,6,0" Text="照井黎Terui_Rei" />
<TextBlock Margin="0,1.5,6,0" Text="约翰·冯·海格力斯" />
<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="18949212459aa" />
<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="筱筱雨吖_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="AAALLLAAANNN" />
<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="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="没有翅膀却想飞上天空" />
<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="沒錢點UberEats也不會變有錢" />
<TextBlock Margin="0,1.5,6,0" Text="(ꐦ°᷄д°᷅)咱也不敢问啊" />
<TextBlock Margin="0,1.5,6,0" Text="去撞南墙再撞北墙然后西墙最后东墙" />
</WrapPanel>
<Grid Height="35">
<Grid.ColumnDefinitions>
Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb
+4 -13
View File
@@ -61,7 +61,7 @@
Next
Catch ex As Exception
Log(ex, "加载帮助列表 UI 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "加载帮助列表 UI 失败")
End Try
End Sub
@@ -76,7 +76,7 @@
EnterHelpPage(Entry)
End If
Catch ex As Exception
Log(ex, "处理帮助项目点击时发生意外错误", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "处理帮助项目点击时发生意外错误")
End Try
End Sub
Public Shared Sub EnterHelpPage(Location As String)
@@ -90,7 +90,7 @@
If FrmHelpDetail.Init(Entry) Then
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}})
Else
Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", NotifyLevel.DebugModeOnly)
Logger.Warn("已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃")
End If
End Sub)
End Sub)
@@ -105,20 +105,11 @@
If FrmHelpDetail.Init(Entry) Then
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}})
Else
Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", NotifyLevel.DebugModeOnly)
Logger.Warn("已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃")
End If
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>
''' 搜索帮助。
Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb
+3 -3
View File
@@ -22,14 +22,14 @@
Do While Content.Contains("xmlns")
Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
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
PanCustom.Children.Clear()
PanCustom.Children.Add(GetObjectFromXML(Content))
Return True
Catch ex As Exception
Log("[System] 自定义信息内容：" & vbCrLf & Content)
Log(ex, "加载帮助 XAML 文件失败", NotifyLevel.MsgBox)
Logger.Info($"自定义信息内容：{vbCrLf}{Content}")
Logger.Error(ex, "加载帮助 XAML 文件失败", LogBehavior.Alert)
Return False
End Try
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
'是否处于隐藏的子页面
Dim IsHiddenPage As Boolean = False
If ItemHelp.Checked AndAlso Settings.Get("UiHiddenOtherHelp") Then IsHiddenPage = True
If ItemAbout.Checked AndAlso Settings.Get("UiHiddenOtherAbout") Then IsHiddenPage = True
If ItemTest.Checked AndAlso Settings.Get("UiHiddenOtherTest") Then IsHiddenPage = True
If ItemHelp.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then IsHiddenPage = True
If ItemAbout.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then IsHiddenPage = True
If ItemTest.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest") Then IsHiddenPage = True
If PageSetupUI.HiddenForceShow Then IsHiddenPage = False
'若页面错误，或尚未加载，则继续
If IsLoad AndAlso Not IsHiddenPage Then Return
@@ -16,9 +16,9 @@
PageSetupUI.HiddenRefresh()
'选择第一个未被禁用的子页面
If IsPageSwitched Then Return
If Not Settings.Get("UiHiddenOtherHelp") Then
If Not Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then
ItemHelp.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenOtherAbout") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then
ItemAbout.SetChecked(True, False, False)
Else
ItemTest.SetChecked(True, False, False)
@@ -37,9 +37,9 @@
Public Sub New()
InitializeComponent()
'选择第一个未被禁用的子页面
If Not Settings.Get("UiHiddenOtherHelp") Then
If Not Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then
PageID = FormMain.PageSubType.OtherHelp
ElseIf Not Settings.Get("UiHiddenOtherAbout") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then
PageID = FormMain.PageSubType.OtherAbout
Else
PageID = FormMain.PageSubType.OtherTest
@@ -83,7 +83,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败（ID " & ID & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换分页面失败（ID {ID}）")
Finally
AniControlEnabled -= 1
End Try
@@ -131,7 +131,12 @@
e.Handled = True
End Sub
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 改善网络环境。",
"反馈", "提交新反馈", "查看反馈列表", "取消")
Case 1
Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb
+27 -29
View File
@@ -81,14 +81,14 @@
End Sub
NewItem.Buttons = {NewIconButton}
FrmSelectLeft.PanList.Children.Add(NewItem)
Log("[Minecraft] 有效的 Minecraft 文件夹：" & Folder.Name & " > " & Folder.Location)
Logger.Info($"有效的 Minecraft 文件夹：{Folder.Name} > {Folder.Location}")
Next
'标题文本
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,
.ToolTip = "在 PCL 当前所在文件夹下创建新的 .minecraft 文件夹",
.LogoScale = 0.9,
@@ -138,7 +138,7 @@
End If
Catch ex As Exception
Log(ex, "构建 Minecraft 文件夹列表 UI 出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "构建 Minecraft 文件夹列表 UI 出错")
Finally
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表
End Try
@@ -155,8 +155,8 @@
End If
Try
'获取输入
NewFolder = SelectFolder()
If NewFolder = "" Then Return
NewFolder = Dialogs.SelectFolder("选择 Minecraft 文件夹", False).FirstOrDefault
If NewFolder Is Nothing Then Return
If NewFolder.Contains("!") OrElse NewFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Return
'要求输入显示名称
Dim SplitedNames As String() = NewFolder.TrimEnd("\").Split("\")
@@ -168,7 +168,7 @@
'添加文件夹
AddFolder(NewFolder, NewName, True)
Catch ex As Exception
Log(ex, "添加文件夹失败（" & NewFolder & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"添加文件夹失败（{NewFolder}）")
End Try
End Sub
''' <summary>
@@ -190,15 +190,15 @@
End If
'检查实际的 Minecraft 文件夹位置（没有问题，或是在子文件夹中）
If Not CheckPermission(FolderPath & "versions\") Then
For Each Folder As DirectoryInfo In New DirectoryInfo(FolderPath).GetDirectories
If CheckPermission(Folder.FullName & "\versions\") Then
FolderPath = Folder.FullName & "\"
For Each Folder In DirectoryUtils.GetDirectories(FolderPath)
If CheckPermission(Folder & "\versions\") Then
FolderPath = Folder & "\"
Exit For
End If
Next
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 IsReplace As Boolean = False
For i = 0 To Folders.Count - 1
@@ -229,10 +229,10 @@
If ShowHint Then Hint("文件夹 " & DisplayName & " 已添加！", HintType.Green)
'检查是否为根目录整合包，自动关闭版本隔离
'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
'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
'3. 能够找到可安装 Mod 的版本
For Each VersionFolder In VersionFolderInfo.EnumerateDirectories
@@ -240,15 +240,15 @@
Instance.Load()
If Not Instance.Modable Then Continue For
'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
'满足以上全部条件则视为根目录整合包
Settings.Set("VersionArgumentIndie", 2, Instance:=Instance)
Settings.Set("VersionArgumentIndieV2", False, Instance:=Instance)
Log("[Setup] 已自动关闭单版本隔离：" & Instance.Name, NotifyLevel.DebugModeOnly)
Logger.Warn($"已自动关闭单版本隔离：{Instance.Name}")
Next
Catch ex As Exception
Log(ex, "向文件夹列表中添加新文件夹失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "向文件夹列表中添加新文件夹失败")
End Try
End Sub)
End Sub
@@ -265,11 +265,11 @@
End Sub
Public Shared Sub CreateMcFolderInCurrentPath()
McFolderSelected = PathExeFolder & ".minecraft\"
If Not Directory.Exists(McFolderSelected) Then
If Not DirectoryUtils.Exists(McFolderSelected) Then
DirectoryUtils.Create(McFolderSelected & "versions\")
McFolderLauncherProfilesJsonCreate(McFolderSelected)
End If
AddFolder(McFolderSelected, GetFolderNameFromPath(PathExeFolder), False)
AddFolder(McFolderSelected, PathUtils.GetLastPart(PathExeFolder), False)
End Sub
'右键菜单
@@ -282,12 +282,10 @@
Select Case MyMsgBox("是否需要清理 PCL 在该文件夹中的配置文件？" & vbCrLf & "这包括各个版本的独立设置（如自定义图标、第三方登录配置）等，对游戏本身没有影响。", "配置文件清理", "删除", "保留", "取消")
Case 1
'删除配置文件
If File.Exists(Target.Location & "PCL.ini") Then File.Delete(Target.Location & "PCL.ini")
If Directory.Exists(Target.Location & "versions\") Then
For Each InstanceInfo In New DirectoryInfo(Target.Location & "versions\").EnumerateDirectories
If Directory.Exists(InstanceInfo.FullName & "\PCL\") Then DeleteDirectory(InstanceInfo.FullName & "\PCL\", True)
Next
End If
FileUtils.Delete(Target.Location & "PCL.ini")
For Each Instance In DirectoryUtils.GetDirectories(Target.Location & "versions\", True)
DirectoryUtils.Delete(Path.Combine(Instance, "PCL"), True)
Next
Case 2
'不删除
Case 3
@@ -299,7 +297,7 @@
Hint(If(Target.Type = McFolder.Types.Custom, "文件夹 " & DeletedName & " 已从列表中移除！", "文件夹名称已复原！"), HintType.Green)
McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception
Log(ex, "从列表中移除游戏文件夹失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "从列表中移除游戏文件夹失败")
End Try
End Sub
Public Sub Delete_Click(sender As Object, e As RoutedEventArgs)
@@ -320,11 +318,11 @@
'删除文件夹
Try
Hint("正在" & DeleteText & "文件夹 " & Target.Name & "！", HintType.Blue)
DeleteDirectory(Target.Location)
DirectoryUtils.Delete(Target.Location)
If DeleteText = "清空" Then DirectoryUtils.Create(Target.Location)
Hint("已" & DeleteText & "文件夹 " & Target.Name & "！", HintType.Green)
Catch ex As Exception
Log(ex, DeleteText & "文件夹 " & Target.Name & " 失败", NotifyLevel.AllUsers)
Logger.Error(ex, $"{DeleteText}文件夹 {Target.Name} 失败", LogBehavior.Toast)
Finally
'刷新列表
McFolderListLoader.Start(IsForceRestart:=True)
@@ -337,7 +335,7 @@
''' </summary>
Private Shared Function RemoveFolderFromSetup(Target As McFolder) As String
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
If Not Folder.EndsWithF(Target.Location) Then Continue For
DeletedName = Folder.BeforeFirst(">")
@@ -371,7 +369,7 @@
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
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
For i = 0 To Folders.Count - 1
Dim FolderCurrent As String = Folders(i)
@@ -394,7 +392,7 @@
Settings.Set("LaunchFolders", Folders.Join("|"))
McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception
Log(ex, "重命名文件夹失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "重命名文件夹失败")
End Try
End Sub
Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb
+7 -12
View File
@@ -102,7 +102,7 @@
Else
LabEmptyTitle.Text = "无可用版本"
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
Else
PanBack.Visibility = Visibility.Visible
@@ -110,7 +110,7 @@
End If
Catch ex As Exception
Log(ex, "将版本列表转换显示时失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "将版本列表转换显示时失败")
End Try
End Sub
Public Shared Sub McInstanceListContent(sender As MyListItem, e As EventArgs)
@@ -204,13 +204,8 @@
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""),
"版本删除确认", , "取消",, True)
Case 1
IniClearCache(Instance.PathIndie & "options.txt")
IniClearCache(Instance.PathVersion & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(Instance.PathVersion)
Else
FileIO.FileSystem.DeleteDirectory(Instance.PathVersion, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
Instance.ResetIniCache()
DirectoryUtils.Delete(Instance.PathVersion, Not IsShiftPressed)
Hint("版本 " & Instance.Name & " 已删除！", HintType.Green)
Case 2
Return
@@ -238,14 +233,14 @@
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End If
Catch ex As OperationCanceledException
Log(ex, "删除版本 " & Instance.Name & " 被主动取消")
Logger.Warn(ex, $"删除版本 {Instance.Name} 被主动取消")
Catch ex As Exception
Log(ex, "删除版本 " & Instance.Name & " 失败", NotifyLevel.MsgBox)
Logger.Error(ex, $"删除版本 {Instance.Name} 失败", LogBehavior.Alert)
End Try
End Sub
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
BtnEmptyDownload.Visibility = NewVisibility
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">
<StackPanel x:Name="PanMain" Margin="25,25,25,10">
<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.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
@@ -29,7 +29,6 @@
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="默认版本隔离" Margin="0,0,25,0" />
<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" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
<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:ValidateExcept>
<local:ValidateExcept.Excepts>
@@ -106,21 +105,24 @@
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
</Grid>
<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"
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">
<TextBlock VerticalAlignment="Center" Grid.Row="12" HorizontalAlignment="Left" Text="Java" Margin="0,0,25,0" />
<Grid Grid.ColumnSpan="2" Grid.Row="12" Grid.Column="1" HorizontalAlignment="Stretch">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" />
</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:MyTextButton HorizontalAlignment="Left" x:Name="BtnArgumentJavaSearch" Text="自动搜索" Padding="25,10,5,5" Grid.Row="5" VerticalContentAlignment="Top" />
<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}" />
<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:MyComboBox
x:Name="ComboArgumentJava" Grid.Column="0" 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>
<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>
</StackPanel>
@@ -291,7 +293,7 @@
<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" />
<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"
ToolTipService.Placement="Right" ToolTip="自动在 Windows 设置 → 系统 → 屏幕 → 显示卡 中将 PCL 和 Java 改为使用高性能显卡。&#xa;如果同时有集成显卡和独立显卡，这能确保 MC 使用独立显卡进行渲染，以大幅提高帧率。" />
</StackPanel>
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb
+28 -29
View File
@@ -27,10 +27,10 @@
UpdateRamType()
UpdateJavaComboBox()
Catch ex As NullReferenceException
Log(ex, "启动设置项存在异常，已被自动重置", NotifyLevel.MsgBox)
Logger.Error(ex, "启动设置项存在异常，已被自动重置", LogBehavior.Alert)
Reset()
Catch ex As Exception
Log(ex, "重载启动设置时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "重载启动设置时出错")
End Try
End Sub
Public Sub Reset()
@@ -42,7 +42,7 @@
JavaSearchLoader.Start(IsForceRestart:=True)
Hint("已初始化启动设置！", HintType.Green)
Catch ex As Exception
Log(ex, "初始化启动设置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "初始化启动设置失败", LogBehavior.Alert)
End Try
Refresh()
End Sub
@@ -57,7 +57,7 @@
Private Sub RadioSkinType3_Check(sender As Object, e As RouteEventArgs) Handles RadioSkinType4.PreviewCheck
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()
If Not SkinInfo.IsVaild Then
@@ -70,9 +70,8 @@
'返回是否成功改变
Private Function ChangeSkin(SkinInfo As McSkinInfo) As Boolean
Try
'拷贝文件
File.Delete(PathAppdata & "CustomSkin.png")
CopyFile(SkinInfo.LocalFile, PathAppdata & "CustomSkin.png")
'复制文件
FileUtils.Copy(SkinInfo.LocalFile, PathAppdata & "CustomSkin.png")
'将单层皮肤扩展到双层
Dim Bitmap As New MyBitmap(PathAppdata & "CustomSkin.png")
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)
g.DrawImageUnscaled(Img, New System.Drawing.Point(0, 0))
End Using
File.Delete(PathAppdata & "CustomSkin.png")
FileUtils.Delete(PathAppdata & "CustomSkin.png")
NewBitmap.Save(PathAppdata & "CustomSkin.png")
End If
'更新设置
Settings.Set("LaunchSkinSlim", SkinInfo.IsSlim)
ChangeSkin = True
Return True
Catch ex As Exception
Log(ex, "改变离线皮肤失败", NotifyLevel.MsgBox)
ChangeSkin = False
Logger.Error(ex, "改变离线皮肤失败", LogBehavior.Alert)
Return False
Finally
'设置当前显示
PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
@@ -97,11 +96,11 @@
End Function
Private Sub BtnSkinDelete_Click(sender As Object, e As EventArgs) Handles BtnSkinDelete.Click
Try
File.Delete(PathAppdata & "CustomSkin.png")
FileUtils.Delete(PathAppdata & "CustomSkin.png")
RadioSkinType0.SetChecked(True, True)
Hint("离线皮肤已清空！", HintType.Green)
Catch ex As Exception
Log(ex, "清空离线皮肤失败", NotifyLevel.MsgBox)
Logger.Error(ex, "清空离线皮肤失败", LogBehavior.Alert)
End Try
End Sub
Private Sub BtnSkinSave_Click(sender As Object, e As EventArgs) Handles BtnSkinSave.Click
@@ -115,7 +114,7 @@
PageLaunchLeft.SkinLegacy.Start()
'设置 UI 改变
If FrmSetupLaunch Is Nothing Then Return
Select Case Settings.Get("LaunchSkinType")
Select Case Settings.Get(Of Integer)("LaunchSkinType")
Case 0, 1, 2 '默认
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Collapsed
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Collapsed
@@ -135,7 +134,7 @@
Public Shared Sub UpdateRamType()
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
''' <summary>
@@ -278,7 +277,7 @@
'------------------------------------------
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
'确定需求的内存值
@@ -289,7 +288,7 @@
If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load()
If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 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)
RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90
@@ -334,7 +333,7 @@ PreFin:
RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1)
Else
'手动配置
Dim Value As Integer = Settings.Get("LaunchRamCustom")
Dim Value = Settings.Get(Of Integer)("LaunchRamCustom")
If Value <= 12 Then
RamGive = Value * 0.1 + 0.3
ElseIf Value <= 25 Then
@@ -359,10 +358,10 @@ PreFin:
If ComboArgumentJava Is Nothing Then Return
'初始化列表
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 SelectedBySetup As String = Settings.Get("LaunchArgumentJavaSelect")
Dim SelectedBySetup As String = Settings.Get(Of String)("LaunchArgumentJavaSelect")
Try
For Each Java In JavaList.ToList().OrderByDescending(Function(v) v.MajorVersion)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
@@ -374,7 +373,7 @@ PreFin:
Next
Catch ex As Exception
Settings.Set("LaunchArgumentJavaSelect", "")
Log(ex, "更新设置 Java 下拉框失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "更新设置 Java 下拉框失败")
End Try
'更新选择项
If SelectedItem Is Nothing AndAlso JavaList.Any Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择”
@@ -403,11 +402,11 @@ PreFin:
If "自动选择".Equals(SelectedJava) Then
'选择 “自动”
Settings.Set("LaunchArgumentJavaSelect", "")
Log("[Java] 修改 Java 选择设置：自动选择")
Logger.Info("修改 Java 选择设置：自动选择")
Else
'选择指定项
Settings.Set("LaunchArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None))
Log("[Java] 修改 Java 选择设置：" & SelectedJava.ToString)
Logger.Info($"修改 Java 选择设置：{SelectedJava}")
End If
RefreshRam(True)
End Sub
@@ -419,16 +418,16 @@ PreFin:
Return
End If
'选择 Java
Dim JavaSelected As String = SelectFile("javaw.exe|javaw.exe", "选择 bin 文件夹中的 javaw.exe 文件")
If JavaSelected = "" Then Return
JavaSelected = GetPathFromFullPath(JavaSelected)
Dim JavaSelected As String = Dialogs.SelectFile("选择 bin 文件夹中的 javaw.exe 文件", False, filter:={({"exe"}, "javaw.exe")}).FirstOrDefault()
If String.IsNullOrEmpty(JavaSelected) Then Return
JavaSelected = PathUtils.AddSlashSuffix(PathUtils.RemoveLastPart(JavaSelected))
Try
'验证 Java 可用
Dim NewEntry As New JavaEntry(JavaSelected, True)
NewEntry.Check()
'加入列表
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)
If Entry.PathFolder = NewEntry.PathFolder Then Continue For
JavaNewList.Add(JsonEntry)
@@ -438,7 +437,7 @@ PreFin:
JavaSearchLoader.Start(IsForceRestart:=True)
Hint("已将该 Java 加入 Java 列表！", HintType.Green)
Catch ex As Exception
Log(ex, "该 Java 存在异常，无法使用", NotifyLevel.MsgBox, "异常的 Java")
Logger.Error(ex, "该 Java 存在异常，无法使用", LogBehavior.Alert)
Return
End Try
End Sub
@@ -488,7 +487,7 @@ PreFin:
If Not CheckArgumentRam.Checked Then Return
If MyMsgBox("内存优化会显著延长启动耗时，建议仅在内存不足时开启。" & vbCrLf &
"如果你在使用机械硬盘，这还可能导致一小段时间的严重卡顿。" &
If(IsAdmin(), "", $"{vbCrLf}{vbCrLf}每次启动游戏，PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限，可以右键 PCL，打开 属性 → 兼容性 → 以管理员身份运行此程序。"),
If(SystemUtils.HasAdminRole(), "", $"{vbCrLf}{vbCrLf}每次启动游戏，PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限，可以右键 PCL，打开 属性 → 兼容性 → 以管理员身份运行此程序。"),
"提醒", "确定", "取消") = 2 Then
CheckArgumentRam.Checked = False
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
'是否处于隐藏的子页面
Dim IsHiddenPage As Boolean = False
If ItemLaunch.Checked AndAlso Settings.Get("UiHiddenSetupLaunch") Then IsHiddenPage = True
If ItemUI.Checked AndAlso Settings.Get("UiHiddenSetupUi") Then IsHiddenPage = True
If ItemSystem.Checked AndAlso Settings.Get("UiHiddenSetupSystem") Then IsHiddenPage = True
If ItemLink.Checked AndAlso Settings.Get("UiHiddenSetupLink") Then IsHiddenPage = True
If ItemLaunch.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLaunch") Then IsHiddenPage = True
If ItemUI.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupUi") Then IsHiddenPage = True
If ItemSystem.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupSystem") Then IsHiddenPage = True
If ItemLink.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLink") Then IsHiddenPage = True
If PageSetupUI.HiddenForceShow Then IsHiddenPage = False
'若页面错误，或尚未加载，则继续
If IsLoad AndAlso Not IsHiddenPage Then Return
@@ -17,13 +17,13 @@
PageSetupUI.HiddenRefresh()
'选择第一个未被禁用的子页面
If IsPageSwitched Then Return
If Not Settings.Get("UiHiddenSetupLaunch") Then
If Not Settings.Get(Of Boolean)("UiHiddenSetupLaunch") Then
ItemLaunch.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenSetupUi") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupUi") Then
ItemUI.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenSetupSystem") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupSystem") Then
ItemSystem.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenSetupLink") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupLink") Then
ItemLink.SetChecked(True, False, False)
Else
ItemLaunch.SetChecked(True, False, False)
@@ -42,13 +42,13 @@
Public Sub New()
InitializeComponent()
'选择第一个未被禁用的子页面
If Not Settings.Get("UiHiddenSetupLaunch") Then
If Not Settings.Get(Of Boolean)("UiHiddenSetupLaunch") Then
PageID = FormMain.PageSubType.SetupLaunch
ElseIf Not Settings.Get("UiHiddenSetupUi") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupUi") Then
PageID = FormMain.PageSubType.SetupUI
ElseIf Not Settings.Get("UiHiddenSetupSystem") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupSystem") Then
PageID = FormMain.PageSubType.SetupSystem
ElseIf Not Settings.Get("UiHiddenSetupLink") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupLink") Then
PageID = FormMain.PageSubType.SetupLink
Else
PageID = FormMain.PageSubType.SetupLaunch
@@ -115,7 +115,7 @@
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败（ID " & ID & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换分页面失败（ID {ID}）")
Finally
AniControlEnabled -= 1
End Try
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLink.xaml.vb
+2 -2
View File
@@ -23,10 +23,10 @@
Public Sub Reset()
Try
SettingService.ResetSettings(Me)
Log("[Setup] 已初始化联机页设置")
Logger.Info("已初始化联机页设置")
Hint("已初始化联机页设置！", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化联机页设置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "初始化联机页设置失败", LogBehavior.Alert)
End Try
Reload()
End Sub
Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb
+5 -5
View File
@@ -30,10 +30,10 @@
Public Sub Reset()
Try
SettingService.ResetSettings(Me)
Log("[Setup] 已初始化启动器页设置")
Logger.Info("已初始化启动器页设置")
Hint("已初始化启动器页设置！", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化启动器页设置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "初始化启动器页设置失败", LogBehavior.Alert)
End Try
Reload()
End Sub
@@ -58,7 +58,7 @@
End Sub
Private Sub SliderDownloadThread_PreviewChange(sender As Object, e As RouteEventArgs) Handles SliderDownloadThread.PreviewChange
If SliderDownloadThread.Value < 100 Then Return
If Not Settings.Get("HintDownloadThread") Then
If Not Settings.Get(Of Boolean)("HintDownloadThread") Then
Settings.Set("HintDownloadThread", True)
MyMsgBox("如果设置过多的下载线程，可能会导致下载时出现非常严重的卡顿。" & vbCrLf &
"一般设置 64 线程即可满足大多数下载需求，除非你知道你在干什么，否则不建议设置更多的线程数！", "警告", "我知道了", IsWarn:=True)
@@ -109,12 +109,12 @@
Public Shared Function IsLauncherNewest() As Boolean?
Try
'确认服务器公告是否正常
Dim ServerContent As String = ReadFile(PathTemp & "Cache\Notice.cfg")
Dim ServerContent As String = If(FileUtils.TryReadAsString(PathTemp & "Cache\Notice.cfg"), "")
If ServerContent.Split("|").Count < 3 Then Return Nothing
'确认是否为最新
Return ServerContent.Split("|")(If(BuildType = BuildTypes.Release, 2, 1)) <= VersionCode
Catch ex As Exception
Log(ex, "确认启动器更新失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "确认启动器更新失败")
Return Nothing
End Try
End Function
Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml
+3 -2
View File
@@ -269,11 +269,11 @@
<local:MyComboBoxItem local:SettingService.Value="0" Content="你知道吗？" />
<local:MyComboBoxItem local:SettingService.Value="1" Content="回声洞" />
<local:MyComboBoxItem local:SettingService.Value="2" Content="Minecraft 新闻（作者：最亮的信标）" />
<local:MyComboBoxItem local:SettingService.Value="3" Content="简单主页（作者：MFn233）" />
<!--<local:MyComboBoxItem local:SettingService.Value="3" Content="简单主页（作者：MFn233）" />-->
<local:MyComboBoxItem local:SettingService.Value="4" Content="每日整合包推荐（作者：wkea）" />
<local:MyComboBoxItem local:SettingService.Value="5" Content="Minecraft 皮肤推荐（作者：wkea）" />
<local:MyComboBoxItem local:SettingService.Value="6" Content="OpenBMCLAPI 仪表盘 Lite（作者：Silverteal、Mxmilu666）" />
<local:MyComboBoxItem local:SettingService.Value="7" Content="PCL 主页市场（作者：凌云）" />
<!--<local:MyComboBoxItem local:SettingService.Value="7" Content="PCL 主页市场（作者：凌云）" />-->
<!--<local:MyComboBoxItem local:SettingService.Value="8" Content="PCL 新闻速报（作者：Joker2184）" />-->
<local:MyComboBoxItem local:SettingService.Value="9" Content="PCL 新功能说明书（作者：WForst-Breeze）" />
<!--<local:MyComboBoxItem local:SettingService.Value="10" Content="OpenMCIM 仪表盘（作者：SALTWOOD）" />-->
@@ -282,6 +282,7 @@
<local:MyComboBoxItem local:SettingService.Value="13" Content="Minecraft 更新摘要（作者：pynickle）" />
<local:MyComboBoxItem local:SettingService.Value="14" Content="今日新闻热点（作者：EYicheng）" />
<local:MyComboBoxItem local:SettingService.Value="15" Content="Minecraft 芝士站（作者：awaEric233）" />
<local:MyComboBoxItem local:SettingService.Value="16" Content="整合包推荐引擎（作者：CHMYGZ）" />
</local:MyComboBox>
</Grid>
</StackPanel>
Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb
+79 -85
View File
@@ -54,19 +54,19 @@
'主页
OnMainPageTypeChanged()
Catch ex As NullReferenceException
Log(ex, "个性化设置项存在异常，已被自动重置", NotifyLevel.MsgBox)
Logger.Error(ex, "个性化设置项存在异常，已被自动重置", LogBehavior.Alert)
Reset()
Catch ex As Exception
Log(ex, "重载个性化设置时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "重载个性化设置时出错")
End Try
End Sub
Public Sub Reset()
Try
SettingService.ResetSettings(Me)
Log("[Setup] 已初始化个性化设置！")
Logger.Info("已初始化个性化设置！")
Hint("已初始化个性化设置", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化个性化设置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "初始化个性化设置失败", LogBehavior.Alert)
End Try
Refresh()
End Sub
@@ -97,7 +97,7 @@
End Sub
Private Sub BtnBackgroundClear_Click(sender As Object, e As EventArgs) Handles BtnBackgroundClear.Click
If MyMsgBox("即将删除背景图片文件夹中的所有文件。" & vbCrLf & "此操作不可撤销，是否确定？", "警告",, "取消", IsWarn:=True) = 1 Then
DeleteDirectory(PathExeFolder & "PCL\Pictures")
DirectoryUtils.Delete(PathExeFolder & "PCL\Pictures")
BackgroundRefresh(False, True)
Hint("背景图片已清空！", HintType.Green)
End If
@@ -113,10 +113,9 @@
'获取可用的图片文件
DirectoryUtils.Create(PathExeFolder & "PCL\Pictures\")
Dim Pic As New List(Of String)
For Each File In EnumerateFiles(PathExeFolder & "PCL\Pictures\")
If File.Extension.Lower <> ".ini" AndAlso File.Extension.Lower <> ".db" Then '文件夹可能会被加入 .ini 和 thumbs.db
Pic.Add(File.FullName)
End If
For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Pictures\")
Dim Extension As String = PathUtils.GetExtension(File)
If Extension <> "ini" AndAlso Extension <> "db" Then Pic.Add(File) '文件夹可能会被加入 .ini 和 thumbs.db
Next
'加载
If Not Pic.Any() Then
@@ -133,18 +132,16 @@
If Refresh Then
Dim Address As String = RandomOne(Pic)
Try
Log("[UI] 加载背景图片：" & Address)
Logger.Info($"加载背景图片：{Address}")
FrmMain.ImgBack.Background = New MyBitmap(Address)
FrmMain.ImgBack.Visibility = Visibility.Visible
FrmMain.UpdateBackgroundAndTitleBar()
If IsHint Then Hint("背景图片已刷新：" & GetFileNameFromPath(Address), HintType.Green, False)
If IsHint Then Hint("背景图片已刷新：" & PathUtils.GetLastPart(Address), HintType.Green, False)
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("刷新背景图片失败，该图片文件可能并非标准格式。" & vbCrLf &
"你可以尝试使用画图打开该文件并重新保存，这会让图片变为标准格式。" & vbCrLf &
"文件：" & Address, NotifyLevel.MsgBox)
Logger.Error($"刷新背景图片失败，该图片文件可能并非标准格式。{vbCrLf}你可以尝试使用画图打开该文件并重新保存，这会让图片变为标准格式。{vbCrLf}文件：{Address}", LogBehavior.Alert)
Else
Log(ex, "刷新背景图片失败（" & Address & "）", NotifyLevel.MsgBox)
Logger.Error(ex, $"刷新背景图片失败（{Address}）", LogBehavior.Alert)
End If
End Try
End If
@@ -152,27 +149,26 @@
End If
Catch ex As Exception
Log(ex, "刷新背景图片时出现未知错误", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新背景图片时出现未知错误")
End Try
End Sub
'顶部栏
Private Sub BtnLogoChange_Click(sender As Object, e As EventArgs) Handles BtnLogoChange.Click
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.jpeg;*.gif;*.webp)|*.png;*.jpg;*.jpeg;*.gif;*.webp", "选择图片")
If FileName = "" Then Return
Dim FileName As String = Dialogs.SelectFile("选择图片", False, filter:={({"png", "jpg", "jpeg", "gif", "webp"}, "常用图片文件")}).FirstOrDefault()
If String.IsNullOrEmpty(FileName) Then Return
Dim TargetPath As String = PathExeFolder & "PCL\Logo.png"
Try
'拷贝文件
File.Delete(PathExeFolder & "PCL\Logo.png")
CopyFile(FileName, PathExeFolder & "PCL\Logo.png")
'复制文件
FileUtils.Copy(FileName, TargetPath)
'设置当前显示
FrmMain.ImageTitleLogo.Source = Nothing '防止因为 Source 属性前后的值相同而不更新 (#5628)
FrmMain.ImageTitleLogo.Source = PathExeFolder & "PCL\Logo.png"
FrmMain.ImageTitleLogo.Source = TargetPath
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("改变标题栏图片失败，该图片文件可能并非标准格式。" & vbCrLf &
"你可以尝试使用画图打开该文件并重新保存，这会让图片变为标准格式。", NotifyLevel.MsgBox)
Logger.Error($"改变标题栏图片失败，该图片文件可能并非标准格式。{vbCrLf}你可以尝试使用画图打开该文件并重新保存，这会让图片变为标准格式。{vbCrLf}文件：{TargetPath}", LogBehavior.Alert)
Else
Log(ex, "设置标题栏图片失败", NotifyLevel.MsgBox)
Logger.Error(ex, "设置标题栏图片失败", LogBehavior.Alert)
End If
FrmMain.ImageTitleLogo.Source = Nothing
End Try
@@ -181,50 +177,48 @@
If Not (AniControlEnabled = 0 AndAlso e.RaiseByMouse) Then Return
Refresh:
'已有图片则不再选择
If File.Exists(PathExeFolder & "PCL\Logo.png") Then
Dim TargetPath As String = PathExeFolder & "PCL\Logo.png"
If FileUtils.Exists(TargetPath) Then
Try
FrmMain.ImageTitleLogo.Source = Nothing '防止因为 Source 属性前后的值相同而不更新 (#5628)
FrmMain.ImageTitleLogo.Source = PathExeFolder & "PCL\Logo.png"
FrmMain.ImageTitleLogo.Source = TargetPath
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("调整标题栏图片失败，该图片文件可能并非标准格式。" & vbCrLf &
"你可以尝试使用画图打开该文件并重新保存，这会让图片变为标准格式。", NotifyLevel.MsgBox)
Logger.Error($"改变标题栏图片失败，该图片文件可能并非标准格式。{vbCrLf}你可以尝试使用画图打开该文件并重新保存，这会让图片变为标准格式。{vbCrLf}文件：{TargetPath}", LogBehavior.Alert)
Else
Log(ex, "调整标题栏图片失败", NotifyLevel.MsgBox)
Logger.Error(ex, "调整标题栏图片失败", LogBehavior.Alert)
End If
FrmMain.ImageTitleLogo.Source = Nothing
e.Handled = True
Try
File.Delete(PathExeFolder & "PCL\Logo.png")
FileUtils.Delete(TargetPath)
Catch exx As Exception
Log(exx, "清理错误的标题栏图片失败", NotifyLevel.MsgBox)
Logger.Error(exx, "清理错误的标题栏图片失败", LogBehavior.Alert)
End Try
End Try
Return
End If
'没有图片则要求选择
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpeg;*.jpg;*.gif;*.webp)|*.png;*.jpeg;*.jpg;*.gif;*.webp", "选择图片")
If FileName = "" Then
Dim FileName As String = Dialogs.SelectFile("选择图片", False, filter:={({"png", "jpeg", "jpg", "gif", "webp"}, "常用图片文件")}).FirstOrDefault()
If String.IsNullOrEmpty(FileName) Then
FrmMain.ImageTitleLogo.Source = Nothing
e.Handled = True
Else
Try
'拷贝文件
File.Delete(PathExeFolder & "PCL\Logo.png")
CopyFile(FileName, PathExeFolder & "PCL\Logo.png")
FileUtils.Copy(FileName, TargetPath)
GoTo Refresh
Catch ex As Exception
Log(ex, "复制标题栏图片失败", NotifyLevel.MsgBox)
Logger.Error(ex, "复制标题栏图片失败", LogBehavior.Alert)
End Try
End If
End Sub
Private Sub BtnLogoDelete_Click(sender As Object, e As EventArgs) Handles BtnLogoDelete.Click
Try
File.Delete(PathExeFolder & "PCL\Logo.png")
FileUtils.Delete(PathExeFolder & "PCL\Logo.png")
RadioLogoType1.SetChecked(True, True)
Hint("标题栏图片已清空！", HintType.Green)
Catch ex As Exception
Log(ex, "清空标题栏图片失败", NotifyLevel.MsgBox)
Logger.Error(ex, "清空标题栏图片失败", LogBehavior.Alert)
End Try
End Sub
@@ -242,7 +236,7 @@ Refresh:
PanMusicDetail.Visibility = Visibility.Visible
BtnMusicClear.Visibility = Visibility.Visible
CardMusic.Title = "背景音乐（" &
EnumerateFiles(PathExeFolder & "PCL\Musics\").Count(Function(f) Not {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(f.Extension.Lower)) &
DirectoryUtils.GetFiles(PathExeFolder & "PCL\Musics\").Count(Function(f) Not {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(PathUtils.GetExtension(f))) &
" 首）"
Else
PanMusicVolume.Visibility = Visibility.Collapsed
@@ -264,16 +258,16 @@ Refresh:
Thread.Sleep(200)
'删除文件
Try
DeleteDirectory(PathExeFolder & "PCL\Musics")
DirectoryUtils.Delete(PathExeFolder & "PCL\Musics")
Hint("背景音乐已删除！", HintType.Green)
Catch ex As Exception
Log(ex, "删除背景音乐失败", NotifyLevel.MsgBox)
Logger.Error(ex, "删除背景音乐失败", LogBehavior.Alert)
End Try
Try
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\")
RunInUi(Sub() MusicRefreshPlay(False))
Catch ex As Exception
Log(ex, "重建背景音乐文件夹失败", NotifyLevel.MsgBox)
Logger.Error(ex, "重建背景音乐文件夹失败", LogBehavior.Alert)
End Try
End Sub)
End If
@@ -290,14 +284,14 @@ Refresh:
'主页
Private Sub BtnCustomFile_Click(sender As Object, e As EventArgs) Handles BtnCustomFile.Click
Try
If File.Exists(PathExeFolder & "PCL\Custom.xaml") Then
If FileUtils.Exists(PathExeFolder & "PCL\Custom.xaml") Then
If MyMsgBox("当前已存在布局文件，继续生成教学文件将会覆盖现有布局文件！", "覆盖确认", "继续", "取消", IsWarn:=True) = 2 Then Return
End If
FileUtils.Write(PathExeFolder & "PCL\Custom.xaml", GetResources("Custom"))
ExtractResources(PathExeFolder & "PCL\Custom.xaml", "Custom")
Hint("教学文件已生成！", HintType.Green)
OpenExplorer(PathExeFolder & "PCL\Custom.xaml")
Catch ex As Exception
Log(ex, "生成教学文件失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "生成教学文件失败")
End Try
End Sub
Private Sub BtnCustomRefresh_Click() Handles BtnCustomRefresh.Click
@@ -314,7 +308,7 @@ Refresh:
End Sub
Public Shared Sub OnMainPageTypeChanged()
If FrmSetupUI Is Nothing Then Return
Select Case CInt(Settings.Get("UiCustomType"))
Select Case CInt(Settings.Get(Of Integer)("UiCustomType"))
Case 0 '无
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
@@ -326,7 +320,7 @@ Refresh:
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Visible
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Settings.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustomWarn.Visibility = If(Settings.Get(Of Boolean)("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从 PCL 文件夹下的 Custom.xaml 读取主页内容。{vbCrLf}你可以手动编辑该文件，向主页添加文本、图片、常用网站、快捷启动等功能。"
CustomEventService.SetEventType(FrmSetupUI.HintCustom, CustomEvent.EventType.None)
Case 2 '联网
@@ -334,7 +328,7 @@ Refresh:
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Visible
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Settings.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustomWarn.Visibility = If(Settings.Get(Of Boolean)("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从指定网址联网获取主页内容。服主也可以用于动态更新服务器公告。{vbCrLf}如果你制作了稳定运行的联网主页，可以点击这条提示投稿，若合格即可加入预设！"
CustomEventService.SetEventType(FrmSetupUI.HintCustom, CustomEvent.EventType.打开网页)
CustomEventService.SetEventData(FrmSetupUI.HintCustom, "https://github.com/Meloong-Git/PCL/discussions/2528")
@@ -435,56 +429,56 @@ Refresh:
If FrmMain.PanTitleSelect Is Nothing OrElse Not FrmMain.PanTitleSelect.IsLoaded Then Return
Try
'顶部栏
If Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageDownload") AndAlso Settings.Get("UiHiddenPageLink") AndAlso Settings.Get("UiHiddenPageSetup") AndAlso Settings.Get("UiHiddenPageOther") Then
If Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenPageDownload") AndAlso Settings.Get(Of Boolean)("UiHiddenPageLink") AndAlso Settings.Get(Of Boolean)("UiHiddenPageSetup") AndAlso Settings.Get(Of Boolean)("UiHiddenPageOther") Then
'顶部栏已被全部隐藏
FrmMain.PanTitleSelect.Visibility = Visibility.Collapsed
Else
'顶部栏未被全部隐藏
FrmMain.PanTitleSelect.Visibility = Visibility.Visible
FrmMain.BtnTitleSelect1.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageDownload"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect2.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageLink"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect3.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageSetup"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect4.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageOther"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect1.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenPageDownload"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect2.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenPageLink"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect3.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenPageSetup"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect4.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenPageOther"), Visibility.Collapsed, Visibility.Visible)
End If
'功能
FrmLaunchLeft.RefreshButtonsUI()
If FrmSetupUI IsNot Nothing Then
FrmSetupUI.CardSwitch.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenFunctionHidden"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.CardSwitch.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenFunctionHidden"), Visibility.Collapsed, Visibility.Visible)
End If
'设置子页面
If FrmSetupLeft IsNot Nothing Then
FrmSetupLeft.ItemLaunch.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenSetupLaunch"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemUI.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenSetupUi"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemLink.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenSetupLink"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemSystem.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenSetupSystem"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemLaunch.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLaunch"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemUI.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenSetupUi"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemLink.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLink"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemSystem.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenSetupSystem"), Visibility.Collapsed, Visibility.Visible)
'隐藏左边选择卡
Dim AvaliableCount As Integer = 0
If Not Settings.Get("UiHiddenSetupLaunch") Then AvaliableCount += 1
If Not Settings.Get("UiHiddenSetupUi") Then AvaliableCount += 1
'If Not Settings.Get("UiHiddenSetupLink") Then AvaliableCount += 1
If Not Settings.Get("UiHiddenSetupSystem") Then AvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenSetupLaunch") Then AvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenSetupUi") Then AvaliableCount += 1
'If Not Settings.Get(Of Boolean)("UiHiddenSetupLink") Then AvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenSetupSystem") Then AvaliableCount += 1
FrmSetupLeft.PanItem.Visibility = If(AvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If
'更多子页面
Dim OtherAvaliableCount As Integer = 0
If Not Settings.Get("UiHiddenOtherHelp") Then OtherAvaliableCount += 1
If Not Settings.Get("UiHiddenOtherAbout") Then OtherAvaliableCount += 1
If Not Settings.Get("UiHiddenOtherTest") Then OtherAvaliableCount += 1
If Not Settings.Get("UiHiddenOtherFeedback") Then OtherAvaliableCount += 1
If Not Settings.Get("UiHiddenOtherVote") Then OtherAvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then OtherAvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then OtherAvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenOtherTest") Then OtherAvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenOtherFeedback") Then OtherAvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenOtherVote") Then OtherAvaliableCount += 1
If FrmOtherLeft IsNot Nothing Then
FrmOtherLeft.ItemHelp.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherHelp"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemFeedback.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherFeedback"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemVote.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherVote"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemAbout.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherAbout"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemTest.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherTest"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemHelp.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenOtherHelp"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemFeedback.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenOtherFeedback"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemVote.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenOtherVote"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemAbout.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemTest.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest"), Visibility.Collapsed, Visibility.Visible)
'隐藏左边选择卡
FrmOtherLeft.PanItem.Visibility = If(OtherAvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If
If OtherAvaliableCount = 1 AndAlso Not HiddenForceShow Then
If Not Settings.Get("UiHiddenOtherHelp") Then
If Not Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then
FrmMain.BtnTitleSelect4.Text = "帮助"
ElseIf Not Settings.Get("UiHiddenOtherAbout") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then
FrmMain.BtnTitleSelect4.Text = "关于"
Else
FrmMain.BtnTitleSelect4.Text = "百宝箱"
@@ -499,7 +493,7 @@ Refresh:
'备注
If FrmSetupUI IsNot Nothing Then FrmSetupUI.CardSwitch.Title = If(HiddenForceShow, "功能隐藏（已暂时关闭，按 F12 以重新启用）", "功能隐藏")
Catch ex As Exception
Log(ex, "刷新功能隐藏项目失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新功能隐藏项目失败")
End Try
End Sub
@@ -514,7 +508,7 @@ Refresh:
CheckHiddenSetupUI.Checked = True
Else
'关闭
If Settings.Get("UiHiddenSetupLaunch") AndAlso Settings.Get("UiHiddenSetupUi") AndAlso Settings.Get("UiHiddenSetupSystem") AndAlso Settings.Get("UiHiddenSetupLink") Then
If Settings.Get(Of Boolean)("UiHiddenSetupLaunch") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupUi") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupSystem") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLink") Then
CheckHiddenSetupLaunch.Checked = False
CheckHiddenSetupSystem.Checked = False
CheckHiddenSetupLink.Checked = False
@@ -524,7 +518,7 @@ Refresh:
End Sub
Private Sub HiddenSetupSub() Handles CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change
'设置子页面
If Settings.Get("UiHiddenSetupLaunch") AndAlso Settings.Get("UiHiddenSetupUi") AndAlso Settings.Get("UiHiddenSetupSystem") AndAlso Settings.Get("UiHiddenSetupLink") Then
If Settings.Get(Of Boolean)("UiHiddenSetupLaunch") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupUi") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupSystem") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLink") Then
'已被全部隐藏
CheckHiddenPageSetup.Checked = True
Else
@@ -543,8 +537,8 @@ Refresh:
CheckHiddenOtherHelp.Checked = True
Else
'关闭
If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") AndAlso
Settings.Get("UiHiddenOtherVote") AndAlso Settings.Get("UiHiddenOtherFeedback") Then
If Settings.Get(Of Boolean)("UiHiddenOtherHelp") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest") AndAlso
Settings.Get(Of Boolean)("UiHiddenOtherVote") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherFeedback") Then
CheckHiddenOtherAbout.Checked = False
CheckHiddenOtherTest.Checked = False
CheckHiddenOtherFeedback.Checked = False
@@ -555,7 +549,7 @@ Refresh:
End Sub
Private Sub HiddenOtherSub(sender As Object, user As Boolean) Handles CheckHiddenOtherHelp.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherTest.Change
'更多子页面（有具体内容的）
If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") Then
If Settings.Get(Of Boolean)("UiHiddenOtherHelp") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest") Then
'已被全部隐藏
CheckHiddenPageOther.Checked = True
Else
@@ -564,7 +558,7 @@ Refresh:
End If
'修改无具体内容的项
If Not user Then Return
If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") Then
If Settings.Get(Of Boolean)("UiHiddenOtherHelp") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest") Then
CheckHiddenOtherFeedback.Checked = True
CheckHiddenOtherVote.Checked = True
End If
@@ -572,8 +566,8 @@ Refresh:
Private Sub HiddenOtherNet(sender As Object, user As Boolean) Handles CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change
'更多子页面（无具体内容的）
If Not user Then Return
If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") AndAlso
(Not Settings.Get("UiHiddenOtherFeedback") OrElse Not Settings.Get("UiHiddenOtherVote")) Then
If Settings.Get(Of Boolean)("UiHiddenOtherHelp") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest") AndAlso
(Not Settings.Get(Of Boolean)("UiHiddenOtherFeedback") OrElse Not Settings.Get(Of Boolean)("UiHiddenOtherVote")) Then
CheckHiddenOtherAbout.Checked = False
CheckHiddenOtherTest.Checked = False
CheckHiddenOtherHelp.Checked = False
Plain Craft Launcher 2/Pages/PageSetup/Settings.vb
+18 -13
View File
@@ -1,5 +1,5 @@
Public Class Settings
Private Shared ReadOnly Entries As Dictionary(Of String, Setting) = (New List(Of Setting) From {
Public Shared ReadOnly Entries As Dictionary(Of String, Setting) = (New List(Of Setting) From {
New Setting("Identify", "", Source:=Sources.Registry),
New Setting("WindowHeight", 550),
New Setting("WindowWidth", 900),
@@ -27,7 +27,7 @@
New Setting("SystemHighestBetaVersionReg", 0, Source:=Sources.Registry, Encrypted:=True),
New Setting("SystemHighestAlphaVersionReg", 0, Source:=Sources.Registry, Encrypted:=True),
New Setting("SystemHelpVersion", 0, Source:=Sources.Registry),
New Setting("SystemDebugMode", False, Source:=Sources.Registry),
New Setting("SystemDebugMode", False, Source:=Sources.Registry, OnChanged:=Sub() Logger.Instance.MinLevel = If(ModeDebug, LogLevel.Trace, LogLevel.Info)),
New Setting("SystemDebugAnim", 9, Source:=Sources.Registry),
New Setting("SystemDebugDelay", False, Source:=Sources.Registry),
New Setting("SystemDebugSkipCopy", False, Source:=Sources.Registry),
@@ -47,11 +47,11 @@
New Setting("CacheMsName", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Migrated", False, Source:=Sources.Registry),
New Setting("CacheMsV2OAuthRefresh", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2OAuthExpires", 0, Source:=Sources.Registry),
New Setting("CacheMsV2Access", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2ProfileJson", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Uuid", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Name", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Expires", 0L, Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideAccess", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideClient", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideUuid", "", Source:=Sources.Registry, Encrypted:=True),
@@ -193,12 +193,12 @@
New Setting("VersionServerAuthServer", "", Source:=Sources.Instance)
}).ToDictionary(Function(e) e.Key)
Private Enum Sources
Public Enum Sources
Normal
Registry
Instance
End Enum
Private Class Setting
Public Class Setting
Public Key As String
Public Encrypted As Boolean
Public DefaultValue As Object
@@ -220,7 +220,7 @@
Me.Type = If(Value, "").GetType
Me.OnChanged = OnChanged
Catch ex As Exception
Log(ex, "初始化设置项失败", NotifyLevel.MsgBoxAndFeedback) '#5095 的 fallback
Logger.Error(ex, "初始化设置项失败") '#5095 的 fallback
End Try
End Sub
@@ -228,10 +228,11 @@
''' 读取过的设置的缓存，若从未读取过则为 Nothing。
''' 若为版本独立设置，键为版本路径；否则，键为空字符串。
''' </summary>
Private ValueCache As New Dictionary(Of String, Object)
Public ValueCache As New ConcurrentDictionary(Of String, Object)
Public Function GetCache(Instance As McInstance)
Dim Key As String = If(Source = Sources.Instance, Instance.PathVersion, "")
Return If(ValueCache.ContainsKey(Key), ValueCache(Key), Nothing)
Dim Result = Nothing
Return If(ValueCache.TryGetValue(Key, Result), Result, Nothing)
End Function
Public Sub [Set](Value As Object, Instance As McInstance)
Dim Key As String = If(Source = Sources.Instance, Instance.PathVersion, "")
@@ -243,12 +244,13 @@
''' </summary>
Public Sub Save(Optional Instance As McInstance = Nothing)
Dim Value As String = GetCache(Instance)
Logger.Trace($"保存设置：{Key} = {Value}{If(Instance Is Nothing, "", $"（实例：{Instance?.PathVersion}）")}")
If Encrypted Then
Try
If Value Is Nothing Then Value = ""
Value = SecretEncrypt(Value, "PCL" & Identify)
Catch ex As Exception
Log(ex, "加密设置失败：" & Key, NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"加密设置失败：{Key}")
End Try
End If
Select Case Source
@@ -281,7 +283,7 @@
'触发改变事件（必须在保存之后，以保证 VersionServerLogin 之类的在事件中读取到的是最新的值）
If Entry.OnChanged IsNot Nothing Then Entry.OnChanged.Invoke(Value)
Catch ex As Exception
Log(ex, "设置设置项时出错（" & Key & ", " & Value & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"设置设置项时出错（{Key}, {Value}）")
End Try
End Sub
''' <summary>
@@ -336,7 +338,7 @@
Try
GotValue = SecretDecrypt(GotValue, "PCL" & Identify)
Catch ex As Exception
Log(ex, "解密设置失败：" & Key, NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"解密设置失败：{Key}")
GotValue = Entry.DefaultValue
Entry.Set(Entry.DefaultValue, Instance)
Entry.Save(Instance)
@@ -345,11 +347,14 @@
End If
Entry.Set(CTypeDynamic(GotValue, Entry.Type), Instance)
Catch ex As Exception
Log(ex, "读取设置失败：" & Key, NotifyLevel.AllUsers)
Logger.Error(ex, $"读取设置失败：{Key}", LogBehavior.Toast)
Entry.Set(CTypeDynamic(Entry.DefaultValue, Entry.Type), Instance)
End Try
Return Entry.GetCache(Instance)
End Function
Public Shared Function [Get](Of T)(Key As String, Optional Instance As McInstance = Nothing) As T
Return [Get](Key, Instance)
End Function
''' <summary>
''' 获取某个未经加密的设置项的值。
''' 若该设置项经过了加密，则会抛出异常。
@@ -385,7 +390,7 @@
'触发改变事件
If Entry.OnChanged IsNot Nothing Then Entry.OnChanged.Invoke(Entry.DefaultValue)
Catch ex As Exception
Log(ex, "重置设置项时出错（" & Key & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"重置设置项时出错（{Key}）")
End Try
End Sub
Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb
+14 -14
View File
@@ -55,7 +55,7 @@
#End Region
Catch ex As Exception
Log(ex, "下载管理左栏监视出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "下载管理左栏监视出错")
End Try
If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Return
Try
@@ -63,7 +63,7 @@
TaskRefresh(Loader)
Next
Catch ex As Exception
Log(ex, "下载管理右栏监视出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "下载管理右栏监视出错")
End Try
End Sub
Public Sub TaskRefresh(Loader As LoaderBase)
@@ -78,7 +78,7 @@
If Val(Card.Tag) = NewValue Then Return
Card.Tag = NewValue
If Card.Children.Count <= 3 Then
Log("[Watcher] 元素不足的卡片：" & Loader.Name, NotifyLevel.DebugModeOnly)
Logger.Warn($"元素不足的卡片：{Loader.Name}")
Return
End If
Card = Card.Children(3)
@@ -90,7 +90,7 @@
Card.Children.Clear()
Card.Children.Add(GetObjectFromXML("<Path xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" Stretch=""Uniform"" Tag=""Failed"" Data=""F1 M2.5,0 L0,2.5 7.5,10 0,17.5 2.5,20 10,12.5 17.5,20 20,17.5 12.5,10 20,2.5 17.5,0 10,7.5 2.5,0Z"" Height=""15"" Width=""15"" HorizontalAlignment=""Center"" Grid.Column=""0"" Grid.Row=""0"" Fill=""{DynamicResource ColorBrush3}"" Margin=""0,1,0,0"" VerticalAlignment=""Top""/>"))
Dim Tb As TextBlock = GetObjectFromXML("<TextBlock xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" TextWrapping=""Wrap"" HorizontalAlignment=""Left"" ToolTip=""单击复制错误详情"" Grid.Column=""1"" Grid.Row=""0"" Margin=""0,0,0,5"" />")
Tb.Text = Loader.Error.GetDetail()
Tb.Text = Loader.Error.GetDisplay(True)
AddHandler Tb.MouseLeftButtonDown,
Sub(sender As TextBlock, e As EventArgs)
ClipboardSet(sender.Text, False)
@@ -106,7 +106,7 @@
#Region "进度不同，更新卡片"
Try
If Card.Children.Count < LoaderList.Count * 2 Then
Log($"[Watcher] 刷新下载管理卡片 {Loader.Name} 失败：卡片中仅有 {Card.Children.Count} 个子项，要求至少有 {LoaderList.Count * 2} 个子项", NotifyLevel.DebugModeOnly)
Logger.Warn($"刷新下载管理卡片 {Loader.Name} 失败：卡片中仅有 {Card.Children.Count} 个子项，要求至少有 {LoaderList.Count * 2} 个子项")
Exit Try
End If
Dim Row As Integer = 0
@@ -133,12 +133,12 @@
Row += 1
Next
Catch ex As Exception
Log(ex, $"刷新下载管理卡片 {Loader.Name} 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"刷新下载管理卡片 {Loader.Name} 失败")
End Try
#End Region
End Select
Catch ex As Exception
Log(ex, "更新下载管理显示失败（" & Loader.State.ToString & "）", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"更新下载管理显示失败（{Loader.State}）")
End Try
ElseIf Not (Loader.State = LoadState.Interrupted OrElse Loader.State = LoadState.Finished) Then
Try
@@ -177,13 +177,13 @@
Try
Card = GetObjectFromXML(CardXAML)
Catch ex As Exception
Log(ex, "新建下载管理卡片失败")
Log("出错的卡片内容：" & vbCrLf & CardXAML)
Logger.Warn(ex, "新建下载管理卡片失败")
Logger.Info($"出错的卡片内容：{vbCrLf}{CardXAML}")
Throw
End Try
FrmSpeedRight.PanMain.Children.Insert(0, Card)
RightCards.Add(Loader.Name, Card)
Log($"[Watcher] 新建下载管理卡片：{Loader.Name}")
Logger.Info($"新建下载管理卡片：{Loader.Name}")
'添加取消按钮
Dim Cancel As New MyIconButton With {.Name = "BtnCancel", .Logo = "F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z", .Height = 20, .Margin = New Thickness(0, 10, 10, 0), .LogoScale = 1.1, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Top}
Card.Children.Add(Cancel)
@@ -193,7 +193,7 @@
AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack())
RightCards.Remove(Loader.Name)
LoaderTaskbar.Remove(Loader)
Log($"[Taskbar] 关闭下载管理卡片：{Loader.Name}，且移出任务列表")
Logger.Info($"关闭下载管理卡片：{Loader.Name}，且移出任务列表")
RunInThread(Sub() Loader.Interrupt())
End Sub
'如果已经失败，再刷新一次，修改成失败的控件
@@ -203,11 +203,11 @@
End If
#End Region
Catch ex As Exception
Log(ex, "添加下载管理卡片失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "添加下载管理卡片失败")
End Try
End If
Catch ex As Exception
Log(ex, "刷新下载管理显示失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新下载管理显示失败")
End Try
End Sub
Public Sub TaskRemove(Loader As Object)
@@ -218,7 +218,7 @@
Dim Card As Grid = RightCards(Loader.Name)
FrmSpeedRight.PanMain.Children.Remove(Card)
RightCards.Remove(Loader.Name)
Log($"[Watcher] 移除下载管理卡片：{Loader.Name}")
Logger.Info($"移除下载管理卡片：{Loader.Name}")
End Sub)
End If
End Sub

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