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

Merge pull request #43 from Hex-Dragon/main

Browse Source 
u
This commit is contained in:
薄奚梦灵
2025-04-30 14:49:34 +08:00
committed by GitHub
parent effdf5a3a9 44aea3e962
commit 124f5c2f8b
63 changed files with 1281 additions and 1995 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+15 -12
View File
@@ -13,13 +13,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.9.3" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.9.3." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.10.0" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.10.0." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 355 'Release
Public Const VersionCode As Integer = 357 'Release
#Else
Public Const VersionCode As Integer = 354 'Snapshot
Public Const VersionCode As Integer = 356 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -745,7 +745,6 @@ Public Module ModBase
Dim IsRight As Boolean = FilePath.EndsWithF("\")
FilePath = Left(FilePath, Len(FilePath) - 1)
GetPathFromFullPath = Left(FilePath, FilePath.LastIndexOfAny({"\", "/"})) & If(IsRight, "\", "/")
If GetPathFromFullPath = "" Then Throw New Exception("不包含路径：" & FilePath)
Else
'是文件路径
GetPathFromFullPath = Left(FilePath, FilePath.LastIndexOfAny({"\", "/"}) + 1)
@@ -2333,13 +2332,17 @@ NextElement:
''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
''' <param name="Arguments">运行参数。</param>
Public Sub ShellOnly(FileName As String, Optional Arguments As String = "")
FileName = ShortenPath(FileName)
Using Program As New Process
Program.StartInfo.Arguments = Arguments
Program.StartInfo.FileName = FileName
Log("[System] 执行外部命令：" & FileName & " " & Arguments)
Program.Start()
End Using
Try
FileName = ShortenPath(FileName)
Using Program As New Process
Program.StartInfo.Arguments = Arguments
Program.StartInfo.FileName = FileName
Log("[System] 执行外部命令：" & FileName & " " & Arguments)
Program.Start()
End Using
Catch ex As Exception
Log(ex, "打开文件或程序失败：" & FileName, LogLevel.Msgbox)
End Try
End Sub
''' <summary>
''' 前台运行文件并返回返回值。
Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+2 -2
View File
@@ -625,8 +625,8 @@ Restart:
End Sub
Public Function LoaderTaskbarProgressGet() As Double
Try
If Not LoaderTaskbar.Any Then Return 1
Return MathClamp(LoaderTaskbar.Select(Function(e) e.Progress).Average(), 0, 1)
If Not LoaderTaskbar.Where(Function(l) l.Show).Any Then Return 1
Return MathClamp(LoaderTaskbar.Where(Function(l) l.Show).Select(Function(l) l.Progress).Average(), 0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5
Plain Craft Launcher 2/Modules/Base/ModValidate.vb
+14 -13
View File
@@ -9,6 +9,7 @@ Public Module ModValidate
Dim Result As String = ""
For Each ValidateRule As Validate In ValidateRules
Result = ValidateRule.Validate(Text)
If Result Is Nothing Then Return ""
If Result <> "" Then Return Result
Next
Return Result
@@ -21,7 +22,7 @@ End Module
''' </summary>
Public MustInherit Class Validate
''' <summary>
''' 验证某字符串是否符合验证要求。若符合，返回空字符串；若不符合，返回错误原因。
''' 验证某字符串是否符合验证要求。若符合，返回空字符串；若不符合，返回错误原因；若需要中断检查并直接通过，返回 Nothing。
''' </summary>
Public MustOverride Function Validate(Str As String) As String
End Class
@@ -135,9 +136,9 @@ Public Class ValidateLength
Me.Max = Max
End Sub
Public Overrides Function Validate(Str As String) As String
If Len(Str) <> Max AndAlso Max = Min Then Return "长度必须为 " & Max & " 个字符！"
If Len(Str) > Max Then Return "长度最长为 " & Max & " 个字符！"
If Len(Str) < Min Then Return "长度至少需 " & Min & " 个字符！"
If Len(Str) <> Max AndAlso Max = Min Then Return $"长度必须为 {Max} 个字符！"
If Len(Str) > Max Then Return $"长度最长为 {Max} 个字符！"
If Len(Str) < Min Then Return $"长度至少需 {Min} 个字符！"
Return ""
End Function
End Class
@@ -234,21 +235,21 @@ Public Class ValidateFolderName
Try
'检查是否为空
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
If LengthCheck <> "" Then Return LengthCheck
'检查空格
If Str.StartsWithF(" ") Then Return "文件夹名不能以空格开头！"
If Str.EndsWithF(" ") Then Return "文件夹名不能以空格结尾！"
'检查长度
LengthCheck = New ValidateLength(1, 100).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
If LengthCheck <> "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWithF(".") Then Return "文件夹名不能以小数点结尾！"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符！").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
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)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
If InvalidStrCheck <> "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名（#4505）
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式！"
'检查文件夹重名
@@ -295,15 +296,15 @@ Public Class ValidateFileName
If Str.EndsWithF(" ") Then Return "文件名不能以空格结尾！"
'检查长度
LengthCheck = New ValidateLength(1, 253).Validate(Str & If(ParentFolder, ""))
If Not LengthCheck = "" Then Return LengthCheck
If LengthCheck <> "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWithF(".") Then Return "文件名不能以小数点结尾！"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符！").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
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)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
If InvalidStrCheck <> "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名（#4505）
If RegexCheck(Str, ".{2,}~\d") Then Return "文件名不能包含这一特殊格式！"
'检查文件重名
@@ -342,10 +343,10 @@ Public Class ValidateFolderPath
If Not Str.TrimEnd("\").EndsWithF(":") Then Str = Str.TrimEnd("\")
'检查是否为空
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
If LengthCheck <> "" Then Return LengthCheck
'检查长度
LengthCheck = New ValidateLength(1, 254).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
If LengthCheck <> "" Then Return LengthCheck
'检查开头
If Str.StartsWithF("\\Mac\") Then GoTo Fin
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+165 -185
View File
@@ -2,6 +2,10 @@
Public Enum CompType
''' <summary>
''' 允许任意种类，或种类未知。
''' </summary>
Any = -1
''' <summary>
''' Mod。
''' </summary>
[Mod] = 0
@@ -18,9 +22,14 @@
''' </summary>
Shader = 3
''' <summary>
''' 数据包。
''' CurseForge：数据包。
''' Modrinth：数据包，或数据包与 Mod 的混合。
''' </summary>
DataPack = 4
''' <summary>
''' 服务端插件。
''' </summary>
Plugin = 5
End Enum
Public Enum CompModLoaderType
'https://docs.curseforge.com/?http#tocS_ModLoaderType
@@ -119,13 +128,10 @@
Public ReadOnly FromCurseForge As Boolean
''' <summary>
''' 工程的种类。
''' 由于 Modrinth 混合使用 Mod 和数据包，结果不一定准确。
''' </summary>
Public ReadOnly Type As CompType
''' <summary>
''' 是否为 Mod / 数据包融合工程。
''' </summary>
Public ReadOnly IsMix As Boolean
''' <summary>
''' 工程的短名。例如 technical-enchant。
''' </summary>
Public ReadOnly Slug As String
@@ -190,7 +196,9 @@
Get
If Not LoadedDatabase Then
LoadedDatabase = True
If Type = CompType.Mod Then _DatabaseEntry = CompDatabase.FirstOrDefault(Function(c) If(FromCurseForge, c.CurseForgeSlug, c.ModrinthSlug) = Slug)
If Type = CompType.Mod OrElse Type = CompType.DataPack Then
_DatabaseEntry = CompDatabase.FirstOrDefault(Function(c) If(FromCurseForge, c.CurseForgeSlug, c.ModrinthSlug) = Slug)
End If
End If
Return _DatabaseEntry
End Get
@@ -266,6 +274,20 @@
LogoUrl = Data("logo")("thumbnailUrl")
End If
End If
'Type
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
Type = CompType.Mod
ElseIf Website.Contains("/modpacks/") Then
Type = CompType.ModPack
ElseIf Website.Contains("/resourcepacks/") Then
Type = CompType.ResourcePack
ElseIf Website.Contains("/texture-packs/") Then
Type = CompType.ResourcePack
ElseIf Website.Contains("/shaders/") Then
Type = CompType.Shader
Else
Type = CompType.DataPack
End If
'FileIndexes / GameVersions / ModLoaders
ModLoaders = New List(Of CompModLoaderType)
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
@@ -286,26 +308,12 @@
Select(Function(v) CInt(Val(v.Split(".")(1).BeforeFirst("-")))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Type
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
Type = CompType.Mod
ElseIf Website.Contains("/modpacks/") Then
Type = CompType.ModPack
ElseIf Website.Contains("/resourcepacks/") Then
Type = CompType.ResourcePack
ElseIf Website.Contains("/texture-packs/") Then
Type = CompType.ResourcePack
ElseIf Website.Contains("/shaders/")
Type = CompType.Shader
Else
Type = CompType.DataPack
End If
'Tags
Tags = New List(Of String)
For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段：https://github.com/Hex-Dragon/PCL2/issues/4267#issuecomment-2254590831
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
'Mod
Case 406 : Tags.Add("世界元素")
Case 407 : Tags.Add("生物群系")
Case 410 : Tags.Add("维度")
@@ -329,7 +337,7 @@
Case 435 : Tags.Add("服务器")
Case 5191 : Tags.Add("改良")
Case 421 : Tags.Add("支持库")
'整合包
'整合包
Case 4484 : Tags.Add("多人")
Case 4479 : Tags.Add("硬核")
Case 4483 : Tags.Add("战斗")
@@ -346,39 +354,36 @@
Case 4480 : Tags.Add("基于地图")
Case 4481 : Tags.Add("轻量")
Case 4482 : Tags.Add("大型")
'数据包
Case 6946 : Tags.Add("Mod 支持")
Case 6947 : 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 6951 : Tags.Add("科技")
Case 6952 : Tags.Add("魔法")
Case 6953 : Tags.Add("实用工具")
'光影包
Case 6553 : Tags.Add("写实")
Case 6554 : Tags.Add("幻想")
Case 6555 : Tags.Add("原版风")
'资源包
Case 5244 : Tags.Add("字体包")
Case 5193 : Tags.Add("数据包")
Case 399 : Tags.Add("蒸汽朋克")
Case 396 : Tags.Add("128x")
Case 398 : Tags.Add("512x 或更高")
Case 397 : Tags.Add("256x")
Case 405 : Tags.Add("其他")
Case 395 : Tags.Add("64x")
Case 400 : Tags.Add("仿真")
Case 393 : Tags.Add("16x")
Case 403 : Tags.Add("传统")
Case 394 : Tags.Add("32x")
Case 404 : Tags.Add("动态效果")
Case 4465 : Tags.Add("模组支持")
Case 402 : Tags.Add("中世纪")
Case 401 : Tags.Add("现代")
Case 6946 : Tags.Add("Mod 相关")
Case 6951 : Tags.Add("科技")
Case 6953 : Tags.Add("实用")
End Select
Next
If Not Tags.Any() Then Tags.Add("杂项")
#End Region
Else
#Region "Modrinth"
@@ -400,16 +405,11 @@
Distinct.OrderByDescending(Function(v) v).ToList
'Type
Select Case Data("project_type").ToString
Case "mod" : Type = CompType.Mod
Case "modpack" : Type = CompType.ModPack
Case "resourcepack" : Type = CompType.ResourcePack
Case "datapack" : Type = CompType.DataPack
Case "shader" : Type = CompType.Shader
Case Else : Type = CompType.Mod 'Modrinth 将数据包标为 Mod
End Select
If Data("categories").ToArray.Contains("datapack") Then 'Modrinth 上的数据包由于未知原因，返回的 project_type 为 mod，这里做兜底处理
Type = CompType.DataPack
IsMix = Data("categories").ToArray.Contains("forge") OrElse Data("categories").ToArray.Contains("fabric") OrElse Data("categories").ToArray.Contains("neoforge") OrElse Data("categories").ToArray.Contains("quilt")
End If
'Tags & ModLoaders
Tags = New List(Of String)
ModLoaders = New List(Of CompModLoaderType)
@@ -430,117 +430,75 @@
Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric)
Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt)
Case "neoforge" : ModLoaders.Add(CompModLoaderType.NeoForge)
'Mod
Case "worldgen" : Tags.Add("世界元素")
Case "datapack" : Type = CompType.DataPack '若包含数据包版本，则优先标为 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 "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险")
Case "decoration" : Tags.Add("装饰")
Case "mobs" : Tags.Add("生物")
Case "equipment" : Tags.Add("装备")
Case "optimization" : Tags.Add("性能优化")
Case "decoration" : If Type <> CompType.ResourcePack Then Tags.Add("装饰")
Case "mobs" : If Type <> CompType.ResourcePack Then Tags.Add("生物")
Case "equipment" : If Type <> CompType.ResourcePack Then Tags.Add("装备")
Case "social" : Tags.Add("服务器")
Case "utility" : Tags.Add("改良")
Case "library" : Tags.Add("支持库")
'整合包
Case "multiplayer" : Tags.Add("多人")
Case "optimization" : Tags.Add("性能优化")
Case "challenging" : Tags.Add("硬核")
Case "combat" : Tags.Add("战斗")
Case "quests" : Tags.Add("任务")
Case "technology" : Tags.Add("科技")
Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险")
Case "kitchen-sink" : Tags.Add("水槽包/大杂烩")
Case "kitchen-sink" : Tags.Add("水槽包")
Case "lightweight" : Tags.Add("轻量")
'数据包
Case "adventure" : Tags.Add("冒险")
Case "cursed" : Tags.Add("Cursed")
Case "decoration" : Tags.Add("装饰")
Case "economy" : Tags.Add("经济")
Case "equipment" : Tags.Add("装备")
Case "food" : Tags.Add("食物")
Case "game-mechanics" : Tags.Add("游戏机制")
Case "library" : Tags.Add("支持库")
Case "magic" : Tags.Add("魔法")
Case "management" : Tags.Add("管理")
Case "minigame" : Tags.Add("小游戏")
Case "mobs" : Tags.Add("生物")
Case "optimization" : Tags.Add("优化")
Case "social" : Tags.Add("社交")
Case "storage" : Tags.Add("存储")
Case "technology" : Tags.Add("科技")
Case "transportation" : Tags.Add("交通")
Case "utility" : Tags.Add("实用工具")
Case "worldgen" : Tags.Add("世界生成")
'光影包
Case "cartoon" : Tags.Add("卡通")
Case "cursed" : Tags.Add("Cursed")
Case "fantasy" : Tags.Add("幻想")
Case "realistic" : Tags.Add("写实")
Case "semi-realistic" : Tags.Add("半写实")
Case "vanilla-like" : Tags.Add("原版风")
Case "atmosphere" : Tags.Add("大气环境")
Case "bloom" : Tags.Add("植被")
Case "colored-lighting" : Tags.Add("光源着色")
Case "foliage" : Tags.Add("树叶")
Case "path-tracing" : Tags.Add("路径追踪")
Case "pbr" : Tags.Add("PBR")
Case "reflections" : Tags.Add("反射")
Case "shadows" : Tags.Add("阴影")
Case "potato" : Tags.Add("土豆画质")
Case "low" : Tags.Add("低性能影响")
Case "medium" : Tags.Add("中性能影响")
Case "high" : Tags.Add("高性能影响")
Case "screenshot" : Tags.Add("极致画质")
Case "canvas" : Tags.Add("Canvas")
Case "iris" : Tags.Add("Iris")
Case "optifine" : Tags.Add("OptiFine")
Case "vanilla" : Tags.Add("原版光影")
'资源包
Case "8x-" : Tags.Add("8x-")
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("512x+")
Case "audio" : Tags.Add("声音")
Case "blocks" : Tags.Add("方块")
Case "combat" : Tags.Add("战斗")
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 "cursed" : Tags.Add("Cursed")
Case "decoration" : Tags.Add("装饰")
Case "entities" : Tags.Add("实体")
Case "environment" : Tags.Add("环境")
Case "equipment" : Tags.Add("装备")
Case "fonts" : Tags.Add("字体")
Case "gui" : Tags.Add("GUI")
Case "items" : Tags.Add("物品")
Case "locale" : Tags.Add("本地化")
Case "modded" : Tags.Add("Modded")
Case "models" : Tags.Add("模型")
Case "realistic" : Tags.Add("写实")
Case "simplistic" : Tags.Add("扁平")
Case "themed" : Tags.Add("主题")
Case "tweaks" : Tags.Add("优化")
Case "utility" : Tags.Add("实用")
Case "vanilla-like" : 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 "vanilla" : Tags.Add("原版可用")
End Select
Next
If Not Tags.Any() Then Tags.Add("杂项")
Tags.Sort()
ModLoaders.Sort()
#End Region
End If
If Not Tags.Any() Then Tags.Add("其他")
Tags.Sort()
ModLoaders.Sort()
End If
'保存缓存
CompProjectCache(Id) = Me
@@ -663,7 +621,7 @@
NewItem.ColumnVersion1.Width = New GridLength(0)
NewItem.ColumnVersion2.MaxWidth = 0
NewItem.ColumnVersion3.Width = New GridLength(0)
ElseIf ShowMcVersionDesc AndAlso ShowMcVersionDesc Then
ElseIf ShowMcVersionDesc AndAlso ShowLoaderDesc Then
'全部显示
NewItem.LabVersion.Text = If(ModLoaderDescriptionPart = "", "", ModLoaderDescriptionPart & " ") & GameVersionDescription
ElseIf ShowMcVersionDesc Then
@@ -793,8 +751,8 @@ NoSubtitle:
If FromCurseForge = Project.FromCurseForge Then Return False
'Mod 加载器一致
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
'MC 版本一致
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False
'若不为光影，则要求 MC 版本一致
If Type <> CompType.Shader AndAlso (GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any()) Then Return False
'最近更新时间差距在一周以内
If LastUpdate IsNot Nothing AndAlso Project.LastUpdate IsNot Nothing AndAlso
Math.Abs((LastUpdate - Project.LastUpdate).Value.TotalDays) > 7 Then Return False
@@ -1020,7 +978,7 @@ NoSubtitle:
'中文请求关键字处理
Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]") AndAlso Not String.IsNullOrEmpty(RawFilter)
If IsChineseSearch AndAlso Task.Input.Type = CompType.Mod Then
If IsChineseSearch AndAlso (Task.Input.Type = CompType.Mod OrElse Task.Input.Type = CompType.DataPack) Then
'构造搜索请求
Dim SearchEntries As New List(Of SearchEntry(Of CompDatabaseEntry))
For Each Entry In CompDatabase
@@ -1111,7 +1069,9 @@ Retry:
Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("data")
ProjectList.Add(New CompProject(JsonEntry))
Dim Project As New CompProject(JsonEntry)
If Task.Input.Type = CompType.ResourcePack AndAlso Project.Tags.Contains("数据包") Then Continue For 'CurseForge 将一些数据包分类成了资源包
ProjectList.Add(Project)
Next
'更新结果
SyncLock ResultsLock
@@ -1146,7 +1106,6 @@ Retry:
'更新结果
SyncLock ResultsLock
For Each Project In ProjectList
If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件（#2458）
RawResults.Add(Project)
Next
End SyncLock
@@ -1174,8 +1133,8 @@ Retry:
If [Error] IsNot Nothing Then
Throw [Error]
Else
If IsChineseSearch AndAlso Task.Input.Type <> CompType.Mod Then
Throw New Exception($"{If(Task.Input.Type = CompType.ModPack, "整合包", "资源包")}搜索仅支持英文")
If IsChineseSearch AndAlso Not (Task.Input.Type = CompType.Mod OrElse Task.Input.Type = CompType.DataPack) Then
Throw New Exception("没有搜索结果，请尝试使用英文搜索")
ElseIf Task.Input.Source = CompSourceType.CurseForge AndAlso Task.Input.Tag.StartsWithF("/") Then
Throw New Exception("CurseForge 不兼容所选的类型")
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
@@ -1233,10 +1192,23 @@ Retry:
#Region "将结果排序并添加"
Dim Scores As New Dictionary(Of CompProject, Double) '排序分
Dim GetDownloadCountMult =
Function(Project As CompProject) As Double
Select Case Task.Input.Type
Case CompType.Mod, CompType.ModPack
Return If(Project.FromCurseForge, 1, 7)
Case CompType.DataPack
Return If(Project.FromCurseForge, 10, 1)
Case CompType.ResourcePack, CompType.Shader
Return If(Project.FromCurseForge, 1, 5)
Case Else
Return 1
End Select
End Function
If String.IsNullOrEmpty(Task.Input.SearchText) Then
'如果没有搜索文本，按下载量将结果排序
For Each Result As CompProject In RealResults
Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 5))
Scores.Add(Result, Result.DownloadCount * GetDownloadCountMult(Result))
Next
Else
'如果有搜索文本，按关联度将结果排序
@@ -1244,7 +1216,7 @@ Retry:
Dim Entry As New List(Of SearchEntry(Of CompProject))
For Each Result As CompProject In RealResults
Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 5)) / 9)
Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9)
Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
@@ -1327,7 +1299,7 @@ Retry:
Case CompFileStatus.Beta
Return If(ModeDebug, "Beta 版", "测试版")
Case Else
Return If(ModeDebug, "Alpha 版", "测试版")
Return If(ModeDebug, "Alpha 版", "早期测试版")
End Select
End Get
End Property
@@ -1375,8 +1347,8 @@ Retry:
''' <summary>
''' 从文件 Json 中初始化实例。若出错会抛出异常。
''' </summary>
Public Sub New(Data As JObject, Type As CompType)
Me.Type = Type
Public Sub New(Data As JObject, DefaultType As CompType)
Type = DefaultType
If Data.ContainsKey("FromCurseForge") Then
#Region "CompJson"
FromCurseForge = Data("FromCurseForge").ToObject(Of Boolean)
@@ -1414,7 +1386,7 @@ Retry:
DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源，这个写法是为了让镜像源排在后面
DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
'Dependencies
If Type = CompType.Mod Then
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
@@ -1425,7 +1397,7 @@ Retry:
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList
If GameVersions.Count > 1 Then
GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
Else
@@ -1452,8 +1424,27 @@ Retry:
DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
Hash = File("hashes")("sha1")
End If
'ModLoaders
'结果可能混杂着 Mod、数据包和服务端插件
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
ModLoaders = New List(Of CompModLoaderType)
If Type = CompType.Mod Then '以尽量宽容的方式检测加载器，以免同时兼容两种的项被删除
If RawLoaders.Intersect({"bukkit", "folia", "paper", "purpur", "spigot"}).Any() Then Type = CompType.Plugin 'Veinminer Enchantment 同时支持服务端与 Fabric
If RawLoaders.Contains("datapack") Then Type = CompType.DataPack
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge) : Type = CompType.Mod
If RawLoaders.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge) : Type = CompType.Mod
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric) : Type = CompType.Mod
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt) : Type = CompType.Mod
ElseIf Type = CompType.DataPack Then
If RawLoaders.Intersect({"bukkit", "folia", "paper", "purpur", "spigot"}).Any() Then Type = CompType.Plugin
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge) : Type = CompType.Mod
If RawLoaders.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge) : Type = CompType.Mod
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric) : Type = CompType.Mod
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt) : Type = CompType.Mod
If RawLoaders.Contains("datapack") Then Type = CompType.DataPack
End If
'Dependencies
If Type = CompType.Mod Then
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
@@ -1466,7 +1457,7 @@ Retry:
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then
'无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
@@ -1474,13 +1465,6 @@ Retry:
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
'ModLoaders
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
ModLoaders = New List(Of CompModLoaderType)
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawLoaders.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
#End Region
End If
End If
@@ -1528,12 +1512,8 @@ Retry:
Dim Title As String = If(BadDisplayName, FileName, DisplayName)
Dim Info As New List(Of String)
If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast("."))
Select Case Type
Case CompType.Mod
If Dependencies.Any Then Info.Add(Dependencies.Count & " 个前置 Mod")
Case CompType.ModPack
If GameVersions.All(Function(v) v.Contains("w")) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
End Select
If Dependencies.Any Then Info.Add(Dependencies.Count & " 项前置")
If GameVersions.All(Function(v) Not IsVersionNameLikeRelease(v)) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
End If
@@ -1599,7 +1579,7 @@ Retry:
TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
End If
'获取工程对象的文件列表
If Not CompFilesCache.ContainsKey(ProjectId) Then '有缓存也不能直接返回，这时候前置 Mod 可能没获取（#5173）
If Not CompFilesCache.ContainsKey(ProjectId) Then '有缓存也不能直接返回，这时候前置可能没获取（#5173）
Log("[Comp] 开始获取文件列表：" & ProjectId)
Dim ResultJsonArray As JArray
If FromCurseForge Then
@@ -1617,15 +1597,15 @@ Retry:
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
End If
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项（#1330）
Where(Function(a) a.Available).ToList.
Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项（#1330）
End If
'获取前置 Mod 列表
If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId)
'获取前置列表
Dim Deps As List(Of String) = CompFilesCache(ProjectId).SelectMany(Function(f) f.RawDependencies).Distinct().ToList
Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
'获取前置 Mod 工程信息
'获取前置工程信息
If UndoneDeps.Any Then
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod：{Join(UndoneDeps, "，")}")
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置：{Join(UndoneDeps, "，")}")
Dim Projects As JArray
If TargetProject.FromCurseForge Then
Projects = GetJson(DlModRequest("https://api.curseforge.com/v1/mods",
@@ -1634,10 +1614,10 @@ Retry:
Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", IsJson:=True)
End If
For Each Project In Projects
Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存
Dim Unused As New CompProject(Project) '在 New 的时候会添加缓存以便之后读取
Next
End If
'更新前置 Mod 信息
'更新前置信息
If Deps.Any Then
For Each DepProject In Deps.Where(Function(id) CompProjectCache.ContainsKey(id)).Select(Function(id) CompProjectCache(id))
For Each File In CompFilesCache(ProjectId)
@@ -1651,7 +1631,7 @@ Retry:
End Function
''' <summary>
''' 预载包含大量 CompFile 的卡片，添加必要的元素和前置 Mod 列表。
''' 预载包含大量 CompFile 的卡片，添加必要的元素和前置列表。
''' </summary>
Public Sub CompFilesCardPreload(Stack As StackPanel, Files As List(Of CompFile))
'获取卡片对应的前置 ID
@@ -1661,18 +1641,18 @@ Retry:
If Not Deps.Any() Then Exit Sub
Deps = Deps.Where(
Function(dep)
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置信息", LogLevel.Debug)
Return CompProjectCache.ContainsKey(dep)
End Function).ToList
'添加开头间隔
Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
'添加前置 Mod 列表
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 = CompProjectCache(Dep).ToCompItem(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)})
Stack.Children.Add(New TextBlock With {.Text = "版本列表", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 12, 0, 5)})
End Sub
#End Region
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
-4
View File
@@ -858,7 +858,6 @@ NextStack:
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing,
Sub()
Try
'弹窗选择：查看日志
If File.Exists(DirectFile.Value.Key) Then
ShellOnly(DirectFile.Value.Key)
@@ -867,9 +866,6 @@ NextStack:
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
ShellOnly(FilePath)
End If
Catch ex As Exception
Log(ex,"尝试打开文件失败",LogLevel.Hint)
End Try
End Sub))
Case 3
'弹窗选择：导出错误报告
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+75 -35
View File
@@ -197,10 +197,17 @@
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private IsNewClientVersionHinted As Boolean = False
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim StartTime As Long = GetTimeTick()
Dim Json As JObject = NetGetCodeByRequestRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", IsJson:=True)
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
'确定官方源是否可用
If Not DlPreferMojang Then
Dim DeltaTime = GetTimeTick() - StartTime
DlPreferMojang = DeltaTime < 4000
Log($"[Download] Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
End If
'添加 PCL 特供项
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
'返回
@@ -1171,18 +1178,54 @@
#Region "DlSource | 镜像下载源"
Public Function DlSourceResourceGet(Original As String) As String()
Original = Original.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return {
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
Original
}
Private DlPreferMojang As Boolean = False
''' <summary>
''' 下载文件（而非获取版本列表）的时候，是否优先使用官方源。
''' </summary>
Public ReadOnly Property DlSourcePreferMojang As Boolean
Get
Return Setup.Get("ToolDownloadSource") = 2 OrElse (Setup.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang)
End Get
End Property
''' <summary>
''' 下载文件（而非获取版本列表）的时候，根据是否优先使用官方源决定使用 Url 的顺序。
''' </summary>
Public Function DlSourceOrder(OfficialUrls As IEnumerable(Of String), MirrorUrls As IEnumerable(Of String)) As IEnumerable(Of String)
Return If(DlSourcePreferMojang, OfficialUrls.Union(MirrorUrls), MirrorUrls.Union(OfficialUrls))
End Function
''' <summary>
''' 获取版本列表（而非下载文件）的时候，是否优先使用官方源。
''' </summary>
Public ReadOnly Property DlVersionListPreferMojang As Boolean
Get
Return Setup.Get("ToolDownloadVersion") = 2 OrElse (Setup.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang)
End Get
End Property
''' <summary>
''' 获取版本列表（而非下载文件）的时候，根据是否优先使用官方源决定使用 Url 的顺序。
''' </summary>
Public Function DlVersionListOrder(OfficialUrls As IEnumerable(Of String), MirrorUrls As IEnumerable(Of String)) As IEnumerable(Of String)
Return If(DlVersionListPreferMojang, OfficialUrls.Union(MirrorUrls), MirrorUrls.Union(OfficialUrls))
End Function
Public Function DlSourceLibraryGet(Original As String) As String()
''' <summary>
''' 下载 Assets 文件。
''' </summary>
Public Function DlSourceAssetsGet(Original As String) As IEnumerable(Of String)
Original = Original.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return DlSourceOrder(
{Original},
{Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets")
})
End Function
''' <summary>
''' 下载 Libraries 文件。
''' </summary>
Public Function DlSourceLibraryGet(Original As String) As IEnumerable(Of String)
If {"minecraftforge", "fabricmc", "neoforged"}.Any(Function(k) Original.Contains(k)) Then '不添加原版源
Return {
Original.
@@ -1195,44 +1238,41 @@
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries")
}
Else
Return {
Original.
Return DlSourceOrder(
{Original},
{Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
Original.
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
Original
}
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries")
})
End If
End Function
Public Function DlSourceModGet(Original As String) As String
Return Original
'Return Original.
' Replace("api.modrinth.com", "mod.mcimirror.top/modrinth").
' Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth").
' Replace("cdn.modrinth.com", "mod.mcimirror.top").
' Replace("api.curseforge.com", "mod.mcimirror.top/curseforge").
' Replace("edge.forgecdn.net", "mod.mcimirror.top").
' Replace("mediafilez.forgecdn.net", "mod.mcimirror.top").
' Replace("media.forgecdn.net", "mod.mcimirror.top")
End Function
Public Function DlSourceLauncherOrMetaGet(Original As String) As String()
''' <summary>
''' 下载 Launcher 或 Meta 文件。
''' 不应使用它来获取版本列表（因为它只使用文件下载源设置来决定源顺序）。
''' </summary>
Public Function DlSourceLauncherOrMetaGet(Original As String) As IEnumerable(Of String)
If Original Is Nothing Then Throw New Exception("无对应的 json 下载地址")
Return {
Original.
Return DlSourceOrder(
{Original},
{Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
Original
}
Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com")
})
End Function
'Mod 下载源
Public Function DlSourceModGet(Original As String) As String
Return Original
End Function
'Loader 自动切换
Private Sub DlSourceLoader(Of InputType, OutputType)(MainLoader As LoaderTask(Of InputType, OutputType),
LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)),
Optional IsForceRestart As Boolean = False)
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+10 -12
View File
@@ -372,8 +372,7 @@ ExitUserJavaCheck:
For Each Java In AllowedJavaList
'如果在官启文件夹启动，会将官启自带 Java 错误视作 MC 文件夹指定 Java，导致了 #2054 的第二例
If Java.PathFolder.Contains(".minecraft\cache\java") Then Continue For
'#5780
If Java.PathFolder.Contains("PCL\MyDownload") Then Continue For
If Java.PathFolder.Contains("PCL\MyDownload\") Then Continue For '#5780
If TargetJavaList.Contains(Java) Then
'直接使用指定的 Java
AllowedJavaList = New List(Of JavaEntry) From {Java}
@@ -558,9 +557,8 @@ 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
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
Log("[Java] 位于 " & Pair.Key & " 的 Java 位于特殊路径，不应优先使用")
Else
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
End If
Next
@@ -714,8 +712,8 @@ Wait:
Return False
Else
Return MyMsgBox($"PCL 未找到 {VersionDescription}，是否需要 PCL 自动下载？" & vbCrLf &
$"如果你已经安装了 {VersionDescription}，请在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"未找到 Java", "自动下载", "取消") = 1
$"如果你已经安装了 {VersionDescription}，可以在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"自动下载 Java？", "自动下载", "取消") = 1
End If
End Function
@@ -744,10 +742,10 @@ Wait:
Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹，防止残留只下了一半但 -version 能跑的 Java
Private Sub JavaFileList(Loader As LoaderTask(Of Integer, List(Of NetFile)))
Log("[Java] 开始获取 Java 下载信息")
Dim IndexFileStr As String = NetGetCodeByLoader(
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json",
"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
IsJson:=True)
Dim IndexFileStr As String = NetGetCodeByLoader(DlVersionListOrder(
{"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}
), IsJson:=True)
'获取下载地址
Dim MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项（最新）
@@ -756,7 +754,7 @@ Wait:
Dim Address As String = TargetEntry.Value("manifest")("url")
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}（{TargetEntry.Key}）：{Address}")
'获取文件列表
Dim ListFileStr As String = NetGetCodeByLoader({Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"), Address}, IsJson:=True)
Dim ListFileStr As String = NetGetCodeByLoader(DlSourceOrder({Address}, {Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com")}), IsJson:=True)
LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\"
Dim Results As New List(Of NetFile)
For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files")
@@ -769,7 +767,7 @@ Wait:
End If
If Checker.Check(LastJavaBaseDir & File.Name) Is Nothing Then Continue For '跳过已存在的文件
Dim Url As String = Info("url")
Results.Add(New NetFile({Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com"), Url}, LastJavaBaseDir & File.Name, Checker))
Results.Add(New NetFile(DlSourceOrder({Url}, {Url.Replace("piston-data.mojang.com", "bmclapi2.bangbang93.com")}), LastJavaBaseDir & File.Name, Checker))
Next
Loader.Output = Results
Log($"[Java] 需要下载 {Results.Count} 个文件，目标文件夹：{LastJavaBaseDir}")
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+38 -33
View File
@@ -1134,23 +1134,22 @@ Retry:
Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
'MC 大版本检测
If (McVersionCurrent.ReleaseTime >= New Date(2024, 4, 2) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
(McVersionCurrent.Version.McCodeMain > 20 AndAlso McVersionCurrent.Version.McCodeMain <> 99) OrElse
(McVersionCurrent.Version.McCodeMain = 20 AndAlso McVersionCurrent.Version.McCodeSub >= 5) Then
If (Not McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2024, 4, 2)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 20, 5)) Then
'1.20.5+（24w14a+）：至少 Java 21
MinVer = New Version(1, 21, 0, 0)
ElseIf (McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
(McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain <> 99) Then
ElseIf (Not McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 18)) Then
'1.18 pre2+：至少 Java 17
MinVer = New Version(1, 17, 0, 0)
ElseIf (McVersionCurrent.ReleaseTime >= New Date(2021, 5, 11) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
(McVersionCurrent.Version.McCodeMain >= 17 AndAlso McVersionCurrent.Version.McCodeMain <> 99) Then
ElseIf (Not McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2021, 5, 11)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 17)) Then
'1.17+ (21w19a+)：至少 Java 16
MinVer = New Version(1, 16, 0, 0)
ElseIf McVersionCurrent.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年，太棒了
'1.12+：至少 Java 8
MinVer = New Version(1, 8, 0, 0)
ElseIf McVersionCurrent.ReleaseTime <= New Date(2013, 5, 1) AndAlso McVersionCurrent.ReleaseTime.Year >= 2001 Then '避免某些版本的 1960 癌
ElseIf McVersionCurrent.ReleaseTime <= New Date(2013, 5, 1) AndAlso McVersionCurrent.ReleaseTime.Year >= 2001 Then '避免某些版本写个 1960 年
'1.5.2-：最高 Java 12
MaxVer = New Version(1, 12, 999, 999)
End If
@@ -1161,11 +1160,11 @@ Retry:
End If
'OptiFine 检测
If McVersionCurrent.Version.HasOptiFine Then
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
If McVersionCurrent.Version.HasOptiFine AndAlso McVersionCurrent.Version.IsStandardVersion Then '不管非标准版本
If McVersionCurrent.Version.McVersion < New Version(1, 7) Then
'<1.7：至多 Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 8 AndAlso McVersionCurrent.Version.McCodeMain <= 11 Then
ElseIf McVersionCurrent.Version.McVersion >= New Version(1, 8) AndAlso McVersionCurrent.Version.McVersion < New Version(1, 12) Then
'1.8 - 1.11：必须恰好 Java 8
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain = 12 Then
@@ -1176,14 +1175,14 @@ Retry:
'Forge 检测
If McVersionCurrent.Version.HasForge Then
If McVersionCurrent.Version.McName = "1.7.2" Then
'1.7.2：必须 Java 7
If McVersionCurrent.Version.McVersion >= New Version(1, 6, 1) AndAlso McVersionCurrent.Version.McVersion <= New Version(1, 7, 2) Then
'1.6.1 - 1.7.2：必须 Java 7
MinVer = If(New Version(1, 7, 0, 0) > MinVer, New Version(1, 7, 0, 0), MinVer)
MaxVer = If(New Version(1, 7, 999, 999) < MaxVer, New Version(1, 7, 999, 999), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
ElseIf McVersionCurrent.Version.McCodeMain <= 12 OrElse Not McVersionCurrent.Version.IsStandardVersion Then '非标准版本
'<=1.12：Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain >= 13 Then
ElseIf McVersionCurrent.Version.McCodeMain <= 14 Then
'1.13 - 1.14：Java 8 - 10
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
MaxVer = If(New Version(1, 10, 999, 999) < MaxVer, New Version(1, 10, 999, 999), MaxVer)
@@ -1201,11 +1200,11 @@ Retry:
End If
'Fabric 检测
If McVersionCurrent.Version.HasFabric Then
If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then
If McVersionCurrent.Version.HasFabric AndAlso McVersionCurrent.Version.IsStandardVersion Then '不管非标准版本
If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 Then
'1.15 - 1.16：Java 8+
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 Then
ElseIf McVersionCurrent.Version.McCodeMain >= 18 Then
'1.18+：Java 17+
MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer)
End If
@@ -1232,18 +1231,22 @@ Retry:
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java
McLaunchLog("无合适的 Java，需要确认是否自动下载")
Dim JavaCode As String
If MinVer >= New Version(1, 22, 0, 0) Then '潜在的向后兼容
If MinVer >= New Version(1, 22) Then '潜在的向后兼容
JavaCode = MinVer.Minor
If Not JavaDownloadConfirm("Java " & JavaCode) Then Throw New Exception("$$")
ElseIf MinVer >= New Version(1, 21, 0, 0) Then
ElseIf MinVer >= New Version(1, 21) Then
JavaCode = 21
If Not JavaDownloadConfirm("Java 21") Then Throw New Exception("$$")
ElseIf MinVer >= New Version(1, 9, 0, 0) Then
ElseIf MinVer >= New Version(1, 9) Then
JavaCode = 17
If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 0) Then
ElseIf MaxVer < New Version(1, 8) Then
JavaCode = 7
If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
If McVersionCurrent.Version.HasForge Then
MyMsgBox("你需要先安装 LegacyJavaFixer Mod，或自行安装 Java 7，然后才能启动该版本。", "未找到 Java")
Else
If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
End If
ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.141 ~ 8.0.320", True) Then Throw New Exception("$$")
@@ -1350,12 +1353,14 @@ Retry:
Arguments += " " & McLaunchArgumentsGameNew(McVersionCurrent)
McLaunchLog("新版 Game 参数获取成功")
End If
'编码参数（#5818、#5892）
'编码参数（#4700、#5892、#5909）
If McLaunchJavaSelected.VersionCode > 8 Then
If Not Arguments.Contains("-Dfile.encoding=") Then Arguments += " -Dfile.encoding=UTF-8"
If Not Arguments.Contains("-Dstdout.encoding=") Then Arguments += " -Dstdout.encoding=UTF-8"
If Not Arguments.Contains("-Dstderr.encoding=") Then Arguments += " -Dstderr.encoding=UTF-8"
End If
If McLaunchJavaSelected.VersionCode >= 18 Then
If Not Arguments.Contains("-Dfile.encoding=") Then Arguments += " -Dfile.encoding=COMPAT"
End If
'替换参数
Dim ReplaceArguments = McLaunchArgumentsReplace(McVersionCurrent, Loader)
If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then
@@ -1675,16 +1680,16 @@ NextVersion:
'窗口尺寸参数
Dim GameSize As Size
Select Case Setup.Get("LaunchArgumentWindowType")
Case 2
Case 2 '与启动器尺寸一致
Dim Result As Size
RunInUiWait(Sub() Result = New Size(GetPixelSize(FrmMain.PanForm.ActualWidth), GetPixelSize(FrmMain.PanForm.ActualHeight)))
GameSize = Result
Case 3
GameSize = New Size(Math.Max(100, Setup.Get("LaunchArgumentWindowWidth") - 2), Math.Max(100, Setup.Get("LaunchArgumentWindowHeight") - 2))
GameSize.Height -= 29.5 * DPI / 96 '标题栏高度
Case 3 '自定义
GameSize = New Size(Math.Max(100, Setup.Get("LaunchArgumentWindowWidth")), Math.Max(100, Setup.Get("LaunchArgumentWindowHeight")))
Case Else
GameSize = New Size(875 - 2, 540 - 2)
GameSize = New Size(875, 540)
End Select
GameSize.Height -= 29.5 * DPI / 96 '标题栏高度
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso
McLaunchJavaSelected.VersionCode <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then
@@ -1713,7 +1718,7 @@ NextVersion:
CpStrings.Add(Library.LocalPath)
End If
Next
If OptiFineCp IsNot Nothing Then CpStrings.Insert(CpStrings.Count - 2, OptiFineCp)
If OptiFineCp IsNot Nothing Then CpStrings.Insert(CpStrings.Count - 2, OptiFineCp) 'OptiFine 的总是需要放到倒数第二位
GameArguments.Add("${classpath}", Join(CpStrings.Select(Function(c) ShortenPath(c)), ";"))
Return GameArguments
@@ -2095,7 +2100,7 @@ IgnoreCustomSkin:
'输出 bat
Try
Dim CmdString As String =
$"{If(McLaunchJavaSelected.VersionCode > 8, "chcp 65001>nul" & vbCrLf, "")}" &
$"{If(McLaunchJavaSelected.VersionCode > 8 AndAlso McLaunchJavaSelected.VersionCode < 18, "chcp 65001>nul" & vbCrLf, "")}" &
"@echo off" & vbCrLf &
$"title 启动 - {McVersionCurrent.Name}" & vbCrLf &
"echo 游戏正在启动，请稍候。" & vbCrLf &
@@ -2107,7 +2112,7 @@ IgnoreCustomSkin:
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
Encoding:=If(McLaunchJavaSelected.VersionCode > 8, Encoding.UTF8, Encoding.Default))
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成，强制结束启动过程")
AbortHint = "导出启动脚本成功！"
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+119 -151
View File
@@ -207,46 +207,43 @@ Public Module ModMinecraft
''' </summary>
Public ReadOnly Property PathIndie As String
Get
InitPathIndie(Modable)
If Setup.IsUnset("VersionArgumentIndieV2", Version:=Me) Then
'决定该版本是否应该被隔离
Dim ShouldBeIndie =
Function() As Boolean
'从老的版本独立设置中迁移：-1 未决定，0 使用全局设置，1 手动开启，2 手动关闭
If Not Setup.IsUnset("VersionArgumentIndie", Version:=Me) AndAlso Setup.Get("VersionArgumentIndie", Version:=Me) > 0 Then
Log($"[Minecraft] 版本隔离初始化（{Name}）：从老的版本独立设置中迁移")
Return Setup.Get("VersionArgumentIndie", Version:=Me) = 1
End If
'若版本文件夹下包含 mods 或 saves 文件夹，则自动开启版本隔离
Dim ModFolder As New DirectoryInfo(Path & "mods\")
Dim SaveFolder As New DirectoryInfo(Path & "saves\")
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateDirectories.Any) Then
Log($"[Minecraft] 版本隔离初始化（{Name}）：版本文件夹下存在 mods 或 saves 文件夹，自动开启")
Return True
End If
'根据全局的默认设置决定是否隔离
Log($"[Minecraft] 版本隔离初始化（{Name}）：从全局默认设置中（{Setup.Get("LaunchArgumentIndieV2")}）判断")
Dim IsRelease As Boolean = State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
Select Case Setup.Get("LaunchArgumentIndieV2")
Case 0 '关闭
Return False
Case 1 '仅隔离可安装 Mod 的版本
Return Modable
Case 2 '仅隔离非正式版
Return IsRelease
Case 3 '隔离非正式版与可安装 Mod 的版本
Return Modable OrElse IsRelease
Case Else '隔离所有版本
Return True
End Select
End Function
Setup.Set("VersionArgumentIndieV2", ShouldBeIndie(), Version:=Me)
End If
Return If(Setup.Get("VersionArgumentIndieV2", Version:=Me), Path, PathMcFolder)
End Get
End Property
''' <summary>
''' 决定该版本是否应该被隔离。
''' </summary>
Public Sub InitPathIndie(Modable As Boolean)
If Not Setup.IsUnset("VersionArgumentIndieV2", Version:=Me) Then Return
Dim ShouldBeIndie =
Function() As Boolean
'从老的版本独立设置中迁移：-1 未决定，0 使用全局设置，1 手动开启，2 手动关闭
If Not Setup.IsUnset("VersionArgumentIndie", Version:=Me) AndAlso Setup.Get("VersionArgumentIndie", Version:=Me) > 0 Then
Log($"[Minecraft] 版本隔离初始化（{Name}）：从老的版本独立设置中迁移")
Return Setup.Get("VersionArgumentIndie", Version:=Me) = 1
End If
'若版本文件夹下包含 mods 或 saves 文件夹，则自动开启版本隔离
Dim ModFolder As New DirectoryInfo(Path & "mods\")
Dim SaveFolder As New DirectoryInfo(Path & "saves\")
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
Log($"[Minecraft] 版本隔离初始化（{Name}）：版本文件夹下存在 mods 或 saves 文件夹，自动开启")
Return True
End If
'根据全局的默认设置决定是否隔离
Log($"[Minecraft] 版本隔离初始化（{Name}）：从全局默认设置中（{Setup.Get("LaunchArgumentIndieV2")}）判断")
Select Case Setup.Get("LaunchArgumentIndieV2")
Case 0 '关闭
Return False
Case 1 '仅隔离可安装 Mod 的版本
Return Modable
Case 2 '仅隔离非正式版
Return State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
Case 3 '隔离非正式版与可安装 Mod 的版本
Return Modable OrElse State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
Case Else '隔离所有版本
Return True
End Select
End Function
Setup.Set("VersionArgumentIndieV2", ShouldBeIndie(), Version:=Me)
End Sub
''' <summary>
''' 该版本的版本文件夹名称。
@@ -318,14 +315,6 @@ Public Module ModMinecraft
_Version.McName = "pending"
GoTo VersionSearchFinish
End If
'从 JumpLoader 信息中获取版本号
If HasJumpLoader Then
Try
_Version.McName = JsonObject("jumploader")("jars")("minecraft")(0)("gameVersion")
GoTo VersionSearchFinish
Catch
End Try
End If
'从 PCL 下载的版本信息中获取版本号
If JsonObject("clientVersion") IsNot Nothing Then
_Version.McName = JsonObject("clientVersion")
@@ -382,7 +371,6 @@ Public Module ModMinecraft
_Version.McName = Regex
GoTo VersionSearchFinish
End If
'FUTURE: [Quilt 支持] 从 Quilt 版本中获取版本号
'从 jar 项中获取版本号
If JsonObject("jar") IsNot Nothing Then
_Version.McName = JsonObject("jar").ToString
@@ -432,7 +420,7 @@ VersionSearchFinish:
_Version.McCodeMain = If(SplitResult.Length <= 2, Val(SplitResult), "0")
SplitResult = If(SplitVersion.Count >= 3, SplitVersion(2), "0")
_Version.McCodeSub = If(SplitResult.Length <= 2, Val(SplitResult), "0")
ElseIf _Version.McName.Contains("w") OrElse _Version.McName = "pending" Then
ElseIf (Not IsVersionNameLikeRelease(_Version.McName)) OrElse _Version.McName = "pending" Then
_Version.McCodeMain = 99
_Version.McCodeSub = 99
End If
@@ -562,25 +550,6 @@ Recheck:
Catch ex As Exception
Throw New Exception("初始化版本 JSON 时失败（" & If(Name, "null") & "）", ex)
End Try
Try
'处理 JumpLoader
If Text.Contains("minecraftforge") AndAlso File.Exists(PathIndie & "config\jumploader.json") Then
For Each ModFile In Directory.EnumerateFiles(PathIndie & "mods")
Dim FileName As String = GetFileNameFromPath(ModFile)
If FileName.EndsWithF(".jar", True) AndAlso FileName.ContainsF("jumploader", True) Then
Log("[Minecraft] 发现 JumpLoader 分支项：" & FileName)
HasJumpLoader = True
Exit For
End If
Next
End If
If HasJumpLoader Then
_JsonObject.Remove("jumploader")
_JsonObject.Add("jumploader", GetJson(ReadFile(PathIndie & "config\jumploader.json")))
End If
Catch ex As Exception
Log(ex, "处理 JumpLoader 失败")
End Try
End If
Return _JsonObject
End Get
@@ -601,10 +570,6 @@ Recheck:
''' Json 是否为 HMCL 格式。
''' </summary>
Public Property IsHmclFormatJson As Boolean = False
''' <summary>
''' 是否包含 JumpLoader。
''' </summary>
Public Property HasJumpLoader As Boolean = False
''' <summary>
''' 版本 jar 中的 version.json 文件对象。
@@ -748,7 +713,6 @@ Recheck:
Version.HasLiteLoader = True
End If
'Fabric、Forge
'FUTURE: [Quilt 支持] 确认这里的玩意儿对不对
If RealJson.Contains("net.fabricmc:fabric-loader") OrElse RealJson.Contains("org.quiltmc:quilt-loader") Then
State = McVersionState.Fabric
Version.HasFabric = True
@@ -859,7 +823,6 @@ ExitDataLoad:
Info = "发生了未知错误，请向作者反馈此问题"
End Select
If Not State = McVersionState.Error Then
If HasJumpLoader Then Info += ", JumpLoader"
If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
End If
@@ -919,6 +882,24 @@ ExitDataLoad:
''' 原版次版本号，如 2（For 1.12.2），快照则固定为 99。不可用则为 -1。
''' </summary>
Public McCodeSub As Integer = -1
''' <summary>
''' 是否为非快照版，且读取到了一个有效的原版版本号。
''' </summary>
Public ReadOnly Property IsStandardVersion As Boolean
Get
Return McCodeMain > -1 AndAlso McCodeMain < 99 AndAlso McCodeSub > -1 AndAlso McCodeSub < 99
End Get
End Property
''' <summary>
''' 标准的原版版本号。
''' 若为快照版或没有有效版本号，则返回 0。
''' </summary>
Public ReadOnly Property McVersion As Version
Get
If Not IsStandardVersion Then Return New Version(0, 0, 0)
Return New Version(1, McCodeMain, McCodeSub)
End Get
End Property
'OptiFine
@@ -1728,10 +1709,6 @@ OnLoaded:
''' 原 Json 中的 Name 项。
''' </summary>
Public OriginalName As String
''' <summary>
''' 是否为 JumpLoader 项。
''' </summary>
Public IsJumpLoader As Boolean = False
Public Overrides Function ToString() As String
Return If(IsNatives, "[Native] ", "") & GetString(Size) & " | " & LocalPath
@@ -1794,65 +1771,58 @@ OnLoaded:
'获取当前支持库列表
Log("[Minecraft] 获取支持库列表：" & Version.Name)
McLibListGet = McLibListGetWithJson(Version.JsonObject, JumpLoaderFolder:=Version.PathIndie & ".jumploader\")
McLibListGet = McLibListGetWithJson(Version.JsonObject)
If Not IncludeVersionJar Then Return McLibListGet
'需要添加原版 Jar
If IncludeVersionJar Then
Dim RealVersion As McVersion
Dim RequiredJar As String = Version.JsonObject("jar")?.ToString
If Version.IsHmclFormatJson OrElse RequiredJar Is Nothing Then
'HMCL 项直接使用自身的 Jar
'根据 Inherit 获取最深层版本
Dim OriginalVersion As McVersion = Version
'1.17+ 的 Forge 不寻找 Inherit
If Not ((Version.Version.HasForge OrElse Version.Version.HasNeoForge) AndAlso Version.Version.McCodeMain >= 17) Then
Do Until OriginalVersion.InheritVersion = ""
If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do
OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\")
Loop
End If
'需要新建对象，否则后面的 Check 会导致 McVersionCurrent 的 State 变回 Original
'复现：启动一个 Snapshot 版本
RealVersion = New McVersion(OriginalVersion.Path)
Else
'Json 已提供 Jar 字段，使用该字段的信息
RealVersion = New McVersion(RequiredJar)
Dim RealVersion As McVersion
Dim RequiredJar As String = Version.JsonObject("jar")?.ToString
If Version.IsHmclFormatJson OrElse RequiredJar Is Nothing Then
'HMCL 项直接使用自身的 Jar
'根据 Inherit 获取最深层版本
Dim OriginalVersion As McVersion = Version
'1.17+ 的 Forge 不寻找 Inherit
If Not ((Version.Version.HasForge OrElse Version.Version.HasNeoForge) AndAlso Version.Version.McCodeMain >= 17) Then
Do Until OriginalVersion.InheritVersion = ""
If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do
OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\")
Loop
End If
Dim ClientUrl As String, ClientSHA1 As String
'判断需求的版本是否存在
'不能调用 RealVersion.Check()，可能会莫名其妙地触发 CheckPermission 正被另一进程使用，导致误判前置不存在
If Not File.Exists(RealVersion.Path & RealVersion.Name & ".json") Then
RealVersion = Version
Log("[Minecraft] 可能缺少前置版本 " & RealVersion.Name & "，找不到对应的 json 文件", LogLevel.Debug)
End If
'获取详细下载信息
If RealVersion.JsonObject("downloads") IsNot Nothing AndAlso RealVersion.JsonObject("downloads")("client") IsNot Nothing Then
ClientUrl = RealVersion.JsonObject("downloads")("client")("url")
ClientSHA1 = RealVersion.JsonObject("downloads")("client")("sha1")
Else
ClientUrl = Nothing
ClientSHA1 = Nothing
End If
'把所需的原版 Jar 添加进去
McLibListGet.Add(New McLibToken With {.LocalPath = RealVersion.Path & RealVersion.Name & ".jar", .Size = 0, .IsNatives = False, .Url = ClientUrl, .SHA1 = ClientSHA1})
'需要新建对象，否则后面的 Check 会导致 McVersionCurrent 的 State 变回 Original
'复现：启动一个 Snapshot 版本
RealVersion = New McVersion(OriginalVersion.Path)
Else
'Json 已提供 Jar 字段，使用该字段的信息
RealVersion = New McVersion(RequiredJar)
End If
Dim ClientUrl As String, ClientSHA1 As String
'判断需求的版本是否存在
'不能调用 RealVersion.Check()，可能会莫名其妙地触发 CheckPermission 正被另一进程使用，导致误判前置不存在
If Not File.Exists(RealVersion.Path & RealVersion.Name & ".json") Then
RealVersion = Version
Log("[Minecraft] 可能缺少前置版本 " & RealVersion.Name & "，找不到对应的 json 文件", LogLevel.Debug)
End If
'获取详细下载信息
If RealVersion.JsonObject("downloads") IsNot Nothing AndAlso RealVersion.JsonObject("downloads")("client") IsNot Nothing Then
ClientUrl = RealVersion.JsonObject("downloads")("client")("url")
ClientSHA1 = RealVersion.JsonObject("downloads")("client")("sha1")
Else
ClientUrl = Nothing
ClientSHA1 = Nothing
End If
'把所需的原版 Jar 添加进去
McLibListGet.Add(New McLibToken With {.LocalPath = RealVersion.Path & RealVersion.Name & ".jar", .Size = 0, .IsNatives = False, .Url = ClientUrl, .SHA1 = ClientSHA1})
End Function
''' <summary>
''' 获取 Minecraft 某一版本忽视继承的支持库列表，即结果中没有继承项。
''' </summary>
Public Function McLibListGetWithJson(JsonObject As JObject, Optional KeepSameNameDifferentVersionResult As Boolean = False, Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing) As List(Of McLibToken)
Public Function McLibListGetWithJson(JsonObject As JObject, Optional KeepSameNameDifferentVersionResult As Boolean = False, Optional CustomMcFolder As String = Nothing) As List(Of McLibToken)
CustomMcFolder = If(CustomMcFolder, PathMcFolder)
Dim BasicArray As New List(Of McLibToken)
'添加基础 Json 项
Dim AllLibs As JArray = JsonObject("libraries")
'添加 JumpLoader Json 项
If JsonObject("jumploader") IsNot Nothing AndAlso JsonObject("jumploader")("jars") IsNot Nothing AndAlso JsonObject("jumploader")("jars")("maven") IsNot Nothing Then
For Each JumpLoaderToken In JsonObject("jumploader")("jars")("maven")
AllLibs.Add(JumpLoaderToken)
Next
End If
'转换为 LibToken
For Each Library As JObject In AllLibs.Children
@@ -1865,14 +1835,6 @@ OnLoaded:
'检查是否需要（Rules）
If Not McJsonRuleCheck(Library("rules")) Then Continue For
'检查 JumpLoader
Dim IsJumpLoader As Boolean = False
If Library("mavenPath") IsNot Nothing Then
IsJumpLoader = True
If Library("name") Is Nothing Then Library.Add("name", Library("mavenPath")) '这里的修改会导致原 Json 内容改变
If Library("repoUrl") IsNot Nothing AndAlso Library("url") Is Nothing Then Library.Add("url", Library("repoUrl"))
End If
'获取根节点下的 url
Dim RootUrl As String = Library("url")
If RootUrl IsNot Nothing Then
@@ -1882,15 +1844,10 @@ OnLoaded:
'根据是否本地化处理（Natives）
If Library("natives") Is Nothing Then '没有 Natives
Dim LocalPath As String
If IsJumpLoader Then
LocalPath = McLibGet(Library("name"), CustomMcFolder:=If(JumpLoaderFolder, CustomMcFolder))
Else
LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder)
End If
LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder)
Try
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("artifact") IsNot Nothing Then
BasicArray.Add(New McLibToken With {
.IsJumpLoader = IsJumpLoader,
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("artifact")("url")),
.LocalPath = If(Library("downloads")("artifact")("path") Is Nothing, McLibGet(Library("name"),
@@ -1899,17 +1856,16 @@ OnLoaded:
.IsNatives = False,
.SHA1 = Library("downloads")("artifact")("sha1")?.ToString})
Else
BasicArray.Add(New McLibToken With {.IsJumpLoader = IsJumpLoader, .OriginalName = Library("name"), .Url = RootUrl, .LocalPath = LocalPath, .Size = 0, .IsNatives = False, .SHA1 = Nothing})
BasicArray.Add(New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .LocalPath = LocalPath, .Size = 0, .IsNatives = False, .SHA1 = Nothing})
End If
Catch ex As Exception
Log(ex, "处理实际支持库列表失败（无 Natives，" & If(Library("name"), "Nothing").ToString & "）")
BasicArray.Add(New McLibToken With {.IsJumpLoader = IsJumpLoader, .OriginalName = Library("name"), .Url = RootUrl, .LocalPath = LocalPath, .Size = 0, .IsNatives = False, .SHA1 = Nothing})
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
Try
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("classifiers") IsNot Nothing AndAlso Library("downloads")("classifiers")("natives-windows") IsNot Nothing Then
BasicArray.Add(New McLibToken With {
.IsJumpLoader = IsJumpLoader,
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("classifiers")("natives-windows")("url")),
.LocalPath = If(Library("downloads")("classifiers")("natives-windows")("path") Is Nothing,
@@ -1919,11 +1875,11 @@ OnLoaded:
.IsNatives = True,
.SHA1 = Library("downloads")("classifiers")("natives-windows")("sha1").ToString})
Else
BasicArray.Add(New McLibToken With {.IsJumpLoader = IsJumpLoader, .OriginalName = Library("name"), .Url = RootUrl, .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")), .Size = 0, .IsNatives = True, .SHA1 = Nothing})
BasicArray.Add(New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")), .Size = 0, .IsNatives = True, .SHA1 = Nothing})
End If
Catch ex As Exception
Log(ex, "处理实际支持库列表失败（有 Natives，" & If(Library("name"), "Nothing").ToString & "）")
BasicArray.Add(New McLibToken With {.IsJumpLoader = IsJumpLoader, .OriginalName = Library("name"), .Url = RootUrl, .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")), .Size = 0, .IsNatives = True, .SHA1 = Nothing})
BasicArray.Add(New McLibToken With {.OriginalName = Library("name"), .Url = RootUrl, .LocalPath = McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")), .Size = 0, .IsNatives = True, .SHA1 = Nothing})
End Try
End If
@@ -1940,7 +1896,7 @@ OnLoaded:
Return GetFolderNameFromPath(GetPathFromFullPath(Token.LocalPath))
End Function
For i = 0 To BasicArray.Count - 1
Dim Key As String = BasicArray(i).Name & BasicArray(i).IsNatives.ToString & BasicArray(i).IsJumpLoader.ToString
Dim Key As String = BasicArray(i).Name & BasicArray(i).IsNatives.ToString
If ResultArray.ContainsKey(Key) Then
Dim BasicArrayVersion As String = GetVersion(BasicArray(i))
Dim ResultArrayVersion As String = GetVersion(ResultArray(Key))
@@ -1964,7 +1920,7 @@ OnLoaded:
''' 获取版本缺失的支持库文件所对应的 NetTaskFile。
''' </summary>
Public Function McLibFix(Version As McVersion) As List(Of NetFile)
If Not Version.IsLoaded Then Version.Load() '确保例如 JumpLoader 等项被合并入 Json
If Not Version.IsLoaded Then Version.Load()
Dim Result As New List(Of NetFile)
'更新此方法时需要同步更新 Forge 新版自动安装方法！
@@ -1978,7 +1934,7 @@ OnLoaded:
End Try
'Library 文件
Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\"))
Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False)))
'统一通行证文件
If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then
@@ -2053,7 +2009,7 @@ OnLoaded:
''' <summary>
''' 将 McLibToken 列表转换为 NetFile。无需下载的文件会被自动过滤。
''' </summary>
Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing) As List(Of NetFile)
Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing) As List(Of NetFile)
CustomMcFolder = If(CustomMcFolder, PathMcFolder)
Dim Result As New List(Of NetFile)
'获取
@@ -2065,18 +2021,23 @@ OnLoaded:
Dim Urls As New List(Of String)
If Token.Url Is Nothing AndAlso Token.Name = "net.minecraftforge:forge:universal" Then
'特判修复 Forge 部分 universal 文件缺失 URL（#5455）
Token.Url = "https://maven.minecraftforge.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")
Token.Url = "https://maven.minecraftforge.net" & Token.LocalPath.Replace(CustomMcFolder & "libraries", "").Replace("\", "/")
End If
If Token.Url IsNot Nothing Then
'获取 URL 的真实地址
Urls.Add(Token.Url)
If Token.Url.Contains("launcher.mojang.com/v1/objects") OrElse Token.Url.Contains("client.txt") OrElse
Token.Url.Contains(".tsrg") Then
Urls.AddRange(DlSourceLauncherOrMetaGet(Token.Url).ToList()) 'Mappings（#4425）
Urls.AddRange(DlSourceLauncherOrMetaGet(Token.Url)) 'Mappings（#4425）
End If
If Token.Url.Contains("maven") Then
Urls.Insert(0, 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"))
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")
If DlSourcePreferMojang Then
Urls.Add(BmclapiUrl) '官方源优先
Else
Urls.Insert(0, BmclapiUrl) '镜像源优先
End If
End If
End If
If Token.LocalPath.Contains("transformer-discovery-service") Then
@@ -2086,13 +2047,13 @@ OnLoaded:
Continue For
ElseIf Token.LocalPath.Contains("optifine\OptiFine") Then
'OptiFine 主 Jar
Dim OptiFineBase As String = Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries\optifine\OptiFine\", "").Split("_")(0) & "/" & GetFileNameFromPath(Token.LocalPath).Replace("-", "_")
Dim OptiFineBase As String = Token.LocalPath.Replace(CustomMcFolder & "libraries\optifine\OptiFine\", "").Split("_")(0) & "/" & GetFileNameFromPath(Token.LocalPath).Replace("-", "_")
OptiFineBase = "/maven/com/optifine/" & OptiFineBase
If OptiFineBase.Contains("_pre") Then OptiFineBase = OptiFineBase.Replace("com/optifine/", "com/optifine/preview_")
Urls.Add("https://bmclapi2.bangbang93.com" & OptiFineBase)
ElseIf Urls.Count <= 2 Then
'普通文件
Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")))
Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(CustomMcFolder & "libraries", "").Replace("\", "/")))
End If
Result.Add(New NetFile(Urls.Distinct, Token.LocalPath, Checker))
Next
@@ -2275,7 +2236,7 @@ OnLoaded:
If File.Exists AndAlso (Token.Size = 0 OrElse Token.Size = File.Length) AndAlso
(Not CheckHash OrElse Token.Hash Is Nothing OrElse Token.Hash = GetFileSHA1(Token.LocalPath)) Then Continue For
'文件不存在，添加下载
Result.Add(New NetFile(DlSourceResourceGet("https://resources.download.minecraft.net/" & Left(Token.Hash, 2) & "/" & Token.Hash), Token.LocalPath, New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.Hash)))
Result.Add(New NetFile(DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"), Token.LocalPath, New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.Hash)))
Next
Catch ex As Exception
Log(ex, "获取版本缺失的资源文件下载列表失败")
@@ -2399,6 +2360,13 @@ NextEntry:
End Function
End Class
''' <summary>
''' 判断版本名是否类似正式版。
''' </summary>
Public Function IsVersionNameLikeRelease(VerName As String) As Boolean
Return VerName.StartsWithF("1.") AndAlso Not (VerName.Contains("w") OrElse VerName.Contains("pre") OrElse VerName.Contains("rc") OrElse VerName.Contains("-"))
End Function
''' <summary>
''' 为邮箱地址或手机号账号进行部分打码。
''' </summary>
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
+6 -2
View File
@@ -837,7 +837,7 @@ Finished:
'仅当 Forge 1.13- 且文件夹名与版本号相同时，才加载该子文件夹下的 Mod
If Not (PageVersionLeft.Version IsNot Nothing AndAlso PageVersionLeft.Version.Version.HasForge AndAlso
PageVersionLeft.Version.Version.McCodeMain < 13 AndAlso
File.Directory.Name = "1." & PageVersionLeft.Version.Version.McCodeMain & "." & PageVersionLeft.Version.Version.McCodeSub) Then
File.Directory.Name = $"1.{PageVersionLeft.Version.Version.McCodeMain}.{PageVersionLeft.Version.Version.McCodeSub}") Then
Continue For
End If
End If
@@ -1127,7 +1127,11 @@ Finished:
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
RunInUi(Sub() FrmVersionMod?.RefreshBars())
If FrmVersionMod?.Filter = PageVersionMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmVersionMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else
RunInUi(Sub() FrmVersionMod?.RefreshBars())
End If
End Sub
Public Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+94 -148
View File
@@ -109,7 +109,7 @@ Public Module ModModpack
End Try
End Function
Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, LoaderProgressDelta As Double)
Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, ProgressIncrement As Double)
'解压文件
Dim RetryCount As Integer = 1
Dim Encode = Encoding.GetEncoding("GB18030")
@@ -117,15 +117,15 @@ Public Module ModModpack
Try
Retry:
Loader.Progress = InitialProgress
'完全不知道为啥会出现文件正在被另一进程使用的问题，总之多试试
DeleteDirectory(InstallTemp)
ExtractFile(FileAddress, InstallTemp, Encode, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * LoaderProgressDelta)
ExtractFile(FileAddress, InstallTemp, Encode, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * ProgressIncrement)
Catch ex As Exception
Log(ex, "第 " & RetryCount & " 次解压尝试失败")
If TypeOf ex Is ArgumentException Then
Encode = Encoding.UTF8
Log("[ModPack] 已切换压缩包解压编码为 UTF8")
End If
'完全不知道为啥会出现文件正在被另一进程使用的问题，总之加个重试
If RetryCount < 5 Then
Thread.Sleep(RetryCount * 2000)
If Loader IsNot Nothing AndAlso Loader.LoadingState <> MyLoading.MyLoadingState.Run Then Exit Sub
@@ -135,6 +135,35 @@ Retry:
Throw New Exception("解压整合包文件失败", ex)
End If
End Try
Loader.Progress = InitialProgress + ProgressIncrement
End Sub
''' <summary>
''' 从整合包的 override 目录复制文件，同时设置 PCL 的配置文件与版本隔离。
''' 对路径末尾是否为 \ 没有要求。
''' </summary>
Private Sub CopyOverrideDirectory(OverridesFolder As String, VersionFolder As String, Loader As LoaderBase, ProgressIncrement As Double)
If Not OverridesFolder.EndsWithF("\") Then OverridesFolder += "\"
If Not VersionFolder.EndsWithF("\") Then VersionFolder += "\"
'复制文件
If Directory.Exists(OverridesFolder) Then
Log($"[ModPack] 处理整合包覆写文件夹：{OverridesFolder} → {VersionFolder}")
CopyDirectory(OverridesFolder, VersionFolder, Sub(Delta) Loader.Progress += Delta * ProgressIncrement)
Else
Log($"[ModPack] 整合包中没有覆写文件夹：{OverridesFolder}")
Loader.Progress += ProgressIncrement
End If
'设置 ini
Dim OverridesIni As String = $"{OverridesFolder}PCL\Setup.ini"
Dim VersionIni As String = $"{VersionFolder}PCL\Setup.ini"
If File.Exists(OverridesIni) Then
WriteIni(OverridesIni, "VersionArgumentIndie", 1) '开启版本隔离
WriteIni(OverridesIni, "VersionArgumentIndieV2", True)
CopyFile(OverridesIni, VersionIni) '覆写已有的 ini
Else
WriteIni(VersionIni, "VersionArgumentIndie", 1) '开启版本隔离
WriteIni(VersionIni, "VersionArgumentIndieV2", True)
End If
IniClearCache(VersionIni) '重置缓存，避免被安装过程中写入的 ini 覆盖
End Sub
#Region "不同类型整合包的安装方法"
@@ -184,7 +213,7 @@ Retry:
Log("[ModPack] 未知 Mod 加载器：" & Id)
End If
Next
'解压与配置文件
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
Dim OverrideHome As String = If(Json("overrides"), "")
@@ -192,21 +221,10 @@ Retry:
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
Task.Progress = 0.6
'复制结果
Log("[ModPack] 整合包 override 目标：" & OverrideHome)
Dim OverrideRoot = InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome) '#5613
If Directory.Exists(OverrideRoot) Then
Dim CopyTarget = $"{PathMcFolder}versions\{VersionName}"
CopyDirectory(OverrideRoot, CopyTarget, Sub(Delta) Task.Progress += Delta * 0.35)
Log($"[ModPack] 整合包 override 复制：{OverrideRoot} -> {CopyTarget}")
Else
Log($"[ModPack] 整合包中未找到 override 文件夹：{OverrideRoot}")
End If
Task.Progress = 0.95
'开启版本隔离
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
$"{PathMcFolder}versions\{VersionName}",
Task, 0.4)
End Sub) With {
.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
End If
@@ -245,24 +263,24 @@ Retry:
Continue For
End If
End If
'建立 CompFile
Dim File As New CompFile(ModJson, CompType.Mod)
If Not File.Available Then Continue For
'根据 modules 和文件名后缀判断资源类型
Dim TargetFolder As String
Dim TargetFolder As String, Type As CompType
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
File.FileName.EndsWithF(".jar", True) Then
TargetFolder = "mods"
ModJson?("FileName")?.ToString?.EndsWithF(".jar", True) Then
TargetFolder = "mods" : Type = CompType.Mod
ElseIf ModuleNames.Contains("pack.mcmeta") Then
TargetFolder = "resourcepacks"
TargetFolder = "resourcepacks" : Type = CompType.ResourcePack
Else
TargetFolder = "shaderpacks"
TargetFolder = "shaderpacks" : Type = CompType.Shader
End If
Else
TargetFolder = "mods"
TargetFolder = "mods" : Type = CompType.Mod
End If
'建立 CompFile
Dim File As New CompFile(ModJson, Type)
If Not File.Available Then Continue For
'实际的添加
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{TargetFolder}\"))
Task.Progress += 1 / (1 + ModList.Count)
@@ -285,16 +303,11 @@ Retry:
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
@@ -379,29 +392,20 @@ Retry:
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
End If
'解压和配置文件
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
Task.Progress = 0.6
'复制 overrides 文件夹和 client-overrides 文件夹
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
Sub(Delta) Task.Progress += Delta * 0.25)
Else
Log("[ModPack] 整合包中未找到 override 目录，已跳过")
End If
Task.Progress = 0.85
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName,
Sub(Delta) Task.Progress += Delta * 0.1)
End If
Task.Progress = 0.95
'开启版本隔离
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
PathMcFolder & "versions\" & VersionName,
Task, 0.4)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "client-overrides",
PathMcFolder & "versions\" & VersionName,
Task, 0.1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表
Dim FileList As New List(Of NetFile)
@@ -422,7 +426,12 @@ Retry:
Dim Urls = File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToList
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = Urls.Distinct.ToList()
FileList.Add(New NetFile(Urls, PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
Dim TargetPath As String = $"{PathMcFolder}versions\{VersionName}\{File("path")}"
If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{PathMcFolder}versions\{VersionName}\", True) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！" & vbCrLf & "错误的文件：" & TargetPath, "文件路径校验失败", IsWarn:=True)
Throw New CancelledException
End If
FileList.Add(New NetFile(Urls, TargetPath,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
Next
If FileList.Any Then
@@ -438,20 +447,15 @@ Retry:
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -502,67 +506,38 @@ Retry:
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
'解压与配置文件
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
Task.Progress = 0.6
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
Else
Log("[ModPack] 整合包中未找到 minecraft override 目录，已跳过")
End If
Task.Progress = 0.95
'开启版本隔离
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "minecraft",
PathMcFolder & "versions\" & VersionName,
Task, 0.4)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造加载器
'构造游戏本体安装加载器
If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Json("gameVersion").ToString
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json（副加载器）",
Sub()
Dim RealFileName As String = PathMcFolder & "versions\" & VersionName & "\" & VersionName & ".json"
Dim OldFileName As String = PathMcFolder & "versions\" & VersionName & "\pack.json"
If File.Exists(OldFileName) Then
'修改 id
Dim FileJson = GetJson(ReadFile(OldFileName))
FileJson("id") = VersionName
'替换文件
File.Delete(OldFileName)
WriteFile(RealFileName, FileJson.ToString)
Log("[ModPack] 已重命名版本 Json：" & RealFileName)
End If
End Sub) With {.ProgressWeight = 0.1, .Show = False})
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
'构造总加载器
Dim Loaders As New List(Of LoaderBase) From {
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)},
New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)},
New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}
New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)},
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}
}
'重复任务检查
Dim LoaderName As String = "HMCL 整合包安装：" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Critical)
Throw New CancelledException
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
'If Archive IsNot Nothing Then Archive.Dispose() '解除占用，以免在加载器中触发 “正由另一进程使用，因此该进程无法访问此文件”
Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -586,24 +561,17 @@ Retry:
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
'解压、配置设置文件
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
Task.Progress = 0.6
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
Else
Log("[ModPack] 整合包中未找到 override .minecraft 目录，已跳过")
End If
Task.Progress = 0.95
'开启版本隔离
WriteIni(SetupFile, "VersionArgumentIndie", 1)
WriteIni(SetupFile, "VersionArgumentIndieV2", True)
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & ".minecraft",
PathMcFolder & "versions\" & VersionName,
Task, 0.4)
'读取 MMC 设置文件（#2655）
Try
Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
@@ -682,16 +650,11 @@ Retry:
End Select
Next
'构造加载器
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
'重复任务检查
Dim LoaderName As String = "MMC 整合包安装：" & VersionName & " "
@@ -728,24 +691,16 @@ Retry:
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
End If
'解压与配置文件
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
Task.Progress = 0.6
'复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
Sub(Delta) Task.Progress += 0.35 * Delta)
Else
Log("[ModPack] 整合包中未找到 overrides 目录，已跳过")
End If
Task.Progress = 0.95
'开启版本隔离
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
PathMcFolder & "versions\" & VersionName,
Task, 0.4)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造加载器
If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息，无法安装！")
@@ -767,16 +722,11 @@ Retry:
.NeoForgeVersion = If(Addons.ContainsKey("neoforge"), Addons("neoforge"), Nothing),
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
'重复任务检查
Dim LoaderName As String = "MCBBS 整合包安装：" & VersionName & " "
@@ -830,13 +780,9 @@ Retry:
Log("[Modpack] 找到压缩包中附带的启动器：" & Launcher)
If MyMsgBox($"整合包里似乎自带了启动器，是否换用它继续安装？{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "换用", "不换用") = 1 Then
OpenExplorer(TargetFolder)
Try
ShellOnly(Launcher, "--wait") '要求等待已有的 PCL 退出
Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序")
FrmMain.EndProgram(False)
Catch ex As Exception
Log(ex, "打开文件失败", LogLevel.Msgbox)
End Try
ShellOnly(Launcher, "--wait") '要求等待已有的 PCL 退出
Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序")
FrmMain.EndProgram(False)
Return
End If
Else
Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml
-84
View File
@@ -1,84 +0,0 @@
<Grid x:Class="MyCompItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
x:Name="PanBack" Height="64"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="7" />
<ColumnDefinition Width="50" />
<ColumnDefinition Width="8" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
<RowDefinition Height="17" />
<RowDefinition Height="18" />
<RowDefinition Height="16" />
<RowDefinition Height="1.1*" />
</Grid.RowDefinitions>
<!-- Logo -->
<Border Grid.Column="1" Grid.Row="1" Grid.RowSpan="3" IsHitTestVisible="False" SnapsToDevicePixels="True" UseLayoutRounding="True"
HorizontalAlignment="Right" VerticalAlignment="Center" Width="50" Height="50">
<Border.Clip>
<RectangleGeometry Rect="0,0,50,50" RadiusX="6" RadiusY="6" />
</Border.Clip>
<local:MyImage x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" FallbackSource="pack://application:,,,/images/Icons/NoIcon.png" />
</Border>
<!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Foreground="{DynamicResource ColorBrush1}" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
</StackPanel>
<!-- Tag 与 详情 -->
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed">
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
<TextBlock Text="科技" Foreground="{DynamicResource ColorBrush2}" FontSize="11" />
</Border>-->
</StackPanel>
<TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="0,0,3,0.5"
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray3}"
IsHitTestVisible="True" SnapsToDevicePixels="False" UseLayoutRounding="False"
ToolTipService.InitialShowDelay="100" ToolTipService.BetweenShowDelay="100"
ToolTipService.Placement="Relative" ToolTipService.PlacementRectangle="-16,-10,500,10000">
<TextBlock.ToolTip>
<ToolTip x:Name="ToolTipInfo" Style="{StaticResource ExtendTextToolTip}" />
</TextBlock.ToolTip>
</TextBlock>
<!-- 下边栏 -->
<Grid Grid.Row="3" Grid.Column="3" Grid.ColumnSpan="2" VerticalAlignment="Bottom"
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="ColumnVersion3" Width="0.7*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="55" />
<ColumnDefinition Width="1*" />
<ColumnDefinition x:Name="ColumnTime1" Width="Auto" />
<ColumnDefinition x:Name="ColumnTime2" Width="Auto" MinWidth="57" SharedSizeGroup="CompItemTime" />
<ColumnDefinition x:Name="ColumnTime3" Width="1*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" SharedSizeGroup="CompItemSource" />
<ColumnDefinition Width="1.7*" />
</Grid.ColumnDefinitions>
<Path x:Name="PathVersion" Grid.Column="0" Fill="{StaticResource ColorBrushGray3}" Stretch="Uniform" Height="11"
Data="M940.4 463.7L773.3 174.2c-17.3-30-49.2-48.4-83.8-48.4H340.2c-34.6 0-66.5 18.5-83.8 48.4L89.2 463.7c-17.3 30-17.3 66.9 0 96.8L256.4 850c17.3 30 49.2 48.4 83.8 48.4h349.2c34.6 0 66.5-18.5 83.8-48.4l167.2-289.5c17.3-29.9 17.3-66.8 0-96.8z m-94.6 96.8L725.9 768.1c-17.3 30-49.2 48.4-83.8 48.4H387.5c-34.6 0-66.5-18.5-83.8-48.4L183.9 560.5c-17.3-30-17.3-66.9 0-96.8l119.8-207.5c17.3-30 49.2-48.4 83.8-48.4h254.6c34.6 0 66.5 18.5 83.8 48.4l119.8 207.5c17.3 30 17.3 66.9 0.1 96.8z M522.3 321.2c-2.5-0.1-5-0.2-7.5-0.2-119.9 0-214 110.3-186.3 235 15.8 70.9 71.5 126.6 142.4 142.4 17.5 3.9 34.7 5.4 51.4 4.7 102.1-3.9 183.6-87.9 183.6-191 0.1-103-81.5-187-183.6-190.9z m68.6 269.1c-18.5 18-43 28.9-68.6 30.7l-6 0.3c-30.2 0.4-58.6-11.4-79.7-33-19.5-20.1-30.7-47-30.9-75-0.3-29.6 11.1-57.4 32-78.3 20.6-20.6 48-32 77.2-32 2.5 0 5 0.1 7.5 0.3 26.7 1.8 51.5 13.2 70.5 32.5 19.6 20 30.8 46.9 31.2 74.9 0.2 30.2-11.5 58.6-33.2 79.6z" />
<TextBlock x:Name="LabVersion" Grid.Column="1" Margin="4,0,2,0" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray3}" FontSize="12"
TextTrimming="WordEllipsis" />
<Path x:Name="PathDownload" Grid.Column="3" Fill="{StaticResource ColorBrushGray4}" Stretch="Uniform" Height="10.5"
Data="M955 610h-59c-15 0-29 13-29 29v196c0 15-13 29-29 29h-649c-15 0-29-13-29-29v-196c0-15-13-29-29-29h-59c-15 0-29 13-29 29V905c0 43 35 78 78 78h787c43 0 78-35 78-78V640c0-15-13-29-29-29zM492 740c11 11 29 11 41 0l265-265c11-11 11-29 0-41l-41-41c-11-11-29-11-41 0l-110 110c-11 11-33 3-33-13V68C571 53 555 39 541 39h-59c-15 0-29 13-29 29v417c0 17-21 25-33 13l-110-110c-11-11-29-11-41 0L226 433c-11 11-11 29 0 41L492 740z" />
<TextBlock x:Name="LabDownload" Grid.Column="4" Margin="5,0,2,0" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray4}" FontSize="12" />
<Path x:Name="PathTime" Grid.Column="6" Fill="{StaticResource ColorBrushGray4}" Stretch="Uniform" Height="11.5" Margin="0,0,1,0"
Data="M810 403l-39 39c-10 10-28 10-39 0l-162-162v412c0 15-12 28-28 28h-56c-15 0-28-12-28-28v-412l-162 162c-10 10-28 10-39 0l-39-39c-10-10-10-28 0-39l278-278c10-10 28-10 39 0l278 278c10 10 10 28-0 39zM568 946h-112v-112h112v112z" />
<TextBlock x:Name="LabTime" Grid.Column="7" Margin="5,0,2,0" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray4}" FontSize="12" />
<Path x:Name="PathSource" Grid.Column="9" Fill="{StaticResource ColorBrushGray4}" Stretch="Uniform" Height="11.5"
Data="M511 143c-203 0-369 165-369 369 0 203 165 369 369 369s369-165 369-369c0-203-165-369-369-369z m0 673c-29 0-68-59-89-159l178 0c-20 100-59 159-89 159z m-98-224c-2-24-3-51-3-79 0-29 1-57 4-83l197 0c2 25 4 53 4 83 0 28-1 54-3 79l-198-0z m98-383c29 0 67 58 88 156l-177-0c20-98 59-155 88-155z m164 221l128 0c7 26 11 54 11 82 0 27-3 54-10 80l-129-0c2-26 3-52 3-79 0-28-1-56-4-83z m101-64l-110-0c-7-37-16-72-28-102-4-11-9-22-15-33 66 25 121 74 155 135z m-376-135c-5 10-10 21-15 33-12 30-21 64-28 102l-110-0c34-60 89-109 154-134z m-181 199l128 0c-2 27-3 54-3 83 0 27 1 53 3 79l-127-0v6c-8-27-12-55-12-85-0-29 3-57 11-83z m24 227l112 0c7 38 16 74 29 105 4 11 9 22 15 33-67-26-122-76-156-139zM621 795c5-10 10-21 15-33 12-30 22-66 29-105l111 0c-34 62-89 111-156 137z" />
<TextBlock x:Name="LabSource" Grid.Column="10" Margin="5,0,2,0" VerticalAlignment="Center" Foreground="{StaticResource ColorBrushGray4}" FontSize="12" />
</Grid>
</Grid>
Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb
-227
View File
@@ -1,227 +0,0 @@
Public Class MyCompItem
#Region "基础属性"
Public Uuid As Integer = GetUuid()
'Logo
Public Property Logo As String
Get
Return PathLogo.Source
End Get
Set(value As String)
PathLogo.Source = value
End Set
End Property
'标题
Public Property Title As String
Get
Return LabTitle.Text
End Get
Set(value As String)
If LabTitle.Text = value Then Exit Property
LabTitle.Text = value
End Set
End Property
'副标题
Public Property SubTitle As String
Get
Return If(LabTitleRaw?.Text, "")
End Get
Set(value As String)
If LabTitleRaw.Text = value Then Exit Property
LabTitleRaw.Text = value
LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
End Set
End Property
'描述
Public Property Description As String
Get
Return LabInfo.Text
End Get
Set(value As String)
If LabInfo.Text = value Then Exit Property
LabInfo.Text = value
End Set
End Property
'指向时扩展描述
Private Sub LabInfo_MouseEnter(sender As Object, e As MouseEventArgs) Handles LabInfo.MouseEnter
If IsTextTrimmed(LabInfo) Then
ToolTipInfo.Content = LabInfo.Text
ToolTipInfo.Width = LabInfo.ActualWidth + 25
LabInfo.ToolTip = ToolTipInfo
Else
LabInfo.ToolTip = Nothing
End If
End Sub
Private Function IsTextTrimmed(textBlock As TextBlock) As Boolean
Dim typeface As New Typeface(textBlock.FontFamily, textBlock.FontStyle, textBlock.FontWeight, textBlock.FontStretch)
Dim formattedText As New FormattedText(textBlock.Text, Thread.CurrentThread.CurrentCulture, textBlock.FlowDirection, typeface, textBlock.FontSize, textBlock.Foreground, DPI)
Return formattedText.Width > textBlock.ActualWidth
End Function
'Tag
Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String))
PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value
Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
</Border>")
PanTags.Children.Add(NewTag)
Next
End Set
End Property
#End Region
#Region "点击"
'触发点击事件
Public Event Click(sender As Object, e As MouseButtonEventArgs)
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub
Log("[Control] 按下资源工程列表项：" & LabTitle.Text)
End If
End Sub
Private Sub ProjectClick(sender As MyCompItem, 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 Card.Title <> "" AndAlso Not Card.IsSwaped Then Titles.Add(Card.Title)
Next
Log("[Comp] 记录当前已展开的卡片：" & String.Join("、", Titles))
FrmMain.PageCurrent.Additional(1) = Titles
End If
'打开详情页
Dim TargetVersion As String
Dim TargetLoader As CompModLoaderType
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
Else
Select Case CType(sender.Tag, CompProject).Type
Case CompType.Mod
TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "")
TargetLoader = PageDownloadMod.Loader.Input.ModLoader
Case CompType.ModPack
TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "")
Case CompType.DataPack
TargetVersion = If(PageDownloadDataPack.Loader.Input.GameVersion, "")
Case CompType.Shader
TargetVersion = If(PageDownloadShader.Loader.Input.GameVersion, "")
Case Else 'CompType.ResourcePack
TargetVersion = If(PageDownloadResourcePack.Loader.Input.GameVersion, "")
End Select
End If
If CType(sender.Tag, CompProject).Type <> CompType.Mod Then TargetLoader = CompModLoaderType.Any
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader}})
End Sub
'鼠标点击判定
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
If IsMouseOver AndAlso CanInteraction Then IsMouseDown = True
End Sub
Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp
IsMouseDown = False
End Sub
#End Region
#Region "后加载指向背景"
Private _RectBack As Border = Nothing
Public ReadOnly Property RectBack As Border
Get
If _RectBack Is Nothing Then
Dim Rect As New Border With {
.Name = "RectBack",
.CornerRadius = New CornerRadius(3),
.RenderTransform = New ScaleTransform(0.8, 0.8),
.RenderTransformOrigin = New Point(0.5, 0.5),
.BorderThickness = New Thickness(GetWPFSize(1)),
.SnapsToDevicePixels = True,
.IsHitTestVisible = False,
.Opacity = 0
}
Rect.SetResourceReference(Border.BackgroundProperty, "ColorBrush7")
Rect.SetResourceReference(Border.BorderBrushProperty, "ColorBrush6")
SetColumnSpan(Rect, 999)
SetRowSpan(Rect, 999)
Children.Insert(0, Rect)
_RectBack = Rect
'<!--<Border x:Name = "RectBack" CornerRadius="3" RenderTransformOrigin="0.5,0.5" SnapsToDevicePixels="True"
'IsHitTestVisible = "False" Opacity="0" BorderThickness="1"
'Grid.ColumnSpan = "4" Background="{DynamicResource ColorBrush7}" BorderBrush="{DynamicResource ColorBrush6}"/>-->
End If
Return _RectBack
End Get
End Property
#End Region
Private StateLast As String
''' <summary>
''' 是否允许交互。目前仅用于 PageDownloadCompDetail 的顶部栏展示：若关闭碰撞检测，则无法展开 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
If Not CanInteraction Then Exit Sub
'判断当前颜色
Dim StateNew As String, Time As Integer
If IsMouseOver Then
If IsMouseDown Then
StateNew = "MouseDown"
Time = 120
Else
StateNew = "MouseOver"
Time = 120
End If
Else
StateNew = "Idle"
Time = 180
End If
If StateLast = StateNew Then Exit Sub
StateLast = StateNew
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画
Dim Ani As New List(Of AniData)
If IsMouseOver Then
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
If IsMouseDown Then
Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
Else
Ani.Add(AaScaleTransform(RectBack, 1 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
End If
Else
Ani.AddRange({
AaOpacity(RectBack, -RectBack.Opacity, Time),
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
End If
AniStart(Ani, "CompItem Color " & Uuid)
Else
'无动画
AniStop("CompItem Color " & Uuid)
If _RectBack IsNot Nothing Then RectBack.Opacity = 0
End If
End Sub
End Class
Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml
-57
View File
@@ -1,57 +0,0 @@
<Grid x:Class="MyLocalModItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL;assembly="
x:Name="PanBack" Height="44"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="6" />
<ColumnDefinition Width="34" />
<ColumnDefinition Width="7" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="4" x:Name="ColumnPaddingRight" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="1*" />
<RowDefinition Height="17" />
<RowDefinition Height="18" />
<RowDefinition Height="1*" />
</Grid.RowDefinitions>
<!-- Logo -->
<Border Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False" SnapsToDevicePixels="True" UseLayoutRounding="True"
HorizontalAlignment="Right" VerticalAlignment="Center" Width="34" Height="34">
<Border.Clip>
<RectangleGeometry Rect="0,0,34,34" RadiusX="6" RadiusY="6" />
</Border.Clip>
<local:MyImage x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" FallbackSource="pack://application:,,,/images/Icons/NoIcon.png" />
</Border>
<!-- 标题 -->
<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0"
SnapsToDevicePixels="False" UseLayoutRounding="False" x:Name="PanTitle">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" x:Name="ColumnTitle" />
<ColumnDefinition Width="Auto" x:Name="ColumnSubtitle" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" x:Name="ColumnExtend" />
</Grid.ColumnDefinitions>
<TextBlock x:Name="LabTitle" TextTrimming="CharacterEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabSubtitle" Grid.Column="1" HorizontalAlignment="Left"
TextTrimming="CharacterEllipsis" FontSize="12" IsHitTestVisible="False"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<!-- 更新按钮 -->
<local:MyIconButton Grid.Column="2"
Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
</Grid>
<!-- Tag 与 详情 -->
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False">
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
<TextBlock Text="科技" Foreground="{DynamicResource ColorBrush2}" FontSize="11" />
</Border>-->
</StackPanel>
<TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="0,0,3,1"
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray4}"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</Grid>
Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb
-544
View File
@@ -1,544 +0,0 @@
Imports System.Windows.Forms
Public Class MyLocalModItem
#Region "基础属性"
Public Uuid As Integer = GetUuid()
'Logo
Public Property Logo As String
Get
Return PathLogo.Source
End Get
Set(value As String)
PathLogo.Source = value
End Set
End Property
'标题
Private _Title As String
Public Property Title As String
Get
Return _Title
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
Case McMod.McModState.Unavailable
LabTitle.TextDecorations = TextDecorations.Strikethrough
value &= " [错误]"
End Select
If LabTitle.Text = value Then Exit Property
LabTitle.Text = value
_Title = RawValue
End Set
End Property
'副标题
Public Property SubTitle As String
Get
Return If(LabSubtitle?.Text, "")
End Get
Set(value As String)
If LabSubtitle.Text = value Then Exit Property
LabSubtitle.Text = value
LabSubtitle.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
End Set
End Property
'描述
Public Property Description As String
Get
Return LabInfo.Text
End Get
Set(value As String)
If LabInfo.Text = value Then Exit Property
LabInfo.Text = value
End Set
End Property
'Tag
Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String))
PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value
Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#0C000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#88000000"" FontSize=""11"" />
</Border>")
PanTags.Children.Add(NewTag)
Next
End Set
End Property
'相关联的 Mod
Public Property Entry As McMod
Get
Return Tag
End Get
Set(value As McMod)
Tag = value
End Set
End Property
#End Region
#Region "点击与勾选"
'触发点击事件
Public Event Click(sender As Object, e As MouseButtonEventArgs)
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub
Log("[Control] 按下本地 Mod 列表项：" & LabTitle.Text)
End If
End Sub
'鼠标点击判定
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown
If Not IsMouseDirectlyOver Then Exit Sub
IsMouseDown = True
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = False
End Sub
Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp
IsMouseDown = False
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
End Sub
'滑动选中
Private Shared SwipeStart As Integer, SwipeEnd As Integer
Private Shared Swiping As Boolean = False
Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值
Private Sub Button_MouseSwipeStart(sender As Object, e As Object) Handles Me.MouseLeftButtonDown
If Parent Is Nothing Then Exit Sub 'Mod 可能已被删除（#3824）
'开始滑动
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
SwipeStart = Index
SwipeEnd = Index
Swiping = True
SwipToState = Not Checked
FrmVersionMod.CardSelect.IsHitTestVisible = False '暂时禁用下边栏
End Sub
Private Sub Button_MouseSwipe(sender As Object, e As Object) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonUp
If Parent Is Nothing Then Exit Sub 'Mod 可能已被删除（#3824）
'结束滑动
If Mouse.LeftButton <> MouseButtonState.Pressed OrElse Not Swiping Then
Swiping = False
FrmVersionMod.CardSelect.IsHitTestVisible = True
Exit Sub
End If
'计算滑动范围
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)
'勾选所有范围中的项
If SwipeStart = SwipeEnd Then Exit Sub
For i = SwipeStart To SwipeEnd
Dim Item As MyLocalModItem = Elements(i)
Item.InitLate(Item, e)
Item.Checked = SwipToState
Next
End Sub
'勾选状态
Public Event Check(sender As Object, e As RouteEventArgs)
Public Event Changed(sender As Object, e As RouteEventArgs)
Private _Checked As Boolean = False
Public Property Checked As Boolean
Get
Return _Checked
End Get
Set(value As Boolean)
Try
'触发属性值修改
Dim RawValue = _Checked
If value = _Checked Then Exit Property
_Checked = value
Dim ChangedEventArgs As New RouteEventArgs(False)
If IsInitialized Then
RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then
_Checked = RawValue
Exit Property
End If
End If
If value Then
Dim CheckEventArgs As New RouteEventArgs(False)
RaiseEvent Check(Me, CheckEventArgs)
If CheckEventArgs.Handled Then Exit Property
End If
'更改动画
If IsVisibleInForm() Then
Dim Anim As New List(Of AniData)
If Checked Then
'由无变有
Dim Delta = 32 - RectCheck.ActualHeight
Anim.Add(AaHeight(RectCheck, Delta * 0.4, 200,, New AniEaseOutFluent(AniEasePower.Weak)))
Anim.Add(AaHeight(RectCheck, Delta * 0.6, 300,, New AniEaseOutBack(AniEasePower.Weak)))
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))
Else
'由有变无
Anim.Add(AaHeight(RectCheck, -RectCheck.ActualHeight, 120,, New AniEaseInFluent(AniEasePower.Weak)))
Anim.Add(AaOpacity(RectCheck, -RectCheck.Opacity, 70, 40))
RectCheck.VerticalAlignment = VerticalAlignment.Center
Anim.Add(AaColor(LabTitle, TextBlock.ForegroundProperty, If(LabTitle.TextDecorations Is Nothing, "ColorBrush1", "ColorBrushGray4"), 120))
End If
AniStart(Anim, "MyLocalModItem Checked " & Uuid)
Else
'不在窗口上时直接设置
RectCheck.VerticalAlignment = VerticalAlignment.Center
RectCheck.Margin = New Thickness(-3, 0, 0, 0)
If Checked Then
RectCheck.Height = 32
RectCheck.Opacity = 1
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
RectCheck.Height = 0
RectCheck.Opacity = 0
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
AniStop("MyLocalModItem Checked " & Uuid)
End If
Catch ex As Exception
Log(ex, "设置 Checked 失败")
End Try
End Set
End Property
#End Region
#Region "后加载内容"
'右下角状态指示图标
Private ImgState As Image
'指向背景
Private _RectBack As Border = Nothing
Public ReadOnly Property RectBack As Border
Get
If _RectBack Is Nothing Then
Dim Rect As New Border With {
.Name = "RectBack",
.CornerRadius = New CornerRadius(3),
.RenderTransform = New ScaleTransform(0.8, 0.8),
.RenderTransformOrigin = New Point(0.5, 0.5),
.BorderThickness = New Thickness(GetWPFSize(1)),
.SnapsToDevicePixels = True,
.IsHitTestVisible = False,
.Opacity = 0
}
Rect.SetResourceReference(Border.BackgroundProperty, "ColorBrush7")
Rect.SetResourceReference(Border.BorderBrushProperty, "ColorBrush6")
SetColumnSpan(Rect, 999)
SetRowSpan(Rect, 999)
Children.Insert(0, Rect)
_RectBack = Rect
'<!--<Border x:Name = "RectBack" CornerRadius="3" RenderTransformOrigin="0.5,0.5" SnapsToDevicePixels="True"
'IsHitTestVisible = "False" Opacity="0" BorderThickness="1"
'Grid.ColumnSpan = "4" Background="{DynamicResource ColorBrush7}" BorderBrush="{DynamicResource ColorBrush6}"/>-->
End If
Return _RectBack
End Get
End Property
'按钮
Public ButtonHandler As Action(Of MyLocalModItem, EventArgs)
Public ButtonStack As FrameworkElement
Private _Buttons As IEnumerable(Of MyIconButton)
Public Property Buttons As IEnumerable(Of MyIconButton)
Get
Return _Buttons
End Get
Set(value As IEnumerable(Of MyIconButton))
_Buttons = value
'移除原 Stack
If ButtonStack IsNot Nothing Then
Children.Remove(ButtonStack)
ButtonStack = Nothing
End If
If Not value.Any() Then Exit Property
'添加新 Stack
ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False}
SetColumnSpan(ButtonStack, 10) : SetRowSpan(ButtonStack, 10)
'构造按钮
For Each Btn As MyIconButton In value
If Btn.Height.Equals(Double.NaN) Then Btn.Height = 25
If Btn.Width.Equals(Double.NaN) Then Btn.Width = 25
CType(ButtonStack, StackPanel).Children.Add(Btn)
Next
Children.Add(ButtonStack)
End Set
End Property
'勾选条
Private _RectCheck As Border
Public ReadOnly Property RectCheck As Border
Get
If _RectCheck Is Nothing Then
_RectCheck = New Border With {.Width = 5, .Height = If(Checked, Double.NaN, 0), .CornerRadius = New CornerRadius(2, 2, 2, 2),
.VerticalAlignment = If(Checked, VerticalAlignment.Stretch, VerticalAlignment.Center),
.HorizontalAlignment = HorizontalAlignment.Left, .UseLayoutRounding = False, .SnapsToDevicePixels = False,
.Margin = If(Checked, New Thickness(-3, 6, 0, 6), New Thickness(-3, 0, 0, 0))}
_RectCheck.SetResourceReference(Border.BackgroundProperty, "ColorBrush3")
SetRowSpan(_RectCheck, 10)
Children.Add(_RectCheck)
End If
Return _RectCheck
End Get
End Property
#End Region
Private Function GetUpdateCompareDescription() As String
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
'简化名称对比
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
Dim NewestSegs = NewestName.Split("-"c).ToList()
Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For
CurrentSegs.Remove(Seg)
NewestSegs.Remove(Seg)
Shortened = True
Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentName = Join(CurrentSegs, "-")
NewestName = Join(NewestSegs, "-")
Entry._Version = CurrentName '使用网络信息作为显示的版本号
End If
Return $"当前版本：{CurrentName}（{GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}）{vbCrLf}最新版本：{NewestName}（{GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)}）"
End Function
Public Sub Refresh() Handles Me.Loaded
RunInUi(
Sub()
'更新
If Entry.CanUpdate Then
BtnUpdate.Visibility = Visibility.Visible
BtnUpdate.ToolTip = $"{GetUpdateCompareDescription()}{vbCrLf}点击以更新，右键查看更新日志。"
Else
BtnUpdate.Visibility = Visibility.Collapsed
End If
'标题与描述
Dim DescFileName As String
Select Case Entry.State
Case McMod.McModState.Fine
DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path)
Case McMod.McModState.Disabled
DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
Case Else 'McMod.McModState.Unavailable
DescFileName = GetFileNameFromPath(Entry.Path)
End Select
Dim NewDescription As String
If Setup.Get("ToolModLocalNameStyle") = 1 Then
'标题显示文件名，详情显示译名
'标题
Title = DescFileName
SubTitle = ""
'描述
If Entry.Comp Is Nothing Then
NewDescription = Entry.Name
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
NewDescription = Titles.Key & Titles.Value
End If
NewDescription = NewDescription.Replace(" | ", " / ")
If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})"
Else
'标题显示译名，详情显示文件名
'标题
If Entry.Comp Is Nothing Then
Title = Entry.Name
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key
SubTitle = Titles.Value & 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, "")
ElseIf Entry.Description IsNot Nothing Then
NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Not Entry.IsFileAvailable Then
NewDescription += ": " & "存在错误，无法获取信息"
End If
Description = NewDescription
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'主 Logo
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo())
'图标右下角的 Logo
If Entry.State = McMod.McModState.Fine Then
If ImgState IsNot Nothing Then
Children.Remove(ImgState)
ImgState = Nothing
End If
Else
If ImgState Is Nothing Then
ImgState = New Image With {
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
}
RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
SetColumn(ImgState, 1) : SetRow(ImgState, 1) : SetRowSpan(ImgState, 2)
Children.Add(ImgState)
'<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1"
' Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False"
' HorizontalAlignment="Right" VerticalAlignment="Bottom"
' Source="/Images/Icons/Unavailable.png" />
End If
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
End If
'标签
If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
End Sub)
End Sub
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed
InitLate(sender, e)
'触发颜色动画
Dim Time As Integer = If(IsMouseOver, 120, 180)
Dim Ani As New List(Of AniData)
'ButtonStack
If ButtonStack IsNot Nothing Then
If IsMouseOver Then
Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
5 + Buttons.Count * 25 - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7))
Else
Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.4))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
4 - ColumnPaddingRight.Width.Value, Time * 0.4))
End If
End If
'RectBack
If IsMouseOver OrElse Checked Then
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
If IsMouseDown Then
Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
Else
Ani.Add(AaScaleTransform(RectBack, 1 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
End If
Else
Ani.AddRange({
AaOpacity(RectBack, -RectBack.Opacity, Time),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
End If
AniStart(Ani, "LocalModItem Color " & Uuid)
End Sub
'触发虚拟化内容
Private Sub InitLate(sender As Object, e As EventArgs)
If ButtonHandler IsNot Nothing Then
ButtonHandler(sender, e)
ButtonHandler = Nothing
End If
End Sub
'显示更新日志
Private Sub BtnUpdate_PreviewMouseRightButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnUpdate.PreviewMouseRightButtonUp
e.Handled = True
ShowUpdateLog()
End Sub
Private Sub ShowUpdateLog()
Dim CurseForgeUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("curseforge.com"))
Dim ModrinthUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("modrinth.com"))
If CurseForgeUrl Is Nothing OrElse ModrinthUrl Is Nothing Then
OpenWebsite(Entry.ChangelogUrls.First)
Else
Select Case MyMsgBox("要在哪个网站上查看更新日志？", "查看更新日志", "Modrinth", "CurseForge", "取消")
Case 1
OpenWebsite(ModrinthUrl)
Case 2
OpenWebsite(CurseForgeUrl)
End Select
End If
End Sub
'触发更新
Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
Select Case MyMsgBox($"是否要更新 {Entry.Name}？{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
Case 1 '更新
FrmVersionMod.UpdateMods({Entry})
Case 2 '查看更新日志
ShowUpdateLog()
Case 3 '取消
End Select
End Sub
'自适应（#4465）
Private Sub PanTitle_SizeChanged() Handles PanTitle.SizeChanged
'0：全部舒展：Auto - Auto - (Auto) - 1*
'1：压缩 Subtitle：Auto - 1* - (Auto) - 0
'2：继续压缩 Title：1* - 0 - (Auto) - 0
Dim CurrentCompressLevel As Integer =
If(ColumnExtend.Width.IsStar, 0, If(ColumnTitle.Width.IsStar, 2, 1)) 'Subtitle 可能是 Collapsed
Dim NewCompressLevel As Integer
Select Case CurrentCompressLevel
Case 0
If ColumnExtend.ActualWidth < 0.5 Then
NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 2, 1)
Else
Return
End If
Case 1
If ColumnSubtitle.ActualWidth < 0.5 Then
NewCompressLevel = 2
ElseIf Not LabSubtitle.IsTextTrimmed Then
NewCompressLevel = 0
Else
Return
End If
Case 2
If Not LabTitle.IsTextTrimmed Then
NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 0, 1)
Else
Return
End If
End Select
Select Case NewCompressLevel
Case 0
'全部舒展：Auto - Auto - (Auto) - 1*
ColumnTitle.Width = GridLength.Auto
ColumnSubtitle.Width = GridLength.Auto
ColumnExtend.Width = New GridLength(1, GridUnitType.Star)
Case 1
'压缩 Subtitle：Auto - 1* - (Auto) - 0
ColumnTitle.Width = GridLength.Auto
ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
Case 2
'继续压缩 Title：1* - 0 - (Auto) - 0
ColumnTitle.Width = New GridLength(1, GridUnitType.Star)
ColumnSubtitle.Width = New GridLength(0, GridUnitType.Pixel)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
End Select
End Sub
End Class