This commit is contained in:
龙腾猫跃
2026-04-29 05:37:25 +08:00
parent 6aedd20512
commit 67764b393d
113 changed files with 5147 additions and 5865 deletions
+3
View File
@@ -0,0 +1,3 @@
[submodule "MeloongCore"]
path = MeloongCore
url = https://github.com/Meloong-Git/MeloongCore.git
+60
View File
@@ -0,0 +1,60 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net462</TargetFramework>
<OutputType>Library</OutputType>
<AllowUnsafeBlocks>True</AllowUnsafeBlocks>
<OutDir>bin\</OutDir>
<AppendTargetFrameworkToOutputPath>false</AppendTargetFrameworkToOutputPath>
<AppendRuntimeIdentifierToOutputPath>false</AppendRuntimeIdentifierToOutputPath>
<Configurations>Debug;Release;Snapshot</Configurations>
<Deterministic>true</Deterministic>
<LangVersion>13.0</LangVersion>
<Nullable>enable</Nullable>
<AnalysisLevel>8.0</AnalysisLevel>
</PropertyGroup>
<ItemGroup>
<PackageReference Include="Nullable" Version="1.3.1">
<PrivateAssets>all</PrivateAssets>
<IncludeAssets>runtime; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets>
</PackageReference>
<PackageReference Include="System.ValueTuple" Version="4.6.1" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\MeloongCore\Shared\MeloongCore.csproj" />
<ProjectReference Include="..\MeloongCore\Wpf\MeloongCoreWpf.csproj" />
</ItemGroup>
<ItemGroup>
<Using Include="System" />
<Using Include="System.ComponentModel" />
<Using Include="System.Collections" />
<Using Include="System.Collections.Generic" />
<Using Include="System.Diagnostics.CodeAnalysis" />
<Using Include="System.Linq" />
<Using Include="System.Text" />
<Using Include="System.IO" />
<Using Include="System.Net" />
<Using Include="System.Threading" />
<Using Include="System.Collections.Concurrent" />
<Using Include="System.Runtime.CompilerServices" />
<Using Include="System.Runtime.InteropServices" />
<Using Include="MeloongCore" />
<Using Include="MeloongCore.Extensions" />
<Using Include="MeloongCore.Wpf" />
<Using Include="MeloongCore.Wpf.Extensions" />
</ItemGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|AnyCPU'">
<DefineConstants>$(DefineConstants);SNAPSHOT</DefineConstants>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|AnyCPU'" />
<PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Snapshot|AnyCPU'">
<Optimize>True</Optimize>
</PropertyGroup>
</Project>
+33 -6
View File
@@ -5,22 +5,49 @@ VisualStudioVersion = 17.2.32616.157
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Plain Craft Launcher 2", "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj", "{4499F2D2-18EF-4238-B1F0-7BD547AFF925}"
EndProject
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "PCLCS", "PCLCS\PCLCS.csproj", "{32DE4AAF-F4D6-42C5-9604-19236DE96C69}"
EndProject
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "MeloongCore", "MeloongCore\Shared\MeloongCore.csproj", "{D22BBF3C-2177-0208-4E29-8466AA41AC6F}"
EndProject
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "MeloongCoreWpf", "MeloongCore\Wpf\MeloongCoreWpf.csproj", "{2DFFE2A0-1101-816B-D240-F644B2D74A68}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Beta|Any CPU = Beta|Any CPU
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
ReleaseUpdate|Any CPU = ReleaseUpdate|Any CPU
Snapshot|Any CPU = Snapshot|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.ActiveCfg = BETA|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.Build.0 = BETA|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.Build.0 = Debug|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.ActiveCfg = Release|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.Build.0 = Release|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.ActiveCfg = ReleaseUpdate|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.Build.0 = ReleaseUpdate|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
{4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Debug|Any CPU.Build.0 = Debug|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Release|Any CPU.ActiveCfg = Release|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Release|Any CPU.Build.0 = Release|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
{32DE4AAF-F4D6-42C5-9604-19236DE96C69}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Debug|Any CPU.Build.0 = Debug|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Release|Any CPU.ActiveCfg = Debug|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Release|Any CPU.Build.0 = Debug|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Snapshot|Any CPU.ActiveCfg = Debug|Any CPU
{AFB035DA-CB49-49CE-B96F-581BF8368CCF}.Snapshot|Any CPU.Build.0 = Debug|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Debug|Any CPU.Build.0 = Debug|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Release|Any CPU.ActiveCfg = Release|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Release|Any CPU.Build.0 = Release|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
{D22BBF3C-2177-0208-4E29-8466AA41AC6F}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Debug|Any CPU.Build.0 = Debug|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Release|Any CPU.ActiveCfg = Release|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Release|Any CPU.Build.0 = Release|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Snapshot|Any CPU.ActiveCfg = Snapshot|Any CPU
{2DFFE2A0-1101-816B-D240-F644B2D74A68}.Snapshot|Any CPU.Build.0 = Snapshot|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
+1 -1
View File
@@ -220,7 +220,7 @@
</Setter.Value>
</Setter>
</Style>
<Style TargetType="local:PageComp" BasedOn="{StaticResource {x:Type local:MyScrollViewer}}" />
<Style TargetType="local:PageResource" BasedOn="{StaticResource {x:Type local:MyScrollViewer}}" />
<Style TargetType="ScrollViewer" x:Key="ScrollViewerFullMargin">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="CanContentScroll" Value="False" />
+97 -83
View File
@@ -3,26 +3,45 @@ Imports System.Windows.Threading
Public Class Application
#If DEBUG Then
''' <summary>
''' 用于开始程序时的一些测试。
''' </summary>
Private Sub Test()
Try
ModDevelop.Start()
Catch ex As Exception
Log(ex, "开发者模式测试出错", LogLevel.Msgbox)
End Try
End Sub
#End If
'开始
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
Try
'动态 DLL 调用(必须尽量在前面,否则模块加载 CacheCow 等 DLL 就可能导致崩溃)
AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
'开始
SecretOnApplicationStart()
'执行开发版测试
If BuildType = BuildTypes.Debug Then
Try
ModDevelop.Start()
Catch ex As Exception
Log(ex, "开发者模式测试出错", NotifyLevel.MsgBox)
End Try
End If
'提升主线程优先级
Thread.CurrentThread.Priority = ThreadPriority.Highest
'确保 .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\")
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)
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
@@ -54,42 +73,42 @@ Public Class Application
End If
End If
'初始化文件结构
Directory.CreateDirectory(Path & "PCL\Pictures")
Directory.CreateDirectory(Path & "PCL\Musics")
DirectoryUtils.Create(PathExeFolder & "PCL\Pictures\")
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\")
Try
Directory.CreateDirectory(PathTemp)
DirectoryUtils.Create(PathTemp)
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限")
Catch ex As Exception
If PathTemp = IO.Path.GetTempPath() & "PCL\" Then
If PathTemp = Path.GetTempPath() & "PCL\" Then
MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
Else
MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
Settings.Set("SystemSystemCache", "")
PathTemp = IO.Path.GetTempPath() & "PCL\"
PathTemp = Path.GetTempPath() & "PCL\"
End If
End Try
Directory.CreateDirectory(PathTemp & "Cache")
Directory.CreateDirectory(PathAppdata)
'检测单例
#If Not DEBUG Then
Dim ShouldWaitForExit As Boolean = e.Args.Length > 0 AndAlso e.Args(0) = "--wait" '要求等待已有的 PCL 退出
Dim WaitRetryCount As Integer = 0
DirectoryUtils.Create(PathTemp & "Cache\")
DirectoryUtils.Create(PathAppdata)
'要求单例
If BuildType <> BuildTypes.Debug Then
Dim ShouldWaitForExit As Boolean = e.Args.Length > 0 AndAlso e.Args(0) = "--wait" '要求等待已有的 PCL 退出
Dim WaitRetryCount As Integer = 0
WaitRetry:
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ")
If WindowHwnd = IntPtr.Zero Then FindWindow(Nothing, "Plain Craft Launcher 2 ")
If WindowHwnd <> IntPtr.Zero Then
If ShouldWaitForExit AndAlso WaitRetryCount < 20 Then '至多等待 10 秒
WaitRetryCount += 1
Thread.Sleep(500)
GoTo WaitRetry
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ")
If WindowHwnd = IntPtr.Zero Then FindWindow(Nothing, "Plain Craft Launcher 2 ")
If WindowHwnd <> IntPtr.Zero Then
If ShouldWaitForExit AndAlso WaitRetryCount < 20 Then '至多等待 10 秒
WaitRetryCount += 1
Thread.Sleep(500)
GoTo WaitRetry
End If
'将已有的 PCL 窗口拖出来
ShowWindowToTop(WindowHwnd)
'播放提示音并退出
Beep()
Environment.[Exit](ProcessReturnValues.Cancel)
End If
'将已有的 PCL 窗口拖出来
ShowWindowToTop(WindowHwnd)
'播放提示音并退出
Beep()
Environment.[Exit](ProcessReturnValues.Cancel)
End If
#End If
'设置 ToolTipService 默认值
ToolTipService.InitialShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(300))
ToolTipService.BetweenShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(400))
@@ -112,17 +131,17 @@ WaitRetry:
'日志初始化
LogStart()
'添加日志
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
#If RELEASE Then
Log($"[Start] 识别码:{Identify}{If(ThemeCheckOne(9), ",正式版", "")}")
#Else
Log($"[Start] 识别码:{Identify}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
#End If
Log($"[Start] 程序路径:{PathWithName}")
Log($"[Start] 程序版本:{VersionDisplay} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
If BuildType = BuildTypes.Snapshot Then
Log($"[Start] 识别码:{Identify}{If(ThemeCheckOne(9), ",已解锁反馈主题", ",未解锁反馈主题")}")
Else
Log($"[Start] 识别码:{Identify}")
End If
Log($"[Start] 程序路径:{PathExe}")
Log($"[Start] 系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Log($"[Start] 管理员权限:{IsAdmin()}")
'检测异常环境
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
If PathExeFolder.Contains(Path.GetTempPath()) OrElse PathExeFolder.Contains("AppData\Local\Temp\") Then
MyMsgBox("请将 PCL 从压缩包中解压后再使用!" & vbCrLf & "如果不会解压,可以在网上寻找教程。", "需要解压!", "我知道了", IsWarn:=True, ForceWait:=True)
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
End If
@@ -132,15 +151,11 @@ WaitRetry:
'计时
Log("[Start] 第一阶段加载用时:" & GetTimeMs() - ApplicationStartTick & " ms")
ApplicationStartTick = GetTimeMs()
'执行测试
#If DEBUG Then
Test()
#End If
AniControlEnabled += 1
Catch ex As Exception
Dim FilePath As String = Nothing
Try
FilePath = PathWithName
FilePath = PathExe
Catch
End Try
MsgBox(ex.GetDetail(True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
@@ -173,41 +188,40 @@ WaitRetry:
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 后再试。", LogLevel.Critical, "运行环境错误")
Log(e.Exception, "你的 .NET Framework 版本过低或损坏,请下载并重新安装 .NET Framework 4.6.2!" & vbCrLf & "若无法安装,可在卸载高版本的 .NET Framework 后再试。", NotifyLevel.Critical, "运行环境错误")
Else
Log(e.Exception, "程序出现未知错误", LogLevel.Critical, "锟斤拷烫烫烫")
Log(e.Exception, "程序出现未知错误", NotifyLevel.Critical, "锟斤拷烫烫烫")
End If
End Sub
'动态 DLL 调用
Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
Public Shared Function AssemblyResolve(sender As Object, Args As ResolveEventArgs) As Assembly
'缓存
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"}
'动态 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)
'查找对应的 DLL
Dim Prefix As String = Prefixes.FirstOrDefault(Function(p) Args.Name.StartsWithF(p))
If Prefix Is Nothing Then Return Nothing
'加载 DLL
If Not Locks.ContainsKey(Prefix) Then Locks(Prefix) = New Object()
SyncLock Locks(Prefix)
If Not LoadedAssembly.ContainsKey(Prefix) Then
Log($"[Start] 加载 DLL:{Prefix}")
LoadedAssembly(Prefix) = Assembly.Load(GetResources(Prefix))
'WebP 特判
If Prefix = "Imazen.WebP" Then
SetDllDirectory(PathPure.TrimEnd("\"c))
Try
WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64"))
Catch ex As Exception
Log(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时,同时写入文件导致文件占用,进而导致崩溃
End Try
Static LoadedAssembly As New Dictionary(Of String, 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
End If
Return LoadedAssembly(Prefix)
End SyncLock
End Function
Return LoadedAssembly(Prefix)
End SyncLock
End Function
End Sub
Private Shared Sub ExtractLibwebp() '这个方法会调用 ModBase,进而调用 MeloongCore,所以不能放在 New 里
SetDllDirectory(PathPure.TrimEnd("\"c))
Try
FileUtils.Write(PathPure & "libwebp.dll", GetResources("libwebp64"))
Catch ex As Exception
Log(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时,同时写入文件导致文件占用,进而导致崩溃
End Try
End Sub
Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
'切换窗口
@@ -99,7 +99,7 @@ Namespace Controls.Behaviors
Dim pasteText = Forms.Clipboard.GetText()
'将换行符替换为空格(#7825)
If Not tb.AcceptsReturn Then pasteText = pasteText.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
If Not tb.AcceptsReturn Then pasteText = pasteText.ReplaceLineEndings(" ", mergeMultiple:=True)
Dim start = tb.SelectionStart
+9 -9
View File
@@ -121,17 +121,17 @@
Case 6
Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).OrderByDescending(Function(a) a).ToList
Case 8, 9
Stack.Tag = CType(Stack.Tag, List(Of CompFile)).SortByComparison(Function(a, b) a.ReleaseDate > b.ReleaseDate)
Stack.Tag = CType(Stack.Tag, List(Of ResourceVersion)).SortByComparison(Function(a, b) a.ReleaseDate > b.ReleaseDate)
HasDuplicates =
CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count
CType(Stack.Tag, List(Of ResourceVersion)).DistinctBy(Function(a) a.Display).Count <>
CType(Stack.Tag, List(Of ResourceVersion)).Count
End Select
'控件转换
Select Case Type
Case 6
ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True)
Case 8
CompFilesCardPreload(Stack, Stack.Tag)
PageDownloadResourceDetail.ResourceFilesCardPreload(Stack, Stack.Tag)
End Select
'实现控件虚拟化
For Each Data As Object In Stack.Tag
@@ -149,12 +149,12 @@
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
Case 8
'若存在重复的版本名,则显示文件名而非版本名(#1344)
Stack.Children.Add(CType(Data, CompFile).ToListItem(
AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
Stack.Children.Add(CType(Data, ResourceVersion).ToListItem(
AddressOf FrmDownloadResourceDetail.Save_Click, IsBadDisplay:=HasDuplicates))
Case 9
'若存在重复的版本名,则显示文件名而非版本名(#1344)
Stack.Children.Add(CType(Data, CompFile).ToListItem(
AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
Stack.Children.Add(CType(Data, ResourceVersion).ToListItem(
AddressOf FrmDownloadResourceDetail.Install_Click, AddressOf FrmDownloadResourceDetail.Save_Click, IsBadDisplay:=HasDuplicates))
Case 10
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
Case 11
@@ -164,7 +164,7 @@
Case 13
Stack.Children.Add(NeoForgeDownloadListItem(Data, AddressOf NeoForgeSave_Click, True))
Case Else
Log("未知的虚拟化种类:" & Type, LogLevel.Feedback)
Log("未知的虚拟化种类:" & Type, NotifyLevel.MsgBoxAndFeedback)
End Select
Next
Stack.Children.Add(New FrameworkElement With {.Height = 18}) '下边距,同时适应折叠
+4 -13
View File
@@ -22,7 +22,7 @@
End If
If HintText.Length > 0 Then TextBox.HintText = HintText
Catch ex As Exception
Log(ex, "初始化可编辑文本框失败(" & If(Name, "") & ")", LogLevel.Feedback)
Log(ex, "初始化可编辑文本框失败(" & If(Name, "") & ")", NotifyLevel.MsgBoxAndFeedback)
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, "设置下拉框透明度失败", LogLevel.Feedback)
Log(ex, "设置下拉框透明度失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Private Sub MyComboBox_DropDownClosed(sender As Object, e As EventArgs) Handles Me.DropDownClosed
@@ -147,25 +147,16 @@
ElseIf Items.Count > NewValue Then
SelectedIndex = NewValue
Else
Log($"[Setting] 尝试显示设置 {SettingService.GetKey(Me)},但没有找到设置值 {NewValue} 的对应项", LogLevel.Debug)
Log($"[Setting] 尝试显示设置 {SettingService.GetKey(Me)},但没有找到设置值 {NewValue} 的对应项", NotifyLevel.DebugModeOnly)
SelectedIndex = -1
SelectedItem = Nothing
'Dim Key As String = SettingService.GetKey(Me)
'Dim DefaultValue = Settings.GetDefault(Key)
'If DefaultValue = NewValue Then
' Log($"[Setting] 尝试显示设置 {Key},但没有找到设置值 {NewValue} 的对应项,这可能是因为程序版本太老了", LogLevel.Hint)
'Else
' Log($"[Setting] 尝试显示设置 {Key},但没有找到设置值 {NewValue} 的对应项,已重置该设置", LogLevel.Debug)
' Settings.Reset(Key)
' RefreshSetting(DefaultValue)
'End If
End If
End Sub
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
If SelectedItem Is Nothing Then Return Nothing
If TypeOf SelectedItem Is DependencyObject Then
Return Val(If(SettingService.GetValue(SelectedItem), SelectedIndex))
Return If(SettingService.GetValue(SelectedItem), SelectedIndex)
Else
Return SelectedIndex
End If
@@ -1,4 +1,6 @@
Public Class MyIconButton
Imports System.Windows.Shapes
Public Class MyIconButton
'自定义事件
Public Event Click(sender As Object, e As EventArgs)
+3 -3
View File
@@ -143,11 +143,11 @@
Log(ex, $"下载图片失败,使用本地备用图片({Source})")
Return
Catch exx As Exception
Log(ex, $"下载图片失败({Source})", LogLevel.Hint)
Log(exx, $"加载备用图片失败({FallbackSource})", LogLevel.Hint)
Log(ex, $"下载图片失败({Source})", NotifyLevel.AllUsers)
Log(exx, $"加载备用图片失败({FallbackSource})", NotifyLevel.AllUsers)
End Try
Else
Log(ex, $"下载图片失败({Source},备用:{FallbackSource})", LogLevel.Hint)
Log(ex, $"下载图片失败({Source},备用:{FallbackSource})", NotifyLevel.AllUsers)
End If
End Try
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
@@ -174,7 +174,7 @@ Public Class MyListItem
Return GetValue(TitleProperty)
End Get
Set(value As String)
SetValue(TitleProperty, value.Replace(vbCr, "").Replace(vbLf, ""))
SetValue(TitleProperty, value.ReplaceLineEndings(""))
End Set
End Property
Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyListItem))
@@ -198,7 +198,7 @@ Public Class MyListItem
End Get
Set(value As String)
If _Info = value Then Return
value = value.Replace(vbCr, "").Replace(vbLf, "")
value = value.ReplaceLineEndings("")
_Info = value
LabInfo.Text = value
LabInfo.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
@@ -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 失败", LogLevel.Msgbox)
Log(ex, "设置帮助 MyListItem 失败", NotifyLevel.MsgBox)
CustomEventService.SetEventType(Me, CustomEvent.EventType.None)
CustomEventService.SetEventData(Me, "")
End Try
@@ -79,7 +79,7 @@ Public Class MyLoading
Do While Ex.InnerException IsNot Nothing
Ex = Ex.InnerException
Loop
LabText.Text = If(Ex.IsNetworkRelated(), "网络环境不佳,请稍后再试,或使用 VPN 改善网络环境", StrTrim(Ex.Message))
LabText.Text = If(Ex.IsNetworkRelated(), "网络环境不佳,请稍后再试,或使用 VPN 改善网络环境", Ex.Message)
End If
Else
LabText.Text = TextError
@@ -26,7 +26,7 @@
ShapeLine.StrokeThickness = GetWPFSize(1)
Catch ex As Exception
Log(ex, "输入弹窗初始化失败", LogLevel.Hint)
Log(ex, "输入弹窗初始化失败", NotifyLevel.AllUsers)
End Try
End Sub
@@ -49,7 +49,7 @@
Log("[Control] 输入弹窗:" & LabTitle.Text)
Catch ex As Exception
Log(ex, "输入弹窗加载失败", LogLevel.Hint)
Log(ex, "输入弹窗加载失败", NotifyLevel.AllUsers)
End Try
End Sub
Private Sub Close()
@@ -35,7 +35,7 @@
Next
Catch ex As Exception
Log(ex, "选择弹窗初始化失败", LogLevel.Hint)
Log(ex, "选择弹窗初始化失败", NotifyLevel.AllUsers)
End Try
End Sub
@@ -56,7 +56,7 @@
Log("[Control] 选择弹窗:" & LabTitle.Text)
Catch ex As Exception
Log(ex, "选择弹窗加载失败", LogLevel.Hint)
Log(ex, "选择弹窗加载失败", NotifyLevel.AllUsers)
End Try
End Sub
Private Sub Close()
@@ -25,7 +25,7 @@
ShapeLine.StrokeThickness = GetWPFSize(1)
Catch ex As Exception
Log(ex, "普通弹窗初始化失败", LogLevel.Hint)
Log(ex, "普通弹窗初始化失败", NotifyLevel.AllUsers)
End Try
End Sub
@@ -47,7 +47,7 @@
Log("[Control] 普通弹窗:" & LabTitle.Text & vbCrLf & LabCaption.Text)
Catch ex As Exception
Log(ex, "普通弹窗加载失败", LogLevel.Hint)
Log(ex, "普通弹窗加载失败", NotifyLevel.AllUsers)
End Try
End Sub
Private Sub Close()
@@ -1,4 +1,5 @@
Imports System.Windows.Markup
Imports System.Windows.Shapes
<ContentProperty("Inlines")>
Public Class MyRadioBox
@@ -99,7 +100,7 @@ Public Class MyRadioBox
End If
Catch ex As Exception
Log(ex, "单选框勾选改变错误", LogLevel.Hint)
Log(ex, "单选框勾选改变错误", NotifyLevel.AllUsers)
End Try
End Sub
Private Sub SyncUI()
@@ -104,7 +104,7 @@ Public Class MyRadioButton
RaiseCustomEvent()
Catch ex As Exception
Log(ex, "单选按钮勾选改变错误", LogLevel.Hint)
Log(ex, "单选按钮勾选改变错误", NotifyLevel.AllUsers)
End Try
End Sub
@@ -27,7 +27,7 @@
AniStart(
AaDouble(
Sub(AnimDelta As Double)
RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
RealOffset = (RealOffset + AnimDelta).Clamp(0, ExtentHeight - ActualHeight)
ScrollToVerticalOffset(RealOffset)
End Sub, Delta * DeltaMult, 300,, New AniEaseOutFluent(6)))
End Sub
@@ -1,4 +1,6 @@
Public Class MySlider
Imports System.Windows.Shapes
Public Class MySlider
Implements ISettingControl
'基础
@@ -29,7 +31,7 @@
Set(newValue As Integer)
Try
newValue = MathClamp(newValue, 0, MaxValue)
newValue = newValue.Clamp(0, MaxValue)
If _Value = newValue Then Return
'触发 Preview 事件,修改新值
@@ -61,7 +63,7 @@
If AniControlEnabled = 0 Then RaiseEvent Change(Me, False)
Catch ex As Exception
Log(ex, "滑动条进度改变出错", LogLevel.Hint)
Log(ex, "滑动条进度改变出错", NotifyLevel.AllUsers)
End Try
End Set
End Property
@@ -71,7 +73,7 @@
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
LineFore.Width = Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5))
LineBack.Width = Math.Max(0, ActualWidth - ShapeDot.Width - NewWidth + If(ActualWidth - ShapeDot.Width - NewWidth < 0.5, 0, 0.5))
SetLeft(ShapeDot, NewWidth)
ShapeDot.Margin = New Thickness(NewWidth, ShapeDot.Margin.Top, ShapeDot.Margin.Right, ShapeDot.Margin.Bottom)
End Sub
'拖动
@@ -89,7 +91,7 @@
AniStop("MySlider KeyPopup " & Uuid)
End Sub
Public Sub DragDoing()
Dim Percent As Double = MathClamp((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width), 0, 1)
Dim Percent As Double = ((Mouse.GetPosition(PanMain).X - ShapeDot.Width / 2) / (ActualWidth - ShapeDot.Width)).Clamp(0, 1)
Dim NewValue As Integer = Percent * MaxValue
If Not NewValue = Value Then
Value = NewValue
+1 -1
View File
@@ -228,7 +228,7 @@
'改变文本
RaiseEvent ValidatedTextChanged(sender, e)
Catch ex As Exception
Log(ex, "进行输入验证时出错", LogLevel.Critical)
Log(ex, "进行输入验证时出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
+297 -298
View File
@@ -10,254 +10,260 @@ Public Class FormMain
Dim FeatureCount As Integer = 0, BugCount As Integer = 0
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 391 Then 'Release 2.12.6.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:会为部分 Forge / NeoForge 选择不支持的 Java"))
BugCount += 4
End If
If LastVersion < 389 Then 'Release 2.12.6.1
If LastVersion = 387 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法使用 Java 25+ 启动 Forge"))
FeatureCount += 4
BugCount += 3
End If
If LastVersion < 387 Then 'Release 2.12.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:降低 Minecraft 的内存占用"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:Minecraft 使用 Java 25+ 时的一个性能问题"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法下载 NeoForge 26.1"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:老版本 Windows 无法启动游戏"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:连接 Mojang 的服务可能失败,提示错误码 421"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法访问爱发电"))
FeatureCount += 24
BugCount += 19
End If
If LastVersion < 383 Then 'Release 2.12.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能完全卡住,或是下载进度反复回退"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:内存管理设置,可以选择 G1GC、ZGC 或分代 ZGC"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:来自 Modrinth 的文件下载速度"))
FeatureCount += 15
BugCount += 16
End If
If LastVersion < 381 Then 'Release 2.12.2
FeatureCount += 3
BugCount += 13
End If
If LastVersion < 379 Then 'Release 2.12.1
If LastVersion >= 376 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "删除:暂时隐藏联机入口……不过只是暂时关闭,它还会回来的!"))
If BuildType = BuildTypes.Release Then
If LastVersion < 391 Then 'Release 2.12.6.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:会为部分 Forge / NeoForge 选择不支持的 Java"))
BugCount += 4
End If
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:适配新的 Minecraft 版本号系统与 Unobfuscated 版本"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:巨幅优化各个下载页面和 Mod 管理页面的性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:更换披风时会显示当前使用的披风"))
FeatureCount += 33
BugCount += 29
End If
If LastVersion < 376 Then 'Release 2.11.2
'FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:联机功能!"))
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 < 390 Then 'Snapshot 2.12.6.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:会为部分 Forge / NeoForge 选择不支持的 Java"))
BugCount += 4
End If
If LastVersion < 388 Then 'Snapshot 2.12.6.1
If LastVersion = 386 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法使用 Java 25+ 启动 Forge"))
FeatureCount += 4
BugCount += 3
End If
If LastVersion < 386 Then 'Snapshot 2.12.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:Minecraft 使用 Java 25+ 时的一个性能问题"))
If LastVersion = 384 OrElse LastVersion = 385 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法正常重命名游戏版本"))
If LastVersion = 385 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法显示 Modrinth 整合包的版本列表"))
BugCount += 1
End If
If LastVersion < 385 Then 'Snapshot 2.12.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法下载 NeoForge 26.1"))
If LastVersion = 384 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能失败,提示下载管理刷新线程出错"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法保存选择的 Minecraft 文件夹"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:使用中文搜索 Mod 时,部分结果会忽略筛选条件"))
If LastVersion < 389 Then 'Release 2.12.6.1
If LastVersion = 387 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法使用 Java 25+ 启动 Forge"))
FeatureCount += 4
BugCount += 3
End If
FeatureCount += 3
BugCount += 6
End If
If LastVersion < 384 Then 'Snapshot 2.12.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:降低 Minecraft 的内存占用"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:老版本 Windows 无法启动游戏"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:连接 Mojang 的服务可能失败,提示错误码 421"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法访问爱发电"))
FeatureCount += 21
BugCount += 14
End If
If LastVersion < 382 Then 'Snapshot 2.12.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能完全卡住,或是下载进度反复回退"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:内存管理设置,可以选择 G1GC、ZGC 或分代 ZGC"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:来自 Modrinth 的文件下载速度"))
FeatureCount += 15
BugCount += 16
End If
If LastVersion < 380 Then 'Snapshot 2.12.2
FeatureCount += 3
BugCount += 13
End If
If LastVersion < 378 Then 'Snapshot 2.12.1
If LastVersion >= 377 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:在版本列表中存在 OptiFine 时可能无法加载版本列表"))
BugCount += 2
If LastVersion < 387 Then 'Release 2.12.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:降低 Minecraft 的内存占用"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:Minecraft 使用 Java 25+ 时的一个性能问题"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法下载 NeoForge 26.1"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:老版本 Windows 无法启动游戏"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:连接 Mojang 的服务可能失败,提示错误码 421"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法访问爱发电"))
FeatureCount += 24
BugCount += 19
End If
End If
If LastVersion < 377 Then 'Snapshot 2.12.0
If LastVersion >= 373 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "删除:暂时隐藏联机入口……不过只是暂时关闭,它还会回来的!"))
If LastVersion < 383 Then 'Release 2.12.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能完全卡住,或是下载进度反复回退"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:内存管理设置,可以选择 G1GC、ZGC 或分代 ZGC"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:来自 Modrinth 的文件下载速度"))
FeatureCount += 15
BugCount += 16
End If
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:适配新的 Minecraft 版本号系统与 Unobfuscated 版本"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:巨幅优化各个下载页面和 Mod 管理页面的性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:更换披风时会显示当前使用的披风"))
FeatureCount += 33
BugCount += 29
End If
If LastVersion < 375 Then 'Snapshot 2.11.2
'If LastVersion >= 373 Then
' FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:对联机进行了各种各样的优化,以改善稳定性"))
' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:若有加入者的网络环境比房主更好,会提示可以让那位加入者担任房主"))
'End If
FeatureCount += 16
BugCount += 4
End If
If LastVersion < 374 Then 'Snapshot 2.11.1
'If LastVersion >= 373 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, "优化:若复制了邀请码,则可以直接快速加入房间"))
' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:关闭 PCL 时总是会提示是否退出联机,防止在关闭 PCL 时无意地关闭或退出了房间"))
' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增:允许自定义要连接的节点"))
'End If
FeatureCount += 9
BugCount += 7
End If
If LastVersion < 373 Then 'Snapshot 2.11.0
'FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:联机功能!"))
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, "修复:无法添加新的正版账号"))
If LastVersion < 381 Then 'Release 2.12.2
FeatureCount += 3
BugCount += 13
End If
If LastVersion < 379 Then 'Release 2.12.1
If LastVersion >= 376 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "删除:暂时隐藏联机入口……不过只是暂时关闭,它还会回来的!"))
End If
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:适配新的 Minecraft 版本号系统与 Unobfuscated 版本"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:巨幅优化各个下载页面和 Mod 管理页面的性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:更换披风时会显示当前使用的披风"))
FeatureCount += 33
BugCount += 29
End If
If LastVersion < 376 Then 'Release 2.11.2
'FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:联机功能!"))
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 < 392 Then 'Snapshot 2.12.7.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:允许永久关闭启动页面的快照版提示"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:下载游戏、整合包的稳定性"))
FeatureCount += 1
BugCount += 5
End If
If LastVersion < 390 Then 'Snapshot 2.12.6.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:会为部分 Forge / NeoForge 选择不支持的 Java"))
BugCount += 4
End If
If LastVersion < 388 Then 'Snapshot 2.12.6.1
If LastVersion = 386 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法使用 Java 25+ 启动 Forge"))
FeatureCount += 4
BugCount += 3
End If
If LastVersion < 386 Then 'Snapshot 2.12.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:Minecraft 使用 Java 25+ 时的一个性能问题"))
If LastVersion = 384 OrElse LastVersion = 385 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法正常重命名游戏版本"))
If LastVersion = 385 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法显示 Modrinth 整合包的版本列表"))
BugCount += 1
End If
If LastVersion < 385 Then 'Snapshot 2.12.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法下载 NeoForge 26.1"))
If LastVersion = 384 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能失败,提示下载管理刷新线程出错"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:无法保存选择的 Minecraft 文件夹"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:使用中文搜索 Mod 时,部分结果会忽略筛选条件"))
End If
FeatureCount += 3
BugCount += 6
End If
If LastVersion < 384 Then 'Snapshot 2.12.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:降低 Minecraft 的内存占用"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:部分关键词搜不到资源,特别是中文 Mod 搜索经常没有结果"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:老版本 Windows 无法启动游戏"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:连接 Mojang 的服务可能失败,提示错误码 421"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法访问爱发电"))
FeatureCount += 21
BugCount += 14
End If
If LastVersion < 382 Then 'Snapshot 2.12.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复:下载可能完全卡住,或是下载进度反复回退"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:内存管理设置,可以选择 G1GC、ZGC 或分代 ZGC"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:来自 Modrinth 的文件下载速度"))
FeatureCount += 15
BugCount += 16
End If
If LastVersion < 380 Then 'Snapshot 2.12.2
FeatureCount += 3
BugCount += 13
End If
If LastVersion < 378 Then 'Snapshot 2.12.1
If LastVersion >= 377 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:在版本列表中存在 OptiFine 时可能无法加载版本列表"))
BugCount += 2
End If
End If
If LastVersion < 377 Then 'Snapshot 2.12.0
If LastVersion >= 373 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "删除:暂时隐藏联机入口……不过只是暂时关闭,它还会回来的!"))
End If
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:适配新的 Minecraft 版本号系统与 Unobfuscated 版本"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:巨幅优化各个下载页面和 Mod 管理页面的性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:更换披风时会显示当前使用的披风"))
FeatureCount += 33
BugCount += 29
End If
If LastVersion < 375 Then 'Snapshot 2.11.2
'If LastVersion >= 373 Then
' FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:对联机进行了各种各样的优化,以改善稳定性"))
' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:若有加入者的网络环境比房主更好,会提示可以让那位加入者担任房主"))
'End If
FeatureCount += 16
BugCount += 4
End If
If LastVersion < 374 Then 'Snapshot 2.11.1
'If LastVersion >= 373 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, "优化:若复制了邀请码,则可以直接快速加入房间"))
' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:关闭 PCL 时总是会提示是否退出联机,防止在关闭 PCL 时无意地关闭或退出了房间"))
' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增:允许自定义要连接的节点"))
'End If
FeatureCount += 9
BugCount += 7
End If
If LastVersion < 373 Then 'Snapshot 2.11.0
'FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:联机功能!"))
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
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)
Dim SortedFeatures = FeatureList.OrderByDescending(Function(f) f.Key).ToList
@@ -276,7 +282,7 @@ Public Class FormMain
'输出更新日志
RunInNewThread(
Sub()
If MyMsgBox(Content, "PCL 已更新至" & VersionDisplayName, "确定", "完整更新日志") = 2 Then
If MyMsgBox(Content, "PCL 已更新至" & VersionDisplay, "确定", "完整更新日志") = 2 Then
OpenWebsite("https://meloong.com/afd/a/LTCat?tab=feed")
End If
End Sub, "UpdateLog Output")
@@ -342,9 +348,7 @@ Public Class FormMain
PageRight = FrmLaunchRight
FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay
'模式提醒
#If DEBUG Then
Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Red)
#End If
If BuildType = BuildTypes.Debug Then Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Red)
If ModeDebug Then Hint("[调试模式] PCL 正以调试模式运行,这可能会导致性能下降,若无必要请不要开启!")
'尽早执行的加载池
McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行,必须跑一次;为了让启动按钮尽快可用,需要尽早执行;为了与 PageLaunchLeft 联动,需要为 0 而不是 GetUuid
@@ -385,14 +389,12 @@ Public Class FormMain
Height = Settings.Get("WindowHeight")
Width = Settings.Get("WindowWidth")
Catch ex As Exception '修复 #2019
Log(ex, "读取窗口默认大小失败", LogLevel.Hint)
Log(ex, "读取窗口默认大小失败", NotifyLevel.AllUsers)
Height = MinHeight + 100
Width = MinWidth + 100
End Try
'#If DEBUG Then
' MinHeight = 50
' MinWidth = 50
'#End If
'MinHeight = 50
'MinWidth = 50
Topmost = False
If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed))
'更改窗口
@@ -411,7 +413,7 @@ Public Class FormMain
Sub()
PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True
Log($"[System] DPI:{DPI},系统版本:{Environment.OSVersion.VersionString},PCL 位置:{PathWithName}")
Log($"[System] DPI:{DPI},系统版本:{Environment.OSVersion.VersionString},PCL 位置:{PathExe}")
End Sub, , True)
}, "Form Show")
'Timer 启动
@@ -444,16 +446,20 @@ Public Class FormMain
ServerLoader.Start()
RunInNewThread(AddressOf TryClearTaskTemp, "TryClearTaskTemp", ThreadPriority.BelowNormal)
Catch ex As Exception
Log(ex, "初始化加载池运行失败", LogLevel.Feedback)
Log(ex, "初始化加载池运行失败", NotifyLevel.MsgBoxAndFeedback)
End Try
'清理自动更新文件
Try
If File.Exists(Path & "PCL\Plain Craft Launcher 2.exe") Then File.Delete(Path & "PCL\Plain Craft Launcher 2.exe")
File.Delete(PathExeFolder & "PCL\Plain Craft Launcher 2.exe")
Catch ex As Exception
Log(ex, "清理自动更新文件失败")
End Try
'上报
Telemetry("启动")
'开源版本提示
If VersionBranchMain = "OpenSource" Then
MyMsgBox($"该版本中无法使用以下特性:{vbCrLf}- CurseForge API 调用:需要自行申请 API Key,然后添加到 ModSecret.vb 的开头{vbCrLf}- 正版登录:需要自行向微软申请 Client ID,然后添加到 ModSecret.vb 的开头{vbCrLf}- 更新与联网通知:避免滥用隐患{vbCrLf}- 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……{vbCrLf}- 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了……", "开源版本说明")
End If
End Sub, "初始化", ThreadPriority.Lowest)
Log("[Start] 第三阶段加载用时:" & GetTimeMs() - ApplicationStartTick & " ms")
@@ -461,20 +467,20 @@ Public Class FormMain
'根据打开次数触发的事件
Private Sub RunCountSub()
Settings.Set("SystemCount", Settings.Get("SystemCount") + 1)
#If Not BETA Then
Select Case Settings.Get("SystemCount")
Case 1
MyMsgBox("欢迎使用 PCL 快照版!" & vbCrLf &
"快照版包含尚未在正式版发布的测试性功能,仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦!" & vbCrLf &
"如果你并非通过赞助或赞助者本人邀请进群获得的本程序,那么可能是有人在违规传播,记得提醒他一下啦。", "快照版使用说明")
End Select
If Settings.Get("SystemCount") >= 99 Then
If ThemeUnlock(6, False) Then
MyMsgBox("你已经使用了 99 次 PCL 啦,感谢你长期以来的支持!" & vbCrLf &
"隐藏主题 铁杆粉 已解锁!", "提示")
If BuildType = BuildTypes.Snapshot Then
Select Case Settings.Get("SystemCount")
Case 1
MyMsgBox("欢迎使用 PCL 快照版!" & vbCrLf &
"快照版包含尚未在正式版发布的测试性功能,仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦!" & vbCrLf &
"如果你并非通过赞助或赞助者本人邀请进群获得的本程序,那么可能是有人在违规传播,记得提醒他一下啦。", "快照版使用说明")
End Select
If Settings.Get("SystemCount") >= 99 Then
If ThemeUnlock(6, False) Then
MyMsgBox("你已经使用了 99 次 PCL 啦,感谢你长期以来的支持!" & vbCrLf &
"隐藏主题 铁杆粉 已解锁!", "提示")
End If
End If
End If
#End If
End Sub
'升级与降级事件
Private Sub UpgradeSub(LastVersionCode As Integer)
@@ -482,19 +488,12 @@ Public Class FormMain
Settings.Set("SystemLastVersionReg", VersionCode)
'检查有记录的最高版本号
Dim LowerVersionCode As Integer
#If BETA Then
LowerVersionCode = Settings.Get("SystemHighestBetaVersionReg")
If LowerVersionCode < VersionCode Then
Settings.Set("SystemHighestBetaVersionReg", VersionCode)
Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
End If
#Else
Dim SettingKey = If(BuildType = BuildTypes.Snapshot, "SystemHighestAlphaVersionReg", "SystemHighestBetaVersionReg")
LowerVersionCode = Settings.Get("SystemHighestAlphaVersionReg")
If LowerVersionCode < VersionCode Then
Settings.Set("SystemHighestAlphaVersionReg", VersionCode)
Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
Log($"[Start] 最高版本号从 {LowerVersionCode} 升高到 {VersionCode}")
End If
#End If
'被移除的窗口设置选项
If Settings.Get("LaunchArgumentWindowType") = 5 Then Settings.Set("LaunchArgumentWindowType", 1)
'修改主题设置项名称
@@ -521,8 +520,8 @@ Public Class FormMain
"多谢各位的理解啦!", "重新解锁提醒")
End If
'移动自定义皮肤
If LastVersionCode <= 161 AndAlso File.Exists(Path & "PCL\CustomSkin.png") AndAlso Not File.Exists(PathAppdata & "CustomSkin.png") Then
CopyFile(Path & "PCL\CustomSkin.png", PathAppdata & "CustomSkin.png")
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)")
End If
If LastVersionCode <= 263 AndAlso File.Exists(PathTemp & "CustomSkin.png") AndAlso Not File.Exists(PathAppdata & "CustomSkin.png") Then
@@ -635,7 +634,7 @@ Public Class FormMain
FeedbackInfo()
Log("请在 https://github.com/Meloong-Git/PCL/issues 提交错误报告,以便于作者解决此问题!")
IsLogShown = True
StartProcess(Path & "PCL\Log1.txt")
StartProcess(PathExeFolder & "PCL\Log1.txt")
End If
Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉
End If
@@ -789,10 +788,10 @@ Public Class FormMain
FrmSetupUI.PanLogoChange.Visibility = Visibility.Visible
End If
Try
ImageTitleLogo.Source = Path & "PCL\Logo.png"
ImageTitleLogo.Source = PathExeFolder & "PCL\Logo.png"
Catch ex As Exception
ImageTitleLogo.Source = Nothing
Log(ex, "显示标题栏图片失败", LogLevel.Msgbox)
Log(ex, "显示标题栏图片失败", NotifyLevel.MsgBox)
End Try
End Select
FrmSetupUI?.CardLogo.TriggerForceResize()
@@ -890,7 +889,7 @@ Public Class FormMain
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
End If
Catch ex As Exception
Log(ex, "切回窗口时出错", LogLevel.Feedback)
Log(ex, "切回窗口时出错", NotifyLevel.MsgBoxAndFeedback)
End Try
'读取剪贴板,自动加入联机房间
Return 'TODO: 联机复活赛
@@ -941,7 +940,7 @@ Public Class FormMain
PrevEffects = e.Effects
Log("[System] 设置拖放类型:" & GetStringFromEnum(e.Effects))
Catch ex As Exception
Log(ex, "处理拖放时出错", LogLevel.Feedback)
Log(ex, "处理拖放时出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Private Sub FrmMain_Drop(sender As Object, e As DragEventArgs) Handles Me.Drop
@@ -956,7 +955,7 @@ Public Class FormMain
'Authlib 拖拽
e.Handled = True
e.Effects = DragDropEffects.Copy
Dim AuthlibServer As String = Net.WebUtility.UrlDecode(Str.Substring("authlib-injector:yggdrasil-server:".Length))
Dim AuthlibServer As String = EscapeUtils.FormUrlUnescape(Str.Substring("authlib-injector:yggdrasil-server:".Length))
Log("[System] Authlib 拖拽:" & AuthlibServer)
If Not String.IsNullOrEmpty(New ValidateHttp().Validate(AuthlibServer)) Then
Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Red)
@@ -1004,7 +1003,7 @@ Public Class FormMain
FileDrag(New List(Of String) From {FilePath})
End If
Catch ex As Exception
Log(ex, "无法接取文本拖拽事件", LogLevel.Developer)
Log(ex, "无法接取文本拖拽事件", NotifyLevel.DevelopOnly)
Return
End Try
ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then
@@ -1019,14 +1018,14 @@ Public Class FormMain
FileDrag(CType(FilePathRaw, IEnumerable(Of String)))
End If
Catch ex As Exception
Log(ex, "接取拖拽事件失败", LogLevel.Feedback)
Log(ex, "接取拖拽事件失败", NotifyLevel.MsgBoxAndFeedback)
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} 个文件", ""), LogLevel.Developer)
Log("[System] 接受文件拖拽:" & FilePath & If(FilePathList.Any, $" 等 {FilePathList.Count} 个文件", ""), NotifyLevel.DevelopOnly)
'基础检查
If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
Hint("请拖入一个文件,而非文件夹!", HintType.Red)
@@ -1049,12 +1048,12 @@ Public Class FormMain
Dim Extension As String = FilePath.AfterLast(".").Lower
If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML,作为主页加载")
If File.Exists(Path & "PCL\Custom.xaml") Then
If File.Exists(PathExeFolder & "PCL\Custom.xaml") Then
If MyMsgBox("已存在一个主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then
Return
End If
End If
CopyFile(FilePath, Path & "PCL\Custom.xaml")
CopyFile(FilePath, PathExeFolder & "PCL\Custom.xaml")
RunInUi(
Sub()
Settings.Set("UiCustomType", 1)
@@ -1092,7 +1091,7 @@ Public Class FormMain
Analyzer.Output(True, New List(Of String))
Return
Catch ex As Exception
Log(ex, "自主错误报告分析失败", LogLevel.Feedback)
Log(ex, "自主错误报告分析失败", NotifyLevel.MsgBoxAndFeedback)
End Try
'未知操作
Hint("PCL 无法确定应当执行的文件拖拽操作……")
@@ -1207,9 +1206,9 @@ Public Class FormMain
''' </summary>
InstanceSetup = 7
''' <summary>
''' 资源工程详情。这是一个副页面。
''' 社区资源详情。这是一个副页面。
''' </summary>
CompDetail = 8
ResourceDetail = 8
''' <summary>
''' 帮助详情。这是一个副页面。
''' </summary>
@@ -1252,8 +1251,8 @@ Public Class FormMain
Return "下载管理"
Case PageType.InstanceSetup
Return "版本设置 - " & If(PageInstanceLeft.Instance Is Nothing, "未知版本", PageInstanceLeft.Instance.Name)
Case PageType.CompDetail
Return "资源下载 - " & CType(Stack.Additional(0), CompProject).TranslatedName
Case PageType.ResourceDetail
Return CType(Stack.Additional(0), ResourceProject).TranslatedName
Case PageType.HelpDetail
Return CType(Stack.Additional(0), HelpEntry).Title
Case Else
@@ -1478,9 +1477,9 @@ Public Class FormMain
Case PageType.InstanceSetup '版本设置
If FrmInstanceLeft Is Nothing Then FrmInstanceLeft = New PageInstanceLeft
PageChangeAnim(FrmInstanceLeft, FrmInstanceLeft.PageGet(SubType))
Case PageType.CompDetail 'Mod 信息
If FrmDownloadCompDetail Is Nothing Then FrmDownloadCompDetail = New PageDownloadCompDetail
PageChangeAnim(New MyPageLeft, FrmDownloadCompDetail)
Case PageType.ResourceDetail '社区资源详情
If FrmDownloadResourceDetail Is Nothing Then FrmDownloadResourceDetail = New PageDownloadResourceDetail
PageChangeAnim(New MyPageLeft, FrmDownloadResourceDetail)
Case PageType.HelpDetail '帮助详情
PageChangeAnim(New MyPageLeft, Stack.Additional(1))
End Select
@@ -1493,7 +1492,7 @@ Public Class FormMain
Log("[Control] 切换主要页面:" & GetStringFromEnum(Stack) & ", " & SubType)
Catch ex As Exception
Log(ex, "切换主要页面失败(ID " & PageCurrent.Page & ")", LogLevel.Feedback)
Log(ex, "切换主要页面失败(ID " & PageCurrent.Page & ")", NotifyLevel.MsgBoxAndFeedback)
Finally
AniControlEnabled -= 1
End Try
@@ -1676,7 +1675,7 @@ Public Class FormMain
Next
Hint("已关闭运行中的 Minecraft!", HintType.Green)
Catch ex As Exception
Log(ex, "强制关闭所有 Minecraft 失败", LogLevel.Feedback)
Log(ex, "强制关闭所有 Minecraft 失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Public Function BtnExtraShutdown_ShowCheck() As Boolean
@@ -1691,7 +1690,7 @@ Public Class FormMain
If RealScroll IsNot Nothing Then
RealScroll.PerformVerticalOffsetDelta(-RealScroll.VerticalOffset)
Else
Log("[UI] 无法返回顶部,未找到合适的 RealScroll", LogLevel.Hint)
Log("[UI] 无法返回顶部,未找到合适的 RealScroll", NotifyLevel.AllUsers)
End If
End Sub
Private Function BtnExtraBack_ShowCheck() As Boolean
Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.2 KiB

Before

Width:  |  Height:  |  Size: 963 B

After

Width:  |  Height:  |  Size: 963 B

Before

Width:  |  Height:  |  Size: 2.1 KiB

After

Width:  |  Height:  |  Size: 2.1 KiB

Before

Width:  |  Height:  |  Size: 951 B

After

Width:  |  Height:  |  Size: 951 B

@@ -1,6 +1,8 @@
'动画引擎模块
'使用 Ani 作为方法或属性的开头,使用 Aa 作为单个动画对象的开头(便于自动补全)
Imports System.Windows.Media.Effects
Public Module ModAnimation
#Region "声明"
@@ -10,8 +12,8 @@ Public Module ModAnimation
''' </summary>
Public ReadOnly Property AniSpeed As Double
Get
Dim Setting = PCL.Settings.Get("SystemDebugAnim")
Return If(Setting >= 30, 200, MathClamp(Setting * 0.1 + 0.1, 0.1, 3))
Dim Setting As Integer = Settings.Get("SystemDebugAnim")
Return If(Setting >= 30, 200, (Setting * 0.1 + 0.1).Clamp(0.1, 3))
End Get
End Property
''' <summary>
@@ -582,10 +584,10 @@ Public Module ModAnimation
Public Class AniEaseLinear
Inherits AniEase
Public Overrides Function GetValue(t As Double) As Double
Return MathClamp(t, 0, 1)
Return t.Clamp(0, 1)
End Function
Public Overrides Function GetDelta(t1 As Double, t0 As Double) As Double
Return MathClamp(t1, 0, 1) - MathClamp(t0, 0, 1)
Return t1.Clamp(0, 1) - t0.Clamp(0, 1)
End Function
End Class
@@ -600,7 +602,7 @@ Public Module ModAnimation
p = Power
End Sub
Public Overrides Function GetValue(t As Double) As Double
Return MathClamp(t, 0, 1) ^ p
Return t.Clamp(0, 1) ^ p
End Function
End Class
''' <summary>
@@ -613,7 +615,7 @@ Public Module ModAnimation
p = Power
End Sub
Public Overrides Function GetValue(t As Double) As Double
Return 1 - MathClamp(1 - t, 0, 1) ^ p
Return 1 - (1 - t).Clamp(0, 1) ^ p
End Function
End Class
''' <summary>
@@ -644,7 +646,7 @@ Public Module ModAnimation
If alpha < 0 Then alpha = 0 '初速度小于平均速度时,退化为线性
End Sub
Public Overrides Function GetValue(percent As Double) As Double
Dim p As Double = MathClamp(percent, 0, 1)
Dim p As Double = percent.Clamp(0, 1)
If alpha = 0 Then Return p '退化到线性
Return (alpha + 1) * p / (1 + alpha * p)
End Function
@@ -661,7 +663,7 @@ Public Module ModAnimation
p = 3 - Power * 0.5
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathClamp(t, 0, 1)
t = t.Clamp(0, 1)
Return t ^ p * Math.Cos(1.5 * Math.PI * (1 - t))
End Function
End Class
@@ -675,7 +677,7 @@ Public Module ModAnimation
p = 3 - Power * 0.5
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathClamp(t, 0, 1)
t = t.Clamp(0, 1)
Return 1 - (1 - t) ^ p * Math.Cos(1.5 * Math.PI * t)
End Function
End Class
@@ -719,7 +721,7 @@ Public Module ModAnimation
p = Power + 4
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = MathClamp(t, 0, 1)
t = t.Clamp(0, 1)
Return t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
End Function
End Class
@@ -733,7 +735,7 @@ Public Module ModAnimation
p = Power + 4
End Sub
Public Overrides Function GetValue(t As Double) As Double
t = 1 - MathClamp(t, 0, 1)
t = 1 - t.Clamp(0, 1)
Return 1 - t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5)
End Function
End Class
@@ -750,7 +752,15 @@ Public Module ModAnimation
Public Sub AniStart(AniGroup As IList, Optional Name As String = "", Optional RefreshTime As Boolean = False)
If RefreshTime Then AniLastTick = GetTimeMs() '避免处理动画时已经造成了极大的延迟,导致动画突然结束
'添加到正在执行的动画组
Dim NewEntry As New AniGroupEntry With {.Data = GetFullList(Of AniData)(AniGroup), .StartTick = GetTimeMs()}
Dim AllAnis = New List(Of AniData)
For Each Element In AniGroup
If TypeOf Element Is ICollection Then
AllAnis.AddRange(Element)
Else
AllAnis.Add(Element)
End If
Next
Dim NewEntry As New AniGroupEntry With {.Data = AllAnis, .StartTick = GetTimeMs()}
If Name = "" Then
Name = NewEntry.Uuid
Else
@@ -803,12 +813,12 @@ Public Module ModAnimation
Log("[Animation] 动画线程开始")
Do While True
'两帧之间的间隔时间
Dim DeltaTime As Long = MathClamp(GetTimeMs() - AniLastTick, 0, 100000)
Dim DeltaTime As Long = (GetTimeMs() - AniLastTick).Clamp(0, 100000)
If DeltaTime < 3 Then GoTo Sleeper
AniLastTick = GetTimeMs()
'记录 FPS
If ModeDebug Then
If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
If (AniLastTick - AniFPSTimer).Clamp(0, 100000) >= 500 Then
AniFPS = AniFPSCounter
AniFPSCounter = 0
AniFPSTimer = AniLastTick
@@ -820,13 +830,8 @@ Public Module ModAnimation
Sub()
AniCount = 0
AniTimer(DeltaTime * AniSpeed)
'#If DEBUG Then
' FrmMain.Title = "F " & AniFPS & ", A " & AniCount & ", R " & NetManage.FileRemain
'#Else
' If ModeDebug Then FrmMain.Title = "FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManage.FileRemain
'#End If
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 & "(" & GetString(NetManager.Speed) & "/s)")
Log("[Report] FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManager.FileRemain & "(" & FormatFileSize(NetManager.Speed) & "/s)")
End If
End Sub)
Sleeper:
@@ -834,7 +839,7 @@ Sleeper:
Thread.Sleep(1)
Loop
Catch ex As Exception
Log(ex, "动画帧执行失败", LogLevel.Critical)
Log(ex, "动画帧执行失败", NotifyLevel.Critical)
End Try
End Sub, "Animation", ThreadPriority.AboveNormal)
End Sub
@@ -845,7 +850,7 @@ Sleeper:
Public Sub AniTimer(DeltaTick As Integer)
Try
If DeltaTick / AniSpeed > 100 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", LogLevel.Developer)
If DeltaTick / AniSpeed > 100 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", NotifyLevel.DevelopOnly)
Dim i As Integer = -1
'循环每个动画组
Do While i + 1 < AniGroups.Count
@@ -910,7 +915,7 @@ NextAni:
Loop
Catch ex As Exception
Log(ex, "动画刻执行失败", LogLevel.Hint)
Log(ex, "动画刻执行失败", NotifyLevel.AllUsers)
End Try
End Sub
@@ -923,15 +928,39 @@ NextAni:
Select Case Ani.TypeMain
Case AniType.Number
Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
Dim Delta As Double = MathUtils.Lerp(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
If Delta <> 0 Then
Select Case Ani.TypeSub
Case AniTypeSub.X
DeltaLeft(Ani.Obj, Delta)
If TypeOf Ani.Obj Is Window Then
CType(Ani.Obj, Window).Left += Delta
Else
Select Case Ani.Obj.HorizontalAlignment
Case HorizontalAlignment.Left, HorizontalAlignment.Stretch
Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left + Delta, Ani.Obj.Margin.Top, Ani.Obj.Margin.Right, Ani.Obj.Margin.Bottom)
Case HorizontalAlignment.Right
Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left, Ani.Obj.Margin.Top, Ani.Obj.Margin.Right - Delta, Ani.Obj.Margin.Bottom)
End Select
End If
Case AniTypeSub.Y
DeltaTop(Ani.Obj, Delta)
If TypeOf Ani.Obj Is Window Then
CType(Ani.Obj, Window).Top += Delta
Else
Select Case Ani.Obj.VerticalAlignment
Case VerticalAlignment.Top
Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left, Ani.Obj.Margin.Top + Delta, Ani.Obj.Margin.Right, Ani.Obj.Margin.Bottom)
Case VerticalAlignment.Bottom
Ani.Obj.Margin = New Thickness(Ani.Obj.Margin.Left, Ani.Obj.Margin.Top, Ani.Obj.Margin.Right, Ani.Obj.Margin.Bottom - Delta)
End Select
End If
Case AniTypeSub.Opacity
Ani.Obj.Opacity = MathClamp(Ani.Obj.Opacity + Delta, 0, 1)
If TypeOf Ani.Obj Is UIElement Then
Dim Obj As UIElement = Ani.Obj
Obj.Opacity = (Obj.Opacity + Delta).Clamp(0, 1)
ElseIf TypeOf Ani.Obj Is DropShadowEffect Then
Dim Obj As DropShadowEffect = Ani.Obj
Obj.Opacity = (Obj.Opacity + Delta).Clamp(0, 1)
End If
Case AniTypeSub.Width
Dim Obj As FrameworkElement = Ani.Obj
Obj.Width = Math.Max(If(Double.IsNaN(Obj.Width), Obj.ActualWidth, Obj.Width) + Delta, 0)
@@ -963,7 +992,7 @@ NextAni:
Case AniType.Color
'利用 Last 记录了余下的小数值
Dim Delta As MyColor = MathPercent(New MyColor(0, 0, 0, 0), Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) + Ani.ValueLast
Dim Delta As MyColor = MyColor.Lerp(New MyColor(0, 0, 0, 0), Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) + Ani.ValueLast
Dim Obj As FrameworkElement = Ani.Obj(0)
Dim Prop As DependencyProperty = Ani.Obj(1)
Dim NewColor As MyColor = New MyColor(Obj.GetValue(Prop)) + Delta
@@ -973,17 +1002,18 @@ NextAni:
Case AniType.Scale
Dim Obj As FrameworkElement = Ani.Obj
Dim Delta As Double = Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)
Obj.Margin = New Thickness(Obj.Margin.Left + MathPercent(0, Ani.Value.Left, Delta), Obj.Margin.Top + MathPercent(0, Ani.Value.Top, Delta), Obj.Margin.Right + MathPercent(0, Ani.Value.Left, Delta), Obj.Margin.Bottom + MathPercent(0, Ani.Value.Top, Delta))
Obj.Width = Math.Max(Obj.Width + MathPercent(0, Ani.Value.Width, Delta), 0)
Obj.Height = Math.Max(Obj.Height + MathPercent(0, Ani.Value.Height, Delta), 0)
Obj.Margin = New Thickness(Obj.Margin.Left + MathUtils.Lerp(0, Ani.Value.Left, Delta), Obj.Margin.Top + MathUtils.Lerp(0, Ani.Value.Top, Delta), Obj.Margin.Right + MathUtils.Lerp(0, Ani.Value.Left, Delta), Obj.Margin.Bottom + MathUtils.Lerp(0, Ani.Value.Top, Delta))
Obj.Width = Math.Max(Obj.Width + MathUtils.Lerp(0, Ani.Value.Width, Delta), 0)
Obj.Height = Math.Max(Obj.Height + MathUtils.Lerp(0, Ani.Value.Height, Delta), 0)
Case AniType.TextAppear
Dim TextCount As Integer = If(Ani.Value(1), Ani.Value(0).ToString.Length, 0) +
Math.Round(Ani.Value(0).ToString.Length * If(Ani.Value(1), -1, 1) * Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, 0))
Dim NewText As String = Mid(Ani.Value(0), 1, TextCount)
Dim Text As String = Ani.Value(0)
Dim TextCount As Integer = If(Ani.Value(1), Text.Length, 0) +
Math.Round(Text.Length * If(Ani.Value(1), -1, 1) * Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, 0))
Dim NewText As String = Text.Substring(0, TextCount)
'添加乱码
If TextCount < Ani.Value(0).ToString.Length Then
Dim NextText As String = Mid(Ani.Value(0), TextCount + 1, 1)
If TextCount < Text.Length Then
Dim NextText As String = Text.Substring(TextCount, 1)
If Convert.ToInt32(Convert.ToChar(NextText)) >= Convert.ToInt32(Convert.ToChar(128)) Then
NewText &= Encoding.GetEncoding("GB18030").GetString({RandomInteger(16 + 160, 87 + 160), RandomInteger(1 + 160, 89 + 160)})
Else
@@ -1006,7 +1036,7 @@ NextAni:
If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
Obj.RenderTransform = New ScaleTransform(1, 1)
End If
Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
Dim Delta As Double = MathUtils.Lerp(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
CType(Obj.RenderTransform, ScaleTransform).ScaleX = Math.Max(CType(Obj.RenderTransform, ScaleTransform).ScaleX + Delta, 0)
CType(Obj.RenderTransform, ScaleTransform).ScaleY = Math.Max(CType(Obj.RenderTransform, ScaleTransform).ScaleY + Delta, 0)
@@ -1016,13 +1046,13 @@ NextAni:
If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
Obj.RenderTransform = New RotateTransform(0)
End If
Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
Dim Delta As Double = MathUtils.Lerp(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
CType(Obj.RenderTransform, RotateTransform).Angle = CType(Obj.RenderTransform, RotateTransform).Angle + Delta
End Select
Ani.TimePercent = Ani.TimeFinished / Ani.TimeTotal '修改执行百分比
Catch ex As Exception
Log(ex, "执行动画失败:" & Ani.ToString, LogLevel.Hint)
Log(ex, "执行动画失败:" & Ani.ToString, NotifyLevel.AllUsers)
End Try
Return Ani
End Function
File diff suppressed because it is too large Load Diff
@@ -38,7 +38,7 @@
RealParent = RealParent.Parent
End While
Catch ex As Exception
Log(ex, "获取父加载器失败(" & Name & ")", LogLevel.Feedback)
Log(ex, "获取父加载器失败(" & Name & ")", NotifyLevel.MsgBoxAndFeedback)
Return Nothing
End Try
End Get
@@ -283,7 +283,7 @@
Try
Input = StartGetInput(Input)
Catch ex As Exception
Log(ex, "加载输入获取失败(" & Name & ")", LogLevel.Hint)
Log(ex, "加载输入获取失败(" & Name & ")", NotifyLevel.AllUsers)
[Error] = ex
SyncLock LockState
State = LoadState.Failed
@@ -322,7 +322,7 @@
If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
LoadDelegate(Me)
If IsInterrupted Then
Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer)
Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", NotifyLevel.DevelopOnly)
Return
End If
If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
@@ -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)}%", LogLevel.Developer)
Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", NotifyLevel.DevelopOnly)
TriggerThreadInterrupt()
End Sub
Public Overrides Sub Interrupt()
@@ -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, LogLevel.Developer)
Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, NotifyLevel.DevelopOnly)
GoTo Restart
End If
End If
@@ -591,7 +591,7 @@ Restart:
End Class
'任务栏进度条
Public LoaderTaskbar As New SafeList(Of LoaderBase)
Public LoaderTaskbar As New ConcurrentList(Of LoaderBase)
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
@@ -635,15 +635,15 @@ Restart:
FrmMain.BtnExtraDownload.ShowRefresh()
End If
Catch ex As Exception
Log(ex, "刷新任务栏进度显示失败", LogLevel.Feedback)
Log(ex, "刷新任务栏进度显示失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Public Function LoaderTaskbarProgressGet() As Double
Try
If Not LoaderTaskbar.Any Then Return 1
Return MathClamp(LoaderTaskbar.Select(Function(l) l.Progress).Average(), 0, 1)
Return LoaderTaskbar.Select(Function(l) l.Progress).Average().Clamp(0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Log(ex, "获取任务栏进度出错", NotifyLevel.MsgBoxAndFeedback)
Return 0.5
End Try
End Function
+58 -61
View File
@@ -36,7 +36,7 @@ Public Module ModNet
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
If MakeLog Then Log(ex, "网络请求失败", LogLevel.Developer)
If MakeLog Then Log(ex, "网络请求失败", NotifyLevel.DevelopOnly)
Throw
End Try
End Function
@@ -176,7 +176,7 @@ RequestFinished:
Log($"[Net] 通过网络请求直接下载小文件:{Url} → {LocalPath}")
'初始化文件路径
Try
Directory.CreateDirectory(GetPathFromFullPath(LocalPath))
DirectoryUtils.Create(LocalPath, isFilePath:=True)
File.Delete(LocalPath)
Catch ex As Exception
Throw New Exception($"预处理下载文件路径失败({LocalPath})", ex)
@@ -257,9 +257,7 @@ Retry:
'DNS 解析
CancelToken = New CancellationTokenSource(Timeout)
HostIp = DNSLookup(Request, CancelToken.Token)
If HostIp IsNot Nothing AndAlso Not IPReliability.ContainsKey(HostIp) Then
IPReliability(HostIp) = -0.01 '预先降低一点,这样快速的重复请求会使用不同的 IP 以提高成功率
End If
If HostIp IsNot Nothing Then IPReliability.GetOrAdd(HostIp, -0.01) '预先降低一点,这样快速的重复请求会使用不同的 IP 以提高成功率
'发送请求
SyncLock RequestClientLock
If RequestClient Is Nothing Then '延迟初始化,以避免在程序启动前加载 CacheCow 导致 DLL 加载失败
@@ -269,8 +267,10 @@ Retry:
})
End If
End SyncLock
CancelToken.Dispose() : CancelToken = New CancellationTokenSource(Timeout)
Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
Dim ResponseBytes As Byte()
CancelToken.Dispose() : CancelToken = New CancellationTokenSource(Timeout)
Using ResponseStream = Response.Content.ReadAsStreamAsync().GetResultWithTimeout(CancelToken, Timeout)
Using Stream As New MemoryStream
ResponseStream.CopyToAsync(Stream, 81920, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
@@ -320,17 +320,16 @@ Retry:
Private Function DNSLookup(Request As HttpRequestMessage, CancelToken As CancellationToken) As String
Dim Host = Request.RequestUri.Host
'不对部分有严格 SNI 限制的域名进行 DNS 解析(#8295)
If {"mojang.com", "minecraft.net", "minecraftservices.com"}.Any(Function(h) Host.ContainsF(h, True)) Then Return Nothing
If {"mojang.com", "minecraft.net", "minecraftservices.com"}.Any(Function(h) Host.ContainsIgnoreCase(h)) Then Return Nothing
'若一分钟内已失败过,则不再重复尝试解析,以减少断网时的 Exception 数量
SyncLock DNSFailureRecord.SyncRoot
If DNSFailureRecord.ContainsKey(Host) Then
If Date.Now - DNSFailureRecord(Host) < New TimeSpan(0, 1, 0) Then
Return Nothing
Else
DNSFailureRecord.Remove(Host)
End If
Dim LastFailureTime As Date
If DNSFailureRecord.TryGetValue(Host, LastFailureTime) Then
If Date.Now - LastFailureTime < New TimeSpan(0, 1, 0) Then
Return Nothing
Else
DNSFailureRecord.Remove(Host)
End If
End SyncLock
End If
'初步 DNS 解析
Dim Candidates As IPAddress()
Try
@@ -363,21 +362,21 @@ Retry:
Request.RequestUri = (New UriBuilder(Request.RequestUri) With {.Host = If(Target.AddressFamily = AddressFamily.InterNetworkV6, $"[{Target}]", Target.ToString)}).Uri
Return Target.ToString
End Function
Private DNSFailureRecord As New SafeDictionary(Of String, Date)
Private DNSFailureRecord As New ConcurrentDictionary(Of String, Date)
''' <summary>
''' 记录每个 IP 地址的请求可靠度。
''' 通常取值 -1 ~ +0.5,越高越好。未尝试过的 IP 应视为 0。
''' </summary>
Private IPReliability As New SafeDictionary(Of String, Double)
Private IPReliability As New ConcurrentDictionary(Of String, Double)
''' <summary>
''' 根据请求结果,记录 IP 地址的可靠度。
''' </summary>
Private Sub RecordIPReliability(IP As String, Result As Double)
If IP Is Nothing Then Return
SyncLock IPReliability.SyncRoot
If Not IPReliability.ContainsKey(IP) Then IPReliability(IP) = 0
IPReliability(IP) = (IPReliability(IP) + Result) / 2
End SyncLock
IPReliability.AddOrUpdate(IP,
Function() Result * 0.5,
Function(k, v) v * 0.5 + Result * 0.5
)
End Sub
''' <summary>
@@ -687,11 +686,11 @@ Retry:
''' <summary>
''' 所属的文件列表任务。
''' </summary>
Public Tasks As New SafeList(Of LoaderDownload)
Public Tasks As New ConcurrentList(Of LoaderDownload)
''' <summary>
''' 所有下载源。
''' </summary>
Public Sources As SafeList(Of NetSource)
Public Sources As ConcurrentList(Of NetSource)
''' <summary>
''' 用于在第一个线程出错时切换下载源。
''' </summary>
@@ -699,7 +698,7 @@ Retry:
''' <summary>
''' 所有已经被标记为失败的,但未完整尝试过的,不允许断点续传的下载源。
''' </summary>
Public SourcesOnce As New SafeList(Of NetSource)
Public SourcesOnce As New ConcurrentList(Of NetSource)
''' <summary>
''' 仅当合并失败或首次下载失败时,会将所有下载源重新标记为不允许断点续传的下载源,逐个重新尝试下载。
''' 这一策略可以兼容多个下载源中的一部分返回错误的文件的情况,以及部分在多线程下载时会抽风的源。
@@ -895,7 +894,7 @@ Retry:
Dim Count As Integer = 0
Urls = Urls.Distinct.ToArray
For Each Source As String In Urls
Sources.Add(New NetSource With {.FailCount = 0, .Url = SecretCdnSign(Source.Replace(vbCr, "").Replace(vbLf, "").Trim), .Id = Count, .IsFailed = False, .Ex = Nothing})
Sources.Add(New NetSource With {.FailCount = 0, .Url = SecretCdnSign(Source.ReplaceLineEndings("").Trim), .Id = Count, .IsFailed = False, .Ex = Nothing})
Count += 1
Next
Me.Sources = Sources
@@ -1049,7 +1048,7 @@ StartThread:
End If
End If
FileSize = ContentLength : IsUnknownSize = False
Log($"[Download] {LocalName}:文件大小 {ContentLength}({GetString(ContentLength)})")
Log($"[Download] {LocalName}:文件大小 {ContentLength}({FormatFileSize(ContentLength)})")
'若文件大小大于 50 M,进行剩余磁盘空间校验
If ContentLength > 50 * 1024 * 1024 Then
For Each Drive As DriveInfo In DriveInfo.GetDrives
@@ -1057,7 +1056,7 @@ StartThread:
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) +
If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0)
If RequiredSpace > 0 AndAlso Drive.TotalFreeSpace < RequiredSpace Then
Throw New Exception(DriveName & " 盘空间不足,无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间,但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" &
Throw New Exception(DriveName & " 盘空间不足,无法进行下载。" & vbCrLf & "需要至少 " & FormatFileSize(RequiredSpace) & " 空间,但当前仅剩余 " & FormatFileSize(Drive.TotalFreeSpace) & "。" &
If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", ""))
End If
Next
@@ -1084,11 +1083,12 @@ NotSupportRange:
Cache = New MemoryStream
ResultStream = Cache
Else
Directory.CreateDirectory(PathTemp & "Download")
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)
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))
Dim ResponseBytes As Byte() = New Byte(16384) {}
@@ -1183,7 +1183,7 @@ SourceBreak:
ex.Message.Contains("(502)") OrElse ex.Message.Contains("(404)") OrElse
ex.Message.Contains("未能解析") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse
((ex.Message.Contains("(403)") OrElse ex.Message.Contains("(429)")) AndAlso Not Th.Source.Url.Contains("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403/429,所以不应因此禁用下载源
(Th.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse Th.Source.FailCount > NetTaskThreadLimit + 2 Then
(Th.Source.FailCount >= NetTaskThreadLimit.Clamp(5, 30) AndAlso DownloadDone < 1) OrElse Th.Source.FailCount > NetTaskThreadLimit + 2 Then
'当一个下载源有多个线程在下载时,只选择其中一个线程进行后续处理
Dim IsThisFail As Boolean = False
SyncLock LockSource
@@ -1196,7 +1196,7 @@ SourceBreak:
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)"), LogLevel.Developer, LogLevel.Debug))
If(IsRangeNotSupported OrElse ex.Message.Contains("(404)"), NotifyLevel.DevelopOnly, NotifyLevel.DebugModeOnly))
SyncLock LockSource
SourcesOnce.Remove(Th.Source)
End SyncLock
@@ -1208,7 +1208,7 @@ SourceBreak:
ElseIf Not Retried Then
'合并失败或首次下载失败,未重试:将所有下载源重新标记为不允许断点续传的下载源,逐个重新尝试下载
'若所有源均不支持 Range,也会走到这里重试
If Not IsRangeNotSupported Then Log($"[Download] {LocalName}:文件下载失败,正在自动重试……", LogLevel.Debug)
If Not IsRangeNotSupported Then Log($"[Download] {LocalName}:文件下载失败,正在自动重试……", NotifyLevel.DebugModeOnly)
Retried = True
SyncLock LockSource
SourcesOnce.Clear()
@@ -1236,7 +1236,7 @@ SourceBreak:
Log("[Download] 已禁用的下载源:" & Source.Url)
If Source.Ex IsNot Nothing Then
ExampleEx = Source.Ex
Log(Source.Ex, "下载源禁用原因", LogLevel.Developer)
Log(Source.Ex, "下载源禁用原因", NotifyLevel.DevelopOnly)
End If
Next
End SyncLock
@@ -1276,15 +1276,14 @@ SourceBreak:
Try
Retry:
'创建文件夹
DirectoryUtils.Create(LocalPath, isFilePath:=True)
If File.Exists(LocalPath) Then File.Delete(LocalPath)
Directory.CreateDirectory(GetPathFromFullPath(LocalPath))
SyncLock LockChain
'合并文件
If IsNoSplit Then
'仅有一个线程,从内存中输出
If ModeDebug Then Log($"[Download] {LocalName}:下载结束,从内存输出文件")
Cache.Position = 0
WriteFile(LocalPath, Cache)
FileUtils.Write(LocalPath, Cache)
ElseIf Threads.DownloadDone = DownloadDone AndAlso Threads.Temp IsNot Nothing Then
'仅有一个文件,直接复制
If ModeDebug Then Log($"[Download] {LocalName}:下载结束,仅有一个文件,无需合并")
@@ -1420,7 +1419,7 @@ Retry:
''' <summary>
''' 需要下载的文件。
''' </summary>
Public Files As SafeList(Of NetFile)
Public Files As ConcurrentList(Of NetFile)
''' <summary>
''' 剩余未完成的文件数。(用于减轻 FilesLock 的占用)
''' </summary>
@@ -1452,7 +1451,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 & " 次", LogLevel.Debug)
Log("[Download] 由于同加载器中失败次数过多引发强制失败:连续失败了 " & value & " 次", NotifyLevel.DebugModeOnly)
On Error Resume Next
Dim ExList As New List(Of Exception)
For Each File In Files
@@ -1495,12 +1494,12 @@ FinishExCatch:
Public Sub New(Name As String, FileTasks As List(Of NetFile))
Me.Name = Name
Files = New SafeList(Of NetFile)(FileTasks)
Files = New ConcurrentList(Of NetFile)(FileTasks)
End Sub
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
If Input IsNot Nothing Then Files = New SafeList(Of NetFile)(Input)
If Input IsNot Nothing Then Files = New ConcurrentList(Of NetFile)(Input)
'去重
Files = New SafeList(Of NetFile)(Files.Distinct(Function(a, b) a.LocalPath = b.LocalPath))
Files = New ConcurrentList(Of NetFile)(Files.DistinctBy(Function(a) a.LocalPath))
'设置剩余文件数
SyncLock FileRemainLock
FileRemain += Files.Where(Function(f) f.State <> NetState.Finished).Count
@@ -1527,7 +1526,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)
Directory.CreateDirectory(GetPathFromFullPath(File.LocalPath)) '创建目标文件夹
DirectoryUtils.Create(File.LocalPath, isFilePath:=True) '创建目标文件夹
Next
'接入下载管理器,获取新开始下载的文件列表
Dim NewFiles = NetManager.Start(Me)
@@ -1555,7 +1554,7 @@ FinishExCatch:
Folders.AddRange(McFolderList.Select(Function(f) f.Location))
Folders = Folders.Distinct.Where(Function(f) Directory.Exists(f)).ToList
'平均分配到多个检查线程
Dim ThreadCount As Integer = MathClamp(FilesToCheck.Count \ 40, 1, 8) '每个线程至少 40 个文件,最多 8 线程
Dim ThreadCount As Integer = (FilesToCheck.Count \ 40).Clamp(1, 8) '每个线程至少 40 个文件,最多 8 线程
If ThreadCount = 1 Then '只有一个线程,直接执行
CheckExistingFiles(FilesToCheck, Folders)
Else
@@ -1590,6 +1589,7 @@ FinishExCatch:
'处理每个文件
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}")
If File.State >= NetState.WaitingToDownload Then Continue For '中断
'已找到相同文件
If Target IsNot Nothing Then
@@ -1645,7 +1645,7 @@ Retry:
End If
Dim Type = TypeIndexes.MaxBy(Function(kv) kv.Item2).FolderName.TrimStart("\"c)
'根据类别进行查找
Static Sizes As New SafeDictionary(Of String, Long)
Static Sizes As New ConcurrentDictionary(Of String, Long)
Select Case Type
Case "assets\", "libraries\"
'assets/libraries:查找 MC 文件夹下的相同路径
@@ -1659,8 +1659,8 @@ Retry:
For Each Candidate In Directory.GetFiles(VersionFolder,
"*." & GetFileNameFromPath(File.LocalPath).AfterLast(".").Lower, SearchOption.TopDirectoryOnly)
'快速进行大小校验
If Not Sizes.ContainsKey(Candidate) Then Sizes(Candidate) = New FileInfo(Candidate).Length
If File.Check.ActualSize <> Sizes(Candidate) Then Continue For
Dim Length = Sizes.GetOrAdd(Candidate, Function(c) New FileInfo(c).Length)
If File.Check.ActualSize <> Length Then Continue For
'Hash 校验
If File.Check.Check(Candidate) Is Nothing Then Return Candidate
Next
@@ -1673,8 +1673,8 @@ Retry:
If Not Directory.Exists(TargetFolder) Then Continue For
For Each Candidate In Directory.GetFiles(TargetFolder)
'快速进行大小校验
If Not Sizes.ContainsKey(Candidate) Then Sizes(Candidate) = New FileInfo(Candidate).Length
If File.Check.ActualSize <> Sizes(Candidate) Then Continue For
Dim Length = Sizes.GetOrAdd(Candidate, Function(c) New FileInfo(c).Length)
If File.Check.ActualSize <> Length Then Continue For
'Hash 校验
If File.Check.Check(Candidate) Is Nothing Then Return Candidate
Next
@@ -1767,12 +1767,12 @@ Retry:
''' <summary>
''' 需要下载的文件。为“本地地址 - 文件对象”键值对。
''' </summary>
Public AllFiles As New SafeDictionary(Of String, NetFile)
Public AllFiles As New ConcurrentDictionary(Of String, NetFile)
''' <summary>
''' 当前的所有下载任务。
''' </summary>
Public Tasks As New SafeList(Of LoaderDownload)
Public Tasks As New ConcurrentList(Of LoaderDownload)
''' <summary>
''' 已下载完成的大小。
@@ -1823,7 +1823,7 @@ Retry:
If SpeedLast.Count >= 10 Then Limit = SpeedLast.Take(10).Average * 0.85 '取近 1 秒的平均速度的 85%
If Limit > NetTaskSpeedLimitLow Then
NetTaskSpeedLimitLow = Limit
Log("[Download] " & "速度下限已提升到 " & GetString(Limit))
Log("[Download] " & "速度下限已提升到 " & FormatFileSize(Limit))
End If
#End Region
#Region "刷新下载任务属性"
@@ -1850,14 +1850,10 @@ Retry:
While True
Thread.Sleep(20)
'获取文件列表
Dim AllFiles As List(Of NetFile)
SyncLock Me.AllFiles.SyncRoot
If Id = 0 AndAlso FileRemain = 0 AndAlso Me.AllFiles.Any() Then Me.AllFiles.Clear() '若已完成,则清空
AllFiles = Me.AllFiles.Values.ToList()
End SyncLock
Dim WaitingFiles As New List(Of NetFile)
Dim OngoingFiles As New List(Of NetFile)
For Each File As NetFile In AllFiles
If Id = 0 AndAlso FileRemain = 0 Then AllFiles.Clear() '若已完成,则清空
For Each File As NetFile In AllFiles.Values
If File.Uuid Mod 2 = Id Then Continue For
If File.State = NetState.WaitingToDownload Then
WaitingFiles.Add(File)
@@ -1893,7 +1889,7 @@ Retry:
Next
End While
Catch ex As Exception
Log(ex, $"下载管理启动线程 {Id} 出错", LogLevel.Critical)
Log(ex, $"下载管理启动线程 {Id} 出错", NotifyLevel.Critical)
End Try
End Sub
RunInNewThread(Sub() ThreadStarter(0), "NetManager ThreadStarter 0")
@@ -1917,7 +1913,7 @@ Retry:
End If
End While
Catch ex As Exception
Log(ex, "下载管理刷新线程出错", LogLevel.Critical)
Log(ex, "下载管理刷新线程出错", NotifyLevel.Critical)
End Try
End Sub, "NetManager StatRefresher")
End Sub
@@ -1946,10 +1942,11 @@ Retry:
Dim NewFiles As New List(Of NetFile)
For i = 0 To Task.Files.Count - 1
Dim File As NetFile = Task.Files(i)
If AllFiles.ContainsKey(File.LocalPath) AndAlso AllFiles(File.LocalPath).State < NetState.Finished Then
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}")
File = AllFiles(File.LocalPath) '将列表中的文件替换成下载中的文件,即两个任务指向同一个文件;抛弃现在的 File 对象
File = OngoingFile '将列表中的文件替换成下载中的文件,即两个任务指向同一个文件;抛弃现在的 File 对象
Task.Files(i) = File
Else
'常规情况(该文件可能已在其他任务中下载完成,但这并不影响)
@@ -2053,7 +2050,7 @@ Retry:
Return {
"(408)", "超时", "timeout", "网络请求失败", "连接尝试失败", "远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称",
"由于目标计算机积极拒绝", "基础连接已经关闭"
}.Any(Function(k) Detail.ContainsF(k, True))
}.Any(Function(k) Detail.ContainsIgnoreCase(k))
End Function
''' <summary>
@@ -2065,7 +2062,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}", LogLevel.Debug)
Log($"[System] 未通过 SSL 证书验证({Failure}),提供的证书为 {Certificate?.Subject},URL:{Request?.Address}", NotifyLevel.DebugModeOnly)
If Request Is Nothing Then
Return Not Enabled
ElseIf Request.Address.Host.Contains("xboxlive") OrElse Request.Address.Host.Contains("minecraftservices") Then
@@ -244,18 +244,18 @@ End Class
''' </summary>
Public Class ValidateFolderName
Inherits Validate
Public Property Path As String
Public Property Folder As String
Public Property UseMinecraftCharCheck As Boolean = True
Public Property IgnoreCase As Boolean = True
Private ReadOnly PathIgnore As IEnumerable(Of DirectoryInfo)
Public Sub New()
End Sub
Public Sub New(Path As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
Me.Path = Path
Public Sub New(Folder As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True)
Me.Folder = Folder
Me.IgnoreCase = IgnoreCase
Me.UseMinecraftCharCheck = UseMinecraftCharCheck
On Error Resume Next
PathIgnore = New DirectoryInfo(Path).EnumerateDirectories
PathIgnore = New DirectoryInfo(Folder).EnumerateDirectories
End Sub
Public Overrides Function Validate(Str As String) As String
Try
@@ -271,7 +271,7 @@ Public Class ValidateFolderName
'检查尾部小数点
If Str.EndsWithF(".") Then Return "文件夹名不能以小数点结尾!"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符!").Validate(Str)
Dim CharactCheck As String = New ValidateExcept(Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符!").Validate(Str)
If CharactCheck <> "" Then Return CharactCheck
'检查特殊字符串
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)
@@ -326,7 +326,7 @@ Public Class ValidateFileName
'检查尾部小数点
If Str.EndsWithF(".") Then Return "文件名不能以小数点结尾!"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符!").Validate(Str)
Dim CharactCheck As String = New ValidateExcept(Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符!").Validate(Str)
If CharactCheck <> "" Then Return CharactCheck
'检查特殊字符串
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)
@@ -388,7 +388,7 @@ Fin:
Dim SubLengthCheck As String = New ValidateNullOrWhiteSpace().Validate(SubStr)
If Not SubLengthCheck = "" Then Return "文件夹路径存在错误!"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符!").Validate(SubStr)
Dim CharactCheck As String = New ValidateExcept(Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符!").Validate(SubStr)
If Not CharactCheck = "" Then Return CharactCheck
'检查头部空格
If SubStr.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
@@ -97,7 +97,7 @@ Public Class MyBitmap
Throw New Exception($"加载 MyBitmap 意外失败({FilePathOrResourceName})", ex)
End If
Else
Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", LogLevel.Developer)
Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", NotifyLevel.DevelopOnly)
Exit Try
End If
End Try
@@ -0,0 +1,78 @@
''' <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
File diff suppressed because it is too large Load Diff
@@ -7,8 +7,8 @@
Me.TargetInstance = TargetInstance
'构建文件结构
TempFolder = RequestTaskTempFolder()
Directory.CreateDirectory(TempFolder & "Temp\")
Directory.CreateDirectory(TempFolder & "Report\")
DirectoryUtils.Create(TempFolder & "Temp\")
DirectoryUtils.Create(TempFolder & "Report\")
Log("[Crash] 崩溃分析暂存文件夹:" & TempFolder)
End Sub
@@ -81,7 +81,7 @@
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
Dim RawOutput As String = LatestLog.Join(vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容:" & vbCrLf & RawOutput)
WriteFile(TempFolder & "RawOutput.log", RawOutput)
FileUtils.Write(TempFolder & "RawOutput.log", RawOutput)
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray))
LatestLog.Clear()
End If
@@ -573,7 +573,7 @@ Done:
'Mod 导致的崩溃
If LogCrash.Contains("-- MOD ") Then
Dim LogCrashMod As String = LogCrash.Between("-- MOD ", "Failure message:")
If LogCrashMod.ContainsF(".jar", True) Then
If LogCrashMod.ContainsIgnoreCase(".jar") Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrashMod, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Else
AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
@@ -764,7 +764,7 @@ NextStack:
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If (Line.ContainsF(".jar", True) AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar
If (Line.ContainsIgnoreCase(".jar") AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
@@ -874,7 +874,7 @@ NextStack:
StartProcess(DirectFile.Value.Key)
Else
Dim FilePath As String = PathTemp & "Crash.txt"
WriteFile(FilePath, DirectFile.Value.Value.Join(vbCrLf))
FileUtils.Write(FilePath, DirectFile.Value.Value.Join(vbCrLf))
StartProcess(FilePath)
End If
End Sub))
@@ -885,8 +885,8 @@ NextStack:
'获取文件路径
RunInUiWait(Sub() FileAddress = SelectSaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
If String.IsNullOrEmpty(FileAddress) Then Return
Directory.CreateDirectory(GetPathFromFullPath(FileAddress))
If File.Exists(FileAddress) Then File.Delete(FileAddress)
DirectoryUtils.Create(FileAddress, isFilePath:=True)
'输出诊断信息
FeedbackInfo()
LogFlush()
@@ -909,7 +909,7 @@ NextStack:
If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
Dim FileContent As String = ReadFile(OutputFile, FileEncoding)
FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
WriteFile(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
FileUtils.Write(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
Log($"[Crash] 导出文件:{FileName},编码:{FileEncoding.HeaderName}")
End If
Next
@@ -918,7 +918,7 @@ NextStack:
DeleteDirectory(TempFolder & "Report\")
Hint("错误报告已导出!", HintType.Green)
Catch ex As Exception
Log(ex, "导出错误报告失败", LogLevel.Feedback)
Log(ex, "导出错误报告失败", NotifyLevel.MsgBoxAndFeedback)
Return
End Try
OpenExplorer(FileAddress)
@@ -1117,7 +1117,7 @@ NextStack:
Replace("\n", vbCrLf).
Replace("\h", "").
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
ReplaceLineEndings(vbCrLf).
Trim(vbCrLf.ToCharArray) &
If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
vbCrLf & "如果要寻求帮助,请把错误报告文件发给对方,而不是发送这个窗口的照片或者截图。" &
@@ -75,7 +75,7 @@
Dim IndexFile = DlClientAssetIndexGet(Instance)
If IndexFile Is Nothing Then
Task.Output = New List(Of NetFile)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", NotifyLevel.DebugModeOnly)
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 可能缺失", LogLevel.Debug)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", NotifyLevel.DebugModeOnly)
Task.Interrupt()
Throw New ThreadInterruptedException
End If
@@ -313,7 +313,7 @@
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}", LogLevel.Debug)
Log($"未发现版本 {Id} 的 json 下载地址,版本列表返回为:{vbCrLf}{DlClientListLoader.Output.Value.ToString}", NotifyLevel.DebugModeOnly)
Return Nothing
Catch ex As Exception
Log(ex, $"获取版本 {Id} 的 json 下载地址失败")
@@ -426,9 +426,9 @@
Dim Entry As New DlOptiFineListEntry With {
.DisplayName = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = {ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}.Join("/"c),
.IsPreview = Name(i).ContainsF("pre", True),
.IsPreview = Name(i).ContainsIgnoreCase("pre"),
.Inherit = Name(i).ToString.Split(" ")(0),
.FileName = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.FileName = If(Name(i).ContainsIgnoreCase("pre"), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.InstanceName = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
@@ -452,7 +452,7 @@
Dim Entry As New DlOptiFineListEntry With {
.DisplayName = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "",
.IsPreview = Token("patch").ToString.ContainsF("pre", True),
.IsPreview = Token("patch").ToString.ContainsIgnoreCase("pre"),
.Inherit = Token("mcversion").ToString,
.FileName = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
@@ -679,7 +679,7 @@
Dim Versions As New List(Of DlForgeVersionEntry)
Try
'分割版本信息
Dim VersionCodes = Mid(Result, 1, Result.LastIndexOfF("</table>")).Split("<td class=""download-version")
Dim VersionCodes = Result.Substring(0, Result.LastIndexOfF("</table>")).Split("<td class=""download-version")
'获取所有版本信息
For i = 1 To VersionCodes.Count - 1
Dim VersionCode = VersionCodes(i)
@@ -720,7 +720,7 @@
Continue For
End If
'添加进列表
Versions.Add(New DlForgeVersionEntry(Name, Branch, Inherit) With {.Category = Category, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .ReleaseTime = ReleaseTime})
Versions.Add(New DlForgeVersionEntry(Name, Branch, Inherit) With {.Category = Category, .IsRecommended = IsRecommended, .Hash = MD5.ReplaceLineEndings(""), .ReleaseTime = ReleaseTime})
Catch ex As Exception
Throw New Exception("Forge 官方源版本信息提取失败(" & VersionCode & ")", ex)
End Try
@@ -846,7 +846,7 @@
Public Sub New(ApiName As String)
IsNeoForge = True
Me.ApiName = ApiName
IsBeta = ApiName.ContainsF("beta", True) OrElse ApiName.ContainsF("alpha", True)
IsBeta = ApiName.ContainsIgnoreCase("beta") OrElse ApiName.ContainsIgnoreCase("alpha")
If ApiName.Contains("1.20.1") Then '1.20.1-47.1.99
VersionName = ApiName.Replace("1.20.1-", "")
Version = New Version("19." & VersionName)
@@ -1151,14 +1151,14 @@
''' <summary>
''' Fabric API 列表,官方源。
''' </summary>
Public DlFabricApiLoader As New LoaderTask(Of Integer, List(Of CompFile))("Fabric API List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of CompFile))) Task.Output = CompFilesGet("fabric-api", False))
Public DlFabricApiLoader As New LoaderTask(Of Integer, List(Of ResourceVersion))("Fabric API List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of ResourceVersion))) Task.Output = ResourceVersion.FromProjectId("fabric-api", ResourcePlatforms.Modrinth, LoadDependencies:=False))
''' <summary>
''' OptiFabric 列表,官方源。
''' </summary>
Public DlOptiFabricLoader As New LoaderTask(Of Integer, List(Of CompFile))("OptiFabric List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of CompFile))) Task.Output = CompFilesGet("322385", True))
Public DlOptiFabricLoader As New LoaderTask(Of Integer, List(Of ResourceVersion))("OptiFabric List Loader",
Sub(Task As LoaderTask(Of Integer, List(Of ResourceVersion))) Task.Output = ResourceVersion.FromProjectId("322385", ResourcePlatforms.CurseForge, LoadDependencies:=False))
#End Region
@@ -54,7 +54,7 @@
Public ReadOnly Property HasEnvironment As Boolean
Get
If PathFolder Is Nothing OrElse PathEnv Is Nothing Then Return False
Return PathEnv.Replace("\", "").Replace("/", "").ContainsF(PathFolder.Replace("\", ""), True)
Return PathEnv.Replace("\", "").Replace("/", "").ContainsIgnoreCase(PathFolder.Replace("\", ""))
End Get
End Property
@@ -70,7 +70,7 @@
''' </summary>
Public Overrides Function ToString() As String
Dim VersionString = Version.ToString
If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3)
If VersionString.StartsWithF("1.") Then VersionString = VersionString.Substring(2)
Return If(IsJre, "JRE ", "JDK ") & MajorVersion & " (" & VersionString & ")" & If(Is64Bit, "", ",32 位") & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
End Function
@@ -95,7 +95,7 @@
Try
'确定文件存在
If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
If {"finalshell", "Paranoia File"}.Any(Function(n) PathJava.ContainsF(n, True)) Then Throw New Exception("不兼容该精简版 Java") '#2249、#8080
If {"finalshell", "Paranoia File"}.Any(Function(n) PathJava.ContainsIgnoreCase(n)) Then Throw New Exception("不兼容该精简版 Java") '#2249、#8080
If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
IsJre = Not File.Exists(PathFolder & "javac.exe")
'运行 -version
@@ -176,14 +176,14 @@
Next
End If
If Not JavaList.Any() Then
Log("[Java] 初始化未找到可用的 Java,将自动触发搜索", LogLevel.Developer)
Log("[Java] 初始化未找到可用的 Java,将自动触发搜索", NotifyLevel.DevelopOnly)
JavaSearchLoader.Start(0)
Else
Log("[Java] 缓存中有 " & JavaList.Count & " 个可用的 Java:")
JavaList.ForEach(Sub(j) Log($"[Java] - {j}"))
End If
Catch ex As Exception
Log(ex, "初始化 Java 列表失败", LogLevel.Feedback)
Log(ex, "初始化 Java 列表失败", NotifyLevel.MsgBoxAndFeedback)
Settings.Set("LaunchArgumentJavaAll", "[]")
End Try
End Sub
@@ -242,7 +242,7 @@
Catch ex As Exception
UserJava = Nothing
Settings.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", NotifyLevel.AllUsers)
End Try
End If
End If
@@ -257,7 +257,7 @@
Catch ex As Exception
UserJava = Nothing
Settings.Reset("LaunchArgumentJavaSelect")
Log(ex, "全局设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
Log(ex, "全局设置中指定的 Java 已无法使用,此设置已重置", NotifyLevel.AllUsers)
End Try
End If
@@ -332,7 +332,7 @@ RetryGet:
Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If GameInstance IsNot Nothing AndAlso Settings.Get("VersionAdvanceJava", GameInstance) Then
'直接跳过弹窗
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug)
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", NotifyLevel.DebugModeOnly)
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
Else
Select Case MyMsgBox("你在设置中手动指定了使用 Java " & JavaCurrent & ",但当前" & Requirement & "。" & vbCrLf &
@@ -400,7 +400,7 @@ UserPass:
Return Nothing
Catch ex As Exception
If ex.Message = "$$" Then Throw ex
Log(ex, "查找符合条件的 Java 失败", LogLevel.Feedback)
Log(ex, "查找符合条件的 Java 失败", NotifyLevel.MsgBoxAndFeedback)
Return Nothing
End Try
End Function
@@ -435,7 +435,7 @@ NoUserJava:
Next
Return False
Catch ex As Exception
Log(ex, "检查 Java 类别时出错", LogLevel.Feedback)
Log(ex, "检查 Java 类别时出错", NotifyLevel.MsgBoxAndFeedback)
Settings.Set("LaunchArgumentJavaSelect", "")
Return True
End Try
@@ -444,7 +444,7 @@ NoUserJava:
''' 将 Java 按照适用性排序。
''' </summary>
Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
Dim PathInfo As New DirectoryInfo(Path)
Dim PathInfo As New DirectoryInfo(PathExeFolder)
Dim PathMcInfo As New DirectoryInfo(McFolderSelected)
'1. 尽量在当前文件夹或当前 Minecraft 文件夹
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
@@ -522,9 +522,9 @@ NoUserJava:
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False, IsFullSearch:=True)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.sdkman\candidates\java\", JavaPreList, False, IsFullSearch:=True)
'查找启动器目录中的 Java
JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
JavaSearchFolder(PathExeFolder, JavaPreList, False, IsFullSearch:=True)
'查找所选 Minecraft 文件夹中的 Java
If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso Path <> McFolderSelected Then JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso PathExeFolder <> McFolderSelected Then JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
'若不全为符号链接,则清除符号链接的地址
Dim JavaWithoutReparse As New Dictionary(Of String, Boolean)
@@ -546,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.ContainsF("system32") Then
If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") OrElse Pair.Key.Contains("system32") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 位于特殊路径,不应优先使用")
Else
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
@@ -565,7 +565,7 @@ NoUserJava:
If Entry.IsUserImport Then JavaPreList(Entry.PathFolder) = True
Next
Catch ex As Exception
Log(ex, "Java 列表已损坏", LogLevel.Feedback)
Log(ex, "Java 列表已损坏", NotifyLevel.MsgBoxAndFeedback)
Settings.Set("LaunchArgumentJavaAll", "[]")
End Try
@@ -573,7 +573,7 @@ NoUserJava:
'确保可用并获取详细信息,转入正式列表
Dim NewJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.Lower = b.Key.Lower) '#794
For Each Entry In JavaPreList.ToList.DistinctBy(Function(a) a.Key.Lower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next
NewJavaList = JavaCheckList(NewJavaList).SortByComparison(AddressOf JavaSorter)
@@ -587,7 +587,7 @@ NoUserJava:
JavaList = NewJavaList
Catch ex As Exception
Log(ex, "搜索 Java 时出错", LogLevel.Feedback)
Log(ex, "搜索 Java 时出错", NotifyLevel.MsgBoxAndFeedback)
JavaList = New List(Of JavaEntry)
End Try
@@ -618,7 +618,7 @@ NoUserJava:
Catch ex As ThreadInterruptedException
Catch ex As Exception
If Entry.IsUserImport Then
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常,将被自动移除", LogLevel.Hint)
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常,将被自动移除", NotifyLevel.AllUsers)
Else
Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常")
End If
@@ -659,10 +659,10 @@ Wait:
Try
'确认目录存在
If Not OriginalPath.Exists Then Return
Dim Path As String = OriginalPath.FullName.Replace("\\", "\")
If Not Path.EndsWithF("\") Then Path += "\"
Dim Folder As String = OriginalPath.FullName.Replace("\\", "\")
If Not Folder.EndsWithF("\") Then Folder += "\"
'若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
If File.Exists(Folder & "javaw.exe") Then Results(Folder) = Source
'查找其下的所有文件夹
'不应使用网易的 Java:https://github.com/Meloong-Git/PCL/issues/1279#issuecomment-2761489121
Static Keywords As String() = {
@@ -704,7 +704,7 @@ 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}", LogLevel.Debug)
Log($"[Java] 由于下载未完成,清理未下载完成的 Java 文件:{LastJavaBaseDir}", NotifyLevel.DebugModeOnly)
DeleteDirectory(LastJavaBaseDir)
ElseIf NewState = LoadState.Finished Then
LastJavaBaseDir = Nothing
@@ -1,6 +1,4 @@
Imports System.IO.Compression
Public Module ModLaunch
Public Module ModLaunch
#Region "开始"
@@ -186,7 +184,7 @@ NextInner:
'没有特殊处理过的错误信息
McLaunchLog("错误:" & ex.GetDetail())
Log(ex,
If(IsSavingBatch, "导出启动脚本失败", "Minecraft 启动失败"), LogLevel.Msgbox,
If(IsSavingBatch, "导出启动脚本失败", "Minecraft 启动失败"), NotifyLevel.MsgBox,
If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
'上报
If Not IsSavingBatch Then
@@ -239,9 +237,8 @@ NextInner:
Dim CheckResult As String = ""
RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
#If BETA Then
'求赞助
If CurrentLaunchOptions?.SaveBatch Is Nothing Then '保存脚本时不提示
If BuildType = BuildTypes.Release AndAlso CurrentLaunchOptions?.SaveBatch Is Nothing Then '保存脚本时不提示
RunInNewThread(
Sub()
Select Case Settings.Get("SystemLaunchCount")
@@ -255,7 +252,6 @@ NextInner:
End Select
End Sub, "Donate")
End If
#End If
'正版购买提示
If CurrentLaunchOptions?.SaveBatch Is Nothing AndAlso '保存脚本时不提示
Not Settings.Get("HintBuy") AndAlso Settings.Get("LoginType") <> McLoginType.Ms Then
@@ -496,7 +492,7 @@ NextInner:
End If
End Select
Catch ex As Exception
Log(ex, "获取登录输入信息失败(" & GetStringFromEnum(LoginType) & ")", LogLevel.Feedback)
Log(ex, "获取登录输入信息失败(" & GetStringFromEnum(LoginType) & ")", NotifyLevel.MsgBoxAndFeedback)
End Try
Return LoginData
End Function
@@ -665,7 +661,7 @@ LoginFinish:
Settings.Set("Login" & Input.Token & "Email", Emails.Join("¨"c))
Settings.Set("Login" & Input.Token & "Pass", Passwords.Join("¨"c))
Catch ex As Exception
Log(ex, "保存启动记录失败", LogLevel.Hint)
Log(ex, "保存启动记录失败", NotifyLevel.AllUsers)
Settings.Set("Login" & Input.Token & "Email", "")
Settings.Set("Login" & Input.Token & "Pass", "")
End Try
@@ -817,17 +813,17 @@ LoginFinish:
Return NeedRefresh
Catch ex As Exception
Dim AllMessage As String = ex.GetBrief()
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
Log(ex, "登录失败原始错误信息", NotifyLevel.Silent)
'读取服务器返回的错误
If TypeOf ex Is ResponsedWebException Then
Dim ErrorMessage As String = Nothing
Try
Dim Response = DirectCast(ex, ResponsedWebException).Response
If Response.ContainsF("errorMessage", True) Then ErrorMessage = GetJson(Response)("errorMessage").ToString()
If Response.ContainsIgnoreCase("errorMessage") Then ErrorMessage = GetJson(Response)("errorMessage").ToString()
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
If ErrorMessage.Contains("密码错误") OrElse ErrorMessage.ContainsF("Incorrect username or password", True) Then
If ErrorMessage.Contains("密码错误") OrElse ErrorMessage.ContainsIgnoreCase("Incorrect username or password") Then
'密码错误,退出登录 (#5090)
McLaunchLog("密码错误,退出登录")
Select Case Data.Input.Type
@@ -905,15 +901,15 @@ Retry:
Dim Result As String
Try
Result = NetRequestByClientMultiple("https://login.live.com/oauth20_token.srf", HttpMethod.Post,
Content:=$"client_id={OAuthClientId}&refresh_token={Uri.EscapeDataString(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
Content:=$"client_id={OAuthClientId}&refresh_token={EscapeUtils.FormUrlEscape(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
ContentType:="application/x-www-form-urlencoded",
Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}},
ThreadCount:=2)
Catch ex As ResponsedWebException
'修改错误列表时,同时检查 MyMsgLogin.xaml.vb 中的对应代码
Dim Response = ex.Response
If Response.ContainsF("must sign in again", True) OrElse Response.ContainsF("password expired", True) OrElse
(Response.Contains("refresh_token") AndAlso Response.Contains("is not valid")) Then '#269
If Response.ContainsIgnoreCase("must sign in again") OrElse Response.ContainsIgnoreCase("password expired") OrElse
(Response.Contains("refresh_token") AndAlso Response.ContainsIgnoreCase("is not valid")) Then '#269
Return {"Relogin", ""}
ElseIf Response.Contains("Account security interrupt") Then
MyMsgBox("该账号由于安全问题无法登陆,请前往微软账户页获取更多信息。", "登录失败", "我知道了", IsWarn:=True)
@@ -1105,7 +1101,7 @@ Retry:
Uuid = McLoginMojangUuid(SkinName, False)
End If
Catch ex As Exception
Log(ex, "皮肤信息获取失败,游戏将以无皮肤的方式启动", LogLevel.Hint)
Log(ex, "皮肤信息获取失败,游戏将以无皮肤的方式启动", NotifyLevel.AllUsers)
End Try
Case 4
'自定义
@@ -1118,7 +1114,7 @@ Retry:
End Function
'根据用户名返回对应 UUID,需要多线程
Public Function McLoginMojangUuid(Name As String, ThrowOnNotFound As Boolean)
If Name.Trim.Length = 0 Then Return StrFill("", "0", 32)
If Name.Trim.Length = 0 Then Return New String("0"c, 32)
'从缓存获取
Dim Uuid As String = ReadIni(PathTemp & "Cache\Uuid\Mojang.ini", Name, "")
If Len(Uuid) = 32 Then Return Uuid
@@ -1141,7 +1137,7 @@ Retry:
Return Uuid
End Function
Public Function McLoginLegacyUuid(Name As String)
Dim FullUuid As String = StrFill(Name.Length.ToString("X"), "0", 16) & StrFill(GetHash(Name).ToString("X"), "0", 16)
Dim FullUuid As String = Name.Length.ToString("X").EnsureLength("0", 16) & GetHash(Name).ToString("X").EnsureLength("0", 16)
Return FullUuid.Substring(0, 12) & "3" & FullUuid.Substring(13, 3) & "9" & FullUuid.Substring(17, 15)
End Function
@@ -1583,7 +1579,7 @@ NextInstance:
McLaunchLog("发现错误的 OptiFineForge TweakClass,目前的游戏参数:" & Arg)
Arg = Arg.Replace(" --tweakClass optifine.OptiFineTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try
WriteFile(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".json", ReadFile(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
FileUtils.Write(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".json", ReadFile(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
Catch ex As Exception
Log(ex, "替换 OptiFineForge TweakClass 失败")
End Try
@@ -1627,15 +1623,15 @@ NextInstance:
Private Iterator Function McLaunchArgumentsReplace(Arguments As List(Of String)) As IEnumerable(Of (Key As String, Value As String))
'基础参数
Yield ("${classpath_separator}", ";")
Yield ("${natives_directory}", ShortenPath(GetNativesFolder()))
Yield ("${library_directory}", ShortenPath(McFolderSelected & "libraries"))
Yield ("${libraries_directory}", ShortenPath(McFolderSelected & "libraries"))
Yield ("${natives_directory}", GetNativesFolder().TrimEnd("\"c))
Yield ("${library_directory}", FileUtils.ShortenPath(McFolderSelected & "libraries"))
Yield ("${libraries_directory}", FileUtils.ShortenPath(McFolderSelected & "libraries"))
Yield ("${pure_directory}", PathPure.TrimEnd("\"c)) '由 PCL 添加,这会允许在分割参数并去重后再替换路径,防止路径中的特殊字符影响参数分割和去重
Yield ("${launcher_name}", "PCL")
Yield ("${launcher_version}", VersionCode)
Yield ("${version_name}", McInstanceSelected.Name)
Yield ("${game_directory}", ShortenPath(Left(McInstanceSelected.PathIndie, McInstanceSelected.PathIndie.Count - 1)))
Yield ("${assets_root}", ShortenPath(McFolderSelected & "assets"))
Yield ("${game_directory}", FileUtils.ShortenPath(Left(McInstanceSelected.PathIndie, McInstanceSelected.PathIndie.Count - 1)))
Yield ("${assets_root}", FileUtils.ShortenPath(McFolderSelected & "assets"))
Yield ("${user_properties}", "{}")
Yield ("${auth_player_name}", McLoginLoader.Output.Name)
Yield ("${auth_uuid}", McLoginLoader.Output.Uuid)
@@ -1643,8 +1639,8 @@ NextInstance:
Yield ("${access_token}", McLoginLoader.Output.AccessToken)
Yield ("${auth_session}", McLoginLoader.Output.AccessToken)
Yield ("${user_type}", "msa") '#1221
Yield ("${primary_jar}", ShortenPath(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".jar")) '#6942
Yield ("${game_assets}", ShortenPath(McFolderSelected & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
Yield ("${primary_jar}", FileUtils.ShortenPath(McInstanceSelected.PathVersion & McInstanceSelected.Name & ".jar")) '#6942
Yield ("${game_assets}", FileUtils.ShortenPath(McFolderSelected & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
Yield ("${assets_index_name}", McAssetsGetIndexName(McInstanceSelected))
'自定义信息
@@ -1697,14 +1693,14 @@ NextInstance:
End If
Next
If OptiFineCp IsNot Nothing Then Cps.Insert(Cps.Count - 2, OptiFineCp) 'OptiFine 的总是需要放到倒数第二位
Yield ("${classpath}", Cps.Select(Function(c) ShortenPath(c)).Join(";"c))
Yield ("${classpath}", Cps.Select(Function(c) FileUtils.ShortenPath(c)).Join(";"c))
End Function
''' <summary>
''' 分割 Java 参数字符串。
''' </summary>
Private Iterator Function SplitJavaArguments(Arg As String) As IEnumerable(Of String)
Arg = Arg.Replace(vbLf, " ").Replace(vbCr, " ").Trim '预处理换行符
Arg = Arg.ReplaceLineEndings(" ", mergeMultiple:=True).Trim '预处理换行符
If String.IsNullOrWhiteSpace(Arg) Then Return
Dim Current As New StringBuilder
Dim InQuotes As Boolean = False
@@ -1783,8 +1779,8 @@ NextInstance:
Private Sub McLaunchNatives(Loader As LoaderTask(Of Integer, Integer))
'创建文件夹
Dim Target As String = GetNativesFolder() & "\"
Directory.CreateDirectory(Target)
Dim Target As String = GetNativesFolder()
DirectoryUtils.Create(Target)
'解压文件
McLaunchLog("正在解压 Natives 文件")
@@ -1821,7 +1817,7 @@ NextInstance:
End Try
End If
'解压新文件
WriteFile(FilePath, Entry.Open)
FileUtils.Write(FilePath, Entry.Open)
McLaunchLog("已解压:" & FilePath)
End If
Next
@@ -1843,18 +1839,18 @@ NextInstance:
End Sub
''' <summary>
''' 获取 Natives 文件夹路径,不以 \ 结尾。
''' 获取 Natives 文件夹路径,以 \ 结尾。
''' </summary>
Private Function GetNativesFolder() As String
Dim Result As String = ShortenPath(McInstanceSelected.PathVersion) & McInstanceSelected.Name & "-natives"
If Not (IsGBKEncoding OrElse Result.IsASCII()) Then
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
If Not Result.IsASCII() Then
Result = OsDrive & "ProgramData\PCL\natives"
Dim Result As String = FileUtils.ShortenPath(McInstanceSelected.PathVersion) & McInstanceSelected.Name & "-natives\"
If Not (IsGBKEncoding OrElse Result.IsAsciiOnly()) Then
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives\"
If Not Result.IsAsciiOnly() Then
Result = OsDrive & "ProgramData\PCL\natives\"
End If
End If
Directory.CreateDirectory(Result) '提前创建,这样 ShortenPath 才有结果(否则在长路径下首次启动 Forge 会崩溃)
Return ShortenPath(Result)
DirectoryUtils.Create(Result) '提前创建,这样 DirectoryUtils.Shorten 才有结果(否则在长路径下首次启动 Forge 会崩溃)
Return FileUtils.ShortenPath(Result)
End Function
#End Region
@@ -1867,7 +1863,7 @@ NextInstance:
If Settings.Get("LaunchAdvanceGraphicCard") Then
Try
SetGPUPreference(McLaunchJavaSelected.PathJava)
SetGPUPreference(PathWithName)
SetGPUPreference(PathExe)
Catch ex As Exception
If IsAdmin() Then
Log(ex, "直接调整显卡设置失败")
@@ -1880,7 +1876,7 @@ NextInstance:
Throw New Exception("调整过程中出现异常")
End If
Catch exx As Exception
Log(exx, "调整显卡设置失败,Minecraft 可能会使用默认显卡运行", LogLevel.Hint)
Log(exx, "调整显卡设置失败,Minecraft 可能会使用默认显卡运行", NotifyLevel.AllUsers)
End Try
End If
End Try
@@ -1914,7 +1910,7 @@ NextInstance:
'更新文件
Dim Profiles As JObject = GetJson(ReadFile(McFolderSelected & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson)
WriteFile(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已更新 launcher_profiles.json")
Catch ex As Exception
Log(ex, "更新 launcher_profiles.json 失败,将在删除文件后重试")
@@ -1944,10 +1940,10 @@ NextInstance:
'更新文件
Dim Profiles As JObject = GetJson(ReadFile(McFolderSelected & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson)
WriteFile(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已在删除后更新 launcher_profiles.json")
Catch exx As Exception
Log(exx, "更新 launcher_profiles.json 失败", LogLevel.Feedback)
Log(exx, "更新 launcher_profiles.json 失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Try
@@ -1997,7 +1993,7 @@ NextInstance:
WriteIni(SetupFileAddress, "fullscreen", "false")
End Select
Catch ex As Exception
Log(ex, "更新 options.txt 失败", LogLevel.Hint)
Log(ex, "更新 options.txt 失败", NotifyLevel.AllUsers)
End Try
'离线皮肤 Alex 警告
@@ -2010,11 +2006,11 @@ NextInstance:
'离线皮肤资源包
Try
Directory.CreateDirectory(McInstanceSelected.PathIndie & "resourcepacks\")
Dim ZipFileAddress As String = McInstanceSelected.PathIndie & "resourcepacks\PCL2 Skin.zip"
DirectoryUtils.Create(ZipFileAddress, isFilePath:=True)
Dim NewTypeSetup As Boolean = McInstanceSelected.Version.Vanilla.Major >= 13 OrElse McInstanceSelected.Version.Vanilla.Major < 6
If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Settings.Get("LaunchSkinType") = 4 AndAlso File.Exists(PathAppdata & "CustomSkin.png") Then
Directory.CreateDirectory(PathTemp)
DirectoryUtils.Create(PathTemp)
Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
Dim PackPicAddress As String = PathTemp & "pack.png"
Dim PackFormat As Integer
@@ -2063,13 +2059,13 @@ NextInstance:
'准备文件
Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png")
Bit.Save(PackPicAddress)
WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
FileUtils.Write(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png")
If (McInstanceSelected.Version.Vanilla.Major = 6 OrElse McInstanceSelected.Version.Vanilla.Major = 7) AndAlso Skin.Pic.Height = 64 Then
McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪")
Skin = Skin.Clip(0, 0, 64, 32)
End If
Skin.Save(Path & "PCL\CustomSkin_Cliped.png")
Skin.Save(PathExeFolder & "PCL\CustomSkin_Cliped.png")
'构建压缩文件
Using ZipFile As New FileStream(ZipFileAddress, FileMode.Create)
Using ZipAr As New ZipArchive(ZipFile, ZipArchiveMode.Create)
@@ -2078,15 +2074,15 @@ NextInstance:
'1.19.3+ 使用复杂版本的替换
If McInstanceSelected.Version.Vanilla >= New Version(19, 0, 3) Then
For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png",
ZipAr.CreateEntryFromFile(PathExeFolder & "PCL\CustomSkin_Cliped.png",
$"assets/minecraft/textures/entity/player/{If(Settings.Get("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png")
Next
Else
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Settings.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
ZipAr.CreateEntryFromFile(PathExeFolder & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Settings.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
End If
End Using
End Using
File.Delete(Path & "PCL\CustomSkin_Cliped.png")
File.Delete(PathExeFolder & "PCL\CustomSkin_Cliped.png")
'更改设置文件
IniClearCache(SetupFileAddress)
Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
@@ -2132,7 +2128,7 @@ IgnoreCustomSkin:
End If
End If
Catch ex As Exception
Log(ex, "离线皮肤资源包设置失败", LogLevel.Hint)
Log(ex, "离线皮肤资源包设置失败", NotifyLevel.AllUsers)
End Try
End Sub
@@ -2151,13 +2147,13 @@ IgnoreCustomSkin:
"@echo off" & vbCrLf &
$"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
"echo 游戏正在启动,请稍候。" & vbCrLf &
$"cd /D ""{ShortenPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
$"cd /D ""{FileUtils.ShortenPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
CustomCommandGlobal & vbCrLf &
CustomCommandVersion & vbCrLf &
$"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), FilterAccessToken(CmdString, "F"),
FileUtils.Write(If(CurrentLaunchOptions.SaveBatch, PathExeFolder & "PCL\LatestLaunch.bat"), FilterAccessToken(CmdString, "F"),
Encoding:=If(McLaunchJavaSelected.MajorVersion > 8, Encoding.UTF8, Encoding.Default))
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成,强制结束启动过程")
@@ -2189,7 +2185,7 @@ IgnoreCustomSkin:
Loop
End If
Catch ex As Exception
Log(ex, "执行全局自定义命令失败", LogLevel.Hint)
Log(ex, "执行全局自定义命令失败", NotifyLevel.AllUsers)
Finally
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183
@@ -2214,7 +2210,7 @@ IgnoreCustomSkin:
Loop
End If
Catch ex As Exception
Log(ex, "执行版本自定义命令失败", LogLevel.Hint)
Log(ex, "执行版本自定义命令失败", NotifyLevel.AllUsers)
Finally
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
McLaunchLog("由于取消启动,已强制结束自定义命令 CMD 进程") '#1183
@@ -2233,9 +2229,9 @@ IgnoreCustomSkin:
Dim PathEnv As String = StartInfo.EnvironmentVariables("Path")
Dim Paths As New List(Of String)
If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder))
Paths.Add(FileUtils.ShortenPath(McLaunchJavaSelected.PathFolder))
StartInfo.EnvironmentVariables("Path") = Paths.Distinct.Join(";"c)
StartInfo.EnvironmentVariables("appdata") = ShortenPath(McFolderSelected)
StartInfo.EnvironmentVariables("appdata") = FileUtils.ShortenPath(McFolderSelected)
'设置其他参数
StartInfo.WorkingDirectory = McInstanceSelected.PathIndie
@@ -2267,7 +2263,7 @@ IgnoreCustomSkin:
Case Else '中
End Select
Catch ex As Exception
Log(ex, "设置进程优先级失败", LogLevel.Feedback)
Log(ex, "设置进程优先级失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -2276,7 +2272,7 @@ IgnoreCustomSkin:
'输出信息
McLaunchLog("")
McLaunchLog("~ 基础参数 ~")
McLaunchLog("PCL 版本:" & VersionDisplayName & " (" & VersionCode & ")")
McLaunchLog("PCL 版本:" & VersionDisplay & " (" & VersionCode & ")")
McLaunchLog($"游戏版本:{McInstanceSelected.VersionDisplayName}({McInstanceSelected.Version.Vanilla},Drop {McInstanceSelected.Version.Drop}{If(McInstanceSelected.Version.Reliable, "", ",无法完全确定")})")
McLaunchLog("资源版本:" & McAssetsGetIndexName(McInstanceSelected))
McLaunchLog("版本继承:" & If(McInstanceSelected.InheritName = "", "无", McInstanceSelected.InheritName))
@@ -1,6 +1,4 @@
Imports System.IO.Compression
Public Module ModMinecraft
Public Module ModMinecraft
#Region "文件夹"
@@ -18,8 +16,8 @@ Public Module ModMinecraft
End Property
Private Sub SetMcFolder(Value As String) '等同 McFolderSelected.Set
If _McFolderSelected = Value Then Return
_McFolderSelected = Value.Replace("$", Path)
Settings.Set("LaunchFolderSelect", Value.Replace(Path, "$"))
_McFolderSelected = Value.Replace("$", PathExeFolder)
Settings.Set("LaunchFolderSelect", Value.Replace(PathExeFolder, "$"))
Log("[Minecraft] 当前选择的 Minecraft 文件夹:" & _McFolderSelected)
End Sub
Private _McFolderSelected As String
@@ -65,8 +63,8 @@ Public Module ModMinecraft
'扫描当前文件夹
Try
If Directory.Exists(Path & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path, .Type = McFolder.Types.Vanilla})
For Each Folder As DirectoryInfo In New DirectoryInfo(Path).GetDirectories
If Directory.Exists(PathExeFolder & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder, .Type = McFolder.Types.Vanilla})
For Each Folder As DirectoryInfo In New DirectoryInfo(PathExeFolder).GetDirectories
If Directory.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Folder.FullName & "\", .Type = McFolder.Types.Vanilla})
Next
Catch ex As Exception
@@ -122,8 +120,8 @@ Public Module ModMinecraft
'若没有可用文件夹,则创建 .minecraft
If Not CacheMcFolderList.Any() Then
Directory.CreateDirectory(Path & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Path & ".minecraft\", .Type = McFolder.Types.Vanilla})
DirectoryUtils.Create(PathExeFolder & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder & ".minecraft\", .Type = McFolder.Types.Vanilla})
End If
For Each Folder As McFolder In CacheMcFolderList
@@ -135,7 +133,7 @@ Public Module ModMinecraft
McFolderList = CacheMcFolderList
Catch ex As Exception
Log(ex, "加载 Minecraft 文件夹列表失败", LogLevel.Feedback)
Log(ex, "加载 Minecraft 文件夹列表失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -159,10 +157,10 @@ Public Module ModMinecraft
""selectedProfile"": ""PCL"",
""clientToken"": ""23323323323323323323323323323333""
}"
WriteFile(Folder & "launcher_profiles.json", ResultJson, Encoding:=Encoding.GetEncoding("GB18030"))
FileUtils.Write(Folder & "launcher_profiles.json", ResultJson, Encoding:=Encoding.GetEncoding("GB18030"))
Log("[Minecraft] 已创建 launcher_profiles.json:" & Folder)
Catch ex As Exception
Log(ex, "创建 launcher_profiles.json 失败(" & Folder & ")", LogLevel.Feedback)
Log(ex, "创建 launcher_profiles.json 失败(" & Folder & ")", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -170,7 +168,7 @@ Public Module ModMinecraft
#Region "版本处理"
Public Const McInstanceCacheVersion As Integer = 35
Public Const McInstanceCacheVersion As Integer = 36
Private _McInstanceSelected As McInstance
''' <summary>
@@ -185,13 +183,12 @@ Public Module ModMinecraft
If ReferenceEquals(_McInstanceSelectedLast, value) Then Return
_McInstanceSelected = value '由于有可能是 Nothing,导致无法初始化,才得这样弄一圈
_McInstanceSelectedLast = value
Settings.MakeInstanceDirty()
'更新 MC 文件夹所选取的 Minecraft 版本
Log("[Launch] 当前选择的 Minecraft 版本:" & If(value?.PathVersion, "无"))
WriteIni(McFolderSelected & "PCL.ini", "Version", If(value?.Name, ""))
If value Is Nothing Then Return
'重置缓存的下载文件夹
PageDownloadCompDetail.CachedFolder.Clear()
PageDownloadResourceDetail.CachedFolder.Clear()
'统一通行证重判
If AniControlEnabled = 0 AndAlso
Settings.Get("VersionServerNide", Instance:=value) <> Settings.Get("CacheNideServer") AndAlso
@@ -481,7 +478,7 @@ VersionSearchFinish:
If JsonPath Is Nothing Then
Throw New Exception($"未找到版本 JSON 文件:{PathVersion}{Name}.json")
Else
Log("[Minecraft] 未找到同名版本 JSON,自动换用 " & JsonPath, LogLevel.Debug)
Log("[Minecraft] 未找到同名版本 JSON,自动换用 " & JsonPath, NotifyLevel.DebugModeOnly)
End If
End If
Return JsonPath
@@ -503,10 +500,10 @@ VersionSearchFinish:
'如果 ReadFile 失败会返回空字符串;这可能是由于文件被临时占用,故延时后重试
If Not FastJsonCheck(_JsonText) Then
If RunInUi() Then
Log("[Minecraft] 版本 JSON 文件为空或有误,由于代码在主线程运行,将不再进行重试", LogLevel.Debug)
Log("[Minecraft] 版本 JSON 文件为空或有误,由于代码在主线程运行,将不再进行重试", NotifyLevel.DebugModeOnly)
GetJson(_JsonText) '触发异常
Else
Log($"[Minecraft] 版本 JSON 文件为空或有误,将在 2s 后重试读取({JsonPath})", LogLevel.Debug)
Log($"[Minecraft] 版本 JSON 文件为空或有误,将在 2s 后重试读取({JsonPath})", NotifyLevel.DebugModeOnly)
Thread.Sleep(2000)
_JsonText = ReadFile(JsonPath)
If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
@@ -566,7 +563,7 @@ VersionSearchFinish:
Try
InstanceNameInheritFrom = If(_JsonObject("inheritsFrom") Is Nothing, "", _JsonObject("inheritsFrom").ToString)
If InstanceNameInheritFrom = Name Then
Log("[Minecraft] 自引用的继承版本:" & Name, LogLevel.Debug)
Log("[Minecraft] 自引用的继承版本:" & Name, NotifyLevel.DebugModeOnly)
InstanceNameInheritFrom = ""
Exit Try
End If
@@ -684,7 +681,7 @@ Recheck:
End If
'检查权限
Try
Directory.CreateDirectory(PathVersion & "PCL\")
DirectoryUtils.Create(PathVersion & "PCL\")
CheckPermissionWithException(PathVersion & "PCL\")
Catch ex As Exception
State = McInstanceState.Error
@@ -823,8 +820,6 @@ ExitDataLoad:
If State = McInstanceState.Fool Then
Info = GetMcFoolName(Version.VanillaName)
ElseIf State <> McInstanceState.Error Then
'这里不应使用缓存,因为不同实例有不同值 (#8508)
Settings.MakeInstanceDirty()
If Settings.Get("VersionServerLogin", Instance:=Me) = 3 Then Info += ", 统一通行证验证"
If Settings.Get("VersionServerLogin", Instance:=Me) = 4 Then Info += ", Authlib 验证"
End If
@@ -853,15 +848,15 @@ ExitDataLoad:
Info = "未知错误:" & ex.GetBrief()
Logo = PathImage & "Blocks/RedstoneBlock.png"
State = McInstanceState.Error
Log(ex, "加载版本失败(" & Name & ")", LogLevel.Feedback)
Log(ex, "加载版本失败(" & Name & ")", NotifyLevel.MsgBoxAndFeedback)
Finally
IsLoaded = True
End Try
Return Me
End Function
Private Function IsSnapshot() As Boolean
Return {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) Version.VanillaName.ContainsF(s, True)) OrElse
Name.ContainsF("combat", True) OrElse
Return {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) Version.VanillaName.ContainsIgnoreCase(s)) OrElse
Name.ContainsIgnoreCase("combat") OrElse
If(JsonObject("type"), "").ToString = "snapshot" OrElse If(JsonObject("type"), "").ToString = "pending"
End Function
@@ -882,15 +877,15 @@ ExitDataLoad:
Dim Info As String
Select Case State
Case McInstanceState.Snapshot, McInstanceState.Original, McInstanceState.Forge, McInstanceState.NeoForge, McInstanceState.Fabric, McInstanceState.OptiFine, McInstanceState.LiteLoader
If Version.VanillaName.ContainsF("pre", True) Then
If Version.VanillaName.ContainsIgnoreCase("pre") Then
Info = "预发布版 " & Version.VanillaName
ElseIf Version.VanillaName.ContainsF("rc", True) Then
ElseIf Version.VanillaName.ContainsIgnoreCase("rc") Then
Info = "发布候选 " & Version.VanillaName
ElseIf Version.VanillaName.Contains("experimental") Then
ElseIf Version.VanillaName.ContainsIgnoreCase("experimental") Then
Info = "实验性快照" & Version.VanillaName
ElseIf Version.VanillaName = "pending" Then
Info = "实验性快照"
ElseIf IsSnapshot Then
ElseIf IsSnapshot() Then
Info = If(Version.Reliable, "快照版 " & Version.VanillaName.Replace("-snapshot", ""), "快照版")
Else
Info = If(Version.Reliable, "正式版 " & Version.VanillaName, "正式版")
@@ -928,7 +923,7 @@ ExitDataLoad:
NewItem.Logo = Logo
End If
Catch ex As Exception
Log(ex, "加载版本图标失败", LogLevel.Hint)
Log(ex, "加载版本图标失败", NotifyLevel.AllUsers)
NewItem.Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png"
End Try
Return NewItem
@@ -1026,8 +1021,8 @@ ExitDataLoad:
Result += Val(RegexSeek(Right(OptiFine, OptiFine.Length - 1), "[0-9]+"))
'测试标记(正式版为 99,Pre[x] 为 50+x,Beta[x] 为 x)
Result *= 100
If OptiFine.ContainsF("pre", True) Then Result += 50
If OptiFine.ContainsF("pre", True) OrElse OptiFine.ContainsF("beta", True) Then
If OptiFine.ContainsIgnoreCase("pre") Then Result += 50
If OptiFine.ContainsIgnoreCase("pre") OrElse OptiFine.ContainsIgnoreCase("beta") Then
If Val(Right(OptiFine, 1)) = 0 AndAlso Right(OptiFine, 1) <> "0" Then
Result += 1 '为 pre 或 beta 结尾,视作 1
Else
@@ -1134,7 +1129,7 @@ ExitDataLoad:
If Drop >= 250 Then
Return $"{Drop \ 10}.{Drop Mod 10}"
ElseIf Drop = 209 Then
Log("[Minecraft] 尝试将旧快照版 Drop 序数转换为版本字符串,这不应该发生!" & vbCrLf & GetStackTrace(), LogLevel.Debug)
Log("[Minecraft] 尝试将旧快照版 Drop 序数转换为版本字符串,这不应该发生!" & vbCrLf & GetStackTrace(), NotifyLevel.DebugModeOnly)
Return "1.20"
Else
Return $"1.{Drop \ 10}"
@@ -1294,24 +1289,24 @@ OnLoaded:
Catch ex As Exception
If Loader.IsInterrupted Then Return '#5617
WriteIni(PathMc & "PCL.ini", "InstanceCache", "") '要求下次重新加载
Log(ex, "加载 .minecraft 版本列表失败", LogLevel.Feedback)
Log(ex, "加载 .minecraft 版本列表失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
'获取版本列表
Private Function InitMcInstanceListWithCache(Path As String) As Dictionary(Of McInstanceCardType, List(Of McInstance))
Private Function InitMcInstanceListWithCache(Folder As String) As Dictionary(Of McInstanceCardType, List(Of McInstance))
Dim Results As New Dictionary(Of McInstanceCardType, List(Of McInstance))
Try
Dim CardCount As Integer = ReadIni(Path & "PCL.ini", "CardCount", -1)
Dim CardCount As Integer = ReadIni(Folder & "PCL.ini", "CardCount", -1)
If CardCount = -1 Then Return Nothing
For i = 0 To CardCount - 1
Dim CardType As McInstanceCardType = ReadIni(Path & "PCL.ini", "CardKey" & (i + 1), ":")
Dim CardType As McInstanceCardType = ReadIni(Folder & "PCL.ini", "CardKey" & (i + 1), ":")
Dim InstanceList As New List(Of McInstance)
'循环读取版本
For Each Folder As String In ReadIni(Path & "PCL.ini", "CardValue" & (i + 1), ":").Split(":")
If Folder = "" Then Continue For
Dim FolderVersions As String = $"{Path}versions\{Folder}\"
For Each VersionName As String In ReadIni(Folder & "PCL.ini", "CardValue" & (i + 1), ":").Split(":")
If VersionName = "" Then Continue For
Dim FolderVersions As String = $"{Folder}versions\{VersionName}\"
If File.Exists(FolderVersions & ".pclignore") Then
If IsFirstMcInstanceListLoad Then
Log("[Minecraft] 清理残留的忽略项目:" & FolderVersions) '#2781
@@ -1332,7 +1327,7 @@ OnLoaded:
Instance.ReleaseTime = ReadIni(Instance.PathVersion & "PCL\Setup.ini", "ReleaseTime", Instance.ReleaseTime)
Instance.State = ReadIni(Instance.PathVersion & "PCL\Setup.ini", "State", Instance.State)
Instance.IsStar = ReadIni(Instance.PathVersion & "PCL\Setup.ini", "IsStar", False)
Instance.DisplayType = ReadIni(Path & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Auto)
Instance.DisplayType = ReadIni(Folder & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Auto)
If Instance.State <> McInstanceState.Error AndAlso
ReadIni(Instance.PathVersion & "PCL\Setup.ini", "VersionVanillaName", "Unknown") <> "Unknown" Then
'读取版本信息
@@ -1375,7 +1370,7 @@ OnLoaded:
End If
Catch ex As Exception
Log(ex, "读取版本加载缓存失败(" & Folder & ")", LogLevel.Debug)
Log(ex, "读取版本加载缓存失败(" & VersionName & ")", NotifyLevel.DebugModeOnly)
Return Nothing
End Try
Next
@@ -1388,20 +1383,21 @@ OnLoaded:
Return Nothing
End Try
End Function
Private Function InitMcInstanceListWithoutCache(Path As String) As Dictionary(Of McInstanceCardType, List(Of McInstance))
Private Function InitMcInstanceListWithoutCache(Folder As String) As Dictionary(Of McInstanceCardType, List(Of McInstance))
Dim InstanceList As New List(Of McInstance)
#Region "循环加载每个版本的信息"
For Each Folder As DirectoryInfo In New DirectoryInfo(Path & "versions").GetDirectories
If Not Folder.Exists OrElse Not Folder.EnumerateFiles.Any Then
Log("[Minecraft] 跳过空文件夹:" & Folder.FullName)
For Each VersionFolderInfo As DirectoryInfo In New DirectoryInfo(Folder & "versions").GetDirectories
If Not VersionFolderInfo.Exists OrElse Not VersionFolderInfo.EnumerateFiles.Any Then
Log("[Minecraft] 跳过空文件夹:" & VersionFolderInfo.FullName)
Continue For
End If
If (Folder.Name = "cache" OrElse Folder.Name = "BLClient" OrElse Folder.Name = "PCL") AndAlso Not File.Exists(Folder.FullName & "\" & Folder.Name & ".json") Then
Log("[Minecraft] 跳过可能不是版本文件夹的项目:" & Folder.FullName)
If (VersionFolderInfo.Name = "cache" OrElse VersionFolderInfo.Name = "BLClient" OrElse VersionFolderInfo.Name = "PCL") AndAlso
Not File.Exists(VersionFolderInfo.FullName & "\" & VersionFolderInfo.Name & ".json") Then
Log("[Minecraft] 跳过可能不是版本文件夹的项目:" & VersionFolderInfo.FullName)
Continue For
End If
Dim VersionFolder As String = Folder.FullName & "\"
Dim VersionFolder As String = VersionFolderInfo.FullName & "\"
If File.Exists(VersionFolder & ".pclignore") Then
If IsFirstMcInstanceListLoad Then
Log("[Minecraft] 清理残留的忽略项目:" & VersionFolder) '#2781
@@ -1517,7 +1513,7 @@ OnLoaded:
Catch ex As Exception
Results.Clear()
Log(ex, "分类版本列表失败", LogLevel.Feedback)
Log(ex, "分类版本列表失败", NotifyLevel.MsgBoxAndFeedback)
End Try
#End Region
#Region "对卡片与版本进行排序"
@@ -1558,14 +1554,14 @@ OnLoaded:
#End Region
#Region "保存卡片缓存"
WriteIni(Path & "PCL.ini", "CardCount", Results.Count)
WriteIni(Folder & "PCL.ini", "CardCount", Results.Count)
For i = 0 To Results.Count - 1
WriteIni(Path & "PCL.ini", "CardKey" & (i + 1), Results.Keys(i))
WriteIni(Folder & "PCL.ini", "CardKey" & (i + 1), Results.Keys(i))
Dim Value As String = ""
For Each Instance As McInstance In Results.Values(i)
Value += Instance.Name & ":"
Next
WriteIni(Path & "PCL.ini", "CardValue" & (i + 1), Value)
WriteIni(Folder & "PCL.ini", "CardValue" & (i + 1), Value)
Next
#End Region
Return Results
@@ -1637,7 +1633,7 @@ OnLoaded:
Return New McSkinInfo With {.IsVaild = False}
End If
Catch ex As Exception
Log(ex, "皮肤文件存在错误", LogLevel.Hint)
Log(ex, "皮肤文件存在错误", NotifyLevel.AllUsers)
Return New McSkinInfo With {.IsVaild = False}
End Try
@@ -1685,7 +1681,7 @@ OnLoaded:
Next
Throw New Exception("未从皮肤返回值中找到符合条件的 Property")
Catch ex As Exception
Log(ex, "无法完成解析的皮肤返回值,可能是未设置自定义皮肤的用户:" & SkinString, LogLevel.Developer)
Log(ex, "无法完成解析的皮肤返回值,可能是未设置自定义皮肤的用户:" & SkinString, NotifyLevel.DevelopOnly)
Throw New Exception("皮肤返回值中不包含皮肤数据项,可能是未设置自定义皮肤的用户", ex)
End Try
SkinString = Encoding.GetEncoding("utf-8").GetString(Convert.FromBase64String(SkinValue))
@@ -1796,7 +1792,7 @@ OnLoaded:
Public OriginalName As String
Public Overrides Function ToString() As String
Return If(IsNatives, "[Native] ", "") & GetString(Size) & " | " & LocalPath
Return If(IsNatives, "[Native] ", "") & FormatFileSize(Size) & " | " & LocalPath
End Function
End Class
@@ -1885,7 +1881,7 @@ OnLoaded:
'不能调用 RealVersion.Check(),可能会莫名其妙地触发 CheckPermission 正被另一进程使用,导致误判前置不存在
If Not File.Exists(RealInstance.PathVersion & RealInstance.Name & ".json") Then
RealInstance = Instance
Log("[Minecraft] 可能缺少前置版本 " & RealInstance.Name & ",找不到对应的 json 文件", LogLevel.Debug)
Log("[Minecraft] 可能缺少前置版本 " & RealInstance.Name & ",找不到对应的 json 文件", NotifyLevel.DebugModeOnly)
End If
'获取详细下载信息
If RealInstance.JsonObject("downloads") IsNot Nothing AndAlso RealInstance.JsonObject("downloads")("client") IsNot Nothing Then
@@ -1933,7 +1929,7 @@ OnLoaded:
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("artifact") IsNot Nothing Then
BasicArray.Add(New McLibToken With {
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("artifact")("url")),
.Url = If(Library("downloads")("artifact")("url"), RootUrl),
.LocalPath = If(Library("downloads")("artifact")("path") Is Nothing, McLibGet(Library("name"),
CustomMcFolder:=CustomMcFolder), CustomMcFolder & "libraries\" & Library("downloads")("artifact")("path").ToString.Replace("/", "\")),
.Size = Val(Library("downloads")("artifact")("size").ToString),
@@ -1947,24 +1943,26 @@ OnLoaded:
BasicArray.Add(New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .LocalPath = LocalPath, .Size = 0, .IsNatives = False, .SHA1 = Nothing})
End Try
ElseIf Library("natives")("windows") IsNot Nothing Then '有 Windows Natives
Dim NativeName As String = Library("natives")("windows")
Try
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("classifiers") IsNot Nothing AndAlso Library("downloads")("classifiers")("natives-windows") IsNot Nothing Then
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("classifiers") IsNot Nothing AndAlso Library("downloads")("classifiers")(NativeName) IsNot Nothing Then
Dim NativeData = Library("downloads")("classifiers")(NativeName)
BasicArray.Add(New McLibToken With {
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("classifiers")("natives-windows")("url")),
.LocalPath = If(Library("downloads")("classifiers")("natives-windows")("path") Is Nothing,
.Url = If(NativeData("url"), RootUrl),
.LocalPath = If(NativeData("path") Is Nothing,
McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").
Replace(".jar", "-" & NativeName & ".jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")),
$"{CustomMcFolder}libraries\{Library("downloads")("classifiers")("natives-windows")("path").ToString.Replace("/", "\")}"),
.Size = Val(Library("downloads")("classifiers")("natives-windows")("size").ToString),
$"{CustomMcFolder}libraries\{NativeData("path").ToString.Replace("/", "\")}"),
.Size = Val(NativeData("size").ToString),
.IsNatives = True,
.SHA1 = Library("downloads")("classifiers")("natives-windows")("sha1").ToString})
.SHA1 = NativeData("sha1").ToString})
Else
BasicArray.Add(
New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .Size = 0, .IsNatives = True, .SHA1 = Nothing,
.LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", $"-{Library("natives")("windows")}.jar").
Replace(".jar", $"-{NativeName}.jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32"))
})
End If
@@ -1973,7 +1971,7 @@ OnLoaded:
BasicArray.Add(
New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .Size = 0, .IsNatives = True, .SHA1 = Nothing,
.LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).
Replace(".jar", $"-{Library("natives")("windows")}.jar").
Replace(".jar", $"-{NativeName}.jar").
Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32"))
})
End Try
@@ -2026,7 +2024,7 @@ OnLoaded:
Dim MainJar As NetFile = DlClientJarGet(Instance, True)
If MainJar IsNot Nothing Then Result.Add(MainJar)
Catch ex As Exception
Log(ex, "版本缺失主 jar 文件所必须的信息", LogLevel.Developer)
Log(ex, "版本缺失主 jar 文件所必须的信息", NotifyLevel.DevelopOnly)
End Try
'Library 文件
@@ -2077,11 +2075,11 @@ OnLoaded:
'跳过校验
If ShouldIgnoreFileCheck(Instance) Then
Log("[Minecraft] 设置要求尽量忽略文件检查,这可能会保留有误的文件", LogLevel.Debug)
Log("[Minecraft] 设置要求尽量忽略文件检查,这可能会保留有误的文件", NotifyLevel.DebugModeOnly)
Result = Result.Where(
Function(f)
If File.Exists(f.LocalPath) Then
Log("[Minecraft] 跳过下载的支持库文件:" & f.LocalPath, LogLevel.Debug)
Log("[Minecraft] 跳过下载的支持库文件:" & f.LocalPath, NotifyLevel.DebugModeOnly)
Return False
Else
Return True
@@ -2101,7 +2099,7 @@ OnLoaded:
For Each Token As McLibToken In Libs
'检查器
Dim Checker As FileChecker
If Token.Name.ContainsF("labymod") Then
If Token.Name.ContainsIgnoreCase("labymod") Then
Checker = New FileChecker '不检查 LabyMod 的文件,它们提供的文件校验信息是错的(#3225)
Else
Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
@@ -2120,7 +2118,7 @@ OnLoaded:
End If
If Token.Url.Contains("maven") Then
Dim BmclapiUrl As String =
Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven").Replace("maven.neoforged.net/releases", "maven")
Token.Url.Replace(Token.Url.Substring(0, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven").Replace("maven.neoforged.net/releases", "maven")
If DlSourcePreferMojang Then
Urls.Add(BmclapiUrl) '官方源优先
Else
@@ -2130,8 +2128,8 @@ OnLoaded:
End If
If Token.LocalPath.Contains("transformer-discovery-service") Then
'Transformer 文件释放
If Not File.Exists(Token.LocalPath) Then WriteFile(Token.LocalPath, GetResources("Transformer"))
Log("[Download] 已自动释放 Transformer Discovery Service", LogLevel.Developer)
If Not File.Exists(Token.LocalPath) Then FileUtils.Write(Token.LocalPath, GetResources("Transformer"))
Log("[Download] 已自动释放 Transformer Discovery Service", NotifyLevel.DevelopOnly)
Continue For
ElseIf Token.LocalPath.Contains("optifine\OptiFine") Then
'OptiFine 主 Jar
@@ -2146,7 +2144,7 @@ OnLoaded:
Result.Add(New NetFile(Urls.Distinct, Token.LocalPath, Checker))
Next
'去重并返回
Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath)
Return Result.DistinctBy(Function(a) a.LocalPath).ToList
End Function
''' <summary>
''' 获取对应的支持库文件地址。
@@ -2253,7 +2251,7 @@ OnLoaded:
Public Hash As String
Public Overrides Function ToString() As String
Return GetString(Size) & " | " & LocalPath
Return FormatFileSize(Size) & " | " & LocalPath
End Function
End Structure
''' <summary>
@@ -2367,7 +2365,7 @@ OnLoaded:
End If
Catch ex As Exception
Log(ex, "Minecraft 更新提示发送失败(" & If(VersionName, "Nothing") & ")", LogLevel.Feedback)
Log(ex, "Minecraft 更新提示发送失败(" & If(VersionName, "Nothing") & ")", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -2459,7 +2457,7 @@ NextEntry:
End If
'打码当前登录的结果
Dim AccessToken As String = McLoginLoader.Output.AccessToken
If AccessToken IsNot Nothing AndAlso AccessToken.Length >= 10 AndAlso Raw.ContainsF(AccessToken, True) AndAlso
If AccessToken IsNot Nothing AndAlso AccessToken.Length >= 10 AndAlso Raw.ContainsIgnoreCase(AccessToken) AndAlso
McLoginLoader.Output.Uuid <> McLoginLoader.Output.AccessToken Then 'UUID 和 AccessToken 一样则不打码
Raw = Raw.Replace(AccessToken, Left(AccessToken, 5) & New String(FilterChar, AccessToken.Length - 10) & Right(AccessToken, 5))
End If
@@ -1,876 +0,0 @@
Imports System.IO.Compression
Public Module ModMod
Private Const LocalModCacheVersion As Integer = 13
Public Class McMod
#Region "基础"
''' <summary>
''' Mod 文件的地址。
''' </summary>
Public ReadOnly Path As String
Public Sub New(Path As String)
Me.Path = If(Path, "")
End Sub
''' <summary>
''' Mod 的完整路径,去除最后的 .disabled 和 .old。
''' </summary>
Public ReadOnly Property RawPath As String
Get
Return GetPathFromFullPath(Path) & RawFileName
End Get
End Property
''' <summary>
''' Mod 的完整文件名。
''' </summary>
Public ReadOnly Property FileName As String
Get
Return GetFileNameFromPath(Path)
End Get
End Property
''' <summary>
''' Mod 的完整文件名,去除最后的 .disabled 和 .old。
''' </summary>
Public ReadOnly Property RawFileName As String
Get
Return FileName.Replace(".disabled", "").Replace(".old", "")
End Get
End Property
''' <summary>
''' Mod 的状态。
''' </summary>
Public ReadOnly Property State As McModState
Get
If Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
Return McModState.Disabled
Else
Return McModState.Fine
End If
End Get
End Property
Public Enum McModState As Integer
Fine = 0
Disabled = 1
End Enum
#End Region
#Region "信息项"
''' <summary>
''' 当任何信息在初始化后更新时触发。
''' </summary>
Public Event OnUpdate(sender As McMod)
''' <summary>
''' Mod 的可读名称。
''' 可能为无扩展的文件名,但不会是 Nothing。
''' </summary>
Public Property DisplayName As String
Get
If _Name Is Nothing Then _Name = CompFile?.DisplayName
If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path)
Return _Name
End Get
Set(value As String)
If _Name Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso
value.Lower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
_Name = value
End If
End Set
End Property
Private _Name As String = Nothing
''' <summary>
''' Mod 的描述信息。
''' 可能为 Nothing。
''' </summary>
Public Property Description As String
Get
Return _Description
End Get
Set(value As String)
If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then
_Description = value.ToString.Trim(vbLf)
'优化显示:若以 [a-zA-Z0-9] 结尾,加上小数点句号
If _Description.Lower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "."
End If
End Set
End Property
Private _Description As String = Nothing
''' <summary>
''' Mod 的版本。
''' 不保证符合版本格式规范,且可能为 Nothing。
''' </summary>
Public Property Version As String
Get
If _Version Is Nothing Then _Version = CompFile?.Version
Return _Version
End Get
Set(value As String)
If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
If value IsNot Nothing AndAlso value.ContainsF("version", True) Then value = "version" '需要修改的标识
_Version = value
End Set
End Property
Public _Version As String = Nothing
#End Region
#Region "从 JAR 获取信息"
''' <summary>
''' 从 JAR 文件中获取 Mod 信息。
''' </summary>
Public Sub LoadMetadataFromJar()
Static IsLoaded As Boolean = False
If IsLoaded Then Return
IsLoaded = True
Dim Jar As ZipArchive = Nothing
Try
'基础可用性检查、打开 Jar 文件
If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径(" & If(Path, "null") & ")")
If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件(" & Path & ")")
Jar = New ZipArchive(New FileStream(Path, FileMode.Open, FileAccess.Read, FileShare.Read))
'信息获取
LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException
Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer)
Catch ex As Exception
Log(ex, "Mod 文件无法打开(" & Path & ")", LogLevel.Developer)
Finally
If Jar IsNot Nothing Then Jar.Dispose()
End Try
End Sub
Private Sub LoadMetadataFromJar(Jar As ZipArchive)
#Region "尝试使用 mcmod.info"
Try
'获取信息文件
Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info")
Dim InfoString As String = Nothing
If InfoEntry IsNot Nothing Then
InfoString = ReadFile(InfoEntry.Open())
If InfoString.Length < 15 Then InfoString = Nothing
End If
If InfoString Is Nothing Then Exit Try
'获取可用 Json 项
Dim InfoObject As JObject
Dim JsonObject = GetJson(InfoString)
If JsonObject.Type = JTokenType.Array Then
InfoObject = JsonObject(0)
Else
InfoObject = JsonObject("modList")(0)
End If
'从文件中获取 Mod 信息项
DisplayName = InfoObject("name")
Description = InfoObject("description")
Version = InfoObject("version")
Catch ex As Exception
Log(ex, "读取 mcmod.info 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 fabric.mod.json"
Try
'获取 fabric.mod.json 文件
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
Dim FabricText As String = Nothing
If FabricEntry IsNot Nothing Then
FabricText = ReadFile(FabricEntry.Open(), Encoding.UTF8)
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
End If
If FabricText Is Nothing Then Exit Try
Dim FabricObject As JObject = GetJson(FabricText)
GotFabric:
'从文件中获取 Mod 信息项
If FabricObject.ContainsKey("name") Then DisplayName = FabricObject("name")
If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fabric.mod.json 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 mods.toml"
Try
'获取 mods.toml 文件
Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml")
Dim TomlText As String = Nothing
If TomlEntry IsNot Nothing Then
TomlText = ReadFile(TomlEntry.Open())
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.Replace(vbCrLf, vbLf).Replace(vbCr, vbLf).Split(vbLf) '统一换行符
If Line.StartsWithF("#") Then '去除注释
Continue For
ElseIf Line.Contains("#") Then
Line = Line.Substring(0, Line.IndexOfF("#"))
End If
Line = Line.Trim(New Char() {" "c, " "c, " "c}) '去除头尾的空格
If Line.Any Then Lines.Add(Line) '去除空行
Next
'读取文件数据
Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))}
For i = 0 To Lines.Count - 1
Dim Line As String = Lines(i)
If Line.StartsWithF("[") AndAlso Line.EndsWithF("]") Then
'段落标记
Dim Header = Line.Trim("[]".ToCharArray)
TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object)))
ElseIf Line.Contains("=") Then
'字段标记
Dim Key As String = Line.Substring(0, Line.IndexOfF("=")).TrimEnd(New Char() {" "c, " "c, " "c})
Dim RawValue As String = Line.Substring(Line.IndexOfF("=") + 1).TrimStart(New Char() {" "c, " "c, " "c})
Dim Value As Object
If RawValue.StartsWithF("""") AndAlso RawValue.EndsWithF("""") Then
'单行字符串
Value = RawValue.Trim("""")
ElseIf RawValue.StartsWithF("'''") Then
'多行字符串
Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")}
If ValueLines(0).EndsWithF("'''") Then '把多行字符串按单行写法写的错误处理(#2732)
ValueLines(0) = ValueLines(0).TrimEnd("'")
Else
Do Until i >= Lines.Count - 1
i += 1
Dim ValueLine As String = Lines(i)
If ValueLine.EndsWithF("'''") Then
ValueLines.Add(ValueLine.TrimEnd("'"))
Exit Do
Else
ValueLines.Add(ValueLine)
End If
Loop
End If
Value = ValueLines.Join(vbLf).Trim(vbLf).Replace(vbLf, vbCrLf)
ElseIf RawValue.Lower = "true" OrElse RawValue.Lower = "false" Then
'布尔型
Value = (RawValue.Lower = "true")
ElseIf Val(RawValue).ToString = RawValue Then
'数字型
Value = Val(RawValue)
Else
'不知道是个啥玩意儿,直接存储
Value = RawValue
End If
TomlData.Last.Value(Key) = Value
Else
'不知道是个啥玩意儿
Exit Try
End If
Next
'从文件数据中获取信息
Dim ModEntry As Dictionary(Of String, Object) = Nothing
For Each TomlSubData In TomlData
If TomlSubData.Key = "mods" Then
ModEntry = TomlSubData.Value
Exit For
End If
Next
If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try
If ModEntry.ContainsKey("displayName") Then DisplayName = ModEntry("displayName")
If ModEntry.ContainsKey("description") Then Description = ModEntry("description")
If ModEntry.ContainsKey("version") Then Version = ModEntry("version")
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 mods.toml 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
#Region "尝试使用 fml_cache_annotation.json"
Try
'获取 fml_cache_annotation.json 文件
Dim FmlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/fml_cache_annotation.json")
Dim FmlText As String = Nothing
If FmlEntry IsNot Nothing Then
FmlText = ReadFile(FmlEntry.Open(), Encoding.UTF8)
If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing
End If
If FmlText Is Nothing Then Exit Try
Dim FmlJson As JObject = GetJson(FmlText)
'获取可用 Json 项
Dim FmlObject As JObject = Nothing
For Each ModFilePair In FmlJson
Dim ModFileAnnos As JArray = ModFilePair.Value("annotations")
If ModFileAnnos IsNot Nothing Then
'先获取 Mod
For Each ModFileAnno In ModFileAnnos
Dim Name As String = If(ModFileAnno("name"), "")
If Name = "Lnet/minecraftforge/fml/common/Mod;" Then
FmlObject = ModFileAnno("values")
GoTo Got
End If
Next
End If
Next
Exit Try
Got:
'从文件中获取 Mod 信息项
If FmlObject.ContainsKey("name") Then DisplayName = FmlObject("name")("value")
If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value")
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fml_cache_annotation.json 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try
#End Region
Return '没能成功获取任何信息
Finished:
#Region "将 Version 代号转换为 META-INF 中的版本"
If _Version = "version" Then
Try
Dim MetaEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/MANIFEST.MF")
If MetaEntry IsNot Nothing Then
Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":")
If MetaString.Contains("Implementation-Version:") Then
MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
Version = MetaString
End If
End If
Catch ex As Exception
Log("获取 META-INF 中的版本信息失败(" & Path & ")", LogLevel.Developer)
Version = Nothing
End Try
End If
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
#End Region
RaiseEvent OnUpdate(Me)
End Sub
#End Region
#Region "网络信息"
''' <summary>
''' 该 Mod 关联的网络项目。
''' </summary>
Public Property Comp As CompProject
Get
Return _Comp
End Get
Set(value As CompProject)
_Comp = value
RaiseEvent OnUpdate(Me)
End Set
End Property
Private _Comp As CompProject
''' <summary>
''' 本地文件对应的联网文件信息。
''' </summary>
Public CompFile As CompFile
''' <summary>
''' 该 Mod 对应的联网最新版本。
''' </summary>
Public Property UpdateFile As CompFile
Get
Return _UpdateFile
End Get
Set(value As CompFile)
_UpdateFile = value
RaiseEvent OnUpdate(Me)
End Set
End Property
Private _UpdateFile As CompFile
''' <summary>
''' 该 Mod 的更新日志网址。
''' </summary>
Public ChangelogUrls As New List(Of String)
''' <summary>
''' 所有网络信息是否已成功加载。
''' </summary>
Public CompLoaded As Boolean = False
''' <summary>
''' 将网络信息保存为 Json。
''' </summary>
Public Function ToJson() As JObject
Dim Json As New JObject
If Comp IsNot Nothing Then Json.Add("Comp", Comp.ToJson())
Json.Add("ChangelogUrls", New JArray(ChangelogUrls))
Json.Add("CompLoaded", CompLoaded)
If CompFile IsNot Nothing Then Json.Add("CompFile", CompFile.ToJson())
If UpdateFile IsNot Nothing Then Json.Add("UpdateFile", UpdateFile.ToJson())
Return Json
End Function
''' <summary>
''' 从 Json 中读取网络信息。
''' </summary>
Public Sub FromJson(Json As JObject)
CompLoaded = Json("CompLoaded")
If Json.ContainsKey("Comp") Then Comp = New CompProject(Json("Comp"))
If Json.ContainsKey("ChangelogUrls") Then ChangelogUrls = Json("ChangelogUrls").ToObject(Of List(Of String))
If Json.ContainsKey("CompFile") Then CompFile = New CompFile(Json("CompFile"), CompType.Mod)
If Json.ContainsKey("UpdateFile") Then UpdateFile = New CompFile(Json("UpdateFile"), CompType.Mod)
End Sub
''' <summary>
''' 该文件是否可以更新。
''' </summary>
Public ReadOnly Property CanUpdate As Boolean
Get
Return Not Settings.Get("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
End Get
End Property
''' <summary>
''' 获取用于 CurseForge 信息获取的 Hash 值(MurmurHash2)。
''' </summary>
Public ReadOnly Property CurseForgeHash As UInteger
Get
If _CurseForgeHash Is Nothing Then
'读取缓存
Dim Info As New FileInfo(Path)
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" AndAlso RegexCheck(Cached, "^\d+$") Then '#5062
_CurseForgeHash = Cached
Return _CurseForgeHash
End If
'读取文件
Dim data As New List(Of Byte)
For Each b As Byte In ReadFileBytes(Path)
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
data.Add(b)
Next
'计算 MurmurHash2
Dim length As Integer = data.Count
Dim h As UInteger = 1 Xor length '1 是种子
Dim i As Integer
For i = 0 To length - 4 Step 4
Dim k As UInteger = data(i) Or CUInt(data(i + 1)) << 8 Or CUInt(data(i + 2)) << 16 Or CUInt(data(i + 3)) << 24
k = (k * &H5BD1E995L) And &HFFFFFFFFL
k = k Xor (k >> 24)
k = (k * &H5BD1E995L) And &HFFFFFFFFL
h = (h * &H5BD1E995L) And &HFFFFFFFFL
h = h Xor k
Next
Select Case length - i
Case 3
h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
h = h Xor (CUInt(data(i + 2)) << 16)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
Case 2
h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
Case 1
h = h Xor data(i)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
End Select
h = h Xor (h >> 13)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
h = h Xor (h >> 15)
_CurseForgeHash = h
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, h.ToString)
End If
Return _CurseForgeHash
End Get
End Property
Private _CurseForgeHash As UInteger?
''' <summary>
''' 获取用于 Modrinth 信息获取的 Hash 值(SHA1)。
''' </summary>
Public ReadOnly Property ModrinthHash As String
Get
If _ModrinthHash Is Nothing Then
'读取缓存
Dim Info As New FileInfo(Path)
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-M")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" Then
_ModrinthHash = Cached
Return _ModrinthHash
End If
'计算 SHA1
_ModrinthHash = GetFileSHA1(Path)
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
End If
Return _ModrinthHash
End Get
End Property
Private _ModrinthHash As String
#End Region
#Region "API"
Public Overrides Function ToString() As String
Return $"{State} - {Path}"
End Function
Public Overrides Function Equals(obj As Object) As Boolean
Dim target = TryCast(obj, McMod)
Return target IsNot Nothing AndAlso Path = target.Path
End Function
#End Region
''' <summary>
''' 是否可能为前置 Mod。目前非常不准确。
''' </summary>
Public Function IsPresetMod() As Boolean
Return DisplayName IsNot Nothing AndAlso (DisplayName.Lower.Contains("core") OrElse DisplayName.Lower.Contains("lib"))
End Function
''' <summary>
''' 根据完整文件路径的文件扩展名判断是否为 Mod 文件。
''' </summary>
Public Shared Function IsModFile(Path As String)
If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
Path = Path.Lower
If Path.EndsWithF(".jar", True) OrElse Path.EndsWithF(".zip", True) OrElse Path.EndsWithF(".litemod", True) OrElse
Path.EndsWithF(".jar.disabled", True) OrElse Path.EndsWithF(".zip.disabled", True) OrElse Path.EndsWithF(".litemod.disabled", True) OrElse
Path.EndsWithF(".jar.old", True) OrElse Path.EndsWithF(".zip.old", True) OrElse Path.EndsWithF(".litemod.old", True) Then Return True
Return False
End Function
End Class
'加载 Mod 列表
Public McModLoader As New LoaderTask(Of String, List(Of McMod))("Mod List Loader", AddressOf McModLoad)
Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of McMod)))
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)
Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
If Loader.IsInterrupted Then Return
Thread.Sleep(100)
Loop
Finally
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在加载 Mod 列表")
End Try
FrmInstanceMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
End If
'获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo)
If Directory.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
'仅当 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
Continue For
End If
End If
If McMod.IsModFile(File.FullName) Then ModFileList.Add(File)
Next
End If
'获取本地文件缓存
Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
Dim Cache As New JObject
Try
Dim CacheContent As String = ReadFile(CachePath)
If Not String.IsNullOrWhiteSpace(CacheContent) Then
Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug)
Cache = New JObject
End If
End If
Catch ex As Exception
Log(ex, "读取本地 Mod 信息缓存失败,已重置")
Cache = New JObject
End Try
Cache("version") = LocalModCacheVersion
'加载 Mod 列表
Dim ModList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList
If Loader.IsInterrupted Then Return
Dim ModEntry As New McMod(ModFile.FullName)
Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName) '存在两个文件,名称相同,但一个启用一个禁用
If DumpMod IsNot Nothing Then
Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry)
Log($"[Mod] 重复的 Mod 文件:{DumpMod.FileName} 与 {ModEntry.FileName},已忽略 {DisabledMod.FileName}", LogLevel.Debug)
If DisabledMod Is ModEntry Then
Continue For
Else
ModList.Remove(DisabledMod)
End If
End If
ModList.Add(ModEntry)
Next
Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
'排序
ModList = ModList.OrderBy(Function(m) m.FileName).ToList
'回设
If Loader.IsInterrupted Then Return
Loader.Output = ModList
'开始联网加载
'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModList, Cache), IsForceRestart:=True)
Catch ex As Exception
Log(ex, "Mod 列表加载失败", LogLevel.Debug)
Throw
End Try
End Sub
'联网加载 Mod 详情
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As New List(Of McMod)
Dim Cache As JObject = Loader.Input.Value
'读取 Comp 缓存,获取需要更新的 Mod 列表
For Each ModEntry As McMod In Loader.Input.Key
If Loader.IsInterrupted Then Return
Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If
Mods.Add(ModEntry)
Next
Log($"[Mod] 有 {Mods.Where(Function(m) m.Comp Is Nothing).Count} 个 Mod 需要联网获取信息,{Mods.Where(Function(m) m.Comp IsNot Nothing).Count} 个 Mod 需要更新信息")
If Not Mods.Any Then
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForEach(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 VanillaVersion = TargetMcVersion.VanillaName
'开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{VanillaVersion}")
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim CurrentTaskThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
RunInNewThread(
Sub()
Try
'步骤 1:获取 Hash 与对应的工程 ID
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 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If ModrinthVersion.Count = 0 Then Return
Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
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 CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
ModrinthMapping(ProjectId).Add(Entry)
'记录对应的 CompFile
Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then
Entry.CompFile = File
Else
Entry.CompFile.Version = File.Version '使用来自 Modrinth 的版本号
End If
Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Return
Dim ModrinthProject As JArray = DlModRequest(
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]")
For Each ProjectJson In ModrinthProject
Dim Project As New CompProject(ProjectJson)
For Each Entry In ModrinthMapping(Project.Id)
Entry.Comp = Project
Next
Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息
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")
For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
If Not UpdateFile.Available Then Continue For
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 Modrinth 上的最新版为 {UpdateFile.FileName}")
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}")
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}"}
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader Modrinth")
'从 CurseForge 获取信息
RunInNewThread(
Sub()
Try
'步骤 1:获取 Hash 与对应的工程 ID
Dim CurseForgeHashes As New List(Of UInteger)
For Each Entry In Mods
CurseForgeHashes.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 的对应关系
If Not CurseForgeRaw.Any() Then Return
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of McMod))
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 CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
CurseForgeMapping(ProjectId).Add(Entry)
'记录对应的 CompFile
Dim File As New CompFile(Project("file"), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next
Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 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 McMod)) '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 CompProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
Entry.Comp = Entry.Comp '再次触发修改事件
Continue For
End If
Entry.Comp = Project
Next
'查找或许版本更新的文件列表
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 McMod)
UpdateFileIds(FileId).AddRange(CurseForgeMapping(Project.Id))
FileIdToProjectSlug(FileId) = Project.Slug
Next
End If
Next
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息
If Not UpdateFileIds.Any() Then Return
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 McMod, CompFile)
For Each FileJson In CurseForgeFiles
Dim File As New CompFile(FileJson, CompType.Mod)
If Not File.Available Then Continue For
For Each Entry As McMod 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 McMod = Pair.Key
Dim UpdateFile As CompFile = Pair.Value
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 CurseForge 上的最新版为 {UpdateFile.FileName}")
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}")
Entry.UpdateFile.DownloadUrls.AddRange(UpdateFile.DownloadUrls) '合并下载源
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate > Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}"}
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
Catch ex As Exception
Log(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).ForEach(Sub(m) m.LoadMetadataFromJar())
'等待线程结束
Do Until EndedThreadCount = 2
Thread.Sleep(10)
If Loader.IsInterrupted Then Return
Loop
'保存缓存
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Return
For Each Entry In Mods
Entry.CompLoaded = Not IsFailed
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = Entry.ToJson()
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
If Loader.IsInterrupted Then Return
If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else
RunInUi(Sub() FrmInstanceMod?.RefreshBars())
End If
End Sub
Public Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
If PageInstanceLeft.Instance.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageInstanceLeft.Instance.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageInstanceLeft.Instance.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If PageInstanceLeft.Instance.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Return ModLoaders
End Function
End Module
@@ -1,6 +1,4 @@
Imports System.IO.Compression
Public Module ModModpack
Public Module ModModpack
'触发整合包安装的外部接口
''' <summary>
@@ -15,7 +13,7 @@ Public Module ModModpack
ModpackInstall(File)
Catch ex As CancelledException
Catch ex As Exception
Log(ex, "手动安装整合包失败", LogLevel.Msgbox)
Log(ex, "手动安装整合包失败", NotifyLevel.MsgBox)
End Try
End Sub)
End Sub
@@ -251,8 +249,35 @@ Retry:
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray))
Task.Output = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & ModList.Join(",") & "]}", "application/json")("data")
'如果文件已被删除,则 API 会跳过那一项
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除,所以没法继续安装了,请向整合包作者反馈该问题")
If ModList.Count = Task.Output.Count Then Return
'如果文件已被删除,则 API 会跳过那一项,导致返回的列表数量小于请求的数量。后面的都是对此的错误处理。
'获取缺失的 fileId 列表
Dim MissingIds = ModList.Except(Task.Output.Select(Function(j) j("id").ToObject(Of Integer))).ToList
Log("[Modpack] 缺失的 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("、"))
'尝试获取对应的工程信息
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, "获取缺失的工程信息失败")
End Try
Dim MissingDesc As New List(Of String)
For Each Missing In Missings
Dim Project = Projects.FirstOrDefault(Function(p) p.Id = Missing.ProjectId)
If Project Is Nothing Then
MissingDesc.Add($"未知 CurseForge 项目 (项目 ID {Missing.ProjectId},文件 ID {Missing.FileId})")
Else
MissingDesc.Add($"{Project.TranslatedName} (文件 ID {Missing.FileId})")
End If
Next
If MyMsgBox($"未找到该整合包所需的以下内容,它们可能已被原作者删除:{vbCrLf}- {MissingDesc.Join(vbCrLf & "- ")}{vbCrLf}{vbCrLf}是否继续安装?缺失这些内容可能导致整合包出现异常!",
"整合包内容缺失", "继续", "取消", IsWarn:=True) = 2 Then
Task.Interrupt()
End If
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
'构造 NetFile
ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
@@ -269,23 +294,23 @@ Retry:
End If
End If
'根据 modules 和文件名后缀判断资源类型
Dim TargetFolder As String, Type As CompType
Dim TargetFolder As String, Type As ResourceTypes
If ModJson("modules").Any Then 'modules 可能返回 null(#1006)
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
ModJson?("FileName")?.ToString.EndsWithF(".jar", True) Then
TargetFolder = "mods" : Type = CompType.Mod
TargetFolder = "mods" : Type = ResourceTypes.Mod
ElseIf ModuleNames.Contains("pack.mcmeta") Then
TargetFolder = "resourcepacks" : Type = CompType.ResourcePack
TargetFolder = "resourcepacks" : Type = ResourceTypes.ResourcePack
Else
TargetFolder = "shaderpacks" : Type = CompType.Shader
TargetFolder = "shaderpacks" : Type = ResourceTypes.Shader
End If
Else
TargetFolder = "mods" : Type = CompType.Mod
TargetFolder = "mods" : Type = ResourceTypes.Mod
End If
'建立 CompFile
Dim File As New CompFile(ModJson, Type)
If Not File.Available Then Continue For
Dim File = ResourceVersion.FromPlatformJson(ModJson, Type)
If Not File.DownloadAvailable Then Continue For
'实际的添加
FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\"))
Task.Progress += 1 / (1 + ModList.Count)
@@ -330,7 +355,7 @@ Retry:
File.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
If File.Exists(FileAddress) AndAlso Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件:" & FileAddress)
File.Delete(FileAddress)
End If
@@ -425,11 +450,11 @@ Retry:
End Select
End If
'添加下载文件
Dim Urls = File("downloads").SelectMany(Function(t) CompFile.HandleCurseForgeDownloadUrls(t.ToString)).ToList
Dim Urls = File("downloads").SelectMany(Function(t) ResourceVersion.ParseCurseForgeDownloadUrls(t.ToString)).ToList
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = Urls.Distinct.ToList()
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then
If Not Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹,请向整合包作者反馈此问题!" & vbCrLf & "错误的文件:" & TargetPath, "文件路径校验失败", IsWarn:=True)
Throw New CancelledException
End If
@@ -471,7 +496,7 @@ Retry:
File.Delete(Target)
End If
Next
If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
If File.Exists(FileAddress) AndAlso Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件:" & FileAddress)
File.Delete(FileAddress)
End If
@@ -576,18 +601,18 @@ Retry:
Task, 0.4)
'读取 MMC 设置文件(#2655)
Try
Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
If File.Exists(MMCSetupFile) Then
Dim MmcSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
If File.Exists(MmcSetupFile) Then
'将其中的等号替换为冒号,以符合 ini 文件格式
Dim Lines As New List(Of String)
For Each Line In ReadFile(MMCSetupFile).Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
For Each Line In ReadFile(MmcSetupFile).Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries)
If Not Line.Contains("=") Then Continue For
Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
Next
WriteFile(MMCSetupFile, Lines.Join(vbCrLf))
FileUtils.Write(MmcSetupFile, Lines.Join(vbCrLf))
'读取文件
If ReadIni(MMCSetupFile, "OverrideCommands", False) Then
Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand")
If ReadIni(MmcSetupFile, "OverrideCommands", False) Then
Dim PreLaunchCommand As String = ReadIni(MmcSetupFile, "PreLaunchCommand")
If PreLaunchCommand <> "" Then
PreLaunchCommand = PreLaunchCommand.Replace("\""", """").
Replace("$INST_JAVA", "{java}javaw.exe").
@@ -598,16 +623,16 @@ Retry:
Log("[ModPack] 迁移 MultiMC 版本独立设置:启动前执行命令:" & PreLaunchCommand)
End If
End If
If ReadIni(MMCSetupFile, "JoinServerOnLaunch", False) Then
Dim ServerAddress As String = ReadIni(MMCSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """")
If ReadIni(MmcSetupFile, "JoinServerOnLaunch", False) Then
Dim ServerAddress As String = ReadIni(MmcSetupFile, "JoinServerOnLaunchAddress").Replace("\""", """")
WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
Log("[ModPack] 迁移 MultiMC 版本独立设置:自动进入服务器:" & ServerAddress)
End If
If ReadIni(MMCSetupFile, "IgnoreJavaCompatibility", False) Then
If ReadIni(MmcSetupFile, "IgnoreJavaCompatibility", False) Then
WriteIni(SetupFile, "VersionAdvanceJava", True)
Log("[ModPack] 迁移 MultiMC 版本独立设置:忽略 Java 兼容性警告")
End If
Dim Logo As String = ReadIni(MMCSetupFile, "iconKey", "")
Dim Logo As String = ReadIni(MmcSetupFile, "iconKey", "")
If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True)
WriteIni(SetupFile, "Logo", "PCL\Logo.png")
@@ -615,9 +640,9 @@ Retry:
Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)")
End If
'JVM 参数
Dim JvmArgs As String = ReadIni(MMCSetupFile, "JvmArgs", "")
Dim JvmArgs As String = ReadIni(MmcSetupFile, "JvmArgs", "")
If JvmArgs <> "" Then
If ReadIni(MMCSetupFile, "OverrideJavaArgs", False) Then
If ReadIni(MmcSetupFile, "OverrideJavaArgs", False) Then
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(覆盖):" & JvmArgs)
Else
@@ -770,6 +795,7 @@ Retry:
New LoaderTask(Of String, Integer)("解压压缩包",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.9)
OpenExplorer(TargetFolder)
Thread.Sleep(400) '避免文件争用
'查找解压后的 exe 文件
Dim Launcher As String = Nothing
@@ -779,7 +805,7 @@ Retry:
If Info.ProductName = "Plain Craft Launcher" Then
Launcher = ExeFile
Log($"[Modpack] 发现整合包附带的 PCL 启动器:{ExeFile}")
ElseIf (Info.ProductName.ContainsF("Launcher", True) OrElse Info.ProductName.ContainsF("启动", True)) AndAlso
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
@@ -792,7 +818,6 @@ Retry:
If Launcher IsNot Nothing Then
Log("[Modpack] 找到压缩包中附带的启动器:" & Launcher)
If MyMsgBox($"整合包里似乎自带了启动器,是否换用它继续安装?{vbCrLf}即将打开:{Launcher}", "换用整合包启动器?", "换用", "不换用") = 1 Then
OpenExplorer(TargetFolder)
StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出
Log("[Modpack] 为换用整合包中的启动器启动,强制结束程序")
FrmMain.EndProgram(False)
@@ -801,10 +826,9 @@ Retry:
Else
Log("[Modpack] 未找到压缩包中附带的启动器")
End If
OpenExplorer(TargetFolder)
'加入文件夹列表
Dim InstanceName As String = GetFolderNameFromPath(TargetFolder)
Directory.CreateDirectory(TargetFolder & ".minecraft\")
DirectoryUtils.Create(TargetFolder & ".minecraft\")
PageSelectLeft.AddFolder(
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
InstanceName, False)
@@ -105,7 +105,7 @@
Loop
WatcherLog("Minecraft 日志监控已退出")
Catch ex As Exception
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
Log(ex, "Minecraft 日志监控主循环出错", NotifyLevel.MsgBoxAndFeedback)
State = MinecraftState.Ended
End Try
End Sub, "Minecraft Watcher PID " & PID)
@@ -174,14 +174,14 @@
End If
End If
Catch ex As Exception
Log(ex, "输出 Minecraft 日志失败", LogLevel.Feedback)
Log(ex, "输出 Minecraft 日志失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Public LatestLog As New Queue(Of String)
Private Sub GameLog(Text As String)
'预处理
If Text Is Nothing Then Return
Text = Text.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf)
Text = Text.ReplaceLineEndings(vbCrLf)
'If Text.Contains("�����") Then Hint("检测到错误的日志编码:" & Text)
'加入预存储
LatestLog.Enqueue(Text)
@@ -194,7 +194,7 @@
If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then
WatcherLog("日志 2/5:游戏用户已设置") '仅确保支持 Minecraft 1.7+
LogProgress = 2
ElseIf LogProgress < 3 AndAlso Text.ContainsF("lwjgl version", True) Then
ElseIf LogProgress < 3 AndAlso Text.ContainsIgnoreCase("lwjgl version") Then
WatcherLog("日志 3/5:LWJGL 版本已确认")
LogProgress = 3
ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then
@@ -265,7 +265,7 @@
MinecraftWindow = TryGetMinecraftWindow()
Catch ex As ComponentModel.Win32Exception
'拒绝访问(#1062)
Log(ex, "由于反作弊或安全软件拦截,PCL 无法操作游戏窗口", LogLevel.Hint)
Log(ex, "由于反作弊或安全软件拦截,PCL 无法操作游戏窗口", NotifyLevel.AllUsers)
IsWindowFinished = True
End Try
If MinecraftWindow Is Nothing Then Return
@@ -297,7 +297,7 @@
End If
IsWindowAppeared = True
Catch ex As Exception
Log(ex, "检查 Minecraft 窗口失败", LogLevel.Feedback)
Log(ex, "检查 Minecraft 窗口失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
''' <summary>
@@ -361,9 +361,9 @@
Analyzer.Prepare()
Analyzer.Analyze()
Analyzer.Output(False, New List(Of String) From
{Instance.PathVersion & Instance.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
{Instance.PathVersion & Instance.Name & ".json", PathExeFolder & "PCL\Log1.txt", PathExeFolder & "PCL\LatestLaunch.bat"})
Catch ex As Exception
Log(ex, "崩溃分析失败", LogLevel.Feedback)
Log(ex, "崩溃分析失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub, "Crash Analyzer")
End Sub
@@ -376,7 +376,7 @@
If Not GameProcess.HasExited Then GameProcess.Kill()
WatcherLog("已强制结束 Minecraft 进程")
Catch ex As Exception
Log(ex, "强制结束 Minecraft 进程失败", LogLevel.Hint)
Log(ex, "强制结束 Minecraft 进程失败", NotifyLevel.AllUsers)
End Try
End Sub
+3 -5
View File
@@ -1,8 +1,6 @@
Public Module ModDevelop
Public Class ModDevelop
#If DEBUG Then
Public Sub Start()
Public Shared Sub Start()
End Sub
#End If
End Module
End Class
+12 -12
View File
@@ -186,7 +186,7 @@ Public Class CustomEvent
MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
Return
End If
Hint("正在开启中,请稍候:" & Arg)
Hint("正在开启,请稍候:" & Arg)
RunInThread(Sub() OpenWebsite(Arg))
Case EventType.打开文件, EventType.打开帮助, EventType.执行命令
@@ -210,7 +210,7 @@ Public Class CustomEvent
StartProcess(Info)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
Log(ex, "执行打开类自定义事件失败", NotifyLevel.MsgBox)
End Try
End Sub)
@@ -267,12 +267,12 @@ Public Class CustomEvent
MyMsgBox(Args(1).Replace("\n", vbCrLf), Args(0).Replace("\n", vbCrLf), If(Args.Length > 2, Args(2), "确定"))
Case EventType.弹出提示
Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, Args(1).ParseToEnum(Of HintType)))
Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, Args(1).ToEnum(Of HintType)))
Case EventType.切换页面
RunInUi(Sub() FrmMain.PageChange(
Args(0).ParseToEnum(Of FormMain.PageType),
If(Args.Length = 1, FormMain.PageSubType.Default, Args(1).ParseToEnum(Of FormMain.PageSubType))))
Args(0).ToEnum(Of FormMain.PageType),
If(Args.Length = 1, FormMain.PageSubType.Default, Args(1).ToEnum(Of FormMain.PageSubType))))
Case EventType.导入整合包, EventType.安装整合包
RunInUi(Sub() ModpackInstall())
@@ -328,7 +328,7 @@ Public Class CustomEvent
MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
End Select
Catch ex As Exception
Log(ex, $"事件执行失败({Type}, {Arg})", LogLevel.Msgbox)
Log(ex, $"事件执行失败({Type}, {Arg})", NotifyLevel.MsgBox)
End Try
End Sub
@@ -372,20 +372,20 @@ Public Class CustomEvent
RelativeUrl = RelativeUrl.Replace("/", "\").Lower.TrimStart("\")
'确认实际路径
Dim Location As String, WorkingDir As String = Path & "PCL"
Dim Location As String, WorkingDir As String = PathExeFolder & "PCL"
HelpTryExtract()
If RelativeUrl.Contains(":\") Then
'绝对路径
Location = RelativeUrl
Log("[Control] 自定义事件中由绝对路径" & Type & ":" & Location)
ElseIf File.Exists(Path & "PCL\" & RelativeUrl) Then
ElseIf File.Exists(PathExeFolder & "PCL\" & RelativeUrl) Then
'相对 PCL 文件夹的路径
Location = Path & "PCL\" & RelativeUrl
Location = PathExeFolder & "PCL\" & RelativeUrl
Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & Type & ":" & Location)
ElseIf File.Exists(Path & "PCL\Help\" & RelativeUrl) Then
ElseIf File.Exists(PathExeFolder & "PCL\Help\" & RelativeUrl) Then
'相对 PCL 本地帮助文件夹的路径
Location = Path & "PCL\Help\" & RelativeUrl
WorkingDir = Path & "PCL\Help\"
Location = PathExeFolder & "PCL\Help\" & RelativeUrl
WorkingDir = PathExeFolder & "PCL\Help\"
Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & Type & ":" & Location)
ElseIf Type = EventType.打开帮助 AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
'相对 PCL 自带帮助文件夹的路径
+43 -41
View File
@@ -23,12 +23,12 @@ Public Module ModMain
''' <summary>
''' 等待弹出的提示列表。以 {String, HintType, Log As Boolean} 形式存储为数组。
''' </summary>
Private HintWaiting As SafeList(Of HintMessage) = If(HintWaiting, New SafeList(Of HintMessage))
Private HintWaiting As ConcurrentList(Of HintMessage) = If(HintWaiting, New ConcurrentList(Of HintMessage))
''' <summary>
''' 在窗口左下角弹出提示文本。
''' </summary>
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Blue, Optional Log As Boolean = True)
If HintWaiting Is Nothing Then HintWaiting = New SafeList(Of HintMessage)
If HintWaiting Is Nothing Then HintWaiting = New ConcurrentList(Of HintMessage)
HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
End Sub
@@ -45,7 +45,7 @@ Public Module ModMain
'End If
Dim CurrentHint = HintWaiting(0)
'去回车
CurrentHint.Text = CurrentHint.Text.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
CurrentHint.Text = CurrentHint.Text.ReplaceLineEndings(" ", mergeMultiple:=True)
'超量提示直接忽略
If FrmMain.PanHint.Children.Count >= 20 Then GoTo EndHint
'检查是否有重复提示
@@ -71,7 +71,7 @@ Public Module ModMain
'有重复提示,且该提示的进入动画已播放
If Not AniIsRun("Hint Show " & DoubleStack.Tag(1)) Then
AniStop("Hint Hide " & DoubleStack.Tag(1))
Dim Delay As Double = (800 + MathClamp(CurrentHint.Text.Length, 5, 23) * 180) * AniSpeed
Dim Delay As Double = (800 + CurrentHint.Text.Length.Clamp(5, 23) * 180) * AniSpeed
AniStart({
AaX(DoubleStack, -12 - DoubleStack.Margin.Left, 50,, New AniEaseOutFluent),
AaX(DoubleStack, -8, 50, 50, New AniEaseInFluent),
@@ -122,7 +122,7 @@ Public Module ModMain
})
AniStart(Animations, "Hint Show " & NewHintControl.Tag(1))
'结束动画
Dim Delay As Double = (800 + MathClamp(CurrentHint.Text.Length, 5, 23) * 180) * AniSpeed
Dim Delay As Double = (800 + CurrentHint.Text.Length.Clamp(5, 23) * 180) * AniSpeed
AniStart({
AaX(NewHintControl, -50, 200, Delay, New AniEaseInFluent),
AaOpacity(NewHintControl, -1, 150, Delay),
@@ -137,7 +137,7 @@ EndHint:
HintWaiting.RemoveAt(0)
Loop
Catch ex As Exception
Log(ex, "显示弹出提示失败", LogLevel.Normal)
Log(ex, "显示弹出提示失败", NotifyLevel.Silent)
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, LogLevel.Debug)
Log("[Control] 主窗体加载完成前出现意料外的等待弹窗:" & Button1 & "," & Button2 & "," & Button3, NotifyLevel.DebugModeOnly)
Else
Try
FrmMain.DragStop()
@@ -285,9 +285,9 @@ EndHint:
''' <param name="Button1">显示的第一个按钮,默认为“确定”。</param>
''' <param name="Button2">显示的第二个按钮,默认为“取消”。</param>
''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
Public Function MyMsgBoxInput(Title As String, Optional Text As String = "", Optional DefaultInput As String = "", Optional ValidateRules As ObjectModel.Collection(Of Validate) = Nothing, Optional HintText As String = "", Optional Button1 As String = "确定", Optional Button2 As String = "取消", Optional IsWarn As Boolean = False) As String
Public Function MyMsgBoxInput(Title As String, Optional Text As String = Nothing, Optional DefaultInput As String = Nothing, Optional ValidateRules As ObjectModel.Collection(Of Validate) = Nothing, Optional HintText As String = "", Optional Button1 As String = "确定", Optional Button2 As String = "取消", Optional IsWarn As Boolean = False) As String
'将弹窗列入队列
Dim Converter As New MyMsgBoxConverter With {.Text = Text, .HintText = HintText, .Type = MyMsgBoxType.Input, .ValidateRules = If(ValidateRules, New ObjectModel.Collection(Of Validate)), .Button1 = Button1, .Button2 = Button2, .Content = DefaultInput, .IsWarn = IsWarn, .Title = Title}
Dim Converter As New MyMsgBoxConverter With {.Text = If(Text, ""), .HintText = If(HintText, ""), .Type = MyMsgBoxType.Input, .ValidateRules = If(ValidateRules, New ObjectModel.Collection(Of Validate)), .Button1 = Button1, .Button2 = Button2, .Content = DefaultInput, .IsWarn = IsWarn, .Title = Title}
WaitingMyMsgBox.Add(Converter)
'虽然我也不知道这是啥但是能用就成了 :)
Try
@@ -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, "处理等待中的弹窗失败", LogLevel.Feedback)
Log(ex, "处理等待中的弹窗失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -418,7 +418,7 @@ EndHint:
Public FrmInstanceExport As PageInstanceExport
'资源信息分页声明
Public FrmDownloadCompDetail As PageDownloadCompDetail
Public FrmDownloadResourceDetail As PageDownloadResourceDetail
#End Region
@@ -488,7 +488,7 @@ EndHint:
''' </summary>
Public Sub New(FilePath As String)
RawPath = FilePath
Dim JsonData As JObject = GetJson(ArgumentReplace(ReadFile(FilePath), AddressOf EscapeXML))
Dim JsonData As JObject = GetJson(ArgumentReplace(ReadFile(FilePath), AddressOf EscapeUtils.XmlEscape))
If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, FilePath)
'加载常规信息
If JsonData("Title") IsNot Nothing Then
@@ -577,8 +577,8 @@ EndHint:
Try
Dim IgnoreList As New List(Of String)
'读取自定义文件
If Directory.Exists(Path & "PCL\Help\") Then
For Each File In EnumerateFiles(Path & "PCL\Help\")
If Directory.Exists(PathExeFolder & "PCL\Help\") Then
For Each File In EnumerateFiles(PathExeFolder & "PCL\Help\")
Select Case File.Extension.Lower
Case ".helpignore"
'加载忽略列表
@@ -612,7 +612,7 @@ NextFile:
Next
Log("[Help] 已扫描缓存文件夹下的帮助文件,目前总计 " & FileList.Count & " 条")
Catch ex As Exception
Log(ex, "检查帮助文件夹失败", LogLevel.Msgbox)
Log(ex, "检查帮助文件夹失败", NotifyLevel.MsgBox)
End Try
If Loader.IsInterrupted Then Return
@@ -624,7 +624,7 @@ NextFile:
Dict.Add(Entry)
If ModeDebug Then Log("[Help] 已加载的帮助条目:" & Entry.Title & " ← " & FilePath)
Catch ex As Exception
Log(ex, "初始化帮助条目失败(" & FilePath & ")", LogLevel.Msgbox)
Log(ex, "初始化帮助条目失败(" & FilePath & ")", NotifyLevel.MsgBox)
End Try
Next
@@ -645,11 +645,11 @@ NextFile:
Public Sub HelpTryExtract()
If Settings.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
DeleteDirectory(PathTemp & "Help")
Directory.CreateDirectory(PathTemp & "Help")
WriteFile(PathTemp & "Cache\Help.zip", GetResources("Help"))
DirectoryUtils.Create(PathTemp & "Help")
FileUtils.Write(PathTemp & "Cache\Help.zip", GetResources("Help"))
ExtractCompressedFile(PathTemp & "Cache\Help.zip", PathTemp & "Help")
Settings.Set("SystemHelpVersion", VersionCode)
Log("[Help] 已解压内置帮助文件,目前状态:" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug)
Log("[Help] 已解压内置帮助文件,目前状态:" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), NotifyLevel.DebugModeOnly)
End If
End Sub
@@ -754,8 +754,8 @@ NextFile:
FrmLaunchLeft.AprilPosTrans.X += Speed.X
FrmLaunchLeft.AprilPosTrans.Y += Speed.Y
'大小改变
FrmLaunchLeft.AprilScaleTrans.ScaleX = MathClamp(1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160), 0.2, 1.8)
FrmLaunchLeft.AprilScaleTrans.ScaleY = MathClamp(1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100), 0.2, 1.8)
FrmLaunchLeft.AprilScaleTrans.ScaleX = (1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160)).Clamp(0.2, 1.8)
FrmLaunchLeft.AprilScaleTrans.ScaleY = (1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100)).Clamp(0.2, 1.8)
'放弃提示
Static GiveUpDistance As Double = -1500
GiveUpDistance += SpeedValue
@@ -774,7 +774,7 @@ NextFile:
End If
Catch ex As Exception
Log(ex, "愚人节移动出错", LogLevel.Feedback)
Log(ex, "愚人节移动出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -790,7 +790,7 @@ NextFile:
PostMessage(Handle, 400 * 16 + 2, 0, 0)
SetForegroundWindow(Handle) '不在这里放不行,神秘 WinAPI,建议别动
Catch ex As Exception
Log(ex, "设置窗口置顶失败", LogLevel.Hint)
Log(ex, "设置窗口置顶失败", NotifyLevel.AllUsers)
End Try
End Sub
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ClassName As String, WindowName As String) As IntPtr
@@ -828,24 +828,26 @@ NextFile:
''' 对替换标记进行处理。会对替换内容使用 EscapeHandler 进行转义。
''' </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 Nothing
'预处理
If Text Is Nothing Then Return Nothing
Dim Replacer =
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 = ShortenPath(s)
If s.Contains(":\") Then s = FileUtils.ShortenPath(s)
Return EscapeHandler(s)
End Function
'基础
Text = Text.Replace("{pcl_version}", Replacer(VersionBaseName))
Text = Text.Replace("{pcl_version_code}", Replacer(VersionCode))
Text = Text.Replace("{pcl_version_branch}", Replacer(VersionBranchName))
Text = Text.Replace("{pcl_version_branch}", Replacer(BuildTypeDisplay))
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(Path))
Text = Text.Replace("{path_with_name}", Replacer(PathWithName))
Text = Text.Replace("{path}", Replacer(PathExeFolder))
Text = Text.Replace("{path_with_name}", Replacer(PathExe))
Text = Text.Replace("{path_temp}", Replacer(PathTemp))
Text = Text.ReplaceOnDemand("{pcl_md5}", Function() Replacer(GetFileMD5(PathExe)))
'时间
If ReplaceTime Then '在窗口标题中,时间会被后续动态替换,所以此时不应该替换
Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy'/'M'/'d")))
@@ -889,11 +891,11 @@ NextFile:
Text = Text.Replace("{login}", Replacer(Nothing))
End If
'高级
Text = Text.RegexReplaceEach("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
Text = Text.RegexReplaceEach("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave()))
Text = Text.RegexReplaceEach("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Settings.GetSafe(m.Groups(1).Value, McInstanceSelected)))
Text = Text.RegexReplaceEach("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Text = Text.RegexReplaceEach("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Text = Text.RegexReplace("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
Text = Text.RegexReplace("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave()))
Text = Text.RegexReplace("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Settings.GetSafe(m.Groups(1).Value, McInstanceSelected)))
Text = Text.RegexReplace("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Text = Text.RegexReplace("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Return Text
End Function
@@ -941,14 +943,14 @@ NextFile:
Try
ResultFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
If RequireNonSpace AndAlso ResultFolder.Contains(" ") Then Exit Try '带空格
Directory.CreateDirectory(ResultFolder)
DirectoryUtils.Create(ResultFolder)
CheckPermissionWithException(ResultFolder)
Return ResultFolder
Catch
End Try
'使用备用路径
ResultFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
Directory.CreateDirectory(ResultFolder)
DirectoryUtils.Create(ResultFolder)
CheckPermission(ResultFolder)
Return ResultFolder
End Function
@@ -968,7 +970,7 @@ NextFile:
If ThemeDontClick = 2 Then ThemeRefresh()
#End Region
Catch ex As Exception
Log(ex, "短程主时钟执行异常", LogLevel.Critical)
Log(ex, "短程主时钟执行异常", NotifyLevel.Critical)
End Try
Timer4Count += 1
If Timer4Count = 4 Then
@@ -978,7 +980,7 @@ NextFile:
If ThemeNow = 12 Then ThemeRefresh()
#End Region
Catch ex As Exception
Log(ex, "中程主时钟执行异常", LogLevel.Debug)
Log(ex, "中程主时钟执行异常", NotifyLevel.DebugModeOnly)
End Try
End If
Timer150Count += 1
@@ -997,7 +999,7 @@ NextFile:
End Sub)
#End Region
Catch ex As Exception
Log(ex, "长程主时钟执行异常", LogLevel.Critical)
Log(ex, "长程主时钟执行异常", NotifyLevel.Critical)
End Try
End If
End Sub
@@ -1010,7 +1012,7 @@ NextFile:
Thread.Sleep(50 * 0.98)
Loop
Catch ex As Exception
Log(ex, "程序主时钟出错", LogLevel.Feedback)
Log(ex, "程序主时钟出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub, "Timer Main")
If Not IsAprilEnabled Then Return
@@ -1026,7 +1028,7 @@ NextFile:
Thread.Sleep(1)
Loop
Catch ex As Exception
Log(ex, "愚人节主时钟出错", LogLevel.Feedback)
Log(ex, "愚人节主时钟出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub, "Timer Main Fool")
End Sub
+26 -22
View File
@@ -1,4 +1,6 @@
Public Module ModMusic
Imports NAudio.Wave
Public Module ModMusic
#Region "播放列表"
@@ -21,8 +23,8 @@
'初始化全部可用音乐列表
If MusicAllList Is Nothing Then
MusicAllList = New List(Of String)
Directory.CreateDirectory(Path & "PCL\Musics\")
For Each File In EnumerateFiles(Path & "PCL\Musics\")
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\")
For Each File In EnumerateFiles(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
@@ -37,7 +39,7 @@
MusicWaitingList.Add(PreventFirst)
End If
Catch ex As Exception
Log(ex, "初始化音乐列表失败", LogLevel.Feedback)
Log(ex, "初始化音乐列表失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
''' <summary>
@@ -79,7 +81,7 @@
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
ToolTipText = "已暂停:" & IO.Path.GetFileNameWithoutExtension(MusicCurrent)
ToolTipText = "已暂停:" & Path.GetFileNameWithoutExtension(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
Else
@@ -88,7 +90,7 @@
Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
ToolTipText = "正在播放:" & IO.Path.GetFileNameWithoutExtension(MusicCurrent)
ToolTipText = "正在播放:" & Path.GetFileNameWithoutExtension(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
Else
@@ -101,7 +103,7 @@
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
Catch ex As Exception
Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
Log(ex, "刷新背景音乐 UI 失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub)
End Sub
@@ -119,7 +121,7 @@
Case MusicStates.Play
MusicPause()
Case Else
Log("[Music] 音乐目前为停止状态,已强制尝试开始播放", LogLevel.Debug)
Log("[Music] 音乐目前为停止状态,已强制尝试开始播放", NotifyLevel.DebugModeOnly)
MusicRefreshPlay(False)
End Select
End If
@@ -155,9 +157,9 @@
Get
If MusicNAudio Is Nothing Then Return MusicStates.Stop
Select Case MusicNAudio.PlaybackState
Case 0 'NAudio.Wave.PlaybackState.Stopped
Case 0 'PlaybackState.Stopped
Return MusicStates.Stop
Case 2 'NAudio.Wave.PlaybackState.Paused
Case 2 'PlaybackState.Paused
Return MusicStates.Pause
Case Else
Return MusicStates.Play
@@ -202,7 +204,7 @@
MusicRefreshUI()
Catch ex As Exception
Log(ex, "刷新背景音乐播放失败", LogLevel.Feedback)
Log(ex, "刷新背景音乐播放失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
''' <summary>
@@ -260,7 +262,7 @@
#End Region
''' <summary>
''' 当前正在播放的 NAudio.Wave.WaveOutEvent。
''' 当前正在播放的 WaveOutEvent。
''' 如果为它赋了类别,则会没有必要地加载 NAudio.dll。
''' </summary>
Public MusicNAudio = Nothing
@@ -273,18 +275,18 @@
''' 在 MusicUuid 不变的前提下,持续播放某地址的音乐,且在播放结束后随机播放下一曲。
''' </summary>
Private Sub MusicLoop(Optional IsFirstLoad As Boolean = False)
Dim CurrentWave As NAudio.Wave.WaveOutEvent = Nothing
Dim Reader As NAudio.Wave.WaveStream = Nothing
Dim CurrentWave As WaveOutEvent = Nothing
Dim Reader As WaveStream = Nothing
Try
'开始播放
CurrentWave = New NAudio.Wave.WaveOutEvent()
CurrentWave = New WaveOutEvent()
MusicNAudio = CurrentWave
CurrentWave.DeviceNumber = -1
Try
Reader = New NAudio.Wave.AudioFileReader(MusicCurrent)
Reader = New AudioFileReader(MusicCurrent)
Catch ex As Exception
Log(ex, "使用 AudioFileReader 加载音频文件失败,换用 MediaFoundationReader 重试", LogLevel.Developer)
Reader = New NAudio.Wave.MediaFoundationReader(MusicCurrent)
Log(ex, "使用 AudioFileReader 加载音频文件失败,换用 MediaFoundationReader 重试", NotifyLevel.DevelopOnly)
Reader = New MediaFoundationReader(MusicCurrent)
End Try
CurrentWave.Init(Reader)
CurrentWave.Play()
@@ -293,11 +295,13 @@
MusicRefreshUI()
'停止条件:播放完毕或变化
Dim PreviousVolume = 0
While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped
While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = PlaybackState.Stopped
If Settings.Get("UiMusicVolume") <> PreviousVolume Then
'更新音量
PreviousVolume = Settings.Get("UiMusicVolume")
#Disable Warning BC40008 '类型或成员已过时
CurrentWave.Volume = PreviousVolume / 1000
#Enable Warning BC40008 '类型或成员已过时
End If
'更新进度条
Dim Percent = Reader.CurrentTime.TotalMilliseconds / Reader.TotalTime.TotalMilliseconds
@@ -305,9 +309,9 @@
Thread.Sleep(100)
End While
'当前音乐已播放结束,继续下一曲
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
If CurrentWave.PlaybackState = PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception
Log(ex, "播放音乐出现内部错误(" & MusicCurrent & ")", LogLevel.Developer)
Log(ex, "播放音乐出现内部错误(" & MusicCurrent & ")", NotifyLevel.DevelopOnly)
If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then
Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL,才能恢复音乐播放功能!", HintType.Red)
Thread.Sleep(1000000000)
@@ -320,7 +324,7 @@
ex.Message.Contains("0xC00D36C4") Then '#5096:不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Red)
Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", NotifyLevel.AllUsers)
End If
'将播放错误的音乐从列表中移除
MusicAllList.Remove(MusicCurrent)
+35 -74
View File
@@ -4,8 +4,6 @@ Imports System.Security.Cryptography
Friend Module ModSecret
#Region "杂项"
'标注 PCL 的不同分支,仅用于替换标记
Public Const VersionBranchMain As String = "OpenSource"
'在开源版的注册表与常规版的注册表隔离,以防数据冲突
@@ -17,53 +15,6 @@ Friend Module ModSecret
'用于匿名数据收集的腾讯云日志服务上报 URL,形如 https://{region}.cls.tencentcs.com/track?topic_id={topic_id}
Public Const ClsBaseUrl As String = ""
Friend Sub SecretOnApplicationStart()
'提升 UI 线程优先级
Thread.CurrentThread.Priority = ThreadPriority.Highest
'确保 .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
Directory.CreateDirectory(Path & "PCL")
Catch ex As Exception
MsgBox($"PCL 无法创建 PCL 文件夹({Path & "PCL"}),请尝试:" & vbCrLf &
"1. 将 PCL 移动到其他文件夹" & If(Path.StartsWithF("C:", True), ",例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
"2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误")
Environment.[Exit](ProcessReturnValues.Cancel)
End Try
If Not CheckPermission(Path & "PCL") Then
MsgBox("PCL 没有对当前文件夹的写入权限,请尝试:" & vbCrLf &
"1. 将 PCL 移动到其他文件夹" & If(Path.StartsWithF("C:", True), ",例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
"2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误")
Environment.[Exit](ProcessReturnValues.Cancel)
End If
'开源版本提示
MyMsgBox($"该版本中无法使用以下特性:
- CurseForge API 调用:需要你自行申请 API Key,然后添加到 ModSecret.vb 的开头
- 正版登录:需要你自行申请 Client ID,然后添加到 ModSecret.vb 的开头
- 更新与联网通知:避免滥用隐患
- 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……
- 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了", "开源版本说明")
End Sub
''' <summary>
''' 获取设备标识码。
''' </summary>
Friend Function SecretGetIdentify() As String
Return "0000-0000-0000-0000"
End Function
#End Region
#Region "网络鉴权"
Friend Function SecretCdnSign(UrlWithMark As String) As String
@@ -78,9 +29,9 @@ Friend Module ModSecret
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
Req.Headers.Add("User-Agent", "LogStatistic") '#4951
ElseIf SimulateBrowserHeaders Then
Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{VersionBranchCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{CInt(BuildType)} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
Else
Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{VersionBranchCode}")
Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{CInt(BuildType)}")
End If
End If
If Not SimulateBrowserHeaders Then Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
@@ -157,7 +108,7 @@ Friend Module ModSecret
Public ColorSemiTransparent As New MyColor(1, Color8)
Public ThemeNow As Integer = -1
Public ColorHue As Integer = 210, ColorSat As Integer = 85, ColorLightAdjust As Integer = 0, ColorHueTopbarDelta As Object = 0
Public ColorHue As Integer = 210, ColorSat As Integer = 85, ColorLightAdjust As Integer = 0, ColorHueTopbarDelta As OneOf(Of Integer, Integer()) = 0
Public ThemeDontClick As Integer = 0
Public Sub ThemeRefresh(Optional NewTheme As Integer = -1)
@@ -199,7 +150,7 @@ Friend Module ModSecret
Application.Current.Resources("ColorObjectBg1") = CType(ColorBg1, Color)
ThemeRefreshMain()
Catch ex As Exception
Log(ex, "刷新主题颜色失败", LogLevel.Hint)
Log(ex, "刷新主题颜色失败", NotifyLevel.AllUsers)
End Try
End Sub
Public Sub ThemeRefreshMain()
@@ -208,15 +159,10 @@ Friend Module ModSecret
If Not FrmMain.IsLoaded Then Return
'顶部条背景
Dim Brush = New LinearGradientBrush With {.EndPoint = New Point(1, 0), .StartPoint = New Point(0, 0)}
If TypeOf ColorHueTopbarDelta Is Integer Then
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 54 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
Else
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(0), ColorSat, 48 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(1), ColorSat, 54 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(2), ColorSat, 48 + ColorLightAdjust)})
End If
Dim Deltas = ColorHueTopbarDelta.Switch(Function(d) New Integer() {-d, 0, d}, Function(d) d)
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue + Deltas(0), ColorSat, 48 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue + Deltas(1), ColorSat, 54 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + Deltas(2), ColorSat, 48 + ColorLightAdjust)})
FrmMain.PanTitle.Background = Brush
FrmMain.PanTitle.Background.Freeze()
'主页面背景
@@ -240,30 +186,23 @@ Friend Module ModSecret
Friend Function ThemeUnlock(Id As Integer, Optional ShowDoubleHint As Boolean = True, Optional UnlockHint As String = Nothing) As Boolean
Return False
End Function
Friend Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean
Return False
End Function
Friend Function DonateCodeInput() As Boolean?
Return Nothing
End Function
#End Region
#Region "更新"
Public IsUpdateStarted As Boolean = False
Public IsUpdateWaitingRestart As Boolean = False
Public Sub UpdateCheckByButton()
Friend Sub UpdateCheckByButton()
Hint("该版本中不包含更新功能……")
End Sub
Public Sub UpdateStart(BaseUrl As String, Slient As Boolean, Optional ReceivedKey As String = Nothing, Optional ForceValidated As Boolean = False)
End Sub
Friend IsUpdateWaitingRestart As Boolean = False
Public Sub UpdateRestart(TriggerRestartAndByEnd As Boolean)
End Sub
Public Sub UpdateReplace(ProcessId As Integer, OldFileName As String, NewFileName As String, TriggerRestart As Boolean)
End Sub
''' <summary>
''' 确保 PathTemp 下的 Latest.exe 是最新正式版的 PCL,它会被用于整合包打包。
''' 确保 PathTemp/Latest.exe 是最新正式版的 PCL,它会被用于整合包打包。
''' 如果不是,则下载一个。
''' </summary>
Friend Sub DownloadLatestPCL(Optional LoaderToSyncProgress As LoaderBase = Nothing)
@@ -285,4 +224,26 @@ Friend Module ModSecret
#End Region
#Region "赞助等级"
Public ReadOnly Property DonationRank As DonationRanks
Get
Return DonationRanks.None
End Get
End Property
Public Sub InputPotatoCode(IsUpdating As Boolean)
End Sub
Friend Sub GeneratePotatoCode()
End Sub
''' <summary>
''' 获取设备识别码。
''' </summary>
Friend Function GetIdentify() As String
Return "0000-0000-0000-0000"
End Function
#End Region
End Module
@@ -0,0 +1,507 @@
''' <summary>
''' 本地的社区资源文件。
''' </summary>
Public Class ResourceFile
#Region "文件信息"
''' <summary>
''' 该文件的文件信息。
''' </summary>
Public ReadOnly File As FileInfo
Public Sub New(FileInfo As FileInfo)
Me.File = FileInfo
End Sub
Public Sub New(FullName As String)
Me.New(New FileInfo(FullName))
End Sub
''' <summary>
''' 该文件是否没有被禁用。
''' </summary>
Public ReadOnly Property IsEnabled As Boolean
Get
Return {".jar", ".zip", ".litemod"}.Contains(File.Extension.Lower)
End Get
End Property
''' <summary>
''' 假若该资源未被禁用时,文件的文件名。
''' </summary>
Public ReadOnly Property EnabledName As String
Get
Return File.Name.Replace(".disabled", "").Replace(".old", "")
End Get
End Property
''' <summary>
''' 假若该资源未被禁用时,文件的完整路径。
''' </summary>
Public ReadOnly Property EnabledFullName As String
Get
Return $"{File.DirectoryName}\{EnabledName}"
End Get
End Property
#End Region
#Region "信息项"
''' <summary>
''' 在初始化结束之后,任何信息被后续更新时触发此事件。
''' </summary>
Public Event OnUpdate(sender As ResourceFile)
''' <summary>
''' 可读名称。
''' 可能为无扩展的文件名,但不会是 Nothing。
''' </summary>
Public Property Display As String
Get
If _Display Is Nothing Then _Display = ProjectVersion?.Display
If _Display Is Nothing Then _Display = Path.GetFileNameWithoutExtension(File.FullName)
Return _Display
End Get
Set(value As String)
If _Display Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso
value.Lower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
_Display = value
End If
End Set
End Property
Private _Display As String = Nothing
''' <summary>
''' Mod 的描述信息。
''' 可能为 Nothing。
''' </summary>
Public Property Description As String
Get
Return _Description
End Get
Set(value As String)
If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then
_Description = value.ToString.Trim(vbLf)
'优化显示:若以 [a-zA-Z0-9] 结尾,加上小数点句号
If _Description.Lower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "."
End If
End Set
End Property
Private _Description As String = Nothing
''' <summary>
''' Mod 的版本。
''' 不保证符合版本格式规范,且可能为 Nothing。
''' </summary>
Public Property Version As String
Get
If _Version Is Nothing Then _Version = ProjectVersion?.Version
Return _Version
End Get
Set(value As String)
If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
If value IsNot Nothing AndAlso value.ContainsIgnoreCase("version") Then value = "version" '需要修改的标识
_Version = value
End Set
End Property
Public _Version As String = Nothing
#End Region
#Region "从 JAR 获取信息"
''' <summary>
''' 从 JAR 文件中获取 Mod 信息。
''' </summary>
Public Sub LoadMetadataFromJar()
Static IsLoaded As Boolean = False
If IsLoaded Then Return
IsLoaded = True
Dim Jar As ZipArchive = Nothing
Try
'基础可用性检查
If 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 & ")")
'打开 Jar 文件
Jar = New ZipArchive(New FileStream(File.FullName, FileMode.Open, FileAccess.Read, FileShare.Read))
'信息获取
LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException
Log(ex, $"Mod 文件由于无权限无法打开({File.FullName})", NotifyLevel.DevelopOnly)
Catch ex As Exception
Log(ex, $"Mod 文件无法打开({File.FullName})", NotifyLevel.DevelopOnly)
Finally
If Jar IsNot Nothing Then Jar.Dispose()
End Try
End Sub
Private Sub LoadMetadataFromJar(Jar As ZipArchive)
#Region "尝试使用 mcmod.info"
Try
'获取信息文件
Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info")
Dim InfoString As String = Nothing
If InfoEntry IsNot Nothing Then
InfoString = ReadFile(InfoEntry.Open())
If InfoString.Length < 15 Then InfoString = Nothing
End If
If InfoString Is Nothing Then Exit Try
'获取可用 Json 项
Dim InfoObject As JObject
Dim JsonObject = GetJson(InfoString)
If JsonObject.Type = JTokenType.Array Then
InfoObject = JsonObject(0)
Else
InfoObject = JsonObject("modList")(0)
End If
'从文件中获取 Mod 信息项
Display = InfoObject("name")
Description = InfoObject("description")
Version = InfoObject("version")
Catch ex As Exception
Log(ex, $"读取 mcmod.info 时出现未知错误({File.FullName})", NotifyLevel.DevelopOnly)
End Try
#End Region
#Region "尝试使用 fabric.mod.json"
Try
'获取 fabric.mod.json 文件
Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json")
Dim FabricText As String = Nothing
If FabricEntry IsNot Nothing Then
FabricText = ReadFile(FabricEntry.Open(), Encoding.UTF8)
If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing
End If
If FabricText Is Nothing Then Exit Try
Dim FabricObject As JObject = GetJson(FabricText)
GotFabric:
'从文件中获取 Mod 信息项
If FabricObject.ContainsKey("name") Then Display = FabricObject("name")
If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fabric.mod.json 时出现未知错误(" & File.FullName & ")", NotifyLevel.DevelopOnly)
End Try
#End Region
#Region "尝试使用 mods.toml"
Try
'获取 mods.toml 文件
Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml")
Dim TomlText As String = Nothing
If TomlEntry IsNot Nothing Then
TomlText = ReadFile(TomlEntry.Open())
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) '统一换行符
If Line.StartsWithF("#") Then '去除注释
Continue For
ElseIf Line.Contains("#") Then
Line = Line.Substring(0, Line.IndexOfF("#"))
End If
Line = Line.Trim(New Char() {" "c, " "c, " "c}) '去除头尾的空格
If Line.Any Then Lines.Add(Line) '去除空行
Next
'读取文件数据
Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))}
For i = 0 To Lines.Count - 1
Dim Line As String = Lines(i)
If Line.StartsWithF("[") AndAlso Line.EndsWithF("]") Then
'段落标记
Dim Header = Line.Trim("[]".ToCharArray)
TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object)))
ElseIf Line.Contains("=") Then
'字段标记
Dim Key As String = Line.Substring(0, Line.IndexOfF("=")).TrimEnd(New Char() {" "c, " "c, " "c})
Dim RawValue As String = Line.Substring(Line.IndexOfF("=") + 1).TrimStart(New Char() {" "c, " "c, " "c})
Dim Value As Object
If RawValue.StartsWithF("""") AndAlso RawValue.EndsWithF("""") Then
'单行字符串
Value = RawValue.Trim("""")
ElseIf RawValue.StartsWithF("'''") Then
'多行字符串
Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")}
If ValueLines(0).EndsWithF("'''") Then '把多行字符串按单行写法写的错误处理(#2732)
ValueLines(0) = ValueLines(0).TrimEnd("'")
Else
Do Until i >= Lines.Count - 1
i += 1
Dim ValueLine As String = Lines(i)
If ValueLine.EndsWithF("'''") Then
ValueLines.Add(ValueLine.TrimEnd("'"))
Exit Do
Else
ValueLines.Add(ValueLine)
End If
Loop
End If
Value = ValueLines.Join(vbLf).Trim(vbLf).ReplaceLineEndings(vbCrLf)
ElseIf RawValue.Lower = "true" OrElse RawValue.Lower = "false" Then
'布尔型
Value = (RawValue.Lower = "true")
ElseIf Val(RawValue).ToString = RawValue Then
'数字型
Value = Val(RawValue)
Else
'不知道是个啥玩意儿,直接存储
Value = RawValue
End If
TomlData.Last.Value(Key) = Value
Else
'不知道是个啥玩意儿
Exit Try
End If
Next
'从文件数据中获取信息
Dim ModEntry As Dictionary(Of String, Object) = Nothing
For Each TomlSubData In TomlData
If TomlSubData.Key = "mods" Then
ModEntry = TomlSubData.Value
Exit For
End If
Next
If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try
If ModEntry.ContainsKey("displayName") Then Display = ModEntry("displayName")
If ModEntry.ContainsKey("description") Then Description = ModEntry("description")
If ModEntry.ContainsKey("version") Then Version = ModEntry("version")
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, $"读取 mods.toml 时出现未知错误({File.FullName})", NotifyLevel.DevelopOnly)
End Try
#End Region
#Region "尝试使用 fml_cache_annotation.json"
Try
'获取 fml_cache_annotation.json 文件
Dim FmlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/fml_cache_annotation.json")
Dim FmlText As String = Nothing
If FmlEntry IsNot Nothing Then
FmlText = ReadFile(FmlEntry.Open(), Encoding.UTF8)
If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing
End If
If FmlText Is Nothing Then Exit Try
Dim FmlJson As JObject = GetJson(FmlText)
'获取可用 Json 项
Dim FmlObject As JObject = Nothing
For Each ModFilePair In FmlJson
Dim ModFileAnnos As JArray = ModFilePair.Value("annotations")
If ModFileAnnos IsNot Nothing Then
'先获取 Mod
For Each ModFileAnno In ModFileAnnos
Dim Name As String = If(ModFileAnno("name"), "")
If Name = "Lnet/minecraftforge/fml/common/Mod;" Then
FmlObject = ModFileAnno("values")
GoTo Got
End If
Next
End If
Next
Exit Try
Got:
'从文件中获取 Mod 信息项
If FmlObject.ContainsKey("name") Then Display = FmlObject("name")("value")
If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value")
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, $"读取 fml_cache_annotation.json 时出现未知错误({File.FullName})", NotifyLevel.DevelopOnly)
End Try
#End Region
Return '没能成功获取任何信息
Finished:
#Region "将 Version 代号转换为 META-INF 中的版本"
If _Version = "version" Then
Try
Dim MetaEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/MANIFEST.MF")
If MetaEntry IsNot Nothing Then
Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":")
If MetaString.Contains("Implementation-Version:") Then
MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
Version = MetaString
End If
End If
Catch ex As Exception
Log($"获取 META-INF 中的版本信息失败({File.FullName})", NotifyLevel.DevelopOnly)
Version = Nothing
End Try
End If
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
#End Region
RaiseEvent OnUpdate(Me)
End Sub
#End Region
#Region "网络信息"
''' <summary>
''' 该 Mod 关联的网络项目。
''' </summary>
Public Property Project As ResourceProject
Get
Return _Project
End Get
Set(value As ResourceProject)
_Project = value
RaiseEvent OnUpdate(Me)
End Set
End Property
Private _Project As ResourceProject
''' <summary>
''' 本地文件对应的联网文件信息。
''' </summary>
Public ProjectVersion As ResourceVersion
''' <summary>
''' 该 Mod 对应的联网最新版本。
''' </summary>
Public Property UpdateFile As ResourceVersion
Get
Return _UpdateFile
End Get
Set(value As ResourceVersion)
_UpdateFile = value
RaiseEvent OnUpdate(Me)
End Set
End Property
Private _UpdateFile As ResourceVersion
''' <summary>
''' 该 Mod 的更新日志网址。
''' </summary>
Public ChangelogUrls As New List(Of String)
''' <summary>
''' 所有网络信息是否已成功加载。
''' </summary>
Public OnlineDataLoaded As Boolean = False
''' <summary>
''' 将网络信息保存为 JSON。
''' </summary>
Public Function ToJson() As JObject
Dim Json As New JObject
If Project IsNot Nothing Then Json.Add("Project", Project.ToJson())
Json.Add("ChangelogUrls", New JArray(ChangelogUrls))
Json.Add("OnlineDataLoaded", OnlineDataLoaded)
If ProjectVersion IsNot Nothing Then Json.Add("Version", ProjectVersion.ToCacheJson())
If UpdateFile IsNot Nothing Then Json.Add("UpdateFile", UpdateFile.ToCacheJson())
Return Json
End Function
''' <summary>
''' 从 JSON 中读取网络信息。
''' </summary>
Public Sub FromJson(Json As JObject)
OnlineDataLoaded = Json("OnlineDataLoaded")
If Json.ContainsKey("Project") Then Project = New ResourceProject(Json("Project"))
If Json.ContainsKey("ChangelogUrls") Then ChangelogUrls = Json("ChangelogUrls").ToObject(Of List(Of String))
If Json.ContainsKey("Version") Then ProjectVersion = ResourceVersion.FromCacheJson(Json("Version"))
If Json.ContainsKey("UpdateFile") Then UpdateFile = ResourceVersion.FromCacheJson(Json("UpdateFile"))
End Sub
''' <summary>
''' 该文件是否可以更新。
''' </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
End Get
End Property
''' <summary>
''' 获取用于 CurseForge 信息获取的 Hash 值(MurmurHash2)。
''' </summary>
Public ReadOnly Property CurseForgeHash As UInteger
Get
If _CurseForgeHash Is Nothing Then
'读取缓存
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
_CurseForgeHash = Cached
Return _CurseForgeHash
End If
'读取文件
Dim data As New List(Of Byte)
For Each b As Byte In ReadFileBytes(File.FullName)
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
data.Add(b)
Next
'计算 MurmurHash2
Dim length As Integer = data.Count
Dim h As UInteger = 1 Xor length '1 是种子
Dim i As Integer
For i = 0 To length - 4 Step 4
Dim k As UInteger = data(i) Or CUInt(data(i + 1)) << 8 Or CUInt(data(i + 2)) << 16 Or CUInt(data(i + 3)) << 24
k = (k * &H5BD1E995L) And &HFFFFFFFFL
k = k Xor (k >> 24)
k = (k * &H5BD1E995L) And &HFFFFFFFFL
h = (h * &H5BD1E995L) And &HFFFFFFFFL
h = h Xor k
Next
Select Case length - i
Case 3
h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
h = h Xor (CUInt(data(i + 2)) << 16)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
Case 2
h = h Xor (data(i) Or CUInt(data(i + 1)) << 8)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
Case 1
h = h Xor data(i)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
End Select
h = h Xor (h >> 13)
h = (h * &H5BD1E995L) And &HFFFFFFFFL
h = h Xor (h >> 15)
_CurseForgeHash = h
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, h.ToString)
End If
Return _CurseForgeHash
End Get
End Property
Private _CurseForgeHash As UInteger?
''' <summary>
''' 获取用于 Modrinth 信息获取的 Hash 值(SHA1)。
''' </summary>
Public ReadOnly Property ModrinthHash As String
Get
If _ModrinthHash Is Nothing Then
'读取缓存
Dim CacheKey As String = GetHash($"{EnabledFullName}-{File.LastWriteTime.ToLongTimeString}-{File.Length}-M")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" Then
_ModrinthHash = Cached
Return _ModrinthHash
End If
'计算 SHA1
_ModrinthHash = GetFileSHA1(File.FullName)
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
End If
Return _ModrinthHash
End Get
End Property
Private _ModrinthHash As String
#End Region
#Region "API"
Public Overrides Function ToString() As String
Return File.FullName
End Function
Public Overrides Function Equals(obj As Object) As Boolean
Dim Target = TryCast(obj, ResourceFile)
Return Target IsNot Nothing AndAlso File.FullName = Target.File.FullName
End Function
#End Region
End Class
@@ -0,0 +1,345 @@
Public Module ResourceFileLoader
Private Const ResourceFileCacheVersion As Integer = 16
'加载 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)))
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)
Try
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
If Loader.IsInterrupted Then Return
Thread.Sleep(100)
Loop
Finally
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在加载 Mod 列表")
End Try
FrmInstanceMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
End If
'获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo)
If Directory.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
'仅当 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
Continue For
End If
End If
Static IsModFile As Func(Of String, Boolean) =
Function(FullName As String)
If FullName Is Nothing OrElse Not FullName.Contains(".") Then Return False
FullName = FullName.Lower
If FullName.EndsWithF(".jar", True) OrElse FullName.EndsWithF(".zip", True) OrElse FullName.EndsWithF(".litemod", True) OrElse
FullName.EndsWithF(".jar.disabled", True) OrElse FullName.EndsWithF(".zip.disabled", True) OrElse FullName.EndsWithF(".litemod.disabled", True) OrElse
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)
Next
End If
'获取本地文件缓存
Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
Dim Cache As New JObject
Try
Dim CacheContent As String = ReadFile(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)
Cache = New JObject
End If
End If
Catch ex As Exception
Log(ex, "读取本地 Mod 信息缓存失败,已重置")
Cache = New JObject
End Try
Cache("version") = ResourceFileCacheVersion
'加载 Mod 列表
Dim ModList As New List(Of ResourceFile)
For Each ModFile As FileInfo 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) '存在两个文件,名称相同,但一个启用一个禁用
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)
If DisabledMod Is ModEntry Then
Continue For
Else
ModList.Remove(DisabledMod)
End If
End If
ModList.Add(ModEntry)
Next
Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
'排序
ModList = ModList.OrderBy(Function(m) m.File.Name).ToList
'回设
If Loader.IsInterrupted Then Return
Loader.Output = ModList
'开始联网加载
'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of ResourceFile), JObject)(ModList, Cache), IsForceRestart:=True)
Catch ex As Exception
Log(ex, "Mod 列表加载失败", NotifyLevel.DebugModeOnly)
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
'读取缓存,获取需要更新的 Mod 列表
For Each ModEntry As ResourceFile In Loader.Input.Key
If Loader.IsInterrupted Then Return
Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
If ModEntry.OnlineDataLoaded AndAlso Date.Now - Cache(CacheKey)("Project")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
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 需要更新信息")
If Not Mods.Any Then
Loader.Input.Key.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 VanillaVersion = TargetMcVersion.VanillaName
'开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{VanillaVersion}")
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim CurrentTaskThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
RunInNewThread(
Sub()
Try
'步骤 1:获取 Hash 与对应的工程 ID
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 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If ModrinthVersion.Count = 0 Then Return
Dim ModrinthMapping As New Dictionary(Of String, List(Of ResourceFile))
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)
ModrinthMapping(ProjectId).Add(Entry)
'记录对应的 ProjectVersion
Dim File = ResourceVersion.FromPlatformJson(ModrinthVersion(Entry.ModrinthHash), ResourceTypes.Mod)
If Entry.ProjectVersion Is Nothing OrElse Entry.ProjectVersion.ReleaseDate < File.ReleaseDate Then
Entry.ProjectVersion = File
Else
Entry.ProjectVersion.Version = File.Version '使用来自 Modrinth 的版本号
End If
Next
If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Return
Dim ModrinthProject As JArray = DlModRequest(
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]")
For Each ProjectJson In ModrinthProject
Dim Project As New ResourceProject(ProjectJson)
For Each Entry In ModrinthMapping(Project.Id)
Entry.Project = Project
Next
Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息
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")
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}")
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 '合并
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}")
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}"}
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
IsFailed = True
Finally
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader Modrinth")
'从 CurseForge 获取信息
RunInNewThread(
Sub()
Try
'步骤 1:获取 Hash 与对应的工程 ID
Dim CurseForgeHashes As New List(Of UInteger)
For Each Entry In Mods
CurseForgeHashes.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 的对应关系
If Not CurseForgeRaw.Any() Then Return
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of ResourceFile))
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)
'记录对应的 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 的工程信息")
'步骤 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 文件列表
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
End If
Entry.Project = Project
Next
'查找或许版本更新的文件列表
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
Next
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息
If Not UpdateFileIds.Any() Then Return
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)
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)
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 UpdateFile As ResourceVersion = Pair.Value
If ModeDebug Then Log($"[Mod] 本地文件 {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 '合并
Entry.ChangelogUrls.Add($"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}")
Entry.UpdateFile.DownloadUrls.AddRange(UpdateFile.DownloadUrls) '合并下载源
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate > Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}"}
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
Catch ex As Exception
Log(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())
'等待线程结束
Do Until EndedThreadCount = 2
Thread.Sleep(10)
If Loader.IsInterrupted Then Return
Loop
'保存缓存
Mods = Mods.Where(Function(m) m.Project IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Return
For Each Entry In Mods
Entry.OnlineDataLoaded = Not IsFailed
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = Entry.ToJson()
Next
FileUtils.Write(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
If Loader.IsInterrupted Then Return
If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else
RunInUi(Sub() FrmInstanceMod?.RefreshBars())
End If
End Sub
End Module
@@ -0,0 +1,726 @@
''' <summary>
''' 社区资源的项目信息。
''' </summary>
Public Class ResourceProject
'源信息
''' <summary>
''' 该项目信息的所属平台。
''' </summary>
Public ReadOnly Platform As ResourcePlatforms
''' <summary>
''' 工程中包含的文件种类。
''' 若为 Modrinth 工程,可能为 Mod 或 数据包。
''' </summary>
Public ReadOnly Types As ResourceTypes
''' <summary>
''' 工程的短名。例如 technical-enchant。
''' </summary>
Public ReadOnly Slug As String
''' <summary>
''' CurseForge 工程的数字 ID。Modrinth 工程的乱码 ID。
''' </summary>
Public ReadOnly Id As String
''' <summary>
''' CurseForge 文件列表的数字 ID。Modrinth 工程的此项无效。
''' </summary>
Public ReadOnly CurseForgeFileIds As List(Of Integer)
'描述性信息
''' <summary>
''' 原始的英文名称。
''' </summary>
Public ReadOnly RawName As String
''' <summary>
''' 英文描述。
''' </summary>
Public ReadOnly Description As String
''' <summary>
''' 来源网站的工程页面网址。确保格式一定标准。
''' CurseForge:https://www.curseforge.com/minecraft/mc-mods/jei
''' Modrinth:https://modrinth.com/mod/technical-enchant
''' </summary>
Public ReadOnly Website As String
''' <summary>
''' 最后一次更新的时间。
''' </summary>
Public ReadOnly LastUpdate As Date
''' <summary>
''' 下载量计数。注意,该计数仅为一个来源,无法反应两边加起来的下载量!
''' </summary>
Public ReadOnly DownloadCount As Integer
''' <summary>
''' 支持的 Mod 加载器列表。可能为空。
''' </summary>
Public ReadOnly Loaders As List(Of ModLoaderTypes)
''' <summary>
''' 描述性标签的内容。已转换为中文。
''' </summary>
Public ReadOnly Tags As List(Of String)
''' <summary>
''' Logo 图片的下载地址。
''' 若为 Nothing 则没有,保证不为空字符串。
''' </summary>
Public LogoUrl As String = Nothing
''' <summary>
''' 支持的 Drop 编号,从高到低排序,不为 Nothing。
''' 例如:261(26.1.x)、180(1.18.x)。
''' </summary>
Public ReadOnly Drops As List(Of Integer)
''' <summary>
''' Modrinth API 返回的原始版本列表。
''' 仅用于 Modrinth 工程的二次筛选,不会被缓存,不会被预处理。
''' 若非从 Modrinth 获取则为 Nothing。
''' </summary>
Public ReadOnly UnsafeGameVersions As List(Of String)
'数据库信息
Private LoadedDatabase As Boolean = False
Private _WikiEntry As WikiEntry = Nothing
''' <summary>
''' 关联的数据库条目。若为 Nothing 则没有。
''' </summary>
Private Property WikiEntry As WikiEntry
Get
If Not LoadedDatabase Then
LoadedDatabase = True
If Types.HasFlag(ResourceTypes.Mod) OrElse Types.HasFlag(ResourceTypes.DataPack) Then
_WikiEntry = WikiEntry.All.FirstOrDefault(Function(c) If(Platform = ResourcePlatforms.CurseForge, c.CurseForgeSlug, c.ModrinthSlug) = Slug)
End If
End If
Return _WikiEntry
End Get
Set(value As WikiEntry)
LoadedDatabase = True
_WikiEntry = value
End Set
End Property
''' <summary>
''' MC 百科的页面 ID。若为 0 则没有。
''' </summary>
Public ReadOnly Property WikiId As Integer
Get
Return If(WikiEntry Is Nothing, 0, WikiEntry.Id)
End Get
End Property
''' <summary>
''' 翻译后的中文名。若数据库没有则等同于 RawName。
''' </summary>
Public ReadOnly Property TranslatedName As String
Get
Return If(WikiEntry Is Nothing OrElse WikiEntry.ChineseName = "", RawName, WikiEntry.ChineseName)
End Get
End Property
'实例化
''' <summary>
''' 从工程 Json 中初始化实例。若出错会抛出异常。
''' </summary>
Public Sub New(Data As JObject)
If Data.ContainsKey("Tags") Then
#Region "缓存 JSON"
Platform = Data("Platform").ToObject(Of Integer)
Types = Data("Types").ToObject(Of Integer)
Slug = Data("Slug")
Id = Data("Id")
If Data.ContainsKey("CurseForgeFileIds") Then CurseForgeFileIds = CType(Data("CurseForgeFileIds"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
RawName = Data("RawName")
Description = Data("Description")
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
Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList
If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl")
If Data.ContainsKey("Drops") Then
Drops = CType(Data("Drops"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
Else
Drops = New List(Of Integer)
End If
#End Region
Else
Platform = If(Data.ContainsKey("summary"), ResourcePlatforms.CurseForge, ResourcePlatforms.Modrinth)
If Platform = ResourcePlatforms.CurseForge Then
#Region "CurseForge"
'简单信息
Id = Data("id")
Slug = Data("slug")
RawName = Data("name")
Description = Data("summary")
Website = Data("links")("websiteUrl").ToString.TrimEnd("/")
LastUpdate = Data("dateReleased") '#1194
DownloadCount = Data("downloadCount")
If Data("logo").Count > 0 Then
If Data("logo")("thumbnailUrl") Is Nothing OrElse Data("logo")("thumbnailUrl") = "" Then
LogoUrl = Data("logo")("url")
Else
LogoUrl = Data("logo")("thumbnailUrl")
End If
End If
If LogoUrl = "" Then LogoUrl = Nothing
'Type
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
Types = ResourceTypes.Mod
ElseIf Website.Contains("/modpacks/") Then
Types = ResourceTypes.ModPack
ElseIf Website.Contains("/resourcepacks/") Then
Types = ResourceTypes.ResourcePack
ElseIf Website.Contains("/texture-packs/") Then
Types = ResourceTypes.ResourcePack
ElseIf Website.Contains("/shaders/") Then
Types = ResourceTypes.Shader
Else
Types = ResourceTypes.DataPack
End If
'FileIndexes / VanillaMajorVersions / ModLoaders
Loaders = New List(Of ModLoaderTypes)
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)
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))
Next
For Each File In If(Data("latestFilesIndexes"), New JArray) '这俩玩意儿包含的文件不一样,见 #3599
If Not McVersion.IsFormatFit(File("gameVersion")) Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("fileId"), {File("gameVersion").ToString}.ToList))
Next
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)
Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
Select Case Category
'Mod
Case 406 : Tags.Add("世界元素")
Case 407 : Tags.Add("生物群系")
Case 410 : Tags.Add("维度")
Case 408 : Tags.Add("矿物/资源")
Case 409 : Tags.Add("天然结构")
Case 412 : Tags.Add("科技")
Case 415 : Tags.Add("管道/物流")
Case 4843 : Tags.Add("自动化")
Case 417 : Tags.Add("能源")
Case 4558 : Tags.Add("红石")
Case 436 : Tags.Add("食物/烹饪")
Case 416 : Tags.Add("农业")
Case 414 : Tags.Add("运输")
Case 420 : Tags.Add("仓储")
Case 419 : Tags.Add("魔法")
Case 422 : Tags.Add("冒险")
Case 424 : Tags.Add("装饰")
Case 411 : Tags.Add("生物")
Case 434 : Tags.Add("装备")
Case 6814 : Tags.Add("性能优化")
Case 9026 : Tags.Add("创造模式")
Case 423 : Tags.Add("信息显示")
Case 435 : Tags.Add("服务器")
Case 5191 : Tags.Add("改良")
Case 421 : Tags.Add("支持库")
'整合包
Case 4484 : Tags.Add("多人")
Case 4479 : Tags.Add("硬核")
Case 4483 : Tags.Add("战斗")
Case 4478 : Tags.Add("任务")
Case 4472 : Tags.Add("科技")
Case 4473 : Tags.Add("魔法")
Case 4475 : Tags.Add("冒险")
Case 4476 : Tags.Add("探索")
Case 4477 : Tags.Add("小游戏")
Case 4474 : Tags.Add("科幻")
Case 4736 : Tags.Add("空岛")
Case 5128 : Tags.Add("原版改良")
Case 4487 : Tags.Add("FTB")
Case 4480 : Tags.Add("基于地图")
Case 4481 : Tags.Add("轻量")
Case 4482 : Tags.Add("大型")
'资源包
Case 403 : Tags.Add("原版风")
Case 400 : Tags.Add("写实风")
Case 401 : Tags.Add("现代风")
Case 402 : Tags.Add("中世纪")
Case 399 : Tags.Add("蒸汽朋克")
Case 5244 : Tags.Add("含字体")
Case 404 : Tags.Add("动态效果")
Case 4465 : Tags.Add("兼容 Mod")
Case 393 : Tags.Add("16x")
Case 394 : Tags.Add("32x")
Case 395 : Tags.Add("64x")
Case 396 : Tags.Add("128x")
Case 397 : Tags.Add("256x")
Case 398 : Tags.Add("超高清")
Case 5193 : Tags.Add("数据包") '有这个 Tag 的项会从资源包请求中被移除
'光影包
Case 6553 : Tags.Add("写实风")
Case 6554 : Tags.Add("幻想风")
Case 6555 : Tags.Add("原版风")
'数据包
Case 6948 : Tags.Add("冒险")
Case 6949 : Tags.Add("幻想")
Case 6950 : Tags.Add("支持库")
Case 6952 : Tags.Add("魔法")
Case 6946 : Tags.Add("Mod 相关")
Case 6951 : Tags.Add("科技")
Case 6953 : Tags.Add("实用")
End Select
Next
#End Region
Else
#Region "Modrinth"
'简单信息
Id = If(Data("project_id"), Data("id")) '两个 API 会返回的 key 不一样
Slug = Data("slug")
RawName = Data("title")
Description = Data("description")
LastUpdate = If(Data("date_modified"), Data("updated"))
DownloadCount = Data("downloads")
LogoUrl = Data("icon_url")
If LogoUrl = "" Then LogoUrl = Nothing
Website = $"https://modrinth.com/{Data("project_type")}/{Slug}"
'GameVersions
'搜索结果的键为 versions,获取特定工程的键为 game_versions
UnsafeGameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).Select(Function(v) v.ToString).Distinct.ToList
Drops = UnsafeGameVersions.Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v <> 209).Distinct.OrderByDescending(Function(v) v).ToList
'Type
Select Case Data("project_type").ToString
Case "modpack" : Types = ResourceTypes.ModPack
Case "resourcepack" : Types = ResourceTypes.ResourcePack
Case "shader" : Types = ResourceTypes.Shader
Case Else : Types = ResourceTypes.Mod 'Modrinth 将数据包标为 Mod,但 categories 字段里有 datapack
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
Next
End If
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("科技")
Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险")
Case "utility" : Tags.Add("实用")
Case "optimization" : Tags.Add("性能优化")
Case "vanilla-like" : Tags.Add("原版风")
Case "realistic" : Tags.Add("写实风")
'Mod/数据包
Case "worldgen" : Tags.Add("世界元素")
Case "food" : Tags.Add("食物/烹饪")
Case "game-mechanics" : Tags.Add("游戏机制")
Case "transportation" : Tags.Add("运输")
Case "storage" : Tags.Add("仓储")
Case "decoration" : If Types <> ResourceTypes.ResourcePack Then Tags.Add("装饰")
Case "mobs" : If Types <> ResourceTypes.ResourcePack Then Tags.Add("生物")
Case "equipment" : If Types <> ResourceTypes.ResourcePack Then Tags.Add("装备")
Case "social" : Tags.Add("服务器")
Case "library" : Tags.Add("支持库")
'整合包
Case "multiplayer" : Tags.Add("多人")
Case "challenging" : Tags.Add("硬核")
Case "combat" : Tags.Add("战斗")
Case "quests" : Tags.Add("任务")
Case "kitchen-sink" : Tags.Add("水槽包")
Case "lightweight" : Tags.Add("轻量")
'资源包
Case "simplistic" : Tags.Add("简洁")
Case "combat" : Tags.Add("战斗")
Case "tweaks" : Tags.Add("改良")
Case "8x-" : Tags.Add("极简")
Case "16x" : Tags.Add("16x")
Case "32x" : Tags.Add("32x")
Case "48x" : Tags.Add("48x")
Case "64x" : Tags.Add("64x")
Case "128x" : Tags.Add("128x")
Case "256x" : Tags.Add("256x")
Case "512x+" : Tags.Add("超高清")
Case "audio" : Tags.Add("含声音")
Case "fonts" : Tags.Add("含字体")
Case "models" : Tags.Add("含模型")
Case "gui" : Tags.Add("含 UI")
Case "locale" : Tags.Add("含语言")
Case "core-shaders" : Tags.Add("核心着色器")
Case "modded" : Tags.Add("兼容 Mod")
'光影包
Case "fantasy" : Tags.Add("幻想风")
Case "semi-realistic" : Tags.Add("半写实风")
Case "cartoon" : Tags.Add("卡通风")
'暂时不添加性能负荷 Tag
'Case "potato" : Tags.Add("极低")
'Case "low" : Tags.Add("低")
'Case "medium" : Tags.Add("中")
'Case "high" : Tags.Add("高")
Case "colored-lighting" : Tags.Add("彩色光照")
Case "path-tracing" : Tags.Add("路径追踪")
Case "pbr" : Tags.Add("PBR")
Case "reflections" : Tags.Add("反射")
Case "iris" : Tags.Add("Iris")
Case "optifine" : Tags.Add("OptiFine")
Case "vanilla" : Tags.Add("原版可用")
End Select
Next
If Types = ResourceTypes.DataPack AndAlso Loaders.Any 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
End Sub
''' <summary>
''' 从工程 ID 联网获取对应工程的信息。
''' </summary>
Public Shared Function FromProjectId(ProjectId As String, Platform As ResourcePlatforms) As ResourceProject
If Not Platform.Flags.IsSingle Then Throw New ArgumentException($"必须指定单一平台,当前值为 {Platform}")
If Cache.ContainsKey(ProjectId) Then '存在缓存
Return Cache(ProjectId)
ElseIf Platform = ResourcePlatforms.CurseForge Then 'CurseForge
Return New ResourceProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId)("data"))
Else 'Modrinth
Return New ResourceProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId))
End If
End Function
''' <summary>
''' 从工程 ID 列表联网获取工程信息,结果不按原顺序排列。
''' </summary>
Public Shared Iterator Function FromProjectIds(ProjectIds As IEnumerable(Of String), Platform As ResourcePlatforms) As IEnumerable(Of ResourceProject)
If Not Platform.Flags.IsSingle Then Throw New ArgumentException($"必须指定单一平台,当前值为 {Platform}")
'获取缓存
Dim MissingProjectIds As New List(Of String)
For Each ProjectId In ProjectIds
If Cache.ContainsKey(ProjectId) Then
Yield Cache(ProjectId)
Else
MissingProjectIds.Add(ProjectId)
End If
Next
If Not MissingProjectIds.Any() Then Return
'联网获取剩余的工程对象
Dim Projects As JArray
If Platform.HasFlag(ResourcePlatforms.CurseForge) Then
Projects = DlModRequest("https://api.curseforge.com/v1/mods",
HttpMethod.Post, "{""modIds"": [" & MissingProjectIds.Join(","c) & "]}", "application/json")("data")
Else
Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{MissingProjectIds.Join(""",""")}""]")
End If
For Each Project In Projects
Yield New ResourceProject(Project)
Next
End Function
''' <summary>
''' 将当前实例转为可用于保存缓存的 Json。
''' </summary>
Public Function ToJson() As JObject
Dim Json As New JObject
Json("Platform") = CInt(Platform)
Json("Types") = CInt(Types)
Json("Slug") = Slug
Json("Id") = Id
If CurseForgeFileIds IsNot Nothing Then Json("CurseForgeFileIds") = New JArray(CurseForgeFileIds)
Json("RawName") = RawName
Json("Description") = Description
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)))
Json("Tags") = New JArray(Tags)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If Drops.Any Then Json("Drops") = New JArray(Drops)
Json("CacheTime") = Date.Now '用于检查缓存时间
Return Json
End Function
''' <summary>
''' 将当前工程信息实例化为控件。
''' </summary>
Public Function ToResourceItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean) As MyVirtualizingElement(Of MyResourceItem)
'获取版本描述
Dim GameVersionDescription As String
If Drops Is Nothing OrElse Not Drops.Any() Then
GameVersionDescription = "仅快照版本" '#5412
Else
Dim Segments As New List(Of String)
Dim IsOld As Boolean = False
For i = 0 To Drops.Count - 1 '版本号一定为降序
'获取当前连续的版本号段
Dim StartDrop As Integer = Drops(i), EndDrop As Integer = Drops(i)
If StartDrop < 120 Then '如果支持新版本,则不显示 1.11-
If Segments.Any() AndAlso Not IsOld Then
Exit For
Else
IsOld = True
End If
End If
For ii = i + 1 To Drops.Count - 1
If AllDrops Is Nothing OrElse AllDrops.IndexOf(Drops(ii)) <> AllDrops.IndexOf(EndDrop) + 1 Then Exit For
EndDrop = Drops(ii)
i = ii
Next
'将版本号段转为描述文本
Dim StartName = McVersion.DropToVersion(StartDrop)
Dim EndName = McVersion.DropToVersion(EndDrop)
If StartDrop = EndDrop Then
Segments.Add(StartName)
ElseIf AllDrops IsNot Nothing AndAlso StartDrop >= AllDrops.First Then
If EndDrop < 120 Then
Segments.Clear()
Segments.Add("全版本")
Exit For
Else
Segments.Add(EndName & "+")
End If
ElseIf EndDrop < 120 Then
Segments.Add(StartName & "-")
Exit For
ElseIf AllDrops Is Nothing OrElse AllDrops.IndexOf(EndDrop) - AllDrops.IndexOf(StartDrop) = 1 Then
Segments.Add(StartName & ", " & EndName)
Else
Segments.Add(StartName & "~" & EndName)
End If
Next
GameVersionDescription = Segments.Join(", ")
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)
Select Case ModLoadersForDesc.Count
Case 0
If Loaders.IsSingle Then
ModLoaderDescriptionFull = "仅 " & Loaders.Single.ToString
ModLoaderDescriptionPart = Loaders.Single.ToString
Else
ModLoaderDescriptionFull = "未知"
ModLoaderDescriptionPart = ""
End If
Case 1
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
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
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
Else
ModLoaderDescriptionFull = ModLoadersForDesc.Join(" / ")
ModLoaderDescriptionPart = ModLoadersForDesc.Join(" / ")
End If
End Select
'实例化 UI
Return New MyVirtualizingElement(Of MyResourceItem)(
Function()
Dim NewItem As New MyResourceItem With {.Tag = Me}
ApplyLogoToMyImage(NewItem.PathLogo)
Dim Titles = GetControlTitle(True)
NewItem.Title = Titles.Title
If Titles.SubTitle = "" Then
CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
Else
NewItem.SubTitle = Titles.SubTitle
End If
NewItem.Tags = Tags
NewItem.Description = Description.ReplaceLineEndings("")
'下边栏
If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then
'全部隐藏
CType(NewItem.PathVersion.Parent, Grid).Children.Remove(NewItem.PathVersion)
CType(NewItem.LabVersion.Parent, Grid).Children.Remove(NewItem.LabVersion)
NewItem.ColumnVersion1.Width = New GridLength(0)
NewItem.ColumnVersion2.MaxWidth = 0
NewItem.ColumnVersion3.Width = New GridLength(0)
ElseIf ShowMcVersionDesc AndAlso ShowLoaderDesc Then
'全部显示
NewItem.LabVersion.Text = If(ModLoaderDescriptionPart = "", "", ModLoaderDescriptionPart & " ") & GameVersionDescription
ElseIf ShowMcVersionDesc Then
'仅显示版本
NewItem.LabVersion.Text = GameVersionDescription
Else
'仅显示 Mod 加载器
NewItem.LabVersion.Text = ModLoaderDescriptionFull
End If
NewItem.LabSource.Text = Platform.ToString
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
NewItem.LabDownload.Text =
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
Return NewItem
End Function) With {.Height = 64}
End Function
Public Sub ApplyLogoToMyImage(Img As MyImage)
If String.IsNullOrEmpty(LogoUrl) Then
Img.Source = PathImage & "Icons/NoIcon.png"
Else
Img.Source = LogoUrl
Img.FallbackSource = DlSourceModGet(LogoUrl)
End If
End Sub
Public Function GetControlTitle(HasModLoaderDescription As Boolean) As (Title As String, SubTitle As String)
'检查下列代码时可以参考 #1567 的测试例
Dim Title As String = RawName
Dim SubtitleList As List(Of String)
If TranslatedName = RawName Then
'没有中文翻译
'将所有名称分段
Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w))
If NameLists.IsSingle Then GoTo NoSubtitle
'查找其中的缩写、Forge/Fabric 等版本标记
SubtitleList = New List(Of String)
Dim NormalNameList = New List(Of String)
For Each Name In NameLists
Dim LowerName As String = Name.Lower
If Name = Name.Upper AndAlso Name <> "FPS" AndAlso Name <> "HUD" Then
'缩写
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 '去掉关键词后没有其他字母
'Forge/Fabric 等版本标记
SubtitleList.Add(Name)
Else
'其他部分
NormalNameList.Add(Name)
End If
Next
'根据分类后的结果处理
If Not NormalNameList.Any() OrElse Not SubtitleList.Any() Then GoTo NoSubtitle
'同时包含 NormalName 和 Subtitle
Title = NormalNameList.Join(" - ")
Else
'有中文翻译
'尝试将文本分为三段:Title (EnglishName) - Suffix
'检查时注意 Carpet(它没有中文译名,但有 Suffix)和 “汤姆存储 - 星的奇妙优化 (Tom's balabala)”
Title = If(TranslatedName.Contains(" ("), TranslatedName.BeforeFirst(" ("), TranslatedName.BeforeLast(" - "))
Dim Suffix As String = ""
If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ")
Dim EnglishName As String = TranslatedName
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
'中段的额外信息截取
SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries).
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 版
Not (SubtitleList.Count = 2 AndAlso SubtitleList.Last.Upper = SubtitleList.Last) Then '不是缩写
SubtitleList = New List(Of String) From {EnglishName} '使用原名
End If
'添加后缀
If Suffix <> "" Then SubtitleList.Add(Suffix)
End If
SubtitleList = SubtitleList.Distinct.ToList()
'设置标题与描述
Dim Subtitle As String = ""
If SubtitleList.Any Then
For Each Ex In SubtitleList
Dim IsModLoaderDescription As Boolean =
Ex.Lower.Contains("neoforge") OrElse Ex.Lower.Contains("forge") OrElse Ex.Lower.Contains("fabric") OrElse Ex.Lower.Contains("quilt")
'是否显示 ModLoader 信息
If Not HasModLoaderDescription AndAlso IsModLoaderDescription Then Continue For
'去除 “Forge/Fabric” 这一无意义提示
If Ex.Length < 16 AndAlso Ex.Lower.Contains("fabric") AndAlso Ex.Lower.Contains("forge") Then Continue For
'将 “Forge” 等提示改为 “Forge 版”
If IsModLoaderDescription AndAlso Not Ex.Contains("版") AndAlso
Ex.Lower.Replace("neoforge", "").Replace("forge", "").Replace("fabric", "").Replace("quilt", "").Length <= 3 Then
Ex = Ex.Replace("Edition", "").Replace("edition", "").Trim.Capitalize & " 版"
End If
'将 “forge” 等词语的首字母大写
Ex = Ex.Replace("neoforge", "NeoForge").Replace("forge", "Forge").Replace("neo", "Neo").Replace("fabric", "Fabric").Replace("quilt", "Quilt")
Subtitle &= " | " & Ex.Trim
Next
Else
NoSubtitle:
Subtitle = ""
End If
Return (Title, Subtitle)
End Function
''' <summary>
''' 工程 ID 对应的工程实例的缓存。不会保存到文件。
''' </summary>
Protected Friend Shared Cache As New Dictionary(Of String, ResourceProject)
''' <summary>
''' 检查是否与某个 Project 是相同的工程,只是在不同的网站。
''' </summary>
Public Function IsLike(Project As ResourceProject) As Boolean
If Id = Project.Id Then Return True '相同实例
'提取字符串中的字母和数字
Dim GetRaw =
Function(Data As String) As String
Dim Result As New StringBuilder()
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r)
Next
Return Result.ToString.Lower
End Function
'来自不同的网站
If Platform = Project.Platform Then Return False
'Mod 加载器一致
If Loaders.Count <> Project.Loaders.Count OrElse Loaders.Except(Project.Loaders).Any() Then Return False
'若不为光影,则要求 MC 版本一致
If Types <> ResourceTypes.Shader AndAlso (Drops.Count <> Project.Drops.Count OrElse Drops.Except(Project.Drops).Any()) 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}) 认定为相似工程")
'如果只有一个有 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
Return True
End If
Return False
End Function
'辅助函数
Public Overrides Function ToString() As String
Return $"{Id} ({Slug}): {RawName}"
End Function
Public Overrides Function Equals(obj As Object) As Boolean
Dim project = TryCast(obj, ResourceProject)
Return project IsNot Nothing AndAlso Id = project.Id
End Function
Public Shared Operator =(left As ResourceProject, right As ResourceProject) As Boolean
Return EqualityComparer(Of ResourceProject).Default.Equals(left, right)
End Operator
Public Shared Operator <>(left As ResourceProject, right As ResourceProject) As Boolean
Return Not left = right
End Operator
End Class
@@ -0,0 +1,515 @@
Public Class ResourceSearcher
Private Const RESULT_PAGE_SIZE = 40
Private Const MSG_NO_CHINESE_RESULT As String = "无搜索结果,请尝试搜索其英文名称"
'输入
Public Class SearchRequest
'结果要求
''' <summary>
''' 结果存储器,会从中获取需加载的页面等。
''' 加载后也应输出到此处。
''' </summary>
Public Storage As SearchResult
''' <summary>
''' 应当尽量达成的结果数量。
''' </summary>
Public TargetResultCount As Integer
''' <summary>
''' 根据加载位置记录,是否还可以继续获取内容。
''' </summary>
Public ReadOnly Property CanContinue As Boolean
Get
If Tag.StartsWithF("/") OrElse Not Sources.HasFlag(ResourcePlatforms.CurseForge) Then Storage.CurseForgeTotal = 0
If Tag.EndsWithF("/") OrElse Not Sources.HasFlag(ResourcePlatforms.Modrinth) Then Storage.ModrinthTotal = 0
If Storage.CurseForgeTotal = -1 OrElse Storage.ModrinthTotal = -1 Then Return True
Return Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
End Get
End Property
'输入内容
''' <summary>
''' 筛选资源种类。
''' </summary>
Public Type As ResourceTypes
''' <summary>
''' 筛选资源标签。空字符串代表不限制。格式例如 "406/worldgen",分别是 CurseForge 和 Modrinth 的 ID。
''' </summary>
Public Tag As String = ""
''' <summary>
''' 筛选 Mod 加载器类别。
''' </summary>
Public ModLoader As ModLoaderTypes = ModLoaderTypes.Any
''' <summary>
''' 筛选 MC 版本。
''' </summary>
Public GameVersion As String = Nothing
''' <summary>
''' 搜索的初始内容。
''' </summary>
Public SearchText As String = Nothing
''' <summary>
''' 允许的来源。
''' </summary>
Public Sources As ResourcePlatforms = ResourcePlatforms.Any
Public Sub New(Type As ResourceTypes, Storage As SearchResult, TargetResultCount As Integer)
Me.Type = Type
Me.Storage = Storage
Me.TargetResultCount = TargetResultCount
End Sub
'构造请求
''' <summary>
''' 获取对应的 CurseForge API 请求链接。
''' </summary>
Public Function GetCurseForgeAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
If Tag.StartsWithF("/") Then Storage.CurseForgeTotal = 0
'应用筛选参数
Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={RESULT_PAGE_SIZE}"
Select Case Type
Case ResourceTypes.Mod
Address += "&classId=6"
Case ResourceTypes.ModPack
Address += "&classId=4471"
Case ResourceTypes.DataPack
Address += "&classId=6945"
Case ResourceTypes.Shader
Address += "&classId=6552"
Case ResourceTypes.ResourcePack
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 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
Return Address
End Function
''' <summary>
''' 获取对应的 Modrinth API 请求链接。
''' </summary>
Public Function GetModrinthAddress(SearchText As String, IgnoreModLoaderFilter As Boolean) As String
If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
'应用筛选参数
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={RESULT_PAGE_SIZE}&index=relevance"
If Not String.IsNullOrEmpty(SearchText) Then Address += "&query=" & EscapeUtils.UrlEscape(SearchText)
If Storage.ModrinthOffset > 0 Then Address += "&offset=" & Storage.ModrinthOffset
'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["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 Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
Address += "&facets=[" & String.Join(",", Facets) & "]"
Return Address
End Function
'相同判断
Public Overrides Function Equals(obj As Object) As Boolean
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
GameVersion = request.GameVersion AndAlso SearchText = request.SearchText
End Function
Public Shared Operator =(left As SearchRequest, right As SearchRequest) As Boolean
Return EqualityComparer(Of SearchRequest).Default.Equals(left, right)
End Operator
Public Shared Operator <>(left As SearchRequest, right As SearchRequest) As Boolean
Return Not left = right
End Operator
Public Overrides Function GetHashCode() As Integer
Return (Type, Tag, ModLoader, GameVersion, SearchText, Sources).GetHashCode()
End Function
End Class
'输出
Public Class SearchResult
'加载位置记录
Public CurseForgeOffset As Integer = 0
Public CurseForgeTotal As Integer = -1
Public ModrinthOffset As Integer = 0
Public ModrinthTotal As Integer = -1
'结果列表
''' <summary>
''' 可供展示的所有工程的列表。
''' </summary>
Public Results As New List(Of ResourceProject)
''' <summary>
''' 当前的错误信息。如果没有则为 Nothing。
''' </summary>
Public ErrorMessage As String = Nothing
End Class
''' <summary>
''' 根据搜索请求获取一系列的工程列表。
''' </summary>
Public Shared Function GetLoader(InputDelegate As Func(Of SearchRequest)) As LoaderTask(Of SearchRequest, Integer)
Return New LoaderTask(Of SearchRequest, Integer)("社区资源获取", AddressOf Run, InputDelegate) With {.ReloadTimeout = 60 * 1000}
End Function
Private Shared Sub Run(Task As LoaderTask(Of SearchRequest, Integer))
Dim Request As SearchRequest = Task.Input
Dim Storage = Request.Storage '避免其他线程对 Request.Storage 重新进行了赋值
#Region "前置检查"
If Storage.Results.Count >= Request.TargetResultCount Then
Log($"[Resource] 已有 {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} 个结果,但无法继续获取,结束处理")
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
Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
End If
#End Region
#Region "中文搜索"
Dim RawSearchText As String = If(Request.SearchText, "").Trim
RawSearchText = RawSearchText.Lower
Log("[Resource] 工程列表搜索原始文本:" & RawSearchText)
Dim IsChineseSearch As Boolean =
RegexCheck(RawSearchText, "[\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
'帮助方法:从搜索项提取可能的英文单词
Dim ExtractWords =
Function(Result As SearchEntry(Of WikiEntry), Source As ResourcePlatforms) As IEnumerable(Of String)
'从各个可能的来源提取候选
Dim Candidates As New List(Of String)
If Result.Item.CurseForgeSlug IsNot Nothing AndAlso Source = ResourcePlatforms.CurseForge Then
Candidates.Add(Result.Item.CurseForgeSlug.Replace("-", " ").Replace("/", " "))
End If
If Result.Item.ModrinthSlug IsNot Nothing AndAlso Source = ResourcePlatforms.Modrinth Then
Candidates.Add(Result.Item.ModrinthSlug.Replace("-", " ").Replace("/", " "))
End If
Candidates.Add(Result.Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
Replace("-", " ").Replace("/", " ").Replace(":", " ").Replace("(", " ").Replace(")", ""))
'分词、清洗、去重
Candidates = Candidates.
SelectMany(Function(c) c.Split(" ")).
Select(Function(w) w.TrimStart("{[(").TrimEnd("}])").Lower).
Where(
Function(w)
If w.Length <= 1 Then Return False '单字或空白
If {"the", "of", "mod", "and", "forge", "fabric", "for", "quilt", "neoforge"}.Contains(w) Then Return False '常见词
If Val(w) > 0 Then Return False '数字
Return True
End Function).Distinct.ToList
'如果一个词可以由其他词拼成,则去掉这个词(例如将 ender io enderio 的 enderio 剔除,只保留 ender io)
Dim CanForm As Func(Of String, Boolean) = Nothing
CanForm = Function(s) Candidates.Contains(s) OrElse Candidates.Any(Function(c) s.StartsWith(c) AndAlso CanForm(s.Substring(c.Length)))
Candidates = Candidates.Where(Function(w) Not Candidates.Any(Function(c) c.Length < w.Length AndAlso w.StartsWith(c) AndAlso CanForm(w.Substring(c.Length)))).ToList()
Return Candidates
End Function
'CurseForge
If Request.Sources.HasFlag(ResourcePlatforms.CurseForge) Then
'数据库搜索
Static CurseForgeSearchEntries As List(Of SearchEntry(Of WikiEntry)) =
WikiEntry.All.Where(Function(Entry) Entry.CurseForgeSlug IsNot Nothing).Select(
Function(Entry) New SearchEntry(Of WikiEntry) With {
.Item = Entry,
.SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.CurseForgeSlug, 0.5)}
}).ToList
Dim CurseForgeSearchResults = Search(CurseForgeSearchEntries, RawSearchText, 100, 0.25)
If CurseForgeSearchResults.Any Then
'选取目标(CurseForge 要求每个词都必须匹配上,所以只能选择一个 Mod 进行搜索)
Dim CurseForgeTarget =
If(CurseForgeSearchResults.First.AbsoluteRight,
CurseForgeSearchResults.Where(Function(s) s.AbsoluteRight).ToList, '优先使用所有完全匹配的
CurseForgeSearchResults.MaxByAll(Function(s) s.Similarity)). '其次使用所有相似度最高的
MaxBy(Function(s) s.Item.Popularity) '然后从中选择最受欢迎的那一个
'后处理
CurseForgeAltSearchText = ExtractWords(CurseForgeTarget, ResourcePlatforms.CurseForge).Join(" ")
Log("[Resource] 中文搜索关键词(CurseForge):" & CurseForgeAltSearchText, NotifyLevel.DebugModeOnly)
End If
End If
'Modrinth
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) Then
'数据库搜索
Static ModrinthSearchEntries As List(Of SearchEntry(Of WikiEntry)) =
WikiEntry.All.Where(Function(Entry) Entry.ModrinthSlug IsNot Nothing).Select(
Function(Entry) New SearchEntry(Of WikiEntry) With {
.Item = Entry,
.SearchSource = New List(Of SearchSource) From {
New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名
New SearchSource(Entry.ChineseName.AfterFirst(" (") & Entry.ModrinthSlug, 0.5)}
}).ToList
Dim ModrinthSearchResults = Search(ModrinthSearchEntries, RawSearchText, 100, 0.25)
If ModrinthSearchResults.Any Then
'分词
Dim WordWeights As New Dictionary(Of String, Double) '各个单词及其出现的权重
For Each Result In ModrinthSearchResults
For Each Word In ExtractWords(Result, ResourcePlatforms.Modrinth)
If Not WordWeights.ContainsKey(Word) Then WordWeights.Add(Word, 0)
Dim Similarity = If(Result.SearchSource.Any(Function(s) s.Aliases.Contains(RawSearchText)), 1000, Result.Similarity) '完全匹配为 1000
WordWeights(Word) += Similarity * Result.Item.Popularity '权重 += 相似度 * 受欢迎程度
Next
Next
ModrinthAltSearchText = WordWeights.MaxBy(Function(w) w.Value).Key
Log("[Resource] 中文搜索关键词(Modrinth):" & ModrinthAltSearchText, NotifyLevel.DebugModeOnly)
'直接请求工程
ModrinthSlugs = ModrinthSearchResults.Take(100).Select(Function(r) r.Item.ModrinthSlug).ToList
End If
End If
'结束
If String.IsNullOrEmpty(CurseForgeAltSearchText) AndAlso String.IsNullOrEmpty(ModrinthAltSearchText) AndAlso Not ModrinthSlugs.Any Then
Throw New Exception(MSG_NO_CHINESE_RESULT)
End If
End If
Task.Progress = 0.05
#End Region
Dim RealResults As New List(Of ResourceProject)
NextPage:
Dim RawResults As New ConcurrentList(Of ResourceProject)
#Region "从 CurseForge 和 Modrinth 获取结果列表,存储于 RawResults"
Dim WorkThreads As New List(Of Thread)
Dim Errors As New ConcurrentList(Of (Ex As Exception, Source As ResourcePlatforms))
'在 1.14-,部分老 Mod 没有设置支持的加载器,因此添加 Forge 筛选就会出现遗漏
'所以,在发起请求时不筛选加载器,然后在返回的结果中自行筛除不是 Forge 的 Mod
Dim IgnoreModLoaderFilter = Request.ModLoader = ModLoaderTypes.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion) < 140
Try
'CurseForge 搜索
If Request.Sources.HasFlag(ResourcePlatforms.CurseForge) AndAlso
Not (Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset) AndAlso '剩余的未显示的搜索结果不足
(Not IsChineseSearch OrElse (IsChineseSearch AndAlso Not String.IsNullOrEmpty(CurseForgeAltSearchText))) Then '如果是中文搜索,就只在有对应搜索关键词的时候才继续
WorkThreads.Add(RunInNewThread(
Sub()
Try
'获取工程列表
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress(If(CurseForgeAltSearchText, RawSearchText), IgnoreModLoaderFilter)
Log("[Resource] 开始 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 将一些数据包分类成了资源包
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} 个)")
Catch ex As Exception
Log(ex, "CurseForge 搜索失败")
Storage.CurseForgeTotal = -1
Errors.Add((ex, ResourcePlatforms.CurseForge))
End Try
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页,所以不能直接给够
End Sub, "CurseForge Search"))
End If
'Modrinth 搜索
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) AndAlso
Not (Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset) AndAlso '剩余的未显示的搜索结果不足
(Not IsChineseSearch OrElse (IsChineseSearch AndAlso Not String.IsNullOrEmpty(ModrinthAltSearchText))) Then '如果是中文搜索,就只在有对应搜索关键词的时候才继续
WorkThreads.Add(RunInNewThread(
Sub()
Try
Dim ModrinthUrl As String = Request.GetModrinthAddress(If(ModrinthAltSearchText, RawSearchText), IgnoreModLoaderFilter)
Log("[Resource] 开始 Modrinth 搜索:" & ModrinthUrl)
Dim RequestResult As JObject = DlModRequest(ModrinthUrl)
Dim ProjectList As New List(Of ResourceProject)
For Each JsonEntry As JObject In RequestResult("hits")
ProjectList.Add(New ResourceProject(JsonEntry))
Next
'更新结果
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} 个)")
Catch ex As Exception
Log(ex, "Modrinth 搜索失败")
Storage.ModrinthTotal = -1
Errors.Add((ex, ResourcePlatforms.Modrinth))
End Try
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页,所以不能直接给够
End Sub, "Modrinth Search"))
End If
'Modrinth 直接获取工程
If Request.Sources.HasFlag(ResourcePlatforms.Modrinth) AndAlso
Not (Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset) AndAlso '剩余的未显示的搜索结果不足
ModrinthSlugs.Any Then '有直接获取的 Slug
WorkThreads.Add(RunInNewThread(
Sub()
Try
Dim ModrinthUrl As String = $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthSlugs.Join(""",""")}""]"
Log("[Resource] 开始 Modrinth 直接获取:" & ModrinthUrl)
Dim ProjectList As New List(Of ResourceProject)
For Each JsonEntry As JObject In DlModRequest(ModrinthUrl)
Dim Project As New ResourceProject(JsonEntry)
'应用筛选
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 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} 个工程")
ModrinthSlugs.Clear() '防止重试/加载下一页时重复获取
Catch ex As Exception
Log(ex, "Modrinth 直接获取失败")
Errors.Add((ex, ResourcePlatforms.Modrinth))
End Try
If Task.Progress < 0.75 Then Task.Progress += 0.25 '可能重复加载多页,所以不能直接给够
End Sub, "Modrinth Get"))
End If
'等待线程结束
For Each Thread In WorkThreads
Thread.Join()
If Task.IsInterrupted Then Return '会自动触发 Finally 以清理线程
Next
'筛除不是 Forge 的 Mod
If IgnoreModLoaderFilter Then
RawResults = RawResults.Where(Function(p) Not p.Loaders.Any() OrElse p.Loaders.Contains(ModLoaderTypes.Forge)).ToList
End If
'确保存在结果
Storage.ErrorMessage = Nothing
If Not RawResults.Any() Then
If Errors.Any() Then
Throw Errors.First.Ex
Else
If IsChineseSearch AndAlso Not (Request.Type = ResourceTypes.Mod OrElse Request.Type = ResourceTypes.DataPack) Then
Throw New Exception(MSG_NO_CHINESE_RESULT)
ElseIf Request.Sources = ResourcePlatforms.CurseForge AndAlso Request.Tag.StartsWithF("/") Then
Throw New Exception("CurseForge 不兼容所选的类型")
ElseIf Request.Sources = ResourcePlatforms.Modrinth AndAlso Request.Tag.EndsWithF("/") Then
Throw New Exception("Modrinth 不兼容所选的类型")
Else
Throw New Exception("没有搜索结果")
End If
End If
ElseIf Errors.Any() Then
'有结果但是有错误
If Errors.Any(Function(e) e.Source = ResourcePlatforms.CurseForge) Then
Storage.ErrorMessage = $"无法连接到 CurseForge,所以目前仅显示了来自 Modrinth 的内容,搜索结果可能不全。{vbCrLf}请稍后再试,或使用 VPN 改善网络环境。"
Else
Storage.ErrorMessage = $"无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。{vbCrLf}请稍后再试,或使用 VPN 改善网络环境。"
End If
End If
Finally
For Each Thread In WorkThreads
If Thread.IsAlive Then Thread.Interrupt()
Next
End Try
#End Region
#Region "提取非重复项,存储于 RealResults"
'将 CurseForge 排在 Modrinth 的前面,避免加载结束顺序不同导致排名不同
RawResults = RawResults.Where(Function(x) x.Platform = ResourcePlatforms.CurseForge).Concat(RawResults.Where(Function(x) x.Platform <> ResourcePlatforms.CurseForge)).ToList
'去重
RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b)).ToList
'已有内容去重
RawResults = RawResults.Where(Function(r) Not RealResults.Any(Function(b) r.IsLike(b)) AndAlso
Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList
'加入列表
RealResults.AddRange(RawResults)
Log($"[Resource] 去重、筛选后累计新增结果 {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} 个")
If Request.CanContinue AndAlso Not Errors.Any Then '如果有某个源失败则不再重试,这时候重试可能导致无限循环
Log("[Resource] 将继续尝试加载下一页")
GoTo NextPage
Else
Log("[Resource] 无法继续加载,将强制结束")
End If
End If
#End Region
#Region "将结果排序并添加"
Dim Scores As New Dictionary(Of ResourceProject, Double) '排序分
Dim GetDownloadCountMult =
Function(Project As ResourceProject) As Double
Select Case Request.Type
Case ResourceTypes.Mod, ResourceTypes.ModPack
Return If(Project.Platform = ResourcePlatforms.CurseForge, 1, 5)
Case ResourceTypes.DataPack
Return If(Project.Platform = ResourcePlatforms.CurseForge, 10, 1)
Case ResourceTypes.ResourcePack, ResourceTypes.Shader
Return If(Project.Platform = ResourcePlatforms.CurseForge, 1, 4)
Case Else
Return 1
End Select
End Function
If String.IsNullOrEmpty(RawSearchText) Then
'如果没有搜索文本,按下载量将结果排序
For Each Result As ResourceProject In RealResults
Scores(Result) = Result.DownloadCount * GetDownloadCountMult(Result)
Next
Else
'如果有搜索文本,按关联度将结果排序
'排序分 = 搜索相对相似度 (1) + 下载量权重 (对数,10 亿时为 1) + 有中文名 (0.2)
Dim SearchEntries As New List(Of SearchEntry(Of ResourceProject))
For Each Result As ResourceProject In RealResults
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(Result.Description, 0.05)}})
Next
Dim SearchResult = Search(SearchEntries, RawSearchText, 10000, -1)
For Each OneResult In SearchResult
Scores(OneResult.Item) +=
If(OneResult.AbsoluteRight, 10, OneResult.Similarity) /
If(SearchResult.First.AbsoluteRight, 10, SearchResult.First.Similarity) '最高 1 分的相似度分
Next
End If
'根据排序分得出结果并添加
If Task.IsInterrupted Then Throw New ThreadInterruptedException '#8246
Storage.Results.AddRange(
Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
#End Region
End Sub
End Class
@@ -0,0 +1,405 @@
''' <summary>
''' 社区资源的单个可下载版本。
''' </summary>
Public Class ResourceVersion
'基础字段
''' <summary>
''' 用于唯一性鉴别该版本的 ID。CurseForge 中为 123456 的大整数,Modrinth 中为英文乱码的 Version 字段。
''' </summary>
Public Id As String
''' <summary>
''' 该版本所对应的单一资源类别。
''' </summary>
Public ResourceType As ResourceTypes
'描述性字段
''' <summary>
''' 版本描述名。
''' 并非文件名或版本号,是由上传者完全自定义的字段。
''' </summary>
Public Display As String
''' <summary>
''' 发布时间。
''' </summary>
Public ReleaseDate As Date
''' <summary>
''' 下载量计数。
''' 注意,仅为一个平台的计数,无法反映多平台加起来的下载量,且 CurseForge 可能错误地返回 0。
''' </summary>
Public DownloadCount As Integer
''' <summary>
''' 版本号。
''' 不一定是标准格式。CurseForge 默认为 Nothing。
''' </summary>
Public Version As String
''' <summary>
''' 支持的 Mod 加载器列表。
''' 可能为空列表,不为 Nothing。
''' </summary>
Public Loaders As List(Of ModLoaderTypes)
''' <summary>
''' 支持的游戏版本列表。类型包括:"26.1.5","26.1","26.1 预览版","1.18.5","1.18","1.18 预览版","21w15a","未知版本"。
''' </summary>
Public GameVersions As List(Of String)
''' <summary>
''' 发布状态。
''' </summary>
Public ReleaseType As ReleaseTypes
''' <summary>
''' 发布状态的友好描述。
''' 例如:"正式版","Beta 版"。
''' </summary>
Public ReadOnly Property ReleaseTypeDisplay As String
Get
Select Case ReleaseType
Case ReleaseTypes.Release
Return "正式版"
Case ReleaseTypes.Beta
Return If(ModeDebug, "Beta 版", "测试版")
Case Else
Return If(ModeDebug, "Alpha 版", "早期测试版")
End Select
End Get
End Property
Public Enum ReleaseTypes
'https://docs.curseforge.com/rest-api/#tocS_FileReleaseType
Release = 1
Beta = 2
Alpha = 3
End Enum
'下载信息
''' <summary>
''' 下载信息是否可用。
''' </summary>
Public ReadOnly Property DownloadAvailable As Boolean
Get
Return FileName IsNot Nothing AndAlso DownloadUrls IsNot Nothing
End Get
End Property
''' <summary>
''' 文件名。
''' </summary>
Public FileName As String = Nothing
''' <summary>
''' 对应文件的所有可能的下载 URL。
''' </summary>
Public DownloadUrls As List(Of String)
''' <summary>
''' 对应文件的 SHA1 或 MD5。
''' </summary>
Public Hash As String = Nothing
''' <summary>
''' 文件大小。不可用时为 -1。
''' </summary>
Public Size As Integer = -1
''' <summary>
''' 作为该版本依赖项的项目 ID。
''' 它们可能没有加载,在加载后会添加到 Dependencies 中(主要是因为 Modrinth 返回的是字符串 ID 而非 Slug,导致 Project.Id 查询不到)。
''' </summary>
Private RawDependencies As New List(Of String)
''' <summary>
''' 作为该版本依赖项的项目 ID。
''' </summary>
Public Dependencies As New List(Of String)
'初始化
''' <summary>
''' 从平台 API 返回的 JSON 中初始化实例。若出错会抛出异常。
''' </summary>
Public Shared Function FromPlatformJson(Data As JObject, ExpectedResourceType As ResourceTypes) As ResourceVersion
Dim Result As New ResourceVersion
With Result
.ResourceType = ExpectedResourceType
If Data.ContainsKey("gameId") Then
#Region "CurseForge"
'简单信息
.Id = Data("id")
.Display = Data("displayName").ToString.Replace(" ", "").Trim(" ")
.Version = Nothing
.ReleaseDate = Data("fileDate")
.ReleaseType = CType(Data("releaseType").ToObject(Of Integer), ReleaseTypes)
.DownloadCount = Data("downloadCount")
.FileName = Data("fileName")
.Size = Data("fileLength")
.Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 1)?("value")
If .Hash Is Nothing Then .Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
'DownloadAddress
Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = $"https://edge.forgecdn.net/files/{CInt(.Id.ToString.Substring(0, 4))}/{CInt(.Id.ToString.Substring(4))}/{ .FileName}"
.DownloadUrls = ParseCurseForgeDownloadUrls(Url.Replace(.FileName, EscapeUtils.UrlEscape(.FileName))) '对脑残 CurseForge 的下载地址进行多种修正
.DownloadUrls.Add(DlSourceModGet(Url)) '添加镜像源;注意 MCIM 源不支持 URL 编码后的文件名,必须传入 URL 编码前的文件名
.DownloadUrls = .DownloadUrls.Distinct.ToList '最终去重
'Dependencies
If Data.ContainsKey("dependencies") Then
.RawDependencies = Data("dependencies").
Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖
d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API
Select(Function(d) d("modId").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.Lower).ToList
.GameVersions = RawVersions.
Where(Function(v) McVersion.IsFormatFit(v)).
Select(Function(v) v.Replace("-snapshot", " 预览版")).
Distinct.ToList
If .GameVersions.IsSingle Then
.GameVersions = .GameVersions.ToList
ElseIf .GameVersions.Count > 1 Then
.GameVersions = .GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
If .ResourceType = ResourceTypes.ModPack Then .GameVersions = { .GameVersions(0)}.ToList '整合包理应只 “支持” 一个版本
Else
.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)
#End Region
Else
#Region "Modrinth"
'简单信息
.Id = Data("id")
.Display = Data("name").ToString.Replace(" ", "").Trim(" ")
.Version = Data("version_number")
.ReleaseDate = Data("date_published")
.ReleaseType = If(Data("version_type").ToString = "release", ReleaseTypes.Release, If(Data("version_type").ToString = "beta", ReleaseTypes.Beta, ReleaseTypes.Alpha))
.DownloadCount = Data("downloads")
If CType(Data("files"), JArray).Any() Then '可能为空
Dim File As JToken = Data("files")(0)
.FileName = File("filename")
.DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
.Size = File("size")
.Hash = File("hashes")("sha1")
End If
'Loaders
'结果可能混杂着 Mod、数据包和服务端插件
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
.Loaders = New List(Of ModLoaderTypes)
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
Else
'使用传入的类别,不作修改(#8377)
End If
'Dependencies
If Data.ContainsKey("dependencies") Then
.RawDependencies = Data("dependencies").
Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖
d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API
d("project_id").ToString.Length > 0). '有时候真的会空……
Select(Function(d) d("project_id").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.Lower).ToList
.GameVersions = RawVersions.Where(Function(v) v.Contains(".")).
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).
Distinct.ToList
If .GameVersions.IsSingle Then
'无需处理
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
Else
.GameVersions = New List(Of String) From {"未知版本"}
End If
#End Region
End If
End With
Return Result
End Function
''' <summary>
''' 从项目 ID 获取其下的全部版本列表,并获取其前置项目信息。
''' </summary>
Public Shared Function FromProjectId(ProjectId As String, Platform As ResourcePlatforms, Optional LoadDependencies As Boolean = True) As List(Of ResourceVersion)
If Not Platform.Flags.IsSingle Then Throw New ArgumentException($"必须指定单一平台,当前值为 {Platform}")
Dim TargetProject = ResourceProject.FromProjectId(ProjectId, Platform)
'获取项目对象的文件列表
If Not ProjectFilesCache.ContainsKey(ProjectId) Then
Log("[Resource] 开始获取项目版本列表:" & ProjectId)
Dim ResultJsonArray As JArray = Nothing
If Platform = ResourcePlatforms.CurseForge Then
For RetryCount As Integer = 0 To 2
Dim ResultJson As JObject = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=" &
(10000 + RetryCount)) '每次重试多请求一个文件,以避免触发 CDN 缓存
'HMCL 一次性请求了 10000 个文件,虽然不知道会不会出问题但先这样吧……(#5522)
'之前只请求一部分文件的方法备份如下:
'If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
' ResultJsonArray = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json")("data")
'Else '否则使用全部文件
' ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999")("data")
'End If
If ResultJson("pagination")("resultCount").ToObject(Of Integer) = ResultJson("pagination")("totalCount").ToObject(Of Integer) Then
ResultJsonArray = ResultJson("data")
Exit For
ElseIf RetryCount < 2 Then
Log($"[Resource] CurseForge 返回的资源版本列表存在缺失,即将进行第 {RetryCount + 1} 次重试", NotifyLevel.DebugModeOnly) '#6224
Log($"[Resource] 返回的原始内容如下:{vbCrLf}{ResultJson}")
Else
Log($"[Resource] CurseForge 返回的资源版本列表存在缺失,返回的原始内容如下:{vbCrLf}{ResultJson}")
Throw New Exception("CurseForge 返回的资源版本列表存在缺失")
End If
Next
Else 'Modrinth
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version?include_changelog=false")
End If
ProjectFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) ResourceVersion.FromPlatformJson(a, TargetProject.Types)).
Where(Function(a) a.DownloadAvailable).
DistinctBy(Function(a) a.Id).ToList 'CurseForge 可能会重复返回相同项(#1330)
End If
Dim Result As List(Of ResourceVersion) = ProjectFilesCache(ProjectId)
If Not LoadDependencies Then Return Result
'加载前置信息
Dim Dependencies As List(Of String) = Result.SelectMany(Function(f) f.RawDependencies).Distinct().ToList
If Dependencies.Any Then
Log($"[Resource] 项目 {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
File.Dependencies.Add(DependencyProject.Id)
End If
Next
Next
End If
Return Result
End Function
''' <summary>
''' 项目 ID 对应的版本信息的缓存。不会保存到文件。
''' </summary>
Protected Friend Shared ProjectFilesCache As New Dictionary(Of String, List(Of ResourceVersion))
'序列化
''' <summary>
''' 从缓存 JSON 读取字段数据。
''' </summary>
Public Shared Function FromCacheJson(Data As JObject) As ResourceVersion
Dim Result As New ResourceVersion
With Result
.ResourceType = CType(Data("ResourceType").ToObject(Of Integer), 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)
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("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))
If Data.ContainsKey("RawDependencies") Then .RawDependencies = Data("RawDependencies").ToObject(Of List(Of String))
If Data.ContainsKey("Dependencies") Then .Dependencies = Data("Dependencies").ToObject(Of List(Of String))
End With
Return Result
End Function
''' <summary>
''' 转为缓存 JSON。
''' </summary>
Public Function ToCacheJson() As JObject
Dim Result As New JObject
With Result
.Add("ResourceType", ResourceType)
.Add("Id", Id)
If Version IsNot Nothing Then .Add("Version", Version)
.Add("DisplayName", Display)
.Add("ReleaseDate", ReleaseDate)
.Add("DownloadCount", DownloadCount)
.Add("ModLoaders", New JArray(Loaders.Select(Function(m) CInt(m))))
.Add("GameVersions", New JArray(GameVersions))
.Add("ReleaseType", CInt(ReleaseType))
If FileName IsNot Nothing Then .Add("FileName", FileName)
If DownloadUrls IsNot Nothing Then .Add("DownloadUrls", New JArray(DownloadUrls))
If Hash IsNot Nothing Then .Add("Hash", Hash)
If Size >= 0 Then .Add("Size", Size)
.Add("RawDependencies", New JArray(RawDependencies))
.Add("Dependencies", New JArray(Dependencies))
End With
Return Result
End Function
'杂项
''' <summary>
''' 转为列表项。
''' </summary>
Public Function ToListItem(ClickHandler As MyListItem.ClickEventHandler, Optional SaveAsButtonHandler As MyIconButton.ClickEventHandler = Nothing,
Optional IsBadDisplay As Boolean = False) As MyVirtualizingElement(Of MyListItem)
Return New MyVirtualizingElement(Of MyListItem)(
Function()
Dim Result As New MyListItem
With Result
'基础属性
.SnapsToDevicePixels = True
.Height = 42
.Type = MyListItem.CheckType.Clickable
.Tag = Me
.Title = If(IsBadDisplay, FileName, Display)
.Logo = $"{PathImage}ReleaseTypes/{ReleaseType}.png"
AddHandler .Click, ClickHandler
'描述
.Info =
Iterator Function()
If .Title <> FileName.BeforeLast(".") Then Yield FileName.BeforeLast(".")
If Dependencies.Any Then Yield $"{Dependencies.Count} 项前置"
If GameVersions.All(Function(v) Not v.Contains(".") OrElse {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) v.ContainsIgnoreCase(s))) Then Yield $"游戏版本 {GameVersions.Join("、"c)}"
If DownloadCount > 0 Then Yield $"下载 {If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万", DownloadCount)} 次" 'CurseForge 的下载次数经常错误地返回 0
Yield $"更新于 {GetTimeSpanString(ReleaseDate - Date.Now, False)}"
If ReleaseType <> ReleaseTypes.Release Then Yield ReleaseTypeDisplay
End Function().Join(","c)
'另存为按钮
If SaveAsButtonHandler IsNot Nothing Then
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnSave, 30)
ToolTipService.SetHorizontalOffset(BtnSave, 2)
AddHandler BtnSave.Click, SaveAsButtonHandler
.Buttons = {BtnSave}
End If
End With
Return Result
End Function) With {.Height = 42}
End Function
''' <summary>
''' 获取下载信息。
''' </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)
End Function
''' <summary>
''' 重新整理 CurseForge 的下载地址。
''' </summary>
Public Shared Function ParseCurseForgeDownloadUrls(Url As String) As List(Of String)
Return {
Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge.", "://mediafilez.").Replace("://media.", "://mediafilez."),
Url.Replace("://edge.", "://mediafilez.").Replace("://media.", "://mediafilez."),
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://media.", "://edge."),
Url
}.Distinct.ToList
End Function
Public Overrides Function ToString() As String
Return $"{Id}: {FileName}"
End Function
End Class
@@ -0,0 +1,85 @@
'获取所有条目:WikiEntry.All
''' <summary>
''' MC 百科条目。
''' </summary>
Public Class WikiEntry
'属性
''' <summary>
''' 在 MC 百科中的对应 ID。
''' </summary>
Public Id As Integer
''' <summary>
''' 中文译名。空字符串代表没有翻译。
''' </summary>
Public ChineseName As String = ""
''' <summary>
''' CurseForge Slug(例如 advanced-solar-panels)。
''' </summary>
Public CurseForgeSlug As String = Nothing
''' <summary>
''' Modrinth Slug(例如 advanced-solar-panels)。
''' </summary>
Public ModrinthSlug As String = Nothing
''' <summary>
''' MC 百科的浏览量逆序排行,1 代表浏览量最低。
''' </summary>
Public Popularity As Integer
Public Overrides Function ToString() As String
Return If(CurseForgeSlug, "") & "&" & If(ModrinthSlug, "") & "|" & Id & "|" & ChineseName & ", Rank " & Popularity
End Function
'读取
''' <summary>
''' 内置数据库中的所有 MC 百科条目。
''' </summary>
Public Shared ReadOnly Property All As List(Of WikiEntry)
Get
Static Cache As List(Of WikiEntry) = Nothing
If Cache IsNot Nothing Then Return Cache
'实际加载
Cache = New List(Of WikiEntry)
Dim 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)
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
Entry.CurseForgeSlug = Nothing
Entry.ModrinthSlug = Splited(1).Replace("@", "")
ElseIf Splited(1).EndsWithF("@") Then
Entry.CurseForgeSlug = Splited(1).TrimEnd("@")
Entry.ModrinthSlug = Entry.CurseForgeSlug
ElseIf Splited(1).Contains("@") Then
Entry.CurseForgeSlug = Splited(1).Split("@")(0)
Entry.ModrinthSlug = Splited(1).Split("@")(1)
Else
Entry.CurseForgeSlug = Splited(1)
Entry.ModrinthSlug = Nothing
End If
Entry.Id = i
If Splited.Count >= 3 Then
Entry.ChineseName = Splited.Last
If Entry.ChineseName.Contains("*") Then '处理 *
Entry.ChineseName = Entry.ChineseName.Replace("*",
$" ({If(Entry.CurseForgeSlug, Entry.ModrinthSlug).Replace("-", " ").Capitalize})")
End If
End If
Cache.Add(Entry)
Next
Next
Return Cache
End Get
End Property
End Class
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.12.6.2")>
<Assembly: AssemblyFileVersion("2.12.6.2")>
<Assembly: AssemblyVersion("2.12.7.0")>
<Assembly: AssemblyFileVersion("2.12.7.0")>
<Assembly: NeutralResourcesLanguage("")>
+30
View File
@@ -160,6 +160,26 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property MeloongCore() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("MeloongCore", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property MeloongCore_Wpf() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("MeloongCore.Wpf", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
@@ -200,6 +220,16 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property PCLCS() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("PCLCS", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
@@ -148,6 +148,12 @@
<data name="LUA" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\lwjgl-unsafe-agent.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="MeloongCore" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\..\PCLCS\bin\MeloongCore.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="MeloongCore.Wpf" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\..\PCLCS\bin\MeloongCore.Wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\moddata.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
@@ -160,6 +166,9 @@
<data name="Ookii.Dialogs.Wpf" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\resources\ookii.dialogs.wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="PCLCS" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\..\PCLCS\bin\PCLCS.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<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>
@@ -1,6 +1,4 @@
Imports System.IO.Compression
Public Module ModDownloadLib
Public Module ModDownloadLib
#Region "Minecraft 下载"
@@ -51,7 +49,7 @@ Public Module ModDownloadLib
Try
Dim InstanceJson As JObject = GetJson(ReadFile(VersionFolder & InstanceName & ".json"))
InstanceJson.Add("clientVersion", Id)
WriteFile($"{VersionFolder}{InstanceName}.json", InstanceJson.ToString)
FileUtils.Write($"{VersionFolder}{InstanceName}.json", InstanceJson.ToString)
Catch ex As Exception
Throw New Exception("添加客户端版本失败", ex)
End Try
@@ -206,7 +204,7 @@ echo ------------------------------
echo ----------------------
echo 服务端已停止。
pause"
WriteFile(VersionFolder & "Launch Server.bat", Bat,
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")
@@ -221,7 +219,7 @@ pause"
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 服务端下载失败", LogLevel.Feedback)
Log(ex, "开始 Minecraft 服务端下载失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Public Sub McDownloadMenuSave(sender As Object, e As RoutedEventArgs)
@@ -266,7 +264,7 @@ pause"
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 下载失败", LogLevel.Feedback)
Log(ex, "开始 Minecraft 下载失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
''' <summary>
@@ -325,7 +323,7 @@ pause"
ElseIf Id.StartsWithF("rd-") Then
WikiName = "Java版Pre-classic_" & Id
Else
Log("[Error] 未知的版本格式:" & Id & "。", LogLevel.Feedback)
Log("[Error] 未知的版本格式:" & Id & "。", NotifyLevel.MsgBoxAndFeedback)
Return
End If
OpenWebsite("https://zh.minecraft.wiki/w/" & WikiName.Replace("_experimental-snapshot-", "-exp"))
@@ -355,7 +353,7 @@ pause"
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 OptiFine 下载失败", LogLevel.Feedback)
Log(ex, "开始 OptiFine 下载失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean), UseJavaWrapper As Boolean)
@@ -397,7 +395,7 @@ pause"
.CreateNoWindow = True,
.RedirectStandardError = True,
.RedirectStandardOutput = True,
.WorkingDirectory = ShortenPath(BaseMcFolderHome)
.WorkingDirectory = FileUtils.ShortenPath(BaseMcFolderHome)
}
If Info.EnvironmentVariables.ContainsKey("appdata") Then
Info.EnvironmentVariables("appdata") = BaseMcFolderHome
@@ -534,7 +532,7 @@ pause"
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
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")
End If
@@ -556,7 +554,7 @@ pause"
If Directory.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then
DeleteDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit)
End If
Directory.CreateDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\")
DirectoryUtils.Create(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\")
McFolderLauncherProfilesJsonCreate(BaseMcFolder)
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
@@ -595,7 +593,7 @@ Retry:
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Try
'新建版本文件夹
Directory.CreateDirectory(VersionFolder)
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.1
'复制 Jar 文件
If File.Exists(VersionFolder & Id & ".jar") Then File.Delete(VersionFolder & Id & ".jar")
@@ -633,7 +631,7 @@ Retry:
}
}"
End If
WriteFile(VersionFolder & Id & ".json", Json)
FileUtils.Write(VersionFolder & Id & ".json", Json)
Catch ex As Exception
Throw New Exception("安装 OptiFine(方式 B)失败", ex)
End Try
@@ -798,7 +796,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 LiteLoader 安装器下载失败", LogLevel.Feedback)
Log(ex, "开始 LiteLoader 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -820,8 +818,6 @@ Retry:
Loaders.Add(New LoaderTask(Of String, String)("安装 LiteLoader",
Sub(Task As LoaderTask(Of String, String))
Try
'新建版本文件夹
Directory.CreateDirectory(VersionFolder)
'构造版本 Json
Dim VersionJson As New JObject
VersionJson.Add("id", VersionName)
@@ -835,8 +831,8 @@ Retry:
VersionJson.Add("minimumLauncherVersion", 18)
VersionJson.Add("inheritsFrom", DownloadInfo.Inherit)
VersionJson.Add("jar", DownloadInfo.Inherit)
'输出 Json 文件
WriteFile(VersionFolder & VersionName & ".json", VersionJson.ToString)
'输出 Json 文件,同时会新建该文件夹
FileUtils.Write(VersionFolder & VersionName & ".json", VersionJson.ToString)
Catch ex As Exception
Throw New Exception("安装新 LiteLoader 版本失败", ex)
End Try
@@ -966,7 +962,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, $"开始 {Info.LoaderName} 安装器下载失败", LogLevel.Feedback)
Log(ex, $"开始 {Info.LoaderName} 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -1235,7 +1231,7 @@ Retry:
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, LogLevel.Debug)
Log($"[Download] 已从待下载 {LoaderName} 支持库中移除:" & Libs(i).LocalPath, NotifyLevel.DebugModeOnly)
Libs.RemoveAt(i)
Exit For
End If
@@ -1256,7 +1252,7 @@ Retry:
For Each LibFile As McLibToken In Libs
Dim RealPath As String = LibFile.LocalPath.Replace(McFolderSelected, McFolder)
If Not File.Exists(RealPath) Then
Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath))
DirectoryUtils.Create(RealPath, isFilePath:=True)
CopyFile(LibFile.LocalPath, RealPath)
End If
If ModeDebug Then Log($"[Download] 复制的 {LoaderName} 支持库文件:" & LibFile.LocalPath)
@@ -1278,7 +1274,7 @@ Retry:
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Directory.CreateDirectory(McFolder & "versions\" & Inherit)
DirectoryUtils.Create(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
End If
@@ -1299,7 +1295,7 @@ Retry:
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
'新建目标版本文件夹
Directory.CreateDirectory(VersionFolder)
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.04
'释放 launcher_installer.json
McFolderLauncherProfilesJsonCreate(McFolder)
@@ -1309,7 +1305,7 @@ Retry:
Retry:
Try
'释放 Forge 注入器
WriteFile(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
FileUtils.Write(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
Task.Progress = 0.06
'运行注入器
ForgelikeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper, IsNeoForge)
@@ -1329,13 +1325,13 @@ Retry:
If DeltaList.Count > 1 Then
'它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
'也可能是因为 Forge 安装器的 Bug,生成了一个名字错误的文件夹,所以需要检查文件夹是否为空
DeltaList = DeltaList.Where(Function(l) l.Name.ContainsF("forge", True) AndAlso l.EnumerateFiles.Any).ToList
DeltaList = DeltaList.Where(Function(l) l.Name.ContainsIgnoreCase("forge") AndAlso l.EnumerateFiles.Any).ToList
End If
If DeltaList.Count = 1 Then
'如果没有新增文件夹,那么预测的文件夹名就是正确的
'如果只新增 1 个文件夹,那么拷贝 json 文件
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
WriteFile(VersionFolder & NewInstanceName & ".json", ReadFile(JsonFile.FullName))
FileUtils.Write(VersionFolder & NewInstanceName & ".json", ReadFile(JsonFile.FullName))
Log($"[Download] 已拷贝新增的版本 JSON 文件:{JsonFile.FullName} -> {VersionFolder}{NewInstanceName}.json")
ElseIf DeltaList.Count > 1 Then
'新增了多个文件夹
@@ -1368,7 +1364,7 @@ Retry:
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Task.Progress = 0.4
'新建版本文件夹
Directory.CreateDirectory(VersionFolder)
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.5
If Json("install") Is Nothing Then
'中版:Legacy 方式 1
@@ -1376,7 +1372,7 @@ Retry:
'建立 Json 文件
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
JsonVersion("id") = NewInstanceName
WriteFile(VersionFolder & NewInstanceName & ".json", JsonVersion.ToString)
FileUtils.Write(VersionFolder & NewInstanceName & ".json", JsonVersion.ToString)
Task.Progress = 0.6
'解压支持库文件
Installer.Dispose()
@@ -1389,12 +1385,12 @@ Retry:
'解压 Jar 文件
Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
If File.Exists(JarAddress) Then File.Delete(JarAddress)
WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
FileUtils.Write(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
Task.Progress = 0.9
'建立 Json 文件
Json("versionInfo")("id") = NewInstanceName
If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit)
WriteFile(VersionFolder & NewInstanceName & ".json", Json("versionInfo").ToString)
FileUtils.Write(VersionFolder & NewInstanceName & ".json", Json("versionInfo").ToString)
End If
Catch ex As Exception
Throw New Exception("非新版方式安装 Forge 失败", ex)
@@ -1542,7 +1538,7 @@ Retry:
If RecommendedList.Count < 5 Then Throw New Exception("获取的推荐版本数过少(" & Result & ")")
'保存
Dim CacheJson As String = "{" & RecommendedList.Join(",") & "}"
WriteFile(PathTemp & "Cache\ForgeRecommendedList.json", CacheJson)
FileUtils.Write(PathTemp & "Cache\ForgeRecommendedList.json", CacheJson)
Log("[Download] 刷新 Forge 推荐版本缓存成功")
Catch ex As Exception
Log(ex, "刷新 Forge 推荐版本缓存失败")
@@ -1566,7 +1562,7 @@ Retry:
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") & ")", LogLevel.Feedback)
Log(ex, "获取 Forge 推荐版本失败(" & If(McVersion, "null") & ")", NotifyLevel.MsgBoxAndFeedback)
Return Nothing
End Try
End Function
@@ -1591,7 +1587,7 @@ Retry:
End If
Next
Else
Log("[System] 未找到可用的 NeoForge 版本", LogLevel.Debug)
Log("[System] 未找到可用的 NeoForge 版本", NotifyLevel.DebugModeOnly)
End If
'显示各个版本
If FreshStableVersion IsNot Nothing Then
@@ -1705,7 +1701,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Fabric 安装器下载失败", LogLevel.Feedback)
Log(ex, "开始 Fabric 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -1751,24 +1747,24 @@ Retry:
Return NewItem
End Function) With {.Height = 42}
End Function
Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyVirtualizingElement(Of MyListItem)
Public Function FabricApiDownloadListItem(Entry As ResourceVersion, OnClick As MyListItem.ClickEventHandler) As MyVirtualizingElement(Of MyListItem)
Return New MyVirtualizingElement(Of MyListItem)(
Function()
Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").BeforeFirst("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Title = Entry.Display.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").BeforeFirst("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.ReleaseTypeDisplay & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Logo = PathImage & "Blocks/Fabric.png"
}
AddHandler NewItem.Click, OnClick
Return NewItem
End Function) With {.Height = 42}
End Function
Public Function OptiFabricDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyVirtualizingElement(Of MyListItem)
Public Function OptiFabricDownloadListItem(Entry As ResourceVersion, OnClick As MyListItem.ClickEventHandler) As MyVirtualizingElement(Of MyListItem)
Return New MyVirtualizingElement(Of MyListItem)(
Function()
Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.Lower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v"), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Title = Entry.Display.Lower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v"), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.ReleaseTypeDisplay & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Logo = PathImage & "Blocks/OptiFabric.png"
}
AddHandler NewItem.Click, OnClick
@@ -1841,12 +1837,12 @@ Retry:
''' <summary>
''' 欲下载的 Fabric API 信息。
''' </summary>
Public FabricApi As CompFile = Nothing
Public FabricApi As ResourceVersion = Nothing
''' <summary>
''' 欲下载的 OptiFabric 信息。
''' </summary>
Public OptiFabric As CompFile = Nothing
Public OptiFabric As ResourceVersion = Nothing
''' <summary>
''' 欲下载的 LiteLoader 详细信息。
@@ -1894,9 +1890,9 @@ Retry:
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, LogLevel.Developer)
Log("[Download] 由于版本已被独立启动,不清理版本文件夹:" & Loader.Input, NotifyLevel.DevelopOnly)
Else
Log("[Download] 由于下载失败或取消,清理版本文件夹:" & Loader.Input, LogLevel.Developer)
Log("[Download] 由于下载失败或取消,清理版本文件夹:" & Loader.Input, NotifyLevel.DevelopOnly)
DeleteDirectory(Loader.Input)
End If
End If
@@ -1924,7 +1920,7 @@ Retry:
Catch ex As CancelledException
Return False
Catch ex As Exception
Log(ex, "开始合并安装失败", LogLevel.Feedback)
Log(ex, "开始合并安装失败", NotifyLevel.MsgBoxAndFeedback)
Return False
End Try
End Function
@@ -1945,9 +1941,9 @@ Retry:
Request.OptiFineEntry = New DlOptiFineListEntry With {
.DisplayName = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"),
.Inherit = Request.MinecraftName,
.IsPreview = Request.OptiFineVersion.ContainsF("pre", True),
.IsPreview = Request.OptiFineVersion.ContainsIgnoreCase("pre"),
.InstanceName = Request.MinecraftName & "-OptiFine_" & Request.OptiFineVersion,
.FileName = If(Request.OptiFineVersion.ContainsF("pre", True), "preview_", "") &
.FileName = If(Request.OptiFineVersion.ContainsIgnoreCase("pre"), "preview_", "") &
"OptiFine_" & Request.MinecraftName & "_" & Request.OptiFineVersion & ".jar"
}
End If
@@ -1992,7 +1988,7 @@ Retry:
Dim LoaderList As New List(Of LoaderBase)
'添加忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(VersionFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() FileUtils.Write(VersionFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
'Fabric API
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})
@@ -2049,11 +2045,11 @@ Retry:
If Directory.Exists(ModsTempFolder) Then
CopyDirectory(ModsTempFolder, ModsFolder)
ElseIf Modable Then
Directory.CreateDirectory(ModsFolder)
DirectoryUtils.Create(ModsFolder)
Log("[Download] 自动创建 Mod 文件夹:" & ModsFolder)
End If
Dim ResourcepacksFolder = New McInstance(VersionFolder).PathIndie & "resourcepacks\"
Directory.CreateDirectory(ResourcepacksFolder)
DirectoryUtils.Create(ResourcepacksFolder)
Log("[Download] 自动创建资源包文件夹:" & ResourcepacksFolder)
End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件
@@ -2079,7 +2075,7 @@ Retry:
If(NeoForgeFolder IsNot Nothing, ",NeoForge:" & NeoForgeFolder, "") &
If(LiteLoaderFolder IsNot Nothing, ",LiteLoader:" & LiteLoaderFolder, "") &
If(FabricFolder IsNot Nothing, ",Fabric:" & FabricFolder, ""))
Directory.CreateDirectory(OutputFolder)
DirectoryUtils.Create(OutputFolder)
Dim HasOptiFine As Boolean = OptiFineFolder IsNot Nothing AndAlso Not OptiFineAsMod, HasForge As Boolean = ForgeFolder IsNot Nothing, HasNeoForge As Boolean = NeoForgeFolder IsNot Nothing, HasLiteLoader As Boolean = LiteLoaderFolder IsNot Nothing, HasFabric As Boolean = FabricFolder IsNot Nothing
Dim OutputName As String, MinecraftName As String, OptiFineName As String, ForgeName As String, NeoForgeName As String, LiteLoaderName As String, FabricName As String
@@ -2227,7 +2223,7 @@ Retry:
#End Region
#Region "保存"
WriteFile(OutputJsonPath, OutputJson.ToString)
FileUtils.Write(OutputJsonPath, OutputJson.ToString)
If MinecraftJar <> OutputJar Then '可能是同一个文件
If File.Exists(OutputJar) Then File.Delete(OutputJar)
CopyFile(MinecraftJar, OutputJar)
@@ -2258,19 +2254,19 @@ Retry:
Static Lock As New Object
SyncLock Lock '避免 OptiFine 和 Forge 安装时同时释放导致冲突
Try
WriteFile(PatchPath, GetResources(Patch))
FileUtils.Write(PatchPath, GetResources(Patch))
Catch ex As Exception
If File.Exists(PatchPath) Then
'因为未知原因可能变为只读文件(#4243)
Log(ex, $"{Patch} 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Developer)
Log(ex, $"{Patch} 文件释放失败,但文件已存在,将在删除后尝试重新生成", NotifyLevel.DevelopOnly)
Try
File.Delete(PatchPath)
WriteFile(PatchPath, GetResources(Patch))
FileUtils.Write(PatchPath, GetResources(Patch))
Catch ex2 As Exception
Log(ex2, $"{Patch} 文件重新释放失败,将尝试更换文件名重新生成", LogLevel.Developer)
Log(ex2, $"{Patch} 文件重新释放失败,将尝试更换文件名重新生成", NotifyLevel.DevelopOnly)
PatchPath = $"{PathPure}{Patch}2.jar"
Try
WriteFile(PatchPath, GetResources(Patch))
FileUtils.Write(PatchPath, GetResources(Patch))
Catch ex3 As Exception
Throw New FileNotFoundException($"释放 {Patch} 最终尝试失败", ex3)
End Try
@@ -171,8 +171,8 @@
Private SelectedForge As DlForgeVersionEntry = Nothing
Private SelectedNeoForge As DlNeoForgeListEntry = Nothing
Private SelectedFabric As String = Nothing
Private SelectedFabricApi As CompFile = Nothing
Private SelectedOptiFabric As CompFile = Nothing
Private SelectedFabricApi As ResourceVersion = Nothing
Private SelectedOptiFabric As ResourceVersion = Nothing
''' <summary>
''' 重载已选择的项目的显示。
@@ -301,7 +301,7 @@
Else
BtnFabricApiClear.Visibility = Visibility.Visible
ImgFabricApi.Visibility = Visibility.Visible
LabFabricApi.Text = SelectedFabricApi.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim
LabFabricApi.Text = SelectedFabricApi.Display.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim
LabFabricApi.Foreground = ColorGray1
End If
End If
@@ -322,7 +322,7 @@
Else
BtnOptiFabricClear.Visibility = Visibility.Visible
ImgOptiFabric.Visibility = Visibility.Visible
LabOptiFabric.Text = SelectedOptiFabric.DisplayName.Lower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v")
LabOptiFabric.Text = SelectedOptiFabric.Display.Lower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v")
LabOptiFabric.Foreground = ColorGray1
End If
End If
@@ -531,9 +531,11 @@
Dim Item = McDownloadListItem(Version, Sub()
End Sub, False).Init()
MinecraftSelected(Item, Nothing)
VersionWaitingSelect = Nothing
Return
Next
Catch ex As Exception
Log(ex, "可视化安装版本列表出错", LogLevel.Feedback)
Log(ex, "可视化安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
''' <summary>
@@ -625,7 +627,7 @@
PanOptiFine.Children.Add(OptiFineDownloadListItem(Version, AddressOf OptiFine_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 OptiFine 安装版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 OptiFine 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -687,7 +689,7 @@
PanLiteLoader.Children.Add(LiteLoaderDownloadListItem(Version, AddressOf LiteLoader_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 LiteLoader 安装版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 LiteLoader 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -761,7 +763,7 @@
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 Forge 安装版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 Forge 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -819,7 +821,7 @@
PanNeoForge.Children.Add(NeoForgeDownloadListItem(Version, AddressOf NeoForge_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 NeoForge 安装版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 NeoForge 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -881,7 +883,7 @@
CardFabric.SwapControl = PanFabric
CardFabric.SwapType = 12
Catch ex As Exception
Log(ex, "可视化 Fabric 安装版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 Fabric 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -911,8 +913,8 @@
''' <summary>
''' 判断某 Fabric API 是否适配当前选择的原版版本。
''' </summary>
Public Function IsFabricApiCompatible(FabricApi As CompFile) As Boolean
Dim FabricApiName = FabricApi.DisplayName
Public Function IsFabricApiCompatible(FabricApi As ResourceVersion) As Boolean
Dim FabricApiName = FabricApi.Display
Try
If FabricApiName Is Nothing OrElse VanillaName Is Nothing Then Return False
FabricApiName = FabricApiName.Lower
@@ -978,12 +980,12 @@
If DlFabricApiLoader.State <> LoadState.Finished Then Return
If VanillaName Is Nothing OrElse SelectedFabric Is Nothing Then Return
'获取版本列表
Dim Versions As New List(Of CompFile)
Dim Versions As New List(Of ResourceVersion)
For Each Version In DlFabricApiLoader.Output
If IsFabricApiCompatible(Version) Then
If Not Version.DisplayName.StartsWithF("[") Then
Log("[Download] 已特判修改 Fabric API 显示名:" & Version.DisplayName, LogLevel.Debug)
Version.DisplayName = "[" & VanillaName & "] " & Version.DisplayName
If Not Version.Display.StartsWithF("[") Then
Log("[Download] 已特判修改 Fabric API 显示名:" & Version.Display, NotifyLevel.DebugModeOnly)
Version.Display = "[" & VanillaName & "] " & Version.Display
End If
Versions.Add(Version)
End If
@@ -1004,7 +1006,7 @@
FabricApi_Selected(Item, Nothing)
End If
Catch ex As Exception
Log(ex, "可视化 Fabric API 安装版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 Fabric API 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -1028,7 +1030,7 @@
''' <summary>
''' 判断某 OptiFabric 是否适配当前选择的原版版本。
''' </summary>
Private Function IsOptiFabricCompatible(ModFile As CompFile) As Boolean
Private Function IsOptiFabricCompatible(ModFile As ResourceVersion) As Boolean
Try
If VanillaName Is Nothing Then Return False
Return ModFile.GameVersions.Contains(VanillaName)
@@ -1076,7 +1078,7 @@
If DlOptiFabricLoader.State <> LoadState.Finished Then Return
If VanillaName Is Nothing OrElse SelectedFabric Is Nothing OrElse SelectedOptiFine Is Nothing Then Return
'获取版本列表
Dim Versions As New List(Of CompFile)
Dim Versions As New List(Of ResourceVersion)
For Each Version In DlOptiFabricLoader.Output
If IsOptiFabricCompatible(Version) Then Versions.Add(Version)
Next
@@ -1096,7 +1098,7 @@
Log($"[Download] 已自动选择 OptiFabric:{Item.Title}")
OptiFabric_Selected(Item, Nothing)
Catch ex As Exception
Log(ex, "可视化 OptiFabric 安装版本列表出错", LogLevel.Feedback)
Log(ex, "可视化 OptiFabric 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -53,7 +53,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败(ID " & ID & ")", LogLevel.Feedback)
Log(ex, "切换分页面失败(ID " & ID & ")", NotifyLevel.MsgBoxAndFeedback)
Finally
AniControlEnabled -= 1
End Try
@@ -89,6 +89,8 @@
Refresh(FrmMain.PageCurrentSub)
End Sub
Public Sub Refresh(SubType As FormMain.PageSubType)
ResourceProject.Cache.Clear()
ResourceVersion.ProjectFilesCache.Clear()
Select Case SubType
Case FormMain.PageSubType.DownloadInstall
DlClientListLoader.Start(IsForceRestart:=True)
@@ -101,46 +103,36 @@
DlOptiFabricLoader.Start(IsForceRestart:=True)
ItemInstall.Checked = True
Case FormMain.PageSubType.DownloadMod
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadMod IsNot Nothing Then
FrmDownloadMod.Content.Storage = New CompProjectStorage
FrmDownloadMod.Content.Storage = New ResourceSearcher.SearchResult
FrmDownloadMod.Content.Page = 0
FrmDownloadMod.PageLoaderRestart()
End If
ItemMod.Checked = True
Case FormMain.PageSubType.DownloadPack
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadPack IsNot Nothing Then
FrmDownloadPack.Content.Storage = New CompProjectStorage
FrmDownloadPack.Content.Storage = New ResourceSearcher.SearchResult
FrmDownloadPack.Content.Page = 0
FrmDownloadPack.PageLoaderRestart()
End If
ItemPack.Checked = True
Case FormMain.PageSubType.DownloadResourcePack
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadResourcePack IsNot Nothing Then
FrmDownloadResourcePack.Content.Storage = New CompProjectStorage
FrmDownloadResourcePack.Content.Storage = New ResourceSearcher.SearchResult
FrmDownloadResourcePack.Content.Page = 0
FrmDownloadResourcePack.PageLoaderRestart()
End If
ItemResourcePack.Checked = True
Case FormMain.PageSubType.DownloadShader
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadShader IsNot Nothing Then
FrmDownloadShader.Content.Storage = New CompProjectStorage
FrmDownloadShader.Content.Storage = New ResourceSearcher.SearchResult
FrmDownloadShader.Content.Page = 0
FrmDownloadShader.PageLoaderRestart()
End If
ItemShader.Checked = True
Case FormMain.PageSubType.DownloadDataPack
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadDataPack IsNot Nothing Then
FrmDownloadDataPack.Content.Storage = New CompProjectStorage
FrmDownloadDataPack.Content.Storage = New ResourceSearcher.SearchResult
FrmDownloadDataPack.Content.Page = 0
FrmDownloadDataPack.PageLoaderRestart()
End If
@@ -1,4 +1,4 @@
<Grid x:Class="MyCompItem"
<Grid x:Class="MyResourceItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
@@ -52,7 +52,7 @@
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<Grid.ColumnDefinitions>
<ColumnDefinition x:Name="ColumnVersion1" Width="Auto" />
<ColumnDefinition x:Name="ColumnVersion2" Width="Auto" SharedSizeGroup="CompItemVersion" />
<ColumnDefinition x:Name="ColumnVersion2" Width="Auto" SharedSizeGroup="ItemVersion" />
<ColumnDefinition x:Name="ColumnVersion3" Width="0.7*" />
<ColumnDefinition Width="Auto" />
@@ -60,11 +60,11 @@
<ColumnDefinition Width="1*" />
<ColumnDefinition x:Name="ColumnTime1" Width="Auto" />
<ColumnDefinition x:Name="ColumnTime2" Width="Auto" MinWidth="57" SharedSizeGroup="CompItemTime" />
<ColumnDefinition x:Name="ColumnTime2" Width="Auto" MinWidth="57" SharedSizeGroup="ItemTime" />
<ColumnDefinition x:Name="ColumnTime3" Width="1*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" SharedSizeGroup="CompItemSource" />
<ColumnDefinition Width="Auto" SharedSizeGroup="ItemSource" />
<ColumnDefinition Width="1.7*" />
</Grid.ColumnDefinitions>
<Path x:Name="PathVersion" Grid.Column="0" Fill="{StaticResource ColorBrushGray3}" Stretch="Uniform" Height="11"
@@ -1,4 +1,4 @@
Public Class MyCompItem
Public Class MyResourceItem
#Region "基础属性"
Public Uuid As Integer = GetUuid()
@@ -82,47 +82,47 @@
Log("[Control] 按下资源工程列表项:" & LabTitle.Text)
End If
End Sub
Private Sub MyCompItem_Click(sender As MyCompItem, e As EventArgs) Handles Me.Click
Private Sub MyResourceItem_Click(sender As MyResourceItem, e As EventArgs) Handles Me.Click
'记录当前展开的卡片标题(#2712)
Dim Titles As New List(Of String)
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
For Each Card As MyCard In FrmDownloadCompDetail.PanResults.Children
If FrmMain.PageCurrent.Page = FormMain.PageType.ResourceDetail Then
For Each Card As MyCard In FrmDownloadResourceDetail.PanResults.Children
If Card.Title <> "" AndAlso Not Card.IsSwapped Then Titles.Add(Card.Title)
Next
Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles))
Log("[Resource] 记录当前已展开的卡片:" & String.Join("、", Titles))
FrmMain.PageCurrent.Additional(1) = Titles
End If
'打开详情页
Dim TargetType As CompType
Dim TargetType As ResourceTypes
Dim TargetInstance As String = Nothing
Dim TargetLoader As CompModLoaderType = CompModLoaderType.Any
Dim TargetLoader As ModLoaderTypes = ModLoaderTypes.Any
If FrmMain.PageCurrent.Page = FormMain.PageType.Download Then
'从下载页进入
Select Case FrmMain.PageCurrentSub
Case FormMain.PageSubType.DownloadMod
TargetType = CompType.Mod
TargetType = ResourceTypes.Mod
TargetInstance = FrmDownloadMod.Content.Loader.Input.GameVersion
TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoader
Case FormMain.PageSubType.DownloadPack
TargetType = CompType.ModPack
TargetType = ResourceTypes.ModPack
TargetInstance = FrmDownloadPack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadDataPack
TargetType = CompType.DataPack
TargetType = ResourceTypes.DataPack
TargetInstance = FrmDownloadDataPack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadResourcePack
TargetType = CompType.ResourcePack
TargetType = ResourceTypes.ResourcePack
TargetInstance = FrmDownloadResourcePack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadShader
TargetType = CompType.Shader
TargetType = ResourceTypes.Shader
TargetInstance = FrmDownloadShader.Content.Loader.Input.GameVersion
End Select
Else
'从详情页进入(查看前置)
TargetType = CompType.Any '允许任意类别
TargetType = ResourceTypes.Any '允许任意类别
TargetInstance = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
End If
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.ResourceDetail,
.Additional = {sender.Tag, New List(Of String), TargetInstance, TargetLoader, TargetType}})
End Sub
@@ -171,7 +171,7 @@
Private StateLast As String
''' <summary>
''' 是否允许交互。目前仅用于 PageDownloadCompDetail 的顶部栏展示:若关闭碰撞检测,则无法展开 Tooltip。
''' 是否允许交互。目前仅用于 PageDownloadResourceDetail 的顶部栏展示:若关闭碰撞检测,则无法展开 Tooltip。
''' </summary>
Public Property CanInteraction As Boolean = True
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
@@ -214,10 +214,10 @@
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
End If
AniStart(Ani, "CompItem Color " & Uuid)
AniStart(Ani, "MyResourceItem Color " & Uuid)
Else
'无动画
AniStop("CompItem Color " & Uuid)
AniStop("MyResourceItem Color " & Uuid)
If _RectBack IsNot Nothing Then RectBack.Opacity = 0
End If
End Sub
@@ -2,7 +2,7 @@
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadCompDetail"
mc:Ignorable="d" x:Class="PageDownloadResourceDetail"
PanScroll="PanBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<Grid Margin="25,25,25,10">
@@ -1,21 +1,21 @@
Public Class PageDownloadCompDetail
Private CompItem As MyCompItem = Nothing
Public Class PageDownloadResourceDetail
Private ResourceItem As MyResourceItem = Nothing
#Region "加载器"
Private CompFileLoader As New LoaderTask(Of Integer, List(Of CompFile))(
"Comp File",
Private ResourceFileLoader As New LoaderTask(Of Integer, List(Of ResourceVersion))(
"Resource File",
Sub(Task)
LoadTargetFromAdditional()
Dim Result = CompFilesGet(Project.Id, Project.FromCurseForge)
Dim Result = ResourceVersion.FromProjectId(Project.Id, Project.Platform)
If Task.IsInterrupted Then Return
Task.Output = Result
End Sub)
'初始化加载器信息
Private Sub PageDownloadCompDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
Private Sub PageDownloadResourceDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
LoadTargetFromAdditional()
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish)
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, ResourceFileLoader, AddressOf Load_OnFinish)
End Sub
Public Sub LoadTargetFromAdditional() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
@@ -23,21 +23,21 @@
TargetLoader = FrmMain.PageCurrent.Additional(3)
TargetType = FrmMain.PageCurrent.Additional(4)
End Sub
Private Project As CompProject
Private TargetInstance As String, TargetLoader As CompModLoaderType
Private Project As ResourceProject
Private TargetInstance As String, TargetLoader As ModLoaderTypes
''' <summary>
''' 当前页面应展示的内容类别。
''' 若当前页面是在查看前置时进入,则也可能为 Any。
''' </summary>
Private TargetType As CompType
Private TargetType As ResourceTypes
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case CompFileLoader.State
Select Case ResourceFileLoader.State
Case LoadState.Failed
Dim ErrorMessage As String = ""
If CompFileLoader.Error IsNot Nothing Then ErrorMessage = CompFileLoader.Error.Message
If ResourceFileLoader.Error IsNot Nothing Then ErrorMessage = ResourceFileLoader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Comp] 下载的文件 json 列表损坏,已自动重试", LogLevel.Debug)
Log("[Resource] 下载的文件 json 列表损坏,已自动重试", NotifyLevel.DebugModeOnly)
PageLoaderRestart()
End If
End Select
@@ -73,15 +73,15 @@
Private GroupedDrop As Boolean '是否按 Drop 筛选(1.21 / 1.20 / 1.19 / ...)而非小版本号(1.21.1 / 1.21 / 1.20.4 / ...)
Private GroupedOld As Boolean '是否折叠远古版本为一个选项
'筛选类型相同的结果(Modrinth 会返回 Mod、服务端插件、数据包混合的列表)
Private Function GetResults() As List(Of CompFile)
Dim Results As List(Of CompFile) = CompFileLoader.Output
Private Function GetResults() As List(Of ResourceVersion)
Dim Results As List(Of ResourceVersion) = ResourceFileLoader.Output
Select Case TargetType
Case CompType.Any
Results = Results.Where(Function(r) r.Type <> CompType.Plugin).ToList
Case CompType.Shader, CompType.ResourcePack
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.Type = TargetType).ToList
Results = Results.Where(Function(r) r.ResourceType = TargetType).ToList
End Select
Return Results
End Function
@@ -153,13 +153,13 @@ GroupDone:
Private Sub UpdateFilterResult()
Dim Results = GetResults()
Dim TargetCardName As String = If(TargetInstance <> "" OrElse TargetLoader <> CompModLoaderType.Any,
$"{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetInstance}(所选版本)", "")
Dim TargetCardName As String = If(TargetInstance <> "" OrElse TargetLoader <> ModLoaderTypes.Any,
$"{If(TargetLoader <> ModLoaderTypes.Any, TargetLoader.ToString & " ", "")}{TargetInstance}(所选版本)", "")
'归类到卡片下
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName))
Dict.Add("其他", New List(Of CompFile))
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType)))
For Each Version As CompFile In Results
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
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
@@ -168,11 +168,11 @@ GroupDone:
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
'遍历加入的加载器列表
Dim Loaders As New List(Of String)
If Project.ModLoaders.Count > 1 AndAlso '工程至少有两个加载器
Version.Type = CompType.Mod AndAlso '是 Mod
If Project.Loaders.Count > 1 AndAlso '工程至少有两个加载器
Version.ResourceType = ResourceTypes.Mod AndAlso '是 Mod
McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的
For Each Loader In Version.ModLoaders
If Loader = CompModLoaderType.Quilt AndAlso Settings.Get("ToolDownloadIgnoreQuilt") Then Continue For
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 & " ")
Next
End If
@@ -180,17 +180,17 @@ GroupDone:
'实际添加
For Each Loader In Loaders
Dim TargetCard As String = Loader & VerName
If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile))
If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of ResourceVersion))
If Not Dict(TargetCard).Contains(Version) Then Dict(TargetCard).Add(Version)
Next
Next
Next
'添加筛选的版本的卡片
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then
Dict.Add(TargetCardName, New List(Of CompFile))
For Each Version As CompFile In Results
Dict.Add(TargetCardName, New List(Of ResourceVersion))
For Each Version As ResourceVersion In Results
If Version.GameVersions.Contains(TargetInstance) AndAlso
(TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then
(TargetLoader = ModLoaderTypes.Any OrElse Version.Loaders.Contains(TargetLoader)) Then
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld) = VersionFilter) Then Continue For
@@ -201,11 +201,11 @@ GroupDone:
'转化为 UI
Try
PanResults.Children.Clear()
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
For Each Pair As KeyValuePair(Of String, List(Of ResourceVersion)) In Dict
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 = CompType.ModPack, 9, 8)} '9 是安装,8 是另存为
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 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
@@ -214,7 +214,7 @@ GroupDone:
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 = CompType.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为
MyCard.StackInstall(NewStack, If(TargetType = ResourceTypes.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为
Else
NewCard.IsSwapped = True
End If
@@ -228,15 +228,15 @@ GroupDone:
CType(PanResults.Children(0), MyCard).IsSwapped = False
End If
'替代提示
If Project.Types = CompType.ModOrDataPack AndAlso (TargetType = CompType.Mod OrElse TargetType = CompType.DataPack) Then
If Project.Types = ResourceTypes.ModOrDataPack AndAlso (TargetType = ResourceTypes.Mod OrElse TargetType = ResourceTypes.DataPack) Then
HintAlternative.Visibility = Visibility.Visible
HintAlternative.Text = If(TargetType = CompType.Mod,
HintAlternative.Text = If(TargetType = ResourceTypes.Mod,
"以下是该项目的 Mod 版本。点击这里查看其数据包版本。", "以下是该项目的数据包版本。点击这里查看其 Mod 版本。")
Else
HintAlternative.Visibility = Visibility.Collapsed
End If
Catch ex As Exception
Log(ex, "可视化工程下载列表出错", LogLevel.Feedback)
Log(ex, "可视化工程下载列表出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Private Function GetGroupedVersionName(Name As String, GroupedByDrop As Boolean, FoldOld As Boolean) As String
@@ -271,14 +271,14 @@ GroupDone:
End If
'放置当前工程
If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem)
CompItem = Project.ToCompItem(True, True).Init()
CompItem.CanInteraction = False
CompItem.Margin = New Thickness(-7, -7, 0, 8)
PanIntro.Children.Insert(0, CompItem)
If ResourceItem IsNot Nothing Then PanIntro.Children.Remove(ResourceItem)
ResourceItem = Project.ToResourceItem(True, True).Init()
ResourceItem.CanInteraction = False
ResourceItem.Margin = New Thickness(-7, -7, 0, 8)
PanIntro.Children.Insert(0, ResourceItem)
'决定按钮显示
BtnIntroWeb.Text = If(Project.FromCurseForge, "转到 CurseForge", "转到 Modrinth")
BtnIntroWeb.Text = $"转到 {Project.Platform}"
BtnIntroWiki.Visibility = If(Project.WikiId = 0, Visibility.Collapsed, Visibility.Visible)
AniControlEnabled -= 1
@@ -289,8 +289,8 @@ GroupDone:
Try
'获取基本信息
Dim File As CompFile = sender.Tag
Dim LoaderName As String = $"{If(Project.FromCurseForge, "CurseForge", "Modrinth")} 整合包下载:{Project.TranslatedName} "
Dim File As ResourceVersion = sender.Tag
Dim LoaderName As String = $"{Project.Platform} 整合包下载:{Project.TranslatedName} "
'获取版本名
Dim PackName As String = Project.TranslatedName.Replace(".zip", "").Replace(".rar", "").Replace(".mrpack", "").Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
@@ -301,8 +301,8 @@ GroupDone:
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
Dim Target As String = $"{McFolderSelected}versions\{InstanceName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = CompItem.PathLogo.ActualSource
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 LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() ModpackInstall(Target, InstanceName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
@@ -326,49 +326,49 @@ GroupDone:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "下载资源整合包失败", LogLevel.Feedback)
Log(ex, "下载资源整合包失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
'资源下载;整合包另存为
Public Shared CachedFolder As New Dictionary(Of CompType, String) '仅在本次缓存的下载文件夹
Public Shared CachedFolder As New Dictionary(Of ResourceTypes, String) '仅在本次缓存的下载文件夹
Public Sub Save_Click(sender As Object, e As EventArgs)
Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
Dim File As ResourceVersion = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
RunInNewThread(
Sub()
Try
Dim Desc As String = Nothing
Select Case File.Type
Case CompType.ModPack : Desc = "整合包"
Case CompType.Mod : Desc = "Mod "
Case CompType.ResourcePack : Desc = "资源包"
Case CompType.Shader : Desc = "光影包"
Case CompType.DataPack : Desc = "数据包"
Select Case File.ResourceType
Case ResourceTypes.ModPack : Desc = "整合包"
Case ResourceTypes.Mod : Desc = "Mod "
Case ResourceTypes.ResourcePack : Desc = "资源包"
Case ResourceTypes.Shader : Desc = "光影包"
Case ResourceTypes.DataPack : Desc = "数据包"
End Select
'确认默认保存位置
Dim DefaultFolder As String = Nothing
If File.Type <> CompType.ModPack Then
If File.ResourceType <> ResourceTypes.ModPack Then
Dim SubFolder As String = Nothing
Select Case File.Type
Case CompType.Mod : SubFolder = "mods\"
Case CompType.ResourcePack : SubFolder = "resourcepacks\"
Case CompType.Shader : SubFolder = "shaderpacks\"
Case CompType.DataPack : SubFolder = "" '导航到版本根目录
Select Case File.ResourceType
Case ResourceTypes.Mod : SubFolder = "mods\"
Case ResourceTypes.ResourcePack : SubFolder = "resourcepacks\"
Case ResourceTypes.Shader : SubFolder = "shaderpacks\"
Case ResourceTypes.DataPack : SubFolder = "" '导航到版本根目录
End Select
Dim IsInstanceSuitable As Func(Of McInstance, Boolean) = Nothing
'获取资源所需的加载器
Dim AllowedLoaders As New List(Of CompModLoaderType)
If File.ModLoaders.Any Then
AllowedLoaders = File.ModLoaders
ElseIf Project.ModLoaders.Any Then
AllowedLoaders = Project.ModLoaders
Dim AllowedLoaders As New List(Of ModLoaderTypes)
If File.Loaders.Any Then
AllowedLoaders = File.Loaders
ElseIf Project.Loaders.Any Then
AllowedLoaders = Project.Loaders
End If
Log($"[Comp] {Desc}要求的加载器种类:" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
Log($"[Resource] {Desc}要求的加载器种类:" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
'判断某个版本是否符合资源要求
IsInstanceSuitable =
Function(Instance As McInstance)
If Not Instance.IsLoaded Then Instance.Load()
'只对 Mod 和数据包进行版本检测
If File.Type = CompType.Mod OrElse File.Type = CompType.DataPack Then
If File.ResourceType = ResourceTypes.Mod OrElse File.ResourceType = ResourceTypes.DataPack Then
If Not File.GameVersions.Any( '判断是否有任何一个版本匹配
Function(FileVersion)
Dim FileIsSnapshot As Boolean = FileVersion.Contains("预览版") OrElse Not FileVersion.Contains(".")
@@ -404,20 +404,20 @@ GroupDone:
End If
'加载器
If Not AllowedLoaders.Any() Then Return True '无要求
If AllowedLoaders.Contains(CompModLoaderType.Forge) AndAlso Instance.Version.HasForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.Fabric) AndAlso Instance.Version.HasFabric Then Return True
If AllowedLoaders.Contains(CompModLoaderType.NeoForge) AndAlso Instance.Version.HasNeoForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.LiteLoader) AndAlso Instance.Version.HasLiteLoader 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
End Function
'获取常规资源默认下载位置
If CachedFolder.ContainsKey(File.Type) Then
DefaultFolder = CachedFolder(File.Type)
Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
If CachedFolder.ContainsKey(File.ResourceType) Then
DefaultFolder = CachedFolder(File.ResourceType)
Log($"[Resource] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
ElseIf McInstanceSelected IsNot Nothing AndAlso IsInstanceSuitable(McInstanceSelected) Then
DefaultFolder = $"{McInstanceSelected.PathIndie}{SubFolder}"
Directory.CreateDirectory(DefaultFolder)
Log($"[Comp] 使用当前版本作为默认下载位置:{DefaultFolder}")
DirectoryUtils.Create(DefaultFolder)
Log($"[Resource] 使用当前版本作为默认下载位置:{DefaultFolder}")
Else
'查找所有可能的版本
Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished
@@ -433,14 +433,14 @@ GroupDone:
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
First()
DefaultFolder = SelectedInstance.FullName
Directory.CreateDirectory(DefaultFolder)
Log($"[Comp] 使用适合的游戏版本作为默认下载位置:{DefaultFolder}")
DirectoryUtils.Create(DefaultFolder)
Log($"[Resource] 使用适合的游戏版本作为默认下载位置:{DefaultFolder}")
Else
DefaultFolder = McFolderSelected
If NeedLoad Then
Hint($"当前 MC 文件夹中没有找到合适的版本!")
Else
Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
Log("[Resource] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If
End If
End If
@@ -465,20 +465,20 @@ GroupDone:
FileName = File.FileName
End Select
End If
If File.Type = CompType.Mod Then FileName = FileName.Replace("~", "-") '~ 会导致 Mixin 加载失败
If File.ResourceType = ResourceTypes.Mod Then FileName = FileName.Replace("~", "-") '~ 会导致 Mixin 加载失败
RunInUi(
Sub()
'弹窗要求选择保存位置
Dim Target As String
Target = SelectSaveFile("选择保存位置", FileName,
Desc & "文件|" &
If(File.Type = CompType.Mod,
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 LoaderName As String = Desc & "下载:" & IO.Path.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder Then CachedFolder(File.Type) = GetPathFromFullPath(Target)
Dim LoaderName As String = Desc & "下载:" & Path.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder Then CachedFolder(File.ResourceType) = GetPathFromFullPath(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})
'启动
@@ -489,9 +489,9 @@ GroupDone:
FrmMain.BtnExtraDownload.Ribble()
End Sub)
Catch ex As Exception
Log(ex, "保存资源文件失败", LogLevel.Feedback)
Log(ex, "保存资源文件失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub, "Download CompDetail Save")
End Sub, "Download Resource Detail Save")
End Sub
Private Sub BtnIntroWeb_Click(sender As Object, e As EventArgs) Handles BtnIntroWeb.Click
@@ -501,14 +501,39 @@ GroupDone:
OpenWebsite("https://www.mcmod.cn/class/" & Project.WikiId & ".html")
End Sub
Private Sub BtnIntroCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroCopy.Click
ClipboardSet(CompItem.LabTitle.Text & CompItem.LabTitleRaw.Text)
ClipboardSet(ResourceItem.LabTitle.Text & ResourceItem.LabTitleRaw.Text)
End Sub
'Mod / 数据包 互相跳转
Private Sub HintAlternative_Click() Handles HintAlternative.Click
TargetType = If(TargetType = CompType.Mod, CompType.DataPack, CompType.Mod)
TargetType = If(TargetType = ResourceTypes.Mod, ResourceTypes.DataPack, ResourceTypes.Mod)
FrmMain.PageCurrent.Additional(4) = TargetType '加载器会从这里重新拿数据
PageLoaderRestart(IsForceRestart:=True)
End Sub
''' <summary>
''' 预载包含大量 ProjectVersion 的卡片,添加必要的元素和前置列表。
''' </summary>
Public Shared Sub ResourceFilesCardPreload(Stack As StackPanel, Files As List(Of ResourceVersion))
'获取卡片对应的前置 ID
'如果为整合包就不会有 Dependencies 信息,所以不用管
Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
Deps.Sort()
If Not Deps.Any() Then Return
Deps = Deps.Where(
Function(dep)
If Not ResourceProject.Cache.ContainsKey(dep) Then Log($"[Resource] 未找到 ID {dep} 的前置信息", NotifyLevel.DebugModeOnly)
Return ResourceProject.Cache.ContainsKey(dep)
End Function).ToList
'添加开头间隔
Stack.Children.Add(New TextBlock With {.Text = "前置资源", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
'添加前置列表
For Each Dep In Deps
Dim Item = ResourceProject.Cache(Dep).ToResourceItem(False, False)
Stack.Children.Add(Item)
Next
'添加结尾间隔
Stack.Children.Add(New TextBlock With {.Text = "版本列表", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 12, 0, 5)})
End Sub
End Class
@@ -4,7 +4,7 @@
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadDataPack"
PanScroll="Content">
<local:PageComp x:Name="Content" PageType="DataPack" TypeName="数据包" TypeNameSpaced="数据包">
<local:PageResource x:Name="Content" PageType="DataPack" TypeName="数据包" TypeNameSpaced="数据包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Content="世界元素" Tag="/worldgen" />
<local:MyComboBoxItem Content="科技" Tag="6951/technology" />
@@ -22,5 +22,5 @@
<local:MyComboBoxItem Content="服务器" Tag="/social" />
<local:MyComboBoxItem Content="支持库" Tag="6950/library" />
<local:MyComboBoxItem Content="Mod 相关" Tag="6946/" />
</local:PageComp>
</local:PageResource>
</local:MyPageRight>
@@ -4,7 +4,7 @@
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadMod"
PanScroll="Content">
<local:PageComp x:Name="Content" PageType="Mod" TypeName="Mod" TypeNameSpaced=" Mod ">
<local:PageResource x:Name="Content" PageType="Mod" TypeName="Mod" TypeNameSpaced=" Mod ">
<local:MyComboBoxItem Content="全部" Tag="" IsSelected="True" />
<local:MyComboBoxItem Content="世界元素" Tag="406/worldgen" />
<local:MyComboBoxItem Content="生物群系" Tag="407/" Margin="15,0,0,0" />
@@ -32,5 +32,5 @@
<local:MyComboBoxItem Content="信息显示" Tag="423/" />
<local:MyComboBoxItem Content="服务器" Tag="435/social" />
<local:MyComboBoxItem Content="支持库" Tag="421/library" />
</local:PageComp>
</local:PageResource>
</local:MyPageRight>
@@ -4,7 +4,7 @@
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadPack"
PanScroll="Content">
<local:PageComp x:Name="Content" PageType="ModPack" TypeName="整合包" TypeNameSpaced="整合包">
<local:PageResource x:Name="Content" PageType="ModPack" TypeName="整合包" TypeNameSpaced="整合包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Tag="4484/" Content="多人" />
<local:MyComboBoxItem Tag="/optimization" Content="性能优化" />
@@ -24,5 +24,5 @@
<local:MyComboBoxItem Tag="4480/" Content="基于地图" />
<local:MyComboBoxItem Tag="4481/lightweight" Content="轻量整合" />
<local:MyComboBoxItem Tag="4482/" Content="大型整合" />
</local:PageComp>
</local:PageResource>
</local:MyPageRight>
@@ -4,7 +4,7 @@
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadResourcePack"
PanScroll="Content">
<local:PageComp x:Name="Content" PageType="ResourcePack" TypeName="资源包" TypeNameSpaced="资源包">
<local:PageResource x:Name="Content" PageType="ResourcePack" TypeName="资源包" TypeNameSpaced="资源包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Content="风格" IsEnabled="False" />
@@ -41,5 +41,5 @@
<local:MyComboBoxItem Margin="15,0,0,0" Content="128x" Tag="396/128x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="256x" Tag="397/256x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="512x 或更高" Tag="398/512x+" />
</local:PageComp>
</local:PageResource>
</local:MyPageRight>
@@ -4,7 +4,7 @@
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadShader"
PanScroll="Content">
<local:PageComp x:Name="Content" PageType="Shader" TypeName="光影包" TypeNameSpaced="光影包">
<local:PageResource x:Name="Content" PageType="Shader" TypeName="光影包" TypeNameSpaced="光影包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Content="风格" IsEnabled="False" />
@@ -30,5 +30,5 @@
<local:MyComboBoxItem Margin="15,0,0,0" Content="原版可用" Tag="/vanilla" ToolTip="作为资源包加载,可以直接在原版游戏里使用。" ToolTipService.HorizontalOffset="70" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="Iris" Tag="/iris" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="OptiFine" Tag="/optifine" />
</local:PageComp>
</local:PageResource>
</local:MyPageRight>
@@ -1,4 +1,4 @@
<local:MyScrollViewer x:Class="PageComp"
<local:MyScrollViewer x:Class="PageResource"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
@@ -1,7 +1,7 @@
Imports System.Windows.Markup
<ContentProperty("SearchTags")>
Public Class PageComp
Public Class PageResource
#Region "属性"
@@ -48,17 +48,17 @@ Public Class PageComp
''' <summary>
''' 该页面对应的资源类型。
''' </summary>
Public Property PageType As CompType
Public Property PageType As ResourceTypes
Get
Return _Type
End Get
Set(Value As CompType)
Set(Value As ResourceTypes)
If _Type = Value Then Return
_Type = Value
BtnSearchInstallModPack.Visibility = If(Value = CompType.ModPack, Visibility.Visible, Visibility.Collapsed)
BtnSearchInstallModPack.Visibility = If(Value = ResourceTypes.ModPack, Visibility.Visible, Visibility.Collapsed)
End Set
End Property
Private _Type As CompType = -1
Private _Type As ResourceTypes = -1
#End Region
@@ -73,10 +73,10 @@ Public Class PageComp
''' </summary>
Public Shared TargetName As String = Nothing
'在点击 MyCompItem 时会获取 Loader 的输入,以使资源详情页面可以应用相同的筛选项
Public Loader As New LoaderTask(Of CompProjectRequest, Integer)("社区资源获取:XXX", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
'在点击 MyResourceItem 时会获取 Loader 的输入,以使资源详情页面可以应用相同的筛选项
Public Loader = ResourceSearcher.GetLoader(AddressOf LoaderInput)
Private Sub PageCompControls_Inited(sender As Object, e As EventArgs) Handles Me.Loaded
Private Sub PageResource_Loaded(sender As Object, e As EventArgs) Handles Me.Loaded
Static IsFirstLoaded As Boolean = False
'不知道从 Initialized 改成 Loaded 会不会有问题,但用 Initialized 会导致初始的筛选器修改被覆盖回默认值
If TargetInstance IsNot Nothing Then
@@ -118,23 +118,23 @@ Public Class PageComp
End If
End If
End Sub
Private Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(PageType, Storage, (Page + 1) * PAGE_SIZE)
Private Function LoaderInput() As ResourceSearcher.SearchRequest
Dim Request As New ResourceSearcher.SearchRequest(PageType, Storage, (Page + 1) * PAGE_SIZE)
Dim GameVersion As String = If(TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w"), TextSearchVersion.Text, Nothing))
With Request
.SearchText = TextSearchName.Text
.GameVersion = GameVersion
.Tag = ComboSearchTag.SelectedItem.Tag
.ModLoader = If(PageType = CompType.Mod, Val(ComboSearchLoader.SelectedItem.Tag), CompModLoaderType.Any)
.Sources = CType(Val(ComboSearchSource.SelectedItem.Tag), CompSourceType)
.ModLoader = If(PageType = ResourceTypes.Mod, Val(ComboSearchLoader.SelectedItem.Tag), ModLoaderTypes.Any)
.Sources = CType(Val(ComboSearchSource.SelectedItem.Tag), ResourcePlatforms)
End With
Return Request
End Function
#End Region
Public Storage As New CompProjectStorage
Public Storage As New ResourceSearcher.SearchResult
''' <summary>
''' 每页展示的结果数量。
''' </summary>
@@ -144,14 +144,14 @@ Public Class PageComp
'结果 UI 化
Private Sub Load_OnFinish()
Try
Log($"[Comp] 开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
Log($"[Resource] 开始可视化{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.ToCompItem(
PanProjects.Children.Add(Result.ToResourceItem(
ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing,
ShowLoaderDesc:=Loader.Input.ModLoader = CompModLoaderType.Any AndAlso (PageType = CompType.Mod OrElse PageType = CompType.ModPack)))
ShowLoaderDesc:=Loader.Input.ModLoader = ModLoaderTypes.Any AndAlso (PageType = ResourceTypes.Mod OrElse PageType = ResourceTypes.ModPack)))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
@@ -177,7 +177,7 @@ Public Class PageComp
'强制返回顶部
ScrollToTop()
Catch ex As Exception
Log(ex, $"可视化{TypeNameSpaced}列表出错", LogLevel.Feedback)
Log(ex, $"可视化{TypeNameSpaced}列表出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -188,7 +188,7 @@ Public Class PageComp
Dim ErrorMessage As String = ""
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log($"[Download] 下载的{TypeNameSpaced}列表 json 文件损坏,已自动重试", LogLevel.Debug)
Log($"[Download] 下载的{TypeNameSpaced}列表 json 文件损坏,已自动重试", NotifyLevel.DebugModeOnly)
CType(Parent, MyPageRight).PageLoaderRestart()
End If
End Select
@@ -222,7 +222,7 @@ Public Class PageComp
'搜索按钮
Private Sub StartNewSearch() Handles BtnSearchRun.Click
Page = 0
If Loader.ShouldStart(LoaderInput()) Then Storage = New CompProjectStorage '避免连续搜索两次使得 CompProjectStorage 引用丢失(#1311)
If Loader.ShouldStart(LoaderInput()) Then Storage = New ResourceSearcher.SearchResult '避免连续搜索两次导致 ProjectStorage 引用丢失(#1311)
Loader.Start()
End Sub
Private Sub EnterTrigger(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyDown, TextSearchVersion.KeyDown
@@ -246,7 +246,7 @@ Public Class PageComp
If Not TextSearchVersion.IsDropDownOpen Then UpdateSearchLoaderVisibility()
End Sub
Private Sub UpdateSearchLoaderVisibility() Handles TextSearchVersion.DropDownClosed
If PageType = CompType.Mod AndAlso (TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w")) Then
If PageType = ResourceTypes.Mod AndAlso (TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w")) Then
ComboSearchLoader.Visibility = Visibility.Visible
Grid.SetColumnSpan(TextSearchVersion, 1)
Else
@@ -13,12 +13,7 @@ Public Class MyLocalModItem
End Get
Set(value As String)
Dim RawValue = value
Select Case Entry.State
Case McMod.McModState.Fine
LabTitle.TextDecorations = Nothing
Case McMod.McModState.Disabled
LabTitle.TextDecorations = TextDecorations.Strikethrough
End Select
LabTitle.TextDecorations = If(Entry.IsEnabled, Nothing, TextDecorations.Strikethrough)
If LabTitle.Text = value Then Return
LabTitle.Text = value
_Title = RawValue
@@ -66,11 +61,11 @@ Public Class MyLocalModItem
End Property
'相关联的 Mod
Public Property Entry As McMod
Public Property Entry As ResourceFile
Get
Return Tag
End Get
Set(value As McMod)
Set(value As ResourceFile)
Tag = value
End Set
End Property
@@ -134,8 +129,8 @@ Public Class MyLocalModItem
'计算滑动范围
Dim Elements = CType(Parent, StackPanel).Children
Dim Index As Integer = Elements.IndexOf(Me)
SwipeStart = MathClamp(Math.Min(SwipeStart, Index), 0, Elements.Count - 1)
SwipeEnd = MathClamp(Math.Max(SwipeEnd, Index), 0, Elements.Count - 1)
SwipeStart = Math.Min(SwipeStart, Index).Clamp(0, Elements.Count - 1)
SwipeEnd = Math.Max(SwipeEnd, Index).Clamp(0, Elements.Count - 1)
'勾选所有范围中的项
If SwipeStart = SwipeEnd Then Return
For i = SwipeStart To SwipeEnd
@@ -183,7 +178,7 @@ Public Class MyLocalModItem
Anim.Add(AaOpacity(RectCheck, 1 - RectCheck.Opacity, 30))
RectCheck.VerticalAlignment = VerticalAlignment.Center
RectCheck.Margin = New Thickness(-3, 0, 0, 0)
Anim.Add(AaColor(LabTitle, TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"), 200))
Anim.Add(AaColor(LabTitle, TextBlock.ForegroundProperty, If(Entry.IsEnabled, "ColorBrush2", "ColorBrush5"), 200))
Else
'由有变无
Anim.Add(AaHeight(RectCheck, -RectCheck.ActualHeight, 120,, New AniEaseInFluent(AniEasePower.Weak)))
@@ -199,11 +194,11 @@ Public Class MyLocalModItem
If Checked Then
RectCheck.Height = 32
RectCheck.Opacity = 1
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.IsEnabled, "ColorBrush2", "ColorBrush5"))
Else
RectCheck.Height = 0
RectCheck.Opacity = 0
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
AniStop("MyLocalModItem Checked " & Uuid)
End If
@@ -300,8 +295,8 @@ Public Class MyLocalModItem
#End Region
Private Function GetUpdateCompareDescription() As String
Dim CurrentName = If(Entry.CompFile.Version, Entry.CompFile.DisplayName).Replace(".jar", "")
Dim NewestName = If(Entry.UpdateFile.Version, Entry.UpdateFile.DisplayName).Replace(".jar", "")
Dim CurrentName = If(Entry.ProjectVersion.Version, Entry.ProjectVersion.Display).Replace(".jar", "")
Dim NewestName = If(Entry.UpdateFile.Version, Entry.UpdateFile.Display).Replace(".jar", "")
'简化名称对比
Dim CurrentSegs = CurrentName.Split("-_+ ".ToCharArray).ToList()
Dim NewestSegs = NewestName.Split("-_+ ".ToCharArray).ToList()
@@ -317,7 +312,7 @@ Public Class MyLocalModItem
NewestName = NewestSegs.Join("-")
Entry._Version = CurrentName '使用网络信息作为显示的版本号
End If
Return $"当前版本:{CurrentName}({GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}){vbCrLf}最新版本:{NewestName}({GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)})"
Return $"当前版本:{CurrentName}({GetTimeSpanString(Entry.ProjectVersion.ReleaseDate - Date.Now, False)}){vbCrLf}最新版本:{NewestName}({GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)})"
End Function
'懒加载
@@ -331,21 +326,16 @@ Public Class MyLocalModItem
Refresh()
End Sub
Public Sub Refresh()
If Not HasEnteredViewport Then Return '避免在未显示时因为 Comp 更新而加载内容
If Not HasEnteredViewport Then Return '避免在未显示时因为资源更新而加载内容
'更新
If Entry.CanUpdate Then
If Entry.HasUpdate Then
BtnUpdate.Visibility = Visibility.Visible
BtnUpdate.ToolTip = $"{GetUpdateCompareDescription()}{vbCrLf}点击以更新,右键查看更新日志。"
Else
BtnUpdate.Visibility = Visibility.Collapsed
End If
'标题与描述
Dim DescFileName As String
If Entry.State = McMod.McModState.Fine OrElse Entry.State = McMod.McModState.Disabled Then
DescFileName = IO.Path.GetFileNameWithoutExtension(Entry.Path)
Else
DescFileName = GetFileNameFromPath(Entry.Path)
End If
Dim DescFileName As String = Path.GetFileNameWithoutExtension(Entry.File.FullName)
Dim NewDescription As String
If Settings.Get("ToolModLocalNameStyle") = 1 Then
'标题显示文件名,详情显示译名
@@ -353,10 +343,10 @@ Public Class MyLocalModItem
Title = DescFileName
SubTitle = ""
'描述
If Entry.Comp Is Nothing Then
NewDescription = Entry.DisplayName
If Entry.Project Is Nothing Then
NewDescription = Entry.Display
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Dim Titles = Entry.Project.GetControlTitle(False)
NewDescription = Titles.Title & Titles.SubTitle
End If
NewDescription = NewDescription.Replace(" | ", " / ")
@@ -364,36 +354,36 @@ Public Class MyLocalModItem
Else
'标题显示译名,详情显示文件名
'标题
If Entry.Comp Is Nothing Then
Title = Entry.DisplayName
If Entry.Project Is Nothing Then
Title = Entry.Display
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Dim Titles = Entry.Project.GetControlTitle(False)
Title = Titles.Title
SubTitle = Titles.SubTitle & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
'描述
NewDescription = DescFileName
End If
If Entry.Comp IsNot Nothing Then
NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "")
If Entry.Project IsNot Nothing Then
NewDescription += ": " & Entry.Project.Description.ReplaceLineEndings("")
ElseIf Entry.Description IsNot Nothing Then
NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "")
NewDescription += ": " & Entry.Description.ReplaceLineEndings("")
End If
Description = NewDescription
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.IsEnabled, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
'主 Logo
If Entry.Comp IsNot Nothing Then
Entry.Comp.ApplyLogoToMyImage(PathLogo)
If Entry.Project IsNot Nothing Then
Entry.Project.ApplyLogoToMyImage(PathLogo)
Else
PathLogo.Source = PathImage & "Icons/NoIcon.png"
End If
'图标右下角的 Logo
If Entry.State = McMod.McModState.Fine Then
If Entry.IsEnabled Then
If ImgState IsNot Nothing Then
Children.Remove(ImgState)
ImgState = Nothing
@@ -412,10 +402,10 @@ Public Class MyLocalModItem
' HorizontalAlignment="Right" VerticalAlignment="Bottom"
' Source="/Images/Icons/Unavailable.png" />
End If
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
ImgState.Source = New MyBitmap(PathImage & $"Icons/Disabled.png")
End If
'标签
If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
If Entry.Project IsNot Nothing Then Tags = Entry.Project.Tags
End Sub
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed
@@ -486,7 +476,7 @@ Public Class MyLocalModItem
'触发更新
Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
Select Case MyMsgBox($"是否要更新 {Entry.DisplayName}?{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
Select Case MyMsgBox($"是否要更新 {Entry.Display}?{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
Case 1 '更新
FrmInstanceMod.UpdateMods({Entry})
Case 2 '查看更新日志
@@ -1,6 +1,4 @@
Imports System.IO.Compression
Public Class ExportOption
Public Class ExportOption
Public Property Title As String
Public Property Description As String
Public Property Rules As String
@@ -23,7 +21,7 @@ Public Class PageInstanceExport
AniControlEnabled += 1
If CurrentInstance <> PageInstanceLeft.Instance.PathVersion Then RefreshAll() '切换到了另一个版本,重置页面
CustomEventService.SetEventData(BtnAdvancedHelp,
If(VersionBranchCode = 50, "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json"))
If(BuildType = BuildTypes.Release, "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json"))
AniControlEnabled -= 1
End Sub
Public Sub RefreshAll() Implements IRefreshable.Refresh
@@ -63,17 +61,17 @@ Public Class PageInstanceExport
'查找文件夹下的对应项
If AcceptCompressedFile Then
For Each File In TargetFolder.EnumerateFiles("*.zip").Concat(TargetFolder.EnumerateFiles("*.rar"))
If SubOptionBlackList.Any(Function(b) File.Name.ContainsF(b)) Then Continue For
If SubOptionBlackList.Any(Function(b) File.Name.Contains(b)) Then Continue For
Panel.Children.Add(New MyCheckBox With {. _
Tag = New ExportOption With {.Title = File.Name, .DefaultChecked = True, .Rules = EscapeLikePattern($"{Folder}/{File.Name}")}})
Tag = New ExportOption With {.Title = File.Name, .DefaultChecked = True, .Rules = EscapeUtils.LikePatternEscape($"{Folder}/{File.Name}")}})
Next
End If
If AcceptFolder Then
For Each SubFolder In TargetFolder.EnumerateDirectories().OrderByDescending(Function(f) f.LastWriteTime)
If SubOptionBlackList.Any(Function(b) SubFolder.Name.ContainsF(b)) Then Continue For
If SubOptionBlackList.Any(Function(b) SubFolder.Name.Contains(b)) Then Continue For
If Not SubFolder.EnumerateFileSystemInfos().Any() Then Continue For
Dim NewCheckBox As New MyCheckBox With {. _
Tag = New ExportOption With {.Title = SubFolder.Name, .DefaultChecked = True, .Rules = EscapeLikePattern($"{Folder}/{SubFolder.Name}/")}}
Tag = New ExportOption With {.Title = SubFolder.Name, .DefaultChecked = True, .Rules = EscapeUtils.LikePatternEscape($"{Folder}/{SubFolder.Name}/")}}
If Panel Is PanOptionsSaves Then GetExportOption(NewCheckBox).Description = SubFolder.LastWriteTime.ToString("yyyy'/'MM'/'dd HH':'mm")
Panel.Children.Add(NewCheckBox)
Next
@@ -95,7 +93,7 @@ Public Class PageInstanceExport
Function(Folder As DirectoryInfo) As Boolean
Try
Return Folder.Exists AndAlso
Folder.EnumerateFileSystemInfos().Any(Function(i) Not SubOptionBlackList.Any(Function(b) i.Name.ContainsF(b)))
Folder.EnumerateFileSystemInfos().Any(Function(i) Not SubOptionBlackList.Any(Function(b) i.Name.Contains(b)))
Catch '一般是由于无法访问,或是一个指向已不存在的文件夹的链接(例如使用 mklink 创造的 resource 文件夹链接)
Return False
End Try
@@ -123,7 +121,7 @@ Public Class PageInstanceExport
Try
If AllEntries.Any(Function(Entry) Entry Like Rule) Then Return True
Catch ex As Exception
Log(ex, $"错误的规则:{Rule}", LogLevel.Hint)
Log(ex, $"错误的规则:{Rule}", NotifyLevel.AllUsers)
Return False
End Try
'粗略检查所有级
@@ -341,11 +339,11 @@ Public Class PageInstanceExport
ConfigLines.Add(Sperator)
ConfigLines.AddRange(GetExtraFileLines())
'结束
WriteFile(ConfigPath, ConfigLines.Join(vbCrLf))
FileUtils.Write(ConfigPath, ConfigLines.Join(vbCrLf))
Hint("已保存配置文件:" & ConfigPath, HintType.Green)
OpenExplorer(ConfigPath)
Catch ex As Exception
Log(ex, "保存配置失败", LogLevel.Msgbox)
Log(ex, "保存配置失败", NotifyLevel.MsgBox)
End Try
End Sub
'读取配置文件
@@ -371,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).Replace(vbCr, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ToList
RulesOverrides = Segments(1).ReplaceLineEndings(vbLf, mergeMultiple:=True).Split(vbLf).ToList
'追加内容段
If Segments.Length > 2 Then
ExtraFiles = Segments(2).Replace(vbCr, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ToList
ExtraFiles = Segments(2).ReplaceLineEndings(vbLf, mergeMultiple:=True).Split(vbLf).ToList
Else
ExtraFiles = Nothing
End If
'结束
Hint("已读取配置文件:" & ConfigPath, HintType.Green)
Catch ex As Exception
Log(ex, "读取配置失败", LogLevel.Msgbox)
Log(ex, "读取配置失败", NotifyLevel.MsgBox)
End Try
End Sub
@@ -414,11 +412,11 @@ Public Class PageInstanceExport
If Not String.IsNullOrWhiteSpace(ConfigPackPath) AndAlso
(Not ConfigPackPath.EndsWithF("\") AndAlso Not ConfigPackPath.EndsWithF("/")) Then
Try
Directory.CreateDirectory(GetPathFromFullPath(ConfigPackPath))
DirectoryUtils.Create(ConfigPackPath, isFilePath:=True)
PackPath = ConfigPackPath
Log($"[Export] 使用配置文件中指定的导出路径:{ConfigPackPath}")
Catch ex As Exception
Log(ex, $"无法使用配置文件中指定的导出路径({ConfigPackPath})", LogLevel.Debug)
Log(ex, $"无法使用配置文件中指定的导出路径({ConfigPackPath})", NotifyLevel.DebugModeOnly)
If MyMsgBox($"指定的路径:{ConfigPackPath}{vbCrLf}{vbCrLf}{ex.GetDetail}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
End Try
End If
@@ -450,23 +448,21 @@ Public Class PageInstanceExport
#Region "准备 PCL 文件"
#If Not BETA Then
If IncludePCL Then
If BuildType <> BuildTypes.Release AndAlso IncludePCL Then
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")
End Sub) With {.ProgressWeight = 0.5, .Block = False})
End If
#End If
#End Region
#Region "复制文件"
Loaders.Add(New LoaderTask(Of Integer, List(Of McMod))("复制导出内容",
Sub(Loader As LoaderTask(Of Integer, List(Of McMod)))
Loader.Output = New List(Of McMod)
Loaders.Add(New LoaderTask(Of Integer, List(Of ResourceFile))("复制导出内容",
Sub(Loader As LoaderTask(Of Integer, List(Of ResourceFile)))
Loader.Output = New List(Of ResourceFile)
'复制版本文件
Dim Progress As Integer = 0
Dim SearchFolder As Action(Of DirectoryInfo)
@@ -495,7 +491,7 @@ Public Class PageInstanceExport
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 McMod(TargetPath)
Dim ModFile As New ResourceFile(TargetPath)
Dim Unused = ModFile.ModrinthHash '提前计算 Hash
Unused = ModFile.CurseForgeHash
Loader.Output.Add(ModFile)
@@ -532,19 +528,17 @@ Public Class PageInstanceExport
'复制 PCL 版本设置
CopyDirectory(McVersion.PathVersion & "PCL\", OverridesFolder & "PCL\")
WriteIni(OverridesFolder & "PCL\Setup.ini", "IsStar", False)
#If BETA Then
'复制 PCL 本体
If IncludePCL Then CopyFile(PathWithName, CacheFolder & "Plain Craft Launcher.exe")
#End If
'复制 PCL 本体(正式版)
If BuildType = BuildTypes.Release AndAlso IncludePCL Then CopyFile(PathExe, CacheFolder & "Plain Craft Launcher.exe")
'复制 PCL 个性化内容
If IncludePCLCustom Then
If Directory.Exists(Path & "PCL\Pictures\") Then CopyDirectory(Path & "PCL\Pictures\", CacheFolder & "PCL\Pictures\")
If Directory.Exists(Path & "PCL\Musics\") Then CopyDirectory(Path & "PCL\Musics\", CacheFolder & "PCL\Musics\")
If Directory.Exists(Path & "PCL\Help\") Then CopyDirectory(Path & "PCL\Help\", CacheFolder & "PCL\Help\")
If File.Exists(Path & "PCL\Custom.xaml") Then CopyFile(Path & "PCL\Custom.xaml", CacheFolder & "PCL\Custom.xaml")
If File.Exists(Path & "PCL\Setup.ini") Then CopyFile(Path & "PCL\Setup.ini", CacheFolder & "PCL\Setup.ini")
If File.Exists(Path & "PCL\hints.txt") Then CopyFile(Path & "PCL\hints.txt", CacheFolder & "PCL\hints.txt")
If File.Exists(Path & "PCL\Logo.png") Then CopyFile(Path & "PCL\Logo.png", CacheFolder & "PCL\Logo.png")
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")
End If
End Sub) With {.ProgressWeight = 5})
@@ -552,9 +546,9 @@ Public Class PageInstanceExport
#Region "联网检查"
Loaders.Add(New LoaderTask(Of List(Of McMod), Dictionary(Of McMod, List(Of String)))("联网获取文件信息",
Sub(Loader As LoaderTask(Of List(Of McMod), Dictionary(Of McMod, List(Of String))))
Loader.Output = New Dictionary(Of McMod, List(Of String))
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
@@ -573,7 +567,7 @@ Public Class PageInstanceExport
If Not ModrinthRaw.ContainsKey(ModFile.ModrinthHash) Then Continue For
If ModrinthRaw(ModFile.ModrinthHash)?("files")?(0)("hashes")?("sha1") <> ModFile.ModrinthHash Then Continue For
'写入下载地址
Loader.Output.AddToList(ModFile, ModrinthRaw(ModFile.ModrinthHash)("files")(0)("url"))
Loader.Output.AddIntoValueCollection(ModFile, ModrinthRaw(ModFile.ModrinthHash)("files")(0)("url"))
Next
Log($"[Export] 从 Modrinth 获取到 {ModrinthRaw.Count} 个本地资源项的对应信息")
Catch ex As Exception
@@ -598,11 +592,11 @@ Public Class PageInstanceExport
Dim File As JObject = ResultJson("file")
If String.IsNullOrEmpty(File("downloadUrl")) Then Continue For
'查找对应的文件
Dim ModFile As McMod = Loader.Input.FirstOrDefault(Function(m) m.CurseForgeHash = File("fileFingerprint").ToObject(Of UInteger))
Dim ModFile As ResourceFile = Loader.Input.FirstOrDefault(Function(m) m.CurseForgeHash = File("fileFingerprint").ToObject(Of UInteger))
If ModFile Is Nothing Then Continue For
'写入下载地址
For Each Address In CompFile.HandleCurseForgeDownloadUrls(File("downloadUrl").ToString)
Loader.Output.AddToList(ModFile, Address)
For Each Address In ResourceVersion.ParseCurseForgeDownloadUrls(File("downloadUrl").ToString)
Loader.Output.AddIntoValueCollection(ModFile, Address)
Next
Next
Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地资源项的对应信息")
@@ -639,19 +633,19 @@ Public Class PageInstanceExport
#Region "生成压缩包"
Loaders.Add(New LoaderTask(Of Dictionary(Of McMod, List(Of String)), Integer)("生成压缩包",
Sub(Loader As LoaderTask(Of Dictionary(Of McMod, List(Of String)), Integer))
Loaders.Add(New LoaderTask(Of Dictionary(Of ResourceFile, List(Of String)), Integer)("生成压缩包",
Sub(Loader As LoaderTask(Of Dictionary(Of ResourceFile, List(Of String)), Integer))
'整理文件列表
Dim Files As New JArray
For Each Pair In Loader.Input
Dim ModFile As McMod = Pair.Key
Dim ModFile As ResourceFile = Pair.Key
Files.Add(New JObject From {
{"path", ModFile.Path.AfterFirst(OverridesFolder).Replace("\", "/")},
{"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.Path)}}},
{"path", ModFile.File.FullName.AfterFirst(OverridesFolder).Replace("\", "/")},
{"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.File.FullName)}}},
{"downloads", New JArray(Pair.Value.OrderBy(Function(u) u.Contains("modrinth.com")))}, '不优先选择 Modrinth
{"fileSize", New FileInfo(ModFile.Path).Length}
{"fileSize", New FileInfo(ModFile.File.FullName).Length}
})
File.Delete(ModFile.Path)
ModFile.File.Delete()
Next
Loader.Progress = 0.2
'导出最终 JSON 文件
@@ -670,7 +664,7 @@ Public Class PageInstanceExport
}
File.WriteAllText(CacheFolder & "modpack\modrinth.index.json", ResultJson.ToString(Newtonsoft.Json.Formatting.Indented))
'打包
Directory.CreateDirectory(GetPathFromFullPath(PackPath))
DirectoryUtils.Create(PackPath, isFilePath:=True)
If File.Exists(PackPath) Then File.Delete(PackPath)
If IncludePCL Then
'首次压缩整合包
@@ -65,7 +65,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败(ID " & ID & ")", LogLevel.Feedback)
Log(ex, "切换分页面失败(ID " & ID & ")", NotifyLevel.MsgBoxAndFeedback)
Finally
AniControlEnabled -= 1
End Try
@@ -6,7 +6,7 @@
Private IsLoad As Boolean = False
Public Sub PageOther_Loaded() Handles Me.Loaded
If FrmMain.PageLast.Page <> FormMain.PageType.CompDetail Then PanBack.ScrollToHome()
If FrmMain.PageLast.Page <> FormMain.PageType.ResourceDetail Then PanBack.ScrollToHome()
AniControlEnabled += 1
SelectedMods.Clear()
ReloadModList()
@@ -40,8 +40,8 @@
End Sub
Public Shared Sub Refresh()
Try
CompProjectCache.Clear()
CompFilesCache.Clear()
ResourceProject.Cache.Clear()
ResourceVersion.ProjectFilesCache.Clear()
File.Delete(PathTemp & "Cache\LocalMod.json")
Log("[Mod] 由于点击刷新按钮,清理本地 Mod 信息缓存")
Catch ex As Exception
@@ -71,7 +71,7 @@
''' <summary>
''' 已加载的 Mod UI 缓存,不确保按显示顺序排列。Key 为 Mod 的 RawFileName。
''' </summary>
Public ModItems As New SafeDictionary(Of String, MyLocalModItem)
Public ModItems As New ConcurrentDictionary(Of String, MyLocalModItem)
''' <summary>
''' 将加载器结果的 Mod 列表加载为 UI。
''' </summary>
@@ -87,24 +87,22 @@
Return
End If
'修改缓存
SyncLock ModItems.SyncRoot
ModItems.Clear()
For Each ModEntity As McMod In McModLoader.Output
ModItems(ModEntity.RawFileName) = McModListItem(ModEntity)
Next
End SyncLock
ModItems.Clear()
For Each ModEntity As ResourceFile In McModLoader.Output
ModItems(ModEntity.EnabledName) = McModListItem(ModEntity)
Next
'显示结果
Filter = FilterType.All
SearchBox.Text = "" '这会触发结果刷新,所以需要在 ModItems 更新之后,详见 #3124 的视频
RefreshUI()
Catch ex As Exception
Log(ex, "加载 Mod 列表 UI 失败", LogLevel.Feedback)
Log(ex, "加载 Mod 列表 UI 失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Private Function McModListItem(Entry As McMod) As MyLocalModItem
Private Function McModListItem(Entry As ResourceFile) As MyLocalModItem
AniControlEnabled += 1
Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry,
.ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.RawFileName)}
.ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.EnabledName)}
AddHandler Entry.OnUpdate, Sub() RunInUi(AddressOf NewItem.Refresh)
AniControlEnabled -= 1
Return NewItem
@@ -133,8 +131,8 @@
ToolTipService.SetVerticalOffset(BtnDelete, 30)
ToolTipService.SetHorizontalOffset(BtnDelete, 2)
AddHandler BtnDelete.Click, AddressOf Delete_Click
Dim BtnED As New MyIconButton With {.LogoScale = 1, .Logo = If(sender.Entry.State = McMod.McModState.Fine, Logo.IconButtonStop, Logo.IconButtonCheck), .Tag = sender}
BtnED.ToolTip = If(sender.Entry.State = McMod.McModState.Fine, "禁用", "启用")
Dim BtnED As New MyIconButton With {.LogoScale = 1, .Logo = If(sender.Entry.IsEnabled, Logo.IconButtonStop, Logo.IconButtonCheck), .Tag = sender}
BtnED.ToolTip = If(sender.Entry.IsEnabled, "禁用", "启用")
ToolTipService.SetPlacement(BtnED, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnED, 30)
ToolTipService.SetHorizontalOffset(BtnED, 2)
@@ -147,24 +145,23 @@
''' </summary>
Public Sub RefreshUI()
If PanList Is Nothing Then Return
Dim ShowingMods = If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of McMod))).Where(Function(m) CanPassFilter(m)).ToList
Dim ShowingMods = If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of ResourceFile))).Where(Function(m) CanPassFilter(m)).ToList
'重新列出列表
AniControlEnabled += 1
If ShowingMods.Any() Then
PanList.Visibility = Visibility.Visible
PanList.Children.Clear()
SyncLock ModItems.SyncRoot
For Each TargetMod In ShowingMods
Dim Item As MyLocalModItem = ModItems(TargetMod.RawFileName)
Item.Checked = SelectedMods.Contains(TargetMod.RawFileName) '更新选中状态
PanList.Children.Add(Item)
Next
End SyncLock
For Each TargetMod In ShowingMods
Dim Item As MyLocalModItem = Nothing
If Not ModItems.TryGetValue(TargetMod.EnabledName, Item) Then Continue For
Item.Checked = SelectedMods.Contains(TargetMod.EnabledName) '更新选中状态
PanList.Children.Add(Item)
Next
Else
PanList.Visibility = Visibility.Collapsed
End If
AniControlEnabled -= 1
SelectedMods = SelectedMods.Where(Function(m) ShowingMods.Any(Function(s) s.RawFileName = m)).ToList '取消选中已经不显示的 Mod
SelectedMods = SelectedMods.Where(Function(m) ShowingMods.Any(Function(s) s.EnabledName = m)).ToList '取消选中已经不显示的 Mod
RefreshBars()
End Sub
@@ -172,6 +169,7 @@
''' 刷新顶栏和底栏显示。
''' </summary>
Public Sub RefreshBars()
'-----------------
' 顶部栏
'-----------------
@@ -179,14 +177,13 @@
'计数
Dim AnyCount As Integer = 0
Dim EnabledCount As Integer = 0
Dim DisabledCount As Integer = 0
Dim UpdateCount As Integer = 0
For Each ModItem In If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of McMod)))
For Each ModItem In If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of ResourceFile)))
AnyCount += 1
If ModItem.CanUpdate Then UpdateCount += 1
If ModItem.State.Equals(McMod.McModState.Fine) Then EnabledCount += 1
If ModItem.State.Equals(McMod.McModState.Disabled) Then DisabledCount += 1
If ModItem.HasUpdate Then UpdateCount += 1
If ModItem.IsEnabled Then EnabledCount += 1
Next
Dim DisabledCount As Integer = AnyCount - EnabledCount
'显示
BtnFilterAll.Text = If(IsSearching, "搜索结果", "全部") & $" ({AnyCount})"
BtnFilterCanUpdate.Text = $"可更新 ({UpdateCount})"
@@ -210,14 +207,10 @@
Dim HasEnabled As Boolean = False
Dim HasDisabled As Boolean = False
For Each ModEntity In McModLoader.Output
If SelectedMods.Contains(ModEntity.RawFileName) Then
If ModEntity.CanUpdate Then HasUpdate = True
If ModEntity.State = McMod.McModState.Fine Then
HasEnabled = True
ElseIf ModEntity.State = McMod.McModState.Disabled Then
HasDisabled = True
End If
End If
If Not SelectedMods.Contains(ModEntity.EnabledName) Then Continue For
If ModEntity.HasUpdate Then HasUpdate = True
If ModEntity.IsEnabled Then HasEnabled = True
If Not ModEntity.IsEnabled Then HasDisabled = True
Next
BtnSelectDisable.IsEnabled = HasEnabled
BtnSelectEnable.IsEnabled = HasDisabled
@@ -278,10 +271,10 @@
''' </summary>
Private Sub BtnManageOpen_Click(sender As Object, e As EventArgs) Handles BtnManageOpen.Click, BtnHintOpen.Click
Try
Directory.CreateDirectory(PageInstanceLeft.Instance.PathIndie & "mods\")
DirectoryUtils.Create(PageInstanceLeft.Instance.PathIndie & "mods\")
OpenExplorer(PageInstanceLeft.Instance.PathIndie & "mods\")
Catch ex As Exception
Log(ex, "打开 Mods 文件夹失败", LogLevel.Msgbox)
Log(ex, "打开 Mods 文件夹失败", NotifyLevel.MsgBox)
End Try
End Sub
@@ -342,7 +335,7 @@ Install:
LoaderFolderRun(McModLoader, Instance.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
End If
Catch ex As Exception
Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox)
Log(ex, "复制 Mod 文件失败", NotifyLevel.MsgBox)
End Try
End If
Return True
@@ -353,8 +346,8 @@ Install:
''' </summary>
Private Sub BtnManageDownload_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageDownload.Click, BtnHintDownload.Click
'预设置当前版本和搜索框内容
PageComp.TargetInstance = PageInstanceLeft.Instance
PageComp.TargetName = SearchBox.Text
PageResource.TargetInstance = PageInstanceLeft.Instance
PageResource.TargetName = SearchBox.Text
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadMod)
End Sub
@@ -369,7 +362,7 @@ Install:
Public Sub CheckChanged(sender As MyLocalModItem, e As RouteEventArgs)
If AniControlEnabled <> 0 Then Return
'更新选择了的内容
Dim SelectedKey As String = sender.Entry.RawFileName
Dim SelectedKey As String = sender.Entry.EnabledName
If sender.Checked Then
If Not SelectedMods.Contains(SelectedKey) Then SelectedMods.Add(SelectedKey)
Else
@@ -386,7 +379,7 @@ Install:
'#4992,Mod 从过滤器看可能不应在列表中,但因为刚切换状态所以依然保留在列表中,所以应该从列表 UI 判断,而非从过滤器判断
Dim ShouldSelected As Boolean = Value AndAlso PanList.Children.Contains(Item)
Item.Checked = ShouldSelected
If ShouldSelected Then SelectedMods.Add(Item.Entry.RawFileName)
If ShouldSelected Then SelectedMods.Add(Item.Entry.EnabledName)
Next
AniControlEnabled -= 1
RefreshBars()
@@ -442,16 +435,16 @@ Install:
''' <summary>
''' 检查该 Mod 项是否符合当前筛选的类别。
''' </summary>
Private Function CanPassFilter(CheckingMod As McMod) As Boolean
Private Function CanPassFilter(CheckingMod As ResourceFile) As Boolean
Select Case Filter
Case FilterType.All
Return True
Case FilterType.Enabled
Return CheckingMod.State = McMod.McModState.Fine
Return CheckingMod.IsEnabled
Case FilterType.Disabled
Return CheckingMod.State = McMod.McModState.Disabled
Return Not CheckingMod.IsEnabled
Case FilterType.CanUpdate
Return CheckingMod.CanUpdate
Return CheckingMod.HasUpdate
Case Else
Return False
End Select
@@ -469,51 +462,51 @@ 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.RawFileName)),
EDMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName)),
Not sender.Equals(BtnSelectDisable))
ChangeAllSelected(False)
End Sub
Private Sub EDMods(ModList As IEnumerable(Of McMod), IsEnable As Boolean)
Private Sub EDMods(ModList As IEnumerable(Of ResourceFile), IsEnable As Boolean)
Dim IsSuccessful As Boolean = True
For Each ModE In ModList.ToList
Dim ModEntity = ModE '仅用于去除迭代变量无法修改的限制
Dim NewPath As String = Nothing
If ModEntity.State = McMod.McModState.Fine AndAlso Not IsEnable Then
If ModEntity.IsEnabled AndAlso Not IsEnable Then
'禁用
NewPath = ModEntity.Path & If(File.Exists(ModEntity.Path & ".old"), ".old", ".disabled")
ElseIf ModEntity.State = McMod.McModState.Disabled AndAlso IsEnable Then
NewPath = ModEntity.File.FullName & If(File.Exists(ModEntity.File.FullName & ".old"), ".old", ".disabled")
ElseIf Not ModEntity.IsEnabled AndAlso IsEnable Then
'启用
NewPath = ModEntity.RawPath
NewPath = ModEntity.EnabledFullName
Else
Continue For
End If
'重命名
Try
If File.Exists(NewPath) Then
If File.Exists(ModEntity.Path) Then
If File.Exists(ModEntity.File.FullName) Then
'同时存在两个名称的 Mod
If GetFileMD5(ModEntity.Path) <> GetFileMD5(NewPath) Then
MyMsgBox($"目前同时存在启用和禁用的两个 Mod 文件:{vbCrLf} - {NewPath}{vbCrLf} - {ModEntity.Path}{vbCrLf}{vbCrLf}注意,这两个文件的内容并不相同。{vbCrLf}在手动删除或重命名其中一个文件后,才能继续操作。", "存在文件冲突")
If GetFileMD5(ModEntity.File.FullName) <> GetFileMD5(NewPath) Then
MyMsgBox($"目前同时存在启用和禁用的两个 Mod 文件:{vbCrLf} - {NewPath}{vbCrLf} - {ModEntity.File.FullName}{vbCrLf}{vbCrLf}注意,这两个文件的内容并不相同。{vbCrLf}在手动删除或重命名其中一个文件后,才能继续操作。", "存在文件冲突")
Continue For
End If
Else
'已经重命名过了
Log("[Mod] Mod 的状态已被切换", LogLevel.Debug)
Log("[Mod] Mod 的状态已被切换", NotifyLevel.DebugModeOnly)
Continue For
End If
End If
File.Delete(NewPath)
File.Move(ModEntity.Path, NewPath)
File.Move(ModEntity.File.FullName, NewPath)
Catch ex As FileNotFoundException
Log(ex, $"未找到需要重命名的 Mod({If(ModEntity.Path, "null")})", LogLevel.Feedback)
Log(ex, $"未找到需要重命名的 Mod({If(ModEntity.File.FullName, "null")})", NotifyLevel.MsgBoxAndFeedback)
ReloadModList(True)
Return
Catch ex As Exception
Log(ex, $"重命名 Mod 失败({If(ModEntity.Path, "null")})")
Log(ex, $"重命名 Mod 失败({If(ModEntity.File.FullName, "null")})")
IsSuccessful = False
End Try
'更改 Loader 中的列表
Dim NewModEntity As New McMod(NewPath)
Dim NewModEntity As New ResourceFile(NewPath)
NewModEntity.FromJson(ModEntity.ToJson)
If McModLoader.Output.Contains(ModEntity) Then
Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity)
@@ -527,7 +520,7 @@ Install:
End If
'更改 UI 中的列表
Dim NewItem As MyLocalModItem = McModListItem(NewModEntity)
ModItems(ModEntity.RawFileName) = NewItem
ModItems(ModEntity.EnabledName) = NewItem
Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry Is ModEntity))
If IndexOfUi = -1 Then Continue For '因为未知原因 Mod 的状态已经切换完了
PanList.Children.RemoveAt(IndexOfUi)
@@ -545,7 +538,7 @@ Install:
'更新
Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click
Dim UpdateList As List(Of McMod) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate).ToList()
Dim UpdateList As List(Of ResourceFile) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName) AndAlso m.HasUpdate).ToList()
If Not UpdateList.Any() Then Return
UpdateMods(UpdateList)
ChangeAllSelected(False)
@@ -554,7 +547,7 @@ Install:
''' 记录正在进行 Mod 更新的 mods 文件夹路径。
''' </summary>
Public Shared UpdatingInstanceModFolders As New List(Of String)
Public Sub UpdateMods(ModList As IEnumerable(Of McMod))
Public Sub UpdateMods(ModList As IEnumerable(Of ResourceFile))
'更新前警告
If Not Settings.Get("HintUpdateMod") OrElse ModList.Count >= 15 Then
If MyMsgBox($"新版本 Mod 可能不兼容旧存档或者其他 Mod,这可能导致游戏崩溃,甚至永久损坏存档!{vbCrLf}如果你在游玩整合包,请千万不要自行更新 Mod!{vbCrLf}{vbCrLf}在更新前,请先备份存档,并检查 Mod 的更新日志。{vbCrLf}如果更新后出现问题,你也可以在回收站找回更新前的 Mod。", "Mod 更新警告", "我已了解风险,继续更新", "取消", IsWarn:=True) = 1 Then
@@ -568,11 +561,11 @@ Install:
ModList = ModList.ToList() '防止刷新影响迭代器
Dim FileList As New List(Of NetFile)
Dim FileCopyList As New Dictionary(Of String, String)
For Each Entry As McMod In ModList
Dim File As CompFile = Entry.UpdateFile
If Not File.Available Then Continue For
For Each Entry As ResourceFile In ModList
Dim File As ResourceVersion = Entry.UpdateFile
If Not File.DownloadAvailable Then Continue For
'确认更新后的文件名
Dim CurrentReplaceName = Entry.CompFile.FileName.Replace(".jar", "").Replace(".old", "").Replace(".disabled", "")
Dim CurrentReplaceName = Entry.ProjectVersion.FileName.Replace(".jar", "").Replace(".old", "").Replace(".disabled", "")
Dim NewestReplaceName = Entry.UpdateFile.FileName.Replace(".jar", "").Replace(".old", "").Replace(".disabled", "")
Dim CurrentSegs = CurrentReplaceName.Split("-"c).ToList()
Dim NewestSegs = NewestReplaceName.Split("-"c).ToList()
@@ -596,8 +589,8 @@ Install:
NewestReplaceName = NewestSegs.Join("-")
End If
'添加到下载列表
Dim TempAddress As String = PathTemp & "mods\" & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName) '需要下载到 mods 文件夹,以便重复文件检查时识别
Dim RealAddress As String = GetPathFromFullPath(Entry.Path) & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName)
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))
FileCopyList(TempAddress) = RealAddress
Next
@@ -608,23 +601,23 @@ Install:
InstallLoaders.Add(New LoaderTask(Of Integer, Integer)("替换旧版 Mod 文件",
Sub()
Try
For Each Entry As McMod In ModList
If File.Exists(Entry.Path) Then
My.Computer.FileSystem.DeleteFile(Entry.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
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)
Else
Log($"[Mod] 未找到更新前的 Mod 文件,跳过对它的删除:{Entry.Path}", LogLevel.Debug)
Log($"[Mod] 未找到更新前的 Mod 文件,跳过对它的删除:{Entry.File.FullName}", NotifyLevel.DebugModeOnly)
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}", LogLevel.Debug)
Log($"[Mod] 更新后的 Mod 文件已存在,将会把它放入回收站:{Entry.Value}", NotifyLevel.DebugModeOnly)
End If
If Directory.Exists(GetPathFromFullPath(Entry.Value)) Then
File.Move(Entry.Key, Entry.Value)
FinishedFileNames.Add(GetFileNameFromPath(Entry.Value))
Else
Log($"[Mod] 更新后的目标文件夹已被删除:{Entry.Value}", LogLevel.Debug)
Log($"[Mod] 更新后的目标文件夹已被删除:{Entry.Value}", NotifyLevel.DebugModeOnly)
End If
Next
Catch ex As OperationCanceledException
@@ -632,7 +625,7 @@ Install:
End Try
End Sub))
'结束处理
Dim Loader As New LoaderCombo(Of IEnumerable(Of McMod))("Mod 更新:" & PageInstanceLeft.Instance.Name, InstallLoaders)
Dim Loader As New LoaderCombo(Of IEnumerable(Of ResourceFile))("Mod 更新:" & PageInstanceLeft.Instance.Name, InstallLoaders)
Dim PathMods As String = PageInstanceLeft.Instance.PathIndie & "mods\"
Loader.OnStateChanged =
Sub()
@@ -683,45 +676,45 @@ Install:
'删除
Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click
DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)))
DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName)))
ChangeAllSelected(False)
End Sub
Private Sub DeleteMods(ModList As IEnumerable(Of McMod))
Private Sub DeleteMods(ModList As IEnumerable(Of ResourceFile))
Try
Dim IsSuccessful As Boolean = True
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
'确认需要删除的文件
ModList = ModList.SelectMany(
Function(Target As McMod)
If Target.State = McMod.McModState.Fine Then
Return {Target.Path, Target.Path & If(File.Exists(Target.Path & ".old"), ".old", ".disabled")}
Function(Target As ResourceFile)
If Target.IsEnabled Then
Return {Target.File.FullName, Target.File.FullName & If(File.Exists(Target.File.FullName & ".old"), ".old", ".disabled")}
Else
Return {Target.Path, Target.RawPath}
Return {Target.File.FullName, Target.EnabledFullName}
End If
End Function).Distinct.Where(Function(m) File.Exists(m)).Select(Function(m) New McMod(m)).ToList()
End Function).Distinct.Where(Function(m) File.Exists(m)).Select(Function(m) New ResourceFile(m)).ToList()
'实际删除文件
For Each ModEntity In ModList
'删除
Try
If IsShiftPressed Then
File.Delete(ModEntity.Path)
ModEntity.File.Delete()
Else
My.Computer.FileSystem.DeleteFile(ModEntity.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
My.Computer.FileSystem.DeleteFile(ModEntity.File.FullName, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消")
ReloadModList(True)
Return
Catch ex As Exception
Log(ex, $"删除 Mod 失败({ModEntity.Path})", LogLevel.Msgbox)
Log(ex, $"删除 Mod 失败({ModEntity.File.FullName})", NotifyLevel.MsgBox)
IsSuccessful = False
End Try
'取消选中
SelectedMods.Remove(ModEntity.RawFileName)
SelectedMods.Remove(ModEntity.EnabledName)
'更改 Loader 和 UI 中的列表
McModLoader.Output.Remove(ModEntity)
SearchResult?.Remove(ModEntity)
ModItems.Remove(ModEntity.RawFileName)
ModItems.Remove(ModEntity.EnabledName)
Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry.Equals(ModEntity)))
If IndexOfUi >= 0 Then PanList.Children.RemoveAt(IndexOfUi)
Next
@@ -738,13 +731,13 @@ Install:
If Not IsSuccessful Then Return
If IsShiftPressed Then
If ModList.IsSingle Then
Hint($"已彻底删除 {ModList.Single.FileName}!", HintType.Green)
Hint($"已彻底删除 {ModList.Single.File.Name}!", HintType.Green)
Else
Hint($"已彻底删除 {ModList.Count} 个文件!", HintType.Green)
End If
Else
If ModList.IsSingle Then
Hint($"已将 {ModList.Single.FileName} 删除到回收站!", HintType.Green)
Hint($"已将 {ModList.Single.File.Name} 删除到回收站!", HintType.Green)
Else
Hint($"已将 {ModList.Count} 个文件删除到回收站!", HintType.Green)
End If
@@ -753,7 +746,7 @@ Install:
Log(ex, "删除 Mod 被主动取消")
ReloadModList(True)
Catch ex As Exception
Log(ex, "删除 Mod 出现未知错误", LogLevel.Feedback)
Log(ex, "删除 Mod 出现未知错误", NotifyLevel.MsgBoxAndFeedback)
ReloadModList(True)
End Try
LoaderRun(LoaderFolderRunType.UpdateOnly)
@@ -772,21 +765,21 @@ Install:
Public Sub Info_Click(sender As Object, e As EventArgs)
Try
Dim ModEntry As McMod = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry
Dim ModEntry As ResourceFile = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry
'加载失败信息
If ModEntry.Comp IsNot Nothing Then
If ModEntry.Project IsNot Nothing Then
'跳转到 Mod 下载页面
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {ModEntry.Comp, New List(Of String), PageInstanceLeft.Instance.Version.VanillaName,
If(PageInstanceLeft.Instance.Version.HasForge, CompModLoaderType.Forge,
If(PageInstanceLeft.Instance.Version.HasNeoForge, CompModLoaderType.NeoForge,
If(PageInstanceLeft.Instance.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any))),
CompType.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}})
Else
'获取信息
Dim ContentLines As New List(Of String)
If ModEntry.Description IsNot Nothing Then ContentLines.Add(ModEntry.Description & vbCrLf)
ContentLines.Add("文件:" & ModEntry.FileName & "(" & GetString(New FileInfo(ModEntry.Path).Length) & ")")
ContentLines.Add("文件:" & ModEntry.File.Name & "(" & FormatFileSize(ModEntry.File.Length) & ")")
If ModEntry.Version IsNot Nothing Then ContentLines.Add("版本:" & ModEntry.Version)
Dim DebugInfo As New List(Of String)
If DebugInfo.Any Then
@@ -794,7 +787,7 @@ Install:
ContentLines.AddRange(DebugInfo)
End If
'获取用于搜索的 Mod 名称
Dim ModOriginalName As String = ModEntry.DisplayName.Replace(" ", "+")
Dim ModOriginalName As String = ModEntry.Display.Replace(" ", "+")
Dim ModSearchName As String = ModOriginalName.Substring(0, 1)
For i = 1 To ModOriginalName.Count - 1
Dim IsLastLower As Boolean = ModOriginalName(i - 1).ToString.Lower.Equals(ModOriginalName(i - 1).ToString)
@@ -807,21 +800,21 @@ Install:
Next
ModSearchName = ModSearchName.Replace("++", "+").Replace("pti+Fine", "ptiFine")
'百科搜索链接
If MyMsgBox(ContentLines.Join(vbCrLf), ModEntry.DisplayName, "百科搜索", "返回") = 1 Then
If MyMsgBox(ContentLines.Join(vbCrLf), ModEntry.Display, "百科搜索", "返回") = 1 Then
OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0")
End If
End If
Catch ex As Exception
Log(ex, "获取 Mod 详情失败", LogLevel.Feedback)
Log(ex, "获取 Mod 详情失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
'打开文件所在的位置
Public Sub Open_Click(sender As MyIconButton, e As EventArgs)
Try
Dim ListItem As MyLocalModItem = sender.Tag
OpenExplorer(ListItem.Entry.Path)
OpenExplorer(ListItem.Entry.File.FullName)
Catch ex As Exception
Log(ex, "打开 Mod 文件位置失败", LogLevel.Feedback)
Log(ex, "打开 Mod 文件位置失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
'删除
@@ -832,7 +825,7 @@ Install:
'启用 / 禁用
Public Sub ED_Click(sender As MyIconButton, e As EventArgs)
Dim ListItem As MyLocalModItem = sender.Tag
EDMods({ListItem.Entry}, ListItem.Entry.State = McMod.McModState.Disabled)
EDMods({ListItem.Entry}, Not ListItem.Entry.IsEnabled)
End Sub
#End Region
@@ -844,28 +837,28 @@ Install:
Return Not String.IsNullOrWhiteSpace(SearchBox.Text)
End Get
End Property
Private SearchResult As List(Of McMod)
Private SearchResult As List(Of ResourceFile)
Public Sub SearchRun() Handles SearchBox.TextChanged
If IsSearching Then
'构造请求
Dim QueryList As New List(Of SearchEntry(Of McMod))
For Each Entry As McMod In McModLoader.Output
Dim QueryList As New List(Of SearchEntry(Of ResourceFile))
For Each Entry As ResourceFile In McModLoader.Output
Dim SearchSources As New List(Of SearchSource)
SearchSources.Add(New SearchSource(Entry.DisplayName, 1))
SearchSources.Add(New SearchSource(Entry.FileName, 1))
SearchSources.Add(New SearchSource(Entry.Display, 1))
SearchSources.Add(New SearchSource(Entry.File.Name, 1))
If Entry.Version IsNot Nothing Then
SearchSources.Add(New SearchSource(Entry.Version, 0.2))
End If
If Entry.Description IsNot Nothing AndAlso Entry.Description <> "" Then
SearchSources.Add(New SearchSource(Entry.Description, 0.4))
End If
If Entry.Comp IsNot Nothing Then
If Entry.Comp.RawName <> Entry.DisplayName Then SearchSources.Add(New SearchSource(Entry.Comp.RawName, 1))
If Entry.Comp.TranslatedName <> Entry.Comp.RawName Then SearchSources.Add(New SearchSource(Entry.Comp.TranslatedName, 1))
If Entry.Comp.Description <> Entry.Description Then SearchSources.Add(New SearchSource(Entry.Comp.Description, 0.4))
SearchSources.Add(New SearchSource(String.Join("", Entry.Comp.Tags), 0.2))
If Entry.Project IsNot Nothing Then
If Entry.Project.RawName <> Entry.Display Then SearchSources.Add(New SearchSource(Entry.Project.RawName, 1))
If Entry.Project.TranslatedName <> Entry.Project.RawName Then SearchSources.Add(New SearchSource(Entry.Project.TranslatedName, 1))
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 McMod) With {.Item = Entry, .SearchSource = SearchSources})
QueryList.Add(New SearchEntry(Of ResourceFile) With {.Item = Entry, .SearchSource = SearchSources})
Next
'进行搜索
SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35).Select(Function(r) r.Item).ToList
@@ -65,7 +65,7 @@
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "修改版本分类失败(" & PageInstanceLeft.Instance.Name & ")", LogLevel.Feedback)
Log(ex, "修改版本分类失败(" & PageInstanceLeft.Instance.Name & ")", NotifyLevel.MsgBoxAndFeedback)
End Try
Reload() '更新 “打开 Mod 文件夹” 按钮
Else
@@ -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 & " 失败", LogLevel.Feedback)
Log(ex, "隐藏版本 " & PageInstanceLeft.Instance.Name & " 失败", NotifyLevel.MsgBoxAndFeedback)
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 & " 描述更改失败", LogLevel.Msgbox)
Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 描述更改失败", NotifyLevel.MsgBox)
End Try
End Sub
@@ -153,7 +153,7 @@
End If
'替换版本设置文件中的路径
If File.Exists(NewPath & "PCL\Setup.ini") Then
WriteFile(NewPath & "PCL\Setup.ini", ReadFile(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath))
FileUtils.Write(NewPath & "PCL\Setup.ini", ReadFile(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath))
End If
'更改已选中的版本
If ReadIni(McFolderSelected & "PCL.ini", "Version") = OldName Then
@@ -162,7 +162,7 @@
'更新版本 Json
Try
JsonObject("id") = NewName
WriteFile(NewPath & NewName & ".json", JsonObject.ToString)
FileUtils.Write(NewPath & NewName & ".json", JsonObject.ToString)
File.Delete(NewPath & GetFileNameFromPath(OldJsonPath))
Catch ex As Exception
Log(ex, "重命名版本 json 失败")
@@ -174,7 +174,7 @@
Reload()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "重命名版本失败", LogLevel.Msgbox)
Log(ex, "重命名版本失败", NotifyLevel.MsgBox)
End Try
End Sub
@@ -194,7 +194,7 @@
File.Delete(PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
End If
Catch ex As Exception
Log(ex, "更改自定义版本图标失败(" & PageInstanceLeft.Instance.Name & ")", LogLevel.Feedback)
Log(ex, "更改自定义版本图标失败(" & PageInstanceLeft.Instance.Name & ")", NotifyLevel.MsgBoxAndFeedback)
End Try
'进行更改
Try
@@ -207,7 +207,7 @@
Reload()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "更改版本图标失败(" & PageInstanceLeft.Instance.Name & ")", LogLevel.Feedback)
Log(ex, "更改版本图标失败(" & PageInstanceLeft.Instance.Name & ")", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -220,7 +220,7 @@
McInstanceListForceRefresh = True
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 收藏状态更改失败", LogLevel.Msgbox)
Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 收藏状态更改失败", NotifyLevel.MsgBox)
End Try
End Sub
@@ -238,16 +238,16 @@
'存档文件夹
Private Sub BtnFolderSaves_Click() Handles BtnFolderSaves.Click
Dim FolderPath As String = PageInstanceLeft.Instance.PathIndie & "saves\"
Directory.CreateDirectory(FolderPath)
OpenExplorer(FolderPath)
Dim Folder As String = PageInstanceLeft.Instance.PathIndie & "saves\"
DirectoryUtils.Create(Folder)
OpenExplorer(Folder)
End Sub
'Mod 文件夹
Private Sub BtnFolderMods_Click() Handles BtnFolderMods.Click
Dim FolderPath As String = PageInstanceLeft.Instance.PathIndie & "mods\"
Directory.CreateDirectory(FolderPath)
OpenExplorer(FolderPath)
Dim Folder As String = PageInstanceLeft.Instance.PathIndie & "mods\"
DirectoryUtils.Create(Folder)
OpenExplorer(Folder)
End Sub
#End Region
@@ -274,7 +274,7 @@
End If
End If
Catch ex As Exception
Log(ex, "导出启动脚本失败(" & PageInstanceLeft.Instance.Name & ")", LogLevel.Msgbox)
Log(ex, "导出启动脚本失败(" & PageInstanceLeft.Instance.Name & ")", NotifyLevel.MsgBox)
End Try
End Sub
@@ -310,7 +310,7 @@
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "尝试补全文件失败(" & PageInstanceLeft.Instance.Name & ")", LogLevel.Msgbox)
Log(ex, "尝试补全文件失败(" & PageInstanceLeft.Instance.Name & ")", NotifyLevel.MsgBox)
End Try
End Sub
@@ -340,7 +340,7 @@
Catch ex As OperationCanceledException
Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 被主动取消")
Catch ex As Exception
Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 失败", LogLevel.Msgbox)
Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 失败", NotifyLevel.MsgBox)
End Try
End Sub
@@ -27,16 +27,16 @@
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="版本隔离" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboArgumentIndieV2" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionArgumentIndieV2" Grid.Column="1">
<local:MyComboBox x:Name="ComboArgumentIndieV2" Grid.Row="0" Grid.ColumnSpan="2" Grid.Column="1">
<local:MyComboBoxItem Content="开启" ToolTipService.InitialShowDelay="0" ToolTipService.BetweenShowDelay="0"
ToolTip="与其他版本的存档、Mod 等文件相互独立,互不干涉。&#xa;这会使你无法跨版本共享存档,但可以规避 Mod 冲突问题。" ToolTipService.HorizontalOffset="100"/>
<local:MyComboBoxItem Content="关闭" ToolTipService.InitialShowDelay="0" ToolTipService.BetweenShowDelay="0"
ToolTip="与其余关闭隔离的版本共享存档、Mod 等文件。&#xa;若存在多个安装了 Mod 的版本,可能会由于 Mod 冲突而导致崩溃。" ToolTipService.HorizontalOffset="100"/>
</local:MyComboBox>
<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" Tag="VersionArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则跟随全局设置的值。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="跟随全局设置" MaxLength="100" />
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="2" Grid.ColumnSpan="2" local:SettingService.Key="VersionArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则跟随全局设置的值。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="跟随全局设置" MaxLength="100" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="4" Grid.ColumnSpan="2" Tag="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="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角。&#xa;若留空,则跟随全局设置的值。&#xa;&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。">
<local:MyTextBox.ValidateRules>
<local:ValidateExcept>
<local:ValidateExcept.Excepts>
@@ -70,11 +70,11 @@
<RowDefinition Height="9" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<local:MyRadioBox Text="跟随全局设置" Width="110" Checked="True" x:Name="RadioRamType2" Tag="VersionRamType/2" Margin="0,0,20,9" />
<local:MyRadioBox Grid.Row="1" Text="自动配置" Width="110" x:Name="RadioRamType0" Tag="VersionRamType/0" Margin="0,0,20,0"
<local:MyRadioBox Text="跟随全局设置" Width="110" Checked="True" x:Name="RadioRamType2" local:SettingService.Key="VersionRamType" local:SettingService.Value="2" Margin="0,0,20,9" />
<local:MyRadioBox Grid.Row="1" Text="自动配置" Width="110" x:Name="RadioRamType0" local:SettingService.Key="VersionRamType" local:SettingService.Value="0" Margin="0,0,20,0"
ToolTip="根据安装的 Mod 量与电脑剩余内存动态调整为游戏分配的内存" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="-10" ToolTipService.VerticalOffset="-3" />
<local:MyRadioBox Grid.Row="3" Text="自定义" x:Name="RadioRamType1" Tag="VersionRamType/1" Margin="0,0,20,0" />
<local:MySlider Grid.Row="3" Grid.Column="1" IsEnabled="False" x:Name="SliderRamCustom" Tag="VersionRamCustom" MaxValue="49" Value="13" />
<local:MyRadioBox Grid.Row="3" Text="自定义" x:Name="RadioRamType1" local:SettingService.Key="VersionRamType" local:SettingService.Value="1" Margin="0,0,20,0" />
<local:MySlider Grid.Row="3" Grid.Column="1" IsEnabled="False" x:Name="SliderRamCustom" local:SettingService.Key="VersionRamCustom" MaxValue="49" Value="13" />
<!--<local:MyTextBox Grid.Row="2" Grid.Column="3" Width="100" VerticalAlignment="Center" Margin="30,0,0,0" Text="2048 MB" />-->
</Grid>
<Grid Margin="0,5,0,0">
@@ -87,7 +87,7 @@
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock Margin="0,6,30,0" Text="启动游戏前进行内存优化" Grid.Row="1" Grid.Column="1" HorizontalAlignment="Left" />
<local:MyComboBox x:Name="ComboRamOptimize" Margin="10,0,0,0" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="2" Tag="VersionRamOptimize">
<local:MyComboBox x:Name="ComboRamOptimize" Margin="10,0,0,0" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="2" local:SettingService.Key="VersionRamOptimize">
<local:MyComboBoxItem Content="跟随全局设置" IsSelected="True" />
<local:MyComboBoxItem Content="开启" />
<local:MyComboBoxItem Content="关闭" />
@@ -141,7 +141,7 @@
<RowDefinition Height="3" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="登录方式" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboServerLogin" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionServerLogin" Grid.Column="1">
<local:MyComboBox x:Name="ComboServerLogin" Grid.Row="0" Grid.ColumnSpan="2" Grid.Column="1">
<local:MyComboBoxItem Content="正版登录或离线登录" IsSelected="True" />
<local:MyComboBoxItem Content="仅正版登录" />
<local:MyComboBoxItem Content="仅离线登录" />
@@ -149,27 +149,27 @@
<local:MyComboBoxItem Content="第三方登录:Authlib Injector 或 LittleSkin" />
</local:MyComboBox>
<TextBlock Name="LabServerNide" Grid.Row="1" VerticalAlignment="Center" HorizontalAlignment="Left" Text="服务器 ID(必填)" Margin="0,8,25,0" Visibility="Collapsed" />
<local:MyTextBox x:Name="TextServerNide" Grid.Row="1" Grid.ColumnSpan="2" ShowValidateResult="False" Tag="VersionServerNide" Grid.Column="1" Margin="0,8,0,0" Visibility="Collapsed" HintText="服主后台 → 集成说明 中提供的服务器 ID">
<local:MyTextBox x:Name="TextServerNide" Grid.Row="1" Grid.ColumnSpan="2" ShowValidateResult="False" local:SettingService.Key="VersionServerNide" Grid.Column="1" Margin="0,8,0,0" Visibility="Collapsed" HintText="服主后台 → 集成说明 中提供的服务器 ID">
<local:MyTextBox.ValidateRules>
<local:ValidateLength Min="32" Max="32" />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
<TextBlock Name="LabServerAuthServer" Grid.Row="1" VerticalAlignment="Center" HorizontalAlignment="Left" Text="认证服务器(必填)" Margin="0,8,25,0" Visibility="Collapsed" />
<local:MyTextBox x:Name="TextServerAuthServer" Grid.Row="1" Grid.ColumnSpan="2" ShowValidateResult="False" Tag="VersionServerAuthServer" Grid.Column="1" Margin="0,8,0,0" Visibility="Collapsed" HintText="Yggdrasil API 认证服务器的完整地址">
<local:MyTextBox x:Name="TextServerAuthServer" Grid.Row="1" Grid.ColumnSpan="2" ShowValidateResult="False" local:SettingService.Key="VersionServerAuthServer" Grid.Column="1" Margin="0,8,0,0" Visibility="Collapsed" HintText="Yggdrasil API 认证服务器的完整地址">
<local:MyTextBox.ValidateRules>
<local:ValidateHttp />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
<TextBlock Name="LabServerAuthRegister" Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="注册链接" Margin="0,8,25,0" Visibility="Collapsed" />
<local:MyTextBox x:Name="TextServerAuthRegister" Grid.Row="2" Grid.ColumnSpan="2" ShowValidateResult="False" Tag="VersionServerAuthRegister" Grid.Column="1" Margin="0,8,0,0" Visibility="Collapsed" HintText="注册账号的网页地址,如 https://xxxxx.xxx/auth/register">
<local:MyTextBox x:Name="TextServerAuthRegister" Grid.Row="2" Grid.ColumnSpan="2" ShowValidateResult="False" local:SettingService.Key="VersionServerAuthRegister" Grid.Column="1" Margin="0,8,0,0" Visibility="Collapsed" HintText="注册账号的网页地址,如 https://xxxxx.xxx/auth/register">
<local:MyTextBox.ValidateRules>
<local:ValidateHttp />
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
<TextBlock Name="LabServerAuthName" Grid.Row="3" VerticalAlignment="Center" HorizontalAlignment="Left" Text="服务器名称" Margin="0,8,25,0" Visibility="Collapsed" />
<local:MyTextBox x:Name="TextServerAuthName" Grid.Row="3" Grid.ColumnSpan="2" ShowValidateResult="False" Tag="VersionServerAuthName" Grid.Column="1" Margin="0,8,0,0" Visibility="Collapsed" HintText="显示在登录页面的服务器名称" />
<local:MyTextBox x:Name="TextServerAuthName" Grid.Row="3" Grid.ColumnSpan="2" ShowValidateResult="False" local:SettingService.Key="VersionServerAuthName" Grid.Column="1" Margin="0,8,0,0" Visibility="Collapsed" HintText="显示在登录页面的服务器名称" />
<TextBlock VerticalAlignment="Center" Grid.Row="5" HorizontalAlignment="Left" Text="自动进入服务器" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextServerEnter" Grid.ColumnSpan="2" Grid.Row="5" Tag="VersionServerEnter" Grid.Column="1" ToolTip="在打开 Minecraft 后自动进入某服务器。&#xa;用英文冒号间隔 IP 与端口,例如 233.233.233.233:12345。">
<local:MyTextBox x:Name="TextServerEnter" Grid.ColumnSpan="2" Grid.Row="5" local:SettingService.Key="VersionServerEnter" Grid.Column="1" ToolTip="在打开 Minecraft 后自动进入某服务器。&#xa;用英文冒号间隔 IP 与端口,例如 233.233.233.233:12345。">
<local:MyTextBox.ValidateRules>
<local:ValidateExcept>
<local:ValidateExcept.Excepts>
@@ -187,7 +187,8 @@
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnServerNideWeb" Grid.Column="0" MinWidth="140" Text="服主后台" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton Grid.Column="0" MinWidth="140" Text="服主后台" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight"
local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://login.mc-user.com:233/server/intro" />
</Grid>
<local:MyButton x:Name="BtnServerAuthLittle" Height="35" MinWidth="150" Margin="0,12,0,0" Text="设置为 LittleSkin" HorizontalAlignment="Left" ColorType="Highlight" />
</StackPanel>
@@ -211,10 +212,10 @@
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Java 虚拟机参数" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionAdvanceJvm" Grid.Column="1" MaxLength="4000" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;也支持使用 PCL 的替换标记,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。&#xa;&#xa;若留空,则跟随全局设置的值。" HintText="跟随全局设置"
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" local:SettingService.Key="VersionAdvanceJvm" Grid.Column="1" MaxLength="4000" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;也支持使用 PCL 的替换标记,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。&#xa;&#xa;若留空,则跟随全局设置的值。" HintText="跟随全局设置"
Height="100" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" VerticalScrollBarVisibility="Auto" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏参数" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="VersionAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如,输入 --demo 则会以试玩模式启动游戏。&#xa;&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;也支持使用 PCL 的替换标记,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。&#xa;&#xa;若留空,则跟随全局设置的值。" HintText="跟随全局设置" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" local:SettingService.Key="VersionAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如,输入 --demo 则会以试玩模式启动游戏。&#xa;&#xa;支持 Minecraft 版本 JSON 中的字符串替换标记,例如 ${library_directory}。&#xa;也支持使用 PCL 的替换标记,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。&#xa;&#xa;若留空,则跟随全局设置的值。" HintText="跟随全局设置" />
<TextBlock VerticalAlignment="Center" Grid.Row="4" HorizontalAlignment="Left" Text="内存管理" Margin="0,0,25,0" />
<local:MyComboBox local:SettingService.Key="VersionAdvanceGC" Grid.Row="4" Grid.ColumnSpan="2" Grid.Column="1">
<local:MyComboBoxItem Content="跟随全局设置" />
@@ -230,21 +231,21 @@
ToolTipService.BetweenShowDelay="0" ToolTip="不自动添加 GC 参数。&#xa;仅当选择此项时,你可以在 “Java 虚拟机参数” 设置中手动添加 GC 参数。" />
</local:MyComboBox>
<TextBlock Grid.Row="6" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,3" />
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="6" Grid.ColumnSpan="2" Tag="VersionAdvanceRun" Grid.Column="1" HintText="" Margin="0,0,0,3"
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="6" Grid.ColumnSpan="2" local:SettingService.Key="VersionAdvanceRun" Grid.Column="1" HintText="" Margin="0,0,0,3"
ToolTip="该项不会覆盖全局设置:启动时会先执行全局设置的命令,再执行版本设置的命令。&#xa;&#xa;在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;你可以用替换标记来动态改变其内容或实现相对路径,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}options.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。&#xa;执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
<local:MyCheckBox Grid.Row="7" Grid.Column="1" x:Name="CheckAdvanceRunWait" Tag="VersionAdvanceRunWait" Visibility="Collapsed"
<local:MyCheckBox Grid.Row="7" Grid.Column="1" x:Name="CheckAdvanceRunWait" local:SettingService.Key="VersionAdvanceRunWait" Visibility="Collapsed"
Text="等待命令执行完成后再继续启动" Margin="0,5,0,0" />
<StackPanel Margin="0,12,0,4" Grid.Row="8" Grid.ColumnSpan="2" HorizontalAlignment="Left">
<local:MyCheckBox Height="28" Text="禁止更新 Mod" x:Name="CheckAdvanceDisableModUpdate" Tag="VersionAdvanceDisableModUpdate"
<local:MyCheckBox Height="28" Text="禁止更新 Mod" x:Name="CheckAdvanceDisableModUpdate" local:SettingService.Key="VersionAdvanceDisableModUpdate"
ToolTip="禁止为此版本更新 Mod,以防止整合包玩家误操作"
ToolTipService.Placement="Right" />
<local:MyCheckBox Height="28" Text="忽略 Java 兼容性警告" x:Name="CheckAdvanceJava" Tag="VersionAdvanceJava"
<local:MyCheckBox Height="28" Text="忽略 Java 兼容性警告" x:Name="CheckAdvanceJava" local:SettingService.Key="VersionAdvanceJava"
ToolTipService.Placement="Right"
ToolTip="如果手动选择了与当前版本不兼容的 Java,则自动跳过兼容性警告弹窗,强制使用手动选择的 Java。" />
<local:MyCheckBox Height="28" Text="关闭文件校验" x:Name="CheckAdvanceAssetsV2" Tag="VersionAdvanceAssetsV2"
<local:MyCheckBox Height="28" Text="关闭文件校验" x:Name="CheckAdvanceAssetsV2" local:SettingService.Key="VersionAdvanceAssetsV2"
ToolTipService.Placement="Right"
ToolTip="完全不更改 assets;不校验 libraries、第三方登录库与版本主 jar 文件是否被修改。&#xa;如果你没有修改相关文件,请勿勾选此项。" />
<local:MyCheckBox Height="28" Text="禁用 Java Launch Wrapper" x:Name="CheckAdvanceDisableJLW" Tag="VersionAdvanceDisableJLW"
<local:MyCheckBox Height="28" Text="禁用 Java Launch Wrapper" x:Name="CheckAdvanceDisableJLW" local:SettingService.Key="VersionAdvanceDisableJLW"
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="VersionAdvanceDisableLUA"
@@ -26,51 +26,30 @@
Public Sub Reload()
Try
'清除缓存
Settings.MakeInstanceDirty()
'启动参数
TextArgumentTitle.Text = Settings.Get("VersionArgumentTitle", Instance:=PageInstanceLeft.Instance)
TextArgumentInfo.Text = Settings.Get("VersionArgumentInfo", Instance:=PageInstanceLeft.Instance)
Dim _unused = PageInstanceLeft.Instance.PathIndie '触发自动判定
ComboArgumentIndieV2.SelectedIndex = If(Settings.Get("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance), 0, 1)
RefreshJavaComboBox()
'游戏内存
CType(FindName("RadioRamType" & Settings.Get("VersionRamType", Instance:=PageInstanceLeft.Instance)), MyRadioBox).Checked = True
OnVersionRamTypeChanged(Settings.Get("VersionRamType", Instance:=PageInstanceLeft.Instance))
SliderRamCustom.Value = Settings.Get("VersionRamCustom", Instance:=PageInstanceLeft.Instance)
ComboRamOptimize.SelectedIndex = Settings.Get("VersionRamOptimize", Instance:=PageInstanceLeft.Instance)
'服务器
TextServerEnter.Text = Settings.Get("VersionServerEnter", Instance:=PageInstanceLeft.Instance)
ComboServerLogin.SelectedIndex = Settings.Get("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
ComboServerLoginLast = ComboServerLogin.SelectedIndex
ServerLogin(ComboServerLogin.SelectedIndex)
TextServerNide.Text = Settings.Get("VersionServerNide", Instance:=PageInstanceLeft.Instance)
TextServerAuthServer.Text = Settings.Get("VersionServerAuthServer", Instance:=PageInstanceLeft.Instance)
TextServerAuthName.Text = Settings.Get("VersionServerAuthName", Instance:=PageInstanceLeft.Instance)
TextServerAuthRegister.Text = Settings.Get("VersionServerAuthRegister", Instance:=PageInstanceLeft.Instance)
UpdateServerLoginUI()
'高级设置
TextAdvanceJvm.Text = Settings.Get("VersionAdvanceJvm", Instance:=PageInstanceLeft.Instance)
TextAdvanceGame.Text = Settings.Get("VersionAdvanceGame", Instance:=PageInstanceLeft.Instance)
TextAdvanceRun.Text = Settings.Get("VersionAdvanceRun", Instance:=PageInstanceLeft.Instance)
CheckAdvanceRunWait.Checked = Settings.Get("VersionAdvanceRunWait", Instance:=PageInstanceLeft.Instance)
If Settings.Get("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) = 2 Then
Log("[Setup] 已迁移老版本的关闭文件校验设置")
Settings.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance)
Settings.Set("VersionAdvanceAssetsV2", True, Instance:=PageInstanceLeft.Instance)
End If
CheckAdvanceAssetsV2.Checked = Settings.Get("VersionAdvanceAssetsV2", Instance:=PageInstanceLeft.Instance)
CheckAdvanceJava.Checked = Settings.Get("VersionAdvanceJava", Instance:=PageInstanceLeft.Instance)
CheckAdvanceDisableJLW.Checked = Settings.Get("VersionAdvanceDisableJLW", Instance:=PageInstanceLeft.Instance)
CheckAdvanceDisableModUpdate.Checked = Settings.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance)
SettingService.RefreshSettings(Me)
'游戏内存
OnVersionRamTypeChanged(Settings.Get("VersionRamType", Instance:=PageInstanceLeft.Instance))
Catch ex As Exception
Log(ex, "重载版本独立设置时出错", LogLevel.Feedback)
Log(ex, "重载版本独立设置时出错", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -78,66 +57,23 @@
Public Sub Reset()
Try
Settings.Reset("VersionServerEnter", Instance:=PageInstanceLeft.Instance)
SettingService.ResetSettings(Me)
Settings.Reset("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionServerNide", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionServerAuthServer", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionServerAuthRegister", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionServerAuthName", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionArgumentTitle", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionArgumentInfo", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionRamType", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionRamCustom", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionRamOptimize", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionAdvanceJvm", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionAdvanceGame", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionAdvanceAssetsV2", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionAdvanceJava", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionAdvanceRun", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionAdvanceRunWait", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionAdvanceDisableJLW", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance)
Settings.Reset("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
JavaSearchLoader.Start(IsForceRestart:=True)
SettingService.ResetSettings(Me)
Log("[Setup] 已初始化版本独立设置")
Hint("已初始化版本独立设置!", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化版本独立设置失败", LogLevel.Msgbox)
Log(ex, "初始化版本独立设置失败", NotifyLevel.MsgBox)
End Try
Reload()
End Sub
'将控件改变路由到设置改变
Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioRamType0.Check, RadioRamType1.Check, RadioRamType2.Check
If AniControlEnabled = 0 Then Settings.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1)), Instance:=PageInstanceLeft.Instance)
End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextServerEnter.ValidatedTextChanged, TextArgumentInfo.ValidatedTextChanged, TextAdvanceGame.ValidatedTextChanged, TextAdvanceJvm.ValidatedTextChanged, TextServerNide.ValidatedTextChanged, TextServerAuthName.ValidatedTextChanged, TextServerAuthRegister.ValidatedTextChanged, TextServerAuthServer.ValidatedTextChanged, TextArgumentTitle.ValidatedTextChanged, TextAdvanceRun.ValidatedTextChanged
If AniControlEnabled = 0 Then
'#3194,不能删减 /
'Dim HandledText As String = sender.Text
'If sender.Tag = "VersionServerAuthServer" OrElse sender.Tag = "VersionServerAuthRegister" Then HandledText = HandledText.TrimEnd("/")
Settings.Set(sender.Tag, sender.Text, Instance:=PageInstanceLeft.Instance)
End If
End Sub
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change
If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Value, Instance:=PageInstanceLeft.Instance)
End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboRamOptimize.SelectionChanged
If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.SelectedIndex, Instance:=PageInstanceLeft.Instance)
End Sub
Private Shared Sub CheckBoxLikeComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndieV2.SelectionChanged
If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.SelectedIndex = 0, Instance:=PageInstanceLeft.Instance)
End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceRunWait.Change, CheckAdvanceAssetsV2.Change, CheckAdvanceJava.Change, CheckAdvanceDisableJLW.Change, CheckAdvanceDisableModUpdate.Change
If AniControlEnabled = 0 Then Settings.Set(sender.Tag, sender.Checked, Instance:=PageInstanceLeft.Instance)
End Sub
#Region "游戏内存"
Public Shared Sub OnVersionRamTypeChanged(Type As Integer)
@@ -161,7 +97,7 @@
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024, 1)
Dim RamGameActual As Double = Math.Round(Math.Min(RamGame, RamAvailable), 5)
Dim RamUsed As Double = Math.Round(RamTotal - RamAvailable, 5)
Dim RamEmpty As Double = Math.Round(MathClamp(RamTotal - RamUsed - RamGame, 0, 1000), 1)
Dim RamEmpty As Double = Math.Round((RamTotal - RamUsed - RamGame).Clamp(0, 1000), 1)
'设置最大可用内存
If RamTotal <= 1.5 Then
SliderRamCustom.MaxValue = Math.Max(Math.Floor((RamTotal - 0.3) / 0.1), 1)
@@ -392,7 +328,7 @@ PreFin:
Private ComboServerLoginLast As Integer
Private Sub ComboServerLogin_Changed() Handles ComboServerLogin.SelectionChanged, TextServerNide.ValidatedTextChanged, TextServerAuthServer.ValidatedTextChanged, TextServerAuthRegister.ValidatedTextChanged
If AniControlEnabled <> 0 Then Return
ServerLogin(ComboServerLogin.SelectedIndex)
UpdateServerLoginUI()
'检查是否输入正确,正确才触发设置改变
If ComboServerLogin.SelectedIndex = 3 AndAlso Not TextServerNide.IsValidated Then Return
If ComboServerLogin.SelectedIndex = 4 AndAlso Not TextServerAuthServer.IsValidated Then Return
@@ -400,10 +336,11 @@ PreFin:
If ComboServerLoginLast = ComboServerLogin.SelectedIndex Then Return
'触发
ComboServerLoginLast = ComboServerLogin.SelectedIndex
ComboChange(ComboServerLogin, Nothing)
Settings.Set("VersionServerLogin", ComboServerLogin.SelectedIndex, Instance:=PageInstanceLeft.Instance)
End Sub
Public Sub ServerLogin(Type As Integer)
Private Sub UpdateServerLoginUI()
If LabServerNide Is Nothing Then Return
Dim Type = ComboServerLogin.SelectedIndex
LabServerNide.Visibility = If(Type = 3, Visibility.Visible, Visibility.Collapsed)
TextServerNide.Visibility = If(Type = 3, Visibility.Visible, Visibility.Collapsed)
PanServerNide.Visibility = If(Type = 3, Visibility.Visible, Visibility.Collapsed)
@@ -417,11 +354,6 @@ PreFin:
CardServer.TriggerForceResize()
End Sub
'统一通行证
Private Sub BtnServerNideWeb_Click(sender As Object, e As EventArgs) Handles BtnServerNideWeb.Click
OpenWebsite("https://login.mc-user.com:233/server/intro")
End Sub
'LittleSkin
Private Sub BtnServerAuthLittle_Click(sender As Object, e As EventArgs) Handles BtnServerAuthLittle.Click
If TextServerAuthServer.Text <> "" AndAlso TextServerAuthServer.Text <> "https://littleskin.cn/api/yggdrasil" AndAlso
@@ -447,7 +379,7 @@ PreFin:
Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Settings.Get("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
Try
For Each Java In JavaList.Clone().OrderByDescending(Function(v) v.MajorVersion)
For Each Java In JavaList.ToList().OrderByDescending(Function(v) v.MajorVersion)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
ToolTipService.SetHorizontalOffset(ListItem, 400)
ComboArgumentJava.Items.Add(ListItem)
@@ -457,7 +389,7 @@ PreFin:
Next
Catch ex As Exception
Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log(ex, "更新版本设置 Java 下拉框失败", LogLevel.Feedback)
Log(ex, "更新版本设置 Java 下拉框失败", NotifyLevel.MsgBoxAndFeedback)
End Try
'更新选择项
If SelectedItem Is Nothing AndAlso JavaList.Any Then
@@ -507,21 +439,22 @@ PreFin:
#End Region
#Region "其他设置"
#Region "版本隔离"
'版本隔离警告
Private IsReverting As Boolean = False
Private Sub ComboArgumentIndieV2_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndieV2.SelectionChanged
If AniControlEnabled <> 0 Then Return
Static IsReverting As Boolean = False
If IsReverting Then Return
If MyMsgBox("调整版本隔离后,你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf &
"如果修改后发现存档消失,把这项设置改回来就能恢复。" & vbCrLf &
If MyMsgBox("调整版本隔离设置后,你需要游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf &
"如果发现存档消失,把这项设置改回来就能恢复。" & vbCrLf &
"如果你不会迁移存档,不建议修改这项设置!",
"警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
IsReverting = True
ComboArgumentIndieV2.SelectedItem = e.RemovedItems(0)
IsReverting = False
End If
'实际应用设置
Settings.Set("VersionArgumentIndieV2", sender.SelectedIndex = 0, Instance:=PageInstanceLeft.Instance)
End Sub
#End Region
@@ -541,7 +474,7 @@ PreFin:
'去除参数中的回车
Private Sub ReplaceEnter(sender As MyTextBox, e As TextChangedEventArgs) Handles TextAdvanceJvm.TextChanged, TextAdvanceGame.TextChanged
Dim NewText = sender.Text.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, " ")
Dim NewText = sender.Text.ReplaceLineEndings(" ", mergeMultiple:=True)
If NewText = sender.Text Then Return
Dim CaretIndex = sender.CaretIndex
sender.Text = NewText
@@ -20,7 +20,7 @@
Data = Converter.Content
Init()
Catch ex As Exception
Log(ex, "登录弹窗初始化失败", LogLevel.Hint)
Log(ex, "登录弹窗初始化失败", NotifyLevel.AllUsers)
End Try
End Sub
@@ -37,7 +37,7 @@
'记录日志
Log("[Control] 登录弹窗:" & LabTitle.Text & vbCrLf & LabCaption.Text)
Catch ex As Exception
Log(ex, "登录弹窗加载失败", LogLevel.Hint)
Log(ex, "登录弹窗加载失败", NotifyLevel.AllUsers)
End Try
End Sub
Private Sub Close()
@@ -64,7 +64,7 @@
Hint("皮肤保存成功!", HintType.Green)
End If
Catch ex As Exception
Log(ex, "保存皮肤失败", LogLevel.Hint)
Log(ex, "保存皮肤失败", NotifyLevel.AllUsers)
End Try
End Sub
Private Sub BtnSkinSave_Checked(sender As MyMenuItem, e As RoutedEventArgs) Handles BtnSkinSave.Checked
@@ -85,7 +85,7 @@
Try
Image = New MyBitmap(Address)
Catch ex As Exception '#2272
Log(ex, $"皮肤文件已损坏:{Address}", LogLevel.Hint)
Log(ex, $"皮肤文件已损坏:{Address}", NotifyLevel.AllUsers)
File.Delete(Address)
Return
End Try
@@ -115,7 +115,7 @@
ImgBack.Source = Image.Clip(Scale * 8, Scale * 8, Scale * 8, Scale * 8)
Log("[Skin] 载入头像成功:" & Loader.Name)
Catch ex As Exception
Log(ex, "载入头像失败(" & If(Address, "null") & "," & Loader.Name & ")", LogLevel.Hint)
Log(ex, "载入头像失败(" & If(Address, "null") & "," & Loader.Name & ")", NotifyLevel.AllUsers)
End Try
End Sub
''' <summary>
@@ -163,7 +163,7 @@
Next
Hint("已刷新头像!", HintType.Green)
Catch ex As Exception
Log(ex, "刷新皮肤缓存失败", LogLevel.Msgbox)
Log(ex, "刷新皮肤缓存失败", NotifyLevel.MsgBox)
End Try
End Sub)
End If
@@ -186,7 +186,7 @@
'完成提示
Hint("更改皮肤成功!", HintType.Green)
Catch ex As Exception
Log(ex, "更改正版皮肤后刷新皮肤失败", LogLevel.Feedback)
Log(ex, "更改正版皮肤后刷新皮肤失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub)
End Sub
@@ -255,7 +255,7 @@ Retry:
Next
SelectedIndex = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception
Log(ex, "获取玩家皮肤列表失败", LogLevel.Feedback)
Log(ex, "获取玩家皮肤列表失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub)
If SelectedIndex Is Nothing Then Return
@@ -278,7 +278,7 @@ Retry:
McLoginMsLoader.Output.ProfileJson = SkinData.ToString()
End If
Catch ex As Exception
Log(ex, "更改披风失败", LogLevel.Hint)
Log(ex, "更改披风失败", NotifyLevel.AllUsers)
Finally
IsChanging = False
End Try
@@ -23,10 +23,10 @@
Sub()
'自动整合包安装:准备
Dim PackInstallPath As String = Nothing
If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip"
If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack"
If File.Exists(PathExeFolder & "modpack.zip") Then PackInstallPath = PathExeFolder & "modpack.zip"
If File.Exists(PathExeFolder & "modpack.mrpack") Then PackInstallPath = PathExeFolder & "modpack.mrpack"
If PackInstallPath IsNot Nothing Then
Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug)
Log("[Launch] 需自动安装整合包:" & PackInstallPath, NotifyLevel.DebugModeOnly)
PageSelectLeft.CreateMcFolderInCurrentPath()
McFolderListLoader.WaitForExit()
End If
@@ -36,7 +36,7 @@
If McFolderSelected = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹")
Else
Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & McFolderSelected, LogLevel.Debug)
Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & McFolderSelected, NotifyLevel.DebugModeOnly)
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
McFolderSelected = McFolderList.First.Location
@@ -55,7 +55,7 @@
Catch ex As CancelledException
Log(ex, "自动安装整合包被用户取消:" & PackInstallPath)
Catch ex As Exception
Log(ex, "自动安装整合包失败:" & PackInstallPath, LogLevel.Msgbox)
Log(ex, "自动安装整合包失败:" & PackInstallPath, NotifyLevel.MsgBox)
End Try
End If
'确认 Minecraft 版本存在
@@ -63,7 +63,7 @@
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), LogLevel.Normal, LogLevel.Debug))
Log("[Launch] 当前选择的 Minecraft 版本无效:" & If(Instance Is Nothing, "null", Instance.PathVersion), If(IsNothing(Instance), NotifyLevel.Silent, NotifyLevel.DebugModeOnly))
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
@@ -80,6 +80,7 @@
RefreshButtonsUI()
RefreshPage(False, False) '有可能选择的版本变化了,需要重新刷新
If McLoginAble() = "" Then McLoginLoader.Start() '自动登录
If Environment.CommandLine.Contains("--test") Then FormMain.EndProgramForce(123) '用于更新器测试生成的程序是否可以正常运行
End Sub)
End Sub, "Version Check", ThreadPriority.AboveNormal)
@@ -256,7 +257,7 @@
PageCurrent = Type
Return PageNew
Catch ex As Exception
Log(ex, "切换登录分页失败(" & GetStringFromEnum(CType(Type, [Enum])) & ")", LogLevel.Feedback)
Log(ex, "切换登录分页失败(" & GetStringFromEnum(CType(Type, [Enum])) & ")", NotifyLevel.MsgBoxAndFeedback)
Return PageNew
End Try
End Function
@@ -337,7 +338,7 @@ UnknownType:
LabTypeOne.Text = If(McInstanceSelected Is Nothing, Settings.Get("CacheAuthServerName"), Settings.Get("VersionServerAuthName", Instance:=McInstanceSelected))
If LabTypeOne.Text = "" Then LabTypeOne.Text = "第三方登录"
Case Else
Log("[Control] 未知的登录页面:" & LoginPageType, LogLevel.Hint)
Log("[Control] 未知的登录页面:" & LoginPageType, NotifyLevel.AllUsers)
GoTo UnknownType
End Select
'刷新页面
@@ -384,13 +385,13 @@ UnknownType:
Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取正版皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", LogLevel.Hint)
Log("[Minecraft] 获取正版皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", NotifyLevel.AllUsers)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 用户未设置自定义皮肤,跳过皮肤加载")
Else
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log(ex, "获取微软正版皮肤失败(" & UserName & ")", LogLevel.Hint)
Log(ex, "获取微软正版皮肤失败(" & UserName & ")", NotifyLevel.AllUsers)
End If
End Try
Finish:
@@ -506,13 +507,13 @@ UseDefault:
Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取统一通行证皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", LogLevel.Hint)
Log("[Minecraft] 获取统一通行证皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", NotifyLevel.AllUsers)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤,跳过皮肤加载")
Else
Data.Output = PathImage & "Skins/Steve.png"
Log(ex, "获取统一通行证皮肤失败(" & UserName & ")", LogLevel.Hint)
Log(ex, "获取统一通行证皮肤失败(" & UserName & ")", NotifyLevel.AllUsers)
End If
End Try
Finish:
@@ -554,13 +555,13 @@ Finish:
Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取 Authlib-Injector 皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", LogLevel.Hint)
Log("[Minecraft] 获取 Authlib-Injector 皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", NotifyLevel.AllUsers)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤,跳过皮肤加载")
Else
Data.Output = PathImage & "Skins/Steve.png"
Log(ex, "获取 Authlib-Injector 皮肤失败(" & UserName & ")", LogLevel.Hint)
Log(ex, "获取 Authlib-Injector 皮肤失败(" & UserName & ")", NotifyLevel.AllUsers)
End If
End Try
Finish:
@@ -678,7 +679,7 @@ ExitRefresh:
If Not McLaunchProcess.HasExited Then McLaunchProcess.Kill()
End If
Catch ex As Exception
Log(ex, "取消启动结束进程失败", LogLevel.Hint)
Log(ex, "取消启动结束进程失败", NotifyLevel.AllUsers)
End Try
End If
End Sub
@@ -735,7 +736,7 @@ ExitRefresh:
Log(ex, "获取 Minecraft 启动下载器失败,可能是因为启动被取消")
HasLaunchDownloader = False
End Try
LabLaunchingDownload.Text = GetString(NetManager.Speed) & "/s"
LabLaunchingDownload.Text = FormatFileSize(NetManager.Speed) & "/s"
'进度改变动画
Dim AnimList As New List(Of AniData) From {
AaGridLengthWidth(ProgressLaunchingFinished, ShowProgress - ProgressLaunchingFinished.Width.Value, 130,, New AniEaseOutFluent),
@@ -768,7 +769,7 @@ ExitRefresh:
End If
AniStart(AnimList, "Launching Progress")
Catch ex As Exception
Log(ex, "刷新启动信息失败", LogLevel.Feedback)
Log(ex, "刷新启动信息失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Private ShowProgress As Double = 0
@@ -6,17 +6,10 @@
xmlns:local="clr-namespace:PCL" PanScroll="PanBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Name="PanMain" Margin="25,25,25,10" Grid.IsSharedSizeScope="True">
<local:MyHint x:Name="PanHint" RelativeSetup="HintSnapshot" Theme="Blue" CanClose="True" Margin="0,0,0,15"
Text="快照版 PCL 包含尚未正式发布的测试功能,仅限赞助者自己使用。&#xa;请不要随意发给其他人,或是用来制作整合包哦!" />
<StackPanel x:Name="PanCustom">
</StackPanel>
<local:MyCard Margin="0,0,0,15" Title="快照版提示" x:Name="PanHint">
<local:MyIconButton LogoScale="1.1" 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="10" HorizontalAlignment="Right" VerticalAlignment="Top"
x:Name="BtnHintClose" />
<StackPanel Margin="25,38,23,15">
<TextBlock x:Name="LabHint1" TextWrapping="Wrap" Margin="0,0,0,2" FontSize="13.5" />
<TextBlock x:Name="LabHint2" TextWrapping="Wrap" Margin="0,0,0,2" FontSize="13.5" />
</StackPanel>
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="启动日志" x:Name="PanLog">
<TextBlock x:Name="LabLog" Margin="20,38,20,18" TextTrimming="None" TextWrapping="Wrap" />
</local:MyCard>
@@ -5,24 +5,13 @@ Public Class PageLaunchRight
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
PanLog.Visibility = If(ModeDebug, Visibility.Visible, Visibility.Collapsed)
PanLog.Visibility = ModeDebug.ToVisibility
'快照版提示
#If BETA Then
PanHint.Visibility = Visibility.Collapsed
#Else
PanHint.Visibility = If(ThemeCheckGold(), Visibility.Collapsed, Visibility.Visible)
LabHint1.Text = "快照版包含尚未正式发布的测试功能,仅用于赞助者本人尝鲜。请不要发给其他人或者用来制作整合包哦!"
LabHint2.Text = $"若已累积赞助¥23.33,在爱发电私信发送 {vbLQ}解锁码{vbRQ} 即可永久隐藏此提示。"
#End If
PanHint.Visibility =
(BuildType <> BuildTypes.Release AndAlso VersionBranchMain = "Official" AndAlso
DonationRank < DonationRanks.Rank23 AndAlso Not CType(Settings.Get("HintSnapshot"), Boolean)).ToVisibility
End Sub
'暂时关闭快照版提示
#If Not BETA Then
Private Sub BtnHintClose_Click(sender As Object, e As EventArgs) Handles BtnHintClose.Click
AniDispose(PanHint, True)
End Sub
#End If
#Region "主页"
''' <summary>
@@ -36,7 +25,7 @@ Public Class PageLaunchRight
RefreshReal()
End SyncLock
Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", If(ModeDebug, LogLevel.Msgbox, LogLevel.Hint))
Log(ex, "加载 PCL 主页自定义信息失败", If(ModeDebug, NotifyLevel.MsgBox, NotifyLevel.AllUsers))
End Try
End Sub)
End Sub
@@ -46,7 +35,7 @@ Public Class PageLaunchRight
Case 1
'加载本地文件
Log("[Page] 主页自定义数据来源:本地文件")
Content = ReadFile(Path & "PCL\Custom.xaml") 'ReadFile 会进行存在检测
Content = ReadFile(PathExeFolder & "PCL\Custom.xaml") 'ReadFile 会进行存在检测
Case 2
'联网下载
Url = Settings.Get("UiCustomNet")
@@ -168,7 +157,7 @@ Public Class PageLaunchRight
End If
Log($"[Page] 需要下载联网主页,当前版本:{Version},检查源:{VersionAddress}")
Catch exx As Exception
Log(exx, $"联网获取主页版本失败", LogLevel.Developer)
Log(exx, $"联网获取主页版本失败", NotifyLevel.DevelopOnly)
Log($"[Page] 无法检查联网主页版本,将直接下载,检查源:{VersionAddress}")
End Try
'实际下载
@@ -176,11 +165,11 @@ Public Class PageLaunchRight
Log($"[Page] 已联网下载主页,内容长度:{FileContent.Length},来源:{Address}")
Settings.Set("CacheSavedPageUrl", Address)
Settings.Set("CacheSavedPageVersion", Version)
WriteFile(PathTemp & "Cache\Custom.xaml", FileContent)
FileUtils.Write(PathTemp & "Cache\Custom.xaml", FileContent)
'若内容变更则要求刷新
If LoadedContentHash <> FileContent.GetHashCode() AndAlso ShouldRefresh Then Refresh()
Catch ex As Exception
Log(ex, $"下载主页失败({Address})", If(ModeDebug, LogLevel.Msgbox, LogLevel.Hint))
Log(ex, $"下载主页失败({Address})", If(ModeDebug, NotifyLevel.MsgBox, NotifyLevel.AllUsers))
End Try
End Sub
@@ -230,7 +219,7 @@ Public Class PageLaunchRight
End If
Dim LoadStartTime As Date = Date.Now
'修改时应同时修改 PageOtherHelpDetail.Init
Content = ArgumentReplace(Content, AddressOf EscapeXML)
Content = ArgumentReplace(Content, AddressOf EscapeUtils.XmlEscape)
Do While Content.Contains("xmlns")
Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Loop
@@ -256,7 +245,7 @@ Public Class PageLaunchRight
If MyMsgBox(If(TypeOf ex Is UnauthorizedAccessException, ex.Message, $"主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{ex.GetBrief}"),
"加载主页失败", "重试", "取消") = 1 Then ForceRefresh()
Else
Log(ex, "加载主页失败", LogLevel.Hint)
Log(ex, "加载主页失败", NotifyLevel.AllUsers)
End If
End Sub
''' <summary>
@@ -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] 要求更换角色,但登录加载器繁忙", LogLevel.Debug)
Log("[Launch] 要求更换角色,但登录加载器繁忙", NotifyLevel.DebugModeOnly)
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, "更换角色失败", LogLevel.Hint)
Log(ex, "更换角色失败", NotifyLevel.AllUsers)
End Try
End Sub)
End Sub
@@ -18,7 +18,7 @@
ComboAccounts.Items.Add(Item)
Next
Catch ex As Exception
Log(ex, $"微软登录信息出错,登录信息已被重置({Settings.Get("LoginMsJson")})", LogLevel.Hint)
Log(ex, $"微软登录信息出错,登录信息已被重置({Settings.Get("LoginMsJson")})", NotifyLevel.AllUsers)
Settings.Set("LoginMsJson", "{}")
End Try
'如果不保留输入,刷新列表后自动选择第一项
@@ -91,10 +91,10 @@
If ex.Message = "$$" Then
ElseIf ex.Message.StartsWithF("$") Then
Hint(ex.Message.TrimStart("$"), HintType.Red)
ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.ContainsF("SSL/TLS") Then
Log(ex, "正版登录验证失败,请考虑在 [设置 → 其他] 中关闭 [在正版登录时验证 SSL 证书],然后再试。" & vbCrLf & vbCrLf & "原始错误信息:", LogLevel.Msgbox)
ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.Contains("SSL/TLS") Then
Log(ex, "正版登录验证失败,请考虑在 [设置 → 其他] 中关闭 [在正版登录时验证 SSL 证书],然后再试。" & vbCrLf & vbCrLf & "原始错误信息:", NotifyLevel.MsgBox)
Else
Log(ex, "正版登录尝试失败", LogLevel.Msgbox)
Log(ex, "正版登录尝试失败", NotifyLevel.MsgBox)
End If
Finally
RunInUi(
@@ -36,8 +36,8 @@
LogoScale="1.1" Logo="M462.336 924.891429L73.142857 950.857143l25.965714-389.193143 467.017143-467.017143a73.398857 73.398857 0 0 1 103.789715 0l259.437714 259.437714a73.398857 73.398857 0 0 1 0 103.789715l-467.017143 467.017143z m155.684571-778.349715L202.861714 561.664l259.474286 259.474286L877.458286 405.942857 618.057143 146.541714zM151.003429 873.033143l233.508571-25.965714-207.579429-207.579429-25.965714 233.545143z m544.841142-492.982857l51.894858 51.894857-233.508572 233.508571-51.931428-51.894857 233.545142-233.508571z">
<local:MyIconButton.ContextMenu>
<ContextMenu Closed="HidePanel" HorizontalOffset="10" VerticalOffset="18">
<local:MyMenuItem Click="BtnEditPassword_Click" Header="修改密码" />
<local:MyMenuItem Click="BtnEditName_Click" Header="修改玩家名" />
<local:MyMenuItem Header="修改密码" local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://account.live.com/password/Change" />
<local:MyMenuItem Header="修改玩家名" local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile" />
</ContextMenu>
</local:MyIconButton.ContextMenu>
</local:MyIconButton>
@@ -41,12 +41,6 @@
Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click
BtnEdit.ContextMenu.IsOpen = True
End Sub
Public Sub BtnEditPassword_Click(sender As Object, e As RoutedEventArgs)
OpenWebsite("https://account.live.com/password/Change")
End Sub
Public Sub BtnEditName_Click(sender As Object, e As RoutedEventArgs)
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
End Sub
'退出登录
Private Sub BtnExit_Click() Handles BtnExit.Click
@@ -125,12 +119,12 @@ Retry:
If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then
Hint("更改皮肤失败:连接皮肤服务器超时,请稍后再试,或使用 VPN 改善网络环境", HintType.Red)
ElseIf TypeOf ex Is ResponsedWebException AndAlso CType(ex, ResponsedWebException).StatusCode = HttpStatusCode.Unauthorized Then
Log(ex, "更改皮肤时遭遇 401 错误", LogLevel.Developer)
Log(ex, "更改皮肤时遭遇 401 错误", NotifyLevel.DevelopOnly)
Hint("正在重新登录,将在登录后自动更改皮肤……")
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
GoTo Retry
Else
Log(ex, "更改皮肤失败", LogLevel.Hint)
Log(ex, "更改皮肤失败", NotifyLevel.AllUsers)
End If
Finally
IsChanging = False
@@ -20,7 +20,8 @@
<TextBlock Name="TextName" Text="加载中" Margin="8,0" FontSize="14" HorizontalAlignment="Center" TextTrimming="CharacterEllipsis" />
<TextBlock Name="TextEmail" Text="加载中" Margin="8,4,8,0" FontSize="12" HorizontalAlignment="Center" TextTrimming="CharacterEllipsis" Foreground="{DynamicResource ColorBrushGray3}" />
</StackPanel>
<local:MyIconButton ToolTip="更改密码" Grid.Row="1" Height="14" Opacity="0" x:Name="BtnEdit" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="32" ToolTipService.HorizontalOffset="1" ToolTipService.InitialShowDelay="50" Grid.Column="0" HorizontalAlignment="Center" Logo="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z" Margin="8,0,0,0" VerticalAlignment="Center" />
<local:MyIconButton ToolTip="更改密码" Grid.Row="1" Height="14" Opacity="0" x:Name="BtnEdit" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="32" ToolTipService.HorizontalOffset="1" ToolTipService.InitialShowDelay="50" Grid.Column="0" HorizontalAlignment="Center" Logo="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z" Margin="8,0,0,0" VerticalAlignment="Center"
local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://login.mc-user.com:233/account/changepw" />
<local:MyIconButton ToolTip="退出登录" Grid.Row="1" Height="14" Opacity="0" x:Name="BtnExit" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="32" ToolTipService.HorizontalOffset="1" ToolTipService.InitialShowDelay="50" Grid.Column="2" HorizontalAlignment="Center" Logo="F1 M 51.0071,19.0027L 51.0071,27.0038L 48.0067,27.0038L 48.0067,22.0031L 25.0035,22.0031L 25.0035,54.0075L 48.0067,54.0075L 48.0067,49.0068L 51.0071,49.0068L 51.0071,57.008L 22.1698,57.008L 22.0031,19.0027L 51.0071,19.0027 Z M 30.0042,35.0049L 45.2563,35.0049L 37.005,28.0039L 47.0066,28.0039L 58.5082,38.0053L 47.0066,48.0067L 37.005,48.0067L 45.2563,41.0057L 30.0042,41.0057L 30.0042,35.0049 Z" Margin="0,0,8,0" VerticalAlignment="Center" />
</Grid>
<local:MySkin HorizontalAlignment="Center" VerticalAlignment="Top" x:Name="Skin" HasCape="False" />
@@ -44,9 +44,6 @@
}, "PageLoginNideSkin Button")
End Sub
Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click
OpenWebsite("https://login.mc-user.com:233/account/changepw")
End Sub
Public Shared Sub ExitLogin() Handles BtnExit.Click
Settings.Set("CacheNideAccess", "")
McLoginNideLoader.Input = Nothing '防止因为输入的用户名密码相同,直接使用了上次登录的加载器结果
@@ -102,11 +102,11 @@ Public Class PageLinkMain
Function() As String
Dim Result As String = ""
For i = 1 To 5
Result &= RadixConvert(RandomInteger(0, 35), 10, 36)
Result &= RandomInteger(0, 35).ConvertRadix(36)
Next
Return Result.Replace("O", "0").Replace("I", "1")
End Function
NetworkName = $"P{RadixConvert(ServerPort, 10, 16).PadLeft(4, "0"c)}-{GenerateRandomCode()}"
NetworkName = $"P{ServerPort.ConvertRadix(16).PadLeft(4, "0"c)}-{GenerateRandomCode()}"
NetworkSecret = GenerateRandomCode()
DiscoverNodeID = -1
Log($"[Link] 尝试创建房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort}")
@@ -138,13 +138,13 @@ Public Class PageLinkMain
Log($"[Link] 实际使用的邀请码:{Code}")
'基础信息
IsServerSide = False
ServerPort = RadixConvert(Code.Substring(1, 4), 16, 10)
ServerPort = Code.Substring(1, 4).Upper.ConvertRadix(16, 10)
NetworkName = Code.Substring(0, 11)
NetworkSecret = Code.Substring(12, 5)
If Code.Substring(20, 3) = "000" Then
DiscoverNodeID = -2
Else
DiscoverNodeID = RadixConvert(Code.Substring(20, 3), 16, 10)
DiscoverNodeID = Code.Substring(20, 3).Upper.ConvertRadix(16, 10)
End If
Log($"[Link] 尝试加入房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort},发现节点 {DiscoverNodeID}")
'启动
@@ -339,9 +339,9 @@ Public Class PageLinkMain
''' 退出联机。
''' 返回是否弹出了警告窗口并且玩家选择了取消。
''' </summary>
Public Function TryExit(Slient As Boolean, Closing As Boolean) As Boolean
Public Function TryExit(Silent As Boolean, Closing As Boolean) As Boolean
If LinkState = LinkStates.Waiting OrElse LinkState = LinkStates.Failed Then Return False
If Not Slient Then
If Not Silent Then
If IsServerSide AndAlso PeopleCount > 1 Then
If MyMsgBox("你确定要关闭联机房间吗?" & vbCrLf & "所有玩家都需要重新输入邀请码才可加入游戏!", "退出联机", "确定", "取消", IsWarn:=True) = 2 Then Return True
ElseIf Closing Then
@@ -361,7 +361,7 @@ Public Class PageLinkMain
End Sub
Private Function GetInviteCode() As String
Return $"{NetworkName}-{NetworkSecret}-{INVITE_CODE_VERSION.ToString.PadLeft(2, "0"c)}{ _
RadixConvert(If(DiscoverNodeID = -1, 0, DiscoverNodeID), 10, 16).PadLeft(3, "0"c)}"
If(DiscoverNodeID = -1, 0, DiscoverNodeID).ConvertRadix(16).PadLeft(3, "0"c)}"
End Function
'复制 IP
@@ -451,7 +451,7 @@ Public Class PageLinkMain
Case Reflection.ProcessorArchitecture.Arm
Architecture = "arm64"
Case Else
Log($"[Link] CPU 是不支持的 {Architecture} 架构,这可能会导致联机模块无法启动!", LogLevel.Debug)
Log($"[Link] CPU 是不支持的 {Architecture} 架构,这可能会导致联机模块无法启动!", NotifyLevel.DebugModeOnly)
Architecture = "arm64"
End Select
Log("[Link] CPU 架构:" & Architecture)
@@ -524,7 +524,7 @@ Public Class PageLinkMain
'获取启动参数
Dim Arguments As String = ServerConfig("Link")("Argument")
Arguments += $" --network-name={NetworkName} --network-secret={NetworkSecret} --listeners {ListenersPort} --rpc-portal {RPCPort} --private-mode true"
Dim HostName = If(IsServerSide, "Server-", "Client-") & RadixConvert(Math.Abs(Identify.GetHashCode), 10, 36)
Dim HostName = If(IsServerSide, "Server-", "Client-") & Math.Abs(Identify.GetHashCode).ConvertRadix(36)
If IsServerSide Then
Arguments += $" -i 10.114.114.114 --hostname={HostName} --tcp-whitelist={ServerPort} --udp-whitelist={ServerPort}"
Else
@@ -562,13 +562,13 @@ Public Class PageLinkMain
Dim PeerCount As Integer = If(Peers Is Nothing, -1, Peers.Where(Function(p) p.Ping > 0).Count)
Select Case PeerCount
Case -1 'CLI 无返回
Task.Progress = MathClamp(Task.Progress + 0.02, 0.15, 0.25)
Task.Progress = (Task.Progress + 0.02).Clamp(0.15, 0.25)
Case 0 'CLI 有返回,但未连接到任何节点
UpdateLoadingPage("正在连接到节点……", "连接节点")
Task.Progress = MathClamp(Task.Progress + 0.02, If(IsServerSide, 0.5, 0.3), If(IsServerSide, 0.95, 0.5))
Task.Progress = (Task.Progress + 0.02).Clamp(If(IsServerSide, 0.5, 0.3), If(IsServerSide, 0.95, 0.5))
Case Else '已连接到节点,但未连接到房主
UpdateLoadingPage("正在连接到房主……", "连接房主")
Task.Progress = MathClamp(Task.Progress + 0.02, Math.Min(0.45 + PeerCount * 0.05, 0.65), 0.95)
Task.Progress = (Task.Progress + 0.02).Clamp(Math.Min(0.45 + PeerCount * 0.05, 0.65), 0.95)
End Select
'超时判定
If LastProgress <> Task.Progress Then
@@ -654,14 +654,14 @@ 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} 的发现节点", LogLevel.Debug)
Log($"[Link] 未找到 ID {DiscoverNodeID} 的发现节点", NotifyLevel.DebugModeOnly)
Panic("房间已过期", "请让房主重新创建房间!")
Throw New ThreadInterruptedException
End If
End If
If SelectedDiscoverNode Is Nothing Then '使用回退发现节点
SelectedDiscoverNode = New JObject From {{"address", FallbackDiscoverAddress}, {"id", FallbackDiscoverID}}
Log("[Link] 将使用回退发现节点", LogLevel.Debug)
Log("[Link] 将使用回退发现节点", NotifyLevel.DebugModeOnly)
End If
FinalPeers.Add(SelectedDiscoverNode("address").ToString())
FinalDiscoverID = SelectedDiscoverNode("id").ToObject(Of Integer)
@@ -676,7 +676,7 @@ ForcedPass:
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
Log(ex, "获取节点列表失败,联机质量可能受到影响", LogLevel.Hint)
Log(ex, "获取节点列表失败,联机质量可能受到影响", NotifyLevel.AllUsers)
FinalPeers.AddRange(ServerConfig("Link")("Peers").Select(Function(p) p.ToString))
If FinalDiscoverID <= 0 Then
FinalPeers.Add(FallbackDiscoverAddress)
@@ -800,11 +800,11 @@ ForcedPass:
LogHistory.Enqueue(Line)
If LogHistory.Count >= 10 Then LogHistory.Dequeue()
'检查日志内容
If Line.ContainsF("new peer connection added", True) Then
Log("[Link] 已建立连接:" & If(RegexSeek(Line, "(?<=remote_addr.+?"")[^""}]{3,}"), Line), LogLevel.Debug)
If Line.ContainsIgnoreCase("new peer connection added") Then
Log("[Link] 已建立连接:" & If(RegexSeek(Line, "(?<=remote_addr.+?"")[^""}]{3,}"), Line), NotifyLevel.DebugModeOnly)
Update()
ElseIf Line.ContainsF("peer connection removed", True) Then
Log("[Link] 已断开连接:" & If(RegexSeek(Line, "(?<=remote_addr.+?"")[^""}]{3,}"), Line), LogLevel.Debug)
ElseIf Line.ContainsIgnoreCase("peer connection removed") Then
Log("[Link] 已断开连接:" & If(RegexSeek(Line, "(?<=remote_addr.+?"")[^""}]{3,}"), Line), NotifyLevel.DebugModeOnly)
Update()
End If
End Sub
@@ -873,8 +873,8 @@ ForcedPass:
'基础信息
Double.TryParse(Info("lat_ms"), NumberStyles.Any, CultureInfo.InvariantCulture, Ping)
Name = PeerName
Relay = Info("cost").ToString.ContainsF("relay", True)
NATType = Info("nat_type").ToString.ParseToEnum(Of NATTypes)
Relay = Info("cost").ToString.ContainsIgnoreCase("relay")
NATType = Info("nat_type").ToString.ToEnum(Of NATTypes)
End Sub
Public Overrides Function ToString() As String
Return $"{Type} - {Name} - Ping {Ping:0.0}ms [中继? {Relay}] - NAT {NATType}"
@@ -1011,7 +1011,7 @@ ForcedPass:
'每 200ms 更新进度条
If LinkState = LinkStates.Loading Then RunInUi(AddressOf UpdateProgressBar)
Catch ex As Exception
Log(ex, "联机模块主时钟出错", LogLevel.Feedback)
Log(ex, "联机模块主时钟出错", NotifyLevel.MsgBoxAndFeedback)
Thread.Sleep(10000)
End Try
Loop
@@ -117,15 +117,21 @@
<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="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="卓" />
<TextBlock Margin="0,1.5,6,0" Text="玖" />
<TextBlock Margin="0,1.5,6,0" Text="雨" />
<TextBlock Margin="0,1.5,6,0" Text="辰" />
<TextBlock Margin="0,1.5,6,0" Text="李" />
<TextBlock Margin="0,1.5,6,0" Text="茧" />
<TextBlock Margin="0,1.5,6,0" Text="烬" />
<TextBlock Margin="0,1.5,6,0" Text="莫" />
<TextBlock Margin="0,1.5,6,0" Text="尊" />
<TextBlock Margin="0,1.5,6,0" Text="埃" />
@@ -137,20 +143,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="W" />
<TextBlock Margin="0,1.5,6,0" Text="悦" />
<TextBlock Margin="0,1.5,6,0" Text="缘" />
<TextBlock Margin="0,1.5,6,0" Text="木" />
<TextBlock Margin="0,1.5,6,0" Text="蔚" />
<TextBlock Margin="0,1.5,6,0" Text="Cr" />
<TextBlock Margin="0,1.5,6,0" Text="@" />
<TextBlock Margin="0,1.5,6,0" Text="呀" />
<TextBlock Margin="0,1.5,6,0" Text="谷" />
<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="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="Siri" />
<TextBlock Margin="0,1.5,6,0" Text="bre" />
<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" />
@@ -158,17 +184,25 @@
<TextBlock Margin="0,1.5,6,0" Text="ZCY" />
<TextBlock Margin="0,1.5,6,0" Text="Kiro" />
<TextBlock Margin="0,1.5,6,0" Text="Win" />
<TextBlock Margin="0,1.5,6,0" Text="hhh" />
<TextBlock Margin="0,1.5,6,0" Text="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="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="芥裔" />
@@ -218,12 +252,41 @@
<TextBlock Margin="0,1.5,6,0" Text="雨润" />
<TextBlock Margin="0,1.5,6,0" Text="颜峰" />
<TextBlock Margin="0,1.5,6,0" Text="符符" />
<TextBlock Margin="0,1.5,6,0" Text="冰块" />
<TextBlock Margin="0,1.5,6,0" Text="莫林" />
<TextBlock Margin="0,1.5,6,0" Text="Gun" />
<TextBlock Margin="0,1.5,6,0" Text="唐匡" />
<TextBlock Margin="0,1.5,6,0" Text="腐蠱" />
<TextBlock Margin="0,1.5,6,0" Text="别打" />
<TextBlock Margin="0,1.5,6,0" Text="):" />
<TextBlock Margin="0,1.5,6,0" Text="临野" />
<TextBlock Margin="0,1.5,6,0" Text="韩枫" />
<TextBlock Margin="0,1.5,6,0" Text="因心" />
<TextBlock Margin="0,1.5,6,0" Text="清风" />
<TextBlock Margin="0,1.5,6,0" Text="夏可" />
<TextBlock Margin="0,1.5,6,0" Text="基本" />
<TextBlock Margin="0,1.5,6,0" Text="杨间" />
<TextBlock Margin="0,1.5,6,0" Text="Slyo" />
<TextBlock Margin="0,1.5,6,0" Text="黑白" />
<TextBlock Margin="0,1.5,6,0" Text="白芷" />
<TextBlock Margin="0,1.5,6,0" Text="汤圆" />
<TextBlock Margin="0,1.5,6,0" Text="黑猫" />
<TextBlock Margin="0,1.5,6,0" Text="柠檬" />
<TextBlock Margin="0,1.5,6,0" Text="愚者" />
<TextBlock Margin="0,1.5,6,0" Text="久蛊" />
<TextBlock Margin="0,1.5,6,0" Text="穆凡" />
<TextBlock Margin="0,1.5,6,0" Text="Han" />
<TextBlock Margin="0,1.5,6,0" Text="玖玖" />
<TextBlock Margin="0,1.5,6,0" Text="梦峰" />
<TextBlock Margin="0,1.5,6,0" Text="小饭" />
<TextBlock Margin="0,1.5,6,0" Text="疾风" />
<TextBlock Margin="0,1.5,6,0" Text="黑色" />
<TextBlock Margin="0,1.5,6,0" Text="洛舞" />
<TextBlock Margin="0,1.5,6,0" Text="医保" />
<TextBlock Margin="0,1.5,6,0" Text="稚苕" />
<TextBlock Margin="0,1.5,6,0" Text="白龙" />
<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" />
@@ -231,6 +294,8 @@
<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="gino" />
<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" />
@@ -240,32 +305,47 @@
<TextBlock Margin="0,1.5,6,0" Text="Gaze" />
<TextBlock Margin="0,1.5,6,0" Text="Cella" />
<TextBlock Margin="0,1.5,6,0" Text="Keyn" />
<TextBlock Margin="0,1.5,6,0" Text="AL76" />
<TextBlock Margin="0,1.5,6,0" Text="4Ghz" />
<TextBlock Margin="0,1.5,6,0" Text="cong" />
<TextBlock Margin="0,1.5,6,0" Text="。_。" />
<TextBlock Margin="0,1.5,6,0" Text="lucky" />
<TextBlock Margin="0,1.5,6,0" Text="Gd64" />
<TextBlock Margin="0,1.5,6,0" Text="空调c" />
<TextBlock Margin="0,1.5,6,0" Text="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="Tarka" />
<TextBlock Margin="0,1.5,6,0" Text="cHEn." />
<TextBlock Margin="0,1.5,6,0" Text="Eiligo" />
<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="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="ziqian" />
<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="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="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="顾東凡" />
@@ -274,6 +354,7 @@
<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="折尾猫" />
@@ -304,21 +385,56 @@
<TextBlock Margin="0,1.5,6,0" Text="八云辰" />
<TextBlock Margin="0,1.5,6,0" Text="祝卿安" />
<TextBlock Margin="0,1.5,6,0" Text="北兮乄" />
<TextBlock Margin="0,1.5,6,0" Text="玉璇玑" />
<TextBlock Margin="0,1.5,6,0" Text="雾雨唯" />
<TextBlock Margin="0,1.5,6,0" Text="大祷师" />
<TextBlock Margin="0,1.5,6,0" Text="大金刚" />
<TextBlock Margin="0,1.5,6,0" Text="胡辣汤" />
<TextBlock Margin="0,1.5,6,0" Text="明日江" />
<TextBlock Margin="0,1.5,6,0" Text="喵千绘" />
<TextBlock Margin="0,1.5,6,0" Text="樗磐呐" />
<TextBlock Margin="0,1.5,6,0" Text="九百百" />
<TextBlock Margin="0,1.5,6,0" Text="真树君" />
<TextBlock Margin="0,1.5,6,0" Text="的角色" />
<TextBlock Margin="0,1.5,6,0" Text="蒋浩然" />
<TextBlock Margin="0,1.5,6,0" Text="问号君" />
<TextBlock Margin="0,1.5,6,0" Text="虚无丶" />
<TextBlock Margin="0,1.5,6,0" Text="鹿泽轩" />
<TextBlock Margin="0,1.5,6,0" Text="西道我" />
<TextBlock Margin="0,1.5,6,0" Text="蛏子酱" />
<TextBlock Margin="0,1.5,6,0" Text="风渐渐" />
<TextBlock Margin="0,1.5,6,0" Text="小黄黄" />
<TextBlock Margin="0,1.5,6,0" Text="锟斤拷" />
<TextBlock Margin="0,1.5,6,0" Text="小竹叶" />
<TextBlock Margin="0,1.5,6,0" Text="九十里" />
<TextBlock Margin="0,1.5,6,0" Text="南华真" />
<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="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="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="TINTIN" />
<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="一哥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" />
@@ -329,16 +445,27 @@
<TextBlock Margin="0,1.5,6,0" Text="sabrina" />
<TextBlock Margin="0,1.5,6,0" Text="XIruotE" />
<TextBlock Margin="0,1.5,6,0" Text="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="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="super9y" />
<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" />
@@ -348,10 +475,15 @@
<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="Buyihan" />
<TextBlock Margin="0,1.5,6,0" Text="疾驰火车" />
<TextBlock Margin="0,1.5,6,0" Text="鸿星天帝" />
<TextBlock Margin="0,1.5,6,0" Text="跳水的鱼" />
<TextBlock Margin="0,1.5,6,0" Text="咸鱼雷音" />
<TextBlock Margin="0,1.5,6,0" Text="云映鹤影" />
<TextBlock Margin="0,1.5,6,0" Text="金禾向暖" />
<TextBlock Margin="0,1.5,6,0" Text="气息荒古" />
<TextBlock Margin="0,1.5,6,0" Text="霜木翔凤" />
<TextBlock Margin="0,1.5,6,0" Text="只见伊人" />
<TextBlock Margin="0,1.5,6,0" Text="苏家阿辰" />
<TextBlock Margin="0,1.5,6,0" Text="未知用户" />
@@ -360,9 +492,12 @@
<TextBlock Margin="0,1.5,6,0" Text="英白拉多" />
<TextBlock Margin="0,1.5,6,0" Text="红袖添香" />
<TextBlock Margin="0,1.5,6,0" Text="氮气炸锅" />
<TextBlock Margin="0,1.5,6,0" Text="爱源神!" />
<TextBlock Margin="0,1.5,6,0" Text="小小小马" />
<TextBlock Margin="0,1.5,6,0" Text="未梦领来" />
<TextBlock Margin="0,1.5,6,0" Text="鸡鸡鸡鸡" />
<TextBlock Margin="0,1.5,6,0" Text="村里村夫" />
<TextBlock Margin="0,1.5,6,0" Text="阿元颜月" />
<TextBlock Margin="0,1.5,6,0" Text="竹林提酒" />
<TextBlock Margin="0,1.5,6,0" Text="黎月红夕" />
<TextBlock Margin="0,1.5,6,0" Text="天下无双" />
@@ -404,16 +539,57 @@
<TextBlock Margin="0,1.5,6,0" Text="凌瑶雪莹" />
<TextBlock Margin="0,1.5,6,0" Text="wswsing" />
<TextBlock Margin="0,1.5,6,0" Text="漆黑噤默" />
<TextBlock Margin="0,1.5,6,0" Text="云水莫伊" />
<TextBlock Margin="0,1.5,6,0" Text="孤星隐耀" />
<TextBlock Margin="0,1.5,6,0" Text="蓝莓蛋糕" />
<TextBlock Margin="0,1.5,6,0" Text="澹台问月" />
<TextBlock Margin="0,1.5,6,0" Text="青山绿衣" />
<TextBlock Margin="0,1.5,6,0" Text="墨迹道术" />
<TextBlock Margin="0,1.5,6,0" Text="落难星言" />
<TextBlock Margin="0,1.5,6,0" Text="莉库莉可" />
<TextBlock Margin="0,1.5,6,0" Text="你好残忍" />
<TextBlock Margin="0,1.5,6,0" Text="胖胖的我" />
<TextBlock Margin="0,1.5,6,0" Text="余秋叶繁" />
<TextBlock Margin="0,1.5,6,0" Text="再见夏霞" />
<TextBlock Margin="0,1.5,6,0" Text="椎名立希" />
<TextBlock Margin="0,1.5,6,0" Text="倾城菜鸡" />
<TextBlock Margin="0,1.5,6,0" Text="言语不行" />
<TextBlock Margin="0,1.5,6,0" Text="白~曦~" />
<TextBlock Margin="0,1.5,6,0" Text="推杯换盏" />
<TextBlock Margin="0,1.5,6,0" Text="漫芜释雪" />
<TextBlock Margin="0,1.5,6,0" Text="幻梦幻蝶" />
<TextBlock Margin="0,1.5,6,0" Text="小鸟游曈" />
<TextBlock Margin="0,1.5,6,0" Text="豆腐与葱" />
<TextBlock Margin="0,1.5,6,0" Text="剑客白洋" />
<TextBlock Margin="0,1.5,6,0" Text="艾露迪克" />
<TextBlock Margin="0,1.5,6,0" Text="空井里蛙" />
<TextBlock Margin="0,1.5,6,0" Text="空乐白夜" />
<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="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="情殇·瑕疵" />
<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="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="虫虫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="PierceShi" />
<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" />
@@ -421,13 +597,24 @@
<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="bentianjia" />
<TextBlock Margin="0,1.5,6,0" Text="shiroNeko" />
<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="孤影赴星河" />
<TextBlock Margin="0,1.5,6,0" Text="清闲挺自在" />
<TextBlock Margin="0,1.5,6,0" Text="欢呼与果糖" />
<TextBlock Margin="0,1.5,6,0" Text="飞天大锅饭" />
<TextBlock Margin="0,1.5,6,0" Text="烟熏秋刀鱼" />
<TextBlock Margin="0,1.5,6,0" Text="人海不可爱" />
<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" />
@@ -444,30 +631,63 @@
<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="渔船制造师" />
<TextBlock Margin="0,1.5,6,0" Text="直型冷凝管" />
<TextBlock Margin="0,1.5,6,0" Text="森风白明梦" />
<TextBlock Margin="0,1.5,6,0" Text="只是个摆设" />
<TextBlock Margin="0,1.5,6,0" Text="清蒸小黄鱼" />
<TextBlock Margin="0,1.5,6,0" Text="徐州老味菜" />
<TextBlock Margin="0,1.5,6,0" Text="胡哲爱蒙多" />
<TextBlock Margin="0,1.5,6,0" Text="黄瓜炒青菜" />
<TextBlock Margin="0,1.5,6,0" Text="阴阳割坤肖" />
<TextBlock Margin="0,1.5,6,0" Text="无厘的抽象" />
<TextBlock Margin="0,1.5,6,0" Text="洒水车之歌" />
<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="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="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="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="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" />
@@ -477,16 +697,30 @@
<TextBlock Margin="0,1.5,6,0" Text="下水道的鼠鼠" />
<TextBlock Margin="0,1.5,6,0" Text="萨卡兹大蟑螂" />
<TextBlock Margin="0,1.5,6,0" Text="吃麦片的老鼠" />
<TextBlock Margin="0,1.5,6,0" Text="双狼天下第一" />
<TextBlock Margin="0,1.5,6,0" Text="丿地狱天使丿" />
<TextBlock Margin="0,1.5,6,0" Text="回忆随缘而起" />
<TextBlock Margin="0,1.5,6,0" Text="杏花村乌龙茶" />
<TextBlock Margin="0,1.5,6,0" Text="想不到丶名字" />
<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="Sylph_茜尔芙" />
<TextBlock Margin="0,1.5,6,0" Text="dadadadada" />
<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="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="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="苇名剑圣有地绫" />
@@ -494,21 +728,38 @@
<TextBlock Margin="0,1.5,6,0" Text="逐梦青年当自强" />
<TextBlock Margin="0,1.5,6,0" Text="哈基米南北路多" />
<TextBlock Margin="0,1.5,6,0" Text="休伯利安养老院" />
<TextBlock Margin="0,1.5,6,0" Text="名为咸鱼的渣子" />
<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="南ིྀ熙ིྀ寒ིྀ笙ིྀ" />
<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="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="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="正电荷PositiveCharge" />
<TextBlock Margin="0,1.5,6,0" Text="沒錢點UberEats也不會變有錢" />
</WrapPanel>
<Grid Height="35">
@@ -517,10 +768,10 @@
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnDonateOutput" Grid.Column="0" MinWidth="140" Text="生成解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" Visibility="Collapsed" />
<local:MyButton x:Name="BtnDonateOutput" Grid.Column="0" MinWidth="140" Text="生成土豆码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" Visibility="Collapsed" />
<local:MyButton x:Name="BtnDonateDonate" Grid.Column="0" MinWidth="140" Text="赞助作者" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" local:CustomEventService.EventType="打开网页" local:CustomEventService.EventData="https://meloong.com/afd/a/LTCat" />
<local:MyButton x:Name="BtnDonateCopy" Grid.Column="1" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnDonateInput" Grid.Column="2" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnDonateInput" Grid.Column="2" MinWidth="140" Text="输入土豆码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid>
</StackPanel>
</local:MyCard>
@@ -10,11 +10,11 @@
If IsLoaded Then Return
IsLoaded = True
ItemAboutPcl.Info = ItemAboutPcl.Info.Replace("%VERSION%", VersionDisplayName).Replace("%VERSIONCODE%", VersionCode).Replace("%BRANCH%", VersionBranchCode)
#If DEBUG Then
BtnDonateDonate.Visibility = Visibility.Collapsed
BtnDonateOutput.Visibility = Visibility.Visible
#End If
ItemAboutPcl.Info = ItemAboutPcl.Info.Replace("%VERSION%", VersionDisplay).Replace("%VERSIONCODE%", VersionCode).Replace("%BRANCH%", CInt(BuildType))
If BuildType = BuildTypes.Debug Then
BtnDonateDonate.Visibility = Visibility.Collapsed
BtnDonateOutput.Visibility = Visibility.Visible
End If
End Sub
@@ -22,13 +22,10 @@
ClipboardSet(Identify)
End Sub
Private Sub BtnDonateCodeInput_Click() Handles BtnDonateInput.Click
DonateCodeInput()
InputPotatoCode(False)
End Sub
#If DEBUG Then
Private Sub BtnDonateOutput_Click(sender As Object, e As EventArgs) Handles BtnDonateOutput.Click
DonateCodeGenerate()
GeneratePotatoCode()
End Sub
#End If
End Class
@@ -27,8 +27,8 @@
'获取全部分类
Dim Types As New List(Of String)
For Each Item As HelpEntry In HelpItems
If Val(VersionBranchCode) = 50 AndAlso Not Item.ShowInPublic Then Continue For
If Val(VersionBranchCode) <> 50 AndAlso Not Item.ShowInSnapshot Then Continue For
If BuildType = BuildTypes.Release AndAlso Not Item.ShowInPublic Then Continue For
If BuildType <> BuildTypes.Release AndAlso Not Item.ShowInSnapshot Then Continue For
For Each Type In Item.Types
If Not Types.Contains(Type) Then Types.Add(Type)
Next
@@ -43,8 +43,8 @@
'确认所属该分类的项目
Dim TypeItems As New List(Of HelpEntry)
For Each Item In HelpItems
If Val(VersionBranchCode) = 50 AndAlso Not Item.ShowInPublic Then Continue For
If Val(VersionBranchCode) <> 50 AndAlso Not Item.ShowInSnapshot Then Continue For
If BuildType = BuildTypes.Release AndAlso Not Item.ShowInPublic Then Continue For
If BuildType <> BuildTypes.Release AndAlso Not Item.ShowInSnapshot Then Continue For
If Item.Types.Contains(Type) Then TypeItems.Add(Item)
Next
'增加卡片
@@ -61,7 +61,7 @@
Next
Catch ex As Exception
Log(ex, "加载帮助列表 UI 失败", LogLevel.Feedback)
Log(ex, "加载帮助列表 UI 失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
@@ -76,7 +76,7 @@
EnterHelpPage(Entry)
End If
Catch ex As Exception
Log(ex, "处理帮助项目点击时发生意外错误", LogLevel.Feedback)
Log(ex, "处理帮助项目点击时发生意外错误", NotifyLevel.MsgBoxAndFeedback)
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 初始化失败,且用户在弹窗中手动放弃", LogLevel.Debug)
Log("[Help] 已取消进入帮助项目,这一般是由于 xaml 初始化失败,且用户在弹窗中手动放弃", NotifyLevel.DebugModeOnly)
End If
End Sub)
End Sub)
@@ -105,7 +105,7 @@
If FrmHelpDetail.Init(Entry) Then
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}})
Else
Log("[Help] 已取消进入帮助项目,这一般是由于 xaml 初始化失败,且用户在弹窗中手动放弃", LogLevel.Debug)
Log("[Help] 已取消进入帮助项目,这一般是由于 xaml 初始化失败,且用户在弹窗中手动放弃", NotifyLevel.DebugModeOnly)
End If
End Sub)
End Sub)
@@ -140,8 +140,8 @@
'构造请求
Dim QueryList As New List(Of SearchEntry(Of HelpEntry))
For Each Entry As HelpEntry In HelpLoader.Output
If Not Entry.ShowInSearch OrElse (Val(VersionBranchCode) = 50 AndAlso Not Entry.ShowInPublic) Then Continue For
If Not Entry.ShowInSearch OrElse (Val(VersionBranchCode) <> 50 AndAlso Not Entry.ShowInSnapshot) Then Continue For
If Not Entry.ShowInSearch OrElse (BuildType = BuildTypes.Release AndAlso Not Entry.ShowInPublic) Then Continue For
If Not Entry.ShowInSearch OrElse (BuildType <> BuildTypes.Release AndAlso Not Entry.ShowInSnapshot) Then Continue For
QueryList.Add(New SearchEntry(Of HelpEntry) With {
.Item = Entry,
.SearchSource = New List(Of SearchSource) From {
@@ -18,7 +18,7 @@
If Content = "" Then Throw New Exception("帮助 xaml 文件为空")
Try
'修改时应同时修改 PageLaunchRight.LoadContent
Content = ArgumentReplace(Content, AddressOf EscapeXML)
Content = ArgumentReplace(Content, AddressOf EscapeUtils.XmlEscape)
Do While Content.Contains("xmlns")
Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Loop
@@ -29,7 +29,7 @@
Return True
Catch ex As Exception
Log("[System] 自定义信息内容:" & vbCrLf & Content)
Log(ex, "加载帮助 XAML 文件失败", LogLevel.Msgbox)
Log(ex, "加载帮助 XAML 文件失败", NotifyLevel.MsgBox)
Return False
End Try
End Function
@@ -83,7 +83,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败(ID " & ID & ")", LogLevel.Feedback)
Log(ex, "切换分页面失败(ID " & ID & ")", NotifyLevel.MsgBoxAndFeedback)
Finally
AniControlEnabled -= 1
End Try
@@ -13,6 +13,7 @@
If ShowHint Then Hint("为便于维护,开源内容中不包含百宝箱功能……")
End Sub
Public Shared Sub MemoryOptimizeInternal(ShowHint As Boolean)
If ShowHint Then Hint("为便于维护,开源内容中不包含百宝箱功能……")
End Sub
Public Shared Function GetRandomCave() As String
Return "为便于维护,开源内容中不包含百宝箱功能……"
@@ -64,7 +64,7 @@
</ContextMenu>
)
End Select
If (Folder.Type = McFolder.Types.Vanilla OrElse Folder.Type = McFolder.Types.RenamedVanilla) AndAlso Folder.Location = Path & ".minecraft\" AndAlso McFolderList.IsSingle Then CType(ContMenu.FindName("Delete"), MyMenuItem).Header = "清空"
If (Folder.Type = McFolder.Types.Vanilla OrElse Folder.Type = McFolder.Types.RenamedVanilla) AndAlso Folder.Location = PathExeFolder & ".minecraft\" AndAlso McFolderList.IsSingle Then CType(ContMenu.FindName("Delete"), MyMenuItem).Header = "清空"
'注册事件
If Not Folder.Type = McFolder.Types.Vanilla Then CType(ContMenu.FindName("Remove"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Remove_Click))
CType(ContMenu.FindName("Open"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Open_Click))
@@ -88,7 +88,7 @@
FrmSelectLeft.PanList.Children.Add(New TextBlock With {.Text = "添加或导入", .Margin = New Thickness(13, 18, 5, 4), .Opacity = 0.6, .FontSize = 12})
'确认创建按钮状态
If Not Directory.Exists(Path & ".minecraft\") Then
If Not Directory.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 出错", LogLevel.Feedback)
Log(ex, "构建 Minecraft 文件夹列表 UI 出错", NotifyLevel.MsgBoxAndFeedback)
Finally
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表
End Try
@@ -168,7 +168,7 @@
'添加文件夹
AddFolder(NewFolder, NewName, True)
Catch ex As Exception
Log(ex, "添加文件夹失败(" & NewFolder & ")", LogLevel.Feedback)
Log(ex, "添加文件夹失败(" & NewFolder & ")", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
''' <summary>
@@ -245,10 +245,10 @@
'满足以上全部条件则视为根目录整合包
Settings.Set("VersionArgumentIndie", 2, Instance:=Instance)
Settings.Set("VersionArgumentIndieV2", False, Instance:=Instance)
Log("[Setup] 已自动关闭单版本隔离:" & Instance.Name, LogLevel.Debug)
Log("[Setup] 已自动关闭单版本隔离:" & Instance.Name, NotifyLevel.DebugModeOnly)
Next
Catch ex As Exception
Log(ex, "向文件夹列表中添加新文件夹失败", LogLevel.Feedback)
Log(ex, "向文件夹列表中添加新文件夹失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub)
End Sub
@@ -264,13 +264,12 @@
Hint("新建 .minecraft 文件夹成功!", HintType.Green)
End Sub
Public Shared Sub CreateMcFolderInCurrentPath()
McFolderSelected = Path & ".minecraft\"
McFolderSelected = PathExeFolder & ".minecraft\"
If Not Directory.Exists(McFolderSelected) Then
Directory.CreateDirectory(McFolderSelected)
Directory.CreateDirectory(McFolderSelected & "versions\")
DirectoryUtils.Create(McFolderSelected & "versions\")
McFolderLauncherProfilesJsonCreate(McFolderSelected)
End If
AddFolder(McFolderSelected, GetFolderNameFromPath(Path), False)
AddFolder(McFolderSelected, GetFolderNameFromPath(PathExeFolder), False)
End Sub
'右键菜单
@@ -300,20 +299,20 @@
Hint(If(Target.Type = McFolder.Types.Custom, "文件夹 " & DeletedName & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Green)
McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception
Log(ex, "从列表中移除游戏文件夹失败", LogLevel.Feedback)
Log(ex, "从列表中移除游戏文件夹失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub
Public Sub Delete_Click(sender As Object, e As RoutedEventArgs)
Dim Target As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
Dim DeleteText As String = If((Target.Type = McFolder.Types.Vanilla OrElse Target.Type = McFolder.Types.RenamedVanilla) AndAlso Target.Location = Path & ".minecraft\" AndAlso McFolderList.IsSingle, "清空", "删除")
Dim DeleteText As String = If((Target.Type = McFolder.Types.Vanilla OrElse Target.Type = McFolder.Types.RenamedVanilla) AndAlso Target.Location = PathExeFolder & ".minecraft\" AndAlso McFolderList.IsSingle, "清空", "删除")
If MyMsgBox("你确定要" & DeleteText & "这个文件夹吗?" & vbCrLf &
"目标文件夹:" & Target.Location & vbCrLf & vbCrLf &
"该文件夹中的游戏存档、游戏版本,以及 MC 之外的其他文件,都会永久丢失,不可恢复!", "警告", "取消", "确认", "取消") <> 2 Then Return
If MyMsgBoxInput("删除确认",
"该文件夹中的游戏存档、游戏版本,以及 MC 之外的其他文件,都会永久丢失,不可恢复!" & vbCrLf &
"目标文件夹:" & Target.Location & vbCrLf & vbCrLf &
"如果确实要删除,请在下面输入【确认删除】以继续。",
ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateSame("确认删除", $"请输入 {vbLQ}确认删除{vbRQ} 这四个字!")},
"如果确实要删除,请在下面输入【Potato】以继续。",
ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateSame("Potato", $"请输入 {vbLQ}Potato{vbRQ}", IgnoreCase:=True)},
Button1:="永久删除文件夹", Button2:="取消", IsWarn:=True) Is Nothing Then Return
RemoveFolderFromSetup(Target)
RunInNewThread(
@@ -322,10 +321,10 @@
Try
Hint("正在" & DeleteText & "文件夹 " & Target.Name & "!", HintType.Blue)
DeleteDirectory(Target.Location)
If DeleteText = "清空" Then Directory.CreateDirectory(Target.Location)
If DeleteText = "清空" Then DirectoryUtils.Create(Target.Location)
Hint("已" & DeleteText & "文件夹 " & Target.Name & "!", HintType.Green)
Catch ex As Exception
Log(ex, DeleteText & "文件夹 " & Target.Name & " 失败", LogLevel.Hint)
Log(ex, DeleteText & "文件夹 " & Target.Name & " 失败", NotifyLevel.AllUsers)
Finally
'刷新列表
McFolderListLoader.Start(IsForceRestart:=True)
@@ -395,7 +394,7 @@
Settings.Set("LaunchFolders", Folders.Join("|"))
McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception
Log(ex, "重命名文件夹失败", LogLevel.Feedback)
Log(ex, "重命名文件夹失败", NotifyLevel.MsgBoxAndFeedback)
End Try
End Sub

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