Merge branch 'main' into feat#6026

This commit is contained in:
wyc-26
2025-06-02 10:59:14 +08:00
124 changed files with 5373 additions and 3102 deletions
+35 -19
View File
@@ -1,26 +1,40 @@
本文件仅作为指引您合理使用本存储库内容的指南,不是法律文件或协议。
一、声明
一、承诺与声明。
本文件仅作为指南,不是法律文件或协议。但开发者在此承诺,在您遵守本指南且善意、合理使用的情况下,不会追究您的责任。
法律上,开发者仍保留所有权利(All Rights Reserved),若情况恶劣,仍可能将诉讼作为最终手段。
  开发者承诺,在您遵守本指南且善意使用的情况下,不会追究您的责任,但最终裁量权仍由开发者保留。
  法律上,开发者仍保留所有权利(All Rights Reserved),且可能随时修改本指南,本指南并不是永久性保证。
二、少量使用情形。
  如果您仅合理使用本存储库中的少量内容,或是参考实现思路,您必须:
  1、给出适当的署名,且提供指向本存储库的链接。GitHub 上的 Fork 可视为满足此条。
  2、不得以任何方式暗示开发者为您或您的使用作担保。
二、轻度使用
三、大量使用情形。
若您仅参考了本存储库中极小部分的内容,或您在制作与 PCL 的实质功能不存在任何重叠的软件,则为轻度使用。
其常见情形例如:
· 使用或参考存储库中极小部分的内容,来开发启动器或其他软件。
· 虽参考了较大量的内容,但制作的软件与 PCL 的实质功能不存在任何重叠。
  如果您基于该存储库创作衍生作品,或合理使用了本存储库中的较大量内容,您必须:
  1、给出适当的署名,且提供指向本存储库的链接。GitHub 上的 Fork 可视为满足此条。
  2、不得以任何方式暗示开发者为您或您的使用作担保。
  3、给出适当的说明,以明确表示该衍生作品是非官方内容。
  4、使用本指南文件作为协议,不得附加额外条款。
  5、该衍生作品的名称必须以 “PCL” 或 “Plain Craft Launcher” 开头,并在其后添加后缀。例如 “PCL 整合包优化版”、“PCL PR Collection”。
  6、该衍生作品不得包含 PCL 的赞助解锁功能,或与其相近的功能或内容。例如将配色修改为蓝色色系以外的颜色。
  7、以善意目的进行合理使用,不要用 PCL 来干坏事、恰烂钱、整烂活。开发者可能会将撤销所有授权作为最终手段。
若属于轻度使用,您需要:
1、以适当的形式给出署名。
2、不得将您的内容与 PCL 混淆,或暗示您的内容与 PCL 有关。
 例如:您的内容不得使用 Planting Craft Launcher、PCL 手机版 等会造成混淆或暗示这与 PCL 有关的名称。
三、重度使用
若不符合轻度使用的情形,即为重度使用。
其常见情形例如:
· 基于本存储库进行修改。
· 参考存储库中较大量的内容,以制作或重新实现 PCL 的部分实质功能(例如启动或下载 Java 版 Minecraft,下载或管理 Mod 等)。
若属于重度使用,您需要:
1、明确表示您的内容是第三方基于 PCL 独立进行二次创作的产物。
2、您的内容的名称必须以 Plain Craft Launcher (PCL) 开头,并在其后添加足以表现其由第三方修改的后缀。
 允许的示例:PCL 某服务器魔改版、PCL PR Collection、PCL (XX Bug Fix)、PCL XXX修改版。
 禁止的示例:PCL 某服务器特供版(暗示由官方提供)、PCL 3、PCL 手机版、PCL++、PCL Pro(这像是官方的后续作品)。
3、在关于页面的首位给出龙腾猫跃的署名及对应的赞助链接,公开源代码,且继续使用本文件作为指南(可参考 CC BY-SC 协议)。
4、软件若有 Minecraft 启动功能,则应实现与 McLaunchPrecheck 函数一致的 Minecraft 正版购买弹窗与赞助弹窗。
5、软件在 Windows 系统上运行时,不应有与 PCL 的赞助解锁功能类似的功能或表现。
 例如:界面的主要色相必须为蓝色(即使没有修改功能,改为其他色相也和需要赞助解锁的主题功能类似)。
————————————
@@ -29,5 +43,7 @@
因为没有法律专业人士检查,所以这不敢作为正式的法律协议,如果有专业人士愿意帮忙改一改我也很乐意……
这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
如果你只是想参考一下,或者用了一小部分代码,署个名就行啦。
如果你整了个魔改版,或者用了一大堆代码,请仔细参考上面的第三条。
如果你只是参考了一小段代码,署个名就行啦,不用担心。
如果对具体细节有疑问,欢迎在 https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E6%8F%90%E9%97%AE 发帖询问!
多谢大家啦!
+3 -8
View File
@@ -8,12 +8,6 @@
<Application.Resources>
<ResourceDictionary>
<!-- 本地化 -->
<ResourceDictionary.MergedDictionaries>
<ResourceDictionary Source="pack://application:,,,/Resources/Language/zh_CN.xaml" />
<ResourceDictionary Source="pack://application:,,,/Resources/Language/zh_CN.xaml" />
</ResourceDictionary.MergedDictionaries>
<!-- Converter -->
<local:AdditionConverter x:Key="AdditionConverter"/>
<local:MultiplicationConverter x:Key="MultiplicationConverter"/>
@@ -66,7 +60,7 @@
<SolidColorBrush x:Key="ColorBrushWhite" Color="#ffffff" />
<SolidColorBrush x:Key="ColorBrushTransparent" Color="Transparent" />
<SolidColorBrush x:Key="ColorBrushSemiTransparent">#01eaf2fe</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrushBackgroundTransparentSidebar" Color="#D2FFFFFF" />
<SolidColorBrush x:Key="ColorBrushBackgroundTransparentSidebar" Color="#F1FFFFFF" />
<!-- Window -->
<Style TargetType="{x:Type Window}" x:Key="MyWindow">
@@ -209,7 +203,7 @@
</Setter.Value>
</Setter>
</Style>
<Style TargetType="local:MyScrollViewer">
<Style TargetType="local:MyScrollViewer" x:Name="StyleMyScrollViewer">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="CanContentScroll" Value="False" />
<Setter Property="PanningMode" Value="VerticalOnly" />
@@ -225,6 +219,7 @@
</Setter.Value>
</Setter>
</Style>
<Style TargetType="local:PageComp" BasedOn="{StaticResource {x:Type local:MyScrollViewer}}" />
<Style TargetType="ScrollViewer" x:Key="ScrollViewerFullMargin">
<Setter Property="OverridesDefaultStyle" Value="True" />
<Setter Property="CanContentScroll" Value="False" />
+13 -18
View File
@@ -115,7 +115,11 @@ WaitRetry:
LogStart()
'添加日志
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
#If RELEASE Then
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",正式版", "")}")
#Else
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
#End If
Log($"[Start] 程序路径:{PathWithName}")
Log($"[Start] 系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Log($"[Start] 管理员权限:{IsAdmin()}")
@@ -131,6 +135,7 @@ WaitRetry:
Setup.Load("SystemDebugAnim")
Setup.Load("ToolDownloadThread")
Setup.Load("ToolDownloadCert")
Setup.Load("ToolDownloadSpeed")
'网络配置初始化
ServicePointManager.Expect100Continue = True
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
@@ -160,28 +165,18 @@ WaitRetry:
End Sub
'异常
Private IsCritErrored As Boolean = False
Private Sub Application_DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs) Handles Me.DispatcherUnhandledException
On Error Resume Next
e.Handled = True
If IsProgramEnded Then Exit Sub
If IsCritErrored Then
'在汇报错误后继续引发错误,知道这次压不住了
FormMain.EndProgramForce(ProcessReturnValues.Exception)
Exit Sub
End If
IsCritErrored = True
Dim ExceptionString As String = GetExceptionDetail(e.Exception, True)
If ExceptionString.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse
ExceptionString.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse
ExceptionString.Contains(".NET Framework") OrElse ' “自动错误判断” 的结果分析
ExceptionString.Contains("未能加载文件或程序集") Then
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
MsgBox("你的 .NET Framework 版本过低或损坏,请下载并重新安装 .NET Framework 4.6.2!", MsgBoxStyle.Information, "运行环境错误")
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
Else
If IsProgramEnded Then Return
FeedbackInfo()
Log(e.Exception, "程序出现未知错误", LogLevel.Assert, "锟斤拷烫烫烫")
Dim Detail As String = GetExceptionDetail(e.Exception, True)
If Detail.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse Detail.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse Detail.Contains("未能加载文件或程序集") OrElse
Detail.Contains(".NET Framework") Then ' “自动错误判断” 的结果分析
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
Log(e.Exception, "你的 .NET Framework 版本过低或损坏,请下载并重新安装 .NET Framework 4.6.2!" & vbCrLf & "若无法安装,可在卸载高版本的 .NET Framework 后再试。", LogLevel.Critical, "运行环境错误")
Else
Log(e.Exception, "程序出现未知错误", LogLevel.Critical, "锟斤拷烫烫烫")
End If
End Sub
@@ -142,7 +142,7 @@ Public Class MyButton
'实现自定义事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Exit Sub
If Not IsMouseDown Then Return
Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then
@@ -185,7 +185,7 @@ Public Class MyButton
AniStart(AaColor(PanFore, BackgroundProperty, If(_ColorType = ColorState.Red, "ColorBrushRedBack", "ColorBrush7"), AnimationColorIn), "MyButton Background " & Uuid)
End Sub
Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Exit Sub
If Not IsMouseDown Then Return
IsMouseDown = False
AniStart({
AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 300, 10, New AniEaseOutFluent(AniEasePower.Middle))
@@ -193,7 +193,7 @@ Public Class MyButton
End Sub
Private Sub Button_MouseLeave() Handles Me.MouseLeave
AniStart(AaColor(PanFore, BackgroundProperty, "ColorBrushHalfWhite", AnimationColorOut), "MyButton Background " & Uuid)
If Not IsMouseDown Then Exit Sub
If Not IsMouseDown Then Return
IsMouseDown = False
AniStart(AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), "MyButton Scale " & Uuid)
End Sub
+63 -44
View File
@@ -3,7 +3,7 @@
'控件
Inherits Grid
Private ReadOnly MainGrid As Grid
Public ReadOnly Property MainChrome As SystemDropShadowChrome
Public ReadOnly Property MainChrome As MyDropShadow
Private ReadOnly MainBorder As Border
Public Property BorderChild As UIElement
Get
@@ -63,17 +63,18 @@
'UI 建立
Public Sub New()
MainChrome = New SystemDropShadowChrome With {.Margin = New Thickness(-9.5, -9, 0.5, -0.5), .Opacity = 0.1, .CornerRadius = New CornerRadius(6)}
MainChrome.SetResourceReference(SystemDropShadowChrome.ColorProperty, "ColorObject1")
MainChrome = New MyDropShadow With {
.Margin = New Thickness(-3, -3, -3, -3 - GetWPFSize(1)), .ShadowRadius = 3, .Opacity = DropShadowIdleOpacity, .CornerRadius = New CornerRadius(5)}
MainChrome.SetResourceReference(MyDropShadow.ColorProperty, "ColorObject1")
Children.Insert(0, MainChrome)
MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(205, 255, 255, 255)), .CornerRadius = New CornerRadius(6), .IsHitTestVisible = False}
MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(245, 255, 255, 255)), .CornerRadius = New CornerRadius(5), .IsHitTestVisible = False}
Children.Insert(1, MainBorder)
MainGrid = New Grid
Children.Add(MainGrid)
End Sub
Private IsLoad As Boolean = False
Private Sub Init() Handles Me.Loaded
If IsLoad Then Exit Sub
If IsLoad Then Return
IsLoad = True
'初次加载限定
If MainTextBlock Is Nothing Then
@@ -108,7 +109,7 @@
'这一部分的代码是好几年前留下的究极屎坑,当时还不知道该咋正确调用这种方法,就写了这么一坨屎
'但是现在……反正勉强能用……懒得改了就这样吧.jpg
'别骂了别骂了.jpg
If IsNothing(Stack.Tag) Then Exit Sub
If IsNothing(Stack.Tag) Then Return
'排序
Select Case Type
Case 3
@@ -186,29 +187,29 @@
Stack.Tag = Nothing
End Sub
'事件
'动画
Private Const DropShadowIdleOpacity As Double = 0.07
Private Const DropShadowHoverOpacity As Double = 0.4
Public Property HasMouseAnimation As Boolean = True
Private Sub MyCard_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter
If Not HasMouseAnimation Then Exit Sub
If Not HasMouseAnimation Then Return
Dim AniList As New List(Of AniData)
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 150))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 150))
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 90))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 90))
AniList.AddRange({
AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject2", 180),
AaColor(MainBorder, Border.BackgroundProperty, New MyColor(230, 255, 255, 255) - MainBorder.Background, 180),
AaOpacity(MainChrome, 0.3 - MainChrome.Opacity, 180)
AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject4", 90),
AaOpacity(MainChrome, DropShadowHoverOpacity - MainChrome.Opacity, 90)
})
AniStart(AniList, "MyCard Mouse " & Uuid)
End Sub
Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
If Not HasMouseAnimation Then Exit Sub
If Not HasMouseAnimation Then Return
Dim AniList As New List(Of AniData)
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 250))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 250))
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 90))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 90))
AniList.AddRange({
AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject1", 300),
AaColor(MainBorder, Border.BackgroundProperty, New MyColor(205, 255, 255, 255) - MainBorder.Background, 300),
AaOpacity(MainChrome, 0.1 - MainChrome.Opacity, 300)
AaColor(MainChrome, MyDropShadow.ColorProperty, "ColorObject1", 90),
AaOpacity(MainChrome, DropShadowIdleOpacity - MainChrome.Opacity, 90)
})
AniStart(AniList, "MyCard Mouse " & Uuid)
End Sub
@@ -222,37 +223,55 @@
Private IsHeightAnimating As Boolean = False
Private ActualUsedHeight As Double '回滚实际高度(例如 NaN)
Private Sub MySizeChanged(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
If Not UseAnimation Then Exit Sub
If Not UseAnimation Then Return
Dim DeltaHeight As Double = If(IsSwaped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height
'卡片的进入时动画已被页面通用切换动画替代
If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Exit Sub
If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Return
StartHeightAnimation(DeltaHeight, e.PreviousSize.Height, False)
End Sub
Private Sub StartHeightAnimation(DeltaHeight As Double, PreviousHeight As Double, IsLoadAnimation As Boolean)
If IsHeightAnimating OrElse FrmMain Is Nothing Then Exit Sub '避免 XAML 设计器出错
Private Sub StartHeightAnimation(Delta As Double, PreviousHeight As Double, IsLoadAnimation As Boolean)
If IsHeightAnimating OrElse FrmMain Is Nothing Then Return '避免 XAML 设计器出错
Dim AnimList As New List(Of AniData)
If DeltaHeight > 10 OrElse (DeltaHeight < -10 AndAlso Not IsNothing(SwapControl)) Then '如果不是需要折叠的卡片,高度减小时的弹跳会吞掉按钮下边框
'高度增加较大,使用弹起动画
Dim Delta As Double = MathClamp(Math.Abs(DeltaHeight) * 0.05, 3, 10) * Math.Sign(DeltaHeight)
AnimList.AddRange({
AaHeight(Me, DeltaHeight + Delta, 300, If(IsLoadAnimation, 30, 0), If(DeltaHeight > FrmMain.Height, New AniEaseInFluent(AniEasePower.ExtraStrong), New AniEaseOutFluent(AniEasePower.ExtraStrong))),
AaHeight(Me, -Delta, 150, 260, Ease:=New AniEaseOutFluent(AniEasePower.Strong))
})
Dim AbsDelta = Math.Abs(Delta)
If AbsDelta <= 800 Then
'短距离,直接使用 150ms 的缓动动画
AnimList.Add(AaHeight(Me, Delta, 150,, New AniEaseOutFluent(AniEasePower.ExtraStrong)))
Else
'普通的改变就行啦
AnimList.AddRange({
AaHeight(Me, DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
})
Dim EaseLength As Integer, EaseTime As Integer
Dim InitSpeed As Integer '到达缓动区前的初速度
If Delta < 0 AndAlso AbsDelta - EaseLength > 5000 * 0.1 Then
'收回距离过长 (>0.1s),强制以 100ms 完成匀速段,然后让减速段更长
EaseLength = 200
EaseTime = 150
InitSpeed = (AbsDelta - EaseLength) / 0.1
ElseIf Delta > 0 AndAlso AbsDelta - EaseLength > 5000 * 0.6 Then
'展开距离过长 (>0.6s),以 5000 速度展示 300ms 匀速段,剩下的距离全部归入减速段
InitSpeed = 5000
EaseLength = AbsDelta - InitSpeed * 0.3
EaseTime = 400
Else
'中程,匀速地快速展开(或收回)
EaseLength = 150
EaseTime = 200
InitSpeed = 4000
End If
'匀速段
AnimList.Add(AaHeight(Me, (AbsDelta - EaseLength) * Math.Sign(Delta),
(AbsDelta - EaseLength) / InitSpeed * 1000))
'减速段
AnimList.Add(AaHeight(Me, EaseLength * Math.Sign(Delta),
EaseTime,, New AniEaseOutFluentWithInitial(InitSpeed, EaseTime / 1000, EaseLength), True))
End If
AnimList.Add(AaCode(
Sub()
IsHeightAnimating = False
Height = ActualUsedHeight
If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed
If IsSwaped AndAlso SwapControl IsNot Nothing Then SwapControl.Visibility = Visibility.Collapsed
End Sub,, True))
AniStart(AnimList, "MyCard Height " & Uuid)
IsHeightAnimating = True
ActualUsedHeight = If(IsSwaped, SwapedHeight, Height)
Height = PreviousHeight
@@ -286,18 +305,18 @@
Return _IsSwaped
End Get
Set(value As Boolean)
If _IsSwaped = value Then Exit Property
If _IsSwaped = value Then Return
_IsSwaped = value
If SwapControl Is Nothing Then Exit Property
If SwapControl Is Nothing Then Return
'展开
If Not IsSwaped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
'若尚未加载,会在 Loaded 事件中触发无动画的折叠,不需要在这里进行
If Not IsLoaded Then Exit Property
If Not IsLoaded Then Return
'更新高度
SwapControl.Visibility = Visibility.Visible
TriggerForceResize()
'改变箭头
AniStart(AaRotateTransform(MainSwap, If(_IsSwaped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 400,, New AniEaseOutBack(AniEasePower.Weak)), "MyCard Swap " & Uuid, True)
AniStart(AaRotateTransform(MainSwap, If(_IsSwaped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 250,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), "MyCard Swap " & Uuid, True)
End Set
End Property
Private _IsSwaped As Boolean = False
@@ -310,7 +329,7 @@
Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
IsMouseDown = True
End Sub
Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
@@ -319,7 +338,7 @@
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
Dim ee = New RouteEventArgs(True)
RaiseEvent PreviewSwap(Me, ee)
@@ -350,7 +369,7 @@ Partial Public Module ModAnimation
AaCode(
Sub()
If RemoveFromChildren Then
If Control.Parent Is Nothing Then Exit Sub
If Control.Parent Is Nothing Then Return
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
@@ -360,7 +379,7 @@ Partial Public Module ModAnimation
}, "MyCard Dispose " & Control.Uuid)
Else
If RemoveFromChildren Then
If Control.Parent Is Nothing Then Exit Sub
If Control.Parent Is Nothing Then Return
CType(Control.Parent, Object).Children.Remove(Control)
Else
Control.Visibility = Visibility.Collapsed
@@ -40,7 +40,7 @@ Public Class MyCheckBox
''' <param name="user">是否由用户引发。</param>
Public Sub SetChecked(value As Boolean, user As Boolean)
Try
If value = Checked Then Exit Sub
If value = Checked Then Return
'Preview 事件
If value AndAlso user Then
@@ -50,7 +50,7 @@ Public Class MyCheckBox
MouseDowned = True
Checkbox_MouseLeave()
MouseDowned = False
Exit Sub
Return
End If
End If
@@ -133,14 +133,14 @@ Public Class MyCheckBox
Private MouseDowned As Boolean = False
Private AllowMouseDown As Boolean = True
Private Sub Checkbox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Exit Sub
If Not MouseDowned Then Return
Log("[Control] 按下复选框(" & (Not Checked).ToString & "):" & Text)
MouseDowned = False
SetChecked(Not Checked, True)
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
End Sub
Private Sub Checkbox_MouseDown() Handles Me.MouseLeftButtonDown
If Not AllowMouseDown Then Exit Sub
If Not AllowMouseDown Then Return
MouseDowned = True
Focus()
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushBg1", 100), "MyCheckBox Background " & Uuid)
@@ -154,7 +154,7 @@ Public Class MyCheckBox
End If
End Sub
Private Sub Checkbox_MouseLeave() Handles Me.MouseLeave
If Not MouseDowned Then Exit Sub
If Not MouseDowned Then Return
MouseDowned = False
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
If Checked Then
@@ -203,7 +203,7 @@ Public Class MyCheckBox
}, "MyCheckBox BorderColor " & Uuid)
End Sub
Private Sub Checkbox_MouseLeaveAnimation() Handles Me.MouseLeave
If Not IsEnabled Then Exit Sub 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
If Not IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
AniStart({
AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut)
}, "MyCheckBox TextColor " & Uuid)
@@ -8,7 +8,7 @@
Public Property HintText As String = ""
Public Overrides Sub OnApplyTemplate()
MyBase.OnApplyTemplate()
If Not IsEditable Then Exit Sub
If Not IsEditable Then Return
Try
TextBox = Template.FindName("PART_EditableTextBox", Me)
TextBox.AddHandler(LostFocusEvent, New RoutedEventHandler(AddressOf RefreshColor))
@@ -116,7 +116,7 @@
'修复 WPF Bug:下拉框文本修改后,依然误认为还选择着此前的选项,导致再次点击该选项时内容不变
Private IsTextChanging As Boolean = False
Private Sub MyComboBox_TextChanged(sender As Object, e As TextChangedEventArgs) Handles Me.TextChanged
If IsTextChanging OrElse Not IsEditable Then Exit Sub
If IsTextChanging OrElse Not IsEditable Then Return
If SelectedItem IsNot Nothing AndAlso Text <> SelectedItem.ToString Then
Dim RawText As String = Text
Dim RawSelectionStart As Integer = TextBox.SelectionStart
@@ -35,7 +35,7 @@
NewFontOpacity = 0.4
Time = AnimationTimeOut
End If
If BackColorName = NewBackColorName AndAlso FontOpacity = NewFontOpacity Then Exit Sub
If BackColorName = NewBackColorName AndAlso FontOpacity = NewFontOpacity Then Return
BackColorName = NewBackColorName
FontOpacity = NewFontOpacity
'触发颜色动画
@@ -1,65 +1,89 @@
Public NotInheritable Class SystemDropShadowChrome
Public Class MyDropShadow
Inherits Decorator
'源码来源于:https://referencesource.microsoft.com/#PresentationFramework.Aero/parent/Shared/Microsoft/Windows/Themes/SystemDropShadowChrome.cs,6d9c27d92a8128c1
Public Shared ReadOnly ColorProperty As DependencyProperty = DependencyProperty.Register("Color", GetType(Color), GetType(SystemDropShadowChrome), New FrameworkPropertyMetadata(Color.FromArgb(&H71, &H0, &H0, &H0), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)))
''' <summary>
''' 阴影颜色。
''' </summary>
Public Property Color As Color
Get
Return CType(GetValue(ColorProperty), Color)
Return GetValue(ColorProperty)
End Get
Set(value As Color)
SetValue(ColorProperty, value)
End Set
End Property
Public Shared ReadOnly ColorProperty As DependencyProperty = DependencyProperty.Register("Color", GetType(Color), GetType(MyDropShadow),
New FrameworkPropertyMetadata(Color.FromArgb(&H71, &H0, &H0, &H0), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)))
Public Shared ReadOnly CornerRadiusProperty As DependencyProperty = DependencyProperty.Register("CornerRadius", GetType(CornerRadius), GetType(SystemDropShadowChrome), New FrameworkPropertyMetadata(New CornerRadius(), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)), New ValidateValueCallback(AddressOf IsCornerRadiusValid))
''' <summary>
''' 阴影模糊半径。
''' </summary>
Public Property ShadowRadius As Double
Get
Return GetValue(ShadowRadiusProperty)
End Get
Set(value As Double)
SetValue(ShadowRadiusProperty, value)
End Set
End Property
Public Shared ReadOnly ShadowRadiusProperty As DependencyProperty = DependencyProperty.Register("ShadowRadius", GetType(Double), GetType(MyDropShadow),
New FrameworkPropertyMetadata(CDbl(5), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)))
''' <summary>
''' 圆角大小。
''' </summary>
Public Property CornerRadius As CornerRadius
Get
Return CType(GetValue(CornerRadiusProperty), CornerRadius)
Return GetValue(CornerRadiusProperty)
End Get
Set(value As CornerRadius)
SetValue(CornerRadiusProperty, value)
End Set
End Property
Private Shared Function IsCornerRadiusValid(value As Object) As Boolean
Dim cr As CornerRadius = CType(value, CornerRadius)
Dim cr As CornerRadius = value
Return Not (cr.TopLeft < 0.0 OrElse cr.TopRight < 0.0 OrElse cr.BottomLeft < 0.0 OrElse cr.BottomRight < 0.0 OrElse Double.IsNaN(cr.TopLeft) OrElse Double.IsNaN(cr.TopRight) OrElse Double.IsNaN(cr.BottomLeft) OrElse Double.IsNaN(cr.BottomRight) OrElse Double.IsInfinity(cr.TopLeft) OrElse Double.IsInfinity(cr.TopRight) OrElse Double.IsInfinity(cr.BottomLeft) OrElse Double.IsInfinity(cr.BottomRight))
End Function
Public Shared ReadOnly CornerRadiusProperty As DependencyProperty = DependencyProperty.Register("CornerRadius", GetType(CornerRadius), GetType(MyDropShadow),
New FrameworkPropertyMetadata(New CornerRadius(), FrameworkPropertyMetadataOptions.AffectsRender, New PropertyChangedCallback(AddressOf ClearBrushes)), New ValidateValueCallback(AddressOf IsCornerRadiusValid))
' =======================================
' 渲染
' =======================================
Private Const ShadowDepth As Double = 5
Protected Overrides Sub OnRender(drawingContext As DrawingContext)
Dim cornerRadius As CornerRadius = Me.CornerRadius
Dim shadowBounds As New Rect(New Point(ShadowDepth, ShadowDepth), New Size(RenderSize.Width, RenderSize.Height))
Dim shadowBounds As New Rect(0, 0, RenderSize.Width, RenderSize.Height)
Dim color As Color = Me.Color
If shadowBounds.Width > 0 AndAlso shadowBounds.Height > 0 AndAlso color.A > 0 Then
Dim centerWidth As Double = shadowBounds.Right - shadowBounds.Left - 2 * ShadowDepth
Dim centerHeight As Double = shadowBounds.Bottom - shadowBounds.Top - 2 * ShadowDepth
Dim centerWidth As Double = shadowBounds.Right - shadowBounds.Left - 2 * ShadowRadius
Dim centerHeight As Double = shadowBounds.Bottom - shadowBounds.Top - 2 * ShadowRadius
Dim maxRadius As Double = Math.Min(centerWidth * 0.5, centerHeight * 0.5)
cornerRadius.TopLeft = Math.Min(cornerRadius.TopLeft, maxRadius)
cornerRadius.TopRight = Math.Min(cornerRadius.TopRight, maxRadius)
cornerRadius.BottomLeft = Math.Min(cornerRadius.BottomLeft, maxRadius)
cornerRadius.BottomRight = Math.Min(cornerRadius.BottomRight, maxRadius)
Dim brushes As Brush() = GetBrushes(color, cornerRadius)
Dim centerTop As Double = shadowBounds.Top + ShadowDepth
Dim centerLeft As Double = shadowBounds.Left + ShadowDepth
Dim centerRight As Double = shadowBounds.Right - ShadowDepth
Dim centerBottom As Double = shadowBounds.Bottom - ShadowDepth
Dim centerTop As Double = shadowBounds.Top + ShadowRadius
Dim centerLeft As Double = shadowBounds.Left + ShadowRadius
Dim centerRight As Double = shadowBounds.Right - ShadowRadius
Dim centerBottom As Double = shadowBounds.Bottom - ShadowRadius
Dim guidelineSetX As Double() = New Double() {centerLeft, centerLeft + cornerRadius.TopLeft, centerRight - cornerRadius.TopRight, centerLeft + cornerRadius.BottomLeft, centerRight - cornerRadius.BottomRight, centerRight}
Dim guidelineSetY As Double() = New Double() {centerTop, centerTop + cornerRadius.TopLeft, centerTop + cornerRadius.TopRight, centerBottom - cornerRadius.BottomLeft, centerBottom - cornerRadius.BottomRight, centerBottom}
drawingContext.PushGuidelineSet(New GuidelineSet(guidelineSetX, guidelineSetY))
cornerRadius.TopLeft += ShadowDepth
cornerRadius.TopRight += ShadowDepth
cornerRadius.BottomLeft += ShadowDepth
cornerRadius.BottomRight += ShadowDepth
cornerRadius.TopLeft += ShadowRadius
cornerRadius.TopRight += ShadowRadius
cornerRadius.BottomLeft += ShadowRadius
cornerRadius.BottomRight += ShadowRadius
Dim topLeft As New Rect(shadowBounds.Left, shadowBounds.Top, cornerRadius.TopLeft, cornerRadius.TopLeft)
drawingContext.DrawRectangle(brushes(Placement.TopLeft), Nothing, topLeft)
Dim topWidth As Double = guidelineSetX(2) - guidelineSetX(1)
If topWidth > 0 Then
Dim top As New Rect(guidelineSetX(1), shadowBounds.Top, topWidth, ShadowDepth)
Dim top As New Rect(guidelineSetX(1), shadowBounds.Top, topWidth, ShadowRadius)
drawingContext.DrawRectangle(brushes(Placement.Top), Nothing, top)
End If
@@ -68,14 +92,14 @@
Dim leftHeight As Double = guidelineSetY(3) - guidelineSetY(1)
If leftHeight > 0 Then
Dim left As New Rect(shadowBounds.Left, guidelineSetY(1), ShadowDepth, leftHeight)
Dim left As New Rect(shadowBounds.Left, guidelineSetY(1), ShadowRadius, leftHeight)
drawingContext.DrawRectangle(brushes(Placement.Left), Nothing, left)
End If
Dim rightHeight As Double = guidelineSetY(4) - guidelineSetY(2)
If rightHeight > 0 Then
Dim right As New Rect(guidelineSetX(5), guidelineSetY(2), ShadowDepth, rightHeight)
Dim right As New Rect(guidelineSetX(5), guidelineSetY(2), ShadowRadius, rightHeight)
drawingContext.DrawRectangle(brushes(Placement.Right), Nothing, right)
End If
@@ -84,20 +108,20 @@
Dim bottomWidth As Double = guidelineSetX(4) - guidelineSetX(3)
If bottomWidth > 0 Then
Dim bottom As New Rect(guidelineSetX(3), guidelineSetY(5), bottomWidth, ShadowDepth)
Dim bottom As New Rect(guidelineSetX(3), guidelineSetY(5), bottomWidth, ShadowRadius)
drawingContext.DrawRectangle(brushes(Placement.Bottom), Nothing, bottom)
End If
Dim bottomRight As New Rect(guidelineSetX(4), guidelineSetY(4), cornerRadius.BottomRight, cornerRadius.BottomRight)
drawingContext.DrawRectangle(brushes(Placement.BottomRight), Nothing, bottomRight)
If cornerRadius.TopLeft = ShadowDepth AndAlso cornerRadius.TopLeft = cornerRadius.TopRight AndAlso cornerRadius.TopLeft = cornerRadius.BottomLeft AndAlso cornerRadius.TopLeft = cornerRadius.BottomRight Then
If cornerRadius.TopLeft = ShadowRadius AndAlso cornerRadius.TopLeft = cornerRadius.TopRight AndAlso cornerRadius.TopLeft = cornerRadius.BottomLeft AndAlso cornerRadius.TopLeft = cornerRadius.BottomRight Then
Dim center As New Rect(guidelineSetX(0), guidelineSetY(0), centerWidth, centerHeight)
drawingContext.DrawRectangle(brushes(Placement.Center), Nothing, center)
Else
Dim figure As New PathFigure()
If cornerRadius.TopLeft > ShadowDepth Then
If cornerRadius.TopLeft > ShadowRadius Then
figure.StartPoint = New Point(guidelineSetX(1), guidelineSetY(0))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(1), guidelineSetY(1)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(1)), True))
@@ -105,7 +129,7 @@
figure.StartPoint = New Point(guidelineSetX(0), guidelineSetY(0))
End If
If cornerRadius.BottomLeft > ShadowDepth Then
If cornerRadius.BottomLeft > ShadowRadius Then
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(3)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(3), guidelineSetY(3)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(3), guidelineSetY(5)), True))
@@ -113,7 +137,7 @@
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(5)), True))
End If
If cornerRadius.BottomRight > ShadowDepth Then
If cornerRadius.BottomRight > ShadowRadius Then
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(4), guidelineSetY(5)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(4), guidelineSetY(4)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(4)), True))
@@ -121,7 +145,7 @@
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(5)), True))
End If
If cornerRadius.TopRight > ShadowDepth Then
If cornerRadius.TopRight > ShadowRadius Then
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(2)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(2), guidelineSetY(2)), True))
figure.Segments.Add(New LineSegment(New Point(guidelineSetX(2), guidelineSetY(0)), True))
@@ -158,28 +182,27 @@
Private _brushes As Brush()
Private Shared Sub ClearBrushes(o As DependencyObject, e As DependencyPropertyChangedEventArgs)
CType(o, SystemDropShadowChrome)._brushes = Nothing
CType(o, MyDropShadow)._brushes = Nothing
End Sub
Private Shared Function CreateStops(c As Color, cornerRadius As Double) As GradientStopCollection
Dim gradientScale As Double = 1 / (cornerRadius + ShadowDepth)
Dim gsc As New GradientStopCollection From {
New GradientStop(c, (0.5 + cornerRadius) * gradientScale)
}
Private Function CreateStops(c As Color, cornerRadius As Double) As GradientStopCollection
Dim gradientScale As Double = 1 / (ShadowRadius + cornerRadius)
Dim gsc As New GradientStopCollection
Dim stopColor As Color = c
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.1 + cornerRadius) * gradientScale))
stopColor.A = CByte(0.74336 * c.A)
gsc.Add(New GradientStop(stopColor, (1.5 + cornerRadius) * gradientScale))
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.3 + cornerRadius) * gradientScale))
stopColor.A = CByte(0.38053 * c.A)
gsc.Add(New GradientStop(stopColor, (2.5 + cornerRadius) * gradientScale))
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.5 + cornerRadius) * gradientScale))
stopColor.A = CByte(0.12389 * c.A)
gsc.Add(New GradientStop(stopColor, (3.5 + cornerRadius) * gradientScale))
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.7 + cornerRadius) * gradientScale))
stopColor.A = CByte(0.02654 * c.A)
gsc.Add(New GradientStop(stopColor, (4.5 + cornerRadius) * gradientScale))
gsc.Add(New GradientStop(stopColor, (ShadowRadius * 0.9 + cornerRadius) * gradientScale))
stopColor.A = 0
gsc.Add(New GradientStop(stopColor, (5 + cornerRadius) * gradientScale))
gsc.Add(New GradientStop(stopColor, (ShadowRadius + cornerRadius) * gradientScale))
gsc.Freeze()
Return gsc
End Function
Private Shared Function CreateBrushes(c As Color, cornerRadius As CornerRadius) As Brush()
Private Function CreateBrushes(c As Color, cornerRadius As CornerRadius) As Brush()
Dim brushes As Brush() = New Brush(8) {}
brushes(Placement.Center) = New SolidColorBrush(c)
brushes(Placement.Center).Freeze()
@@ -297,3 +320,5 @@
End Function
End Class
'参考自:https://referencesource.microsoft.com/#PresentationFramework.Aero/parent/Shared/Microsoft/Windows/Themes/SystemDropShadowChrome.cs,6d9c27d92a8128c1
@@ -11,7 +11,7 @@
Return _Progress
End Get
Set(value As Double)
If _Progress = value Then Exit Property
If _Progress = value Then Return
_Progress = value
If value < 0.0001 Then
PanProgress.Visibility = Visibility.Collapsed
@@ -30,7 +30,7 @@
Return _Logo
End Get
Set(value As String)
If value = _Logo Then Exit Property
If value = _Logo Then Return
_Logo = value
Path.Data = (New GeometryConverter).ConvertFromString(value)
End Set
@@ -51,7 +51,7 @@
Return _Show
End Get
Set(value As Boolean)
If _Show = value Then Exit Property
If _Show = value Then Return
_Show = value
RunInUi(Sub()
If value Then
@@ -121,7 +121,7 @@
Focus()
End Sub
Private Sub Button_RightMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonDown
If Not CanRightClick Then Exit Sub
If Not CanRightClick Then Return
If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
@@ -141,7 +141,7 @@
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_RightMouseUp() Handles PanClick.MouseRightButtonUp
If Not CanRightClick Then Exit Sub
If Not CanRightClick Then Return
If Not IsLeftMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
@@ -14,7 +14,7 @@ Public Class MyExtraTextButton
Return _Logo
End Get
Set(value As String)
If value = _Logo Then Exit Property
If value = _Logo Then Return
_Logo = value
Path.Data = (New GeometryConverter).ConvertFromString(value)
End Set
@@ -55,7 +55,7 @@ Public Class MyExtraTextButton
Return _Show
End Get
Set(value As Boolean)
If _Show = value Then Exit Property
If _Show = value Then Return
_Show = value
RunInUi(
Sub()
+4 -12
View File
@@ -3,22 +3,14 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
FocusVisualStyle="{x:Null}"
UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Stretch" BorderThickness="1" BorderBrush="#99FF4444" CornerRadius="3">
<Border.Background>
<LinearGradientBrush EndPoint="1,0.5" StartPoint="0,0.5">
<GradientStop x:Name="Gradient1" Color="#88FFBBBB" Offset="0.3"/>
<GradientStop x:Name="Gradient2" Color="#88FF8888" Offset="0.9"/>
</LinearGradientBrush>
</Border.Background>
UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Stretch" BorderThickness="3,0,0,0" BorderBrush="#99FF4444" CornerRadius="2">
<Grid UseLayoutRounding="False" SnapsToDevicePixels="False">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<Path IsHitTestVisible="False" Grid.Column="0" x:Name="Path" VerticalAlignment="Center" Fill="#BF0000" Width="14" Stretch="Uniform" Margin="10,0,2,0" Data="F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z " />
<TextBlock IsHitTestVisible="False" Grid.Column="1" x:Name="LabText" Margin="0,0.5,0,0" Padding="6,6,8,6" VerticalAlignment="Center" Foreground="#BF0000" TextWrapping="Wrap" />
<local:MyIconButton x:Name="BtnClose" SnapsToDevicePixels="True" Visibility="Collapsed" Foreground="#BF0000" Theme="Custom" Margin="0,0,6,0" Grid.Column="2" Height="20" Width="20" VerticalAlignment="Center" Logo="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z"
ToolTip="不再显示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" />
<TextBlock IsHitTestVisible="False" x:Name="LabText" LineHeight="16" Margin="0,0,0,-1" Padding="12,9" VerticalAlignment="Center" TextWrapping="Wrap" />
<local:MyIconButton x:Name="BtnClose" Visibility="Collapsed" Theme="Custom" Margin="0,0,8,0" Grid.Column="1" Height="20" Width="20" VerticalAlignment="Center" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z"
ToolTip="不再提示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" />
</Grid>
</Border>
+62 -27
View File
@@ -2,37 +2,73 @@
<ContentProperty("Inlines")>
Public Class MyHint
Public Uuid As Integer = GetUuid()
Private _IsWarn As Boolean = True
Public Property IsWarn As Boolean
'边框
Public Property HasBorder As Boolean
Get
Return _IsWarn
Return BorderThickness.Top > 0
End Get
Set(value As Boolean)
If _IsWarn = value Then Exit Property
_IsWarn = value
If _IsWarn Then
BorderBrush = New MyColor("#CCFF4444")
Gradient1.Color = New MyColor("#BBFFBBBB")
Gradient2.Color = New MyColor("#BBFF8888")
Path.Fill = New MyColor("#BF0000")
LabText.Foreground = New MyColor("#BF0000")
BtnClose.Foreground = New MyColor("#BF0000")
Path.Data = (New GeometryConverter).ConvertFromString("F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z ")
If value Then
BorderThickness = New Thickness(3, GetWPFSize(1), GetWPFSize(1), GetWPFSize(1))
Else
BorderBrush = New MyColor("#CC4D76FF")
Gradient1.Color = New MyColor("#BBB0D0FF")
Gradient2.Color = New MyColor("#BB9EBAFF")
Path.Fill = New MyColor("#0062BF")
LabText.Foreground = New MyColor("#0062BF")
BtnClose.Foreground = New MyColor("#0062BF")
Path.Data = (New GeometryConverter).ConvertFromString("F1M38,19C48.4934,19 57,27.5066 57,38 57,48.4934 48.4934,57 38,57 27.5066,57 19,48.4934 19,38 19,27.5066 27.5066,19 38,19z M33.25,33.25L33.25,36.4167 36.4166,36.4167 36.4166,47.5 33.25,47.5 33.25,50.6667 44.3333,50.6667 44.3333,47.5 41.1666,47.5 41.1666,36.4167 41.1666,33.25 33.25,33.25z M38.7917,25.3333C37.48,25.3333 36.4167,26.3967 36.4167,27.7083 36.4167,29.02 37.48,30.0833 38.7917,30.0833 40.1033,30.0833 41.1667,29.02 41.1667,27.7083 41.1667,26.3967 40.1033,25.3333 38.7917,25.3333z")
BorderThickness = New Thickness(3, 0, 0, 0)
End If
End Set
End Property
'配色
Public Enum Themes
Blue = 0
Red = 1
Yellow = 2
End Enum
Public Property Theme As Themes
Get
Return _ColorType
End Get
Set(value As Themes)
_ColorType = value
UpdateUI()
End Set
End Property
Private _ColorType As Themes = Themes.Red
Private Sub UpdateUI() Handles Me.Loaded
Select Case Theme
Case Themes.Blue
Background = New MyColor("#d9ecff")
BorderBrush = New MyColor("#1172D4")
LabText.Foreground = New MyColor("#0F64B8")
BtnClose.Foreground = New MyColor("#0F64B8")
Case Themes.Red
Background = New MyColor("#ffdddf")
BorderBrush = New MyColor("#d82929")
LabText.Foreground = New MyColor("#bf0b0b")
BtnClose.Foreground = New MyColor("#bf0b0b")
Case Themes.Yellow
Background = New MyColor("#ffebd7")
BorderBrush = New MyColor("#f57a00")
LabText.Foreground = New MyColor("#d86c00")
BtnClose.Foreground = New MyColor("#d86c00")
End Select
End Sub
<Obsolete("IsWarn 已过时。请换用 Theme 属性。")>
Public Property IsWarn As Boolean
Get
Return Theme = Themes.Red
End Get
Set(value As Boolean)
Theme = If(value, Themes.Red, Themes.Blue)
End Set
End Property
Public Shared ReadOnly IsWarnProperty As DependencyProperty =
DependencyProperty.Register("IsWarn", GetType(Boolean), GetType(MyHint), New PropertyMetadata(True,
Sub(d As MyHint, e As DependencyPropertyChangedEventArgs)
d.Theme = If(e.NewValue, Themes.Red, Themes.Blue)
End Sub))
'文本
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
@@ -52,6 +88,7 @@ Public Class MyHint
d.LabText.Text = e.NewValue
End Sub))
'关闭按钮
Public Property CanClose As Boolean
Get
Return BtnClose.Visibility = Visibility.Visible
@@ -60,12 +97,9 @@ Public Class MyHint
BtnClose.Visibility = If(value, Visibility.Visible, Visibility.Collapsed)
End Set
End Property
Public Property RelativeSetup As String = ""
Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If CanClose AndAlso Setup.Get(RelativeSetup) Then
Visibility = Visibility.Collapsed
End If
If CanClose AndAlso Setup.Get(RelativeSetup) Then Visibility = Visibility.Collapsed
End Sub
Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
Setup.Set(RelativeSetup, True)
@@ -109,13 +143,14 @@ Public Class MyHint
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyHint, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Not Control.IsHitTestVisible Then Exit Sub
If Not Control.IsHitTestVisible Then Return
Control.IsHitTestVisible = False
AniStart({
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
AaCode(Sub()
AaCode(
Sub()
If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control)
Else
@@ -186,7 +186,7 @@
End Class
Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyIconButton, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Not Control.IsHitTestVisible Then Exit Sub
If Not Control.IsHitTestVisible Then Return
Control.IsHitTestVisible = False
AniStart({
AaScaleTransform(Control, -1.5, 200,, New AniEaseInFluent),
@@ -72,7 +72,7 @@ Public Class MyIconTextButton
Public Event Click(sender As Object, e As RouteEventArgs)
Private IsMouseDown As Boolean = False
Private Sub MyIconTextButton_MouseUp() Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Exit Sub
If Not IsMouseDown Then Return
Log("[Control] 按下带图标按钮:" & Text)
IsMouseDown = False
RaiseEvent Click(Me, New RouteEventArgs(True))
+9 -9
View File
@@ -34,9 +34,9 @@
End Get
Set(value As String)
If value = "" Then value = Nothing
If _Source = value Then Exit Property
If _Source = value Then Return
_Source = value
If Not IsInitialized Then Exit Property '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
If Not IsInitialized Then Return '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
Load()
End Set
End Property
@@ -82,7 +82,7 @@
End Get
Set(value As String)
If value = "" Then value = Nothing
If _ActualSource = value Then Exit Property
If _ActualSource = value Then Return
_ActualSource = value
Try
Dim Bitmap As MyBitmap = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件
@@ -103,12 +103,12 @@
'空
If Source Is Nothing Then
ActualSource = Nothing
Exit Sub
Return
End If
'本地图片
If Not Source.StartsWithF("http") Then
ActualSource = Source
Exit Sub
Return
End If
'从缓存加载网络图片
Dim Url As String = Source
@@ -118,7 +118,7 @@
Dim EnableCache As Boolean = Me.EnableCache
If EnableCache AndAlso TempFile.Exists Then
ActualSource = TempPath
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
End If
RunInNewThread(
Sub()
@@ -159,19 +159,19 @@ RetryStart:
'空
If Url Is Nothing Then
ActualSource = Nothing
Exit Sub
Return
End If
'本地图片
If Not Url.StartsWithF("http") Then
ActualSource = Url
Exit Sub
Return
End If
'从缓存加载网络图片
TempPath = GetTempPath(Url)
TempFile = New FileInfo(TempPath)
If EnableCache AndAlso TempFile.Exists() Then
ActualSource = TempPath
If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Return '无需刷新缓存
End If
'下载
If Source = Url Then Thread.Sleep(1000) '延迟 1s 重试
@@ -197,7 +197,7 @@ Public Class MyListItem
Return _Info
End Get
Set(value As String)
If _Info = value Then Exit Property
If _Info = value Then Return
value = value.Replace(vbCr, "").Replace(vbLf, "")
_Info = value
LabInfo.Text = value
@@ -212,7 +212,7 @@ Public Class MyListItem
Return _Logo
End Get
Set(value As String)
If _Logo = value Then Exit Property
If _Logo = value Then Return
_Logo = value
'删除旧 Logo
If Not IsNothing(PathLogo) Then Children.Remove(PathLogo)
@@ -297,7 +297,7 @@ Public Class MyListItem
Return _Type
End Get
Set(value As CheckType)
If _Type = value Then Exit Property
If _Type = value Then Return
_Type = value
'切换左栏大小
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
@@ -345,7 +345,7 @@ Public Class MyListItem
Return _Checked
End Get
Set(value As Boolean)
SetChecked(value, False, True)
SetChecked(value, False, value <> _Checked) '仅在值发生变化时触发动画 (#4596)
End Set
End Property
''' <summary>
@@ -367,31 +367,31 @@ Public Class MyListItem
RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then
_Checked = RawValue
Exit Sub
Return
End If
End If
_Checked = value
Else
If value = _Checked Then Exit Sub
If value = _Checked Then Return
_Checked = value
If IsInitialized Then
RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then
_Checked = RawValue
Exit Sub
Return
End If
End If
End If
If value Then
Dim CheckEventArgs As New RouteEventArgs(user)
RaiseEvent Check(Me, CheckEventArgs)
If CheckEventArgs.Handled Then Exit Sub
If CheckEventArgs.Handled Then Return
End If
'保证只有一个单选 ListItem 选中
If Type = CheckType.RadioBox Then
If IsNothing(Parent) Then Exit Sub
If IsNothing(Parent) Then Return
Dim RadioboxList As New List(Of MyListItem)
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
@@ -502,15 +502,15 @@ Public Class MyListItem
'触发点击事件
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If Not IsMouseDown Then Exit Sub
If Not IsMouseDown Then Return
RaiseEvent Click(sender, e)
If e.Handled Then Exit Sub
If e.Handled Then Return
'触发自定义事件
If Not String.IsNullOrEmpty(EventType) Then
ModEvent.TryStartEvent(EventType, EventData)
e.Handled = True
End If
If e.Handled Then Exit Sub
If e.Handled Then Return
'实际的单击处理
Select Case Type
Case CheckType.Clickable
@@ -581,7 +581,7 @@ Public Class MyListItem
Time = 180
End If
End If
If StateLast = StateNew Then Exit Sub
If StateLast = StateNew Then Return
StateLast = StateNew
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
@@ -35,7 +35,7 @@ Public Class MyLoading
Return _ShowProgress
End Get
Set(value As Boolean)
If _ShowProgress = value Then Exit Property
If _ShowProgress = value Then Return
_ShowProgress = value
RefreshText()
End Set
@@ -82,7 +82,7 @@ Public Class MyLoading
LabText.Text = StrTrim(Ex.Message)
If {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) LabText.Text.Contains(s)) Then
LabText.Text = "网络环境不佳,请重试或尝试使用 VPN"
LabText.Text = "网络环境不佳,请稍后重试,或使用 VPN 以改善网络环境"
End If
End If
Else
@@ -142,7 +142,7 @@ Public Class MyLoading
Return _OuterState
End Get
Set(value As MyLoadingState)
If _OuterState = value Then Exit Property
If _OuterState = value Then Return
Dim OldValue = _OuterState
_OuterState = value
'引发事件
@@ -159,7 +159,7 @@ Public Class MyLoading
Return _InnerState
End Get
Set(value As MyLoadingState)
If _InnerState = value Then Exit Property
If _InnerState = value Then Return
Dim OldValue = _InnerState
_InnerState = value
'引发事件
@@ -183,7 +183,7 @@ Public Class MyLoading
Private IsLooping As Boolean = False
Private Sub AniLoop()
'这坨循环代码也是老屎坑了,救救.jpg
If Not HasAnimation OrElse IsLooping OrElse Not InnerState = MyLoadingState.Run OrElse AniSpeed > 10 OrElse Not IsLoaded Then Exit Sub
If Not HasAnimation OrElse IsLooping OrElse Not InnerState = MyLoadingState.Run OrElse AniSpeed > 10 OrElse Not IsLoaded Then Return
IsLooping = True
ErrorAnimationWaiting = True
AniStart({
@@ -271,7 +271,7 @@ Public Class MyLoadingStateSimulator
Return _LoadingState
End Get
Set(value As MyLoadingState)
If _LoadingState = value Then Exit Property
If _LoadingState = value Then Return
Dim OldState = _LoadingState
_LoadingState = value
RaiseEvent LoadingStateChanged(value, OldState)
@@ -37,7 +37,7 @@
Time = AnimationTimeOut
End If
'重复性验证
If ColorName = BackName Then Exit Sub
If ColorName = BackName Then Return
ColorName = BackName
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
@@ -72,13 +72,14 @@
End Sub
Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited OrElse Not TextArea.IsValidated Then Exit Sub
TextArea.Validate() '#5773
If MyConverter.IsExited OrElse Not TextArea.IsValidated Then Return
MyConverter.IsExited = True
MyConverter.Result = TextArea.Text
Close()
End Sub
Public Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
If MyConverter.IsExited Then Return
MyConverter.IsExited = True
MyConverter.Result = Nothing
Close()
@@ -77,13 +77,13 @@
End Sub
Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited OrElse SelectedIndex = -1 Then Exit Sub
If MyConverter.IsExited OrElse SelectedIndex = -1 Then Return
MyConverter.IsExited = True
MyConverter.Result = SelectedIndex
Close()
End Sub
Public Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
If MyConverter.IsExited Then Return
MyConverter.IsExited = True
MyConverter.Result = Nothing
Close()
@@ -70,7 +70,7 @@
End Sub
Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited Then Exit Sub
If MyConverter.IsExited Then Return
If MyConverter.Button1Action IsNot Nothing Then
MyConverter.Button1Action()
Else
@@ -80,7 +80,7 @@
End If
End Sub
Public Sub Btn2_Click() Handles Btn2.Click
If MyConverter.IsExited Then Exit Sub
If MyConverter.IsExited Then Return
If MyConverter.Button2Action IsNot Nothing Then
MyConverter.Button2Action()
Else
@@ -90,7 +90,7 @@
End If
End Sub
Public Sub Btn3_Click() Handles Btn3.Click
If MyConverter.IsExited Then Exit Sub
If MyConverter.IsExited Then Return
If MyConverter.Button3Action IsNot Nothing Then
MyConverter.Button3Action()
Else
@@ -39,16 +39,17 @@
Element.Opacity = 0
Element.RenderTransform = New TranslateTransform(-25, 0)
If TypeOf Element Is MyListItem Then CType(Element, MyListItem).IsMouseOverAnimationEnabled = False
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 200, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 100, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaTranslateX(Element, 5, 200, Delay, New AniEaseOutFluent))
AniList.Add(AaTranslateX(Element, 20, 300, Delay, New AniEaseOutBack(AniEasePower.Weak)))
If TypeOf Element Is MyListItem Then
AniList.Add(AaCode(Sub()
AniList.Add(AaCode(
Sub()
CType(Element, MyListItem).IsMouseOverAnimationEnabled = True
CType(Element, MyListItem).RefreshColor(Me, New EventArgs)
End Sub, Delay + 280))
End If
Delay += Math.Max(8, 20 - Id) * 2.5
Delay += Math.Max(15 - Id, 7) * 2
Id += 1
End If
Next
@@ -63,8 +64,8 @@
RenderTransformOrigin = New Point(0.5, 0.5)
End If
AniStart({
AaScaleTransform(Me, 0.95 - CType(RenderTransform, ScaleTransform).ScaleX, 130,, New AniEaseInFluent(AniEasePower.Weak)),
AaOpacity(Me, -Opacity, 100, 30)
AaScaleTransform(Me, 0.95 - CType(RenderTransform, ScaleTransform).ScaleX, 110,, New AniEaseInFluent(AniEasePower.Weak)),
AaOpacity(Me, -Opacity, 80, 30)
}, "PageLeft PageChange " & Uuid)
Else
'逐个退出动画
@@ -72,8 +73,8 @@
Dim Id As Integer = 0
Dim Controls = GetAllAnimControls()
For Each Element As FrameworkElement In Controls
AniList.Add(AaOpacity(Element, -Element.Opacity, 60, 80 / Controls.Count * Id))
AniList.Add(AaTranslateX(Element, -6, 60, 80 / Controls.Count * Id))
AniList.Add(AaOpacity(Element, -Element.Opacity, 50, 70 / Controls.Count * Id))
AniList.Add(AaTranslateX(Element, -6, 50, 70 / Controls.Count * Id))
Id += 1
Next
AniStart(AniList, "PageLeft PageChange " & Uuid)
@@ -87,7 +88,7 @@
Return AllControls
End Function
Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Return
If TypeOf Element Is MyTextButton Then
AllControls.Add(Element)
ElseIf TypeOf Element Is MyListItem Then
+11 -11
View File
@@ -33,7 +33,7 @@
Return _PageState
End Get
Set(value As PageStates)
If _PageState = value Then Exit Property
If _PageState = value Then Return
_PageState = value
If ModeDebug Then Log("[UI] 页面状态切换为 " & GetStringFromEnum(value))
End Set
@@ -106,7 +106,7 @@
End Sub
'重试
Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
If Not PageLoaderAutoRun Then Exit Sub
If Not PageLoaderAutoRun Then Return
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
Else
@@ -187,7 +187,7 @@
''' 需要立即切换至 Empty。
''' </summary>
Public Sub PageOnForceExit()
If PageState = PageStates.Empty Then Exit Sub
If PageState = PageStates.Empty Then Return
If ModeDebug Then Log("[UI] 已触发 PageOnForceExit")
PageState = PageStates.Empty
AniStop("PageRight PageChange " & PageUuid)
@@ -302,7 +302,7 @@
Private Sub PageLoaderState(sender As Object, NewState As LoadState, OldState As LoadState)
Select Case NewState
Case LoadState.Failed, LoadState.Loading
If OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Exit Sub
If OldState = LoadState.Failed OrElse OldState = LoadState.Loading Then Return
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Start/Refresh)")
'(重新)开始运行
'需要从部分状态切换到 ReloadExit
@@ -314,7 +314,7 @@
PageState = PageStates.ContentExit
End Select
Case LoadState.Finished, LoadState.Aborted, LoadState.Waiting
If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Exit Sub
If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Abort)")
'运行结束
'需要从 LoaderWait 切换到 ContentEnter,或从 LoaderStay 切换到 LoaderExit
@@ -358,10 +358,10 @@
Else
Control.Opacity = 0
Control.RenderTransform = New TranslateTransform(0, -16)
AniList.Add(AaOpacity(Control, 1, 150, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaOpacity(Control, 1, 100, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaTranslateY(Control, 5, 250, Delay, New AniEaseOutFluent))
AniList.Add(AaTranslateY(Control, 11, 350, Delay, New AniEaseOutBack))
Delay += 40
Delay += 25
End If
Next
Next
@@ -387,9 +387,9 @@
CType(Control, MyExtraTextButton).Show = False
Else
Control.IsHitTestVisible = False
AniList.Add(AaOpacity(Control, -1, 90, Delay))
AniList.Add(AaTranslateY(Control, -6, 90, Delay))
Delay += 20
AniList.Add(AaOpacity(Control, -1, 70, Delay))
AniList.Add(AaTranslateY(Control, -6, 70, Delay))
Delay += 15
End If
Next
Next
@@ -423,7 +423,7 @@
Return AllControls.Except(DisabledPageAnimControls)
End Function
Private Sub _GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Return
If TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint OrElse TypeOf Element Is MyExtraTextButton OrElse TypeOf Element Is TextBlock OrElse TypeOf Element Is MyTextButton Then
AllControls.Add(Element)
ElseIf TypeOf Element Is ContentControl Then
@@ -41,7 +41,7 @@ Public Class MyRadioBox
RaiseEvent PreviewCheck(Me, e)
If e.Handled Then
Radiobox_MouseLeave()
Exit Sub
Return
End If
End If
@@ -54,7 +54,7 @@ Public Class MyRadioBox
End If
'保证只有一个单选框选中
If Parent Is Nothing Then Exit Sub
If Parent Is Nothing Then Return
Dim RadioboxList As New List(Of MyRadioBox)
Dim CheckedCount As Integer = 0
For Each Control In CType(Parent, Object).Children '收集控件列表与选中个数
@@ -172,7 +172,7 @@ Public Class MyRadioBox
Private MouseDowned As Boolean = False
Private AllowMouseDown As Boolean = True
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Exit Sub
If Not MouseDowned Then Return
Log("[Control] 按下单选框:" & Text)
SetChecked(True, True)
MouseDowned = False
@@ -187,7 +187,7 @@ Public Class MyRadioBox
End If
End Sub
Private Sub Radiobox_MouseLeave() Handles Me.MouseLeave
If Not MouseDowned Then Exit Sub
If Not MouseDowned Then Return
MouseDowned = False
AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
If Not Checked Then
@@ -224,7 +224,7 @@ Public Class MyRadioBox
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn), "MyRadioBox TextColor " & Uuid)
End Sub
Private Sub Radiobox_MouseLeaveAnimation() Handles Me.MouseLeave
If Not Me.IsEnabled Then Exit Sub 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
If Not Me.IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
If IsLoaded AndAlso AniControlEnabled = 0 Then
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
@@ -62,7 +62,7 @@ Public Class MyRadioButton
'保证只有一个单选框选中
If IsNothing(Parent) Then Exit Sub
If IsNothing(Parent) Then Return
Dim RadioboxList As New List(Of MyRadioButton)
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
@@ -101,7 +101,7 @@ Public Class MyRadioButton
'更改动画
If Not IsChanged Then Exit Sub
If Not IsChanged Then Return
RefreshColor(Nothing, anime)
'触发事件
@@ -147,17 +147,17 @@ Public Class MyRadioButton
Public Event PreviewClick(sender As Object, e As RouteEventArgs)
Private IsMouseDown As Boolean = False
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Checked Then Exit Sub
If Not IsMouseDown Then Exit Sub
If Checked Then Return
If Not IsMouseDown Then Return
Log("[Control] 按下单选按钮:" & Text)
IsMouseDown = False
Dim e As New RouteEventArgs(True)
RaiseEvent PreviewClick(Me, e)
If e.Handled Then Exit Sub
If e.Handled Then Return
SetChecked(True, True, True)
End Sub
Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
If Checked Then Exit Sub
If Checked Then Return
IsMouseDown = True
RefreshColor()
End Sub
+2 -2
View File
@@ -301,7 +301,7 @@ Public Class MyResizer
End Sub
Private Sub updateMouseDown()
Dim flag As Boolean = Mouse.LeftButton = MouseButtonState.Released
Dim flag = (GetAsyncKeyState(&H1) And &H8000) = 0 '调用原生API判断鼠标是否抬起,如果使用WPF的API的话鼠标不在窗口上时不会更新状态 (#5655)
If flag Then
resizeRight = False
resizeLeft = False
@@ -311,5 +311,5 @@ Public Class MyResizer
End Sub
Private Declare Function GetCursorPos Lib "user32.dll" (<Out()> ByRef lpPoint As PointAPI) As Boolean
Private Declare Function GetAsyncKeyState Lib "user32.dll" (vKey As Integer) As Short
End Class
@@ -6,16 +6,15 @@
Private RealOffset As Double
Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Exit Sub
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Return
Dim SourceType = e.Source.GetType
If Content.TemplatedParent Is Nothing AndAlso (
(GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse
TypeOf e.Source Is CheckBox
) Then
TypeOf e.Source Is CheckBox) Then
'如果当前是在对有滚动条的下拉框或文本框执行,则不接管操作
Exit Sub
Return
End If
e.Handled = True
PerformVerticalOffsetDelta(-e.Delta)
@@ -14,7 +14,7 @@
Return _MaxValue
End Get
Set(value As Integer)
If value = _MaxValue Then Exit Property
If value = _MaxValue Then Return
_MaxValue = value
RefreshWidth(Nothing, Nothing)
End Set
@@ -29,7 +29,7 @@
Try
newValue = MathClamp(newValue, 0, MaxValue)
If _Value = newValue Then Exit Property
If _Value = newValue Then Return
'触发 Preview 事件,修改新值
Dim OldValue = _Value
@@ -40,12 +40,12 @@
If e.Handled Then
_Value = OldValue
DragStop()
Exit Property
Return
End If
End If
If IsLoaded AndAlso AniControlEnabled = 0 Then
If ActualWidth < ShapeDot.Width Then Exit Property
If ActualWidth < ShapeDot.Width Then Return
Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - ShapeDot.Width)
Dim DeltaProcess As Double = Math.Abs(LineFore.Width / (ActualWidth - ShapeDot.Width) - _Value / MaxValue)
Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 300 + If(ChangeByKey, 100, 0)
@@ -103,7 +103,7 @@
Popup.IsOpen = False
End Sub
Public Sub RefreshPopup()
If GetHintText Is Nothing Then Exit Sub
If GetHintText Is Nothing Then Return
Popup.IsOpen = True
TextHint.Text = GetHintText.DynamicInvoke(Value)
Dim typeface As New Typeface(TextHint.FontFamily, TextHint.FontStyle, TextHint.FontWeight, TextHint.FontStretch)
@@ -165,7 +165,7 @@
End Sub
Private Sub MySlider_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
'拒绝一边拖动一边用按键改变
If ReferenceEquals(Me, DragControl) Then Exit Sub
If ReferenceEquals(Me, DragControl) Then Return
'改变值
If e.Key = Key.Left Then
ChangeByKey = True
@@ -178,7 +178,7 @@
ChangeByKey = False
e.Handled = True
Else
Exit Sub
Return
End If
'更新 Popup
If GetHintText IsNot Nothing Then
+5 -5
View File
@@ -36,7 +36,7 @@
End Property
Public Overrides Sub OnApplyTemplate()
MyBase.OnApplyTemplate()
If HintText = "" OrElse labHint.Text <> "" Then Exit Sub
If HintText = "" OrElse labHint.Text <> "" Then Return
labHint.Text = If(Text = "", HintText, "")
End Sub
@@ -217,11 +217,11 @@
IsTextChanged = IsLoaded
'进行输入验证
Validate()
If Not IsValidated Then Exit Sub
If Not IsValidated Then Return
'改变文本
RaiseEvent ValidatedTextChanged(sender, e)
Catch ex As Exception
Log(ex, "进行输入验证时出错", LogLevel.Assert)
Log(ex, "进行输入验证时出错", LogLevel.Critical)
End Try
End Sub
@@ -230,7 +230,7 @@
Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.GotFocus, Me.LostFocus
Try
'不对 ComboBox 从属进行动画
If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Exit Sub
If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Return
'判断当前颜色
Dim ForeColorName As String, BackColorName As String
Dim AnimationTime As Integer
@@ -280,7 +280,7 @@
End Sub
Private Sub RefreshTextColor() Handles Me.IsEnabledChanged
Dim NewColor As MyColor = If(IsEnabled, ColorGray1, ColorGray4)
If CType(Foreground, SolidColorBrush).Color.R = NewColor.R Then Exit Sub
If CType(Foreground, SolidColorBrush).Color.R = NewColor.R Then Return
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not Text = "" Then
'有动画
AniStart({AaColor(Me, ForegroundProperty, If(IsEnabled, "ColorBrushGray1", "ColorBrushGray4"), 200)}, "MyTextBox TextColor " & Uuid)
@@ -72,7 +72,7 @@
Time = AnimationTimeOut
End If
'重复性验证
If ColorName = ForeName Then Exit Sub
If ColorName = ForeName Then Return
ColorName = ForeName
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
+8 -10
View File
@@ -99,9 +99,7 @@
<Grid x:Name="PanTitle" Height="48">
<Grid.Background>
<LinearGradientBrush EndPoint="1,0" StartPoint="0,0">
<GradientStop Color="{StaticResource ColorObject3}" Offset="0"/>
<GradientStop Color="{StaticResource ColorObject2}" Offset="0.5"/>
<GradientStop Color="{StaticResource ColorObject3}" Offset="1"/>
<GradientStop Color="{StaticResource ColorObject4}" Offset="0"/>
</LinearGradientBrush>
</Grid.Background>
<local:MyImage x:Name="ImgTitle" IsHitTestVisible="False" Stretch="UniformToFill" IsEnabled="False" RenderOptions.BitmapScalingMode="LowQuality" />
@@ -115,19 +113,19 @@
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Path x:Name="ShapeTitleLogo" Data="M26,29 v-25 h5 a7,7 180 0 1 0,14 h-5 M61,6.5 a10,11.5 180 1 0 0,18 M68,2.5 v24.5 h12 M98,2 v27 M107,2 v27" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="19,15.5,0,15.5" Stretch="fill" Stroke="White" StrokeThickness="1.9" Width="53" />
<Path x:Name="ShapeTitleLogo" Data="M26,29 v-25 h6 a7,7 180 0 1 0,14 h-6 M62.5,6.5 a10,11.5 180 1 0 0,18 M71,2.5 v24.5 h13.5" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="19,15.5,0,15.5" Stretch="fill" Stroke="White" StrokeThickness="2.2" Width="39" />
<TextBlock x:Name="LabTitleLogo" Visibility="Collapsed" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="18,0,0,0" Foreground="White" FontSize="17" VerticalAlignment="Center" />
<local:MyImage x:Name="ImageTitleLogo" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="7" VerticalAlignment="Center" Visibility="Collapsed" />
<StackPanel Grid.Column="1" x:Name="PanTitleSelect" HorizontalAlignment="Left" Height="27" VerticalAlignment="Center" Orientation="Horizontal" Margin="13,0">
<local:MyRadioButton x:Name="BtnTitleSelect0" Text="{DynamicResource LangTitleHome}" Tag="0" Margin="5,0" Checked="True" Padding="2,0"
LogoScale="0.95" Logo="M985.403 552.96C985.403 812.702 773.041 1024 512 1024S38.597 812.702 38.597 552.96c0-158.208 79.163-304.955 211.771-392.625 31.074-20.52 72.94-11.973 93.46 19.101s12.012 72.94-19.062 93.46c-94.681 62.622-151.237 167.306-151.237 280.064 0 185.344 151.788 336.108 338.471 336.108S850.471 738.304 850.471 552.96c0-114.649-57.974-220.278-155.096-282.585-31.35-20.125-40.448-61.833-20.362-93.184s61.794-40.448 93.184-20.4c135.995 87.236 217.206 235.362 217.206 396.169zM512 560.128c37.258 0 67.466-30.208 67.466-67.466V67.466C579.466 30.208 549.258 0 512 0s-67.466 30.208-67.466 67.466v425.196c0 37.258 30.208 67.466 67.466 67.466z" />
<local:MyRadioButton x:Name="BtnTitleSelect1" Text="{DynamicResource LangTitleDownload}" Tag="1" Margin="5,0" Padding="2,0"
<local:MyRadioButton x:Name="BtnTitleSelect0" Text="启动" Tag="0" Margin="5,0" Checked="True" Padding="2,0"
LogoScale="0.9" Logo="M52.1,164.5c-1.4,0-3.1-0.5-4.2-1.3c-2.6-1.7-4-4.2-4-7V43.8c0-2.9,1.6-5.8,4.1-7c1.2-0.8,2.7-1.2,4.1-1.2c1.5,0,2.9,0.4,4.2,1.2L153.1,93c0,0,0.1,0,0.1,0.1c2.6,1.7,4,4.2,4,7c0,3-1.7,5.8-4.2,7.1l-96.8,56.2C55.1,164,53.5,164.5,52.1,164.5z M60.4,142.1l72.1-42.1L60.4,58.2V142.1z" />
<local:MyRadioButton x:Name="BtnTitleSelect1" Text="下载" Tag="1" Margin="5,0" Padding="2,0"
LogoScale="0.9" Logo="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" />
<local:MyRadioButton x:Name="BtnTitleSelect2" Text="联机" Tag="2" Margin="5,0" Padding="2,0"
LogoScale="1.05" Logo="M512 817c-48.601 0-88-39.399-88-88s39.399-88 88-88 88 39.399 88 88-39.399 88-88 88zM237.671 565.74C308.335 474.58 397.369 429 504.774 429c118.433 0 214.225 55.421 287.377 166.264l-53.407 30.369c-13.84 7.87-31.362 4.367-41.114-8.219-50.291-64.911-114.577-97.367-192.856-97.367-86.851 0-156.835 40.318-209.95 120.953l-47.995-28.02c-15.263-8.91-20.412-28.507-11.502-43.77a32 32 0 0 1 2.344-3.47zM107.691 419.47C205.24 278.491 337.805 208 505.379 208c178.77 0 317.694 80.224 416.772 240.672l-56.54 31.73c-13.686 7.68-30.922 4.303-40.697-7.975C735.581 360.213 629.07 303.009 505.38 300.815 373.997 298.485 261.637 362.88 168.3 494l-50.116-28.505c-15.362-8.738-20.732-28.275-11.994-43.637a32 32 0 0 1 1.5-2.387z"/>
<local:MyRadioButton x:Name="BtnTitleSelect3" Text="{DynamicResource LangTitleSetup}" Tag="3" Margin="5,0" Padding="2,0"
<local:MyRadioButton x:Name="BtnTitleSelect3" Text="设置" Tag="3" Margin="5,0" Padding="2,0"
LogoScale="1.1" Logo="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"/>
<local:MyRadioButton x:Name="BtnTitleSelect4" Text="{DynamicResource LangTitleOther}" Tag="4" Margin="5,0" Padding="2,0"
<local:MyRadioButton x:Name="BtnTitleSelect4" Text="更多" Tag="4" Margin="5,0" Padding="2,0"
LogoScale="0.93" Logo="M364 0h-273C40 0 0 40 0 91v273C0 414 40 455 91 455h273C414 455 455 414 455 364V91C455 40 414 0 364 0zM341 341H113V113h227v227zM933 0h-273C609 0 568 40 568 91v273c0 50 40 91 91 91h273C983 455 1024 414 1024 364V91c0-50-40-91-90-91zM910 341h-227V113h227v227zM364 568h-273C40 568 0 609 0 659v273c0 50 40 91 91 91h273C414 1024 455 983 455 932v-273C455 609 414 568 364 568zM341 910H113v-227h227v227zM933 568h-273c-50 0-91 40-91 91v273c0 50 40 91 91 91h273c50 0 90-40 90-91v-273c0-50-40-90-90-90zM910 910h-227v-227h227v227z"/>
</StackPanel>
</Grid>
@@ -145,7 +143,7 @@
<Rectangle x:Name="RectLeftBackground" Width="0" Fill="{DynamicResource ColorBrushBackgroundTransparentSidebar}" IsHitTestVisible="False" />
<Rectangle x:Name="RectLeftShadow" Width="4" HorizontalAlignment="Left" IsHitTestVisible="False" Grid.Column="1" >
<Rectangle.Fill>
<LinearGradientBrush EndPoint="1,0" StartPoint="0,0" Opacity="0.085">
<LinearGradientBrush EndPoint="1,0" StartPoint="0,0" Opacity="0.04">
<GradientStop Color="#000000" Offset="0"/>
<GradientStop Color="#00000000" Offset="1"/>
</LinearGradientBrush>
+127 -74
View File
@@ -10,6 +10,20 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 357 Then 'Release 2.10.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:下载资源包、光影包、数据包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:允许设置文件下载源"))
FeatureCount += 9
BugCount += 26
End If
If LastVersion < 355 Then 'Release 2.9.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:Minecraft 会优先使用独立显卡运行"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:简化下载新版本第二步的 UI"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:使用新的版本隔离策略"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:添加了在全局启动设置与版本独立设置之间互相跳转的按钮"))
FeatureCount += 20
BugCount += 28
End If
If LastVersion < 352 Then 'Release 2.9.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:导出整合包功能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:支持在超长路径下安装、启动游戏"))
@@ -58,6 +72,26 @@ Public Class FormMain
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 358 Then 'Snapshot 2.10.1
If LastVersion >= 356 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:下载资源包、光影包时能自动跳转到对应的文件夹"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:调整界面样式与动画,让整体视觉更干净,操作体验更顺滑"))
FeatureCount += 25
BugCount += 23
End If
If LastVersion < 356 Then 'Snapshot 2.10.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:下载资源包、光影包、数据包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:允许设置文件下载源"))
FeatureCount += 9
BugCount += 26
End If
If LastVersion < 354 Then 'Snapshot 2.9.3
If LastVersion = 352 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:低版本 MC 没有声音"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:若不安装 Mod 加载器,则无法安装 OptiFine 1.14+"))
End If
FeatureCount += 8
BugCount += 8
End If
If LastVersion < 352 Then 'Snapshot 2.9.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:Minecraft 会优先使用独立显卡运行"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:简化下载新版本第二步的 UI"))
@@ -129,7 +163,7 @@ Public Class FormMain
'整理更新日志文本
Dim ContentList As New List(Of String)
Dim SortedFeatures = FeatureList.OrderByDescending(Function(f) f.Key).ToList
If Not SortedFeatures.Any() AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then ContentList.Add("龙猫忘记写更新日志啦!可以去提醒他一下……")
If Not SortedFeatures.Any() AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then ContentList.Add("没有更新日志……")
For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项
ContentList.Add(SortedFeatures(i).Value)
Next
@@ -183,6 +217,9 @@ Public Class FormMain
'刷新主题
ThemeCheckAll(False)
Setup.Load("UiLauncherTheme")
'注册拖拽事件(不能直接加 Handles,否则没用;#6340)
[AddHandler](DragDrop.DragEnterEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True)
[AddHandler](DragDrop.DragOverEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True)
'加载 UI
InitializeComponent()
Opacity = 0
@@ -239,7 +276,7 @@ Public Class FormMain
Resizer.addResizerUp(ResizerT)
'PLC 彩蛋
If RandomInteger(1, 1000) = 233 Then
ShapeTitleLogo.Data = New GeometryConverter().ConvertFromString("M26,29 v-25 h5 a7,7 180 0 1 0,14 h-5 M80,6.5 a10,11.5 180 1 0 0,18 M47,2.5 v24.5 h12 M98,2 v27 M107,2 v27")
ShapeTitleLogo.Data = New GeometryConverter().ConvertFromString("M26,29 v-25 h6 a7,7 180 0 1 0,14 h-6 M83,6.5 a10,11.5 180 1 0 0,18 M48,2.5 v24.5 h13.5")
End If
'加载窗口
ThemeRefreshMain()
@@ -295,8 +332,8 @@ Public Class FormMain
'启动加载器池
Try
JavaListInit() '延后到同意协议后再执行,避免在初次启动时进行进程操作
Thread.Sleep(200)
DlClientListMojangLoader.Start(1)
Thread.Sleep(100)
DlClientListMojangLoader.Start(1) 'PCL 会同时根据这里的加载结果决定是否使用官方源进行下载
RunCountSub()
ServerLoader.Start(1)
RunInNewThread(AddressOf TryClearTaskTemp, "TryClearTaskTemp", ThreadPriority.BelowNormal)
@@ -405,8 +442,8 @@ Public Class FormMain
Log("[Start] 已从老版本迁移 Mod 命名设置")
End If
'输出更新日志
If LastVersionCode <= 0 Then Exit Sub
If LowerVersionCode >= VersionCode Then Exit Sub
If LastVersionCode <= 0 Then Return
If LowerVersionCode >= VersionCode Then Return
ShowUpdateLog(LowerVersionCode)
End Sub
Private Sub DowngradeSub(LastVersionCode As Integer)
@@ -440,7 +477,7 @@ Public Class FormMain
Next
End Sub, "强行停止下载任务")
Else
Exit Sub
Return
End If
End If
'关闭
@@ -480,8 +517,6 @@ Public Class FormMain
On Error Resume Next
IsProgramEnded = True
AniControlEnabled += 1
PageLinkIoi.IoiStop(False)
PageLinkHiper.HiperStop(False)
If IsUpdateWaitingRestart Then UpdateRestart(False)
If ReturnCode = ProcessReturnValues.Exception Then
If Not IsLogShown Then
@@ -492,14 +527,10 @@ Public Class FormMain
End If
Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉
End If
Log("[System] 程序已退出,返回值:" & GetStringFromEnum(CType(ReturnCode, [Enum])))
Log("[System] 程序已退出,返回值:" & GetStringFromEnum(ReturnCode))
LogFlush()
If ReturnCode = ProcessReturnValues.Success Then
If ReturnCode <> ProcessReturnValues.Success Then Environment.Exit(ReturnCode)
Process.GetCurrentProcess.Kill()
Else
Environment.Exit(ReturnCode)
Process.GetCurrentProcess.Kill()
End If
End Sub
Private Sub BtnTitleClose_Click(sender As Object, e As RoutedEventArgs) Handles BtnTitleClose.Click
EndProgram(True)
@@ -540,12 +571,12 @@ Public Class FormMain
'按键事件
Private Sub FormMain_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If e.IsRepeat Then Exit Sub
If e.IsRepeat Then Return
'调用弹窗:回车选择第一个,Esc 选择最后一个
If PanMsg.Children.Count > 0 Then
If e.Key = Key.Enter Then
CType(PanMsg.Children(0), Object).Btn1_Click()
Exit Sub
Return
ElseIf e.Key = Key.Escape Then
Dim Msg As Object = PanMsg.Children(0)
If TypeOf Msg IsNot MyMsgInput AndAlso TypeOf Msg IsNot MyMsgSelect AndAlso Msg.Btn3.Visibility = Visibility.Visible Then
@@ -555,7 +586,7 @@ Public Class FormMain
Else
Msg.Btn1_Click()
End If
Exit Sub
Return
End If
End If
'按 ESC 返回上一级
@@ -564,7 +595,7 @@ Public Class FormMain
If e.Key = Key.F11 AndAlso PageCurrent = FormMain.PageType.VersionSelect Then
FrmSelectRight.ShowHidden = Not FrmSelectRight.ShowHidden
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Exit Sub
Return
End If
'更改功能隐藏可见性
If e.Key = Key.F12 Then
@@ -575,13 +606,13 @@ Public Class FormMain
Hint("功能隐藏设置已重新开启!", HintType.Finish)
End If
PageSetupUI.HiddenRefresh()
Exit Sub
Return
End If
'按 F5 刷新页面
If e.Key = Key.F5 Then
If TypeOf PageLeft Is IRefreshable Then CType(PageLeft, IRefreshable).Refresh()
If TypeOf PageRight Is IRefreshable Then CType(PageRight, IRefreshable).Refresh()
Exit Sub
Return
End If
'调用启动游戏
If e.Key = Key.Enter AndAlso PageCurrent = FormMain.PageType.Launch Then
@@ -596,7 +627,7 @@ Public Class FormMain
End Sub
Private Sub FormMain_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseDown
'鼠标侧键返回上一级
If FrmMain.PanMsg.Children.Count > 0 OrElse WaitingMyMsgBox.Any Then Exit Sub '弹窗中(#5513)
If FrmMain.PanMsg.Children.Count > 0 OrElse WaitingMyMsgBox.Any Then Return '弹窗中(#5513)
If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack()
End Sub
Private Sub TriggerPageBack()
@@ -623,14 +654,39 @@ Public Class FormMain
End Sub
'文件拖放
Private Sub FrmMain_PreviewDragOver(sender As Object, e As DragEventArgs) Handles Me.PreviewDragOver
If e.Data.GetFormats.Contains("FileDrop") Then
e.Effects = DragDropEffects.Link
Else
e.Effects = DragDropEffects.None
Private Sub HandleDrag(sender As Object, e As DragEventArgs)
Try
If e.Handled AndAlso (e.Effects <> DragDropEffects.None) Then Return
e.Handled = True
'缓存
Static PrevData As IDataObject, PrevEffects As DragDropEffects
If e.Data Is PrevData Then
e.Effects = PrevEffects
Return
End If
'确定拖放效果
e.Effects = DragDropEffects.None
If e.Data.GetDataPresent(DataFormats.Text) Then
Dim Str As String = e.Data.GetData(DataFormats.Text)
If Str.StartsWithF("authlib-injector:yggdrasil-server:") Then
e.Effects = DragDropEffects.Copy
ElseIf Str.StartsWithF("file:///") Then
e.Effects = DragDropEffects.Copy
End If
ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then
Dim Files As String() = e.Data.GetData(DataFormats.FileDrop)
If Files IsNot Nothing AndAlso Files.Length > 0 Then
e.Effects = DragDropEffects.Link
End If
End If
PrevData = e.Data
PrevEffects = e.Effects
Log("[System] 设置拖放类型:" & GetStringFromEnum(e.Effects))
Catch ex As Exception
Log(ex, "处理拖放时出错", LogLevel.Feedback)
End Try
End Sub
Private Sub FrmMain_Drop(sender As Object, e As DragEventArgs) Handles Me.PreviewDrop
Private Sub FrmMain_Drop(sender As Object, e As DragEventArgs) Handles Me.Drop
Try
If e.Data.GetDataPresent(DataFormats.Text) Then
'获取文本
@@ -640,22 +696,23 @@ Public Class FormMain
If Str.StartsWithF("authlib-injector:yggdrasil-server:") Then
'Authlib 拖拽
e.Handled = True
e.Effects = DragDropEffects.Copy
Dim AuthlibServer As String = Net.WebUtility.UrlDecode(Str.Substring("authlib-injector:yggdrasil-server:".Length))
Log("[System] Authlib 拖拽:" & AuthlibServer)
If Not String.IsNullOrEmpty(New ValidateHttp().Validate(AuthlibServer)) Then
Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Critical)
Exit Sub
Return
End If
Dim TargetVersion = If(PageCurrent = PageType.VersionSetup, PageVersionLeft.Version, McVersionCurrent)
If TargetVersion Is Nothing Then
Hint("请先下载游戏,再设置第三方登录!", HintType.Critical)
Exit Sub
Return
End If
If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then
'LittleSkin
If MyMsgBox($"是否要在版本 {TargetVersion.Name} 中开启 LittleSkin 登录?" & vbCrLf &
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Exit Sub
Return
End If
Setup.Set("VersionServerLogin", 4, Version:=TargetVersion)
Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Version:=TargetVersion)
@@ -666,7 +723,7 @@ Public Class FormMain
If MyMsgBox($"是否要在版本 {TargetVersion.Name} 中开启第三方登录?" & vbCrLf &
$"登录服务器:{AuthlibServer}" & vbCrLf & vbCrLf &
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Exit Sub
Return
End If
Setup.Set("VersionServerLogin", 4, Version:=TargetVersion)
Setup.Set("VersionServerAuthServer", AuthlibServer, Version:=TargetVersion)
@@ -684,20 +741,22 @@ Public Class FormMain
'文件拖拽(例如从浏览器下载窗口拖入)
Dim FilePath = Net.WebUtility.UrlDecode(Str).Substring("file:///".Length).Replace("/", "\")
e.Handled = True
e.Effects = DragDropEffects.Copy
FileDrag(New List(Of String) From {FilePath})
End If
Catch ex As Exception
Log(ex, "无法接取文本拖拽事件", LogLevel.Developer)
Exit Sub
Return
End Try
ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then
'获取文件并检查
Dim FilePathRaw = e.Data.GetData(DataFormats.FileDrop)
If FilePathRaw Is Nothing Then '#2690
Hint("请将文件解压后再拖入!", HintType.Critical)
Exit Sub
Return
End If
e.Handled = True
e.Effects = DragDropEffects.Link
FileDrag(CType(FilePathRaw, IEnumerable(Of String)))
End If
Catch ex As Exception
@@ -712,10 +771,10 @@ Public Class FormMain
'基础检查
If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
Hint("请拖入一个文件,而非文件夹!", HintType.Critical)
Exit Sub
Return
ElseIf Not File.Exists(FilePathList.First) Then
Hint("拖入的文件不存在:" & FilePathList.First, HintType.Critical)
Exit Sub
Return
End If
'多文件拖拽
If FilePathList.Count > 1 Then
@@ -723,17 +782,17 @@ Public Class FormMain
For Each File In FilePathList
If Not {"jar", "litemod", "disabled", "old"}.Contains(File.AfterLast(".").ToLower) Then
Hint("一次请只拖入一个文件!", HintType.Critical)
Exit Sub
Return
End If
Next
End If
'自定义主页
'主页
Dim Extension As String = FilePath.AfterLast(".").ToLower
If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML,作为自定义主页加载")
Log("[System] 文件后缀为 XAML,作为主页加载")
If File.Exists(Path & "PCL\Custom.xaml") Then
If MyMsgBox("已存在一个自定义主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then
Exit Sub
If MyMsgBox("已存在一个主页文件,是否要将它覆盖?", "覆盖确认", "覆盖", "取消") = 2 Then
Return
End If
End If
CopyFile(FilePath, Path & "PCL\Custom.xaml")
@@ -743,18 +802,18 @@ Public Class FormMain
FrmLaunchRight.ForceRefresh()
Hint("已加载主页自定义文件!", HintType.Finish)
End Sub)
Exit Sub
Return
End If
'安装 Mod
If PageVersionMod.InstallMods(FilePathList) Then Exit Sub
If PageVersionMod.InstallMods(FilePathList) Then Return
'安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装")
Try
ModpackInstall(FilePath)
Exit Sub
Return
Catch ex As CancelledException
Exit Sub '用户主动取消
Return '用户主动取消
Catch ex As Exception
'安装失败,继续往后尝试
End Try
@@ -762,17 +821,17 @@ Public Class FormMain
'RAR 处理
If Extension = "rar" Then
Hint("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试!")
Exit Sub
Return
End If
'错误报告分析
Try
Log("[System] 尝试进行错误报告分析")
Dim Analyzer As New CrashAnalyzer(GetUuid())
Analyzer.Import(FilePath)
If Analyzer.Prepare() = 0 Then Exit Try
If Not Analyzer.Prepare() Then Exit Try
Analyzer.Analyze()
Analyzer.Output(True, New List(Of String))
Exit Sub
Return
Catch ex As Exception
Log(ex, "自主错误报告分析失败", LogLevel.Feedback)
End Try
@@ -812,7 +871,7 @@ Public Class FormMain
Return _Hidden
End Get
Set(value As Boolean)
If _Hidden = value Then Exit Property
If _Hidden = value Then Return
_Hidden = value
If value Then
'隐藏
@@ -911,6 +970,9 @@ Public Class FormMain
DownloadLiteLoader = 9
DownloadMod = 11
DownloadPack = 12
DownloadDataPack = 13
DownloadResourcePack = 14
DownloadShader = 15
SetupLaunch = 0
SetupUI = 1
SetupSystem = 2
@@ -941,18 +1003,9 @@ Public Class FormMain
Case PageType.VersionSetup
Return "版本设置 - " & If(PageVersionLeft.Version Is Nothing, "未知版本", PageVersionLeft.Version.Name)
Case PageType.CompDetail
Dim Project As CompProject = Stack.Additional(0)
Select Case Project.Type
Case CompType.Mod
Return "Mod 下载 - " & Project.TranslatedName
Case CompType.ModPack
Return "整合包下载 - " & Project.TranslatedName
Case Else 'CompType.ResourcePack
Return "资源包下载 - " & Project.TranslatedName
End Select
Return "资源下载 - " & CType(Stack.Additional(0), CompProject).TranslatedName
Case PageType.HelpDetail
Dim Entry As HelpEntry = Stack.Additional(0)
Return Entry.Title
Return CType(Stack.Additional(0), HelpEntry).Title
Case Else
Return ""
End Select
@@ -1081,7 +1134,7 @@ Public Class FormMain
''' 通过点击导航栏改变页面。
''' </summary>
Private Sub BtnTitleSelect_Click(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnTitleSelect0.Check, BtnTitleSelect1.Check, BtnTitleSelect2.Check, BtnTitleSelect3.Check, BtnTitleSelect4.Check
If IsChangingPage Then Exit Sub
If IsChangingPage Then Return
PageChangeActual(Val(sender.Tag))
End Sub
''' <summary>
@@ -1100,7 +1153,7 @@ Public Class FormMain
''' 切换现有页面的实际方法。
''' </summary>
Private Sub PageChangeActual(Stack As PageStackData, Optional SubType As PageSubType = -1)
If PageCurrent = Stack AndAlso (PageCurrentSub = SubType OrElse SubType = -1) Then Exit Sub
If PageCurrent = Stack AndAlso (PageCurrentSub = SubType OrElse SubType = -1) Then Return
AniControlEnabled += 1
Try
@@ -1219,7 +1272,7 @@ Public Class FormMain
PanMainLeft.Background = Nothing
AniControlEnabled -= 1
RunInUi(Sub() PanMainLeft_Resize(PanMainLeft.ActualWidth), True)
End Sub, 130),
End Sub, 110),
AaCode(
Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
@@ -1238,7 +1291,7 @@ Public Class FormMain
PanMainRight.Background = Nothing
AniControlEnabled -= 1
RunInUi(Sub() BtnExtraBack.ShowRefresh(), True)
End Sub, 130),
End Sub, 110),
AaCode(
Sub()
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
@@ -1271,7 +1324,7 @@ Public Class FormMain
'左边栏改变
Private Sub PanMainLeft_SizeChanged(sender As Object, e As SizeChangedEventArgs) Handles PanMainLeft.SizeChanged
If Not e.WidthChanged Then Exit Sub
If Not e.WidthChanged Then Return
PanMainLeft_Resize(e.NewSize.Width)
End Sub
Private Sub PanMainLeft_Resize(NewWidth As Double)
@@ -1281,16 +1334,16 @@ Public Class FormMain
If NewWidth > 0 Then
'宽度足够,显示
AniStart({
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 180,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 180),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 150)
}, "FrmMain LeftChange", True)
Else
'宽度不足,隐藏
AniStart({
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 180,, New AniEaseOutFluent),
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 180),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 150)
}, "FrmMain LeftChange", True)
End If
Else
@@ -1306,14 +1359,14 @@ Public Class FormMain
'在时钟中调用,使得即使鼠标在窗口外松开,也可以释放控件
Public Sub DragTick()
If DragControl Is Nothing Then Exit Sub
If DragControl Is Nothing Then Return
If Not Mouse.LeftButton = MouseButtonState.Pressed Then
DragStop()
End If
End Sub
'在鼠标移动时调用,以改变 Slider 位置
Public Sub DragDoing() Handles PanBack.MouseMove
If DragControl Is Nothing Then Exit Sub
If DragControl Is Nothing Then Return
If Mouse.LeftButton = MouseButtonState.Pressed Then
DragControl.DragDoing()
Else
@@ -1323,7 +1376,7 @@ Public Class FormMain
Public Sub DragStop()
'存在其他线程调用的可能性,因此需要确保在 UI 线程运行
RunInUi(Sub()
If DragControl Is Nothing Then Exit Sub
If DragControl Is Nothing Then Return
Dim Control = DragControl
DragControl = Nothing
Control.DragStop() '控件会在该事件中判断 DragControl,所以得放在后面
@@ -624,6 +624,26 @@ Public Module ModAnimation
Return Ease.GetValue(t)
End Function
End Class
''' <summary>
''' 以特定速度开始的平滑结束。
''' </summary>
Public Class AniEaseOutFluentWithInitial
Inherits AniEase
Private ReadOnly alpha As Double '(初速度 / 平均速度) – 1
''' <param name="InitialPixelPerSecond">初速度,px/s</param>
''' <param name="TotalSecond">总时长,s</param>
''' <param name="TotalDistance">总路程,px</param>
Public Sub New(InitialPixelPerSecond As Double, TotalSecond As Double, TotalDistance As Double)
Dim v0_norm As Double = InitialPixelPerSecond * TotalSecond / TotalDistance '归一化初速度
alpha = v0_norm - 1.0
If alpha < 0 Then alpha = 0 '初速度小于平均速度时,退化为线性
End Sub
Public Overrides Function GetValue(percent As Double) As Double
Dim p As Double = MathClamp(percent, 0, 1)
If alpha = 0 Then Return p '退化到线性
Return (alpha + 1) * p / (1 + alpha * p)
End Function
End Class
'Back / 回弹
''' <summary>
@@ -807,7 +827,7 @@ Sleeper:
Thread.Sleep(1)
Loop
Catch ex As Exception
Log(ex, "动画帧执行失败", LogLevel.Assert)
Log(ex, "动画帧执行失败", LogLevel.Critical)
End Try
End Sub, "Animation", ThreadPriority.AboveNormal)
End Sub
+60 -43
View File
@@ -1,10 +1,11 @@
Imports System.Globalization
Imports System.IO.Compression
Imports System.Reflection
Imports System.Runtime.CompilerServices
Imports System.Security.Cryptography
Imports System.Security.Principal
Imports System.Text.RegularExpressions
Imports System.Windows.Markup
Imports System.Xaml
Imports Newtonsoft.Json
Public Module ModBase
@@ -12,13 +13,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.9.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.9.2." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.10.1" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.10.1." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 352 'Release
Public Const VersionCode As Integer = 357 'Release
#Else
Public Const VersionCode As Integer = 353 'Snapshot
Public Const VersionCode As Integer = 358 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -744,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)
@@ -785,13 +785,16 @@ Public Module ModBase
End Function
'读取、写入、复制文件
''' <summary>
''' 复制文件。会自动创建文件夹、会覆盖已有的文件。
''' </summary>
Public Sub CopyFile(FromPath As String, ToPath As String)
Try
'还原文件路径
If Not FromPath.Contains(":\") Then FromPath = Path & FromPath
If Not ToPath.Contains(":\") Then ToPath = Path & ToPath
'如果复制同一个文件则跳过
If FromPath = ToPath Then Exit Sub
If FromPath = ToPath Then Return
'确保目录存在
Directory.CreateDirectory(GetPathFromFullPath(ToPath))
'复制文件
@@ -803,7 +806,6 @@ Public Module ModBase
''' <summary>
''' 读取文件,如果失败则返回空数组。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function ReadFileBytes(FilePath As String, Optional Encoding As Encoding = Nothing) As Byte()
Try
'还原文件路径
@@ -1363,7 +1365,7 @@ RetryDir:
Try
Directory.Delete(Path, True)
Catch ex As Exception
If Not RetriedDir Then
If Not RetriedDir AndAlso Not RunInUi() Then
RetriedDir = True
Log(ex, $"删除文件夹失败,将在 0.3s 后重试({Path})")
Thread.Sleep(300)
@@ -1459,7 +1461,7 @@ RetryDir:
CommonReason = "由于操作系统或显卡存在问题,导致出现错误。请尝试重启 PCL。"
ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) DescList.Any(Function(l) l.Contains(s))) Then
CommonReason = "你的网络环境不佳,导致难以连接到服务器。请检查网络,多重试几次,或尝试使用 VPN。"
CommonReason = "你的网络环境不佳,导致难以连接到服务器。请稍后重试,或使用 VPN 以改善网络环境。"
End If
'构造输出信息
@@ -1502,7 +1504,7 @@ RetryDir:
CommonReason = "由于操作系统或显卡存在问题,导致出现错误。请尝试重启 PCL。"
ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then
CommonReason = "你的网络环境不佳,导致难以连接到服务器。请检查网络,多重试几次,或尝试使用 VPN。"
CommonReason = "你的网络环境不佳,导致难以连接到服务器。请稍后重试,或使用 VPN 以改善网络环境。"
End If
'构造输出信息
@@ -1697,6 +1699,7 @@ RetryDir:
End Function
''' <summary>
''' 获取处于两个子字符串之间的部分,裁切尽可能多的内容。
''' 等效于 AfterLast 后接 BeforeFirst。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
@@ -1980,8 +1983,8 @@ RetryDir:
#Region "系统"
''' <summary>
''' 线程安全的,可以直接使用 For Each 的 List。
''' 在使用 For Each 循环时,列表的结果可能并非最新,但不会抛出异常。
''' 线程安全的 List。
''' 通过在 For Each 循环中使用一个浅表副本规避多线程操作或移除自身导致的异常。
''' </summary>
Public Class SafeList(Of T)
Inherits SynchronizedCollection(Of T)
@@ -2013,8 +2016,8 @@ RetryDir:
End Class
''' <summary>
''' 线程安全的,可以直接使用 For Each 的字典。
''' 在使用 For Each 循环时,字典的结果可能并非最新,但不会抛出异常。
''' 线程安全的字典。
''' 通过在 For Each 循环中使用一个浅表副本规避多线程操作或移除自身导致的异常。
''' </summary>
Public Class SafeDictionary(Of TKey, TValue)
Implements IDictionary(Of TKey, TValue)
@@ -2331,6 +2334,7 @@ NextElement:
''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
''' <param name="Arguments">运行参数。</param>
Public Sub ShellOnly(FileName As String, Optional Arguments As String = "")
Try
FileName = ShortenPath(FileName)
Using Program As New Process
Program.StartInfo.Arguments = Arguments
@@ -2338,6 +2342,9 @@ NextElement:
Log("[System] 执行外部命令:" & FileName & " " & Arguments)
Program.Start()
End Using
Catch ex As Exception
Log(ex, "打开文件或程序失败:" & FileName, LogLevel.Msgbox)
End Try
End Sub
''' <summary>
''' 前台运行文件并返回返回值。
@@ -2669,7 +2676,7 @@ Retry:
End Select
End If
'If Double.IsNaN(newValue) OrElse Double.IsInfinity(newValue) Then Exit Sub '安全性检查
'If Double.IsNaN(newValue) OrElse Double.IsInfinity(newValue) Then Return '安全性检查
'Select Case control.VerticalAlignment
' Case VerticalAlignment.Top, VerticalAlignment.Stretch, VerticalAlignment.Center
' control.Margin = New Thickness(control.Margin.Left, newValue, control.Margin.Right, control.Margin.Bottom)
@@ -2747,13 +2754,27 @@ Retry:
''' <summary>
''' 将 XML 转换为对应 UI 对象。
''' </summary>
Public Function GetObjectFromXML(Str As String)
Using Stream As New MemoryStream
Public Function GetObjectFromXML(Str As String) As Object
Using Stream As New MemoryStream(Encoding.UTF8.GetBytes(Str))
'类型检查
Using Reader As New XamlXmlReader(Stream)
While Reader.Read()
For Each BlackListType In {GetType(WebBrowser), GetType(Frame), GetType(MediaElement), GetType(ObjectDataProvider), GetType(XamlReader), GetType(Window), GetType(XmlDataProvider)}
If Reader.Type IsNot Nothing AndAlso BlackListType.IsAssignableFrom(Reader.Type.UnderlyingType) Then Throw New UnauthorizedAccessException($"不允许使用 {BlackListType.Name} 类型。")
If Reader.Value IsNot Nothing AndAlso Reader.Value = BlackListType.Name Then Throw New UnauthorizedAccessException($"不允许使用 {BlackListType.Name} 值。")
Next
For Each BlackListMember In {"Code", "FactoryMethod", "Static"}
If Reader.Member IsNot Nothing AndAlso Reader.Member.Name = BlackListMember Then Throw New UnauthorizedAccessException($"不允许使用 {BlackListMember} 成员。")
Next
End While
End Using
'实际的加载
Stream.Position = 0
Using Writer As New StreamWriter(Stream)
Writer.Write(Str)
Writer.Flush()
Stream.Position = 0
Return XamlReader.Load(Stream)
Return Markup.XamlReader.Load(Stream)
End Using
End Using
End Function
@@ -2828,9 +2849,10 @@ Retry:
''' </summary>
Feedback = 5
''' <summary>
''' 弹窗,结束程序。
''' 弹出 Windows 原生弹窗,要求反馈。在无法保证 WPF 窗口能正常运行时使用此级别。
''' 在第二次触发后会直接结束程序。
''' </summary>
Assert = 6
Critical = 6
End Enum
Private LogList As New StringBuilder
Private LogWritter As StreamWriter
@@ -2873,7 +2895,7 @@ Retry:
Private ReadOnly LogFlushLock As New Object '防止外部调用 LogFlush 时同时输出多次日志
Public Sub LogFlush()
On Error Resume Next
If LogWritter Is Nothing Then Exit Sub
If LogWritter Is Nothing Then Return
Dim Log As String = Nothing
SyncLock LogFlushLock
If LogList.Length > 0 Then
@@ -2889,6 +2911,7 @@ Retry:
End Sub
Private ReadOnly LogListLock As New Object '防止日志乱码,只在调试模式下启用
Private IsCriticalErrorTriggered As Boolean = False
''' <summary>
''' 输出 Log。
''' </summary>
@@ -2910,7 +2933,7 @@ Retry:
#If DEBUG Then
Console.Write(AppendText)
#End If
If IsProgramEnded OrElse Level = LogLevel.Normal Then Exit Sub
If IsProgramEnded OrElse Level = LogLevel.Normal Then Return
'去除前缀
Text = Text.RegexReplace("\[[^\]]+?\] ", "")
@@ -2937,20 +2960,17 @@ Retry:
Else
MyMsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
End If
Case LogLevel.Assert
Dim Time As Long = GetTimeTick()
Case LogLevel.Critical
If IsCriticalErrorTriggered Then
FormMain.EndProgramForce(ProcessReturnValues.Exception)
Return
End If
IsCriticalErrorTriggered = True
If CanFeedback(False) Then
If MsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
Else
MsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
End If
If GetTimeTick() - Time < 1500 Then
'弹窗无法保留
Log("[System] PCL 已崩溃:" & vbCrLf & Text)
FormMain.EndProgramForce(ProcessReturnValues.Exception)
Else
FormMain.EndProgramForce(ProcessReturnValues.Fail)
End If
End Select
End Sub
@@ -2960,7 +2980,7 @@ Retry:
''' <param name="Desc">错误描述。会在处理时在末尾加入冒号。</param>
Public Sub Log(Ex As Exception, Desc As String, Optional Level As LogLevel = LogLevel.Debug, Optional Title As String = "出现错误")
On Error Resume Next
If TypeOf Ex Is ThreadInterruptedException Then Exit Sub
If TypeOf Ex Is ThreadInterruptedException Then Return
'获取错误信息
Dim ExFull As String = Desc & ":" & GetExceptionDetail(Ex)
@@ -2977,7 +2997,7 @@ Retry:
#If DEBUG Then
Console.Write(AppendText)
#End If
If IsProgramEnded Then Exit Sub
If IsProgramEnded Then Return
'输出提示
Select Case Level
@@ -3006,20 +3026,17 @@ Retry:
Else
MyMsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
End If
Case LogLevel.Assert
Dim Time As Long = GetTimeTick()
Case LogLevel.Critical
If IsCriticalErrorTriggered Then
FormMain.EndProgramForce(ProcessReturnValues.Exception)
Return
End If
IsCriticalErrorTriggered = True
If CanFeedback(False) Then
If MsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
Else
MsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
End If
If GetTimeTick() - Time < 1500 Then
'弹窗无法保留
Log("[System] PCL 已崩溃:" & vbCrLf & ExFull)
FormMain.EndProgramForce(ProcessReturnValues.Exception)
Else
FormMain.EndProgramForce(ProcessReturnValues.Fail)
End If
End Select
End Sub
@@ -85,7 +85,7 @@
Return _State
End Get
Set(value As LoadState)
If _State = value Then Exit Property
If _State = value Then Return
Dim OldState = _State
If value = LoadState.Finished AndAlso Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
_State = value
@@ -112,7 +112,7 @@
Return _LoadingState
End Get
Set(value As MyLoading.MyLoadingState)
If _LoadingState = value Then Exit Property
If _LoadingState = value Then Return
Dim OldState = _LoadingState
_LoadingState = value
RaiseEvent LoadingStateChanged(value, OldState)
@@ -154,7 +154,7 @@
End Select
End Get
Set(value As Double)
If _Progress = value Then Exit Property
If _Progress = value Then Return
Dim OldValue = _Progress
_Progress = value
RaiseEvent ProgressChanged(value, OldValue)
@@ -184,7 +184,7 @@
Thread.Sleep(10)
Loop
If State = LoadState.Finished Then
Exit Sub
Return
ElseIf State = LoadState.Aborted Then
Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf IsNothing([Error]) Then
@@ -207,7 +207,7 @@
If Timeout < 0 Then Throw New TimeoutException(TimeoutMessage)
Loop
If State = LoadState.Finished Then
Exit Sub
Return
ElseIf State = LoadState.Aborted Then
Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf IsNothing([Error]) Then
@@ -308,7 +308,7 @@
Progress = -1
End SyncLock
Else
Exit Sub
Return
End If
LastRunningThread = New Thread(
@@ -319,11 +319,12 @@
LoadDelegate(Me)
If IsAborted Then
Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer)
Else
Return
End If
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
RaisePreviewFinish()
State = LoadState.Finished
LastFinishedTime = GetTimeTick() '未中断,本次输出有效
End If
Catch ex As CancelledException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断,已完成 {Math.Round(Progress * 100)}%")
If Not IsAborted Then State = LoadState.Aborted
@@ -333,7 +334,7 @@
'如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Aborted
If Not IsAborted Then State = LoadState.Aborted
Catch ex As Exception
If IsAborted Then Exit Sub
If IsAborted Then Return
Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
[Error] = ex
State = LoadState.Failed
@@ -342,14 +343,14 @@
LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsAborted
End Sub
Public Overrides Sub Abort()
If State <> LoadState.Loading Then Exit Sub
If State <> LoadState.Loading Then Return
SyncLock LockState
State = LoadState.Aborted
End SyncLock
TriggerThreadAbort()
End Sub
Private Sub TriggerThreadAbort()
If LastRunningThread Is Nothing Then Exit Sub
If LastRunningThread Is Nothing Then Return
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
If LastRunningThread.IsAlive Then LastRunningThread.Interrupt()
LastRunningThread = Nothing
@@ -419,7 +420,7 @@
'改变状态
SyncLock LockState
If State = LoadState.Loading Then
Exit Sub
Return
Else
State = LoadState.Loading
End If
@@ -439,7 +440,7 @@
If State = LoadState.Loading OrElse State = LoadState.Waiting Then
State = LoadState.Aborted
Else
Exit Sub
Return
End If
End SyncLock
RunInThread(
@@ -470,7 +471,7 @@
Case Else
'完蛋,出错了
SyncLock LockState
If State >= LoadState.Finished Then Exit Sub
If State >= LoadState.Finished Then Return
[Error] = New Exception(Loader.Name & "失败", Loader.Error)
State = Loader.State
End SyncLock
@@ -478,14 +479,14 @@
Loader.Abort()
Next
FrmMain.BtnExtraDownload.ShowRefresh()
Exit Sub
Return
End Select
End Sub
''' <summary>
''' 触发一次更新,以启动新加载器或完成。
''' </summary>
Private Sub Update()
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Exit Sub
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Return
Dim IsFinished As Boolean = True
Dim Blocked As Boolean = False
Dim Input As Object = Me.Input
@@ -584,16 +585,11 @@ Restart:
Try
Dim NewState As Shell.TaskbarItemProgressState
Dim NewProgress As Double = LoaderTaskbarProgressGet()
'检查任务是否完成,若完成则移除
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar.ToList()
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar.ToList()
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
'若单个任务已中止,或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar
If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Aborted) Then
FrmSpeedLeft?.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If
@@ -626,7 +622,7 @@ Restart:
Public Function LoaderTaskbarProgressGet() As Double
Try
If Not LoaderTaskbar.Any Then Return 1
Return MathClamp(LoaderTaskbar.Select(Function(e) e.Progress).Average(), 0, 1)
Return MathClamp(LoaderTaskbar.Select(Function(l) l.Progress).Average(), 0, 1)
Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5
+19 -19
View File
@@ -1345,7 +1345,7 @@ Wrong:
If State < NetState.Merge Then
State = NetState.Merge
Else
Exit Sub
Return
End If
End SyncLock
Dim RetryCount As Integer = 0
@@ -1355,8 +1355,7 @@ Retry:
SyncLock LockChain
'创建文件夹
If File.Exists(LocalPath) Then File.Delete(LocalPath)
Dim Info As New FileInfo(LocalPath)
Info.Directory.Create()
Directory.CreateDirectory(GetPathFromFullPath(LocalPath))
'合并文件
If IsNoSplit Then
'仅有一个线程,从缓存中输出
@@ -1435,7 +1434,7 @@ Retry:
''' </summary>
Private Sub Fail(Optional RaiseEx As Exception = Nothing)
SyncLock LockState
If State >= NetState.Finish Then Exit Sub
If State >= NetState.Finish Then Return
If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
'凉凉
State = NetState.Error
@@ -1451,10 +1450,10 @@ Retry:
Public Sub Abort(CausedByTask As LoaderDownload)
'从特定任务中移除,如果它还属于其他任务,则继续下载
Tasks.Remove(CausedByTask)
If Tasks.Any Then Exit Sub
If Tasks.Any Then Return
'确认中断
SyncLock LockState
If State >= NetState.Finish Then Exit Sub
If State >= NetState.Finish Then Return
State = NetState.Error
End SyncLock
InterruptAndDelete()
@@ -1474,7 +1473,7 @@ Retry:
''' </summary>
Public Sub Finish(Optional PrintLog As Boolean = True)
SyncLock LockState
If State >= NetState.Finish Then Exit Sub
If State >= NetState.Finish Then Return
State = NetState.Finish
End SyncLock
SyncLock NetManager.LockRemain
@@ -1601,7 +1600,7 @@ NextElement:
'输入检测
If Not Files.Any() Then
OnFinish()
Exit Sub
Return
End If
For Each File As NetFile In Files
If File Is Nothing Then Throw New ArgumentException("存在空文件请求!")
@@ -1658,13 +1657,14 @@ NextElement:
End Sub
Private Sub StartCopy(Files As List(Of NetFile), FolderList As List(Of String))
Try
If ModeDebug Then Log("[Download] 检查线程分配文件数:" & Files.Count & ",线程名:" & Thread.CurrentThread.Name)
If ModeDebug Then Log($"[Download] 检查线程分配文件数:{Files.Count},线程名:{Thread.CurrentThread.Name}")
'试图从已存在的 Minecraft 文件夹中寻找目标文件
Dim ExistFiles As New List(Of KeyValuePair(Of NetFile, String)) '{NetFile, Target As String}
For Each File As NetFile In Files
Dim ExistFilePath As String = Nothing
'判断是否有已存在的文件
If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWithF(PathMcFolder) Then
If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso
File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWithF(PathMcFolder) Then
Dim Relative = File.LocalPath.Replace(PathMcFolder, "")
For Each Folder In FolderList
Dim Target = Folder & Relative
@@ -1690,7 +1690,7 @@ NextElement:
For Each FileToken In ExistFiles
Dim File As NetFile = FileToken.Key
SyncLock LockState
If File.State > NetState.WaitForCopy Then Exit Sub
If File.State > NetState.WaitForCopy Then Return
End SyncLock
Dim LocalPath As String = FileToken.Value
Dim RetryCount As Integer = 0
@@ -1701,7 +1701,7 @@ Retry:
File.Finish(False)
Catch ex As Exception
RetryCount += 1
Log(ex, String.Format("复制已存在的文件失败,重试第 {2} 次({0} -> {1})", LocalPath, File.LocalPath, RetryCount))
Log(ex, $"复制已存在的文件失败,重试第 {RetryCount} 次({LocalPath} -> {File.LocalPath})")
If RetryCount < 3 Then
Thread.Sleep(200)
GoTo Retry
@@ -1719,14 +1719,14 @@ Retry:
'要求全部文件完成
SyncLock FileRemainLock
FileRemain -= 1
If FileRemain > 0 Then Exit Sub
If FileRemain > 0 Then Return
End SyncLock
OnFinish()
End Sub
Public Sub OnFinish()
RaisePreviewFinish()
SyncLock LockState
If State > LoadState.Loading Then Exit Sub
If State > LoadState.Loading Then Return
State = LoadState.Finished
End SyncLock
End Sub
@@ -1739,7 +1739,7 @@ Retry:
End Sub
Public Sub OnFail(ExList As List(Of Exception))
SyncLock LockState
If State > LoadState.Loading Then Exit Sub
If State > LoadState.Loading Then Return
If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误!")}
'寻找第一个不是 404 的下载源
Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList
@@ -1768,7 +1768,7 @@ Retry:
End Sub
Public Overrides Sub Abort()
SyncLock LockState
If State >= LoadState.Finished Then Exit Sub
If State >= LoadState.Finished Then Return
State = LoadState.Aborted
End SyncLock
Log("[Download] " & Name & " 已取消!")
@@ -1885,7 +1885,7 @@ Retry:
''' 启动监控线程,用于新增下载线程。
''' </summary>
Private Sub StartManager()
If IsManagerStarted Then Exit Sub
If IsManagerStarted Then Return
IsManagerStarted = True
Dim ThreadStarter =
Sub(Id As Integer) '0 或 1
@@ -1936,7 +1936,7 @@ Retry:
Next
End While
Catch ex As Exception
Log(ex, $"下载管理启动线程 {Id} 出错", LogLevel.Assert)
Log(ex, $"下载管理启动线程 {Id} 出错", LogLevel.Critical)
End Try
End Sub
RunInNewThread(Sub() ThreadStarter(0), "NetManager ThreadStarter 0")
@@ -1960,7 +1960,7 @@ Retry:
Loop
End While
Catch ex As Exception
Log(ex, "下载管理刷新线程出错", LogLevel.Assert)
Log(ex, "下载管理刷新线程出错", LogLevel.Critical)
End Try
End Sub, "NetManager StatRefresher")
End Sub
@@ -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
@@ -150,13 +151,13 @@ Public Class ValidateExcept
Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
Public Property ErrorMessage As String
Public Sub New()
ErrorMessage = "输入内容不能包含 %!"
ErrorMessage = "输入内容不能包含 %"
End Sub '用于 XAML 初始化
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能包含 %!")
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能包含 %")
Me.Excepts = Excepts
Me.ErrorMessage = ErrorMessage
End Sub
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能包含 %!")
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能包含 %")
Me.Excepts = New ObjectModel.Collection(Of String)
Me.ErrorMessage = ErrorMessage
For Each Data As String In Excepts
@@ -185,12 +186,12 @@ Public Class ValidateExceptSame
Public Property IgnoreCase As Boolean = False
Public Sub New()
End Sub
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能为 %!", Optional IgnoreCase As Boolean = False)
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
Me.Excepts = Excepts
Me.ErrorMessage = ErrorMessage
Me.IgnoreCase = IgnoreCase
End Sub
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能为 %!", Optional IgnoreCase As Boolean = False)
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
Me.Excepts = New ObjectModel.Collection(Of String)
For Each Data As String In Excepts
Me.Excepts.Add(Data)
@@ -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
@@ -1,6 +1,10 @@
Public Module ModComp
Public Enum CompType
''' <summary>
''' 允许任意种类,或种类未知。
''' </summary>
Any = -1
''' <summary>
''' Mod。
''' </summary>
@@ -13,6 +17,19 @@
''' 资源包。
''' </summary>
ResourcePack = 2
''' <summary>
''' 光影包。
''' </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
@@ -111,6 +128,7 @@
Public ReadOnly FromCurseForge As Boolean
''' <summary>
''' 工程的种类。
''' 由于 Modrinth 混合使用 Mod 和数据包,结果不一定准确。
''' </summary>
Public ReadOnly Type As CompType
''' <summary>
@@ -178,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
@@ -254,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
@@ -274,17 +308,9 @@
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
Else
Type = CompType.ResourcePack
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
@@ -328,10 +354,36 @@
Case 4480 : Tags.Add("基于地图")
Case 4481 : Tags.Add("轻量")
Case 4482 : Tags.Add("大型")
'FUTURE: Res
'资源包
Case 403 : Tags.Add("原版风")
Case 400 : Tags.Add("写实风")
Case 401 : Tags.Add("现代风")
Case 402 : Tags.Add("中世纪")
Case 399 : Tags.Add("蒸汽朋克")
Case 5244 : Tags.Add("含字体")
Case 404 : Tags.Add("动态效果")
Case 4465 : Tags.Add("兼容 Mod")
Case 393 : Tags.Add("16x")
Case 394 : Tags.Add("32x")
Case 395 : Tags.Add("64x")
Case 396 : Tags.Add("128x")
Case 397 : Tags.Add("256x")
Case 398 : Tags.Add("超高清")
Case 5193 : Tags.Add("数据包") '有这个 Tag 的项会从资源包请求中被移除
'光影包
Case 6553 : Tags.Add("写实风")
Case 6554 : Tags.Add("幻想风")
Case 6555 : Tags.Add("原版风")
'数据包
Case 6948 : Tags.Add("冒险")
Case 6949 : Tags.Add("幻想")
Case 6950 : Tags.Add("支持库")
Case 6952 : Tags.Add("魔法")
Case 6946 : Tags.Add("Mod 相关")
Case 6951 : Tags.Add("科技")
Case 6953 : Tags.Add("实用")
End Select
Next
If Not Tags.Any() Then Tags.Add("杂项")
#End Region
Else
#Region "Modrinth"
@@ -353,9 +405,10 @@
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 "shader" : Type = CompType.Shader
Case Else : Type = CompType.Mod 'Modrinth 将数据包标为 Mod
End Select
'Tags & ModLoaders
Tags = New List(Of String)
@@ -377,41 +430,78 @@
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("轻量")
'FUTURE: Res
'资源包
Case "simplistic" : Tags.Add("简洁")
Case "combat" : Tags.Add("战斗")
Case "tweaks" : Tags.Add("改良")
Case "8x-" : Tags.Add("极简")
Case "16x" : Tags.Add("16x")
Case "32x" : Tags.Add("32x")
Case "48x" : Tags.Add("48x")
Case "64x" : Tags.Add("64x")
Case "128x" : Tags.Add("128x")
Case "256x" : Tags.Add("256x")
Case "512x+" : Tags.Add("超高清")
Case "audio" : Tags.Add("含声音")
Case "fonts" : Tags.Add("含字体")
Case "models" : Tags.Add("含模型")
Case "gui" : Tags.Add("含 UI")
Case "locale" : Tags.Add("含语言")
Case "core-shaders" : Tags.Add("核心着色器")
Case "modded" : Tags.Add("兼容 Mod")
'光影包
Case "fantasy" : Tags.Add("幻想风")
Case "semi-realistic" : Tags.Add("半写实风")
Case "cartoon" : Tags.Add("卡通风")
'暂时不添加性能负荷 Tag
'Case "potato" : Tags.Add("极低")
'Case "low" : Tags.Add("低")
'Case "medium" : Tags.Add("中")
'Case "high" : Tags.Add("高")
Case "colored-lighting" : Tags.Add("彩色光照")
Case "path-tracing" : Tags.Add("路径追踪")
Case "pbr" : Tags.Add("PBR")
Case "reflections" : Tags.Add("反射")
Case "iris" : Tags.Add("Iris")
Case "optifine" : Tags.Add("OptiFine")
Case "vanilla" : Tags.Add("原版可用")
End Select
Next
If 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
@@ -534,7 +624,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
@@ -664,8 +754,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
@@ -775,8 +865,12 @@ NoSubtitle:
Address += "&classId=6"
Case CompType.ModPack
Address += "&classId=4471"
Case CompType.DataPack
Address += "&classId=6945"
Case CompType.Shader
Address += "&classId=6552"
Case CompType.ResourcePack
'FUTURE: Res
Address += "&classId=12"
End Select
Address += "&categoryId=" & If(Tag = "", "0", Tag.BeforeFirst("/"))
If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
@@ -856,38 +950,39 @@ NoSubtitle:
''' 根据搜索请求获取一系列的工程列表。需要基于加载器运行。
''' </summary>
Public Sub CompProjectsGet(Task As LoaderTask(Of CompProjectRequest, Integer))
Dim Storage = Task.Input.Storage '避免多线程问题
Dim Request As CompProjectRequest = Task.Input
Dim Storage = Request.Storage '避免多线程问题
If Task.Input.Storage.Results.Count >= Task.Input.TargetResultCount Then
Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,多于所需的 {Task.Input.TargetResultCount} 个结果,结束处理")
Exit Sub
ElseIf Not Task.Input.CanContinue Then
If Not Task.Input.Storage.Results.Any() Then
If Request.Storage.Results.Count >= Request.TargetResultCount Then
Log($"[Comp] 已有 {Request.Storage.Results.Count} 个结果,多于所需的 {Request.TargetResultCount} 个结果,结束处理")
Return
ElseIf Not Request.CanContinue Then
If Not Request.Storage.Results.Any() Then
Throw New Exception("没有符合条件的结果")
Else
Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,少于所需的 {Task.Input.TargetResultCount} 个结果,但无法继续获取,结束处理")
Exit Sub
Log($"[Comp] 已有 {Request.Storage.Results.Count} 个结果,少于所需的 {Request.TargetResultCount} 个结果,但无法继续获取,结束处理")
Return
End If
End If
#Region "拒绝 1.13- Quilt(这个版本根本没有 Quilt)"
If Task.Input.ModLoader = CompModLoaderType.Quilt AndAlso VersionSortInteger(If(Task.Input.GameVersion, "1.15"), "1.14") = -1 Then
Throw New Exception("Quilt 不支持 Minecraft " & Task.Input.GameVersion)
If Request.ModLoader = CompModLoaderType.Quilt AndAlso VersionSortInteger(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
End If
#End Region
#Region "处理搜索文本,赋值回 Task.Input.SearchText"
Dim RawFilter As String = If(Task.Input.SearchText, "").Trim
Task.Input.SearchText = RawFilter
Dim RawFilter As String = If(Request.SearchText, "").Trim
Request.SearchText = RawFilter
RawFilter = RawFilter.ToLower
Log("[Comp] 工程列表搜索原始文本:" & RawFilter)
'中文请求关键字处理
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 (Request.Type = CompType.Mod OrElse Request.Type = CompType.DataPack) Then
'构造搜索请求
Dim SearchEntries As New List(Of SearchEntry(Of CompDatabaseEntry))
For Each Entry In CompDatabase
@@ -900,7 +995,7 @@ NoSubtitle:
})
Next
'获取搜索结果
Dim SearchResults = Search(SearchEntries, Task.Input.SearchText, 3)
Dim SearchResults = Search(SearchEntries, Request.SearchText, 3)
If Not SearchResults.Any() Then Throw New Exception("无搜索结果,请尝试搜索英文名称")
Dim SearchResult As String = ""
For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的,也最多只要 5 个
@@ -918,14 +1013,14 @@ NoSubtitle:
If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For
RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " "
Next
Task.Input.SearchText = RealFilter
Request.SearchText = RealFilter
Log("[Comp] 中文搜索最终关键词:" & RealFilter, LogLevel.Developer)
End If
'驼峰英文请求关键字处理
Dim SpacedKeywords = Task.Input.SearchText.RegexReplace("([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)", "$& ")
Dim ConnectedKeywords = Task.Input.SearchText.Replace(" ", "")
Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchText, ConnectedKeywords & " " & RawFilter)).ToLower
Dim SpacedKeywords = Request.SearchText.RegexReplace("([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)", "$& ")
Dim ConnectedKeywords = Request.SearchText.Replace(" ", "")
Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Request.SearchText, ConnectedKeywords & " " & RawFilter)).ToLower
'最终处理关键字:分割、去重
Dim RightKeywords As New List(Of String)
@@ -939,15 +1034,15 @@ NoSubtitle:
RightKeywords.Add(Keyword)
Next
If RawFilter.Length > 0 AndAlso Not RightKeywords.Any() Then
Task.Input.SearchText = RawFilter '全都被过滤掉了
Request.SearchText = RawFilter '全都被过滤掉了
Else
Task.Input.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower
Request.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower
End If
'例外项:OptiForge、OptiFabric(拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod)
If RawFilter.Replace(" ", "").ContainsF("optiforge", True) Then Task.Input.SearchText = "optiforge"
If RawFilter.Replace(" ", "").ContainsF("optifabric", True) Then Task.Input.SearchText = "optifabric"
Log("[Comp] 工程列表搜索最终文本:" & Task.Input.SearchText, LogLevel.Debug)
If RawFilter.Replace(" ", "").ContainsF("optiforge", True) Then Request.SearchText = "optiforge"
If RawFilter.Replace(" ", "").ContainsF("optifabric", True) Then Request.SearchText = "optifabric"
Log("[Comp] 工程列表搜索最终文本:" & Request.SearchText, LogLevel.Debug)
Task.Progress = 0.1
#End Region
@@ -963,10 +1058,17 @@ Retry:
Dim ModrinthThread As Thread = Nothing
Dim ResultsLock As New Object
'在 1.14-,部分老 Mod 没有设置支持的加载器,因此添加 Forge 筛选就会出现遗漏
'所以,在发起请求时不筛选加载器,然后在返回的结果中自行筛除不是 Forge 的 Mod
Dim IsOldForgeRequest = Request.ModLoader = CompModLoaderType.Forge AndAlso Request.GameVersion?.Contains(".") AndAlso Val(Request.GameVersion.Split(".")(1)) < 14
If IsOldForgeRequest Then Request.ModLoader = CompModLoaderType.Any
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress()
Dim ModrinthUrl As String = Request.GetModrinthAddress()
If IsOldForgeRequest Then Request.ModLoader = CompModLoaderType.Forge '设置回去
Try
'启动 CurseForge 线程
Dim CurseForgeUrl As String = Task.Input.GetCurseForgeAddress()
Dim CurseForgeFailed As Boolean = False
If CurseForgeUrl IsNot Nothing Then
CurseForgeThread = RunInNewThread(
@@ -978,7 +1080,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 Request.Type = CompType.ResourcePack AndAlso Project.Tags.Contains("数据包") Then Continue For 'CurseForge 将一些数据包分类成了资源包
ProjectList.Add(Project)
Next
'更新结果
SyncLock ResultsLock
@@ -997,7 +1101,6 @@ Retry:
End If
'启动 Modrinth 线程
Dim ModrinthUrl As String = Task.Input.GetModrinthAddress()
Dim ModrinthFailed As Boolean = False
If ModrinthUrl IsNot Nothing Then
ModrinthThread = RunInNewThread(
@@ -1013,7 +1116,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
@@ -1031,9 +1133,9 @@ Retry:
'等待线程结束
If CurseForgeThread IsNot Nothing Then CurseForgeThread.Join()
If Task.IsAborted Then Exit Sub '会自动触发 Finally
If Task.IsAborted Then Return '会自动触发 Finally
If ModrinthThread IsNot Nothing Then ModrinthThread.Join()
If Task.IsAborted Then Exit Sub
If Task.IsAborted Then Return
'确保存在结果
Storage.ErrorMessage = Nothing
@@ -1041,11 +1143,11 @@ 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, "整合包", "资源包")}搜索仅支持英文")
ElseIf Task.Input.Source = CompSourceType.CurseForge AndAlso Task.Input.Tag.StartsWithF("/") Then
If IsChineseSearch AndAlso Not (Request.Type = CompType.Mod OrElse Request.Type = CompType.DataPack) Then
Throw New Exception("没有搜索结果,请尝试使用英文搜索")
ElseIf Request.Source = CompSourceType.CurseForge AndAlso Request.Tag.StartsWithF("/") Then
Throw New Exception("CurseForge 不兼容所选的类型")
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
ElseIf Request.Source = CompSourceType.Modrinth AndAlso Request.Tag.EndsWithF("/") Then
Throw New Exception("Modrinth 不兼容所选的类型")
Else
Throw New Exception("没有搜索结果")
@@ -1054,17 +1156,22 @@ Retry:
ElseIf [Error] IsNot Nothing Then
'有结果但是有错误
If CurseForgeFailed Then
Storage.ErrorMessage = $"无法连接到 CurseForge,所以目前仅显示了来自 Modrinth 的内容,结果可能不全。{vbCrLf}请尝试使用 VPN 或加速器以改善网络。"
Storage.ErrorMessage = $"无法连接到 CurseForge,所以目前仅显示了来自 Modrinth 的内容,搜索结果可能不全。{vbCrLf}请稍后重试,或使用 VPN 以改善网络环境。"
Else
Storage.ErrorMessage = $"无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,结果可能不全。{vbCrLf}请尝试使用 VPN 或加速器以改善网络。"
Storage.ErrorMessage = $"无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。{vbCrLf}请稍后重试,或使用 VPN 以改善网络环境。"
End If
End If
Finally
If CurseForgeThread IsNot Nothing Then CurseForgeThread.Interrupt()
If ModrinthThread IsNot Nothing Then ModrinthThread.Interrupt()
CurseForgeThread?.Interrupt()
ModrinthThread?.Interrupt()
End Try
'筛除不是 Forge 的 Mod
If IsOldForgeRequest Then
RawResults = RawResults.Where(Function(p) Not p.ModLoaders.Any() OrElse p.ModLoaders.Contains(CompModLoaderType.Forge)).ToList
End If
#End Region
#Region "提取非重复项,存储于 RealResults"
@@ -1085,9 +1192,9 @@ Retry:
#Region "检查结果数量,如果不足且可继续,会继续加载下一页"
If RealResults.Count + Storage.Results.Count < Task.Input.TargetResultCount Then
Log($"[Comp] 总结果数需求最少 {Task.Input.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
If Task.Input.CanContinue AndAlso [Error] Is Nothing Then '如果有下载源失败则不再重试,这时候重试可能导致无限循环
If RealResults.Count + Storage.Results.Count < Request.TargetResultCount Then
Log($"[Comp] 总结果数需求最少 {Request.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
If Request.CanContinue AndAlso [Error] Is Nothing Then '如果有下载源失败则不再重试,这时候重试可能导致无限循环
Log("[Comp] 将继续尝试加载下一页")
GoTo Retry
Else
@@ -1100,10 +1207,23 @@ Retry:
#Region "将结果排序并添加"
Dim Scores As New Dictionary(Of CompProject, Double) '排序分
If String.IsNullOrEmpty(Task.Input.SearchText) Then
Dim GetDownloadCountMult =
Function(Project As CompProject) As Double
Select Case Request.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(Request.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
'如果有搜索文本,按关联度将结果排序
@@ -1111,7 +1231,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)}})
@@ -1194,7 +1314,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
@@ -1242,8 +1362,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)
@@ -1281,7 +1401,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
@@ -1292,7 +1412,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
@@ -1319,8 +1439,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
@@ -1333,7 +1472,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
@@ -1341,13 +1480,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
@@ -1395,12 +1527,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
@@ -1466,7 +1594,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
@@ -1484,15 +1612,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",
@@ -1501,10 +1629,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)
@@ -1518,28 +1646,28 @@ Retry:
End Function
''' <summary>
''' 预载包含大量 CompFile 的卡片,添加必要的元素和前置 Mod 列表。
''' 预载包含大量 CompFile 的卡片,添加必要的元素和前置列表。
''' </summary>
Public Sub CompFilesCardPreload(Stack As StackPanel, Files As List(Of CompFile))
'获取卡片对应的前置 ID
'如果为整合包就不会有 Dependencies 信息,所以不用管
Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
Deps.Sort()
If Not Deps.Any() Then Exit Sub
If Not Deps.Any() Then Return
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
@@ -71,11 +71,7 @@
'将可能可用的日志文件导出
For Each FilePath In RightLogs
Try
If FilePath.Contains("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath).Split(vbCrLf.ToCharArray)))
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath, Encoding.UTF8).Split(vbCrLf.ToCharArray)))
End If
Catch ex As Exception
Log(ex, "读取可能的崩溃日志文件失败(" & FilePath & ")")
End Try
@@ -117,11 +113,7 @@ Extracted:
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.ToLower
If Ext = ".log" OrElse Ext = ".txt" Then
If TargetFile.Name.StartsWithF("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName, Encoding.UTF8).Split(vbCrLf.ToCharArray)))
End If
Else
File.Delete(TargetFile.FullName)
End If
@@ -137,20 +129,21 @@ Extracted:
Private Enum AnalyzeFileType
HsErr
MinecraftLog
ExtraLog
ExtraLogFile
ExtraReportFile
CrashReport
End Enum
Private DirectFile As KeyValuePair(Of String, String())? = Nothing '在弹窗中选择直接打开的文件
''' <summary>
''' 从 AnalyzeRawFiles 中提取实际有用的文本片段存储到 AnalyzeFiles,并整理可用于生成报告的文件。
''' 返回找到的用于分析的项目数。
''' 返回是否有足够信息可用于分析。
''' </summary>
Public Function Prepare() As Integer
Public Function Prepare() As Boolean
Log("[Crash] 步骤 2:准备日志文本")
'对日志文件进行分类
DirectFile = Nothing
Dim TotalFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
For Each LogFile In AnalyzeRawFiles
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower
Dim TargetType As AnalyzeFileType
@@ -170,27 +163,35 @@ Extracted:
TargetType = AnalyzeFileType.MinecraftLog
If DirectFile Is Nothing Then DirectFile = LogFile
Else
TargetType = AnalyzeFileType.ExtraLog
TargetType = AnalyzeFileType.ExtraLogFile
End If
ElseIf MatchName.EndsWithF(".log", True) OrElse MatchName.EndsWithF(".txt", True) Then
TargetType = AnalyzeFileType.ExtraLog
ElseIf MatchName.EndsWithF(".log", True) Then
TargetType = AnalyzeFileType.ExtraLogFile
ElseIf MatchName.EndsWithF(".txt", True) Then
TargetType = AnalyzeFileType.ExtraReportFile
Else
Log("[Crash] " & MatchName & " 分类为 Ignore")
Continue For
End If
If Not LogFile.Value.Any() Then
Log("[Crash] " & MatchName & " 由于内容为空跳过")
Else
TotalFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
If LogFile.Value.Any Then
AllFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
Log("[Crash] " & MatchName & " 分类为 " & GetStringFromEnum(TargetType))
Else
Log("[Crash] " & MatchName & " 由于内容为空跳过")
End If
Next
'若只有额外日志,则将它们视作 Minecraft 日志
If AllFiles.Any() AndAlso AllFiles.All(Function(p) p.Key = AnalyzeFileType.ExtraLogFile) Then
Log("[Crash] 由于仅发现了额外日志,将它们视作 Minecraft 日志进行分析")
AllFiles = AllFiles.Select(Function(p) New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(AnalyzeFileType.MinecraftLog, p.Value)).ToList
End If
'将分类后的文件分别写入
For Each SelectType In {AnalyzeFileType.MinecraftLog, AnalyzeFileType.HsErr, AnalyzeFileType.ExtraLog, AnalyzeFileType.CrashReport}
For Each SelectType In {AnalyzeFileType.MinecraftLog, AnalyzeFileType.HsErr, AnalyzeFileType.ExtraLogFile, AnalyzeFileType.CrashReport}
'获取该种类的所有文件 {文件路径 -> 文件内容行}
Dim SelectedFiles As New List(Of KeyValuePair(Of String, String()))
For Each File In TotalFiles
For Each File In AllFiles
If SelectType = File.Key Then SelectedFiles.Add(File.Value)
Next
If Not SelectedFiles.Any() Then Continue For
@@ -232,7 +233,7 @@ Extracted:
Next
'选择一份最佳的来自启动器的游戏日志
For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt", "PCL 启动器日志.txt"}
If FileNameDict.ContainsKey(FileName) Then
If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName)
'截取 “以下为游戏输出的最后一段内容” 后的内容
Dim HasLauncherMark As Boolean = False
@@ -249,37 +250,42 @@ Extracted:
LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为启动器日志")
Exit For
End If
Next
'选择一份最佳的 Minecraft Log
For Each FileName As String In {"latest.log", "latest log.txt", "debug.log", "debug log.txt"}
If FileNameDict.ContainsKey(FileName) Then
If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName)
LogMc += GetHeadTailLines(CurrentLog.Value, 250, 500)
LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为 Minecraft 日志")
Exit For
End If
Next
'查找 Debug Log
For Each FileName As String In {"debug.log", "debug log.txt"}
If FileNameDict.ContainsKey(FileName) Then
If Not FileNameDict.ContainsKey(FileName) Then Continue For
Dim CurrentLog = FileNameDict(FileName)
LogMcDebug += GetHeadTailLines(CurrentLog.Value, 1000, 0)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为 Minecraft Debug 日志")
Exit For
End If
Next
'检查错误
'兜底
If LogMc = "" Then
If LogMcDebug <> "" Then '如果没有找到 Minecraft 日志,则使用 Debug 日志作为兜底
LogMc = LogMcDebug
ElseIf FileNameDict.Any() Then '如果都没有找到,则使用第一个文件
Dim CurrentLog = FileNameDict.First.Value
LogMc += GetHeadTailLines(CurrentLog.Value, 1500, 500)
Log("[Crash] 导入分析:" & CurrentLog.Key & ",作为兜底日志")
Else
LogMc = Nothing
Throw New Exception("无法找到匹配的 Minecraft Log")
End If
End If
If LogMcDebug = "" Then LogMcDebug = Nothing
Case AnalyzeFileType.ExtraLog
Case AnalyzeFileType.ExtraLogFile, AnalyzeFileType.ExtraReportFile
'全部丢过去
For Each SelectedFile In SelectedFiles
OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告:" & SelectedFile.Key & ",作为额外日志")
Log("[Crash] 输出报告:" & SelectedFile.Key & ",不用作分析")
Next
End Select
Catch ex As Exception
@@ -287,15 +293,13 @@ Extracted:
End Try
Next
'获取种类数
Dim ResultCount As Integer = If(LogMc Is Nothing, 0, 1) + If(LogHs Is Nothing, 0, 1) + If(LogCrash Is Nothing, 0, 1)
If ResultCount = 0 Then
Log("[Crash] 步骤 2:准备日志文本完成,没有任何可供分析的日志")
Else
'结束
Prepare = LogMc IsNot Nothing OrElse LogHs IsNot Nothing OrElse LogCrash IsNot Nothing
If Prepare Then
Log(("[Crash] 步骤 2:准备日志文本完成,找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogMcDebug Is Nothing, "", "游戏 Debug 日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、") & "用作分析")
Else
Log("[Crash] 步骤 2:准备日志文本完成,没有任何可供分析的日志")
End If
Return ResultCount
End Function
''' <summary>
''' 输出字符串的前后某些行,并统一行尾为 vbLf (正则 \n)、删除空行和重复行。
@@ -386,7 +390,7 @@ Extracted:
''' </summary>
Public Sub Analyze(Optional Version As McVersion = Nothing)
Log("[Crash] 步骤 3:分析崩溃原因")
LogAll = (If(LogMc, "") & If(LogMcDebug, "") & If(LogHs, "") & If(LogCrash, ""))
LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "")
'1. 精准日志匹配,中/高优先级
AnalyzeCrit1()
@@ -472,7 +476,7 @@ Done:
'空白分析
If LogMc Is Nothing AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing Then
AppendReason(CrashReason.没有可用的分析文件)
Exit Sub
Return
End If
'崩溃报告分析,高优先级
@@ -563,8 +567,9 @@ Done:
If LogCrash.Contains("has mods that were not found") AndAlso RegexCheck(LogCrash, "The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
'Mod 导致的崩溃
If LogCrash.Contains("-- MOD ") Then
If LogCrash.Between("-- MOD ", "Failure message:").ContainsF(".jar", True) Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrash, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Dim LogCrashMod As String = LogCrash.Between("-- MOD ", "Failure message:")
If LogCrashMod.ContainsF(".jar", True) Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrashMod, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Else
AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
End If
@@ -613,9 +618,9 @@ Done:
Dim IsMixin As Boolean = MixinAnalyze(LogMc)
'常规信息
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf))
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf))
If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
@@ -872,7 +877,7 @@ NextStack:
Try
'获取文件路径
RunInUiWait(Sub() FileAddress = SelectSaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
If String.IsNullOrEmpty(FileAddress) Then Exit Sub
If String.IsNullOrEmpty(FileAddress) Then Return
Directory.CreateDirectory(GetPathFromFullPath(FileAddress))
If File.Exists(FileAddress) Then File.Delete(FileAddress)
'输出诊断信息
@@ -895,9 +900,10 @@ NextStack:
End Select
If File.Exists(OutputFile) Then
If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
WriteFile(TempFolder & "Report\" & FileName,
SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
Encoding:=FileEncoding)
Dim FileContent As String = ReadFile(OutputFile, FileEncoding)
FileContent = FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*"))
FileContent = FilterUserName(FileContent, "*")
WriteFile(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
Log($"[Crash] 导出文件:{FileName},编码:{FileEncoding.HeaderName}")
End If
Next
@@ -907,7 +913,7 @@ NextStack:
Hint("错误报告已导出!", HintType.Finish)
Catch ex As Exception
Log(ex, "导出错误报告失败", LogLevel.Feedback)
Exit Sub
Return
End Try
OpenExplorer(FileAddress)
End Select
@@ -1018,7 +1024,7 @@ NextStack:
Case CrashReason.OptiFine与Forge不兼容
Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。")
Case CrashReason.ShadersMod与OptiFine同时安装
Results.Add("无需同时安装 Optifine 和 Shaders Mod,OptiFine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
Results.Add("无需同时安装 OptiFine 和 Shaders Mod,OptiFine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
Case CrashReason.低版本Forge与高版本Java不兼容
Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 1.8.0.320 的 Java")
Case CrashReason.版本Json中存在多个Forge
@@ -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")))
'返回
@@ -237,7 +244,7 @@
'检查是否有要求的版本(#5195)
If Not String.IsNullOrEmpty(Loader.Input) Then
Dim Id = Loader.Input
If Not DlClientListLoader.Output.Value("versions").Any(Function(v) v("id") = Id) Then
If DlClientListLoader.Output.Value IsNot Nothing AndAlso Not DlClientListLoader.Output.Value("versions").Any(Function(v) v("id") = Id) Then
Throw New Exception("BMCLAPI 源未包含目标版本 " & Id)
End If
End If
@@ -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.
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)
@@ -1251,7 +1291,7 @@
'检查加载器成功
MainLoader.Output = SubLoader.Key.Output
DlSourceLoaderAbort(LoaderList)
Exit Sub
Return
ElseIf BeforeLoadersAllFailed Then
'此前的加载器全部失败,直接启动后续加载器
If WaitCycle < SubLoader.Value * 100 Then WaitCycle = SubLoader.Value * 100
@@ -1293,7 +1333,7 @@
'检查父加载器中断
If MainLoader.IsAborted Then
DlSourceLoaderAbort(LoaderList)
Exit Sub
Return
End If
Loop
End Sub
@@ -98,7 +98,7 @@
''' 检查并获取 Java 详细信息。在 Java 存在异常时抛出错误。
''' </summary>
Public Sub Check()
If IsChecked Then Exit Sub
If IsChecked Then Return
Dim Output As String = Nothing
Try
'确定文件存在
@@ -108,6 +108,9 @@
If Not File.Exists(PathFolder & "java.exe") Then
Throw New FileNotFoundException("未找到 java.exe 文件", PathFolder & "java.exe")
End If
If File.Exists(PathFolder & "pdf-bookmark") Then
Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
End If
IsJre = Not File.Exists(PathFolder & "javac.exe")
'运行 -version
Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 15000).ToLower
@@ -372,6 +375,7 @@ ExitUserJavaCheck:
For Each Java In AllowedJavaList
'如果在官启文件夹启动,会将官启自带 Java 错误视作 MC 文件夹指定 Java,导致了 #2054 的第二例
If Java.PathFolder.Contains(".minecraft\cache\java") 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}
@@ -555,10 +559,9 @@ 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") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
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 位于特殊路径,不应优先使用")
Else
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
End If
Next
@@ -668,19 +671,20 @@ Wait:
Private Sub JavaSearchFolder(OriginalPath As DirectoryInfo, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False)
Try
'确认目录存在
If Not OriginalPath.Exists Then Exit Sub
If Not OriginalPath.Exists Then Return
Dim Path As String = OriginalPath.FullName.Replace("\\", "\")
If Not Path.EndsWithF("\") Then Path += "\"
'若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹
'不应使用网易的 Java:https://github.com/Hex-Dragon/PCL2/issues/1279#issuecomment-2761489121
Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon",
"soft", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
"游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
"应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot",
"runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
"4297127d64ec6", "国服", "网易", "ext", "netease", "1.", "启动"}
"4297127d64ec6", "1.", "启动"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
@@ -711,8 +715,8 @@ Wait:
Return False
Else
Return MyMsgBox($"PCL 未找到 {VersionDescription},是否需要 PCL 自动下载?" & vbCrLf &
$"如果你已经安装了 {VersionDescription},请在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"未找到 Java", "自动下载", "取消") = 1
$"如果你已经安装了 {VersionDescription},可以在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"自动下载 Java?", "自动下载", "取消") = 1
End If
End Function
@@ -741,10 +745,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. '选择最靠后的一项(最新)
@@ -753,7 +757,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")
@@ -766,7 +770,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}")
@@ -65,7 +65,7 @@ Public Module ModLaunch
''' 记录启动日志。
''' </summary>
Public Sub McLaunchLog(Text As String)
Text = SecretFilter(Text, "*")
Text = FilterUserName(FilterAccessToken(Text, "*"), "*")
RunInUi(Sub() FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text)
Log("[Launch] " & Text)
End Sub
@@ -220,6 +220,7 @@ NextInner:
If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
#If BETA Then
'求赞助
If CurrentLaunchOptions?.SaveBatch Is Nothing Then '保存脚本时不提示
RunInNewThread(
Sub()
Select Case Setup.Get("SystemLaunchCount")
@@ -232,9 +233,11 @@ NextInner:
End If
End Select
End Sub, "Donate")
End If
#End If
'正版购买提示
If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
If CurrentLaunchOptions?.SaveBatch Is Nothing AndAlso '保存脚本时不提示
Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
If IsSystemLanguageChinese() Then
RunInNewThread(
Sub()
@@ -575,11 +578,7 @@ SkipLogin:
Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
Dim Input As McLoginServer = Data.Input
Dim NeedRefresh As Boolean = False, WasRefreshed As Boolean = False
Dim LogUsername As String = Input.UserName
If LogUsername.Contains("@") AndAlso Setup.Get("UiLauncherEmail") Then
LogUsername = AccountFilter(LogUsername)
End If
McLaunchLog("登录方式:" & Input.Description & "(" & LogUsername & ")")
McLaunchLog("登录方式:" & Input.Description)
Data.Progress = 0.05
'尝试登录
If (Not Data.Input.ForceReselectProfile) AndAlso
@@ -599,7 +598,7 @@ SkipLogin:
McLaunchLog("验证登录失败:" & AllMessage)
If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then
McLaunchLog("已触发超时登录失败")
Throw New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
Throw New Exception("$登录失败:你的网络环境不佳,导致难以连接到海外服务器。" & vbCrLf & "请稍后重试,或使用加速器或 VPN 以改善网络环境。")
End If
End Try
Data.Progress = 0.25
@@ -842,7 +841,7 @@ LoginFinish:
" - 只注册了账号,但没有加入对应服务器。")
End Select
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
Throw New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
Throw New Exception("$登录失败:你的网络环境不佳,导致难以连接到海外服务器。" & vbCrLf & "请稍后重试,或使用加速器或 VPN 以改善网络环境。")
ElseIf ex.Message.StartsWithF("$") Then
Throw
Else
@@ -953,7 +952,7 @@ Retry:
End If
Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916235") Then
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请尝试使用加速器或 VPN。", "登录失败", "我知道了")
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN。", "登录失败", "我知道了")
Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916238") Then
If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf &
@@ -1081,8 +1080,7 @@ Retry:
Uuid = McLoginMojangUuid(SkinName, False)
End If
Catch ex As Exception
Log(ex, "离线启动时使用的正版皮肤获取失败")
MyMsgBox("由于设置的离线启动时使用的正版皮肤获取失败,游戏将以无皮肤的方式启动。" & vbCrLf & "请检查你的网络是否通畅,或尝试使用 VPN!" & vbCrLf & vbCrLf & "详细的错误信息:" & ex.Message, "皮肤获取失败")
Log(ex, "皮肤信息获取失败,游戏将以无皮肤的方式启动", LogLevel.Hint)
End Try
Case 4
'自定义
@@ -1131,23 +1129,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
@@ -1158,11 +1155,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
@@ -1173,14 +1170,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)
@@ -1198,11 +1195,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
@@ -1219,28 +1216,32 @@ Retry:
'选择 Java
McLaunchLog("Java 版本需求:最低 " & MinVer.ToString & ",最高 " & MaxVer.ToString)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
If Task.IsAborted Then Exit Sub
If Task.IsAborted Then Return
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
Exit Sub
Return
End If
'无合适的 Java
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
If Task.IsAborted Then Return '中断加载会导致 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 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("$$")
@@ -1270,7 +1271,7 @@ Retry:
'检查下载结果
If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872#
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
If Task.IsAborted Then Exit Sub
If Task.IsAborted Then Return
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
Else
@@ -1347,6 +1348,14 @@ Retry:
Arguments += " " & McLaunchArgumentsGameNew(McVersionCurrent)
McLaunchLog("新版 Game 参数获取成功")
End If
'编码参数(#4700、#5892、#5909)
If McLaunchJavaSelected.VersionCode > 8 Then
If Not Arguments.Contains("-Dstdout.encoding=") Then Arguments = "-Dstdout.encoding=UTF-8 " & Arguments
If Not Arguments.Contains("-Dstderr.encoding=") Then Arguments = "-Dstderr.encoding=UTF-8 " & Arguments
End If
If McLaunchJavaSelected.VersionCode >= 18 Then
If Not Arguments.Contains("-Dfile.encoding=") Then Arguments = "-Dfile.encoding=COMPAT " & Arguments
End If
'替换参数
Dim ReplaceArguments = McLaunchArgumentsReplace(McVersionCurrent, Loader)
If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then
@@ -1666,16 +1675,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))
Case Else
GameSize = New Size(875 - 2, 540 - 2)
End Select
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(854, 480)
End Select
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
@@ -1704,7 +1713,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
@@ -1771,7 +1780,7 @@ NextVersion:
Catch ex As UnauthorizedAccessException
McLaunchLog("删除多余文件访问被拒绝,跳过删除步骤")
McLaunchLog("实际的错误信息:" & GetExceptionSummary(ex))
Exit Sub
Return
End Try
Next
@@ -1899,7 +1908,6 @@ NextVersion:
'1.6 ~ 10 :zh_CN 时正常,zh_cn 时自动切换为英文
'1.11 ~ 12:zh_cn 时正常,zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文
'1.13+ :zh_cn 时正常,zh_CN 时自动切换为英文
IniClearCache(SetupFileAddress) '清除缓存(#2294)
Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none")
Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves"), '#3844,整合包可能已经自带了 options.txt
If(Setup.Get("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.ToLower)
@@ -2091,21 +2099,20 @@ IgnoreCustomSkin:
"@echo off" & vbCrLf &
$"title 启动 - {McVersionCurrent.Name}" & vbCrLf &
"echo 游戏正在启动,请稍候。" & vbCrLf &
$"set APPDATA=""{ShortenPath(McVersionCurrent.PathIndie)}""" & vbCrLf &
$"cd /D ""{ShortenPath(McVersionCurrent.PathIndie)}""" & vbCrLf &
CustomCommandGlobal & vbCrLf &
CustomCommandVersion & vbCrLf &
$"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf &
"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")))
WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), FilterAccessToken(CmdString, "F"),
Encoding:=If(McLaunchJavaSelected.VersionCode > 8, Encoding.UTF8, Encoding.Default))
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成,强制结束启动过程")
AbortHint = "导出启动脚本成功!"
OpenExplorer(CurrentLaunchOptions.SaveBatch)
Loader.Parent.Abort()
Exit Sub '导出脚本完成
Return '导出脚本完成
End If
Catch ex As Exception
Log(ex, "输出启动脚本失败")
@@ -2176,8 +2183,6 @@ IgnoreCustomSkin:
StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder)
'设置其他参数
StartInfo.StandardErrorEncoding = If(McLaunchJavaSelected.VersionCode > 8, Encoding.UTF8, Nothing)
StartInfo.StandardOutputEncoding = If(McLaunchJavaSelected.VersionCode > 8, Encoding.UTF8, Nothing)
StartInfo.WorkingDirectory = ShortenPath(McVersionCurrent.PathIndie)
StartInfo.UseShellExecute = False
StartInfo.RedirectStandardOutput = True
@@ -2192,7 +2197,7 @@ IgnoreCustomSkin:
If Loader.IsAborted Then
McLaunchLog("由于取消启动,已强制结束游戏进程") '#1631
GameProcess.Kill()
Exit Sub
Return
End If
Loader.Output = GameProcess
McLaunchProcess = GameProcess
@@ -127,7 +127,7 @@ Public Module ModMinecraft
''' </summary>
Public Sub McFolderLauncherProfilesJsonCreate(Folder As String)
Try
If File.Exists(Folder & "launcher_profiles.json") Then Exit Sub
If File.Exists(Folder & "launcher_profiles.json") Then Return
Dim ResultJson As String =
"{
""profiles"": {
@@ -165,10 +165,10 @@ Public Module ModMinecraft
Return _McVersionCurrent
End Get
Set(value As McVersion)
If ReferenceEquals(_McVersionLast, value) Then Exit Property
If ReferenceEquals(_McVersionLast, value) Then Return
_McVersionCurrent = value '由于有可能是 Nothing,导致无法初始化,才得这样弄一圈
_McVersionLast = value
If value Is Nothing Then Exit Property
If value Is Nothing Then Return
'重置缓存的 Mod 文件夹
PageDownloadCompDetail.CachedFolder = Nothing
'统一通行证重判
@@ -207,15 +207,9 @@ Public Module ModMinecraft
''' </summary>
Public ReadOnly Property PathIndie As String
Get
Return GetPathIndie(Modable)
End Get
End Property
''' <summary>
''' 在不加载版本的情况下获取版本隔离目录。
''' </summary>
Public Function GetPathIndie(Modable As Boolean) As String
'决定版本隔离类型
If Setup.IsUnset("VersionArgumentIndieV2", Version:=Me) Then
If Not IsLoaded Then Load()
'决定该版本是否应该被隔离
Dim ShouldBeIndie =
Function() As Boolean
'从老的版本独立设置中迁移:-1 未决定,0 使用全局设置,1 手动开启,2 手动关闭
@@ -226,34 +220,31 @@ Public Module ModMinecraft
'若版本文件夹下包含 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
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 AndAlso State <> McVersionState.Old AndAlso State <> McVersionState.Snapshot
Log($"[Minecraft] 版本隔离初始化({Name}):从全局默认设置中({Setup.Get("LaunchArgumentIndieV2")})判断,State {GetStringFromEnum(State)},IsRelease {IsRelease},Modable {Modable}")
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
Return Not IsRelease
Case 3 '隔离非正式版与可安装 Mod 的版本
Return Modable OrElse State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
Return Not IsRelease OrElse Modable
Case Else '隔离所有版本
Return True
End Select
End Function
Setup.Set("VersionArgumentIndieV2", ShouldBeIndie(), Version:=Me)
End If
'根据隔离类型决定路径
If Setup.Get("VersionArgumentIndieV2", Version:=Me) Then
Return Path
Else
Return PathMcFolder
End If
End Function
Return If(Setup.Get("VersionArgumentIndieV2", Version:=Me), Path, PathMcFolder)
End Get
End Property
''' <summary>
''' 该版本的版本文件夹名称。
@@ -325,14 +316,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")
@@ -389,7 +372,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
@@ -439,7 +421,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
@@ -569,25 +551,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
@@ -608,10 +571,6 @@ Recheck:
''' Json 是否为 HMCL 格式。
''' </summary>
Public Property IsHmclFormatJson As Boolean = False
''' <summary>
''' 是否包含 JumpLoader。
''' </summary>
Public Property HasJumpLoader As Boolean = False
''' <summary>
''' 版本 jar 中的 version.json 文件对象。
@@ -755,7 +714,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
@@ -866,7 +824,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
@@ -926,6 +883,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
@@ -1081,7 +1056,7 @@ ExitDataLoad:
ElseIf Name = "24w14potato" Then
Return "2024 | 毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
ElseIf Name = "25w14craftmine" Then
Return "2025 | 扼杀创造力并不是一件好事,所以我们决定给你机会来创造一切!"
Return "2025 | 你可以合成任何东西——包括合成你的世界!"
Else
Return ""
End If
@@ -1159,7 +1134,7 @@ Reload:
'改变当前选择的版本
OnLoaded:
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then
'尝试读取已储存的选择
Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version")
@@ -1171,7 +1146,7 @@ OnLoaded:
McVersionCurrent = Version
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
Log("[Minecraft] 选择该文件夹储存的 Minecraft 版本:" & McVersionCurrent.Path)
Exit Sub
Return
End If
Next
Next
@@ -1621,7 +1596,7 @@ OnLoaded:
Try
For Each SkinProperty In GetJson(SkinString)("properties")
If SkinProperty("name") = "textures" Then
SkinValue = SkinProperty("value")
SkinValue = SkinProperty("value").Replace("http:", "https:")
Exit Try
End If
Next
@@ -1735,10 +1710,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
@@ -1801,10 +1772,10 @@ 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
@@ -1842,24 +1813,17 @@ OnLoaded:
End If
'把所需的原版 Jar 添加进去
McLibListGet.Add(New McLibToken With {.LocalPath = RealVersion.Path & RealVersion.Name & ".jar", .Size = 0, .IsNatives = False, .Url = ClientUrl, .SHA1 = ClientSHA1})
End If
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
@@ -1872,14 +1836,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
@@ -1889,15 +1845,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
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"),
@@ -1906,17 +1857,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,
@@ -1926,11 +1876,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
@@ -1947,7 +1897,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))
@@ -1971,7 +1921,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 新版自动安装方法!
@@ -1985,7 +1935,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
@@ -2060,7 +2010,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)
'获取
@@ -2072,18 +2022,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
@@ -2093,13 +2048,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
@@ -2282,7 +2237,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, "获取版本缺失的资源文件下载列表失败")
@@ -2309,7 +2264,7 @@ OnLoaded:
End If
Next
'进行提示
If Version Is Nothing Then Exit Sub
If Version Is Nothing Then Return
Dim Time As Date = Version("releaseTime")
Dim MsgBoxText As String = $"新版本:{VersionName}{vbCrLf}" &
If((Date.Now - Time).TotalDays > 1, "更新时间:" & Time.ToString, "更新于:" & GetTimeSpanString(Time - Date.Now, False))
@@ -2407,26 +2362,40 @@ NextEntry:
End Class
''' <summary>
''' 为邮箱地址或手机号账号进行部分打码。
''' 判断版本名是否类似正式版。
''' </summary>
Public Function AccountFilter(Account As String) As String
If Account.Contains("@") Then
'是邮箱
Dim Splits = Account.Split("@")
'If Splits(0).Count >= 6 Then
' '前半部分至少 6 位,屏蔽后 4 位
' Return Mid(Splits(0), 1, Splits(0).Count - 4) & "****" & "@" & Splits(1)
'Else
'前半部分不到 6 位,返回全 *
Return "".PadLeft(Splits(0).Count, "*") & "@" & Splits(1)
'End If
ElseIf Account.Count >= 6 Then
'至少 6 位,屏蔽后 4 位
Return Mid(Account, 1, Account.Count - 4) & "****"
Else
'不到 6 位,返回全 *
Return "".PadLeft(Account.Count, "*")
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>
''' 打码字符串中的 AccessToken。
''' </summary>
Public Function FilterAccessToken(Raw As String, FilterChar As Char) As String
'打码 "accessToken " 后的内容
If Raw.Contains("accessToken ") Then
For Each Token In RegexSearch(Raw, "(?<=accessToken ([^ ]{5}))[^ ]+(?=[^ ]{5})")
Raw = Raw.Replace(Token, New String(FilterChar, Token.Count))
Next
End If
'打码当前登录的结果
Dim AccessToken As String = McLoginLoader.Output.AccessToken
If AccessToken IsNot Nothing AndAlso AccessToken.Length >= 10 AndAlso Raw.ContainsF(AccessToken, True) AndAlso
McLoginLoader.Output.Uuid <> McLoginLoader.Output.AccessToken Then 'UUID 和 AccessToken 一样则不打码
Raw = Raw.Replace(AccessToken, Left(AccessToken, 5) & New String(FilterChar, AccessToken.Length - 10) & Right(AccessToken, 5))
End If
Return Raw
End Function
''' <summary>
''' 打码字符串中的 Windows 用户名。
''' </summary>
Public Function FilterUserName(Raw As String, FilterChar As Char) As String
If Raw.Contains(":\Users\") Then
For Each Token In RegexSearch(Raw, "(?<=:\\Users\\)[^\\]+")
Raw = Raw.Replace(Token, New String(FilterChar, Token.Count))
Next
End If
Return Raw
End Function
End Module
@@ -188,9 +188,9 @@ Public Module ModMod
Private _Dependencies As New Dictionary(Of String, String)
Private Sub AddDependency(ModID As String, Optional VersionRequirement As String = Nothing)
'确保信息正确
If ModID Is Nothing OrElse ModID.Count < 2 Then Exit Sub
If ModID Is Nothing OrElse ModID.Count < 2 Then Return
ModID = ModID.ToLower
If ModID = "name" OrElse Val(ModID).ToString = ModID Then Exit Sub '跳过 name 与纯数字 id
If ModID = "name" OrElse Val(ModID).ToString = ModID Then Return '跳过 name 与纯数字 id
If VersionRequirement Is Nothing OrElse ((Not VersionRequirement.Contains(".")) AndAlso (Not VersionRequirement.Contains("-"))) OrElse VersionRequirement.Contains("$") Then
VersionRequirement = Nothing
Else
@@ -279,7 +279,7 @@ Public Module ModMod
''' 进行文件可用性检查与 .class 以外的信息获取。
''' </summary>
Public Sub Load(Optional ForceReload As Boolean = False)
If IsLoaded AndAlso Not ForceReload Then Exit Sub
If IsLoaded AndAlso Not ForceReload Then Return
'初始化
Init()
Dim Jar As ZipArchive = Nothing
@@ -819,7 +819,7 @@ Finished:
Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod")
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input)
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
Thread.Sleep(100)
Loop
Finally
@@ -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
@@ -872,7 +872,7 @@ Finished:
Dim ModUpdateList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList
Loader.Progress += 0.94 / ModFileList.Count
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
'加载 McMod 对象
Dim ModEntry As New McMod(ModFile.FullName)
ModEntry.Load()
@@ -912,7 +912,7 @@ Finished:
End Function)
'回设
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
Loader.Output = ModList
'开始联网加载
@@ -950,7 +950,7 @@ Finished:
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If ModrinthVersion.Count = 0 Then Exit Sub
If ModrinthVersion.Count = 0 Then Return
Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
For Each Entry In Mods
If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
@@ -963,10 +963,10 @@ Finished:
Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
If Loader.IsAbortedWithThread(MainThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Exit Sub
If Not ModrinthMapping.Any() Then Return
Dim ModrinthProject = CType(GetJson(DlModRequest(
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]",
"GET", "", "application/json")), JArray)
@@ -1013,13 +1013,13 @@ Finished:
Dim CurseForgeHashes As New List(Of UInteger)
For Each Entry In Mods
CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
If Loader.IsAbortedWithThread(MainThread) Then Return
Next
Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If Not CurseForgeRaw.Any() Then Exit Sub
If Not CurseForgeRaw.Any() Then Return
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of McMod))
For Each Project In CurseForgeRaw
Dim ProjectId = Project("id").ToString
@@ -1034,10 +1034,10 @@ Finished:
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
If Loader.IsAbortedWithThread(MainThread) Then Return
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Exit Sub
If Not CurseForgeMapping.Any() Then Return
Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST",
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
@@ -1078,7 +1078,7 @@ Finished:
Next
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息
If Not UpdateFileIds.Any() Then Exit Sub
If Not UpdateFileIds.Any() Then Return
Dim CurseForgeFiles = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST",
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
@@ -1114,20 +1114,24 @@ Finished:
End Sub, "Mod List Detail Loader CurseForge")
'等待线程结束
Do Until EndedThreadCount = 2
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
Thread.Sleep(10)
Loop
'保存缓存
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Exit Sub
If Not Mods.Any() Then Return
For Each Entry In Mods
Entry.CompLoaded = Not IsFailed
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
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)
@@ -8,7 +8,7 @@ Public Module ModModpack
''' </summary>
Public Sub ModpackInstall()
Dim File As String = SelectFile("整合包文件(*.rar;*.zip;*.mrpack)|*.rar;*.zip;*.mrpack", "选择整合包压缩文件") '选择整合包文件
If String.IsNullOrEmpty(File) Then Exit Sub
If String.IsNullOrEmpty(File) Then Return
RunInThread(
Sub()
Try
@@ -109,30 +109,61 @@ 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")
Dim InitialProgress = Loader.Progress
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
If Loader IsNot Nothing AndAlso Loader.LoadingState <> MyLoading.MyLoadingState.Run Then Return
RetryCount += 1
GoTo Retry
Else
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 "不同类型整合包的安装方法"
@@ -182,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"), "")
@@ -190,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
@@ -243,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)
@@ -283,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))
'设置图标
@@ -377,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)
@@ -420,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
@@ -436,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")
@@ -500,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()
@@ -584,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"
@@ -680,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 & " "
@@ -726,24 +691,23 @@ 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 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 & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
Sub(Delta) Task.Progress += 0.35 * Delta)
Else
Log("[ModPack] 整合包中未找到 overrides 目录,已跳过")
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
PathMcFolder & "versions\" & VersionName,
Task, 0.4)
'JVM 参数
If Json("launchInfo") IsNot Nothing Then
Dim LaunchInfo As JObject = Json("launchInfo")
If LaunchInfo.ContainsKey("javaArgument") Then WriteIni(SetupFile, "VersionAdvanceJvm", String.Join(" ", LaunchInfo("javaArgument")))
If LaunchInfo.ContainsKey("launchArgument") Then WriteIni(SetupFile, "VersionAdvanceGame", String.Join(" ", LaunchInfo("launchArgument")))
End If
Task.Progress = 0.95
'开启版本隔离
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
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 整合包未提供游戏版本附加信息,无法安装!")
@@ -765,16 +729,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 & " "
@@ -15,7 +15,7 @@
TriggerLauncherShutdown = False
End If
Next
If IsWatcherRunning = IsRunning Then Exit Sub
If IsWatcherRunning = IsRunning Then Return
IsWatcherRunning = IsRunning
If IsWatcherRunning Then
MinecraftStart()
@@ -81,7 +81,7 @@
WatcherStateChanged()
'初始化进程与日志读取
Me.GameProcess = Loader.Input
GameProcess = Loader.Input
GameProcess.BeginOutputReadLine()
GameProcess.BeginErrorReadLine()
AddHandler GameProcess.OutputDataReceived, AddressOf LogReceived
@@ -118,7 +118,7 @@
Return _State
End Get
Set(value As MinecraftState)
If _State = value Then Exit Property
If _State = value Then Return
_State = value
WatcherStateChanged()
End Set
@@ -144,7 +144,7 @@
'输出文本
Dim Copyed As New List(Of String)
SyncLock WaitingLogLock
If Not WaitingLog.Any() Then Exit Sub
If Not WaitingLog.Any() Then Return
Copyed = WaitingLog
WaitingLog = New List(Of String)(1000)
End SyncLock
@@ -180,8 +180,9 @@
Public LatestLog As New Queue(Of String)
Private Sub GameLog(Text As String)
'预处理
If Text Is Nothing Then Exit Sub
If Text Is Nothing Then Return
Text = Text.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf)
'If Text.Contains("�����") Then Hint("检测到错误的日志编码:" & Text)
'加入预存储
LatestLog.Enqueue(Text)
If LatestLog.Count >= 501 Then LatestLog.Dequeue()
@@ -256,8 +257,8 @@
Private WindowHandle As IntPtr
Private Sub TimerWindow()
Try
If GameProcess.HasExited Then Exit Sub
If IsWindowFinished Then Exit Sub
If GameProcess.HasExited Then Return
If IsWindowFinished Then Return
'获取全部窗口,检查是否有新增的
Dim MinecraftWindow As KeyValuePair(Of IntPtr, String)? = Nothing
Try
@@ -267,7 +268,7 @@
Log(ex, "由于反作弊或安全软件拦截,PCL 无法操作游戏窗口", LogLevel.Hint)
IsWindowFinished = True
End Try
If MinecraftWindow Is Nothing Then Exit Sub
If MinecraftWindow Is Nothing Then Return
Dim MinecraftWindowName = MinecraftWindow.Value.Value, MinecraftWindowHandle = MinecraftWindow.Value.Key
'已找到窗口
If Not MinecraftWindowName.StartsWithF("FML") Then
@@ -307,27 +308,27 @@
TryGetMinecraftWindow = Nothing
EnumWindows(
Sub(hwnd As IntPtr, lParam As Integer)
If TryGetMinecraftWindow IsNot Nothing Then Exit Sub
If TryGetMinecraftWindow IsNot Nothing Then Return
'检查类名
Dim str As New StringBuilder(512)
GetClassName(hwnd, str, str.Capacity)
Dim ClassName As String = str.ToString
If Not (ClassName = "GLFW30" OrElse ClassName = "LWJGL" OrElse ClassName = "SunAwtFrame") Then Exit Sub
If Not (ClassName = "GLFW30" OrElse ClassName = "LWJGL" OrElse ClassName = "SunAwtFrame") Then Return
'获取窗口标题名
str = New StringBuilder(512)
GetWindowText(hwnd, str, str.Capacity)
Dim WindowText As String = str.ToString
'有的 Mod 可以修改窗口标题,所以不能检测是否为 Minecraft 打头,这并不准确
'部分版本会搞个 GLFW message window 出来所以得反选
If Not (WindowText.StartsWithF("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWithF("GLFW")) Then Exit Sub
If Not (WindowText.StartsWithF("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWithF("GLFW")) Then Return
'获取窗口关联的进程
Dim ProcessId As Integer
GetWindowThreadProcessId(hwnd, ProcessId)
Try
If Process.GetProcessById(ProcessId).StartTime < GameProcess.StartTime Then Exit Sub '需要是此后启动的进程
If Process.GetProcessById(ProcessId).StartTime < GameProcess.StartTime Then Return '需要是此后启动的进程
Catch ex As Exception
Log(ex, "枚举 Minecraft 窗口进程失败")
Exit Sub
Return
End Try
'返回
TryGetMinecraftWindow = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText)
@@ -344,7 +345,7 @@
'崩溃处理
Private Sub Crashed()
If State = MinecraftState.Crashed OrElse State = MinecraftState.Ended Then Exit Sub
If State = MinecraftState.Crashed OrElse State = MinecraftState.Ended Then Return
State = MinecraftState.Crashed
'崩溃分析
WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
+5 -5
View File
@@ -1,7 +1,7 @@
Public Module ModEvent
Public Sub TryStartEvent(Type As String, Data As String)
If String.IsNullOrWhiteSpace(Type) Then Exit Sub
If String.IsNullOrWhiteSpace(Type) Then Return
Dim RealData As String() = {""}
If Data IsNot Nothing Then RealData = Data.Split("|")
StartEvent(Type, RealData)
@@ -15,7 +15,7 @@
Data(0) = Data(0).Replace("\", "/")
If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200)
MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
Exit Sub
Return
End If
Hint("正在开启中,请稍候……")
OpenWebsite(Data(0))
@@ -39,7 +39,7 @@
Case 2
Setup.Set("HintCustomCommand", True)
Case 3
Exit Sub
Return
End Select
End If
Dim Info As New ProcessStartInfo With {
@@ -58,7 +58,7 @@
If Data(0) = "\current" Then
If McVersionCurrent Is Nothing Then
Hint("请先选择一个 Minecraft 版本!", HintType.Critical)
Exit Sub
Return
Else
Data(0) = McVersionCurrent.Name
End If
@@ -100,7 +100,7 @@
Data(0) = Data(0).Replace("\", "/")
If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Exit Sub
Return
End If
Try
Select Case Data.Length
+33 -20
View File
@@ -34,12 +34,12 @@ Public Module ModMain
''' <summary>
''' 等待弹出的提示列表。以 {String, HintType, Log As Boolean} 形式存储为数组。
''' </summary>
Private HintWaiting As List(Of HintMessage) = If(HintWaiting, New List(Of HintMessage))
Private HintWaiting As SafeList(Of HintMessage) = If(HintWaiting, New SafeList(Of HintMessage))
''' <summary>
''' 在窗口左下角弹出提示文本。
''' </summary>
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Info, Optional Log As Boolean = True)
If HintWaiting Is Nothing Then HintWaiting = New List(Of HintMessage)
If HintWaiting Is Nothing Then HintWaiting = New SafeList(Of HintMessage)
HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
End Sub
@@ -47,7 +47,7 @@ Public Module ModMain
Try
'Tag 存储了:{ 是否可以重用, Uuid }
If Not HintWaiting.Any() Then Exit Sub
If Not HintWaiting.Any() Then Return
Do While HintWaiting.Any
''清除空提示
'If IsNothing(HintWaiting(0)) OrElse IsNothing(HintWaiting(0)(0)) Then
@@ -343,7 +343,7 @@ EndHint:
Public WaitingMyMsgBox As List(Of MyMsgBoxConverter) = If(WaitingMyMsgBox, New List(Of MyMsgBoxConverter))
Public Sub MyMsgBoxTick()
Try
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Exit Sub
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing OrElse FrmMain.WindowState = WindowState.Minimized Then Return
If FrmMain.PanMsg.Children.Count > 0 Then
'弹窗中
FrmMain.PanMsg.Visibility = Visibility.Visible
@@ -405,6 +405,9 @@ EndHint:
Public FrmDownloadFabric As PageDownloadFabric
Public FrmDownloadMod As PageDownloadMod
Public FrmDownloadPack As PageDownloadPack
Public FrmDownloadDataPack As PageDownloadDataPack
Public FrmDownloadShader As PageDownloadShader
Public FrmDownloadResourcePack As PageDownloadResourcePack
'设置页面声明
Public FrmSetupLeft As PageSetupLeft
@@ -634,7 +637,7 @@ NextFile:
Catch ex As Exception
Log(ex, "检查帮助文件夹失败", LogLevel.Msgbox)
End Try
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
'将文件实例化
Dim Dict As New List(Of HelpEntry)
@@ -650,7 +653,7 @@ NextFile:
'回设
If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
If Loader.IsAborted Then Exit Sub
If Loader.IsAborted Then Return
Loader.Output = Dict
Catch ex As Exception
@@ -693,8 +696,8 @@ NextFile:
Private AprilDistance As Integer = 0
Private Sub TimerFool()
Try
If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Exit Sub
If IsAprilGiveup OrElse FrmMain.PageCurrent <> FormMain.PageType.Launch OrElse AniControlEnabled <> 0 OrElse Not FrmLaunchLeft.BtnLaunch.IsLoaded Then Exit Sub
If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Return
If IsAprilGiveup OrElse FrmMain.PageCurrent <> FormMain.PageType.Launch OrElse AniControlEnabled <> 0 OrElse Not FrmLaunchLeft.BtnLaunch.IsLoaded Then Return
'计算是否空闲
Dim MousePos = FrmMain.lastMouseArg.GetPosition(FrmMain)
@@ -763,7 +766,7 @@ NextFile:
'移动
AprilSpeed = AprilSpeed * 0.8 + Acc
Dim SpeedValue = Math.Min(60, AprilSpeed.Length)
If SpeedValue < 0.01 Then Exit Sub
If SpeedValue < 0.01 Then Return
AprilSpeed.Normalize()
AprilSpeed *= SpeedValue
AprilDistance += SpeedValue
@@ -873,17 +876,26 @@ NextFile:
End Sub
''' <summary>
''' 申请一个可用于任务缓存的临时文件夹,以 \ 结尾。
''' 这些文件夹无需进行后续清理。
''' 申请一个可用于任务缓存的临时文件夹,以 \ 结尾。这些文件夹无需进行后续清理。
''' 若所有缓存位置均没有权限,会抛出异常。
''' </summary>
''' <param name="RequireNonSpace">是否要求路径不包含空格。</param>
Public Function RequestTaskTempFolder(Optional RequireNonSpace As Boolean = False) As String
TryClearTaskTemp()
RequestTaskTempFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
If RequireNonSpace AndAlso RequestTaskTempFolder.Contains(" ") Then
RequestTaskTempFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
End If
Directory.CreateDirectory(RequestTaskTempFolder)
Dim ResultFolder As String
Try
ResultFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
If RequireNonSpace AndAlso ResultFolder.Contains(" ") Then Exit Try '带空格
Directory.CreateDirectory(ResultFolder)
CheckPermissionWithException(ResultFolder)
Return ResultFolder
Catch
End Try
'使用备用路径
ResultFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
Directory.CreateDirectory(ResultFolder)
CheckPermission(ResultFolder)
Return ResultFolder
End Function
#End Region
@@ -901,7 +913,7 @@ NextFile:
If ThemeDontClick = 2 Then ThemeRefresh()
#End Region
Catch ex As Exception
Log(ex, "短程主时钟执行异常", LogLevel.Assert)
Log(ex, "短程主时钟执行异常", LogLevel.Critical)
End Try
Timer4Count += 1
If Timer4Count = 4 Then
@@ -921,7 +933,8 @@ NextFile:
#Region "每 7.5s 执行一次的代码"
If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDistance <> 0 Then FrmMain.BtnExtraApril.Ribble()
'以未知原因窗口被丢到一边去的修复(Top、Left = -25600),还有 #745
RunInUi(Sub()
RunInUi(
Sub()
If Not FrmMain.Hidden Then
If FrmMain.Top < -9000 Then FrmMain.Top = 100
If FrmMain.Left < -9000 Then FrmMain.Left = 100 '窗口拉至最大时 Left = -18.8
@@ -929,7 +942,7 @@ NextFile:
End Sub)
#End Region
Catch ex As Exception
Log(ex, "长程主时钟执行异常", LogLevel.Assert)
Log(ex, "长程主时钟执行异常", LogLevel.Critical)
End Try
End If
End Sub
@@ -945,7 +958,7 @@ NextFile:
Log(ex, "程序主时钟出错", LogLevel.Feedback)
End Try
End Sub, "Timer Main")
If Not IsAprilEnabled Then Exit Sub
If Not IsAprilEnabled Then Return
RunInNewThread(
Sub()
Try
@@ -245,7 +245,12 @@
RunInThread(
Sub()
Log("[Music] 已恢复播放")
Try
MusicNAudio?.Play()
Catch 'https://github.com/Hex-Dragon/PCL2/pull/5415#issuecomment-2751135223
MusicNAudio?.Stop()
MusicNAudio?.Play()
End Try
MusicRefreshUI()
End Sub)
Return True
@@ -273,6 +278,7 @@
'开始播放
CurrentWave = New NAudio.Wave.WaveOutEvent()
MusicNAudio = CurrentWave
CurrentWave.DeviceNumber = -1
Reader = New NAudio.Wave.AudioFileReader(MusicCurrent)
CurrentWave.Init(Reader)
CurrentWave.Play()
+44 -27
View File
@@ -1,7 +1,5 @@
'由于包含加解密等安全信息,本文件中的部分代码已被删除
Imports System.Net
Imports System.Reflection
Imports System.Security.Cryptography
Friend Module ModSecret
@@ -69,26 +67,6 @@ Friend Module ModSecret
If Not DataList.Any(Function(d) d.Contains("-Dlog4j2.formatMsgNoLookups=true")) Then DataList.Add("-Dlog4j2.formatMsgNoLookups=true")
End Sub
''' <summary>
''' 打码字符串中的 AccessToken。
''' </summary>
Friend Function SecretFilter(Raw As String, FilterChar As Char) As String
'打码 "accessToken " 后的内容
If Raw.Contains("accessToken ") Then
For Each Token In RegexSearch(Raw, "(?<=accessToken ([^ ]{5}))[^ ]+(?=[^ ]{5})")
Raw = Raw.Replace(Token, New String(FilterChar, Token.Count))
Next
End If
'打码当前登录的结果
Dim AccessToken As String = McLoginLoader.Output.AccessToken
If AccessToken Is Nothing OrElse AccessToken.Length < 10 OrElse Not Raw.ContainsF(AccessToken, True) OrElse
McLoginLoader.Output.Uuid = McLoginLoader.Output.AccessToken Then 'UUID 和 AccessToken 一样则不打码
Return Raw
Else
Return Raw.Replace(AccessToken, Left(AccessToken, 5) & New String(FilterChar, AccessToken.Length - 10) & Right(AccessToken, 5))
End If
End Function
#End Region
#Region "网络鉴权"
@@ -200,12 +178,51 @@ Friend Module ModSecret
Public ThemeDontClick As Integer = 0
Public Sub ThemeRefresh(Optional NewTheme As Integer = -1)
Hint("该版本中不包含主题功能……")
Try
If ThemeNow = NewTheme AndAlso NewTheme >= 0 Then Return
If NewTheme >= 0 Then ThemeNow = NewTheme
Color1 = New MyColor().FromHSL2(ColorHue, ColorSat * 0.2, 25 + ColorLightAdjust * 0.3)
Color2 = New MyColor().FromHSL2(ColorHue, ColorSat, 45 + ColorLightAdjust)
Color3 = New MyColor().FromHSL2(ColorHue, ColorSat, 55 + ColorLightAdjust)
Color4 = New MyColor().FromHSL2(ColorHue, ColorSat, 65 + ColorLightAdjust)
Color5 = New MyColor().FromHSL2(ColorHue, ColorSat, 80 + ColorLightAdjust * 0.4)
Color6 = New MyColor().FromHSL2(ColorHue, ColorSat, 91 + ColorLightAdjust * 0.1)
Color7 = New MyColor().FromHSL2(ColorHue, ColorSat, 95)
Color8 = New MyColor().FromHSL2(ColorHue, ColorSat, 97)
ColorBg0 = Color4 * 0.4 + Color5 * 0.4 + ColorGray4 * 0.2
ColorBg1 = New MyColor(190, Color7)
ColorSemiTransparent = New MyColor(1, Color8)
Application.Current.Resources("ColorBrush1") = New SolidColorBrush(Color1)
Application.Current.Resources("ColorBrush2") = New SolidColorBrush(Color2)
Application.Current.Resources("ColorBrush3") = New SolidColorBrush(Color3)
Application.Current.Resources("ColorBrush4") = New SolidColorBrush(Color4)
Application.Current.Resources("ColorBrush5") = New SolidColorBrush(Color5)
Application.Current.Resources("ColorBrush6") = New SolidColorBrush(Color6)
Application.Current.Resources("ColorBrush7") = New SolidColorBrush(Color7)
Application.Current.Resources("ColorBrush8") = New SolidColorBrush(Color8)
Application.Current.Resources("ColorBrushBg0") = New SolidColorBrush(ColorBg0)
Application.Current.Resources("ColorBrushBg1") = New SolidColorBrush(ColorBg1)
Application.Current.Resources("ColorObject1") = CType(Color1, Color)
Application.Current.Resources("ColorObject2") = CType(Color2, Color)
Application.Current.Resources("ColorObject3") = CType(Color3, Color)
Application.Current.Resources("ColorObject4") = CType(Color4, Color)
Application.Current.Resources("ColorObject5") = CType(Color5, Color)
Application.Current.Resources("ColorObject6") = CType(Color6, Color)
Application.Current.Resources("ColorObject7") = CType(Color7, Color)
Application.Current.Resources("ColorObject8") = CType(Color8, Color)
Application.Current.Resources("ColorObjectBg0") = CType(ColorBg0, Color)
Application.Current.Resources("ColorObjectBg1") = CType(ColorBg1, Color)
ThemeRefreshMain()
Catch ex As Exception
Log(ex, "刷新主题颜色失败", LogLevel.Hint)
End Try
End Sub
Public Sub ThemeRefreshMain()
RunInUi(
Sub()
If Not FrmMain.IsLoaded Then Exit Sub
If Not FrmMain.IsLoaded Then Return
'顶部条背景
Dim Brush = New LinearGradientBrush With {.EndPoint = New Point(1, 0), .StartPoint = New Point(0, 0)}
If ThemeNow = 5 Then
@@ -236,9 +253,9 @@ Friend Module ModSecret
'主页面背景
If Setup.Get("UiBackgroundColorful") Then
Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)}
Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 20, Math.Min(60, ColorSat) * 0.5, 80)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.9, 90)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1.1, .Color = New MyColor().FromHSL2(ColorHue + 20, Math.Min(60, ColorSat) * 0.5, 80)})
Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 15, ColorSat * 0.8, 91)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.8, 91)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1.1, .Color = New MyColor().FromHSL2(ColorHue + 15, ColorSat * 0.8, 91)})
FrmMain.PanForm.Background = Brush
Else
FrmMain.PanForm.Background = New MyColor(245, 245, 245)
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.9.2.0")>
<Assembly: AssemblyFileVersion("2.9.2.0")>
<Assembly: AssemblyVersion("2.10.1.0")>
<Assembly: AssemblyFileVersion("2.10.1.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -19,7 +19,7 @@
Return LabTitle.Text
End Get
Set(value As String)
If LabTitle.Text = value Then Exit Property
If LabTitle.Text = value Then Return
LabTitle.Text = value
End Set
End Property
@@ -30,7 +30,7 @@
Return If(LabTitleRaw?.Text, "")
End Get
Set(value As String)
If LabTitleRaw.Text = value Then Exit Property
If LabTitleRaw.Text = value Then Return
LabTitleRaw.Text = value
LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
End Set
@@ -42,7 +42,7 @@
Return LabInfo.Text
End Get
Set(value As String)
If LabInfo.Text = value Then Exit Property
If LabInfo.Text = value Then Return
LabInfo.Text = value
End Set
End Property
@@ -88,11 +88,11 @@
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
If e.Handled Then Return
Log("[Control] 按下资源工程列表项:" & LabTitle.Text)
End If
End Sub
Private Sub ProjectClick(sender As MyCompItem, e As EventArgs) Handles Me.Click
Private Sub MyCompItem_Click(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
@@ -103,26 +103,37 @@
FrmMain.PageCurrent.Additional(1) = Titles
End If
'打开详情页
Dim TargetVersion As String
Dim TargetLoader As CompModLoaderType
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
Dim TargetType As CompType
Dim TargetVersion As String = Nothing
Dim TargetLoader As CompModLoaderType = CompModLoaderType.Any
If FrmMain.PageCurrent.Page = FormMain.PageType.Download Then
'从下载页进入
Select Case FrmMain.PageCurrentSub
Case FormMain.PageSubType.DownloadMod
TargetType = CompType.Mod
TargetVersion = FrmDownloadMod.Content.Loader.Input.GameVersion
TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoader
Case FormMain.PageSubType.DownloadPack
TargetType = CompType.ModPack
TargetVersion = FrmDownloadPack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadDataPack
TargetType = CompType.DataPack
TargetVersion = FrmDownloadDataPack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadResourcePack
TargetType = CompType.ResourcePack
TargetVersion = FrmDownloadResourcePack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadShader
TargetType = CompType.Shader
TargetVersion = FrmDownloadShader.Content.Loader.Input.GameVersion
End Select
Else
'从详情页进入(查看前置)
TargetType = CompType.Any '允许任意类别
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 Else 'CompType.ResourcePack
'FUTURE: Res
TargetVersion = "" 'If(PageDownloadResource.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}})
.Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader, TargetType}})
End Sub
'鼠标点击判定
@@ -174,7 +185,7 @@
''' </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
If Not CanInteraction Then Return
'判断当前颜色
Dim StateNew As String, Time As Integer
If IsMouseOver Then
@@ -189,7 +200,7 @@
StateNew = "Idle"
Time = 180
End If
If StateLast = StateNew Then Exit Sub
If StateLast = StateNew Then Return
StateLast = StateNew
'触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
@@ -0,0 +1,95 @@
<local:MyScrollViewer x:Class="PageComp"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:local="clr-namespace:PCL"
mc:Ignorable="d"
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled">
<StackPanel Orientation="Vertical" Margin="25">
<local:MyCard Title="搜索XXX" Margin="0,0,0,15" x:Name="PanAlways">
<StackPanel Margin="25,40,25,15">
<Grid Margin="0,0,0,11" HorizontalAlignment="Stretch">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1.3*" />
<ColumnDefinition Width="1.2*" />
<ColumnDefinition Width="50" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="名称" Margin="0,0,18,0" />
<local:MyTextBox x:Name="TextSearchName" Grid.Column="1" Grid.ColumnSpan="2" />
<TextBlock VerticalAlignment="Center" Grid.Column="4" HorizontalAlignment="Left" Text="来源" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchSource" Grid.Column="5">
<local:MyComboBoxItem Content="全部" Tag="3" IsSelected="True" />
<local:MyComboBoxItem Content="CurseForge" Tag="1" />
<local:MyComboBoxItem Content="Modrinth" Tag="2" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.5" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
<local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" MaxDropDownHeight="320" Margin="10,0,0,0">
<local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="NeoForge" Tag="6" />
<local:MyComboBoxItem Content="Fabric" Tag="4" />
<local:MyComboBoxItem Content="Quilt" Tag="5" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" MaxDropDownHeight="320" />
</Grid>
<Grid Margin="0,4,0,6" Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnSearchRun" Text="搜索" MinWidth="140" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" />
<local:MyButton x:Name="BtnSearchReset" Text="重置条件" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" />
<local:MyButton x:Name="BtnSearchInstallModPack" Text="安装已有整合包" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="2"
ToolTip="在当前选择的 Minecraft 文件夹下安装整合包" ToolTipService.HorizontalOffset="-55" ToolTipService.VerticalOffset="5" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel x:Name="PanContent">
<local:MyHint x:Name="HintError" HasBorder="True" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。&#xa;请稍后重试,或使用 VPN 以改善网络环境。" Theme="Yellow" Margin="0,0,0,15" />
<local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard>
<local:MyCard Margin="0,15,0,0" x:Name="CardPages" HorizontalAlignment="Center">
<StackPanel Orientation="Horizontal" Height="23" Margin="10,7">
<local:MyIconButton x:Name="BtnPageFirst" IsEnabled="False" Opacity="0.2" Margin="0,0.5,5,0.5"
Logo="M496.213333 329.856L315.306667 510.848l180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z m298.666667 0l-180.949333 180.992 180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z" />
<local:MyIconButton x:Name="BtnPageLeft" IsEnabled="False" Opacity="0.2" Margin="0,0,5,0"
Logo="M650.752 278.357333l-241.322667 241.365334 241.322667 241.365333a42.666667 42.666667 0 1 1-60.330667 60.330667l-271.530666-271.530667a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.416-27.648l271.530666-271.530666a42.666667 42.666667 0 0 1 60.330667 60.330666z" />
<TextBlock x:Name="LabPage" Text="1"
Margin="8,0,13,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight" Margin="0,0,30,0"
Logo="M404.309333 278.357333l241.322667 241.365334-241.322667 241.365333a42.666667 42.666667 0 1 0 60.330667 60.330667l271.530667-271.530667a42.453333 42.453333 0 0 0 11.818666-22.613333l0.597334-5.034667v-5.034667a42.496 42.496 0 0 0-12.416-27.648L464.64 218.026667a42.666667 42.666667 0 0 0-60.330667 60.330666z" />
</StackPanel>
</local:MyCard>
</StackPanel>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取XXX列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
@@ -1,8 +1,71 @@
Public Class PageDownloadMod
Imports System.Windows.Markup
<ContentProperty("SearchTags")>
Public Class PageComp
#Region "属性"
Public Const PageSize = 40
''' <summary>
''' 在切换到该页面时自动设置的目标版本。
''' 用于 XAML 快速设置的 Tag 下拉框列表。
''' </summary>
Public ReadOnly Property SearchTags As ItemCollection
Get
Return ComboSearchTag.Items
End Get
End Property
''' <summary>
''' 英文前后不含空格的可读资源类型名,例如 "Mod"、"整合包"。
''' </summary>
Public Property TypeName As String
Get
Return _TypeName
End Get
Set(Value As String)
If _TypeName = Value Then Return
_TypeName = Value
Loader.Name = $"社区资源获取:{Value}"
End Set
End Property
Private _TypeName As String = ""
''' <summary>
''' 英文前后含一个空格的可读资源类型名,例如 " Mod "、"整合包"。
''' </summary>
Public Property TypeNameSpaced As String
Get
Return _TypeNameSpaced
End Get
Set(Value As String)
If _TypeNameSpaced = Value Then Return
_TypeNameSpaced = Value
PanAlways.Title = $"搜索{Value}"
Load.Text = $"正在获取{Value}列表"
End Set
End Property
Private _TypeNameSpaced As String = ""
''' <summary>
''' 该页面对应的资源类型。
''' </summary>
Public Property PageType As CompType
Get
Return _Type
End Get
Set(Value As CompType)
If _Type = Value Then Return
_Type = Value
BtnSearchInstallModPack.Visibility = If(Value = CompType.ModPack, Visibility.Visible, Visibility.Collapsed)
End Set
End Property
Private _Type As CompType = -1
#End Region
#Region "加载"
''' <summary>
''' 在切换到页面时,应自动将筛选项设置为与该目标 MC 版本和加载器相同。
''' </summary>
Public Shared TargetVersion As McVersion = Nothing
''' <summary>
@@ -10,12 +73,11 @@
''' </summary>
Public Shared TargetName As String = Nothing
'加载器信息
Public Shared Loader As New LoaderTask(Of CompProjectRequest, Integer)("CompProject Mod", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Public Shared Storage As New CompProjectStorage
Public Shared Page As Integer = 0
'在点击 MyCompItem 时会获取 Loader 的输入,以使资源详情页面可以应用相同的筛选项
Public Loader As New LoaderTask(Of CompProjectRequest, Integer)("社区资源获取:XXX", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Private IsLoaderInited As Boolean = False
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Loaded
Private Sub PageCompControls_Inited(sender As Object, e As EventArgs) Handles Me.Loaded
'不知道从 Initialized 改成 Loaded 会不会有问题,但用 Initialized 会导致初始的筛选器修改被覆盖回默认值
If TargetVersion IsNot Nothing Then
'设置目标
@@ -43,47 +105,51 @@
End If
'如果已经完成请求,则重新开始
If IsLoaderInited Then StartNewSearch()
PanScroll.ScrollToHome()
ScrollToHome()
End If
'加载器初始化
If IsLoaderInited Then Return
IsLoaderInited = True
PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
CType(Parent, MyPageRight).PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
If McVersionHighest = -1 Then McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1)))
End Sub
Private Shared Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(CompType.Mod, Storage, (Page + 1) * PageSize)
If FrmDownloadMod IsNot Nothing Then
Dim ModLoader As CompModLoaderType = Val(FrmDownloadMod.ComboSearchLoader.SelectedItem.Tag)
Dim GameVersion As String = If(FrmDownloadMod.TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(FrmDownloadMod.TextSearchVersion.Text.Contains(".") OrElse FrmDownloadMod.TextSearchVersion.Text.Contains("w"), FrmDownloadMod.TextSearchVersion.Text, Nothing))
If GameVersion IsNot Nothing AndAlso GameVersion.Contains(".") AndAlso Val(GameVersion.Split(".")(1)) < 14 AndAlso '1.14-
ModLoader = CompModLoaderType.Forge Then '选择了 Forge
ModLoader = CompModLoaderType.Any '此时,视作没有筛选 Mod Loader(因为部分老 Mod 没有设置自己支持的加载器)
End If
Private Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(PageType, Storage, (Page + 1) * PageSize)
Dim GameVersion As String = If(TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w"), TextSearchVersion.Text, Nothing))
If TargetName IsNot Nothing Then
FrmDownloadMod.TextSearchName.Text = TargetName
TargetName = Nothing
End If
With Request
.SearchText = FrmDownloadMod.TextSearchName.Text
.SearchText = TextSearchName.Text
.GameVersion = GameVersion
.Tag = FrmDownloadMod.ComboSearchTag.SelectedItem.Tag
.ModLoader = ModLoader
.Source = CType(Val(FrmDownloadMod.ComboSearchSource.SelectedItem.Tag), CompSourceType)
.Tag = ComboSearchTag.SelectedItem.Tag
.ModLoader = If(PageType = CompType.Mod, Val(ComboSearchLoader.SelectedItem.Tag), CompModLoaderType.Any)
.Source = CType(Val(ComboSearchSource.SelectedItem.Tag), CompSourceType)
End With
End If
Return Request
End Function
#End Region
Public Storage As New CompProjectStorage
''' <summary>
''' 每页展示的结果数量。
''' </summary>
Public Const PageSize = 40
Public Page As Integer = 0
'结果 UI 化
Private Sub Load_OnFinish()
Try
Log($"[Comp] 开始可视化 Mod 列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
Log($"[Comp] 开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
'列表项
PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
PanProjects.Children.Add(Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing, Loader.Input.ModLoader = CompModLoaderType.Any))
PanProjects.Children.Add(Storage.Results(i).ToCompItem(
ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing,
ShowLoaderDesc:=Loader.Input.ModLoader = CompModLoaderType.Any AndAlso (PageType = CompType.Mod OrElse PageType = CompType.ModPack)))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
@@ -107,9 +173,9 @@
HintError.Text = Storage.ErrorMessage
End If
'强制返回顶部
PanBack.ScrollToTop()
ScrollToTop()
Catch ex As Exception
Log(ex, "可视化 Mod 列表出错", LogLevel.Feedback)
Log(ex, $"可视化{TypeNameSpaced}列表出错", LogLevel.Feedback)
End Try
End Sub
@@ -120,14 +186,13 @@
Dim ErrorMessage As String = ""
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Download] 下载的 Mod 列表 json 文件损坏,已自动重试", LogLevel.Debug)
PageLoaderRestart()
Log($"[Download] 下载的{TypeNameSpaced}列表 json 文件损坏,已自动重试", LogLevel.Debug)
CType(Parent, MyPageRight).PageLoaderRestart()
End If
End Select
End Sub
'切换页码
Private Sub BtnPageFirst_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageFirst.Click
ChangePage(0)
End Sub
@@ -141,7 +206,7 @@
CardPages.IsEnabled = False
Page = NewPage
FrmMain.BackToTop()
Log($"[Download] Mod 切换到第 {Page + 1} 页")
Log($"[Download] {TypeName}:切换到第 {Page + 1} 页")
RunInThread(
Sub()
Thread.Sleep(100) '等待向上滚的动画结束
@@ -179,7 +244,7 @@
If Not TextSearchVersion.IsDropDownOpen Then UpdateSearchLoaderVisibility()
End Sub
Private Sub UpdateSearchLoaderVisibility() Handles TextSearchVersion.DropDownClosed
If TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w") Then
If PageType = CompType.Mod AndAlso (TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w")) Then
ComboSearchLoader.Visibility = Visibility.Visible
Grid.SetColumnSpan(TextSearchVersion, 1)
Else
@@ -191,4 +256,9 @@
#End Region
'安装已有整合包按钮
Private Sub BtnSearchInstallModPack_Click(sender As Object, e As EventArgs) Handles BtnSearchInstallModPack.Click
ModpackInstall()
End Sub
End Class
@@ -4,23 +4,31 @@
#Region "加载器"
Private CompFileLoader As New LoaderTask(Of Integer, List(Of CompFile))(
"Comp File", Sub(Task As LoaderTask(Of Integer, List(Of CompFile))) Task.Output = CompFilesGet(Project.Id, Project.FromCurseForge))
"Comp File",
Sub(Task)
LoadTargetFromAdditional()
Dim Result = CompFilesGet(Project.Id, Project.FromCurseForge)
If Task.IsAborted Then Return
Task.Output = Result
End Sub)
'初始化加载器信息
Private Sub PageDownloadCompDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
LoadTargetFromAdditional()
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish)
End Sub
Private Sub PageDownloadCompDetail_Loaded(sender As Object, e As EventArgs) Handles Me.Loaded
'Initialized 只会执行一次
Public Sub LoadTargetFromAdditional() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
PageType = FrmMain.PageCurrent.Additional(4)
End Sub
Private Project As CompProject
Private TargetVersion As String, TargetLoader As CompModLoaderType
''' <summary>
''' 当前页面应展示的内容类别。可能为 Any。
''' </summary>
Private PageType As CompType
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case CompFileLoader.State
@@ -62,18 +70,30 @@
Private VersionFilter As String
Private IsMajorVersionFilter As Boolean '是否按大版本号筛选(1.21 / 1.20 / 1.19 / ...)而非小版本号(1.21.1 / 1.21 / 1.20.4 / ...)
'筛选类型相同的结果(Modrinth 会返回 Mod、服务端插件、数据包混合的列表)
Private Function GetResults() As List(Of CompFile)
Dim Results As List(Of CompFile) = CompFileLoader.Output
If PageType = CompType.Any Then
Results = Results.Where(Function(r) r.Type <> CompType.Plugin).ToList
Else
Results = Results.Where(Function(r) r.Type = PageType).ToList
End If
Return Results
End Function
Private Sub Load_OnFinish()
Dim Results = GetResults()
'初始化筛选器
Dim VersionFilters As List(Of String)
'按小版本号筛选?
IsMajorVersionFilter = False
VersionFilters = CompFileLoader.Output.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
'按大版本号筛选?
If VersionFilters.Count >= 9 Then
IsMajorVersionFilter = True
VersionFilters = CompFileLoader.Output.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
End If
@@ -100,7 +120,7 @@
'自动选择
Dim ToCheck As MyRadioButton = Nothing
If TargetVersion <> "" Then
Dim TargetFile = CompFileLoader.Output.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
If TargetFile IsNot Nothing Then
Dim TargetGroup = GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True)
For Each Button As MyRadioButton In PanFilter.Children
@@ -118,24 +138,26 @@
UpdateFilterResult()
End Sub
Private Sub UpdateFilterResult()
Dim Results = GetResults()
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any,
$"所选版本:{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "")
'归类到卡片下
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName))
Dict.Add("其他版本", New List(Of CompFile))
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType)))
For Each Version As CompFile In CompFileLoader.Output
For Each Version As CompFile In Results
For Each GameVersion In Version.GameVersions
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
GetGroupedVersionName(GameVersion, IsMajorVersionFilter, True) <> VersionFilter Then Continue For
'决定添加到哪个卡片
Dim Ver As String = GetGroupedVersionName(GameVersion, False, False)
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
'遍历加入的加载器列表
Dim Loaders As New List(Of String)
If Project.ModLoaders.Count > 1 AndAlso '至少有两个加载器
Project.Type = CompType.Mod AndAlso '是 Mod
Ver.StartsWith("1.") Then '不是 “快照版本” 之类的
If Project.ModLoaders.Count > 1 AndAlso '工程至少有两个加载器
Version.Type = CompType.Mod AndAlso '是 Mod
VerName.StartsWith("1.") Then '不是 “快照版本” 之类的
For Each Loader In Version.ModLoaders
If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
@@ -144,16 +166,16 @@
If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的,确保它在一张卡片里
'实际添加
For Each Loader In Loaders
Dim TargetCard As String = Loader & Ver
Dim TargetCard As String = Loader & VerName
If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile))
If Not Dict(TargetCard).Contains(Version) Then Dict(TargetCard).Add(Version)
Next
Next
Next
'添加筛选的版本的卡片
If TargetCardName <> "" Then
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True).StartsWithF(VersionFilter)) Then
Dict.Add(TargetCardName, New List(Of CompFile))
For Each Version As CompFile In CompFileLoader.Output
For Each Version As CompFile In Results
If Version.GameVersions.Contains(TargetVersion) AndAlso
(TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then
'检查是否符合版本筛选器
@@ -169,7 +191,7 @@
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(Project.Type = CompType.ModPack, 9, 8)} 'FUTURE: Res
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(PageType = CompType.ModPack, 9, 8)} '9 是安装,8 是另存为
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
@@ -178,13 +200,13 @@
If Pair.Key = TargetCardName OrElse
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
MyCard.StackInstall(NewStack, If(Project.Type = CompType.ModPack, 9, 8), Pair.Key) 'FUTURE: Res
MyCard.StackInstall(NewStack, If(PageType = CompType.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为
Else
NewCard.IsSwaped = True
End If
'增加提示
If Pair.Key = "其他版本" Then
NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢,可能无法识别刚更新的 MC 版本,只需等待几天即可自动恢复正常。", .IsWarn = False, .Margin = New Thickness(0, 0, 0, 7)})
NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢,可能无法识别刚更新的 MC 版本。几天后即可正常识别。", .Theme = MyHint.Themes.Yellow, .Margin = New Thickness(5, 0, 0, 8)})
End If
Next
'如果只有一张卡片,展开第一张卡片
@@ -237,7 +259,7 @@
AniControlEnabled -= 1
End Sub
'整合包下载(安装)
'整合包安装
Public Sub Install_Click(sender As MyListItem, e As EventArgs)
Try
@@ -250,7 +272,7 @@
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Exit Sub
If String.IsNullOrEmpty(VersionName) Then Return
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
@@ -269,7 +291,7 @@
Case LoadState.Aborted
Hint(MyLoader.Name & "已取消!", HintType.Info)
Case LoadState.Loading
Exit Sub '不重新加载版本列表
Return '不重新加载版本列表
End Select
McInstallFailedClearFolder(MyLoader)
End Sub}
@@ -282,77 +304,89 @@
Log(ex, "下载资源整合包失败", LogLevel.Feedback)
End Try
End Sub
'Mod、资源包下载;整合包另存为
'资源下载;整合包另存为
Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹
Public Sub Save_Click(sender As Object, e As EventArgs)
Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
RunInNewThread(
Sub()
Try
Dim Desc As String = If(Project.Type = CompType.ModPack, "整合包", If(Project.Type = CompType.Mod, "Mod ", "资源包"))
Dim Desc As String = Nothing
Select Case File.Type
Case CompType.ModPack : Desc = "整合包"
Case CompType.Mod : Desc = "Mod "
Case CompType.ResourcePack : Desc = "资源包"
Case CompType.Shader : Desc = "光影包"
Case CompType.DataPack : Desc = "数据包"
End Select
'确认默认保存位置
Dim DefaultFolder As String = Nothing
If Project.Type = CompType.Mod Then
'获取 Mod 所需的加载器种类
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
If File.ModLoaders.Any Then '从文件中获取
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge) OrElse File.ModLoaders.Contains(CompModLoaderType.NeoForge)
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
ElseIf Project.ModLoaders.Any Then '从工程中获取
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge) OrElse File.ModLoaders.Contains(CompModLoaderType.NeoForge)
AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric)
If File.Type <> CompType.ModPack Then
Dim SubFolder As String = Nothing
Select Case Project.Type
Case CompType.Mod : SubFolder = "mods\"
Case CompType.ResourcePack : SubFolder = "resourcepacks\"
Case CompType.Shader : SubFolder = "shaderpacks\"
Case CompType.DataPack : SubFolder = "" '导航到版本根目录
End Select
Dim IsVersionSuitable As Func(Of McVersion, Boolean) = Nothing
'获取资源所需的加载器
Dim AllowedLoaders As New List(Of CompModLoaderType)
If File.ModLoaders.Any Then
AllowedLoaders = File.ModLoaders
ElseIf Project.ModLoaders.Any Then
AllowedLoaders = Project.ModLoaders
End If
If AllowForge IsNot Nothing AndAlso Not AllowForge AndAlso
AllowFabric IsNot Nothing AndAlso Not AllowFabric Then
AllowForge = Nothing : AllowFabric = Nothing
End If
Log("[Comp] 允许 Forge:" & If(AllowForge, "未知") & ",允许 Fabric:" & If(AllowFabric, "未知"))
'判断某个版本是否符合要求
Dim IsVersionSuitable As Func(Of McVersion, Boolean) =
Log($"[Comp] {Desc}要求的加载器种类:" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
'判断某个版本是否符合资源要求
IsVersionSuitable =
Function(Version)
If Not Version.IsLoaded Then Version.Load()
If Not Version.Modable Then Return False
'只对 Mod 和数据包进行版本检测
If Project.Type = CompType.Mod OrElse Project.Type = CompType.DataPack Then
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
If AllowForge AndAlso (Version.Version.HasForge OrElse Version.Version.HasNeoForge) Then Return True
If AllowFabric AndAlso Version.Version.HasFabric Then Return True
End If
'加载器
If Not AllowedLoaders.Any() Then Return True '无要求
If AllowedLoaders.Contains(CompModLoaderType.Forge) AndAlso Version.Version.HasForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.Fabric) AndAlso Version.Version.HasFabric Then Return True
If AllowedLoaders.Contains(CompModLoaderType.NeoForge) AndAlso Version.Version.HasNeoForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.LiteLoader) AndAlso Version.Version.HasLiteLoader Then Return True
Return False
End Function
'获取 Mod 默认下载位置
'获取常规资源默认下载位置
If CachedFolder IsNot Nothing Then
DefaultFolder = CachedFolder
Log("[Comp] 使用上次下载时的文件夹作为默认下载位置")
Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then
DefaultFolder = McVersionCurrent.PathIndie & "mods\"
DefaultFolder = $"{McVersionCurrent.PathIndie}{SubFolder}"
Directory.CreateDirectory(DefaultFolder)
Log("[Comp] 使用当前版本的 mods 文件夹作为默认下载位置(" & McVersionCurrent.Name & ")")
Log($"[Comp] 使用当前版本作为默认下载位置:{DefaultFolder}")
Else
'查找所有可能的版本
Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished
If NeedLoad Then
Hint("正在查找适合的游戏版本……")
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
End If
Dim SuitableVersions As New List(Of McVersion)
For Each Version As McVersion In McVersionList.Values.SelectMany(Function(l) l)
If IsVersionSuitable(Version) Then SuitableVersions.Add(Version)
Next
If Not SuitableVersions.Any() Then
Dim SuitableVersions = McVersionList.Values.SelectMany(Function(l) l).Where(Function(v) IsVersionSuitable(v)).
Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}"))
If SuitableVersions.Any Then
Dim SelectedVersion = SuitableVersions.
OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
First()
DefaultFolder = SelectedVersion.FullName
Directory.CreateDirectory(DefaultFolder)
Log($"[Comp] 使用适合的游戏版本作为默认下载位置:{DefaultFolder}")
Else
DefaultFolder = PathMcFolder
If NeedLoad Then
Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本!")
Hint("当前 MC 文件夹中没有找到适合此资源的版本!")
Else
Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If
Else '选择 Mod 数量最多的版本
Dim SelectedVersion = SuitableVersions.OrderBy(
Function(v)
Dim Info As New DirectoryInfo(v.PathIndie & "mods\")
Return If(Info.Exists, Info.GetFiles().Length, -1)
End Function).LastOrDefault()
DefaultFolder = SelectedVersion.PathIndie & "mods\"
Directory.CreateDirectory(DefaultFolder)
Log("[Comp] 使用适合的游戏版本作为默认下载位置(" & SelectedVersion.Name & ")")
End If
End If
End If
@@ -382,13 +416,13 @@
Dim Target As String
Target = SelectSaveFile("选择保存位置", FileName,
Desc & "文件|" &
If(Project.Type = CompType.Mod,
If(File.Type = CompType.Mod,
If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Exit Sub
If Not Target.Contains("\") Then Return
'构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & GetFileNameWithoutExtentionFromPath(Target) & " "
If Target <> DefaultFolder AndAlso Project.Type = CompType.Mod Then CachedFolder = GetPathFromFullPath(Target)
If Target <> DefaultFolder AndAlso File.Type = CompType.Mod Then CachedFolder = GetPathFromFullPath(Target)
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
'启动
@@ -0,0 +1,26 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadDataPack"
PanScroll="{Binding ElementName=Content}">
<local:PageComp x:Name="Content" PageType="DataPack" TypeName="数据包" TypeNameSpaced="数据包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Content="世界元素" Tag="/worldgen" />
<local:MyComboBoxItem Content="科技" Tag="6951/technology" />
<local:MyComboBoxItem Content="游戏机制" Tag="/game-mechanics" />
<local:MyComboBoxItem Content="运输" Tag="/transportation" />
<local:MyComboBoxItem Content="仓储" Tag="/storage" />
<local:MyComboBoxItem Content="魔法" Tag="6952/magic" />
<local:MyComboBoxItem Content="冒险" Tag="6948/adventure" />
<local:MyComboBoxItem Content="幻想" Tag="6949/" />
<local:MyComboBoxItem Content="装饰" Tag="/decoration" />
<local:MyComboBoxItem Content="生物" Tag="/mobs" />
<local:MyComboBoxItem Content="实用" Tag="6953/utility" />
<local:MyComboBoxItem Content="装备与工具" Tag="/equipment" />
<local:MyComboBoxItem Content="性能优化" Tag="/optimization" />
<local:MyComboBoxItem Content="服务器" Tag="/social" />
<local:MyComboBoxItem Content="支持库" Tag="6950/library" />
<local:MyComboBoxItem Content="Mod 相关" Tag="6946/" />
</local:PageComp>
</local:MyPageRight>
@@ -0,0 +1,2 @@
Public Class PageDownloadDataPack
End Class
@@ -0,0 +1,35 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadMod"
PanScroll="{Binding ElementName=Content}">
<local:PageComp x:Name="Content" PageType="Mod" TypeName="Mod" TypeNameSpaced=" Mod ">
<local:MyComboBoxItem Content="全部" Tag="" IsSelected="True" />
<local:MyComboBoxItem Content="世界元素" Tag="406/worldgen" />
<local:MyComboBoxItem Content="生物群系" Tag="407/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="维度" Tag="410/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="矿物与资源" Tag="408/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="天然结构" Tag="409/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="科技" Tag="412/technology" />
<local:MyComboBoxItem Content="管道与物流" Tag="415/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="自动化" Tag="4843/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="能源" Tag="417/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="红石" Tag="4558/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="食物与烹饪" Tag="436/food" />
<local:MyComboBoxItem Content="农业" Tag="416/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="游戏机制" Tag="/game-mechanics" />
<local:MyComboBoxItem Content="运输" Tag="414/transportation" />
<local:MyComboBoxItem Content="仓储" Tag="420/storage" />
<local:MyComboBoxItem Content="魔法" Tag="419/magic" />
<local:MyComboBoxItem Content="冒险" Tag="422/adventure" />
<local:MyComboBoxItem Content="装饰" Tag="424/decoration" />
<local:MyComboBoxItem Content="生物" Tag="411/mobs" />
<local:MyComboBoxItem Content="实用" Tag="5191/utility" />
<local:MyComboBoxItem Content="装备与工具" Tag="434/equipment" />
<local:MyComboBoxItem Content="性能优化" Tag="/optimization" />
<local:MyComboBoxItem Content="信息显示" Tag="423/" />
<local:MyComboBoxItem Content="服务器" Tag="435/social" />
<local:MyComboBoxItem Content="支持库" Tag="421/library" />
</local:PageComp>
</local:MyPageRight>
@@ -0,0 +1,2 @@
Public Class PageDownloadMod
End Class
@@ -0,0 +1,28 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadPack"
PanScroll="{Binding ElementName=Content}">
<local:PageComp x:Name="Content" PageType="ModPack" TypeName="整合包" TypeNameSpaced="整合包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Tag="4484/" Content="多人" />
<local:MyComboBoxItem Tag="/optimization" Content="性能优化" />
<local:MyComboBoxItem Tag="4479/challenging" Content="硬核" />
<local:MyComboBoxItem Tag="4483/combat" Content="战斗" />
<local:MyComboBoxItem Tag="4478/quests" Content="任务" />
<local:MyComboBoxItem Tag="4472/technology" Content="科技" />
<local:MyComboBoxItem Tag="4473/magic" Content="魔法" />
<local:MyComboBoxItem Tag="4475/adventure" Content="冒险" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="水槽包" />
<local:MyComboBoxItem Tag="4476/" Content="探索" />
<local:MyComboBoxItem Tag="4477/" Content="小游戏" />
<local:MyComboBoxItem Tag="4471/" Content="科幻" />
<local:MyComboBoxItem Tag="4736/" Content="空岛" />
<local:MyComboBoxItem Tag="5128/" Content="原版改良" />
<local:MyComboBoxItem Tag="4487/" Content="FTB" ToolTip="由 FTB 官方发布" ToolTipService.HorizontalOffset="70" />
<local:MyComboBoxItem Tag="4480/" Content="基于地图" />
<local:MyComboBoxItem Tag="4481/lightweight" Content="轻量整合" />
<local:MyComboBoxItem Tag="4482/" Content="大型整合" />
</local:PageComp>
</local:MyPageRight>
@@ -0,0 +1,2 @@
Public Class PageDownloadPack
End Class
@@ -0,0 +1,45 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadResourcePack"
PanScroll="{Binding ElementName=Content}">
<local:PageComp x:Name="Content" PageType="ResourcePack" TypeName="资源包" TypeNameSpaced="资源包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Content="风格" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="原版风" Tag="403/vanilla-like" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="写实风" Tag="400/realistic" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="现代风" Tag="401/" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="中世纪" Tag="402/" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="蒸汽朋克" Tag="399/" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="主题化" Tag="/themed" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="简洁" Tag="/simplistic" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="装饰" Tag="/decoration" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="战斗" Tag="/combat" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="实用" Tag="/utility" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="改良" Tag="/tweaks" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="鬼畜" Tag="/cursed" />
<local:MyComboBoxItem Content="特性" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含实体" Tag="/entities" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含声音" Tag="/audio" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含字体" Tag="5244/fonts" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含模型" Tag="/models" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含语言" Tag="/locale" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="含 UI" Tag="/gui" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="核心着色器" Tag="/core-shaders" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="动态效果" Tag="404/" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="兼容 Mod" Tag="4465/modded" />
<local:MyComboBoxItem Content="分辨率" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="8x 或更低" Tag="/8x-" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="16x" Tag="393/16x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="32x" Tag="394/32x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="48x" Tag="/48x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="64x" Tag="395/64x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="128x" Tag="396/128x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="256x" Tag="397/256x" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="512x 或更高" Tag="398/512x+" />
</local:PageComp>
</local:MyPageRight>
@@ -0,0 +1,2 @@
Public Class PageDownloadResourcePack
End Class
@@ -0,0 +1,34 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadShader"
PanScroll="{Binding ElementName=Content}">
<local:PageComp x:Name="Content" PageType="Shader" TypeName="光影包" TypeNameSpaced="光影包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Content="风格" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="原版风" Tag="6555/vanilla-like" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="幻想风" Tag="6554/fantasy" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="写实风" Tag="6553/realistic" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="半写实风" Tag="/semi-realistic" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="卡通风" Tag="/cartoon" />
<local:MyComboBoxItem Content="特性" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="彩色光照" Tag="/colored-lighting" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="路径追踪" Tag="/path-tracing" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="PBR" Tag="/pbr" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="反射" Tag="/reflections" />
<local:MyComboBoxItem Content="性能负荷" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="极低" Tag="/potato" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="低" Tag="/low" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="中" Tag="/medium" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="高" Tag="/high" />
<local:MyComboBoxItem Content="加载器" IsEnabled="False" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="原版可用s" Tag="/vanilla" ToolTip="作为资源包加载,可以直接在原版游戏里使用。" ToolTipService.HorizontalOffset="70" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="Iris" Tag="/iris" />
<local:MyComboBoxItem Margin="15,0,0,0" Content="OptiFine" Tag="/optifine" />
</local:PageComp>
</local:MyPageRight>
@@ -0,0 +1,2 @@
Public Class PageDownloadShader
End Class
@@ -217,14 +217,14 @@ Public Module ModDownloadLib
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Exit Sub
If Not VersionFolder.Contains("\") Then Return
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Minecraft {Id} 服务端下载" Then Continue For
Hint("该服务端正在下载中!", HintType.Critical)
Exit Sub
Return
Next
Dim Loaders As New List(Of LoaderBase)
@@ -244,7 +244,7 @@ Public Module ModDownloadLib
Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载,没法下,撤退!", HintType.Critical)
Thread.Sleep(2000) '等玩家把上一个提示看完
Task.Abort()
Exit Sub
Return
End If
Dim JarUrl As String = McVersion.JsonObject("downloads")("server")("url")
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(McVersion.JsonObject("downloads")("server")("size"), -1), Hash:=McVersion.JsonObject("downloads")("server")("sha1"))
@@ -294,14 +294,14 @@ pause"
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Exit Sub
If Not VersionFolder.Contains("\") Then Return
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Return
Next
Dim Loaders As New List(Of LoaderBase)
@@ -383,7 +383,7 @@ pause"
WikiName = "Java版Pre-classic_" & Id
Else
Log("[Error] 未知的版本格式:" & Id & "。", LogLevel.Feedback)
Exit Sub
Return
End If
OpenWebsite("https://zh.minecraft.wiki/w/" & WikiName.Replace("_experimental-snapshot-", "-exp"))
End Sub
@@ -396,13 +396,13 @@ pause"
Try
Dim Id As String = DownloadInfo.NameVersion
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.NameFile, "OptiFine Jar (*.jar)|*.jar")
If Not Target.Contains("\") Then Exit Sub
If Not Target.Contains("\") Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"OptiFine {DownloadInfo.NameDisplay} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Return
Next
Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
@@ -434,16 +434,16 @@ pause"
End Try
'检查下载结果
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
If Task.IsAborted Then Exit Sub
If Task.IsAborted Then Return
If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。")
End If
End SyncLock
'添加 Java Wrapper 作为主 Jar
Dim Arguments As String
If UseJavaWrapper AndAlso Not Setup.Get("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer"
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer"
Else
Arguments = $"-Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" optifine.Installer"
Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer"
End If
If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动
@@ -545,8 +545,8 @@ pause"
Dim VersionFolder As String = McFolder & "versions\" & Id & "\"
Dim IsNewVersion As Boolean = DownloadInfo.Inherit.Contains("w") OrElse Val(DownloadInfo.Inherit.Split(".")(1)) >= 14
Dim Target As String = If(IsNewVersion,
RequestTaskTempFolder() & "temp",
McFolder & "libraries\optifine\OptiFine\" & DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "") & "\" & DownloadInfo.NameFile.Replace("OptiFine_", "OptiFine-").Replace("preview_", ""))
$"{RequestTaskTempFolder()}OptiFine.jar",
$"{McFolder}libraries\optifine\OptiFine\{DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "")}\{DownloadInfo.NameFile.Replace("OptiFine_", "OptiFine-").Replace("preview_", "")}")
Dim Loaders As New List(Of LoaderBase)
'获取下载地址
@@ -584,7 +584,7 @@ pause"
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
'等待原版文件下载完成
If ClientDownloadLoader Is Nothing Then Exit Sub
If ClientDownloadLoader Is Nothing Then Return
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
@@ -593,9 +593,9 @@ pause"
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsAborted Then Exit Sub
If Task.IsAborted Then Return
'拷贝原版文件
If Not IsCustomFolder Then Exit Sub
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
@@ -613,8 +613,8 @@ pause"
Log("[Download] 检测为新版 OptiFine:" & DownloadInfo.Inherit)
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine(方式 A)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim BaseMcFolderHome As String = RequestTaskTempFolder().TrimEnd("\")
Dim BaseMcFolder As String = BaseMcFolderHome & "\.minecraft\"
Dim BaseMcFolderHome As String = RequestTaskTempFolder()
Dim BaseMcFolder As String = BaseMcFolderHome & ".minecraft\"
Try
'准备安装环境
If Directory.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then
@@ -707,7 +707,7 @@ Retry:
'下载支持库
If FixLibrary Then
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 OptiFine 支持库文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
Sub(Task) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
Loaders.Add(New LoaderDownload("下载 OptiFine 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 4})
End If
@@ -831,7 +831,7 @@ Retry:
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Return
Next
'已有版本检查
@@ -840,7 +840,7 @@ Retry:
File.Delete(VersionFolder & VersionName & ".jar")
File.Delete(VersionFolder & VersionName & ".json")
Else
Exit Sub
Return
End If
End If
@@ -859,13 +859,13 @@ Retry:
Try
Dim Id As String = DownloadInfo.Inherit
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), "LiteLoader 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Exit Sub
If Not Target.Contains("\") Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Return
Next
'构造步骤加载器
@@ -1041,13 +1041,13 @@ Retry:
Dim Target As String = SelectSaveFile("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
$"{Info.LoaderName} 安装器 (*.{Info.FileExtension})|*.{Info.FileExtension}")
Dim DisplayName As String = $"{Info.LoaderName} {Info.Inherit} - {Info.VersionName}"
If Not Target.Contains("\") Then Exit Sub
If Not Target.Contains("\") Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"{DisplayName} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Return
Next
'获取下载地址
@@ -1103,7 +1103,7 @@ Retry:
End Try
'检查下载结果
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60))
If Task.IsAborted Then Exit Sub
If Task.IsAborted Then Return
If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。")
End If
End SyncLock
@@ -1188,8 +1188,8 @@ Retry:
outputWaitHandle.WaitOne(10000)
errorWaitHandle.WaitOne(10000)
process.Dispose()
'检查是否安装成功:最后两行中是否有 true(true 可能在倒数第二行,见 #832)
If LastResults.Last = "true" OrElse (LastResults.Count >= 2 AndAlso LastResults(LastResults.Count - 2) = "true") Then Exit Sub
'检查是否安装成功:最后 5 行中是否有 true(true 可能在倒数数行,见 #832)
If LastResults.Reverse().Take(5).Any(Function(l) l = "true") Then Return
Log(Join(LastResults, vbCrLf))
Dim LastLines As String = ""
For i As Integer = Math.Max(0, LastResults.Count - 5) To LastResults.Count - 1 '最后 5 行
@@ -1237,7 +1237,7 @@ Retry:
Task.Progress = 0.91
Case Else
If ModeDebug Then Log("[Installer] " & Content)
Exit Sub
Return
End Select
Log("[Installer] " & Content)
End Sub
@@ -1282,7 +1282,7 @@ Retry:
For Each ForgeVersion In ForgeLoader.Output
If VersionSortInteger(ForgeVersion.Version.ToString, LoaderVersion) = 0 Then
Info = ForgeVersion
Exit Sub
Return
End If
Next
Throw New Exception($"未能找到 {LoaderName} " & Inherit & "-" & LoaderVersion & " 的详细信息!")
@@ -1346,7 +1346,7 @@ Retry:
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Dim ClientMappings As JToken = RawJson("downloads")("client_mappings")
Libs.Add(New McLibToken With {
.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.Url = ClientMappings("url"), .Size = ClientMappings("size"), .SHA1 = ClientMappings("sha1")})
Log($"[Download] 需要下载 Mappings:{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})")
End If
@@ -1385,7 +1385,7 @@ Retry:
#End Region
#Region "原版文件"
'等待原版文件下载完成
If ClientDownloadLoader Is Nothing Then Exit Sub
If ClientDownloadLoader Is Nothing Then Return
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList()
@@ -1394,9 +1394,9 @@ Retry:
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsAborted Then Exit Sub
If Task.IsAborted Then Return
'拷贝原版文件
If Not IsCustomFolder Then Exit Sub
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Directory.CreateDirectory(McFolder & "versions\" & Inherit)
@@ -1639,7 +1639,7 @@ Retry:
''' 尝试刷新 Forge 推荐版本缓存。
''' </summary>
Public Sub McDownloadForgeRecommendedRefresh()
If IsForgeRecommendedRefreshed Then Exit Sub
If IsForgeRecommendedRefreshed Then Return
IsForgeRecommendedRefreshed = True
RunInNewThread(Sub()
Try
@@ -1795,13 +1795,13 @@ Retry:
Dim FileName As String = GetFileNameFromPath(Url)
Dim Version As String = GetFileNameFromPath(DownloadInfo("version").ToString)
Dim Target As String = SelectSaveFile("选择保存位置", FileName, "Fabric 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Exit Sub
If Not Target.Contains("\") Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Fabric {Version} 安装器下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Return
Next
'构造步骤加载器
@@ -2006,7 +2006,7 @@ Retry:
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
Case LoadState.Loading
Exit Sub '不重新加载版本列表
Return '不重新加载版本列表
End Select
McInstallFailedClearFolder(Loader)
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
@@ -2055,14 +2055,12 @@ Retry:
''' 获取合并安装加载器列表,并进行前期的缓存清理与 Java 检查工作。
''' </summary>
''' <exception cref="CancelledException" />
Public Function McInstallLoader(Request As McInstallRequest, Optional DontFixLibraries As Boolean = False) As List(Of LoaderBase)
'获取缓存目录
Dim TempMcFolder As String = RequestTaskTempFolder(
PathTemp.Contains(" ") AndAlso '要求路径不包含空格
(Request.OptiFineEntry IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing))
Public Function McInstallLoader(Request As McInstallRequest) As List(Of LoaderBase)
'获取缓存目录(安装 Mod 加载器的文件夹不能包含空格)
Dim TempMcFolder As String = RequestTaskTempFolder(Request.OptiFineEntry IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing)
'获取参数
Dim OutputFolder As String = PathMcFolder & "versions\" & Request.TargetVersionName & "\"
Dim VersionFolder As String = PathMcFolder & "versions\" & Request.TargetVersionName & "\"
If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder)
Dim OptiFineFolder As String = Nothing
If Request.OptiFineVersion IsNot Nothing Then
@@ -2089,14 +2087,12 @@ Retry:
If Request.LiteLoaderEntry IsNot Nothing Then LiteLoaderFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-LiteLoader"
'判断 OptiFine 是否作为 Mod 进行下载
'Dim MinecraftCode As Integer = If(Request.MinecraftName.Contains("."), Val(Request.MinecraftName.Split(".")(1)), 0)
Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso
(Request.FabricVersion IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing) '选择了 OptiFine 与任意 Mod 加载器
Dim ModsFolder As String = New McVersion(OutputFolder).GetPathIndie(True) & "mods\"
Dim Modable As Boolean = Request.FabricVersion IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing
Dim ModsTempFolder As String = TempMcFolder & "mods\"
Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso Modable '选择了 OptiFine 与任意 Mod 加载器
If OptiFineAsMod Then
Log("[Download] OptiFine 将作为 Mod 进行下载")
OptiFineFolder = ModsFolder
OptiFineFolder = ModsTempFolder
End If
'记录日志
@@ -2108,80 +2104,90 @@ Retry:
Log("[Download] 对应的原版版本:" & Request.MinecraftName)
'重复版本检查
If File.Exists(OutputFolder & Request.TargetVersionName & ".json") Then
If File.Exists($"{VersionFolder}{Request.TargetVersionName}.json") Then
Hint("版本 " & Request.TargetVersionName & " 已经存在!", HintType.Critical)
Throw New CancelledException
End If
Dim LoaderList As New List(Of LoaderBase)
'添加忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(OutputFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(VersionFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
'Fabric API
If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsFolder)}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False})
End If
'OptiFabric
If Request.OptiFabric IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsFolder)}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False})
End If
'原版
Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.TargetVersionName)) With {.Show = False, .ProgressWeight = 39, .Block = Request.ForgeVersion Is Nothing AndAlso Request.OptiFineEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}
Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.TargetVersionName)) With {.Show = False, .ProgressWeight = 39,
.Block = Request.ForgeVersion Is Nothing AndAlso Request.NeoForgeVersion Is Nothing AndAlso Request.OptiFineEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}
LoaderList.Add(ClientLoader)
'OptiFine
If Request.OptiFineEntry IsNot Nothing Then
If OptiFineAsMod Then
LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.NameDisplay, McDownloadOptiFineSaveLoader(Request.OptiFineEntry, OptiFineFolder & Request.OptiFineEntry.NameFile)) With {.Show = False, .ProgressWeight = 16, .Block = Request.ForgeVersion Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.NameDisplay, McDownloadOptiFineSaveLoader(Request.OptiFineEntry, OptiFineFolder & Request.OptiFineEntry.NameFile)) With {.Show = False, .ProgressWeight = 16,
.Block = Request.ForgeVersion Is Nothing AndAlso Request.NeoForgeVersion Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
Else
LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.NameDisplay, McDownloadOptiFineLoader(Request.OptiFineEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder, False)) With {.Show = False, .ProgressWeight = 24, .Block = Request.ForgeVersion Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.NameDisplay, McDownloadOptiFineLoader(Request.OptiFineEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder, False)) With {.Show = False, .ProgressWeight = 24,
.Block = Request.ForgeVersion Is Nothing AndAlso Request.NeoForgeVersion Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
End If
End If
'Forge
If Request.ForgeVersion IsNot Nothing Then
LoaderList.Add(New LoaderCombo(Of String)("下载 Forge " & Request.ForgeVersion, McDownloadForgelikeLoader(False, Request.ForgeVersion, "forge-" & Request.ForgeVersion, Request.MinecraftName, Request.ForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder)) With {.Show = False, .ProgressWeight = 25, .Block = Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing AndAlso Request.NeoForgeEntry Is Nothing})
LoaderList.Add(New LoaderCombo(Of String)("下载 Forge " & Request.ForgeVersion, McDownloadForgelikeLoader(False, Request.ForgeVersion, "forge-" & Request.ForgeVersion, Request.MinecraftName, Request.ForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder)) With {.Show = False, .ProgressWeight = 25,
.Block = Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing AndAlso Request.NeoForgeEntry Is Nothing})
End If
'NeoForge
If Request.NeoForgeVersion IsNot Nothing Then
LoaderList.Add(New LoaderCombo(Of String)("下载 NeoForge " & Request.NeoForgeVersion, McDownloadForgelikeLoader(True, Request.NeoForgeVersion, "neoforge-" & Request.NeoForgeVersion, Request.MinecraftName, Request.NeoForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder)) With {.Show = False, .ProgressWeight = 25, .Block = Request.ForgeEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
LoaderList.Add(New LoaderCombo(Of String)("下载 NeoForge " & Request.NeoForgeVersion, McDownloadForgelikeLoader(True, Request.NeoForgeVersion, "neoforge-" & Request.NeoForgeVersion, Request.MinecraftName, Request.NeoForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder)) With {.Show = False, .ProgressWeight = 25,
.Block = Request.ForgeEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
End If
'LiteLoader
If Request.LiteLoaderEntry IsNot Nothing Then
LoaderList.Add(New LoaderCombo(Of String)("下载 LiteLoader " & Request.MinecraftName, McDownloadLiteLoaderLoader(Request.LiteLoaderEntry, TempMcFolder, ClientLoader, False)) With {.Show = False, .ProgressWeight = 1, .Block = Request.FabricVersion Is Nothing})
LoaderList.Add(New LoaderCombo(Of String)("下载 LiteLoader " & Request.MinecraftName, McDownloadLiteLoaderLoader(Request.LiteLoaderEntry, TempMcFolder, ClientLoader, False)) With {.Show = False, .ProgressWeight = 1,
.Block = Request.FabricVersion Is Nothing})
End If
'Fabric
If Request.FabricVersion IsNot Nothing Then
LoaderList.Add(New LoaderCombo(Of String)("下载 Fabric " & Request.FabricVersion, McDownloadFabricLoader(Request.FabricVersion, Request.MinecraftName, TempMcFolder, False)) With {.Show = False, .ProgressWeight = 2, .Block = True})
LoaderList.Add(New LoaderCombo(Of String)("下载 Fabric " & Request.FabricVersion, McDownloadFabricLoader(Request.FabricVersion, Request.MinecraftName, TempMcFolder, False)) With {.Show = False, .ProgressWeight = 2,
.Block = True})
End If
'合并安装
LoaderList.Add(New LoaderTask(Of String, String)("安装游戏",
Sub(Task As LoaderTask(Of String, String))
InstallMerge(OutputFolder, OutputFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.3
'合并 JSON
MergeJson(VersionFolder, VersionFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.2
'迁移文件
If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", PathMcFolder & "libraries")
If Directory.Exists(TempMcFolder & "mods") Then CopyDirectory(TempMcFolder & "mods", ModsFolder)
'新建 mods 文件夹
If Request.ForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then
Task.Progress = 0.8
Dim ModsFolder = New McVersion(VersionFolder).PathIndie & "mods\" '版本隔离信息在此时被决定
If Directory.Exists(ModsTempFolder) Then
CopyDirectory(ModsTempFolder, ModsFolder)
ElseIf Modable Then
Directory.CreateDirectory(ModsFolder)
Log("[Download] 自动创建 mods 文件夹:" & ModsFolder)
End If
End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件
If Not DontFixLibraries AndAlso
(Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then
If Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then
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(OutputFolder))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
LoaderList.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
End If
'删除忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() File.Delete(OutputFolder & ".pclignore")) With {.Show = False})
LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() File.Delete(VersionFolder & ".pclignore")) With {.Show = False})
'总加载器
Return LoaderList
End Function
''' <summary>
''' 将多个版本 Json 进行合并,如果目标已存在则直接覆盖。失败会抛出异常。
''' 将多个版本 JSON 进行合并,如果目标已存在则直接覆盖。失败会抛出异常。
''' </summary>
Private Sub InstallMerge(OutputFolder As String, MinecraftFolder As String, Optional OptiFineFolder As String = Nothing, Optional OptiFineAsMod As Boolean = False, Optional ForgeFolder As String = Nothing, Optional ForgeVersion As String = Nothing, Optional NeoForgeFolder As String = Nothing, Optional NeoForgeVersion As String = Nothing, Optional FabricFolder As String = Nothing, Optional LiteLoaderFolder As String = Nothing)
Private Sub MergeJson(OutputFolder As String, MinecraftFolder As String, Optional OptiFineFolder As String = Nothing, Optional OptiFineAsMod As Boolean = False, Optional ForgeFolder As String = Nothing, Optional ForgeVersion As String = Nothing, Optional NeoForgeFolder As String = Nothing, Optional NeoForgeVersion As String = Nothing, Optional FabricFolder As String = Nothing, Optional LiteLoaderFolder As String = Nothing)
Log("[Download] 开始进行版本合并,输出:" & OutputFolder & ",Minecraft:" & MinecraftFolder &
If(OptiFineFolder IsNot Nothing, ",OptiFine:" & OptiFineFolder, "") &
If(ForgeFolder IsNot Nothing, ",Forge:" & ForgeFolder, "") &
@@ -39,7 +39,7 @@
Version("id") = "20w14∞"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato"
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato", "25w14craftmine"
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
@@ -42,7 +42,7 @@
End If
End Sub
Public Sub Forge_StateChanged(sender As MyLoading, newState As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState)
If newState <> MyLoading.MyLoadingState.Stop Then Exit Sub
If newState <> MyLoading.MyLoadingState.Stop Then Return
Dim Card As MyCard = CType(sender.Parent, FrameworkElement).Parent
Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = sender.State
@@ -23,10 +23,10 @@
<local:MyImage x:Name="ImgLogo" Margin="52,0,0,0" VerticalAlignment="Center" HorizontalAlignment="Left" Height="32" RenderOptions.BitmapScalingMode="HighQuality" />
<local:MyTextBox Margin="93,0,16,0" Padding="-1,0" MinHeight="30" FontSize="15" VerticalAlignment="Center" x:Name="TextSelectName" MaxLength="70" HasBackground="False" />
</local:MyCard>
<local:MyHint Text="如果不安装 Fabric API,大多数 Mod 都会无法使用!" Margin="0,10,0,0" x:Name="HintFabricAPI" IsWarn="True" />
<local:MyHint Text="必须安装 OptiFabric 才能正常使用 OptiFine!" Margin="0,10,0,0" x:Name="HintOptiFabric" IsWarn="True" />
<local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,10,0,0" x:Name="HintOptiFabricOld" IsWarn="False" />
<local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,10,0,0" x:Name="HintModOptiFine" IsWarn="False" />
<local:MyHint Text="如果不安装 Fabric API,大多数 Mod 都会无法使用!" Margin="0,10,0,0" x:Name="HintFabricAPI" Theme="Red" />
<local:MyHint Text="必须安装 OptiFabric 才能正常使用 OptiFine!" Margin="0,10,0,0" x:Name="HintOptiFabric" Theme="Red" />
<local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,10,0,0" x:Name="HintOptiFabricOld" Theme="Yellow" />
<local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,10,0,0" x:Name="HintModOptiFine" Theme="Yellow" />
<local:MyCard Title="Forge" Height="40" Margin="0,12,0,0" x:Name="CardForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanForge" />
<Grid x:Name="PanForgeInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
@@ -19,7 +19,7 @@
SelectReload()
'非重复加载部分
If IsLoad Then Exit Sub
If IsLoad Then Return
IsLoad = True
McDownloadForgeRecommendedRefresh()
@@ -38,7 +38,7 @@
Public IsInSelectPage As Boolean = False
Private IsFirstLoaded As Boolean = False
Private Sub EnterSelectPage()
If IsInSelectPage Then Exit Sub
If IsInSelectPage Then Return
IsInSelectPage = True
PanInner.Margin = New Thickness(25, 10, 25, 40)
@@ -87,8 +87,8 @@
DlOptiFabricLoader.Start()
AniStart({
AaOpacity(PanMinecraft, -PanMinecraft.Opacity, 90, 10),
AaTranslateX(PanMinecraft, -50 - CType(PanMinecraft.RenderTransform, TranslateTransform).X, 100, 10),
AaOpacity(PanMinecraft, -PanMinecraft.Opacity, 70, 10),
AaTranslateX(PanMinecraft, -50 - CType(PanMinecraft.RenderTransform, TranslateTransform).X, 90, 10),
AaCode(
Sub()
PanBack.ScrollToHome()
@@ -101,15 +101,15 @@
FabricApi_Loaded()
OptiFabric_Loaded()
SelectReload()
PanMinecraft.Visibility = Visibility.Collapsed
End Sub, After:=True),
AaOpacity(PanSelect, 1 - PanSelect.Opacity, 90, 100),
AaTranslateX(PanSelect, -CType(PanSelect.RenderTransform, TranslateTransform).X, 200, 100, Ease:=New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(PanSelect, 1 - PanSelect.Opacity, 70, 100),
AaTranslateX(PanSelect, -CType(PanSelect.RenderTransform, TranslateTransform).X, 160, 100, Ease:=New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaCode(
Sub()
PanMinecraft.Visibility = Visibility.Collapsed
PanBack.IsHitTestVisible = True
'初始化 Binding
If IsFirstLoaded Then Exit Sub
If IsFirstLoaded Then Return
IsFirstLoaded = True
BtnOptiFineClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFine.MainTextBlock, .Mode = BindingMode.OneWay})
BtnLiteLoaderClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardLiteLoader.MainTextBlock, .Mode = BindingMode.OneWay})
@@ -122,7 +122,7 @@
}, "FrmDownloadInstall SelectPageSwitch", True)
End Sub
Public Sub ExitSelectPage() Handles BtnBack.Click
If Not IsInSelectPage Then Exit Sub
If Not IsInSelectPage Then Return
IsInSelectPage = False
PanInner.Margin = New Thickness(25, 10, 25, 25)
@@ -137,11 +137,11 @@
PanBack.ScrollToHome()
AniStart({
AaOpacity(PanSelect, -PanSelect.Opacity, 90, 10),
AaTranslateX(PanSelect, 50 - CType(PanSelect.RenderTransform, TranslateTransform).X, 100, 10),
AaOpacity(PanSelect, -PanSelect.Opacity, 70, 10),
AaTranslateX(PanSelect, 50 - CType(PanSelect.RenderTransform, TranslateTransform).X, 90, 10),
AaCode(Sub() PanBack.ScrollToHome(), After:=True),
AaOpacity(PanMinecraft, 1 - PanMinecraft.Opacity, 90, 100),
AaTranslateX(PanMinecraft, -CType(PanMinecraft.RenderTransform, TranslateTransform).X, 200, 100, Ease:=New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(PanMinecraft, 1 - PanMinecraft.Opacity, 70, 100),
AaTranslateX(PanMinecraft, -CType(PanMinecraft.RenderTransform, TranslateTransform).X, 160, 100, Ease:=New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaCode(
Sub()
PanSelect.Visibility = Visibility.Collapsed
@@ -168,19 +168,19 @@
'OptiFine
Private SelectedOptiFine As DlOptiFineListEntry = Nothing
Private Sub SetOptiFineInfoShow(IsShow As String)
If PanOptiFineInfo.Tag = IsShow Then Exit Sub
If PanOptiFineInfo.Tag = IsShow Then Return
PanOptiFineInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanOptiFineInfo, -CType(PanOptiFineInfo.RenderTransform, TranslateTransform).Y, 270, 100, Ease:=New AniEaseOutBack),
AaOpacity(PanOptiFineInfo, 1 - PanOptiFineInfo.Opacity, 100, 90)
AaTranslateY(PanOptiFineInfo, -CType(PanOptiFineInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanOptiFineInfo, 1 - PanOptiFineInfo.Opacity, 80, 90)
}, "SetOptiFineInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanOptiFineInfo, 6 - CType(PanOptiFineInfo.RenderTransform, TranslateTransform).Y, 200),
AaOpacity(PanOptiFineInfo, -PanOptiFineInfo.Opacity, 100)
AaTranslateY(PanOptiFineInfo, 6 - CType(PanOptiFineInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanOptiFineInfo, -PanOptiFineInfo.Opacity, 50)
}, "SetOptiFineInfoShow")
End If
End Sub
@@ -188,19 +188,19 @@
'LiteLoader
Private SelectedLiteLoader As DlLiteLoaderListEntry = Nothing
Private Sub SetLiteLoaderInfoShow(IsShow As String)
If PanLiteLoaderInfo.Tag = IsShow Then Exit Sub
If PanLiteLoaderInfo.Tag = IsShow Then Return
PanLiteLoaderInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanLiteLoaderInfo, -CType(PanLiteLoaderInfo.RenderTransform, TranslateTransform).Y, 270, 100, Ease:=New AniEaseOutBack),
AaOpacity(PanLiteLoaderInfo, 1 - PanLiteLoaderInfo.Opacity, 100, 90)
AaTranslateY(PanLiteLoaderInfo, -CType(PanLiteLoaderInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanLiteLoaderInfo, 1 - PanLiteLoaderInfo.Opacity, 80, 90)
}, "SetLiteLoaderInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanLiteLoaderInfo, 6 - CType(PanLiteLoaderInfo.RenderTransform, TranslateTransform).Y, 200),
AaOpacity(PanLiteLoaderInfo, -PanLiteLoaderInfo.Opacity, 100)
AaTranslateY(PanLiteLoaderInfo, 6 - CType(PanLiteLoaderInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanLiteLoaderInfo, -PanLiteLoaderInfo.Opacity, 50)
}, "SetLiteLoaderInfoShow")
End If
End Sub
@@ -208,19 +208,19 @@
'Forge
Private SelectedForge As DlForgeVersionEntry = Nothing
Private Sub SetForgeInfoShow(IsShow As String)
If PanForgeInfo.Tag = IsShow Then Exit Sub
If PanForgeInfo.Tag = IsShow Then Return
PanForgeInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanForgeInfo, -CType(PanForgeInfo.RenderTransform, TranslateTransform).Y, 270, 100, Ease:=New AniEaseOutBack),
AaOpacity(PanForgeInfo, 1 - PanForgeInfo.Opacity, 100, 90)
AaTranslateY(PanForgeInfo, -CType(PanForgeInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanForgeInfo, 1 - PanForgeInfo.Opacity, 80, 90)
}, "SetForgeInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanForgeInfo, 6 - CType(PanForgeInfo.RenderTransform, TranslateTransform).Y, 200),
AaOpacity(PanForgeInfo, -PanForgeInfo.Opacity, 100)
AaTranslateY(PanForgeInfo, 6 - CType(PanForgeInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanForgeInfo, -PanForgeInfo.Opacity, 50)
}, "SetForgeInfoShow")
End If
End Sub
@@ -228,19 +228,19 @@
'NeoForge
Private SelectedNeoForge As DlNeoForgeListEntry = Nothing
Private Sub SetNeoForgeInfoShow(IsShow As String)
If PanNeoForgeInfo.Tag = IsShow Then Exit Sub
If PanNeoForgeInfo.Tag = IsShow Then Return
PanNeoForgeInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanNeoForgeInfo, -CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 270, 100, Ease:=New AniEaseOutBack),
AaOpacity(PanNeoForgeInfo, 1 - PanNeoForgeInfo.Opacity, 100, 90)
AaTranslateY(PanNeoForgeInfo, -CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanNeoForgeInfo, 1 - PanNeoForgeInfo.Opacity, 80, 90)
}, "SetNeoForgeInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanNeoForgeInfo, 6 - CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 200),
AaOpacity(PanNeoForgeInfo, -PanNeoForgeInfo.Opacity, 100)
AaTranslateY(PanNeoForgeInfo, 6 - CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanNeoForgeInfo, -PanNeoForgeInfo.Opacity, 50)
}, "SetNeoForgeInfoShow")
End If
End Sub
@@ -248,19 +248,19 @@
'Fabric
Private SelectedFabric As String = Nothing
Private Sub SetFabricInfoShow(IsShow As String)
If PanFabricInfo.Tag = IsShow Then Exit Sub
If PanFabricInfo.Tag = IsShow Then Return
PanFabricInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanFabricInfo, -CType(PanFabricInfo.RenderTransform, TranslateTransform).Y, 270, 100, Ease:=New AniEaseOutBack),
AaOpacity(PanFabricInfo, 1 - PanFabricInfo.Opacity, 100, 90)
AaTranslateY(PanFabricInfo, -CType(PanFabricInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanFabricInfo, 1 - PanFabricInfo.Opacity, 80, 90)
}, "SetFabricInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanFabricInfo, 6 - CType(PanFabricInfo.RenderTransform, TranslateTransform).Y, 200),
AaOpacity(PanFabricInfo, -PanFabricInfo.Opacity, 100)
AaTranslateY(PanFabricInfo, 6 - CType(PanFabricInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanFabricInfo, -PanFabricInfo.Opacity, 50)
}, "SetFabricInfoShow")
End If
End Sub
@@ -268,19 +268,19 @@
'FabricApi
Private SelectedFabricApi As CompFile = Nothing
Private Sub SetFabricApiInfoShow(IsShow As String)
If PanFabricApiInfo.Tag = IsShow Then Exit Sub
If PanFabricApiInfo.Tag = IsShow Then Return
PanFabricApiInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanFabricApiInfo, -CType(PanFabricApiInfo.RenderTransform, TranslateTransform).Y, 270, 100, Ease:=New AniEaseOutBack),
AaOpacity(PanFabricApiInfo, 1 - PanFabricApiInfo.Opacity, 100, 90)
AaTranslateY(PanFabricApiInfo, -CType(PanFabricApiInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanFabricApiInfo, 1 - PanFabricApiInfo.Opacity, 80, 90)
}, "SetFabricApiInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanFabricApiInfo, 6 - CType(PanFabricApiInfo.RenderTransform, TranslateTransform).Y, 200),
AaOpacity(PanFabricApiInfo, -PanFabricApiInfo.Opacity, 100)
AaTranslateY(PanFabricApiInfo, 6 - CType(PanFabricApiInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanFabricApiInfo, -PanFabricApiInfo.Opacity, 50)
}, "SetFabricApiInfoShow")
End If
End Sub
@@ -288,19 +288,19 @@
'OptiFabric
Private SelectedOptiFabric As CompFile = Nothing
Private Sub SetOptiFabricInfoShow(IsShow As String)
If PanOptiFabricInfo.Tag = IsShow Then Exit Sub
If PanOptiFabricInfo.Tag = IsShow Then Return
PanOptiFabricInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanOptiFabricInfo, -CType(PanOptiFabricInfo.RenderTransform, TranslateTransform).Y, 270, 100, Ease:=New AniEaseOutBack),
AaOpacity(PanOptiFabricInfo, 1 - PanOptiFabricInfo.Opacity, 100, 90)
AaTranslateY(PanOptiFabricInfo, -CType(PanOptiFabricInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanOptiFabricInfo, 1 - PanOptiFabricInfo.Opacity, 80, 90)
}, "SetOptiFabricInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanOptiFabricInfo, 6 - CType(PanOptiFabricInfo.RenderTransform, TranslateTransform).Y, 200),
AaOpacity(PanOptiFabricInfo, -PanOptiFabricInfo.Opacity, 100)
AaTranslateY(PanOptiFabricInfo, 6 - CType(PanOptiFabricInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanOptiFabricInfo, -PanOptiFabricInfo.Opacity, 50)
}, "SetOptiFabricInfoShow")
End If
End Sub
@@ -310,7 +310,7 @@
''' 重载已选择的项目的显示。
''' </summary>
Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardNeoForge.Swap, LoadNeoForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
If SelectedMinecraftId Is Nothing OrElse IsReloading Then Exit Sub
If SelectedMinecraftId Is Nothing OrElse IsReloading Then Return
IsReloading = True
'主预览
SelectNameUpdate()
@@ -540,13 +540,13 @@
Private IsSelectNameEdited As Boolean = False
Private IsSelectNameChanging As Boolean = False
Private Sub SelectNameUpdate()
If IsSelectNameEdited OrElse IsSelectNameChanging Then Exit Sub
If IsSelectNameEdited OrElse IsSelectNameChanging Then Return
IsSelectNameChanging = True
TextSelectName.Text = GetSelectName()
IsSelectNameChanging = False
End Sub
Private Sub TextSelectName_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextSelectName.TextChanged
If IsSelectNameChanging Then Exit Sub
If IsSelectNameChanging Then Return
IsSelectNameEdited = True
SelectReload()
End Sub
@@ -590,7 +590,7 @@
Version("id") = "20w14∞"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato"
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato", "25w14craftmine"
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
@@ -717,7 +717,7 @@
''' </summary>
Private Sub OptiFine_Loaded() Handles LoadOptiFine.StateChanged
Try
If DlOptiFineListLoader.State <> LoadState.Finished Then Exit Sub
If DlOptiFineListLoader.State <> LoadState.Finished Then Return
'获取版本列表
Dim Versions As New List(Of DlOptiFineListEntry)
@@ -725,7 +725,7 @@
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(Version, SelectedForge) Then Continue For
If Version.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Versions.Add(Version)
Next
If Not Versions.Any() Then Exit Sub
If Not Versions.Any() Then Return
'排序
Versions = Versions.Sort(
Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
@@ -791,13 +791,13 @@
''' </summary>
Private Sub LiteLoader_Loaded() Handles LoadLiteLoader.StateChanged
Try
If DlLiteLoaderListLoader.State <> LoadState.Finished Then Exit Sub
If DlLiteLoaderListLoader.State <> LoadState.Finished Then Return
'获取版本列表
Dim Versions As New List(Of DlLiteLoaderListEntry)
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
If Version.Inherit = SelectedMinecraftId Then Versions.Add(Version)
Next
If Not Versions.Any() Then Exit Sub
If Not Versions.Any() Then Return
'可视化
PanLiteLoader.Children.Clear()
For Each Version In Versions
@@ -871,13 +871,13 @@
''' </summary>
Private Sub Forge_Loaded() Handles LoadForge.StateChanged
Try
If Not LoadForge.State.IsLoader Then Exit Sub
If Not LoadForge.State.IsLoader Then Return
Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = LoadForge.State
If SelectedMinecraftId <> Loader.Input Then Exit Sub
If Loader.State <> LoadState.Finished Then Exit Sub
If SelectedMinecraftId <> Loader.Input Then Return
If Loader.State <> LoadState.Finished Then Return
'获取要显示的版本
Dim Versions = Loader.Output.ToList '复制数组,以免 Output 在实例化后变空
If Not Loader.Output.Any() Then Exit Sub
If Not Loader.Output.Any() Then Return
PanForge.Children.Clear()
Versions = Versions.Where(
Function(v)
@@ -942,9 +942,9 @@
Private Sub NeoForge_Loaded() Handles LoadNeoForge.StateChanged
Try
'获取版本列表
If DlNeoForgeListLoader.State <> LoadState.Finished Then Exit Sub
If DlNeoForgeListLoader.State <> LoadState.Finished Then Return
Dim Versions = DlNeoForgeListLoader.Output.Value.Where(Function(v) v.Inherit = SelectedMinecraftId).ToList
If Not Versions.Any() Then Exit Sub
If Not Versions.Any() Then Return
'可视化
PanNeoForge.Children.Clear()
NeoForgeDownloadListItemPreload(PanNeoForge, Versions, AddressOf NeoForge_Selected, False)
@@ -1001,10 +1001,10 @@
''' </summary>
Private Sub Fabric_Loaded() Handles LoadFabric.StateChanged
Try
If DlFabricListLoader.State <> LoadState.Finished Then Exit Sub
If DlFabricListLoader.State <> LoadState.Finished Then Return
'获取版本列表
Dim Versions As JArray = DlFabricListLoader.Output.Value("loader")
If Not Versions.Any() Then Exit Sub
If Not Versions.Any() Then Return
'可视化
PanFabric.Children.Clear()
PanFabric.Tag = Versions
@@ -1106,8 +1106,8 @@
''' </summary>
Private Sub FabricApi_Loaded() Handles LoadFabricApi.StateChanged
Try
If DlFabricApiLoader.State <> LoadState.Finished Then Exit Sub
If SelectedMinecraftId Is Nothing OrElse SelectedFabric Is Nothing Then Exit Sub
If DlFabricApiLoader.State <> LoadState.Finished Then Return
If SelectedMinecraftId Is Nothing OrElse SelectedFabric Is Nothing Then Return
'获取版本列表
Dim Versions As New List(Of CompFile)
For Each Version In DlFabricApiLoader.Output
@@ -1119,7 +1119,7 @@
Versions.Add(Version)
End If
Next
If Not Versions.Any() Then Exit Sub
If Not Versions.Any() Then Return
Versions = Versions.OrderByDescending(Function(v) v.ReleaseDate).ToList
'可视化
PanFabricApi.Children.Clear()
@@ -1202,14 +1202,14 @@
''' </summary>
Private Sub OptiFabric_Loaded() Handles LoadOptiFabric.StateChanged
Try
If DlOptiFabricLoader.State <> LoadState.Finished Then Exit Sub
If SelectedMinecraftId Is Nothing OrElse SelectedFabric Is Nothing OrElse SelectedOptiFine Is Nothing Then Exit Sub
If DlOptiFabricLoader.State <> LoadState.Finished Then Return
If SelectedMinecraftId Is Nothing OrElse SelectedFabric Is Nothing OrElse SelectedOptiFine Is Nothing Then Return
'获取版本列表
Dim Versions As New List(Of CompFile)
For Each Version In DlOptiFabricLoader.Output
If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Versions.Add(Version)
Next
If Not Versions.Any() Then Exit Sub
If Not Versions.Any() Then Return
'排序
Versions = Versions.OrderByDescending(Function(v) v.ReleaseDate).ToList
'可视化
@@ -1254,10 +1254,10 @@
'确认版本隔离
If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
(Setup.Get("LaunchArgumentIndieV2") = 0 OrElse Setup.Get("LaunchArgumentIndieV2") = 2) Then
If MyMsgBox("你尚未开启版本隔离,这会导致多个版本共用同一个 Mod 文件夹。" & vbCrLf &
"因此游戏可能会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
"推荐在开始下载前,在 设置 → 启动选项 → 版本隔离 中开启版本隔离!", "版本隔离提示", "取消下载", "继续") = 1 Then
Exit Sub
If MyMsgBox("你尚未开启版本隔离,多个 MC 版本会共用同一个 Mod 文件夹。" & vbCrLf &
"因此,游戏可能会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
"推荐先在 设置 → 启动选项 → 默认版本隔离 中开启版本隔离!", "版本隔离提示", "取消下载", "继续") = 1 Then
Return
End If
End If
'提交安装申请
@@ -1275,7 +1275,7 @@
.OptiFabric = SelectedOptiFabric,
.LiteLoaderEntry = SelectedLiteLoader
}
If Not McInstall(Request) Then Exit Sub
If Not McInstall(Request) Then Return
'返回,这样在再次进入安装页面时这个版本就会显示文件夹已重复
ExitSelectPage()
End Sub
@@ -85,7 +85,30 @@
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemDataPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="13" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="数据包"
LogoScale="0.96" Logo="M445 545c18 0 33 14 33 33v149a182 182 0 1 1-182-182z m282 0a182 182 0 1 1-182 182v-149c0-18 14-33 33-33zM412 611H296a116 116 0 1 0 116 116V611z m315 0H611v116a116 116 0 1 0 116-116zM296 113a182 182 0 0 1 182 182v149a33 33 0 0 1-33 33H296a182 182 0 0 1 0-365z m431 0a182 182 0 0 1 0 365h-149a33 33 0 0 1-33-33V296A182 182 0 0 1 727 113zM296 180a116 116 0 0 0 0 232H412V296c0-62-48-112-109-115z m431 0a116 116 0 0 0-116 116V412h116c62 0 112-48 115-109l0-6a116 116 0 0 0-116-116z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="13" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemResourcePack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="14" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="资源包"
LogoScale="0.81" Logo="M884.4 130.6H140.6c-41.9 0-76 34.1-76 76v613.3c0 41.9 34.1 76 76 76h743.8c41.9 0 76-34.1 76-76V206.6c0-41.9-34.1-76-76-76z m-743.8 72h743.8c2.2 0 4 1.8 4 4v371.3L796 461.7c-21.7-27.3-54.1-43.7-88.8-45-34.7-1.3-68.1 12.7-91.7 38.3L454 630c-2.8 3-7.2 3.5-10.5 1.3l-103-70.3c-31.5-21.5-72.8-22.5-105.3-2.7l-98.6 60.1V206.6c0-2.2 1.8-4 4-4z m743.8 621.3H140.6c-2.2 0-4-1.8-4-4V702.7l136.1-83c8.4-5.1 19.1-4.8 27.2 0.7l103 70.3c15.9 10.8 35.1 15.6 54.2 13.4 19-2.2 36.7-11.2 49.8-25.3l161.6-175c9.5-10.3 22.3-15.7 36.2-15.1 13.9 0.5 26.3 6.8 35.1 17.8l148.7 187v126.3c-0.1 2.3-1.9 4.1-4.1 4.1z M231.8 400.6a69.6 69.6 0 1 0 98.4-98.4 69.6 69.6 0 1 0-98.4 98.4Z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="14" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemShader" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="15" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="光影包"
LogoScale="1.04" Logo="M512 0c25 0 42 17 42 42v85c0 25-17 42-42 42s-42-17-42-42V42c0-25 17-42 42-42zM512 853c25 0 42 17 42 42v85c0 25-17 42-42 42s-42-17-42-42v-85c0-25 17-42 42-42zM209 149c-17-17-42-17-59 0-17 17-17 42 0 59l59 59c17 17 42 17 59 0 17-17 17-42 0-59L209 149zM755 755c17-17 42-17 59 0l59 59c17 17 17 42 0 59s-42 17-59 0l-59-59c-17-17-17-46 0-59zM42 469c-25 0-42 17-42 42s17 42 42 42h85c25 0 42-17 42-42s-17-42-42-42H42zM853 512c0-25 17-42 42-42h85c25 0 42 17 42 42s-17 42-42 42h-85c-25 0-42-17-42-42zM149 814c-17 17-17 42 0 59 17 17 42 17 59 0l59-59c17-17 17-42 0-59-17-17-42-17-59 0l-59 59zM755 268c-17-17-17-42 0-59l59-59c17-17 42-17 59 0s17 42 0 59l-59 59c-17 17-46 17-59 0z M512 213c-166 0-298 132-298 298s132 298 298 298 298-132 298-298-132-298-298-298z m0 512c-119 0-213-93-213-213s93-213 213-213 213 93 213 213-93 213-213 213z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="15" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" Logo="M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageLeft>
@@ -11,7 +11,7 @@
''' <summary>
''' 勾选事件改变页面。
''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemClient.Check, ItemOptiFine.Check, ItemForge.Check, ItemNeoForge.Check, ItemLiteLoader.Check, ItemMod.Check, ItemFabric.Check, ItemPack.Check
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemClient.Check, ItemOptiFine.Check, ItemForge.Check, ItemNeoForge.Check, ItemLiteLoader.Check, ItemMod.Check, ItemFabric.Check, ItemPack.Check, ItemResourcePack.Check, ItemShader.Check, ItemDataPack.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -47,6 +47,15 @@
Case FormMain.PageSubType.DownloadPack
If FrmDownloadPack Is Nothing Then FrmDownloadPack = New PageDownloadPack
Return FrmDownloadPack
Case FormMain.PageSubType.DownloadResourcePack
If FrmDownloadResourcePack Is Nothing Then FrmDownloadResourcePack = New PageDownloadResourcePack
Return FrmDownloadResourcePack
Case FormMain.PageSubType.DownloadShader
If FrmDownloadShader Is Nothing Then FrmDownloadShader = New PageDownloadShader
Return FrmDownloadShader
Case FormMain.PageSubType.DownloadDataPack
If FrmDownloadDataPack Is Nothing Then FrmDownloadDataPack = New PageDownloadDataPack
Return FrmDownloadDataPack
Case Else
Throw New Exception("未知的下载子页面种类:" & ID)
End Select
@@ -56,7 +65,7 @@
''' 切换现有页面。
''' </summary>
Public Sub PageChange(ID As FormMain.PageSubType)
If PageID = ID Then Exit Sub
If PageID = ID Then Return
AniControlEnabled += 1
Try
PageChangeRun(PageGet(ID))
@@ -110,19 +119,50 @@
DlOptiFabricLoader.Start(IsForceRestart:=True)
ItemInstall.Checked = True
Case FormMain.PageSubType.DownloadMod
PageDownloadMod.Storage = New CompProjectStorage
PageDownloadMod.Page = 0
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart()
If FrmDownloadMod IsNot Nothing Then
FrmDownloadMod.Content.Storage = New CompProjectStorage
FrmDownloadMod.Content.Page = 0
FrmDownloadMod.PageLoaderRestart()
End If
ItemMod.Checked = True
Case FormMain.PageSubType.DownloadPack
PageDownloadPack.Storage = New CompProjectStorage
PageDownloadPack.Page = 0
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart()
If FrmDownloadPack IsNot Nothing Then
FrmDownloadPack.Content.Storage = New CompProjectStorage
FrmDownloadPack.Content.Page = 0
FrmDownloadPack.PageLoaderRestart()
End If
ItemPack.Checked = True
Case FormMain.PageSubType.DownloadResourcePack
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadResourcePack IsNot Nothing Then
FrmDownloadResourcePack.Content.Storage = New CompProjectStorage
FrmDownloadResourcePack.Content.Page = 0
FrmDownloadResourcePack.PageLoaderRestart()
End If
ItemResourcePack.Checked = True
Case FormMain.PageSubType.DownloadShader
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadShader IsNot Nothing Then
FrmDownloadShader.Content.Storage = New CompProjectStorage
FrmDownloadShader.Content.Page = 0
FrmDownloadShader.PageLoaderRestart()
End If
ItemShader.Checked = True
Case FormMain.PageSubType.DownloadDataPack
CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadDataPack IsNot Nothing Then
FrmDownloadDataPack.Content.Storage = New CompProjectStorage
FrmDownloadDataPack.Content.Page = 0
FrmDownloadDataPack.PageLoaderRestart()
End If
ItemDataPack.Checked = True
Case FormMain.PageSubType.DownloadClient
DlClientListLoader.Start(IsForceRestart:=True)
ItemClient.Checked = True
@@ -147,13 +187,13 @@
'点击返回
Private Sub ItemInstall_Click(sender As Object, e As MouseButtonEventArgs) Handles ItemInstall.Click
If Not ItemInstall.Checked Then Exit Sub
If Not ItemInstall.Checked Then Return
FrmDownloadInstall.ExitSelectPage()
End Sub
'展开手动安装
Private Sub ItemHand_Click(sender As Object, e As RouteEventArgs) Handles ItemHand.Changed
If ItemHand.Checked = False Then Exit Sub
If ItemHand.Checked = False Then Return
e.Handled = True
AniControlEnabled += 1
If Not Setup.Get("HintHandInstall") Then
@@ -162,7 +202,7 @@
"在自动安装页面先选择 MC 版本,然后就可以选择 OptiFine、Forge 等组件,让 PCL 自动进行安装了。", "自动安装提示", "返回自动安装", "继续下载手动安装包") = 1 Then
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.Download}, FormMain.PageSubType.DownloadInstall)
AniControlEnabled -= 1
Exit Sub
Return
End If
End If
ItemHand.Visibility = Visibility.Collapsed
@@ -1,121 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadMod"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="25">
<local:MyCard Title="搜索 Mod" Margin="0,0,0,15" x:Name="PanAlways">
<StackPanel Margin="25,40,25,15">
<Grid Margin="0,0,0,11" HorizontalAlignment="Stretch">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1.3*" />
<ColumnDefinition Width="1.2*" />
<ColumnDefinition Width="50" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="名称" Margin="0,0,18,0" />
<local:MyTextBox x:Name="TextSearchName" Grid.Column="1" Grid.ColumnSpan="2" />
<TextBlock VerticalAlignment="Center" Grid.Column="4" HorizontalAlignment="Left" Text="来源" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchSource" Grid.Column="5">
<local:MyComboBoxItem Content="全部" Tag="3" IsSelected="True" />
<local:MyComboBoxItem Content="CurseForge" Tag="1" />
<local:MyComboBoxItem Content="Modrinth" Tag="2" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.4" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
<local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" MaxDropDownHeight="320" Margin="10,0,0,0">
<local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="Fabric" Tag="4" />
<local:MyComboBoxItem Content="Quilt" Tag="5" />
<local:MyComboBoxItem Content="NeoForge" Tag="6" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部" Tag="" IsSelected="True" />
<local:MyComboBoxItem Content="世界元素" Tag="406/worldgen" />
<local:MyComboBoxItem Content="生物群系" Tag="407/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="维度" Tag="410/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="矿物与资源" Tag="408/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="天然结构" Tag="409/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="科技" Tag="412/technology" />
<local:MyComboBoxItem Content="管道与物流" Tag="415/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="自动化" Tag="4843/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="能源" Tag="417/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="红石" Tag="4558/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="食物与烹饪" Tag="436/food" />
<local:MyComboBoxItem Content="农业" Tag="416/" Margin="15,0,0,0" />
<local:MyComboBoxItem Content="游戏机制" Tag="/game-mechanics" />
<local:MyComboBoxItem Content="运输" Tag="414/transportation" />
<local:MyComboBoxItem Content="仓储" Tag="420/storage" />
<local:MyComboBoxItem Content="魔法" Tag="419/magic" />
<local:MyComboBoxItem Content="冒险" Tag="422/adventure" />
<local:MyComboBoxItem Content="装饰" Tag="424/decoration" />
<local:MyComboBoxItem Content="生物" Tag="411/mobs" />
<local:MyComboBoxItem Content="装备与工具" Tag="434/equipment" />
<local:MyComboBoxItem Content="性能优化" Tag="/optimization" />
<local:MyComboBoxItem Content="信息显示" Tag="423/" />
<local:MyComboBoxItem Content="服务器" Tag="435/social" />
<local:MyComboBoxItem Content="改良" Tag="5191/utility" />
<local:MyComboBoxItem Content="支持库" Tag="421/library" />
</local:MyComboBox>
</Grid>
<Grid Margin="0,4,0,6" Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnSearchRun" Text="搜索" MinWidth="140" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" />
<local:MyButton x:Name="BtnSearchReset" Text="重置条件" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel x:Name="PanContent">
<local:MyHint x:Name="HintError" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,结果可能不全。&#xa;请尝试使用 VPN 或加速器以改善网络。" IsWarn="True" Margin="0,0,0,15" />
<local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard>
<local:MyCard Margin="0,15,0,0" x:Name="CardPages" HorizontalAlignment="Center">
<StackPanel Orientation="Horizontal" Height="23" Margin="10,7">
<local:MyIconButton x:Name="BtnPageFirst" IsEnabled="False" Opacity="0.2" Margin="0,0.5,5,0.5"
Logo="M496.213333 329.856L315.306667 510.848l180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z m298.666667 0l-180.949333 180.992 180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z" />
<local:MyIconButton x:Name="BtnPageLeft" IsEnabled="False" Opacity="0.2" Margin="0,0,5,0"
Logo="M650.752 278.357333l-241.322667 241.365334 241.322667 241.365333a42.666667 42.666667 0 1 1-60.330667 60.330667l-271.530666-271.530667a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.416-27.648l271.530666-271.530666a42.666667 42.666667 0 0 1 60.330667 60.330666z" />
<TextBlock x:Name="LabPage" Text="1"
Margin="8,0,13,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight" Margin="0,0,30,0"
Logo="M404.309333 278.357333l241.322667 241.365334-241.322667 241.365333a42.666667 42.666667 0 1 0 60.330667 60.330667l271.530667-271.530667a42.453333 42.453333 0 0 0 11.818666-22.613333l0.597334-5.034667v-5.034667a42.496 42.496 0 0 0-12.416-27.648L464.64 218.026667a42.666667 42.666667 0 0 0-60.330667 60.330666z" />
</StackPanel>
</local:MyCard>
</StackPanel>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取 Mod 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -1,110 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadPack"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="25">
<local:MyCard Title="搜索整合包" Margin="0,0,0,15" x:Name="PanAlways">
<StackPanel Margin="25,40,25,15">
<Grid Margin="0,0,0,11" HorizontalAlignment="Stretch">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="2.5*" />
<ColumnDefinition Width="50" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="名称" Margin="0,0,18,0" />
<local:MyTextBox x:Name="TextSearchName" Grid.Column="1" />
<TextBlock VerticalAlignment="Center" Grid.Column="3" HorizontalAlignment="Left" Text="来源" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchSource" Grid.Column="4">
<local:MyComboBoxItem Content="全部" Tag="3" IsSelected="True" />
<local:MyComboBoxItem Content="CurseForge" Tag="1" />
<local:MyComboBoxItem Content="Modrinth" Tag="2" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.4" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="4" Grid.Row="2" MaxDropDownHeight="320">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Tag="4484/" Content="多人" />
<local:MyComboBoxItem Tag="/optimization" Content="性能优化" />
<local:MyComboBoxItem Tag="4479/challenging" Content="硬核" />
<local:MyComboBoxItem Tag="4483/combat" Content="战斗" />
<local:MyComboBoxItem Tag="4478/quests" Content="任务" />
<local:MyComboBoxItem Tag="4472/technology" Content="科技" />
<local:MyComboBoxItem Tag="4473/magic" Content="魔法" />
<local:MyComboBoxItem Tag="4475/adventure" Content="冒险" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="大杂烩" />
<local:MyComboBoxItem Tag="4476/" Content="探索" />
<local:MyComboBoxItem Tag="4477/" Content="小游戏" />
<local:MyComboBoxItem Tag="4471/" Content="科幻" />
<local:MyComboBoxItem Tag="4736/" Content="空岛" />
<local:MyComboBoxItem Tag="5128/" Content="原版改良" />
<local:MyComboBoxItem Tag="4487/" Content="FTB"
ToolTip="由 FTB 官方发布" ToolTipService.HorizontalOffset="70" />
<local:MyComboBoxItem Tag="4480/" Content="基于地图" />
<local:MyComboBoxItem Tag="4481/lightweight" Content="轻量整合" />
<local:MyComboBoxItem Tag="4482/" Content="大型整合" />
</local:MyComboBox>
</Grid>
<Grid Margin="0,4,0,6" Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnSearchRun" Text="搜索" MinWidth="140" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" />
<local:MyButton x:Name="BtnSearchReset" Text="重置条件" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" />
<local:MyButton x:Name="BtnSearchInstall" Text="安装已有整合包" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="2"
ToolTip="在当前选择的 Minecraft 文件夹下安装整合包" ToolTipService.HorizontalOffset="-55" ToolTipService.VerticalOffset="5" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel x:Name="PanContent">
<local:MyHint x:Name="HintError" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,结果可能不全。&#xa;请尝试使用 VPN 或加速器以改善网络。" IsWarn="True" Margin="0,0,0,15" />
<local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard>
<local:MyCard Margin="0,15,0,0" x:Name="CardPages" HorizontalAlignment="Center">
<StackPanel Orientation="Horizontal" Height="23" Margin="10,7">
<local:MyIconButton x:Name="BtnPageFirst" IsEnabled="False" Opacity="0.2" Margin="0,0.5,5,0.5"
Logo="M496.213333 329.856L315.306667 510.848l180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z m298.666667 0l-180.949333 180.992 180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z" />
<local:MyIconButton x:Name="BtnPageLeft" IsEnabled="False" Opacity="0.2" Margin="0,0,5,0"
Logo="M650.752 278.357333l-241.322667 241.365334 241.322667 241.365333a42.666667 42.666667 0 1 1-60.330667 60.330667l-271.530666-271.530667a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.416-27.648l271.530666-271.530666a42.666667 42.666667 0 0 1 60.330667 60.330666z" />
<TextBlock x:Name="LabPage" Text="1"
Margin="8,0,13,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight" Margin="0,0,30,0"
Logo="M404.309333 278.357333l241.322667 241.365334-241.322667 241.365333a42.666667 42.666667 0 1 0 60.330667 60.330667l271.530667-271.530667a42.453333 42.453333 0 0 0 11.818666-22.613333l0.597334-5.034667v-5.034667a42.496 42.496 0 0 0-12.416-27.648L464.64 218.026667a42.666667 42.666667 0 0 0-60.330667 60.330666z" />
</StackPanel>
</local:MyCard>
</StackPanel>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取整合包列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -1,128 +0,0 @@
Public Class PageDownloadPack
Public Const PageSize = 40
'加载器信息
Public Shared Loader As New LoaderTask(Of CompProjectRequest, Integer)("CompProject ModPack", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Public Shared Storage As New CompProjectStorage
Public Shared Page As Integer = 0
Private Sub PageDownloadPack_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
If McVersionHighest = -1 Then McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1)))
End Sub
Private Shared Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(CompType.ModPack, Storage, (Page + 1) * PageSize)
If FrmDownloadPack IsNot Nothing Then
With Request
.SearchText = FrmDownloadPack.TextSearchName.Text
.GameVersion = If(FrmDownloadPack.TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(FrmDownloadPack.TextSearchVersion.Text.Contains(".") OrElse FrmDownloadPack.TextSearchVersion.Text.Contains("w"), FrmDownloadPack.TextSearchVersion.Text, Nothing))
.Tag = FrmDownloadPack.ComboSearchTag.SelectedItem.Tag
.Source = CType(Val(FrmDownloadPack.ComboSearchSource.SelectedItem.Tag), CompSourceType)
End With
End If
Return Request
End Function
'结果 UI 化
Private Sub Load_OnFinish()
Try
Log($"[Comp] 开始可视化整合包列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
'列表项
PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
PanProjects.Children.Add(Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing, True))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal,
Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1
BtnPageFirst.IsEnabled = Page > 1
BtnPageFirst.Opacity = If(Page > 1, 1, 0.2)
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
'错误信息
If Storage.ErrorMessage Is Nothing Then
HintError.Visibility = Visibility.Collapsed
Else
HintError.Visibility = Visibility.Visible
HintError.Text = Storage.ErrorMessage
End If
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
Log(ex, "可视化整合包列表出错", LogLevel.Feedback)
End Try
End Sub
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case Loader.State
Case LoadState.Failed
Dim ErrorMessage As String = ""
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Download] 下载的整合包列表 json 文件损坏,已自动重试", LogLevel.Debug)
PageLoaderRestart()
End If
End Select
End Sub
'切换页码
Private Sub BtnPageFirst_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageFirst.Click
ChangePage(0)
End Sub
Private Sub BtnPageLeft_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageLeft.Click
ChangePage(Page - 1)
End Sub
Private Sub BtnPageRight_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageRight.Click
ChangePage(Page + 1)
End Sub
Private Sub ChangePage(NewPage As Integer)
CardPages.IsEnabled = False
Page = NewPage
FrmMain.BackToTop()
Log($"[Download] 整合包切换到第 {Page + 1} 页")
RunInThread(Sub()
Thread.Sleep(100) '等待向上滚的动画结束
RunInUi(Sub() CardPages.IsEnabled = True)
Loader.Start()
End Sub)
End Sub
Private Sub BtnSearchInstall_Click(sender As Object, e As EventArgs) Handles BtnSearchInstall.Click
ModpackInstall()
End Sub
#Region "搜索"
'搜索按钮
Private Sub StartNewSearch() Handles BtnSearchRun.Click
Page = 0
If Loader.ShouldStart(LoaderInput()) Then Storage = New CompProjectStorage '避免连续搜索两次使得 CompProjectStorage 引用丢失(#1311)
Loader.Start()
End Sub
Private Sub EnterTrigger(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyDown, TextSearchVersion.KeyDown
If e.Key = Key.Enter Then StartNewSearch()
End Sub
'重置按钮
Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click
TextSearchName.Text = ""
TextSearchVersion.Text = "全部 (也可自行输入)"
TextSearchVersion.SelectedIndex = 0
ComboSearchSource.SelectedIndex = 0
ComboSearchTag.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
#End Region
End Class
@@ -87,7 +87,7 @@
LabTitle.Text = "登录 Minecraft"
LabCaption.Text =
$"登录网页将自动开启,请在网页中输入 {UserCode}(已自动复制)。" & vbCrLf & vbCrLf &
$"如果网络环境不佳,网页可能一直加载不出来,届时请使用 VPN 并重试。" & vbCrLf &
$"如果网络环境不佳,网页可能一直加载不出来,届时请使用使用加速器或 VPN 以改善网络环境。" & vbCrLf &
$"你也可以用其他设备打开 {Website} 并输入上述代码。"
Btn1.EventData = Website
Btn2.EventData = UserCode
@@ -97,7 +97,7 @@
Private Sub WorkThread()
Thread.Sleep(3000)
If MyConverter.IsExited Then Exit Sub
If MyConverter.IsExited Then Return
OpenWebsite(Website)
ClipboardSet(UserCode)
Thread.Sleep((Data("interval").ToObject(Of Integer) - 1) * 1000)
@@ -125,6 +125,9 @@
ElseIf ex.Message.Contains("expired_token") Then
Finished(New Exception("$登录用时太长啦,重新试试吧!"))
Return
ElseIf ex.Message.Contains("service abuse") Then
Finished(New Exception("$非常抱歉,该账号已被微软封禁,无法登录。"))
Return
ElseIf ex.Message.Contains("AADSTS70000") Then '可能不能判 “invalid_grant”,见 #269
Finished(New RestartException)
Return
@@ -49,7 +49,7 @@
If Not Loader.State = LoadState.Finished Then
Hint("皮肤正在获取中,请稍候!", HintType.Critical)
If Not Loader.State = LoadState.Loading Then Loader.Start()
Exit Sub
Return
End If
Try
Dim FileAddress As String = SelectSaveFile("选取保存皮肤的位置", GetFileNameFromPath(Address), "皮肤图片文件(*.png)|*.png")
@@ -87,7 +87,7 @@
Catch ex As Exception '#2272
Log(ex, $"皮肤文件已损坏:{Address}", LogLevel.Hint)
File.Delete(Address)
Exit Sub
Return
End Try
ImgBack.Tag = Address
'大小检查
@@ -209,11 +209,11 @@
'检查条件,获取新披风
If IsChanging Then
Hint("正在更改披风中,请稍候!")
Exit Sub
Return
End If
If McLoginMsLoader.State = LoadState.Failed Then
Hint("登录失败,无法更改披风!", HintType.Critical)
Exit Sub
Return
End If
Hint("正在获取披风列表,请稍候……")
IsChanging = True
@@ -226,7 +226,7 @@ Retry:
If McLoginMsLoader.State <> LoadState.Finished Then McLoginMsLoader.WaitForExit(PageLoginMsSkin.GetLoginData())
If McLoginMsLoader.State <> LoadState.Finished Then
Hint("登录失败,无法更改披风!", HintType.Critical)
Exit Sub
Return
End If
Dim AccessToken As String = McLoginMsLoader.Output.AccessToken
Dim Uuid As String = McLoginMsLoader.Output.Uuid
@@ -243,7 +243,8 @@ Retry:
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"},
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"},
{"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}, {"Minecraft Experience", "村民救援披风"},
{"Mojang Office", "Mojang 办公室披风"}, {"Home", "家园披风"}, {"Menace", "入侵披风"}
{"Mojang Office", "Mojang 办公室披风"}, {"Home", "家园披风"}, {"Menace", "入侵披风"}, {"Yearn", "渴望披风"},
{"Common", "普通披风"}, {"Pan", "薄煎饼披风"}, {"Founder's", "创始人披风"}
}
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes")
@@ -256,7 +257,7 @@ Retry:
Log(ex, "获取玩家皮肤列表失败", LogLevel.Feedback)
End Try
End Sub)
If SelId Is Nothing Then Exit Sub
If SelId Is Nothing Then Return
'发送请求
Dim Result As String = NetRequestRetry("https://api.minecraftservices.com/minecraft/profile/capes/active",
If(SelId = 0, "DELETE", "PUT"),
@@ -264,7 +265,7 @@ Retry:
"application/json", Headers:=New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
If Result.Contains("""errorMessage""") Then
Hint("更改披风失败:" & GetJson(Result)("errorMessage"), HintType.Critical)
Exit Sub
Return
Else
Hint("更改披风成功!", HintType.Finish)
End If
@@ -9,7 +9,7 @@
AprilPosTrans.X = 0
AprilPosTrans.Y = 0
If IsLoad Then Exit Sub
If IsLoad Then Return
IsLoad = True
AniControlEnabled += 1
@@ -353,7 +353,7 @@ UnknownType:
GoTo UnknownType
End Select
'刷新页面
If PageCurrent = Type Then Exit Sub
If PageCurrent = Type Then Return
PageChange(Type, Anim).Reload(KeepInput)
Dim Control As MyRadioButton = FindName("RadioLoginType" & Setup.Get("LoginType"))
If Control IsNot Nothing Then Control.Checked = True
@@ -393,7 +393,7 @@ UnknownType:
Catch ex As Exception
If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = ""
Exit Sub
Return
ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取正版皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", LogLevel.Hint)
@@ -463,7 +463,7 @@ UseDefault:
Catch ex As Exception
If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = ""
Exit Sub
Return
ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png"
Log("获取离线登录使用的正版皮肤失败(" & ID & "):获取皮肤太过频繁,请 5 分钟后再试!")
@@ -515,7 +515,7 @@ UseDefault:
Catch ex As Exception
If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = ""
Exit Sub
Return
ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取统一通行证皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", LogLevel.Hint)
@@ -563,7 +563,7 @@ Finish:
Catch ex As Exception
If ex.GetType.Name = "ThreadInterruptedException" Then
Data.Output = ""
Exit Sub
Return
ElseIf GetExceptionSummary(ex).Contains("429") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取 Authlib-Injector 皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", LogLevel.Hint)
@@ -592,13 +592,13 @@ Finish:
'版本选择按钮
Private Sub BtnVersion_Click(sender As Object, e As EventArgs) Handles BtnVersion.Click
If McLaunchLoader.State = LoadState.Loading Then Exit Sub
If McLaunchLoader.State = LoadState.Loading Then Return
FrmMain.PageChange(FormMain.PageType.VersionSelect)
End Sub
'启动按钮
Public Sub LaunchButtonClick() Handles BtnLaunch.Click
If McLaunchLoader.State = LoadState.Loading OrElse Not BtnLaunch.IsEnabled OrElse
(FrmMain.PageRight IsNot Nothing AndAlso FrmMain.PageRight.PageState <> MyPageRight.PageStates.ContentStay AndAlso FrmMain.PageRight.PageState <> MyPageRight.PageStates.ContentEnter) Then Exit Sub
(FrmMain.PageRight IsNot Nothing AndAlso FrmMain.PageRight.PageState <> MyPageRight.PageStates.ContentStay AndAlso FrmMain.PageRight.PageState <> MyPageRight.PageStates.ContentEnter) Then Return
'愚人节处理
If IsAprilEnabled AndAlso Not IsAprilGiveup Then
ThemeUnlock(12, False, "隐藏主题 滑稽彩 已解锁!")
@@ -619,7 +619,7 @@ Finish:
Private BtnLaunchState As Integer = 0
Private BtnLaunchVersion As McVersion = Nothing
Public Sub RefreshButtonsUI() Handles BtnLaunch.Loaded
If Not BtnLaunch.IsLoaded Then Exit Sub
If Not BtnLaunch.IsLoaded Then Return
'获取当前状态
Dim CurrentState As Integer
If (Not IsLoadFinished) OrElse McVersionListLoader.State = LoadState.Loading OrElse McFolderListLoader.State = LoadState.Loading Then
@@ -695,7 +695,7 @@ ExitRefresh:
End Sub
'版本设置按钮
Private Sub BtnMore_Click(sender As Object, e As EventArgs) Handles BtnMore.Click
If McLaunchLoader.State = LoadState.Loading Then Exit Sub
If McLaunchLoader.State = LoadState.Loading Then Return
McVersionCurrent.Load()
PageVersionLeft.Version = McVersionCurrent
FrmMain.PageChange(FormMain.PageType.VersionSetup, 0)
@@ -705,7 +705,7 @@ ExitRefresh:
''' </summary>
Public Sub LaunchingRefresh()
Try
If McLaunchLoaderReal.State = LoadState.Aborted Then Exit Sub
If McLaunchLoaderReal.State = LoadState.Aborted Then Return
'阶段状态获取
Dim IsLaunched As Boolean = False '是否已经启动游戏,只是在等待窗口
Try
@@ -719,7 +719,7 @@ ExitRefresh:
LabLaunchingStage.Text = "已完成"
Catch ex As Exception
Log(ex, "获取是否启动完成失败,可能是由于启动状态改变导致集合已修改")
Exit Sub
Return
End Try
If AniIsRun("Launch State Page") Then IsLaunched = False '等待页面切换动画完成
'计算应显示的进度
@@ -789,7 +789,7 @@ ExitRefresh:
Private ActualUsedWidth As Double
Private Sub PanLaunchingInfo_SizeChangedW(sender As Object, e As SizeChangedEventArgs) Handles PanLaunchingInfo.SizeChanged
Dim DeltaWidth As Double = e.NewSize.Width - e.PreviousSize.Width
If e.PreviousSize.Width = 0 OrElse IsWidthAnimating OrElse Math.Abs(DeltaWidth) < 1 OrElse PanLaunchingInfo.ActualWidth = 0 Then Exit Sub
If e.PreviousSize.Width = 0 OrElse IsWidthAnimating OrElse Math.Abs(DeltaWidth) < 1 OrElse PanLaunchingInfo.ActualWidth = 0 Then Return
AniStart({
AaWidth(PanLaunchingInfo, DeltaWidth, 180,, New AniEaseOutFluent),
AaCode(Sub()
@@ -805,7 +805,7 @@ ExitRefresh:
Private ActualUsedHeight As Double
Private Sub PanLaunchingInfo_SizeChangedH(sender As Object, e As SizeChangedEventArgs) Handles PanLaunchingInfo.SizeChanged
Dim DeltaHeight As Double = e.NewSize.Height - e.PreviousSize.Height
If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse PanLaunchingInfo.ActualHeight = 0 Then Exit Sub
If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse PanLaunchingInfo.ActualHeight = 0 Then Return
AniStart({
AaHeight(PanLaunchingInfo, DeltaHeight, 180,, New AniEaseOutFluent),
AaCode(Sub()
@@ -22,10 +22,10 @@
End Sub
#End If
#Region "自定义主页"
#Region "主页"
''' <summary>
''' 刷新自定义主页。
''' 刷新主页。
''' </summary>
Private Sub Refresh() Handles Me.Loaded
RunInNewThread(
@@ -35,9 +35,9 @@
RefreshReal()
End SyncLock
Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", LogLevel.Msgbox)
Log(ex, "加载 PCL 主页自定义信息失败", If(ModeDebug, LogLevel.Msgbox, LogLevel.Hint))
End Try
End Sub, $"刷新自定义主页 #{GetUuid()}")
End Sub, $"刷新主页 #{GetUuid()}")
End Sub
Private Sub RefreshReal()
Dim Content As String = ""
@@ -65,7 +65,7 @@ Download:
RunInUiWait(Sub() LoadContent("")) '在加载结束前清空页面
Setup.Set("CacheSavedPageVersion", "")
OnlineLoader.Start(Url) '下载完成后将会再次触发更新
Exit Sub
Return
End If
Case 3
Select Case Setup.Get("UiCustomPreset")
@@ -133,8 +133,8 @@ Download:
End Sub
Private RefreshLock As New Object
'联网获取自定义主页文件
Private OnlineLoader As New LoaderTask(Of String, Integer)("自定义主页获取", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
'联网获取主页文件
Private OnlineLoader As New LoaderTask(Of String, Integer)("下载主页", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
Private Sub OnlineLoaderSub(Task As LoaderTask(Of String, Integer))
Dim Address As String = Task.Input '#3721 中连续触发两次导致内容变化
Try
@@ -146,50 +146,46 @@ Download:
VersionAddress = Address.BeforeFirst("?")
If Not VersionAddress.EndsWith("/") Then VersionAddress += "/"
VersionAddress += "version"
If Address.Contains("?") Then VersionAddress += Address.AfterLast("?")
If Address.Contains("?") Then VersionAddress += "?" & Address.AfterFirst("?")
End If
'校验版本
Dim Version As String = ""
Dim NeedDownload As Boolean = True
Try
Version = NetGetCodeByRequestOnce(VersionAddress, Timeout:=10000)
If Version.Length > 1000 Then Throw New Exception($"获取的自定义主页版本过长({Version.Length} 字符)")
If Version.Length > 1000 Then Throw New Exception($"获取的主页版本过长({Version.Length} 字符)")
Dim CurrentVersion As String = Setup.Get("CacheSavedPageVersion")
If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then
Log($"[Page] 当前缓存的自定义主页已为最新,当前版本:{Version},检查源:{VersionAddress}")
Log($"[Page] 当前缓存的主页已为最新,当前版本:{Version},检查源:{VersionAddress}")
NeedDownload = False
Else
Log($"[Page] 需要下载联网自定义主页,当前版本:{Version},检查源:{VersionAddress}")
Log($"[Page] 需要下载联网主页,当前版本:{Version},检查源:{VersionAddress}")
End If
Catch exx As Exception
Log(exx, $"联网获取自定义主页版本失败", LogLevel.Developer)
Log($"[Page] 无法检查联网自定义主页版本,将直接下载,检查源:{VersionAddress}")
Log(exx, $"联网获取主页版本失败", LogLevel.Developer)
Log($"[Page] 无法检查联网主页版本,将直接下载,检查源:{VersionAddress}")
End Try
'实际下载
If NeedDownload Then
Dim FileContent As String = NetGetCodeByRequestRetry(Address)
Log($"[Page] 已联网下载自定义主页,内容长度:{FileContent.Length},来源:{Address}")
Log($"[Page] 已联网下载主页,内容长度:{FileContent.Length},来源:{Address}")
Setup.Set("CacheSavedPageUrl", Address)
Setup.Set("CacheSavedPageVersion", Version)
WriteFile(PathTemp & "Cache\Custom.xaml", FileContent)
End If
'要求刷新
Refresh()
RunInUi(AddressOf Refresh) '不直接调用 Refresh,以防止死循环(#6245)
Catch ex As Exception
If Setup.Get("CacheSavedPageVersion") = "" Then
Log(ex, $"联网下载自定义主页失败({Address})", LogLevel.Msgbox)
Else
Log(ex, $"联网下载自定义主页失败({Address})")
End If
Log(ex, $"下载主页失败({Address})", If(ModeDebug, LogLevel.Msgbox, LogLevel.Hint))
End Try
End Sub
''' <summary>
''' 立即强制刷新自定义主页。
''' 立即强制刷新主页。
''' 必须在 UI 线程调用。
''' </summary>
Public Sub ForceRefresh() Implements IRefreshable.Refresh
Log("[Page] 要求强制刷新自定义主页")
Log("[Page] 要求强制刷新主页")
ClearCache()
'实际的刷新
If FrmMain.PageCurrent.Page = FormMain.PageType.Launch Then
@@ -201,44 +197,55 @@ Download:
End Sub
''' <summary>
''' 清空自定义主页缓存信息。
''' 清空主页缓存信息。
''' </summary>
Private Sub ClearCache()
LoadedContentHash = -1
OnlineLoader.Input = ""
Setup.Set("CacheSavedPageUrl", "")
Setup.Set("CacheSavedPageVersion", "")
Log("[Page] 已清空自定义主页缓存")
Log("[Page] 已清空主页缓存")
End Sub
''' <summary>
''' 从文本内容中加载自定义主页。
''' 从文本内容中加载主页。
''' 必须在 UI 线程调用。
''' </summary>
Private Sub LoadContent(Content As String)
SyncLock LoadContentLock
'如果加载目标内容一致则不加载
Dim Hash = Content.GetHashCode()
If Hash = LoadedContentHash Then Exit Sub
If Hash = LoadedContentHash Then Return
LoadedContentHash = Hash
'实际加载内容
PanCustom.Children.Clear()
If String.IsNullOrWhiteSpace(Content) Then
Log($"[Page] 实例化:清空自定义主页 UI,来源为空")
Log($"[Page] 实例化:清空主页 UI,来源为空")
Return
End If
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Content = HelpArgumentReplace(Content)
Log($"[Page] 实例化:加载自定义主页 UI 开始,最终内容长度:{Content.Count}")
Dim LoadStartTime As Date = Date.Now
Try
'修改时应同时修改 PageOtherHelpDetail.Init
Content = HelpArgumentReplace(Content)
If Content.Contains("xmlns") Then Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Log($"[Page] 实例化:加载主页 UI 开始,最终内容长度:{Content.Count}")
PanCustom.Children.Add(GetObjectFromXML(Content))
Catch ex As Exception
Log("[Page] 加载失败的自定义主页内容:" & vbCrLf & Content)
If MyMsgBox($"自定义主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{GetExceptionSummary(ex)}", "加载自定义主页失败", "重试", "取消") = 1 Then
If ModeDebug Then
Log(ex, "加载失败的主页内容:" & vbCrLf & Content)
If MyMsgBox(If(TypeOf ex Is UnauthorizedAccessException, ex.Message, $"主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{GetExceptionSummary(ex)}"),
"加载主页界面失败", "重试", "取消") = 1 Then
GoTo Refresh '防止 SyncLock 死锁
End If
Else
Log(ex, "加载主页界面失败", LogLevel.Hint)
End If
Return
End Try
Log($"[Page] 实例化:加载自定义主页 UI 完成")
Dim LoadCostTime = (Date.Now - LoadStartTime).Milliseconds
Log($"[Page] 实例化:加载主页 UI 完成,耗时 {LoadCostTime}ms")
If LoadCostTime > 3000 Then Hint($"主页加载过于缓慢(花费了 {Math.Round(LoadCostTime / 1000, 1)} 秒),请向主页作者反馈此问题,或暂时停止使用该主页")
End SyncLock
Return
Refresh:
@@ -49,11 +49,10 @@
Log("[Launch] 要求更换角色,但登录加载器繁忙", LogLevel.Debug)
If CType(McLoginLoader.Input, McLoginServer).ForceReselectProfile Then
Hint("正在尝试更换,请稍候!")
Exit Sub
Else
Hint("正在登录中,请稍后再更换角色!", HintType.Critical)
Exit Sub
End If
Return
End If
Hint("正在尝试更换,请稍候!")
Setup.Set("CacheAuthUuid", "") '清空选择缓存
@@ -6,7 +6,7 @@
xmlns:local="clr-namespace:PCL"
mc:Ignorable="d" d:DesignWidth="297.6">
<StackPanel Margin="0,0,0,5">
<local:MyHint x:Name="HintChinese" Text="玩家名如果包含英文、数字、下划线以外的内容,可能会无法进入 Minecraft 1.18 以后的世界!" Margin="0,0,0,15" Visibility="Collapsed" />
<local:MyHint x:Name="HintChinese" Theme="Red" Text="玩家名如果包含英文、数字、下划线以外的内容,可能会无法进入 Minecraft 1.18 以后的世界!" Margin="0,0,0,15" Visibility="Collapsed" />
<local:MySkin HorizontalAlignment="Center" x:Name="Skin" HasCape="False" Margin="0,0,0,15" />
<local:MyComboBox IsEditable="True" x:Name="ComboName" Height="28" IsTextSearchEnabled="False" HintText="游戏用户名" />
</StackPanel>
@@ -45,7 +45,7 @@ Public Class PageLoginLegacy
If LoginData.UserName.Trim = "" Then Return "玩家名不能为空!"
If LoginData.UserName.Contains("""") Then Return "玩家名不能包含英文引号!"
If McVersionCurrent IsNot Nothing AndAlso
((McVersionCurrent.Version.McCodeMain = 20 AndAlso McVersionCurrent.Version.McCodeSub >= 3) OrElse McVersionCurrent.Version.McCodeMain > 20) AndAlso
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 20, 3)) AndAlso
LoginData.UserName.Trim.Length > 16 Then
Return "自 1.20.3 起,玩家名至多只能包含 16 个字符!"
End If
@@ -25,7 +25,7 @@
ComboAccounts.SelectedIndex = If(KeepInput, Math.Max(0, IndexBefore), 0)
End Sub
Private Sub ComboAccounts_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboAccounts.SelectionChanged
If AniControlEnabled <> 0 OrElse ComboAccounts.SelectedItem Is Nothing OrElse ComboAccounts.ContentPresenter Is Nothing Then Exit Sub
If AniControlEnabled <> 0 OrElse ComboAccounts.SelectedItem Is Nothing OrElse ComboAccounts.ContentPresenter Is Nothing Then Return
If TypeOf ComboAccounts.SelectedItem Is MyListItem Then
ComboAccounts.ContentPresenter.Content = CType(ComboAccounts.SelectedItem, MyListItem).Title
ElseIf TypeOf ComboAccounts.SelectedItem Is MyComboBoxItem Then
@@ -33,7 +33,7 @@
AniStart(AaOpacity(PanButtons, 1 - PanButtons.Opacity, 120), "PageLoginMsSkin Button")
End Sub
Public Sub HidePanel() Handles PanData.MouseLeave
If BtnEdit.ContextMenu.IsOpen OrElse BtnSkin.ContextMenu.IsOpen OrElse PanData.IsMouseOver Then Exit Sub
If BtnEdit.ContextMenu.IsOpen OrElse BtnSkin.ContextMenu.IsOpen OrElse PanData.IsMouseOver Then Return
AniStart(AaOpacity(PanButtons, -PanButtons.Opacity, 120), "PageLoginMsSkin Button")
End Sub
@@ -74,14 +74,14 @@
'检查条件,获取新皮肤
If IsChanging Then
Hint("正在更改皮肤中,请稍候!")
Exit Sub
Return
End If
If McLoginLoader.State = LoadState.Failed Then
Hint("登录失败,无法更改皮肤!", HintType.Critical)
Exit Sub
Return
End If
Dim SkinInfo As McSkinInfo = McSkinSelect()
If Not SkinInfo.IsVaild Then Exit Sub
If Not SkinInfo.IsVaild Then Return
Hint("正在更改皮肤……")
IsChanging = True
'开始实际获取
@@ -108,7 +108,7 @@ Retry:
GoTo Retry
ElseIf Result.Contains("""error""") Then
Hint("更改皮肤失败:" & GetJson(Result)("error"), HintType.Critical)
Exit Sub
Return
End If
'获取新皮肤地址
Log("[Skin] 皮肤修改返回值:" & vbCrLf & Result)
@@ -117,7 +117,7 @@ Retry:
For Each Skin As JObject In ResultJson("skins")
If Skin("state").ToString = "ACTIVE" Then
MySkin.ReloadCache(Skin("url"))
Exit Sub
Return
End If
Next
Throw New Exception("未知错误(" & Result & ")")
@@ -103,7 +103,6 @@
<RowDefinition Height="Auto" />
<RowDefinition Height="1*" />
</Grid.RowDefinitions>
<!--<local:MyHint IsWarn="True" Text="这是错误文本。" x:Name="HintTypeError" Visibility="Collapsed" Grid.ColumnSpan="5" Grid.RowSpan="5" Margin="15,15,15,0" VerticalAlignment="Top" />-->
<local:MyCard x:Name="BtnSelectCreate" Grid.Column="1" Grid.Row="1">
<Grid Margin="35,0,25,0" IsHitTestVisible="False">
<Grid.RowDefinitions>
@@ -18,7 +18,7 @@
Private IsLoad As Boolean = False
Private Sub OnLoaded() Handles Me.Loaded
FormMain.EndProgramForce(ProcessReturnValues.Aborted)
If IsLoad Then Exit Sub
If IsLoad Then Return
IsLoad = True
'启动监视线程
If Not IsWatcherStarted Then RunInNewThread(AddressOf WatcherThread, "Hiper Watcher")
@@ -149,7 +149,7 @@
'每 1 秒执行的 Timer
Private Sub WatcherTimer1()
If HiperState <> LoadState.Finished Then Exit Sub
If HiperState <> LoadState.Finished Then Return
RunInUi(Sub()
'索引码剩余时间
Dim Span As TimeSpan = HiperCertTime - Date.Now
@@ -178,7 +178,7 @@
HiperExit(True)
ShowWindowToTop(Handle)
Beep()
Exit Sub
Return
End If
'网络质量
Dim QualityScore As Integer = If(IpIsInChina, 0, -2)
@@ -272,7 +272,7 @@
Log("[Hiper] 连接步骤:" & Intro)
LoadStep = [Step]
RunInUiWait(Sub()
If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.LabLoadDesc.IsLoaded Then Exit Sub
If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.LabLoadDesc.IsLoaded Then Return
FrmLinkHiper.LabLoadDesc.Text = Intro
FrmLinkHiper.UpdateProgress()
End Sub)
@@ -280,7 +280,7 @@
'承接重试
Private Sub CardLoad_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles CardLoad.MouseLeftButtonUp
If Not InitLoader.State = LoadState.Failed Then Exit Sub
If Not InitLoader.State = LoadState.Failed Then Return
InitLoader.Start(IsForceRestart:=True)
End Sub
@@ -299,7 +299,7 @@
Private Sub UpdateProgress(Optional Value As Double = -1)
If Value = -1 Then Value = InitLoader.Progress
Dim DisplayingProgress As Double = ColumnProgressA.Width.Value
If Math.Round(Value - DisplayingProgress, 3) = 0 Then Exit Sub
If Math.Round(Value - DisplayingProgress, 3) = 0 Then Return
If DisplayingProgress > Value Then
ColumnProgressA.Width = New GridLength(Value, GridUnitType.Star)
ColumnProgressB.Width = New GridLength(1 - Value, GridUnitType.Star)
@@ -327,7 +327,7 @@
'退出
Private Sub BtnFinishExit_Click(sender As Object, e As EventArgs) Handles BtnFinishExit.Click
If IsServerSide AndAlso MyMsgBox("你确定要关闭联机房间吗?", "确认退出", "确定", "取消", IsWarn:=True) = 2 Then Exit Sub
If IsServerSide AndAlso MyMsgBox("你确定要关闭联机房间吗?", "确认退出", "确定", "取消", IsWarn:=True) = 2 Then Return
HiperExit(False)
End Sub
@@ -338,7 +338,7 @@
'Ping 房主
Private Sub BtnFinishPing_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnFinishPing.MouseLeftButtonUp
LabFinishPing.Text = "检测中"
If TaskPingHost.State = LoadState.Loading Then Exit Sub
If TaskPingHost.State = LoadState.Loading Then Return
TaskPingHost.Start(True, IsForceRestart:=True)
End Sub
Private Shared TaskPingHost As New LoaderTask(Of Boolean, Integer)("HiPer Ping Host",
@@ -362,7 +362,7 @@
Return _CurrentSubpage
End Get
Set(value As Subpages)
If _CurrentSubpage = value Then Exit Property
If _CurrentSubpage = value Then Return
_CurrentSubpage = value
Log("[Hiper] 子页面更改为 " & GetStringFromEnum(value))
PageOnContentExit()
@@ -384,7 +384,7 @@
If InitLoader.State = LoadState.Loading Then InitLoader.Abort()
If InitLoader.State = LoadState.Failed Then InitLoader.State = LoadState.Waiting
RunInUi(Sub()
If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.IsLoaded Then Exit Sub
If FrmLinkHiper Is Nothing OrElse Not FrmLinkHiper.IsLoaded Then Return
FrmLinkHiper.CurrentSubpage = If(ExitToCertPage, Subpages.PanCert, Subpages.PanSelect)
FrmLinkHiper.PageOnContentExit()
End Sub)
@@ -10,7 +10,7 @@
<StackPanel Orientation="Vertical" Margin="25,10">
<local:MyCard Margin="0,15,0,0" x:Name="CardUser" Title="已连接的玩家 (0)">
<StackPanel Margin="20,37,20,15">
<local:MyHint Margin="5,2,5,8" x:Name="LabHint" IsWarn="False" />
<local:MyHint Margin="5,2,5,8" x:Name="LabHint" />
<StackPanel x:Name="PanUserList" />
<Grid Height="35" Margin="5,8,5,5">
<Grid.ColumnDefinitions>
@@ -3,10 +3,10 @@
Private IsLoad As Boolean = False
Private IsPageSwitched As Boolean = False '如果在 Loaded 前切换到其他页面,会导致触发 Loaded 时再次切换一次
Private Sub PageLinkLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If IsLoad Then Exit Sub
If IsLoad Then Return
IsLoad = True
'切换默认页面
If IsPageSwitched Then Exit Sub
If IsPageSwitched Then Return
ItemHiper.SetChecked(True, False, False)
End Sub
Private Sub PageOtherLeft_Unloaded(sender As Object, e As RoutedEventArgs) Handles Me.Unloaded
@@ -56,7 +56,7 @@
''' 切换现有页面。
''' </summary>
Public Sub PageChange(ID As FormMain.PageSubType)
If PageID = ID Then Exit Sub
If PageID = ID Then Return
AniControlEnabled += 1
IsPageSwitched = True
Try
@@ -104,260 +104,295 @@
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="赞助者">
<StackPanel Margin="25,40,10,20">
<TextBlock HorizontalAlignment="Left" Text="以下是 2025 年 2 月的高级赞助者们!感谢各位对 PCL 和伟大的咕咕咕事业的支持!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" />
<WrapPanel Margin="0,0,0,10"> <TextBlock Width="120" Margin="0,1.5" Text="Morisummer" />
<TextBlock Width="120" Margin="0,1.5" Text="香" />
<TextBlock Width="120" Margin="0,1.5" Text="Creeper" />
<TextBlock Width="120" Margin="0,1.5" Text="tjsstctd" />
<TextBlock Width="120" Margin="0,1.5" Text="tangent95" />
<TextBlock Width="120" Margin="0,1.5" Text="Qqwertyui1" />
<TextBlock Width="120" Margin="0,1.5" Text="爱吃东西的布布" />
<TextBlock Width="120" Margin="0,1.5" Text="青丘" />
<TextBlock Width="120" Margin="0,1.5" Text="Lithium" />
<TextBlock Width="240" Margin="0,1.5" Text="派大星教授加博士先生" />
<TextBlock Width="120" Margin="0,1.5" Text="海月" />
<TextBlock Width="120" Margin="0,1.5" Text="电鳗" />
<TextBlock Width="120" Margin="0,1.5" Text="mojanng_" />
<TextBlock Width="120" Margin="0,1.5" Text="柒白绛" />
<TextBlock Width="120" Margin="0,1.5" Text="山药汤圆" />
<TextBlock Width="120" Margin="0,1.5" Text="hrjrb" />
<TextBlock Width="120" Margin="0,1.5" Text="ccd114514" />
<TextBlock Width="120" Margin="0,1.5" Text="煦翛" />
<TextBlock Width="120" Margin="0,1.5" Text="xiaozhengjiang" />
<TextBlock Width="120" Margin="0,1.5" Text="梦醒方知梦" />
<TextBlock Width="120" Margin="0,1.5" Text="MCwsj" />
<TextBlock Width="120" Margin="0,1.5" Text="7_Sloth" />
<TextBlock Width="120" Margin="0,1.5" Text="混沌青莲" />
<TextBlock Width="120" Margin="0,1.5" Text="112233" />
<TextBlock Width="120" Margin="0,1.5" Text="cry" />
<TextBlock Width="120" Margin="0,1.5" Text="青椒" />
<TextBlock Width="120" Margin="0,1.5" Text="MostxLingo" />
<TextBlock Width="120" Margin="0,1.5" Text="暖男排狗后面" />
<TextBlock Width="120" Margin="0,1.5" Text="大狗芬里尔" />
<TextBlock Width="120" Margin="0,1.5" Text="xfuiz" />
<TextBlock Width="120" Margin="0,1.5" Text="Hilsars" />
<TextBlock Width="120" Margin="0,1.5" Text="翎霜流火" />
<TextBlock Width="120" Margin="0,1.5" Text="但愿如此" />
<TextBlock Width="120" Margin="0,1.5" Text="AF" />
<TextBlock Width="120" Margin="0,1.5" Text="王王的朋友" />
<TextBlock Width="120" Margin="0,1.5" Text="风未酉" />
<TextBlock Width="120" Margin="0,1.5" Text="YukiNoa" />
<TextBlock Width="120" Margin="0,1.5" Text="柠鼠" />
<TextBlock Width="120" Margin="0,1.5" Text="xioaliepei" />
<TextBlock Width="120" Margin="0,1.5" Text="照井黎Terui_Rei" />
<TextBlock Width="120" Margin="0,1.5" Text="1w2w3w" />
<TextBlock Width="120" Margin="0,1.5" Text="奈何" />
<TextBlock Width="120" Margin="0,1.5" Text="Dispaper" />
<TextBlock Width="120" Margin="0,1.5" Text="绅士不是坤" />
<TextBlock Width="120" Margin="0,1.5" Text="Jason" />
<TextBlock Width="120" Margin="0,1.5" Text="Auditor1027" />
<TextBlock Width="120" Margin="0,1.5" Text="上财葬俗" />
<TextBlock Width="240" Margin="0,1.5" Text="スター?プレイヤー007" />
<TextBlock Width="120" Margin="0,1.5" Text="404" />
<TextBlock Width="120" Margin="0,1.5" Text="C-R-Carlos" />
<TextBlock Width="120" Margin="0,1.5" Text="雨霁青青" />
<TextBlock Width="120" Margin="0,1.5" Text="无尽的折腾" />
<TextBlock Width="120" Margin="0,1.5" Text="Zheng404" />
<TextBlock Width="120" Margin="0,1.5" Text="IC_Star" />
<TextBlock Width="120" Margin="0,1.5" Text="叶子L" />
<TextBlock Width="120" Margin="0,1.5" Text="E·Nigme·粥" />
<TextBlock Width="120" Margin="0,1.5" Text="ccc`" />
<TextBlock Width="120" Margin="0,1.5" Text="shangt541" />
<TextBlock Width="120" Margin="0,1.5" Text="i_c" />
<TextBlock Width="120" Margin="0,1.5" Text="毒饺子" />
<TextBlock Width="120" Margin="0,1.5" Text="花菜球酥" />
<TextBlock Width="120" Margin="0,1.5" Text="Guardsman" />
<TextBlock Width="120" Margin="0,1.5" Text="末地大师" />
<TextBlock Width="120" Margin="0,1.5" Text="ART_js" />
<TextBlock Width="120" Margin="0,1.5" Text="可爱的安小唯" />
<TextBlock Width="120" Margin="0,1.5" Text="GDDR3" />
<TextBlock Width="120" Margin="0,1.5" Text="不想疏忽" />
<TextBlock Width="120" Margin="0,1.5" Text="uuhihj" />
<TextBlock Width="120" Margin="0,1.5" Text="fy-z" />
<TextBlock Width="120" Margin="0,1.5" Text="阿迟" />
<TextBlock Width="120" Margin="0,1.5" Text="古泽" />
<TextBlock Width="120" Margin="0,1.5" Text="记得回家吃饭" />
<TextBlock Width="120" Margin="0,1.5" Text="Vularia" />
<TextBlock Width="120" Margin="0,1.5" Text="L" />
<TextBlock Width="120" Margin="0,1.5" Text="zzz" />
<TextBlock Width="120" Margin="0,1.5" Text="DD酱です" />
<TextBlock Width="120" Margin="0,1.5" Text="lzzy" />
<TextBlock Width="120" Margin="0,1.5" Text="盐" />
<TextBlock Width="120" Margin="0,1.5" Text="王杰" />
<TextBlock Width="120" Margin="0,1.5" Text="金兔银鲤" />
<TextBlock Width="120" Margin="0,1.5" Text="晓景红" />
<TextBlock Width="120" Margin="0,1.5" Text="66581k" />
<TextBlock Width="120" Margin="0,1.5" Text="zpi寻觅" />
<TextBlock Width="120" Margin="0,1.5" Text="二叠" />
<TextBlock Width="120" Margin="0,1.5" Text="JMHE" />
<TextBlock Width="120" Margin="0,1.5" Text="rjq1212" />
<TextBlock Width="120" Margin="0,1.5" Text="jEVd" />
<TextBlock Width="120" Margin="0,1.5" Text="Me4444da" />
<TextBlock Width="120" Margin="0,1.5" Text="NekoTsumiki" />
<TextBlock Width="120" Margin="0,1.5" Text="日笙漓雨" />
<TextBlock Width="120" Margin="0,1.5" Text="天空叶雨" />
<TextBlock Width="120" Margin="0,1.5" Text="隐藏老六" />
<TextBlock Width="120" Margin="0,1.5" Text="YANGGE" />
<TextBlock Width="120" Margin="0,1.5" Text="里的囧啊睡觉的" />
<TextBlock Width="120" Margin="0,1.5" Text="415411户用" />
<TextBlock Width="120" Margin="0,1.5" Text="咱们尬聊吧" />
<TextBlock Width="120" Margin="0,1.5" Text="洛斯里克的旅人" />
<TextBlock Width="120" Margin="0,1.5" Text="寒寒子" />
<TextBlock Width="120" Margin="0,1.5" Text="冬天吃棒冰" />
<TextBlock Width="120" Margin="0,1.5" Text="缘了了" />
<TextBlock Width="120" Margin="0,1.5" Text="Hamtaro937" />
<TextBlock Width="120" Margin="0,1.5" Text="404_null_" />
<TextBlock Width="120" Margin="0,1.5" Text="是霭墨哒~" />
<TextBlock Width="120" Margin="0,1.5" Text="also春分" />
<TextBlock Width="120" Margin="0,1.5" Text="Rikka" />
<TextBlock Width="120" Margin="0,1.5" Text="罐装冰块." />
<TextBlock Width="120" Margin="0,1.5" Text="mc_niunai" />
<TextBlock Width="120" Margin="0,1.5" Text="一片空白" />
<TextBlock Width="120" Margin="0,1.5" Text="嗨害嗨" />
<TextBlock Width="120" Margin="0,1.5" Text="XxiaozhangX" />
<TextBlock Width="120" Margin="0,1.5" Text="云默_初心" />
<TextBlock Width="120" Margin="0,1.5" Text="番薯" />
<TextBlock Width="120" Margin="0,1.5" Text="佛系的快乐水" />
<TextBlock Width="120" Margin="0,1.5" Text="青雀人间体" />
<TextBlock Width="120" Margin="0,1.5" Text="Minecraft00A" />
<TextBlock Width="240" Margin="0,1.5" Text="安东老鼠Anton Rattus" />
<TextBlock Width="120" Margin="0,1.5" Text="KissyXissy" />
<TextBlock Width="120" Margin="0,1.5" Text="α" />
<TextBlock Width="120" Margin="0,1.5" Text="kkx" />
<TextBlock Width="120" Margin="0,1.5" Text="书中君" />
<TextBlock Width="120" Margin="0,1.5" Text="WuCun" />
<TextBlock Width="120" Margin="0,1.5" Text="流年似水" />
<TextBlock Width="120" Margin="0,1.5" Text="坚果饼子" />
<TextBlock Width="120" Margin="0,1.5" Text="风幽" />
<TextBlock Width="120" Margin="0,1.5" Text="皿良皮车" />
<TextBlock Width="120" Margin="0,1.5" Text="塌琪" />
<TextBlock Width="120" Margin="0,1.5" Text="dingdang6283" />
<TextBlock Width="120" Margin="0,1.5" Text="无心之眼" />
<TextBlock Width="120" Margin="0,1.5" Text="mc小李" />
<TextBlock Width="120" Margin="0,1.5" Text="把罐子捡起来" />
<TextBlock Width="120" Margin="0,1.5" Text="华子" />
<TextBlock Width="120" Margin="0,1.5" Text="水电风扇" />
<TextBlock Width="120" Margin="0,1.5" Text="ahjsvjvs" />
<TextBlock Width="120" Margin="0,1.5" Text="椰汁城传奇" />
<TextBlock Width="120" Margin="0,1.5" Text="梓笙" />
<TextBlock Width="120" Margin="0,1.5" Text="空欢喜" />
<TextBlock Width="120" Margin="0,1.5" Text="是折木木阿" />
<TextBlock Width="120" Margin="0,1.5" Text="BreezyCarp" />
<TextBlock Width="120" Margin="0,1.5" Text="IAMDAEV" />
<TextBlock Width="120" Margin="0,1.5" Text="洛阳蓝焰" />
<TextBlock Width="120" Margin="0,1.5" Text="TC" />
<TextBlock Width="120" Margin="0,1.5" Text="Alanshen233" />
<TextBlock Width="120" Margin="0,1.5" Text="DirtySoup" />
<TextBlock Width="120" Margin="0,1.5" Text="江南遇知音" />
<TextBlock Width="240" Margin="0,1.5" Text="目睹世界终焉的不死人" />
<TextBlock Width="120" Margin="0,1.5" Text="PG社区" />
<TextBlock Width="120" Margin="0,1.5" Text="氼乚" />
<TextBlock Width="120" Margin="0,1.5" Text="武陟永" />
<TextBlock Width="120" Margin="0,1.5" Text="关于皆非" />
<TextBlock Width="120" Margin="0,1.5" Text="FVHERFJIKL" />
<TextBlock Width="120" Margin="0,1.5" Text="happy" />
<TextBlock Width="120" Margin="0,1.5" Text="施国祥" />
<TextBlock Width="120" Margin="0,1.5" Text="神秘" />
<TextBlock Width="120" Margin="0,1.5" Text="Jerry" />
<TextBlock Width="120" Margin="0,1.5" Text="j-vns" />
<TextBlock Width="120" Margin="0,1.5" Text="飘逸非凡" />
<TextBlock Width="120" Margin="0,1.5" Text="阿飘" />
<TextBlock Width="120" Margin="0,1.5" Text="笑笑狐阿狸" />
<TextBlock Width="120" Margin="0,1.5" Text="罗教授不是歌手" />
<TextBlock Width="120" Margin="0,1.5" Text="某猫" />
<TextBlock Width="120" Margin="0,1.5" Text="YUEZHIHUAN" />
<TextBlock Width="120" Margin="0,1.5" Text="河姆渡鱼化石" />
<TextBlock Width="120" Margin="0,1.5" Text="ZeroMostia" />
<TextBlock Width="120" Margin="0,1.5" Text="枯萎的西行妖" />
<TextBlock Width="120" Margin="0,1.5" Text="Elyas" />
<TextBlock Width="120" Margin="0,1.5" Text="Boris_Vasha" />
<TextBlock Width="120" Margin="0,1.5" Text="凯" />
<TextBlock Width="240" Margin="0,1.5" Text="都是万恶的马哈鱼害的" />
<TextBlock Width="120" Margin="0,1.5" Text="阎阎" />
<TextBlock Width="120" Margin="0,1.5" Text="Laotou" />
<TextBlock Width="120" Margin="0,1.5" Text="IN" />
<TextBlock Width="120" Margin="0,1.5" Text="浪客wave" />
<TextBlock Width="120" Margin="0,1.5" Text="A.L" />
<TextBlock Width="120" Margin="0,1.5" Text="xlz" />
<TextBlock Width="120" Margin="0,1.5" Text="幻紫薰" />
<TextBlock Width="120" Margin="0,1.5" Text="落子" />
<TextBlock Width="120" Margin="0,1.5" Text="张卿予" />
<TextBlock Width="120" Margin="0,1.5" Text="无眠" />
<TextBlock Width="120" Margin="0,1.5" Text="苏瑾" />
<TextBlock Width="120" Margin="0,1.5" Text="Arthur" />
<TextBlock Width="120" Margin="0,1.5" Text="敬乎尔珍" />
<TextBlock Width="120" Margin="0,1.5" Text="御清宇" />
<TextBlock Width="120" Margin="0,1.5" Text="MJD" />
<TextBlock Width="120" Margin="0,1.5" Text="邸网管" />
<TextBlock Width="120" Margin="0,1.5" Text="chiguaba" />
<TextBlock Width="120" Margin="0,1.5" Text="清风不及君" />
<TextBlock Width="120" Margin="0,1.5" Text="万象聚今朝" />
<TextBlock Width="120" Margin="0,1.5" Text="泗木" />
<TextBlock Width="120" Margin="0,1.5" Text="正义人" />
<TextBlock HorizontalAlignment="Left" Text="以下是 2025 年 4 月的高级赞助者们!感谢各位对 PCL 和伟大的咕咕咕事业的支持!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" />
<WrapPanel Margin="0,0,0,10"> <TextBlock Width="120" Margin="0,1.5" Text="秦屎皇" />
<TextBlock Width="120" Margin="0,1.5" Text="Hyacinth" />
<TextBlock Width="120" Margin="0,1.5" Text="hjk" />
<TextBlock Width="120" Margin="0,1.5" Text="JiechuAik" />
<TextBlock Width="120" Margin="0,1.5" Text="ls" />
<TextBlock Width="120" Margin="0,1.5" Text="Alleyne" />
<TextBlock Width="120" Margin="0,1.5" Text="泠羽洛" />
<TextBlock Width="120" Margin="0,1.5" Text="user0527" />
<TextBlock Width="120" Margin="0,1.5" Text="zxgcugdyb" />
<TextBlock Width="120" Margin="0,1.5" Text="Night_Fall" />
<TextBlock Width="120" Margin="0,1.5" Text="冷酷们" />
<TextBlock Width="120" Margin="0,1.5" Text="迅卩" />
<TextBlock Width="120" Margin="0,1.5" Text="WTFdog" />
<TextBlock Width="120" Margin="0,1.5" Text="NID" />
<TextBlock Width="120" Margin="0,1.5" Text="LexSar" />
<TextBlock Width="120" Margin="0,1.5" Text="巡洋舰7179" />
<TextBlock Width="120" Margin="0,1.5" Text="不允许使用的昵称" />
<TextBlock Width="120" Margin="0,1.5" Text="DLINX" />
<TextBlock Width="120" Margin="0,1.5" Text="仄仄仄" />
<TextBlock Width="120" Margin="0,1.5" Text="abc" />
<TextBlock Width="120" Margin="0,1.5" Text="胖虎贼懒" />
<TextBlock Width="120" Margin="0,1.5" Text="次月" />
<TextBlock Width="120" Margin="0,1.5" Text="芝士绒散" />
<TextBlock Width="120" Margin="0,1.5" Text="桂月兔子" />
<TextBlock Width="120" Margin="0,1.5" Text="TT" />
<TextBlock Width="120" Margin="0,1.5" Text="Wah" />
<TextBlock Width="120" Margin="0,1.5" Text="卅载风雪满故园" />
<TextBlock Width="240" Margin="0,1.5" Text="左手肘击,右手元神" />
<TextBlock Width="120" Margin="0,1.5" Text="幸运星" />
<TextBlock Width="120" Margin="0,1.5" Text="SphereBall" />
<TextBlock Width="120" Margin="0,1.5" Text="doubi_sir" />
<TextBlock Width="120" Margin="0,1.5" Text="Tencelll" />
<TextBlock Width="120" Margin="0,1.5" Text="bigby" />
<TextBlock Width="120" Margin="0,1.5" Text="Musire" />
<TextBlock Width="120" Margin="0,1.5" Text="YouMi" />
<TextBlock Width="120" Margin="0,1.5" Text="冉棠" />
<TextBlock Width="120" Margin="0,1.5" Text="白噪音" />
<TextBlock Width="120" Margin="0,1.5" Text="恶俗狗" />
<TextBlock Width="120" Margin="0,1.5" Text="空濛是只大笨狐狸" />
<TextBlock Width="120" Margin="0,1.5" Text="KSGDBCA" />
<TextBlock Width="120" Margin="0,1.5" Text="ALYESY" />
<TextBlock Width="120" Margin="0,1.5" Text="火花狐" />
<TextBlock Width="120" Margin="0,1.5" Text="LovePGKD" />
<TextBlock Width="120" Margin="0,1.5" Text="Ls00w" />
<TextBlock Width="120" Margin="0,1.5" Text="小洋和小昊" />
<TextBlock Width="120" Margin="0,1.5" Text="五月" />
<TextBlock Width="120" Margin="0,1.5" Text="绝沓" />
<TextBlock Width="120" Margin="0,1.5" Text="辻渃" />
<TextBlock Width="120" Margin="0,1.5" Text="又想玉玉了QWQ" />
<TextBlock Width="120" Margin="0,1.5" Text="雨沫云汐" />
<TextBlock Width="120" Margin="0,1.5" Text="回青观落日" />
<TextBlock Width="120" Margin="0,1.5" Text="猫七七" />
<TextBlock Width="120" Margin="0,1.5" Text="泉东居士" />
<TextBlock Width="120" Margin="0,1.5" Text="猫猫念余年" />
<TextBlock Width="120" Margin="0,1.5" Text="yoseya" />
<TextBlock Width="120" Margin="0,1.5" Text="雨" />
<TextBlock Width="120" Margin="0,1.5" Text="MRCA_MLU" />
<TextBlock Width="120" Margin="0,1.5" Text="不要太狗血" />
<TextBlock Width="120" Margin="0,1.5" Text="zhaoesaf" />
<TextBlock Width="120" Margin="0,1.5" Text="月球领航员" />
<TextBlock Width="120" Margin="0,1.5" Text="IsolatedLam" />
<TextBlock Width="120" Margin="0,1.5" Text="1818" />
<TextBlock Width="120" Margin="0,1.5" Text="ghjklbnm144" />
<TextBlock Width="120" Margin="0,1.5" Text="Good night" />
<TextBlock Width="120" Margin="0,1.5" Text="盖着被子就跑" />
<TextBlock Width="120" Margin="0,1.5" Text="shabbyunicorn3" />
<TextBlock Width="120" Margin="0,1.5" Text="LEMON TEA" />
<TextBlock Width="120" Margin="0,1.5" Text="冰激凌天尊" />
<TextBlock Width="120" Margin="0,1.5" Text="向东114514" />
<TextBlock Width="120" Margin="0,1.5" Text="Wangderful555" />
<TextBlock Width="120" Margin="0,1.5" Text="JDS123" />
<TextBlock Width="120" Margin="0,1.5" Text="Nalyne" />
<TextBlock Width="120" Margin="0,1.5" Text="uglyduckling" />
<TextBlock Width="120" Margin="0,1.5" Text="小孩" />
<TextBlock Width="120" Margin="0,1.5" Text="长宁QAQ" />
<TextBlock Width="120" Margin="0,1.5" Text="WYXiLYH" />
<TextBlock Width="120" Margin="0,1.5" Text="蔡徐坤" />
<TextBlock Width="120" Margin="0,1.5" Text="风清_GuDER" />
<TextBlock Width="120" Margin="0,1.5" Text="nananatuki" />
<TextBlock Width="120" Margin="0,1.5" Text="绯星" />
<TextBlock Width="120" Margin="0,1.5" Text="非牛非马先生小姐" />
<TextBlock Width="120" Margin="0,1.5" Text="......" />
<TextBlock Width="120" Margin="0,1.5" Text="镜千视界" />
<TextBlock Width="120" Margin="0,1.5" Text="脆脆屑人" />
<TextBlock Width="120" Margin="0,1.5" Text="海妖" />
<TextBlock Width="120" Margin="0,1.5" Text="5418ly" />
<TextBlock Width="120" Margin="0,1.5" Text="传奇阿玮" />
<TextBlock Width="120" Margin="0,1.5" Text="Qian" />
<TextBlock Width="120" Margin="0,1.5" Text="SeaSurgeX" />
<TextBlock Width="120" Margin="0,1.5" Text="hehe" />
<TextBlock Width="120" Margin="0,1.5" Text="凌憬awa" />
<TextBlock Width="120" Margin="0,1.5" Text="我当个混子就行" />
<TextBlock Width="120" Margin="0,1.5" Text="聪聪" />
<TextBlock Width="120" Margin="0,1.5" Text="Zhea" />
<TextBlock Width="120" Margin="0,1.5" Text="The_Back-Admin" />
<TextBlock Width="120" Margin="0,1.5" Text="寒雨KanU_" />
<TextBlock Width="120" Margin="0,1.5" Text="衡阳雁去" />
<TextBlock Width="120" Margin="0,1.5" Text="空月" />
<TextBlock Width="120" Margin="0,1.5" Text="IFwikidot管理员" />
<TextBlock Width="120" Margin="0,1.5" Text="是阿改哦" />
<TextBlock Width="120" Margin="0,1.5" Text="铮难弄" />
<TextBlock Width="120" Margin="0,1.5" Text="???" />
<TextBlock Width="120" Margin="0,1.5" Text="锕礸" />
<TextBlock Width="240" Margin="0,1.5" Text="我真的事仁济啊(恼)" />
<TextBlock Width="120" Margin="0,1.5" Text="初辟鸿蒙" />
<TextBlock Width="120" Margin="0,1.5" Text="火丙知日" />
<TextBlock Width="120" Margin="0,1.5" Text="李白" />
<TextBlock Width="120" Margin="0,1.5" Text="Tian_bei" />
<TextBlock Width="120" Margin="0,1.5" Text="御风任飞" />
<TextBlock Width="120" Margin="0,1.5" Text="PurplePuffCake" />
<TextBlock Width="120" Margin="0,1.5" Text="倾天" />
<TextBlock Width="120" Margin="0,1.5" Text="柚子_grapefruit_" />
<TextBlock Width="120" Margin="0,1.5" Text="qt2000" />
<TextBlock Width="120" Margin="0,1.5" Text="玉驹素海" />
<TextBlock Width="120" Margin="0,1.5" Text="忘崽小杜" />
<TextBlock Width="120" Margin="0,1.5" Text="才毅" />
<TextBlock Width="120" Margin="0,1.5" Text="smhMCJack" />
<TextBlock Width="120" Margin="0,1.5" Text="Muyiyi" />
<TextBlock Width="120" Margin="0,1.5" Text="dingyaa1" />
<TextBlock Width="120" Margin="0,1.5" Text="菍" />
<TextBlock Width="120" Margin="0,1.5" Text="明凡HD" />
<TextBlock Width="120" Margin="0,1.5" Text="SenLin233" />
<TextBlock Width="120" Margin="0,1.5" Text="zjhf" />
<TextBlock Width="120" Margin="0,1.5" Text="末影花生" />
<TextBlock Width="120" Margin="0,1.5" Text="shui素大青花" />
<TextBlock Width="120" Margin="0,1.5" Text="凌梦_dream" />
<TextBlock Width="120" Margin="0,1.5" Text="O.W.B." />
<TextBlock Width="120" Margin="0,1.5" Text="走过的四季" />
<TextBlock Width="120" Margin="0,1.5" Text="风羽" />
<TextBlock Width="120" Margin="0,1.5" Text="梧筱墨" />
<TextBlock Width="120" Margin="0,1.5" Text="StarSky" />
<TextBlock Width="120" Margin="0,1.5" Text="乌罗布罗斯" />
<TextBlock Width="120" Margin="0,1.5" Text="Kinllia" />
<TextBlock Width="120" Margin="0,1.5" Text="梦醒皆是虚无" />
<TextBlock Width="120" Margin="0,1.5" Text="ZmdNotFound" />
<TextBlock Width="120" Margin="0,1.5" Text="防水抹布" />
<TextBlock Width="120" Margin="0,1.5" Text="BBK" />
<TextBlock Width="120" Margin="0,1.5" Text="白璃是你姐姐呀" />
<TextBlock Width="120" Margin="0,1.5" Text="天之海" />
<TextBlock Width="120" Margin="0,1.5" Text="花落影" />
<TextBlock Width="120" Margin="0,1.5" Text="小渣渣" />
<TextBlock Width="120" Margin="0,1.5" Text="djhwshm" />
<TextBlock Width="120" Margin="0,1.5" Text="Sola18" />
<TextBlock Width="120" Margin="0,1.5" Text="漆黑" />
<TextBlock Width="120" Margin="0,1.5" Text="jian_ke" />
<TextBlock Width="120" Margin="0,1.5" Text="MaTTer" />
<TextBlock Width="120" Margin="0,1.5" Text="grizzly" />
<TextBlock Width="120" Margin="0,1.5" Text="樱井落花" />
<TextBlock Width="120" Margin="0,1.5" Text="那个谁" />
<TextBlock Width="120" Margin="0,1.5" Text="Hiang224855" />
<TextBlock Width="120" Margin="0,1.5" Text="Mingze Du" />
<TextBlock Width="120" Margin="0,1.5" Text="yuuio" />
<TextBlock Width="120" Margin="0,1.5" Text="Flowing_Shadow" />
<TextBlock Width="120" Margin="0,1.5" Text="buluo" />
<TextBlock Width="120" Margin="0,1.5" Text="Gannet09" />
<TextBlock Width="120" Margin="0,1.5" Text="惠子呀惠子" />
<TextBlock Width="120" Margin="0,1.5" Text="PMapleLP" />
<TextBlock Width="120" Margin="0,1.5" Text="p_p" />
<TextBlock Width="120" Margin="0,1.5" Text="冉皓Kamiya" />
<TextBlock Width="120" Margin="0,1.5" Text="陈陈陈陈最" />
<TextBlock Width="120" Margin="0,1.5" Text="纳兰叶秋" />
<TextBlock Width="120" Margin="0,1.5" Text="++0" />
<TextBlock Width="120" Margin="0,1.5" Text="Duskbean" />
<TextBlock Width="120" Margin="0,1.5" Text="mc_宣羽" />
<TextBlock Width="120" Margin="0,1.5" Text="八两大西瓜" />
<TextBlock Width="120" Margin="0,1.5" Text="Madam企鹅" />
<TextBlock Width="120" Margin="0,1.5" Text="PMm" />
<TextBlock Width="120" Margin="0,1.5" Text="无敌钢筋大玉" />
<TextBlock Width="120" Margin="0,1.5" Text="诸葛千绝" />
<TextBlock Width="120" Margin="0,1.5" Text="风华一指流砂" />
<TextBlock Width="120" Margin="0,1.5" Text="小阿君" />
<TextBlock Width="120" Margin="0,1.5" Text="桃乐志" />
<TextBlock Width="240" Margin="0,1.5" Text="把你switch借我玩玩" />
<TextBlock Width="120" Margin="0,1.5" Text="林宇" />
<TextBlock Width="120" Margin="0,1.5" Text="星辰星空" />
<TextBlock Width="120" Margin="0,1.5" Text="幽寂" />
<TextBlock Width="120" Margin="0,1.5" Text="BasaltSlrtean" />
<TextBlock Width="120" Margin="0,1.5" Text="智子10086号" />
<TextBlock Width="120" Margin="0,1.5" Text="op" />
<TextBlock Width="120" Margin="0,1.5" Text="seasonlog" />
<TextBlock Width="120" Margin="0,1.5" Text="guxuyuming" />
<TextBlock Width="120" Margin="0,1.5" Text="Marshmallow" />
<TextBlock Width="120" Margin="0,1.5" Text="孤单" />
<TextBlock Width="120" Margin="0,1.5" Text="甘李子" />
<TextBlock Width="120" Margin="0,1.5" Text="xaslat-渊" />
<TextBlock Width="120" Margin="0,1.5" Text="Sweecol" />
<TextBlock Width="120" Margin="0,1.5" Text="木瓜牛奶布丁" />
<TextBlock Width="120" Margin="0,1.5" Text="午夜里的猫爱睡觉" />
<TextBlock Width="120" Margin="0,1.5" Text="超级番薯Pro" />
<TextBlock Width="120" Margin="0,1.5" Text="宝盖木" />
<TextBlock Width="120" Margin="0,1.5" Text="守着那个它" />
<TextBlock Width="120" Margin="0,1.5" Text="橙子dc" />
<TextBlock Width="120" Margin="0,1.5" Text="FY_dusty" />
<TextBlock Width="120" Margin="0,1.5" Text="Mr." />
<TextBlock Width="120" Margin="0,1.5" Text="星辰" />
<TextBlock Width="120" Margin="0,1.5" Text="ko8888ko" />
<TextBlock Width="120" Margin="0,1.5" Text="Rutriste" />
<TextBlock Width="120" Margin="0,1.5" Text="坐轮椅的猫师傅" />
<TextBlock Width="120" Margin="0,1.5" Text="洛圣都劲夫" />
<TextBlock Width="120" Margin="0,1.5" Text="hyh" />
<TextBlock Width="120" Margin="0,1.5" Text="无刃幻越" />
<TextBlock Width="120" Margin="0,1.5" Text="JRgril" />
<TextBlock Width="120" Margin="0,1.5" Text="西宫硝子" />
<TextBlock Width="120" Margin="0,1.5" Text="Loneliness" />
<TextBlock Width="120" Margin="0,1.5" Text="青青草" />
<TextBlock Width="120" Margin="0,1.5" Text="童璃" />
<TextBlock Width="120" Margin="0,1.5" Text="北极光" />
<TextBlock Width="120" Margin="0,1.5" Text="玲妹儿" />
<TextBlock Width="120" Margin="0,1.5" Text="SuLiHuaSong" />
<TextBlock Width="120" Margin="0,1.5" Text="多米" />
<TextBlock Width="120" Margin="0,1.5" Text="PigTheCreeper" />
<TextBlock Width="120" Margin="0,1.5" Text="Finext652" />
<TextBlock Width="120" Margin="0,1.5" Text="秋禾_Hikari" />
<TextBlock Width="120" Margin="0,1.5" Text="steven" />
<TextBlock Width="120" Margin="0,1.5" Text="akergo" />
<TextBlock Width="120" Margin="0,1.5" Text="锦菌" />
<TextBlock Width="120" Margin="0,1.5" Text="阿銓" />
<TextBlock Width="120" Margin="0,1.5" Text="茉莉花茶少糖" />
<TextBlock Width="120" Margin="0,1.5" Text="凯" />
<TextBlock Width="240" Margin="0,1.5" Text="广寒宫中金蟾炖兔子" />
<TextBlock Width="120" Margin="0,1.5" Text="BUBU" />
<TextBlock Width="120" Margin="0,1.5" Text="yzt" />
<TextBlock Width="120" Margin="0,1.5" Text="Eyedazzler" />
<TextBlock Width="120" Margin="0,1.5" Text="空白" />
<TextBlock Width="120" Margin="0,1.5" Text="薛十一" />
<TextBlock Width="120" Margin="0,1.5" Text="胡克霍霍" />
<TextBlock Width="120" Margin="0,1.5" Text="S1767" />
<TextBlock Width="120" Margin="0,1.5" Text="沐雪于梦" />
<TextBlock Width="120" Margin="0,1.5" Text="门一多" />
<TextBlock Width="120" Margin="0,1.5" Text="dy2022" />
<TextBlock Width="120" Margin="0,1.5" Text="幽谷响" />
<TextBlock Width="120" Margin="0,1.5" Text="我的世界" />
<TextBlock Width="120" Margin="0,1.5" Text="Bobsteve" />
<TextBlock Width="120" Margin="0,1.5" Text="EthanCAi" />
<TextBlock Width="120" Margin="0,1.5" Text="老鼠大" />
<TextBlock Width="120" Margin="0,1.5" Text="公孙月" />
<TextBlock Width="120" Margin="0,1.5" Text="nayo" />
<TextBlock Width="120" Margin="0,1.5" Text="白夜与黑昼" />
<TextBlock Width="120" Margin="0,1.5" Text="J-10" />
<TextBlock Width="120" Margin="0,1.5" Text="jade_lin" />
<TextBlock Width="120" Margin="0,1.5" Text="马不露肉" />
<TextBlock Width="120" Margin="0,1.5" Text="PANDA" />
<TextBlock Width="120" Margin="0,1.5" Text="子夜" />
<TextBlock Width="120" Margin="0,1.5" Text="墨霜二十一" />
<TextBlock Width="120" Margin="0,1.5" Text="August" />
<TextBlock Width="120" Margin="0,1.5" Text="CarrotMan_CD" />
<TextBlock Width="120" Margin="0,1.5" Text="yuguya" />
<TextBlock Width="120" Margin="0,1.5" Text="瞳鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="小妤情绪零碎" />
<TextBlock Width="120" Margin="0,1.5" Text="777" />
<TextBlock Width="120" Margin="0,1.5" Text="林海珠" />
<TextBlock Width="120" Margin="0,1.5" Text="Mikey" />
<TextBlock Width="120" Margin="0,1.5" Text="君莫笑" />
<TextBlock Width="120" Margin="0,1.5" Text="梦璃素弦" />
<TextBlock Width="120" Margin="0,1.5" Text="一只果粒" />
<TextBlock Width="120" Margin="0,1.5" Text="我裂开啊" />
<TextBlock Width="120" Margin="0,1.5" Text="半个景煦子" />
<TextBlock Width="120" Margin="0,1.5" Text="售票员发通报??" />
<TextBlock Width="120" Margin="0,1.5" Text="蓝莓呢" />
<TextBlock Width="120" Margin="0,1.5" Text="Golfl." />
<TextBlock Width="120" Margin="0,1.5" Text="彧隳" />
<TextBlock Width="120" Margin="0,1.5" Text="吃灰的浅影" />
<TextBlock Width="120" Margin="0,1.5" Text="222" />
<TextBlock Width="120" Margin="0,1.5" Text="雅书" />
<TextBlock Width="120" Margin="0,1.5" Text="成长中的羽翼" />
<TextBlock Width="120" Margin="0,1.5" Text="伊仔今天也很非" />
<TextBlock Width="120" Margin="0,1.5" Text="DARTS_STUDIOS." />
<TextBlock Width="120" Margin="0,1.5" Text="。" />
<TextBlock Width="120" Margin="0,1.5" Text="redblock" />
<TextBlock Width="120" Margin="0,1.5" Text="白上林" />
<TextBlock Width="120" Margin="0,1.5" Text="炒面炒面林" />
<TextBlock Width="120" Margin="0,1.5" Text=": D" />
<TextBlock Width="120" Margin="0,1.5" Text="聆世音" />
<TextBlock Width="120" Margin="0,1.5" Text="量籽嘉素" />
<TextBlock Width="120" Margin="0,1.5" Text="Watanuki" />
<TextBlock Width="120" Margin="0,1.5" Text="HUGO37211" />
<TextBlock Width="120" Margin="0,1.5" Text="忍小建" />
<TextBlock Width="120" Margin="0,1.5" Text="朝夕" />
<TextBlock Width="120" Margin="0,1.5" Text="lazier" />
<TextBlock Width="120" Margin="0,1.5" Text="忧化中" />
<TextBlock Width="120" Margin="0,1.5" Text="子八年" />
<TextBlock Width="240" Margin="0,1.5" Text="A decadent person" />
<TextBlock Width="120" Margin="0,1.5" Text="Rrzttc" />
<TextBlock Width="120" Margin="0,1.5" Text="FancyBitz" />
<TextBlock Width="120" Margin="0,1.5" Text="chihaya anon" />
<TextBlock Width="120" Margin="0,1.5" Text="Mc__XiaoYao" />
<TextBlock Width="120" Margin="0,1.5" Text="诺伊" />
<TextBlock Width="120" Margin="0,1.5" Text="小生饭盒" />
<TextBlock Width="120" Margin="0,1.5" Text="伊之心" />
<TextBlock Width="120" Margin="0,1.5" Text="Kelvin_0" />
<TextBlock Width="120" Margin="0,1.5" Text="林小鸭" />
<TextBlock Width="120" Margin="0,1.5" Text="松鼠" />
<TextBlock Width="120" Margin="0,1.5" Text="亦似花落亦如霞" />
<TextBlock Width="120" Margin="0,1.5" Text="掺了牛奶的水" />
<TextBlock Width="120" Margin="0,1.5" Text="河里的螃蟹" />
<TextBlock Width="120" Margin="0,1.5" Text="BesidU" />
<TextBlock Width="120" Margin="0,1.5" Text="抛抛不是泡泡" />
<TextBlock Width="120" Margin="0,1.5" Text="WJMAS" />
<TextBlock Width="120" Margin="0,1.5" Text="18858019934" />
<TextBlock Width="120" Margin="0,1.5" Text="钩子Goou_Zi" />
<TextBlock Width="120" Margin="0,1.5" Text="开心快乐每一天" />
<TextBlock Width="120" Margin="0,1.5" Text="财阀" />
<TextBlock Width="120" Margin="0,1.5" Text="小小小柴" />
<TextBlock Width="120" Margin="0,1.5" Text="晓游明" />
<TextBlock Width="120" Margin="0,1.5" Text="吃不饱的小云云" />
<TextBlock Width="120" Margin="0,1.5" Text="RandomQAQ" />
<TextBlock Width="120" Margin="0,1.5" Text="Ahhhh" />
<TextBlock Width="120" Margin="0,1.5" Text="dingwenbo" />
<TextBlock Width="120" Margin="0,1.5" Text="逆行若羽" />
<TextBlock Width="120" Margin="0,1.5" Text="Cloud5321" />
<TextBlock Width="120" Margin="0,1.5" Text="ETERNALpause" />
<TextBlock Width="120" Margin="0,1.5" Text="小怕" />
<TextBlock Width="240" Margin="0,1.5" Text="mycraftgod2014111" />
<TextBlock Width="120" Margin="0,1.5" Text="xueling" />
<TextBlock Width="120" Margin="0,1.5" Text="拉的一坨" />
<TextBlock Width="120" Margin="0,1.5" Text="典急蚌孝豹" />
<TextBlock Width="120" Margin="0,1.5" Text="MENGXI_梦惜" />
<TextBlock Width="120" Margin="0,1.5" Text="baicai1339" />
<TextBlock Width="120" Margin="0,1.5" Text="xvp1563" />
<TextBlock Width="120" Margin="0,1.5" Text="库洛米" />
<TextBlock Width="120" Margin="0,1.5" Text="空心清风" />
<TextBlock Width="120" Margin="0,1.5" Text="素年锦时" />
<TextBlock Width="120" Margin="0,1.5" Text="浅色" />
<TextBlock Width="120" Margin="0,1.5" Text="绪方田月" />
<TextBlock Width="120" Margin="0,1.5" Text="bootspuss" />
<TextBlock Width="120" Margin="0,1.5" Text="万万大喜" />
<TextBlock Width="120" Margin="0,1.5" Text="FORxiaomo" />
<TextBlock Width="120" Margin="0,1.5" Text="躺床上发霉" />
<TextBlock Width="240" Margin="0,1.5" Text="wuuuuuuuuuuud" />
<TextBlock Width="120" Margin="0,1.5" Text="xinyue_game" />
<TextBlock Width="120" Margin="0,1.5" Text="天灵雪" />
<TextBlock Width="120" Margin="0,1.5" Text="笙默语℡" />
<TextBlock Width="120" Margin="0,1.5" Text="QQGG" />
<TextBlock Width="120" Margin="0,1.5" Text="暮色极夜" />
<TextBlock Width="120" Margin="0,1.5" Text="陆舫" />
<TextBlock Width="120" Margin="0,1.5" Text="以炙面包" />
<TextBlock Width="120" Margin="0,1.5" Text="Craig" />
<TextBlock Width="120" Margin="0,1.5" Text="Hamider" />
<TextBlock Width="120" Margin="0,1.5" Text="狂仙儿" />
<TextBlock Width="120" Margin="0,1.5" Text="ggg" />
<TextBlock Width="120" Margin="0,1.5" Text="原色龙" />
<TextBlock Width="120" Margin="0,1.5" Text="江黎洛" />
<TextBlock Width="120" Margin="0,1.5" Text="大花曼陀罗" />
<TextBlock Width="120" Margin="0,1.5" Text="弎十五" />
<TextBlock Width="120" Margin="0,1.5" Text="肆意" />
<TextBlock Width="120" Margin="0,1.5" Text="phoximity" />
<TextBlock Width="120" Margin="0,1.5" Text="Saga_Xuan" />
<TextBlock Width="120" Margin="0,1.5" Text="噜啦啦啦" />
<TextBlock Width="120" Margin="0,1.5" Text="cicada" />
<TextBlock Width="120" Margin="0,1.5" Text="星索" />
<TextBlock Width="120" Margin="0,1.5" Text="泠LINg" />
</WrapPanel>
<Grid Height="35">
<Grid.ColumnDefinitions>
@@ -7,7 +7,7 @@
PanBack.ScrollToHome()
'非重复加载部分
If IsLoaded Then Exit Sub
If IsLoaded Then Return
IsLoaded = True
ItemAboutPcl.Info = ItemAboutPcl.Info.Replace("%VERSION%", VersionDisplayName).Replace("%VERSIONCODE%", VersionCode).Replace("%BRANCH%", VersionBranchCode)
@@ -14,17 +14,20 @@
''' 根据特定帮助项初始化页面 UI,返回是否成功加载。
''' </summary>
Public Function Init(Entry As HelpEntry) As Boolean
Dim FileContent = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & If(Entry.XamlContent, "") & "</StackPanel>"
Dim Content = If(Entry.XamlContent, "")
If Content = "" Then Throw New Exception("帮助 xaml 文件为空")
Try
If String.IsNullOrEmpty(Entry.XamlContent) Then Throw New Exception("帮助 xaml 文件为空")
'修改时应同时修改 PageLaunchRight.LoadContent
Content = HelpArgumentReplace(Content)
If Content.Contains("xmlns") Then Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Me.Entry = Entry
PanCustom.Children.Clear()
FileContent = HelpArgumentReplace(FileContent)
PanCustom.Children.Add(GetObjectFromXML(FileContent))
PanCustom.Children.Add(GetObjectFromXML(Content))
Return True
Catch ex As Exception
Log("[System] 自定义信息内容:" & vbCrLf & FileContent)
Log(ex, "加载帮助 xaml 文件失败", LogLevel.Msgbox)
Log("[System] 自定义信息内容:" & vbCrLf & Content)
Log(ex, "加载帮助 XAML 文件失败", LogLevel.Msgbox)
Return False
End Try
End Function
@@ -10,12 +10,12 @@
If ItemTest.Checked AndAlso Setup.Get("UiHiddenOtherTest") Then IsHiddenPage = True
If PageSetupUI.HiddenForceShow Then IsHiddenPage = False
'若页面错误,或尚未加载,则继续
If IsLoad AndAlso Not IsHiddenPage Then Exit Sub
If IsLoad AndAlso Not IsHiddenPage Then Return
IsLoad = True
'刷新子页面隐藏情况
PageSetupUI.HiddenRefresh()
'选择第一个未被禁用的子页面
If IsPageSwitched Then Exit Sub
If IsPageSwitched Then Return
If Not Setup.Get("UiHiddenOtherHelp") Then
ItemHelp.SetChecked(True, False, False)
ElseIf Not Setup.Get("UiHiddenOtherAbout") Then
@@ -76,7 +76,7 @@
''' 切换现有页面。
''' </summary>
Public Sub PageChange(ID As FormMain.PageSubType)
If PageID = ID Then Exit Sub
If PageID = ID Then Return
AniControlEnabled += 1
IsPageSwitched = True
Try
@@ -126,13 +126,13 @@
'打开网页
Private Sub TryFeedback(sender As Object, e As RouteEventArgs) Handles ItemFeedback.Changed
If Not ItemFeedback.Checked Then Exit Sub
If Not ItemFeedback.Checked Then Return
TryFeedback()
e.Handled = True
End Sub
Public Shared Sub TryFeedback()
If Not CanFeedback(True) Then Exit Sub
Select Case MyMsgBox("在提交新反馈前,建议先搜索反馈列表,以避免重复提交。" & vbCrLf & "如果无法打开该网页,请尝试使用加速器或 VPN。",
If Not CanFeedback(True) Then Return
Select Case MyMsgBox("在提交新反馈前,建议先搜索反馈列表,以避免重复提交。" & vbCrLf & "如果无法打开该网页,请使用 VPN 以改善网络环境。",
"反馈", "提交新反馈", "查看反馈列表", "取消")
Case 1
Feedback(True, False)
@@ -141,13 +141,13 @@
End Select
End Sub
Private Sub TryVote(sender As Object, e As RouteEventArgs) Handles ItemVote.Changed
If Not ItemVote.Checked Then Exit Sub
If Not ItemVote.Checked Then Return
TryVote()
e.Handled = True
End Sub
Public Shared Sub TryVote()
If MyMsgBox("是否要打开新功能投票网页?" & vbCrLf & "如果无法打开该网页,请尝试使用加速器或 VPN。",
"新功能投票", "打开", "取消") = 2 Then Exit Sub
If MyMsgBox("是否要打开新功能投票网页?" & vbCrLf & "如果无法打开该网页,请使用 VPN 以改善网络环境。",
"新功能投票", "打开", "取消") = 2 Then Return
OpenWebsite("https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8?discussions_q=category%3A%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8+sort%3Adate_created")
End Sub
@@ -21,7 +21,7 @@
Exit For
End If
Next
If IsEqual Then Exit Sub
If IsEqual Then Return
End If
McFolderListLast = McFolderList
@@ -127,7 +127,7 @@
For i = 0 To McFolderList.Count - 1
If McFolderList(i).Path = PathMcFolder Then
CType(FrmSelectLeft.PanList.Children(i + 1), MyListItem).Checked = True '去掉第一个标题
Exit Sub
Return
End If
Next
If Not McFolderList.Any() Then
@@ -151,20 +151,20 @@
'检查是否有下载任务
If HasDownloadingTask() Then
Hint("在下载任务进行时,无法添加游戏文件夹!", HintType.Critical)
Exit Sub
Return
End If
Try
'获取输入
NewFolder = SelectFolder()
If NewFolder = "" Then Exit Sub
If NewFolder.Contains("!") OrElse NewFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Exit Sub
If NewFolder = "" Then Return
If NewFolder.Contains("!") OrElse NewFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Return
'要求输入显示名称
Dim SplitedNames As String() = NewFolder.TrimEnd("\").Split("\")
Dim DefaultName As String = If(SplitedNames.Last = ".minecraft", If(SplitedNames.Count >= 3, SplitedNames(SplitedNames.Count - 2), ""), SplitedNames.Last)
If DefaultName.Length > 40 Then DefaultName = DefaultName.Substring(0, 39)
Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", DefaultName,
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
If String.IsNullOrWhiteSpace(NewName) Then Exit Sub
If String.IsNullOrWhiteSpace(NewName) Then Return
'添加文件夹
AddFolder(NewFolder, NewName, True)
Catch ex As Exception
@@ -183,7 +183,7 @@
If Not CheckPermission(FolderPath) Then
If ShowHint Then
Hint("添加文件夹失败:PCL 没有访问该文件夹的权限!", HintType.Critical)
Exit Sub
Return
Else
Throw New Exception("PCL 没有访问文件夹的权限:" & FolderPath)
End If
@@ -208,7 +208,7 @@
IsAdded = True
If Folder.Split(">")(0) = DisplayName Then
If ShowHint Then Hint("此文件夹已在列表中!", HintType.Info)
Exit Sub
Return
Else
Folders(i) = DisplayName & ">" & FolderPath
IsReplace = True
@@ -225,15 +225,15 @@
Setup.Set("LaunchFolderSelect", FolderPath.Replace(Path, "$"))
McFolderListLoader.Start(IsForceRestart:=True)
'提示
If IsReplace Then Exit Sub
If IsReplace Then Return
If ShowHint Then Hint("文件夹 " & DisplayName & " 已添加!", HintType.Finish)
'检查是否为根目录整合包,自动关闭版本隔离
'1. 根目录中存在数个 Mod
Dim ModFolder As New DirectoryInfo(FolderPath & "mods\")
If Not (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count >= 3) Then Exit Sub
If Not (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count >= 3) Then Return
'2. 版本数较少,可能为整合包
Dim VersionFolder As New DirectoryInfo(FolderPath & "versions\")
If Not (VersionFolder.Exists AndAlso VersionFolder.EnumerateDirectories.Count <= 3) Then Exit Sub
If Not (VersionFolder.Exists AndAlso VersionFolder.EnumerateDirectories.Count <= 3) Then Return
'3. 能够找到可安装 Mod 的版本
For Each VersionPath In VersionFolder.EnumerateDirectories
Dim Version As New McVersion(VersionPath.FullName)
@@ -241,7 +241,7 @@
If Not Version.Modable Then Continue For
'4. 该版本的隔离文件夹下不存在 mods
Dim ModIndieFolder As New DirectoryInfo(Version.Path & "mods\")
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Exit Sub
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Return
'满足以上全部条件则视为根目录整合包
Setup.Set("VersionArgumentIndie", 2, Version:=Version)
Setup.Set("VersionArgumentIndieV2", False, Version:=Version)
@@ -258,7 +258,7 @@
'检查是否有下载任务
If HasDownloadingTask() Then
Hint("在下载任务进行时,无法创建游戏文件夹!", HintType.Critical)
Exit Sub
Return
End If
If Not Directory.Exists(Path & ".minecraft\") Then
Directory.CreateDirectory(Path & ".minecraft\")
@@ -290,7 +290,7 @@
'不删除
Case 3
'取消
Exit Sub
Return
End Select
End If
'若修改了本部分代码,应对应修改 Delete_Click 中的代码
@@ -317,8 +317,8 @@
Public Sub Delete_Click(sender As Object, e As RoutedEventArgs)
Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
Dim DeleteText As String = If((Folder.Type = McFolderType.Original OrElse Folder.Type = McFolderType.RenamedOriginal) AndAlso Folder.Path = Path & ".minecraft\" AndAlso McFolderList.Count = 1, "清空", "删除")
If MyMsgBox("你确定要" & DeleteText & "这个文件夹吗?" & vbCrLf & "目标文件夹:" & Folder.Path & vbCrLf & vbCrLf & "这会导致该文件夹中的所有存档与其他文件永久丢失,且不可恢复!", "删除警告", "取消", "确认", "取消") <> 2 Then Exit Sub
If MyMsgBox("如果你在该文件夹中存放了除 MC 以外的其他文件,这些文件也会被一同删除!" & vbCrLf & "继续删除会导致该文件夹中的所有文件永久丢失,请在仔细确认后再继续!" & vbCrLf & "目标文件夹:" & Folder.Path & vbCrLf & vbCrLf & "这是最后一次警告!", "删除警告", "确认" & DeleteText, "取消", IsWarn:=True) <> 1 Then Exit Sub
If MyMsgBox("你确定要" & DeleteText & "这个文件夹吗?" & vbCrLf & "目标文件夹:" & Folder.Path & vbCrLf & vbCrLf & "这会导致该文件夹中的所有存档与其他文件永久丢失,且不可恢复!", "删除警告", "取消", "确认", "取消") <> 2 Then Return
If MyMsgBox("如果你在该文件夹中存放了除 MC 以外的其他文件,这些文件也会被一同删除!" & vbCrLf & "继续删除会导致该文件夹中的所有文件永久丢失,请在仔细确认后再继续!" & vbCrLf & "目标文件夹:" & Folder.Path & vbCrLf & vbCrLf & "这是最后一次警告!", "删除警告", "确认" & DeleteText, "取消", IsWarn:=True) <> 1 Then Return
'移出列表
If Folder.Type = McFolderType.Custom Then
Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|"))
@@ -369,7 +369,7 @@
Dim NewName As String =
MyMsgBoxInput("输入新名称", "", Folder.Name,
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
If String.IsNullOrWhiteSpace(NewName) Then Exit Sub
If String.IsNullOrWhiteSpace(NewName) Then Return
'修改自定义名
Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|"))
Dim IsAdded As Boolean = False
@@ -380,7 +380,7 @@
IsAdded = True
If FolderCurrent.Split(">")(0) = NewName Then
'名称未修改
Exit Sub
Return
Else
Folders(i) = NewName & ">" & Folder.Path
End If
@@ -400,12 +400,12 @@
'点击选项
Public Sub Folder_Change(sender As MyListItem, e As RouteEventArgs)
If Not e.RaiseByMouse OrElse Not sender.Checked Then Exit Sub
If Not e.RaiseByMouse OrElse Not sender.Checked Then Return
'检查是否有下载任务
If HasDownloadingTask(True) Then
Hint("在下载任务进行时,无法切换游戏文件夹!", HintType.Critical)
e.Handled = True
Exit Sub
Return
End If
'更换
Setup.Set("LaunchFolderSelect", CType(sender.Tag, McFolder).Path.Replace(Path, "$"))
@@ -221,6 +221,7 @@
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""),
"版本删除确认", , "取消",, True)
Case 1
IniClearCache(Version.PathIndie & "options.txt")
IniClearCache(Version.Path & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(Version.Path)
@@ -230,7 +231,7 @@
Hint("版本 " & Version.Name & " 已删除到回收站!", HintType.Finish)
End If
Case 2
Exit Sub
Return
End Select
'从 UI 中移除
If Version.DisplayType = McVersionCardType.Hidden OrElse Not Version.IsStar Then
@@ -21,6 +21,7 @@
{"HintClearRubbish", New SetupEntry(0, Source:=SetupSource.Registry)},
{"HintUpdateMod", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintCustomCommand", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintCustomWarn", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintMoreAdvancedSetup", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintIndieSetup", New SetupEntry(False, Source:=SetupSource.Registry)},
{"HintExportConfig", New SetupEntry(False, Source:=SetupSource.Registry)},
@@ -100,7 +101,7 @@
{"LaunchArgumentWindowHeight", New SetupEntry(480)},
{"LaunchArgumentWindowType", New SetupEntry(1)},
{"LaunchArgumentRam", New SetupEntry(False, Source:=SetupSource.Registry)},
{"LaunchAdvanceJvm", New SetupEntry("-Dfile.encoding=UTF-8 -Dstdout.encoding=UTF-8 -Dstderr.encoding=UTF-8 -XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Djdk.lang.Process.allowAmbiguousCommands=true -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true")},
{"LaunchAdvanceJvm", New SetupEntry("-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Djdk.lang.Process.allowAmbiguousCommands=true -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true")},
{"LaunchAdvanceGame", New SetupEntry("")},
{"LaunchAdvanceRun", New SetupEntry("")},
{"LaunchAdvanceRunWait", New SetupEntry(True)},
@@ -117,7 +118,8 @@
{"ToolHelpChinese", New SetupEntry(True, Source:=SetupSource.Registry)},
{"ToolDownloadThread", New SetupEntry(63, Source:=SetupSource.Registry)},
{"ToolDownloadSpeed", New SetupEntry(42, Source:=SetupSource.Registry)},
{"ToolDownloadVersion", New SetupEntry(0, Source:=SetupSource.Registry)},
{"ToolDownloadSource", New SetupEntry(1, Source:=SetupSource.Registry)},
{"ToolDownloadVersion", New SetupEntry(1, Source:=SetupSource.Registry)},
{"ToolDownloadTranslate", New SetupEntry(0, Source:=SetupSource.Registry)},
{"ToolDownloadTranslateV2", New SetupEntry(1, Source:=SetupSource.Registry)},
{"ToolDownloadIgnoreQuilt", New SetupEntry(True, Source:=SetupSource.Registry)},
@@ -244,7 +246,7 @@
Value = CTypeDynamic(Value, E.Type)
If E.State = 2 Then
'如果已应用,且值相同,则无需再次更改
If E.Value = Value AndAlso Not ForceReload Then Exit Sub
If E.Value = Value AndAlso Not ForceReload Then Return
Else
'如果未应用,则直接更改并应用
If E.Source <> SetupSource.Version Then E.State = 2
@@ -361,7 +363,7 @@
''' </summary>
Private Sub Read(Key As String, ByRef E As SetupEntry, Version As McVersion)
Try
If Not E.State = 0 Then Exit Sub
If Not E.State = 0 Then Return
Dim SourceValue As String = Nothing '先用 String 储存,避免类型转换
Select Case E.Source
Case SetupSource.Normal
@@ -421,7 +423,7 @@
'游戏内存
Public Sub LaunchRamType(Type As Integer)
If FrmSetupLaunch Is Nothing Then Exit Sub
If FrmSetupLaunch Is Nothing Then Return
FrmSetupLaunch.RamType(Type)
End Sub
@@ -492,11 +494,9 @@
Public Sub UiLauncherTransparent(Value As Integer)
FrmMain.Opacity = Value / 1000 + 0.4
End Sub
#If Not BETA Then
Public Sub UiLauncherTheme(Value As Integer)
ThemeRefresh(Value)
End Sub
#End If
Public Sub UiBackgroundColorful(Value As Boolean)
ThemeRefresh()
End Sub
@@ -514,7 +514,7 @@
FrmMain.ImgBack.Margin = New Thickness(-(Value + 1) / 1.8)
End Sub
Public Sub UiBackgroundSuit(Value As Integer)
If IsNothing(FrmMain.ImgBack.Background) Then Exit Sub
If IsNothing(FrmMain.ImgBack.Background) Then Return
Dim Width As Double = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Width
Dim Height As Double = CType(FrmMain.ImgBack.Background, ImageBrush).ImageSource.Height
If Value = 0 Then
@@ -585,18 +585,20 @@
'主页
Public Sub UiCustomType(Value As Integer)
If FrmSetupUI Is Nothing Then Exit Sub
If FrmSetupUI Is Nothing Then Return
Select Case Value
Case 0 '无
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustomWarn.Visibility = Visibility.Collapsed
Case 1 '本地
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Visible
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Setup.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从 PCL 文件夹下的 Custom.xaml 读取主页内容。{vbCrLf}你可以手动编辑该文件,向主页添加文本、图片、常用网站、快捷启动等功能。"
FrmSetupUI.HintCustom.EventType = ""
FrmSetupUI.HintCustom.EventData = ""
@@ -605,6 +607,7 @@
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Visible
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Setup.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从指定网址联网获取主页内容。服主也可以用于动态更新服务器公告。{vbCrLf}如果你制作了稳定运行的联网主页,可以点击这条提示投稿,若合格即可加入预设!"
FrmSetupUI.HintCustom.EventType = "打开网页"
FrmSetupUI.HintCustom.EventData = "https://github.com/Hex-Dragon/PCL2/discussions/2528"
@@ -613,6 +616,7 @@
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustomWarn.Visibility = Visibility.Collapsed
End Select
FrmSetupUI.CardCustom.TriggerForceResize()
End Sub
@@ -743,16 +747,16 @@
'游戏内存
Public Sub VersionRamType(Type As Integer)
If FrmVersionSetup Is Nothing Then Exit Sub
If FrmVersionSetup Is Nothing Then Return
FrmVersionSetup.RamType(Type)
End Sub
'服务器
Public Sub VersionServerLogin(Type As Integer)
If FrmVersionSetup Is Nothing Then Exit Sub
If FrmVersionSetup Is Nothing Then Return
'为第三方登录清空缓存以更新描述
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "")
If PageVersionLeft.Version Is Nothing Then Exit Sub
If PageVersionLeft.Version Is Nothing Then Return
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load()
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub
@@ -118,7 +118,7 @@
</local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="游戏内存">
<StackPanel Margin="25,40,25,15">
<local:MyHint x:Name="LabRamWarn" Text="32 位 Java 最多只能分配 1 GB 内存,建议安装 64 位 Java!" IsWarn="True" Margin="0,0,0,12" />
<local:MyHint x:Name="LabRamWarn" Visibility="Visible" Text="32 位 Java 只能分配最多 1 GB 的内存。强烈建议换用 64 位的 Java!" Theme="Yellow" Margin="0,0,0,12" />
<Grid Margin="0,0,0,3">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
@@ -173,7 +173,7 @@
</local:MyCard>
<local:MyCard x:Name="CardSkin" Margin="0,0,0,15" Title="离线皮肤" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,25,15">
<local:MyHint Text="由于技术问题,此功能只保证对 1.19.2 以前的版本有效!" IsWarn="True" Margin="0,0,0,10" />
<local:MyHint Text="由于技术问题,此功能只保证对 1.19.2 以前的版本有效!" Theme="Yellow" Margin="0,0,0,10" />
<Grid Margin="-1,0,0,0">
<Grid.ColumnDefinitions>
<ColumnDefinition />
@@ -226,37 +226,37 @@
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
<RowDefinition Height="Auto" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<local:MyHint Text="你可以在版本独立设置中找到更多高级启动选项。" Margin="0,2,0,12" IsWarn="False" Grid.ColumnSpan="2"
CanClose="True" RelativeSetup="HintMoreAdvancedSetup" />
<StackPanel Grid.Row="1" VerticalAlignment="Center" Orientation="Horizontal" HorizontalAlignment="Left" Margin="0,0,25,0">
<StackPanel VerticalAlignment="Center" Orientation="Horizontal" HorizontalAlignment="Left" Margin="0,0,25,0">
<TextBlock Text="JVM 参数头部" VerticalAlignment="Center" />
<local:MyIconButton Height="23" Margin="0,1,0,0" x:Name="BtnAdvanceJvmReset" VerticalAlignment="Center"
ToolTip="还原" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1"
Logo="M530 0c287 0 521 229 521 511s-233 511-521 511c-233 0-436-151-500-368a63 63 0 0 1 44-79 65 65 0 0 1 80 43c48 162 200 276 375 276 215 0 390-171 390-383s-174-383-390-383c-103 0-199 39-270 106l21-5a63 63 0 0 1 33 123l-157 42a65 65 0 0 1-90-42l-49-183a65 65 0 1 1 126-33l6 26A524 524 0 0 1 530 0z" LogoScale="0.9" />
</StackPanel>
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="1" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,除非有确定把握,否则请不要修改" MaxLength="4000"
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,除非有确定把握,否则请不要修改" MaxLength="4000"
Height="100" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" VerticalScrollBarVisibility="Auto" />
<TextBlock Grid.Row="3" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏参数尾部" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="3" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如输入 --demo 则会以试玩模式启动游戏。" />
<TextBlock Grid.Row="5" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="5" Grid.ColumnSpan="2" Tag="LaunchAdvanceRun" Grid.Column="1" HintText=""
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏参数尾部" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如输入 --demo 则会以试玩模式启动游戏。" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动前执行命令" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceRun" Grid.Row="4" Grid.ColumnSpan="2" Tag="LaunchAdvanceRun" Grid.Column="1" HintText=""
ToolTip="在 MC 启动前执行特定命令或程序,语法与 Windows 的命令提示符一致。&#xa;&#xa;可以使用以下替换标记实现相对路径(路径均以 \ 结尾):&#xa; · {path}:PCL 的 exe 文件所在的文件夹&#xa; · {minecraft}:.minecraft 文件夹&#xa; · {verpath}:版本文件夹(.minecraft\versions\版本名\)&#xa; · {verindie}:开启版本隔离时等同版本文件夹,未开启时等同 .minecraft 文件夹&#xa; · {java}:游戏运行时的 Java 文件夹&#xa;&#xa;除此之外,也支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {uuid}:玩家的 UUID&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号&#xa;&#xa;例如:&#xa; · &quot;{verpath}test.exe&quot; :运行版本文件夹下的 test.exe 程序&#xa; · &quot;{java}java.exe&quot; -jar &quot;{verpath}test.jar&quot; :用 Java 运行版本文件夹下的 test.jar&#xa; · notepad &quot;{verindie}options.txt&quot; :使用记事本打开该版本的设置文件&#xa;&#xa;涉及路径的操作最好都打上双引号,以避免路径中的空格导致运行失败。&#xa;执行命令时,命令行所在的目录是当前的 .minecraft 文件夹。" />
<local:MyCheckBox Grid.Row="6" Grid.Column="1" x:Name="CheckAdvanceRunWait" Tag="LaunchAdvanceRunWait" Visibility="Collapsed"
<local:MyCheckBox Grid.Row="5" Grid.Column="1" x:Name="CheckAdvanceRunWait" Tag="LaunchAdvanceRunWait" Visibility="Collapsed"
Text="等待命令执行完成后再继续启动" Margin="0,8,0,7" />
<StackPanel Margin="0,12,0,4" Grid.Row="7" Grid.ColumnSpan="2" HorizontalAlignment="Left">
<StackPanel Margin="0,12,0,4" Grid.Row="6" Grid.ColumnSpan="2" HorizontalAlignment="Left">
<local:MyCheckBox Height="28" Text="禁用 Java Launch Wrapper" x:Name="CheckAdvanceDisableJLW" Tag="LaunchAdvanceDisableJLW"
ToolTipService.Placement="Right" ToolTip="PCL 会使用 Java Launch Wrapper 来修复老版本 Java 在中文路径下无法启动的问题。&#xa;如果这被反作弊拦截,或遇到其他问题,也可以将其关闭。" />
<local:MyCheckBox Height="28" Text="要求 Java 使用高性能显卡" x:Name="CheckAdvanceGraphicCard" Tag="LaunchAdvanceGraphicCard"
ToolTipService.Placement="Right" ToolTip="自动在 Windows 设置 → 系统 → 屏幕 → 显示卡 中将 Java 改为使用高性能显卡。&#xa;如果电脑同时有集显和独显,这能确保 MC 使用独显进行渲染,以大幅提高性能。" />
</StackPanel>
<local:MyHint Text="你还可以在版本独立设置中找到更多高级启动选项。" Margin="0,5,0,10" Theme="Blue" Grid.Row="7" Grid.ColumnSpan="2"
CanClose="True" RelativeSetup="HintMoreAdvancedSetup" />
</Grid>
</local:MyCard>
<local:MyExtraTextButton HorizontalAlignment="Center" Margin="0,-5,0,15"
@@ -14,7 +14,7 @@
End If
'非重复加载部分
If IsLoad Then Exit Sub
If IsLoad Then Return
IsLoad = True
AniControlEnabled += 1
@@ -122,18 +122,18 @@
Private Sub BtnSkinChange_Click(sender As Object, e As EventArgs) Handles BtnSkinChange.Click
Dim SkinInfo As McSkinInfo = McSkinSelect()
If Not SkinInfo.IsVaild Then Exit Sub
If Not SkinInfo.IsVaild Then Return
ChangeSkin(SkinInfo)
End Sub
Private Sub RadioSkinType3_Check(sender As Object, e As RouteEventArgs) Handles RadioSkinType4.PreviewCheck
If Not (AniControlEnabled = 0 AndAlso e.RaiseByMouse) Then Exit Sub
If Not (AniControlEnabled = 0 AndAlso e.RaiseByMouse) Then Return
'已有图片则不再选择
If File.Exists(PathAppdata & "CustomSkin.png") Then Exit Sub
If File.Exists(PathAppdata & "CustomSkin.png") Then Return
'没有图片则要求选择
Dim SkinInfo As McSkinInfo = McSkinSelect()
If Not SkinInfo.IsVaild Then
e.Handled = True
Exit Sub
Return
End If
'正式改变
If Not ChangeSkin(SkinInfo) Then e.Handled = True
@@ -187,7 +187,7 @@
#Region "游戏内存"
Public Sub RamType(Type As Integer)
If SliderRamCustom Is Nothing Then Exit Sub
If SliderRamCustom Is Nothing Then Return
SliderRamCustom.IsEnabled = (Type = 1)
End Sub
@@ -195,7 +195,7 @@
''' 刷新 UI 上的 RAM 显示。
''' </summary>
Public Sub RefreshRam(ShowAnim As Boolean)
If LabRamGame Is Nothing OrElse LabRamUsed Is Nothing OrElse FrmMain.PageCurrent <> FormMain.PageType.Setup OrElse FrmSetupLeft.PageID <> FormMain.PageSubType.SetupLaunch Then Exit Sub
If LabRamGame Is Nothing OrElse LabRamUsed Is Nothing OrElse FrmMain.PageCurrent <> FormMain.PageType.Setup OrElse FrmSetupLeft.PageID <> FormMain.PageSubType.SetupLaunch Then Return
'获取内存情况
Dim RamGame As Double = Math.Round(GetRam(McVersionCurrent, False), 5)
Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024, 1)
@@ -409,7 +409,7 @@ PreFin:
'刷新 Java 下拉框显示
Public Sub RefreshJavaComboBox()
If ComboArgumentJava Is Nothing Then Exit Sub
If ComboArgumentJava Is Nothing Then Return
'初始化列表
ComboArgumentJava.Items.Clear()
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"})
@@ -448,9 +448,9 @@ PreFin:
'下拉框选择更改
Private Sub JavaSelectionUpdate() Handles ComboArgumentJava.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
If AniControlEnabled <> 0 Then Return
'Java 不可用时也不清空,会导致刷新时找不到对象
If ComboArgumentJava.SelectedItem Is Nothing OrElse ComboArgumentJava.SelectedItem.Tag Is Nothing Then Exit Sub
If ComboArgumentJava.SelectedItem Is Nothing OrElse ComboArgumentJava.SelectedItem.Tag Is Nothing Then Return
'设置新的 Java
Dim SelectedJava = ComboArgumentJava.SelectedItem.Tag
If "自动选择".Equals(SelectedJava) Then
@@ -469,11 +469,11 @@ PreFin:
Private Sub BtnArgumentJavaSelect_Click(sender As Object, e As EventArgs) Handles BtnArgumentJavaSelect.Click
If JavaSearchLoader.State = LoadState.Loading Then
Hint("正在搜索 Java,请稍候!", HintType.Critical)
Exit Sub
Return
End If
'选择 Java
Dim JavaSelected As String = SelectFile("javaw.exe|javaw.exe", "选择 bin 文件夹中的 javaw.exe 文件")
If JavaSelected = "" Then Exit Sub
If JavaSelected = "" Then Return
JavaSelected = GetPathFromFullPath(JavaSelected)
Try
'验证 Java 可用
@@ -492,14 +492,14 @@ PreFin:
Hint("已将该 Java 加入 Java 列表!", HintType.Finish)
Catch ex As Exception
Log(ex, "该 Java 存在异常,无法使用", LogLevel.Msgbox, "异常的 Java")
Exit Sub
Return
End Try
End Sub
'自动查找
Private Sub BtnArgumentJavaSearch_Click(sender As Object, e As EventArgs) Handles BtnArgumentJavaSearch.Click
If JavaSearchLoader.State = LoadState.Loading Then
Hint("正在搜索 Java,请稍候!", HintType.Critical)
Exit Sub
Return
End If
RunInThread(
Sub()
@@ -518,7 +518,7 @@ PreFin:
#Region "其他选项"
Private Sub WindowTypeUIRefresh() Handles ComboArgumentWindowType.SelectionChanged
If ComboArgumentWindowType Is Nothing Then Exit Sub
If ComboArgumentWindowType Is Nothing Then Return
If ComboArgumentWindowType.SelectedIndex = 3 AndAlso LabArgumentWindowMiddle IsNot Nothing AndAlso LabArgumentWindowMiddle.Visibility = Visibility.Collapsed Then
LabArgumentWindowMiddle.Visibility = Visibility.Visible
TextArgumentWindowHeight.Visibility = Visibility.Visible
@@ -532,7 +532,7 @@ PreFin:
'可见性选择直接关闭的警告
Private Sub ComboArgumentVisibie_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentVisibie.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
If AniControlEnabled <> 0 Then Return
If ComboArgumentVisibie.SelectedIndex = 0 Then
If MyMsgBox("若在游戏启动后立即关闭启动器,崩溃检测、更改游戏标题等功能将失效。" & vbCrLf &
"如果想保留这些功能,可以选择让启动器在游戏启动后隐藏,游戏退出后自动关闭。", "提醒", "继续", "取消") = 2 Then
@@ -543,7 +543,7 @@ PreFin:
'开启自动内存优化的警告
Private Sub CheckArgumentRam_Change() Handles CheckArgumentRam.Change
If AniControlEnabled <> 0 Then Exit Sub
If AniControlEnabled <> 0 Then Return
If Not CheckArgumentRam.Checked Then Return
If MyMsgBox("内存优化会显著延长启动耗时,建议仅在内存不足时开启。" & vbCrLf &
"如果你在使用机械硬盘,这还可能导致一小段时间的严重卡顿。" &
@@ -555,8 +555,8 @@ PreFin:
'版本隔离提示
Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndieV2.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
MyMsgBox("默认策略只会对今后新安装的版本生效。" & vbCrLf & "已有版本的隔离策略需要在它的版本设置中调整。")
If AniControlEnabled <> 0 Then Return
MyMsgBox("本设置仅会对之后新安装的版本生效。" & vbCrLf & "如果要修改已安装的版本的隔离方式,请在它的版本独立设置中调整。")
End Sub
#End Region

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