diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..c987a5b --- /dev/null +++ b/.editorconfig @@ -0,0 +1,4 @@ +[*.{cs,vb}] + +# IDE0028: 简化集合初始化 +dotnet_style_collection_initializer = true:silent diff --git a/Plain Craft Launcher 2.sln b/Plain Craft Launcher 2.sln new file mode 100644 index 0000000..4e87318 --- /dev/null +++ b/Plain Craft Launcher 2.sln @@ -0,0 +1,47 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio Version 16 +VisualStudioVersion = 16.0.29728.190 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "Plain Craft Launcher 2", "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj", "{4499F2D2-18EF-4238-B1F0-7BD547AFF925}" +EndProject +Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Releaser", "Releaser", "{0FB7B07C-83E1-477E-B05B-C298304748BC}" + ProjectSection(SolutionItems) = preProject + E:\工具\de4dot\de4dot.exe = E:\工具\de4dot\de4dot.exe + E:\软件\dnSpy\dnSpy.exe = E:\软件\dnSpy\dnSpy.exe + Releaser\Release.nrproj = Releaser\Release.nrproj + Releaser\Releaser.bat = Releaser\Releaser.bat + Releaser\Snapshot.nrproj = Releaser\Snapshot.nrproj + Releaser\Snapshot.vmp = Releaser\Snapshot.vmp + EndProjectSection +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Beta|Any CPU = Beta|Any CPU + Debug|Any CPU = Debug|Any CPU + Release|Any CPU = Release|Any CPU + ReleaseUpdate|Any CPU = ReleaseUpdate|Any CPU + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.ActiveCfg = BETA|Any CPU + {4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Beta|Any CPU.Build.0 = BETA|Any CPU + {4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Debug|Any CPU.Build.0 = Debug|Any CPU + {4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.ActiveCfg = Release|Any CPU + {4499F2D2-18EF-4238-B1F0-7BD547AFF925}.Release|Any CPU.Build.0 = Release|Any CPU + {4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.ActiveCfg = ReleaseUpdate|Any CPU + {4499F2D2-18EF-4238-B1F0-7BD547AFF925}.ReleaseUpdate|Any CPU.Build.0 = ReleaseUpdate|Any CPU + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {838A572E-025C-4A2B-B682-68732EC0FE76} + EndGlobalSection + GlobalSection(Performance) = preSolution + HasPerformanceSessions = true + EndGlobalSection + GlobalSection(Performance) = preSolution + HasPerformanceSessions = true + EndGlobalSection +EndGlobal diff --git a/Plain Craft Launcher 2/App.config b/Plain Craft Launcher 2/App.config new file mode 100644 index 0000000..7ea53f5 --- /dev/null +++ b/Plain Craft Launcher 2/App.config @@ -0,0 +1,33 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Application.xaml b/Plain Craft Launcher 2/Application.xaml new file mode 100644 index 0000000..ccd7772 --- /dev/null +++ b/Plain Craft Launcher 2/Application.xaml @@ -0,0 +1,542 @@ + + + + + + + + + + + + #343d4a + #0b5bcb + #1370f3 + #4890f5 + #96c0f9 + #d5e6fd + #e0eafd + #eaf2fe + #80e0eafd + #343d4a + #0b5bcb + #1370f3 + #4890f5 + #96c0f9 + #d5e6fd + #e0eafd + #eaf2fe + #40eaf2fe + #404040 + #737373 + #8c8c8c + #a6a6a6 + #cccccc + #ebebeb + #f0f0f0 + #f5f5f5 + #404040 + #737373 + #8c8c8c + #a6a6a6 + #cccccc + #ebebeb + #f0f0f0 + #f5f5f5 + #80fbdddd + #ff4c4c + #ce2111 + + + #01eaf2fe + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Application.xaml.vb b/Plain Craft Launcher 2/Application.xaml.vb new file mode 100644 index 0000000..b7a5504 --- /dev/null +++ b/Plain Craft Launcher 2/Application.xaml.vb @@ -0,0 +1,238 @@ +Imports System.Net +Imports System.Reflection +Imports System.Windows.Threading + +Public Class Application + +#If DEBUG Then + ''' + ''' 用于开始程序时的一些测试。 + ''' + Private Sub Test() + Try + ModDevelop.Start() + Catch ex As Exception + Log(ex, "开发者模式测试出错", LogLevel.Feedback) + End Try + End Sub + +#End If + + '开始 + Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup + ApplicationStartTick = GetTimeTick() + SecretOnApplicationStart() + Try + '检查参数调用 + If e.Args.Length > 0 Then + If e.Args(0) = "--update" Then + '自动更新 + UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4)) + Environment.[Exit](Result.Cancel) + Exit Sub + ElseIf e.Args(0) = "--link" Then + '稍作等待后切换到联机页面 + Thread.Sleep(1000) + FormMain.IsLinkRestart = True +#If DEBUG Then + ElseIf e.Args(0) = "--make" Then + '制作更新包 + UpdateMake(e.Args(1)) + Environment.[Exit](Result.Cancel) + Exit Sub +#End If + End If + End If + '初始化文件结构 + Directory.CreateDirectory(Path & "PCL\Pictures") + Directory.CreateDirectory(Path & "PCL\Musics") + Try + Directory.CreateDirectory(PathTemp) + If Not CheckPermission(PathTemp) Then Throw New Exception("PCL2 没有对 " & PathTemp & " 的访问权限") + Catch ex As Exception + MyMsgBox("手动设置的缓存文件夹不可用，PCL2 将使用默认缓存文件夹。" & vbCrLf & "错误原因：" & GetString(ex, False), "缓存文件夹不可用") + Setup.Set("SystemSystemCache", "") + PathTemp = IO.Path.GetTempPath() & "PCL\" + End Try + Directory.CreateDirectory(PathTemp & "Cache") + Directory.CreateDirectory(PathTemp & "Download") + '检测单例 +#If Not DEBUG Then + Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher 2　") + If WindowHwnd <> IntPtr.Zero Then + '将已有的 PCL2 窗口拖出来 + ShowWindowToTop(WindowHwnd) + '播放提示音并退出 + Beep() + Environment.[Exit](Result.Cancel) + Exit Sub + End If +#End If + '设置初始窗口 + If Setup.Get("UiLauncherLogo") AndAlso Not FormMain.IsLinkRestart Then + FrmStart = New SplashScreen("Images\icon.ico") + FrmStart.Show(False, True) + End If + '动态 DLL 调用 + AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve + '日志初始化 + LogStart() + '添加日志 + Log("[Start] 程序版本：" & VersionDisplayName & "（" & VersionCode & "）") + Log("[Start] 识别码：" & UniqueAddress & If(ThemeCheckOne(9), "，已解锁反馈主题", "")) + Log("[Start] 程序路径：" & PathWithName) + '检测压缩包运行 + If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then + MyMsgBox("PCL2 正在临时文件夹运行，设置、游戏存档等很可能无法保存，且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL2 从压缩文件中解压，或是更换文件夹后再继续使用！", "环境警告", "我知道了", IsWarn:=True) + End If + '设置初始化 + Setup.Load("SystemDebugMode") + Setup.Load("SystemDebugAnim") + Setup.Load("ToolDownloadThread") + '网络配置初始化 + ServicePointManager.Expect100Continue = True + ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 + ServicePointManager.DefaultConnectionLimit = 1024 + ServicePointManager.ServerCertificateValidationCallback = New Security.RemoteCertificateValidationCallback(Function() As Boolean + Return True + End Function) + '计时 + Log("[Start] 第一阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms") + ApplicationStartTick = GetTimeTick() + '执行测试 +#If DEBUG Then + Test() +#End If + AniControlEnabled += 1 + Catch ex As Exception + MsgBox(GetString(ex, False, True), MsgBoxStyle.Critical, "PCL2 初始化错误") + FormMain.EndProgramForce(Result.Exception) + End Try + End Sub + + '结束 + Private Sub Application_SessionEnding(sender As Object, e As SessionEndingCancelEventArgs) Handles Me.SessionEnding + FrmMain.EndProgram(False) + 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(Result.Exception) + Exit Sub + End If + IsCritErrored = True + Dim ExceptionString As String = GetString(e.Exception, False, 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(Result.Cancel) + Else + FeedbackInfo() + Log(e.Exception, "程序出现未知错误", LogLevel.Assert, "锟斤拷烫烫烫") + End If + End Sub + + '动态 DLL 调用 + Private Shared AssemblyStun As Assembly + Private Shared AssemblyNAudio As Assembly + Private Shared AssemblyJson As Assembly + Private Shared AssemblyDialog As Assembly + Private Shared ReadOnly AssemblyStunLock As New Object + Private Shared ReadOnly AssemblyNAudioLock As New Object + Private Shared ReadOnly AssemblyJsonLock As New Object + Private Shared ReadOnly AssemblyDialogLock As New Object + Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly + If args.Name.StartsWith("NAudio") Then + SyncLock AssemblyNAudioLock + If AssemblyNAudio Is Nothing Then + Log("[Start] 加载 DLL：NAudio") + AssemblyNAudio = Assembly.Load(GetResources("NAudio")) + End If + Return AssemblyNAudio + End SyncLock + ElseIf args.Name.StartsWith("Newtonsoft.Json") Then + SyncLock AssemblyJsonLock + If AssemblyJson Is Nothing Then + Log("[Start] 加载 DLL：Json") + AssemblyJson = Assembly.Load(GetResources("Json")) + End If + Return AssemblyJson + End SyncLock + ElseIf args.Name.StartsWith("Ookii.Dialogs.Wpf") Then + SyncLock AssemblyDialogLock + If AssemblyDialog Is Nothing Then + Log("[Start] 加载 DLL：Dialogs") + AssemblyDialog = Assembly.Load(GetResources("Dialogs")) + End If + Return AssemblyDialog + End SyncLock + ElseIf args.Name.StartsWith("STUN") Then + SyncLock AssemblyStunLock + If AssemblyStun Is Nothing Then + Log("[Start] 加载 DLL：STUN") + AssemblyStun = Assembly.Load(GetResources("STUN")) + End If + Return AssemblyStun + End SyncLock + Else + Return Nothing + End If + End Function + + '切换窗口 + + + '控件模板事件 + Private Sub MyIconButton_Click(sender As Object, e As EventArgs) + If Setup.Get("LoginType") = McLoginType.Legacy Then + '离线 + Dim Names As New List(Of String) + Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨")) + Names.Remove(sender.Tag) + Setup.Set("LoginLegacyName", Join(Names, "¨")) + FrmLoginLegacy.ComboName.ItemsSource = Names + FrmLoginLegacy.ComboName.Text = If(Names.Count > 0, Names(0), "") + Else + '非离线 + Dim Token As String = GetStringFromEnum(Setup.Get("LoginType")) + Dim Dict As New Dictionary(Of String, String) + Dim Names As New List(Of String) + Dim Passs As New List(Of String) + If Not Setup.Get("Login" & Token & "Email") = "" Then Names.AddRange(Setup.Get("Login" & Token & "Email").ToString.Split("¨")) + If Not Setup.Get("Login" & Token & "Pass") = "" Then Passs.AddRange(Setup.Get("Login" & Token & "Pass").ToString.Split("¨")) + For i = 0 To Names.Count - 1 + Dict.Add(Names(i), Passs(i)) + Next + Dict.Remove(sender.Tag) + Setup.Set("Login" & Token & "Email", Join(Dict.Keys.ToArray, "¨")) + Setup.Set("Login" & Token & "Pass", Join(Dict.Values.ToArray, "¨")) + Select Case Token + Case "Mojang" + FrmLoginMojang.ComboName.ItemsSource = Dict.Keys + FrmLoginMojang.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "") + FrmLoginMojang.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "") + Case "Nide" + FrmLoginNide.ComboName.ItemsSource = Dict.Keys + FrmLoginNide.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "") + FrmLoginNide.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "") + Case "Auth" + FrmLoginAuth.ComboName.ItemsSource = Dict.Keys + FrmLoginAuth.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "") + FrmLoginAuth.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "") + Case Else + DebugAssert(True) + Exit Sub + End Select + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/IMyRadio.vb b/Plain Craft Launcher 2/Controls/IMyRadio.vb new file mode 100644 index 0000000..8649305 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/IMyRadio.vb @@ -0,0 +1,4 @@ +Public Interface IMyRadio + Event Check(sender As Object, e As RouteEventArgs) + Event Changed(sender As Object, e As RouteEventArgs) +End Interface diff --git a/Plain Craft Launcher 2/Controls/MyButton.xaml b/Plain Craft Launcher 2/Controls/MyButton.xaml new file mode 100644 index 0000000..5cff437 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyButton.xaml @@ -0,0 +1,16 @@ + + + + + + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Controls/MyButton.xaml.vb b/Plain Craft Launcher 2/Controls/MyButton.xaml.vb new file mode 100644 index 0000000..686b855 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyButton.xaml.vb @@ -0,0 +1,196 @@ +Public Class MyButton + + '声明 + Public Event Click(sender As Object, e As EventArgs) '自定义事件 + + '自定义属性 + Public Uuid As Integer = GetUuid() + Public Property Text As String + Get + Return LabText.Text + End Get + Set(value As String) + LabText.Text = value + End Set + End Property '显示文本 + Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyButton), New PropertyMetadata(New PropertyChangedCallback( + Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs) + If Not IsNothing(sender) Then CType(sender, MyButton).LabText.Text = e.NewValue + End Sub))) + Public Property TextPadding As Thickness + Get + Return LabText.Padding + End Get + Set(value As Thickness) + LabText.Padding = value + End Set + End Property + Private _ColorType As ColorState = ColorState.Normal '配色方案 + Public Property ColorType As ColorState + Get + Return _ColorType + End Get + Set(value As ColorState) + _ColorType = value + RefreshColor() + End Set + End Property + Public Enum ColorState + Normal = 0 + Highlight = 1 + Red = 2 + End Enum + '属性穿透 + Public Shared Shadows ReadOnly PaddingProperty As DependencyProperty = DependencyProperty.Register("Padding", GetType(Thickness), GetType(MyButton), New PropertyMetadata(New PropertyChangedCallback( + Sub(sender As MyButton, e As DependencyPropertyChangedEventArgs) If sender IsNot Nothing Then sender.PanFore.Padding = e.NewValue))) + Public Overloads Property Padding As Thickness + Get + Return PanFore.Padding + End Get + Set(value As Thickness) + PanFore.Padding = value + End Set + End Property + Public Property RealRenderTransform As Transform + Get + Return PanFore.RenderTransform + End Get + Set(value As Transform) + PanFore.RenderTransform = value + End Set + End Property + + '自定义事件 + Private Const AnimationColorIn As Integer = 100 + Private Const AnimationColorOut As Integer = 200 + Private Sub RefreshColor(Optional obj = Nothing, Optional e = Nothing) Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded, Me.IsEnabledChanged + Try + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + + If IsEnabled Then + Select Case ColorType + Case ColorState.Normal + If IsMouseOver Then + '指向（Main 3） + AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrush3", AnimationColorIn)}, "MyButton Color " & Uuid) + Else + '普通（Main 1） + AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrush1", AnimationColorOut)}, "MyButton Color " & Uuid) + End If + Case ColorState.Highlight + If IsMouseOver Then + '指向（Main 3） + AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrush3", AnimationColorIn)}, "MyButton Color " & Uuid) + Else + '高亮（Main 2） + AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrush2", AnimationColorOut)}, "MyButton Color " & Uuid) + End If + Case ColorState.Red + If IsMouseOver Then + '红色指向 + AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrushRedLight", AnimationColorIn)}, "MyButton Color " & Uuid) + Else + '红色 + AniStart({AaColor(PanFore, Border.BorderBrushProperty, "ColorBrushRedDark", AnimationColorOut)}, "MyButton Color " & Uuid) + End If + End Select + Else + '不可用（Gray 4） + AniStart({AaColor(PanFore, Border.BorderBrushProperty, ColorGray4 - PanFore.BorderBrush, AnimationColorOut)}, "MyButton Color " & Uuid) + End If + Else + + AniStop("MyButton Color " & Uuid) + If IsEnabled Then + Select Case ColorType + Case ColorState.Normal + If IsMouseOver Then + PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrush3") + Else + PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrush1") + End If + Case ColorState.Highlight + If IsMouseOver Then + PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrush3") + Else + PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrush2") + End If + Case ColorState.Red + If IsMouseOver Then + PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrushRedLight") + Else + PanFore.SetResourceReference(Border.BorderBrushProperty, "ColorBrushRedDark") + End If + End Select + Else + PanFore.BorderBrush = ColorGray4 + End If + + End If + Catch ex As Exception + Log(ex, "刷新按钮颜色出错") + End Try + End Sub + + '实现自定义事件 + Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp + If IsMouseDown Then + Log("[Control] 按下按钮：" & Text) + RaiseEvent Click(sender, e) + If Not String.IsNullOrEmpty(Tag) Then + If Tag.ToString.StartsWith("链接-") OrElse Tag.ToString.StartsWith("启动-") Then + Hint("主页自定义按钮语法已更新，且不再兼容老版本语法，请查看新的自定义示例！") + End If + End If + ModEvent.TryStartEvent(EventType, EventData) + End If + End Sub + Public Property EventType As String + Get + Return GetValue(EventTypeProperty) + End Get + + Set(ByVal value As String) + SetValue(EventTypeProperty, value) + End Set + End Property + Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyButton), New PropertyMetadata(Nothing)) + Public Property EventData As String + Get + Return GetValue(EventDataProperty) + End Get + + Set(ByVal value As String) + SetValue(EventDataProperty, value) + End Set + End Property + Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyButton), New PropertyMetadata(Nothing)) + + '鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行） + Private IsMouseDown As Boolean = False + Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown + IsMouseDown = True + Focus() + AniStart({ + AaScaleTransform(PanFore, 0.955 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 80,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), + AaScaleTransform(PanFore, -0.01, 700,, New AniEaseOutFluent(AniEasePower.Middle)) + }, "MyButton Scale " & Uuid) + End Sub + Private Sub Button_MouseEnter() Handles Me.MouseEnter + AniStart(AaColor(PanFore, BackgroundProperty, If(_ColorType = ColorState.Red, "ColorBrushRedBack", "ColorBrush9"), AnimationColorIn), "MyButton Background " & Uuid) + End Sub + Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp + If Not IsMouseDown Then Exit Sub + IsMouseDown = False + AniStart({ + AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 300, 10, New AniEaseOutFluent(AniEasePower.Middle)) + }, "MyButton Scale " & Uuid) + End Sub + Private Sub Button_MouseLeave() Handles Me.MouseLeave + AniStart(AaColor(PanFore, BackgroundProperty, "ColorBrushHalfWhite", AnimationColorOut), "MyButton Background " & Uuid) + If Not IsMouseDown Then Exit Sub + IsMouseDown = False + AniStart(AaScaleTransform(PanFore, 1 - CType(PanFore.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), "MyButton Scale " & Uuid) + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyCard.vb b/Plain Craft Launcher 2/Controls/MyCard.vb new file mode 100644 index 0000000..46e99e8 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyCard.vb @@ -0,0 +1,300 @@ +Public Class MyCard + + '控件 + Inherits Grid + Private ReadOnly MainGrid As Grid + Private ReadOnly MainChrome As SystemDropShadowChrome + Private ReadOnly MainBorder As Border + Public MainTextBlock As TextBlock + Public MainSwap As Shapes.Path + + '属性 + Public Uuid As Integer = GetUuid() + Public Property Title As String + Get + Return GetValue(TitleProperty) + End Get + Set(value As String) + SetValue(TitleProperty, value) + If MainTextBlock IsNot Nothing Then MainTextBlock.Text = value + End Set + End Property + Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyCard), New PropertyMetadata("")) + + '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") + Children.Add(MainChrome) + MainBorder = New Border With {.Background = New SolidColorBrush(Color.FromArgb(205, 255, 255, 255)), .CornerRadius = New CornerRadius(6), .IsHitTestVisible = False} + Children.Add(MainBorder) + MainGrid = New Grid + Children.Add(MainGrid) + End Sub + Private IsLoad As Boolean = False + Private Sub MyCard_Loaded() Handles Me.Loaded + '卡片的进入时动画已被页面通用切换动画替代 + 'If LoadAnimation AndAlso IsLoad Then + ' StartHeightAnimation(Math.Min(50, ActualHeight), ActualHeight - Math.Min(50, ActualHeight), True) + 'End If + If IsLoad Then Exit Sub + '初次加载限定 + If Not Title = "" AndAlso IsNothing(MainTextBlock) Then + MainTextBlock = New TextBlock With {.HorizontalAlignment = HorizontalAlignment.Left, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(15, 12, 0, 0), .FontWeight = FontWeights.Bold, .FontSize = 13, .IsHitTestVisible = False} + MainTextBlock.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush1") + MainTextBlock.SetBinding(TextBlock.TextProperty, New Binding("Title") With {.Source = Me, .Mode = BindingMode.OneWay}) + MainGrid.Children.Add(MainTextBlock) + End If + If CanSwap OrElse SwapControl IsNot Nothing Then + If SwapControl Is Nothing AndAlso Children.Count > 3 Then SwapControl = Children(3) + MainSwap = New Shapes.Path With {.HorizontalAlignment = HorizontalAlignment.Right, .Stretch = Stretch.Uniform, .Height = 6, .Width = 10, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(0, 17, 16, 0), .Data = New GeometryConverter().ConvertFromString("M2,4 l-2,2 10,10 10,-10 -2,-2 -8,8 -8,-8 z"), .RenderTransform = New RotateTransform(180), .RenderTransformOrigin = New Point(0.5, 0.5)} + MainSwap.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush1") + MainGrid.Children.Add(MainSwap) + End If + IsLoad = True + '改变默认的折叠 + If IsSwaped AndAlso SwapControl IsNot Nothing Then + MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0)) + '取消由于高度变化被迫触发的高度动画 + Dim RawUseAnimation As Boolean = UseAnimation + UseAnimation = False + Height = SwapedHeight + AniStop("MyCard Height " & Uuid) + IsHeightAnimating = False + RunInUi(Sub() UseAnimation = RawUseAnimation, True) + End If + End Sub + Public Sub StackInstall() + StackInstall(SwapControl, SwapType, Title) + TriggerForceResize() + End Sub + Public Shared Sub StackInstall(ByRef Stack As StackPanel, Type As Integer, Optional CardTitle As String = "") + '这一部分的代码是好几年前留下的究极屎坑，当时还不知道该咋正确调用这种方法，就写了这么一坨屎 + '但是现在……反正勉强能用……懒得改了就这样吧.jpg + '别骂了别骂了.jpg + If IsNothing(Stack.Tag) Then Exit Sub + '排序 + Select Case Type + Case 3 + Stack.Tag = Sort(CType(Stack.Tag, List(Of DlOptiFineListEntry)), Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean + Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay) + End Function) + Case 4, 10 + Stack.Tag = Sort(CType(Stack.Tag, List(Of DlLiteLoaderListEntry)), Function(Left As DlLiteLoaderListEntry, Right As DlLiteLoaderListEntry) As Boolean + Return VersionSortBoolean(Left.Inherit, Right.Inherit) + End Function) + Case 6 + Stack.Tag = Sort(CType(Stack.Tag, List(Of DlForgeVersionEntry)), Function(Left As DlForgeVersionEntry, Right As DlForgeVersionEntry) As Boolean + Return VersionSortBoolean(Left.Version, Right.Version) + End Function) + Case 8, 9 + Stack.Tag = Sort(CType(Stack.Tag, List(Of DlCfFile)), Function(Left As DlCfFile, Right As DlCfFile) As Boolean + Return Left.Date > Right.Date + End Function) + End Select + '控件转换 + Select Case Type + Case 5 + Dim LoadingPickaxe As New MyLoading With {.Text = "正在获取版本列表", .Margin = New Thickness(5)} + Dim Loader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Main", AddressOf DlForgeVersionMain) + LoadingPickaxe.State = Loader + Loader.Start(Stack.Tag) + AddHandler LoadingPickaxe.StateChanged, AddressOf FrmDownloadForge.Forge_StateChanged + AddHandler LoadingPickaxe.Click, AddressOf FrmDownloadForge.Forge_Click + Stack.Children.Add(LoadingPickaxe) + Case 6 + ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True) + Case 8 + DlCfFilesPreload(Stack, Stack.Tag, AddressOf FrmDownloadMod.ProjectClick) + End Select + '实现控件虚拟化 + For Each Data As Object In Stack.Tag + Select Case Type + Case 0 + Stack.Children.Add(PageSelectRight.McVersionListItem(Data)) + Case 1 + Stack.Children.Add(PageOtherFeedback.FeedbackListItem(Data, CardTitle)) + Case 2 + Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True)) + Case 3 + Stack.Children.Add(OptiFineDownloadListItem(Data, AddressOf OptiFineSave_Click, True)) + Case 4 + Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf FrmDownloadLiteLoader.DownloadStart, False)) + Case 5 + Case 6 + Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True)) + Case 7 + Stack.Children.Add(McDownloadListItem(Data, AddressOf FrmDownloadInstall.MinecraftSelected, False)) + Case 8 + Stack.Children.Add(CType(Data, DlCfFile).ToListItem(AddressOf FrmDownloadCfDetail.Save_Click)) + Case 9 + Stack.Children.Add(CType(Data, DlCfFile).ToListItem(AddressOf FrmDownloadCfDetail.Install_Click, AddressOf FrmDownloadCfDetail.Save_Click)) + Case 10 + Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True)) + Case 11 + Stack.Children.Add(CType(Data, HelpEntry).ToListItem) + Case Else + Log("未知的虚拟化种类：" & Type, LogLevel.Feedback) + End Select + Next + Stack.Children.Add(New FrameworkElement With {.Height = 18}) '下边距，同时适应折叠 + Stack.Tag = Nothing + End Sub + + '事件 + Private Sub MyCard_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter + 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)) + 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) + }) + AniStart(AniList, "MyCard Mouse " & Uuid) + End Sub + Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave + 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)) + 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) + }) + AniStart(AniList, "MyCard Mouse " & Uuid) + End Sub + + '高度改变动画 + Public Property UseAnimation As Boolean = True + 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 + 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 + 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 设计器出错 + + Dim AnimList As New List(Of AniData) + If DeltaHeight > 10 OrElse (DeltaHeight < -10 AndAlso Not IsNothing(SwapControl)) Then '如果不是需要折叠的卡片，高度减小时的弹跳会吞掉按钮下边框 + '高度增加较大，使用弹起动画 + Dim Delta As Double = MathRange(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)) + }) + Else + '普通的改变就行啦 + AnimList.AddRange({ + AaHeight(Me, DeltaHeight, MathRange(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent) + }) + End If + AnimList.Add(AaCode(Sub() + IsHeightAnimating = False + Height = ActualUsedHeight + If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed + End Sub,, True)) + AniStart(AnimList, "MyCard Height " & Uuid) + + IsHeightAnimating = True + ActualUsedHeight = If(IsSwaped, SwapedHeight, Height) + Height = PreviousHeight + End Sub + ''' + ''' 通知 MyCard，控件内容已改变，需要中断动画并更新高度。 + ''' + Public Sub TriggerForceResize() + Height = If(IsSwaped, SwapedHeight, Double.NaN) + AniStop("MyCard Height " & Uuid) + IsHeightAnimating = False + End Sub + + '折叠 + '若设置了 CanSwap，或 SwapControl 不为空，则判定为会进行折叠 + '这是因为不能直接在 XAML 中设置 SwapControl + Public SwapControl As Object + Public Property CanSwap As Boolean = False + ''' + ''' 被折叠的种类，用于控件虚拟化。 + ''' + Public Property SwapType As Integer + ''' + ''' 是否已被折叠。 + ''' + Public Property IsSwaped As Boolean + Get + Return _IsSwaped + End Get + Set(ByVal value As Boolean) + If _IsSwaped = value Then Exit Property + _IsSwaped = value + If SwapControl Is Nothing Then Exit Property + '展开 + If Not IsSwaped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title) + '若尚未加载，会在 Loaded 事件中触发无动画的折叠，不需要在这里进行 + If Not IsLoaded Then Exit Property + '更新高度 + 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) + End Set + End Property + Private _IsSwaped As Boolean = False + + Public Property SwapLogoRight As Boolean = False + Private IsMouseDown As Boolean = False + Public Event PreviewSwap(sender As Object, e As RouteEventArgs) + Public Event Swap(sender As Object, e As RouteEventArgs) + Public Const SwapedHeight As Integer = 40 + 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 (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判 + IsMouseDown = True + End Sub + Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp + If IsMouseDown Then + IsMouseDown = False + Dim Pos As Double = Mouse.GetPosition(Me).Y + If Not IsSwaped AndAlso (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置；或已经不在可视树上的误判 + + Dim ee = New RouteEventArgs(True) + RaiseEvent PreviewSwap(Me, ee) + If ee.Handled Then + IsMouseDown = False + Exit Sub + End If + + IsSwaped = Not IsSwaped + Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", "：" & Title)) + RaiseEvent Swap(Me, ee) + End If + End Sub + Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave + IsMouseDown = False + End Sub + +End Class +Partial Public Module ModAnimation + Public Sub AniDispose(Control As MyCard, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing) + If Not Control.IsHitTestVisible Then Exit Sub + 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() + If RemoveFromChildren Then + CType(Control.Parent, Object).Children.Remove(Control) + Else + Control.Visibility = Visibility.Collapsed + End If + If CallBack IsNot Nothing Then CallBack(Control) + End Sub,, True) + }, "MyCard Dispose " & Control.Uuid) + End Sub +End Module \ No newline at end of file diff --git a/Plain Craft Launcher 2/Controls/MyCheckBox.xaml b/Plain Craft Launcher 2/Controls/MyCheckBox.xaml new file mode 100644 index 0000000..0f369e5 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyCheckBox.xaml @@ -0,0 +1,14 @@ + + + + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb b/Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb new file mode 100644 index 0000000..74c7234 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyCheckBox.xaml.vb @@ -0,0 +1,202 @@ +Public Class MyCheckBox + + '基础 + + Public Uuid As Integer = GetUuid() + ''' + ''' 复选框勾选状态改变。 + ''' + ''' 是否为用户手动改变的勾选状态。 + Public Event Change(sender As Object, user As Boolean) + Public Event PreviewChange(sender As Object, e As RouteEventArgs) + Public Sub RaiseChange() + RaiseEvent Change(Me, False) + End Sub '使外部程序引发本控件的 Change 事件 + + '自定义属性 + + Private _Checked As Boolean = False '是否选中 + Public Property Checked As Boolean + Get + Return _Checked + End Get + Set(value As Boolean) + SetChecked(value, False, True) + End Set + End Property + Private Const AnimationTimeOfCheck As Integer = 150 '勾选状态变更动画长度 + ''' + ''' 手动设置 Checked 属性。 + ''' + ''' 新的 Checked 属性。 + ''' 是否由用户引发。 + ''' 是否执行动画。 + Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean) + Try + If value = _Checked Then Exit Sub + + 'Preview 事件 + + If value AndAlso user Then + Dim e = New RouteEventArgs(user) + RaiseEvent PreviewChange(Me, e) + If e.Handled Then + MouseDowned = True + Checkbox_MouseLeave() + MouseDowned = False + Exit Sub + End If + End If + + _Checked = value + If IsLoaded Then RaiseEvent Change(Me, user) + + '更改动画 + + If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画 + AllowMouseDown = False + If Checked Then + '由无变有 + AniStart({ + AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True), + AaScaleTransform(ShapeCheck, 1 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack(AniEasePower.Weak)), + AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True) + }, "MyCheckBox Scale " & Uuid) + AniStart({ + AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray4"), AnimationTimeOfCheck) + }, "MyCheckBox BorderColor " & Uuid) + AniStart({ + AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2) + }, "MyCheckBox AllowMouseDown " & Uuid) + Else + '由有变无 + AniStart({ + AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True), + AaScaleTransform(ShapeCheck, -CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 0.9, , New AniEaseInFluent(AniEasePower.Weak)), + AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True) + }, "MyCheckBox Scale " & Uuid) + AniStart({ + AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfCheck) + }, "MyCheckBox BorderColor " & Uuid) + AniStart({ + AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2) + }, "MyCheckBox AllowMouseDown " & Uuid) + End If + Else + '不使用动画 + AniStop("MyCheckBox Scale " & Uuid) + AniStop("MyCheckBox BorderColor " & Uuid) + AniStop("MyCheckBox AllowMouseDown " & Uuid) + If Checked Then + CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1 + CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1 + ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4")) + Else + CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0 + CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0 + ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4")) + End If + End If + + Catch ex As Exception + Log(ex, "设置 Checked 失败") + End Try + End Sub + Public Property Text As String + Get + Return GetValue(TextProperty) + End Get + Set(value As String) + SetValue(TextProperty, value) + End Set + End Property '内容 + Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyCheckbox), New PropertyMetadata(New PropertyChangedCallback( + Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs) + If Not IsNothing(sender) Then CType(sender, MyCheckbox).LabText.Text = e.NewValue + End Sub))) + + '点击事件 + + Private MouseDowned As Boolean = False + Private AllowMouseDown As Boolean = True + Private Sub Checkbox_MouseUp() Handles Me.MouseLeftButtonUp + If Not MouseDowned Then Exit Sub + Log("[Control] 按下复选框（" & (Not Checked).ToString & "）：" & Text) + MouseDowned = False + SetChecked(Not Checked, True, 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 + MouseDowned = True + Focus() + AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrush9", 100), "MyCheckBox Background " & Uuid) + If Checked Then + AniStart({ + AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), + AaScaleTransform(ShapeCheck, 0.9 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, 1000, , New AniEaseOutFluent(AniEasePower.Strong)) + }, "MyCheckBox Scale " & Uuid) + Else + AniStart(AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyCheckBox Scale " & Uuid) + End If + End Sub + Private Sub Checkbox_MouseLeave() Handles Me.MouseLeave + If Not MouseDowned Then Exit Sub + MouseDowned = False + AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid) + If Checked Then + AniStart({ + AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), + AaScaleTransform(ShapeCheck, 1 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, 500, , New AniEaseOutFluent(AniEasePower.Strong)) + }, "MyCheckBox Scale " & Uuid) + Else + AniStart(AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyCheckBox Scale " & Uuid) + End If + End Sub + + '指向动画 + + Private Const AnimationTimeOfMouseIn As Integer = 100 + Private Const AnimationTimeOfMouseOut As Integer = 200 + Private Sub Checkbox_IsEnabledChanged() Handles Me.IsEnabledChanged + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + '有动画 + If IsEnabled Then + '可用 + Checkbox_MouseLeaveAnimation() + Else + '不可用 + AniStart({ + AaColor(ShapeBorder, Border.BorderBrushProperty, ColorGray4 - ShapeBorder.BorderBrush, AnimationTimeOfMouseOut) + }, "MyCheckBox BorderColor " & Uuid) + AniStart({ + AaColor(LabText, TextBlock.ForegroundProperty, ColorGray4 - LabText.Foreground, AnimationTimeOfMouseOut) + }, "MyCheckBox TextColor " & Uuid) + End If + Else + '无动画 + AniStop("MyCheckBox TextColor " & Uuid) + AniStop("MyCheckBox BorderColor " & Uuid) + LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4")) + ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4")) + End If + End Sub + Private Sub Checkbox_MouseEnterAnimation() Handles Me.MouseEnter + AniStart({ + AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn) + }, "MyCheckBox TextColor " & Uuid) + AniStart({ + AaColor(ShapeBorder, Border.BorderBrushProperty, "ColorBrush3", AnimationTimeOfMouseIn) + }, "MyCheckBox BorderColor " & Uuid) + End Sub + Private Sub Checkbox_MouseLeaveAnimation() Handles Me.MouseLeave + If Not IsEnabled Then Exit Sub 'MouseLeave 比 IsEnabledChanged 后执行，所以如果自定义事件修改了 IsEnabled，将导致显示错误 + AniStart({ + AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut) + }, "MyCheckBox TextColor " & Uuid) + AniStart({ + AaColor(ShapeBorder, Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut) + }, "MyCheckBox BorderColor " & Uuid) + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyComboBox.vb b/Plain Craft Launcher 2/Controls/MyComboBox.vb new file mode 100644 index 0000000..ceef0f9 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyComboBox.vb @@ -0,0 +1,135 @@ +Public Class MyComboBox + Inherits ComboBox + Public Event TextChanged(sender As Object, e As TextChangedEventArgs) + + '基础 + Public Uuid As Integer = GetUuid() + Private TextBox As MyTextBox + Public Property HintText As String = "" + Public Overrides Sub OnApplyTemplate() + MyBase.OnApplyTemplate() + If Not IsEditable Then Exit Sub + Try + TextBox = Template.FindName("PART_EditableTextBox", Me) + TextBox.AddHandler(LostFocusEvent, New RoutedEventHandler(AddressOf RefreshColor)) + TextBox.ChangedEventList.Add(New RoutedEventHandler(Sub(sender, e) RaiseEvent TextChanged(sender, e))) + TextBox.Tag = Tag '有时需要用文本框的 Tag 来写入设置 + If Text = "" Then + TextBox.Text = _Text + Else + RaiseEvent TextChanged(Me, Nothing) + End If + If HintText.Length > 0 Then TextBox.HintText = HintText + Catch ex As Exception + Log(ex, "初始化可编辑文本框失败（" & If(Name, "") & "）", LogLevel.Feedback) + End Try + End Sub + Private _Text As String = SelectedItem + Public Shadows Property Text As String + Get + If IsEditable Then + If TextBox Is Nothing Then + Return If(_Text, "") + Else + Return If(TextBox.Text, "") + End If + Else + Return If(SelectedItem, "").ToString + End If + End Get + Set(value As String) + If IsEditable Then + If IsNothing(TextBox) Then + _Text = value + Else + TextBox.Text = value + End If + Else + Throw New NotSupportedException("该 ComboBox 不支持修改文本。") + End If + End Set + End Property + + '鼠标按下接口 + Private IsMouseDown As Boolean = False + Private Sub MyComboBox_PreviewMouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown + IsMouseDown = True + End Sub + Private Sub MyComboBox_PreviewMouseLeftButtonUp(sender As Object, e As EventArgs) Handles Me.PreviewMouseLeftButtonUp, Me.MouseLeave + IsMouseDown = False + End Sub + + '指向动画 + Public Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.PreviewMouseLeftButtonDown, Me.PreviewMouseLeftButtonUp, Me.GotKeyboardFocus + '判断当前颜色 + Dim ColorName As String + Dim BackName As String + Dim Time As Integer + If IsEnabled Then + If IsEditable AndAlso Template.FindName("PART_EditableTextBox", Me).IsFocused Then + ColorName = "ColorBrush4" + BackName = "ColorBrush9" + Time = 60 + ElseIf IsMouseDown OrElse IsDropDownOpen Then + ColorName = "ColorBrush3" + BackName = "ColorBrush9" + Time = 60 + ElseIf IsMouseOver Then + ColorName = "ColorBrush3" + BackName = "ColorBrushHalfWhite" + Time = 100 + Else + ColorName = "ColorBrush1" + BackName = "ColorBrushHalfWhite" + Time = 200 + End If + Else + ColorName = "ColorBrushGray4" + BackName = "ColorBrushHalfWhite" + Time = 200 + End If + '触发颜色动画 + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + '有动画 + AniStart({ + AaColor(Me, ForegroundProperty, ColorName, Time), + AaColor(Me, BackgroundProperty, BackName, Time) + }, "MyComboBox Color " & Uuid) + Else + '无动画 + AniStop("MyComboBox Color " & Uuid) + SetResourceReference(ForegroundProperty, ColorName) + SetResourceReference(BackgroundProperty, BackName) + End If + End Sub + + Private RealWidth As Double '由于下拉框 Popup 宽度与 Width 一致，故不能为 NaN（Auto） + Private Sub MyComboBox_DropDownOpened(sender As Object, e As EventArgs) Handles Me.DropDownOpened + RealWidth = Width + Width = ActualWidth + Try + CType(Template.FindName("PanPopup", Me), Grid).Opacity = FrmMain.Opacity + Catch ex As Exception + Log(ex, "设置下拉框透明度失败", LogLevel.Feedback) + End Try + End Sub + Private Sub MyComboBox_DropDownClosed(sender As Object, e As EventArgs) Handles Me.DropDownClosed + Width = RealWidth + End Sub + + '修复 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 SelectedItem IsNot Nothing AndAlso Text <> SelectedItem.ToString Then + Dim RawText As String = Text + Dim RawSelectionStart As Integer = TextBox.SelectionStart + IsTextChanging = True + SelectedItem = Nothing + Text = RawText + TextBox.SelectionStart = RawSelectionStart + IsTextChanging = False + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyComboBoxItem.vb b/Plain Craft Launcher 2/Controls/MyComboBoxItem.vb new file mode 100644 index 0000000..3e77499 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyComboBoxItem.vb @@ -0,0 +1,67 @@ +Public Class MyComboBoxItem + Inherits ComboBoxItem + + '基础 + + Public Uuid As Integer = GetUuid() + Public Sub New() + Style = FindResource("MyComboBoxItem") + End Sub + + '指向动画 + + Private Const AnimationTimeIn As Integer = 100 + Private Const AnimationTimeOut As Integer = 300 + Private BackColorName As String, FontOpacity As Double + + Private Sub RefreshColor() Handles Me.Unselected, Me.MouseMove, Me.MouseLeave, Me.Selected, Me.IsEnabledChanged + '判断当前颜色 + Dim NewBackColorName As String, NewFontOpacity As Double + Dim Time As Integer + If IsSelected Then + NewBackColorName = "ColorBrush6" + NewFontOpacity = 1 + Time = AnimationTimeIn + ElseIf IsMouseOver Then + NewBackColorName = "ColorBrush8" + NewFontOpacity = 1 + Time = AnimationTimeIn + ElseIf IsEnabled Then + NewBackColorName = "ColorBrushTransparent" + NewFontOpacity = 1 + Time = AnimationTimeOut + Else + NewBackColorName = "ColorBrushTransparent" + NewFontOpacity = 0.4 + Time = AnimationTimeOut + End If + If BackColorName = NewBackColorName AndAlso FontOpacity = NewFontOpacity Then Exit Sub + BackColorName = NewBackColorName + FontOpacity = NewFontOpacity + '触发颜色动画 + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + '有动画 + AniStart({ + AaColor(Me, BackgroundProperty, BackColorName, Time), + AaOpacity(Me, FontOpacity - Opacity, Time) + }, "ComboBoxItem Color " & Uuid) + Else + '无动画 + AniStop("ComboBoxItem Color " & Uuid) + SetResourceReference(BackgroundProperty, BackColorName) + Opacity = FontOpacity + End If + End Sub + + Public Overrides Function Tostring() As String + Return Content.ToString + End Function + Public Shared Widening Operator CType(Value As MyComboBoxItem) As String + Return Value.Content.ToString + End Operator + + Private Sub MyComboBoxItem_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp + Log("[Control] 选择下拉列表项：" & Tostring()) + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyExtraButton.xaml b/Plain Craft Launcher 2/Controls/MyExtraButton.xaml new file mode 100644 index 0000000..b507666 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyExtraButton.xaml @@ -0,0 +1,25 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb b/Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb new file mode 100644 index 0000000..c56673e --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyExtraButton.xaml.vb @@ -0,0 +1,191 @@ +Public Class MyExtraButton + + '声明 + Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件 + Public Event RightClick(sender As Object, e As MouseButtonEventArgs) + + '自定义属性 + Public Uuid As Integer = GetUuid() + Private _Logo As String = "" + Public Property Logo As String + Get + Return _Logo + End Get + Set(value As String) + If value = _Logo Then Exit Property + _Logo = value + Path.Data = (New GeometryConverter).ConvertFromString(value) + End Set + End Property + Private _LogoScale As Double = 1 + Public Property LogoScale() As Double + Get + Return _LogoScale + End Get + Set(value As Double) + _LogoScale = value + If Not IsNothing(Path) Then Path.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale} + End Set + End Property + Private _Show As Boolean = False + Public Property Show As Boolean + Get + Return _Show + End Get + Set(value As Boolean) + If _Show = value Then Exit Property + _Show = value + RunInUi(Sub() + If value Then + '有了 + Visibility = Visibility.Visible + AniStart({ + AaScaleTransform(Me, 0.3 - CType(RenderTransform, ScaleTransform).ScaleX, 500, 60, New AniEaseOutFluent(AniEasePower.Weak)), + AaScaleTransform(Me, 0.7, 500, 60, New AniEaseOutBack(AniEasePower.Weak)), + AaHeight(Me, 50 - Height, 200,, New AniEaseOutFluent(AniEasePower.Weak)) + }, "MyExtraButton MainScale " & Uuid) + Else + '没了 + AniStart({ + AaScaleTransform(Me, -CType(RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseInFluent(AniEasePower.Weak)), + AaHeight(Me, -Height, 400, 100, New AniEaseOutFluent()), + AaCode(Sub() Visibility = Visibility.Collapsed,, True) + }, "MyExtraButton MainScale " & Uuid) + End If + IsHitTestVisible = value '防止缩放动画中依然可以点进去 + End Sub) + End Set + End Property + Public Delegate Function ShowCheckDelegate() As Boolean + Public ShowCheck As ShowCheckDelegate = Nothing + Public Sub ShowRefresh() + If ShowCheck IsNot Nothing Then Show = ShowCheck() + End Sub + + '触发点击事件 + Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp + If IsLeftMouseHeld Then + Log("[Control] 按下附加按钮" & If(ToolTip = "", "", "：" & ToolTip.ToString)) + RaiseEvent Click(sender, e) + e.Handled = True + Button_LeftMouseUp() + End If + End Sub + Private Sub Button_RightMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonUp + If IsRightMouseHeld Then + Log("[Control] 右键按下附加按钮" & If(ToolTip = "", "", "：" & ToolTip.ToString)) + RaiseEvent RightClick(sender, e) + e.Handled = True + Button_RightMouseUp() + End If + End Sub + Private _CanRightClick As Boolean = False + Public Property CanRightClick As Boolean + Get + Return _CanRightClick + End Get + Set(ByVal value As Boolean) + _CanRightClick = value + End Set + End Property + + '鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行） + Private IsLeftMouseHeld As Boolean = False + Private IsRightMouseHeld As Boolean = False + Private Sub Button_LeftMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonDown + If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then + AniStart({ + AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), + AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent) + }, "MyExtraButton Scale " & Uuid) + End If + IsLeftMouseHeld = True + Focus() + End Sub + Private Sub Button_RightMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseRightButtonDown + If Not CanRightClick Then Exit Sub + If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then + AniStart({ + AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), + AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent) + }, "MyExtraButton Scale " & Uuid) + End If + IsRightMouseHeld = True + Focus() + End Sub + Private Sub Button_LeftMouseUp() Handles PanClick.MouseLeftButtonUp + If Not IsRightMouseHeld Then + AniStart({ + AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack) + }, "MyExtraButton Scale " & Uuid) + End If + IsLeftMouseHeld = False + RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave + End Sub + Private Sub Button_RightMouseUp() Handles PanClick.MouseRightButtonUp + If Not CanRightClick Then Exit Sub + If Not IsLeftMouseHeld Then + AniStart({ + AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack) + }, "MyExtraButton Scale " & Uuid) + End If + IsRightMouseHeld = False + RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave + End Sub + Private Sub Button_MouseLeave() Handles PanClick.MouseLeave + IsLeftMouseHeld = False + IsRightMouseHeld = False + AniStart({ + AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent) + }, "MyExtraButton Scale " & Uuid) + RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave + End Sub + + '自定义事件 + '务必放在 IsMouseDown 更新之后 + Private Const AnimationColorIn As Integer = 120 + Private Const AnimationColorOut As Integer = 150 + Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded + Try + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + + If IsMouseOver Then + '指向 + AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush4", AnimationColorIn), "MyExtraButton Color " & Uuid) + Else + '普通 + AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush3", AnimationColorOut), "MyExtraButton Color " & Uuid) + End If + + Else + + AniStop("MyExtraButton Color " & Uuid) + If IsMouseOver Then + PanColor.SetResourceReference(BackgroundProperty, "ColorBrush2") + Else + PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3") + End If + + End If + Catch ex As Exception + Log(ex, "刷新图标按钮颜色出错") + End Try + End Sub + + ''' + ''' 发出一圈波浪效果提示。 + ''' + Public Sub Ribble() + RunInUi(Sub() + Dim Shape As New Border With {.CornerRadius = New CornerRadius(1000), .BorderThickness = New Thickness(0.001), .Opacity = 0.5, .RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransform = New ScaleTransform()} + Shape.SetResourceReference(Border.BackgroundProperty, "ColorBrush5") + PanScale.Children.Insert(0, Shape) + AniStart({ + AaScaleTransform(Shape, 13, 1000, Ease:=New AniEaseInoutFluent(AniEasePower.Strong, 0.3)), + AaOpacity(Shape, -Shape.Opacity, 1000), + AaCode(Sub() PanScale.Children.Remove(Shape), After:=True) + }, "ExtraButton Ribble " & GetUuid()) + End Sub) + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyHint.xaml b/Plain Craft Launcher 2/Controls/MyHint.xaml new file mode 100644 index 0000000..41570ca --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyHint.xaml @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Controls/MyHint.xaml.vb b/Plain Craft Launcher 2/Controls/MyHint.xaml.vb new file mode 100644 index 0000000..dd64166 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyHint.xaml.vb @@ -0,0 +1,82 @@ +Public Class MyHint + + Public Uuid As Integer = GetUuid() + + Private _IsWarn As Boolean = True + Public Property IsWarn As Boolean + Get + Return _IsWarn + End Get + Set(value As Boolean) + If _IsWarn = value Then Exit Property + _IsWarn = value + If _IsWarn Then + BorderBrush = New MyColor("#99FF4444") + Gradient1.Color = New MyColor("#88FFBBBB") + Gradient2.Color = New MyColor("#88FF8888") + 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 ") + Else + BorderBrush = New MyColor("#994D76FF") + Gradient1.Color = New MyColor("#88B0D0FF") + Gradient2.Color = New MyColor("#889EBAFF") + 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") + End If + End Set + End Property + + Public Property Text As String + Get + Return LabText.Text + End Get + Set(ByVal value As String) + LabText.Text = value + End Set + End Property + + Public Property CanClose As Boolean + Get + Return BtnClose.Visibility = Visibility.Visible + End Get + Set(ByVal value As Boolean) + BtnClose.Visibility = If(value, Visibility.Visible, Visibility.Collapsed) + End Set + End Property + + Public 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 + End Sub + Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click + Setup.Set(RelativeSetup, True) + AniDispose(Me, False) + End Sub + +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 + 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() + If RemoveFromChildren Then + CType(Control.Parent, Object).Children.Remove(Control) + Else + Control.Visibility = Visibility.Collapsed + End If + If CallBack IsNot Nothing Then CallBack(Control) + End Sub,, True) + }, "MyCard Dispose " & Control.Uuid) + End Sub +End Module diff --git a/Plain Craft Launcher 2/Controls/MyIconButton.xaml b/Plain Craft Launcher 2/Controls/MyIconButton.xaml new file mode 100644 index 0000000..5b4d8a0 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyIconButton.xaml @@ -0,0 +1,15 @@ + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb b/Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb new file mode 100644 index 0000000..aba7e65 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb @@ -0,0 +1,168 @@ +Public Class MyIconButton + + '声明 + Public Event Click(sender As Object, e As EventArgs) '自定义事件 + + '自定义属性 + + Public Uuid As Integer = GetUuid() + Public Property Logo As String + Get + Return Path.Data.ToString + End Get + Set(value As String) + Path.Data = (New GeometryConverter).ConvertFromString(value) + End Set + End Property + + Private _LogoScale As Double = 1 + Public Property LogoScale() As Double + Get + Return _LogoScale + End Get + Set(value As Double) + _LogoScale = value + If Not IsNothing(Path) Then Path.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale} + End Set + End Property + + Public Enum Themes + Color + White + Black + Custom + End Enum + Public Property Theme As Themes = Themes.Color + + Private _Foreground As New SolidColorBrush(Color.FromRgb(128, 128, 128)) + Public Property Foreground As SolidColorBrush + Get + Return _Foreground + End Get + Set(value As SolidColorBrush) + _Foreground = value + AniControlEnabled += 1 + RefreshAnim() + AniControlEnabled -= 1 + End Set + End Property + + '触发点击事件 + Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp + If IsMouseDown Then + Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", "：" & Name)) + RaiseEvent Click(sender, e) + e.Handled = True + Button_MouseUp() + End If + End Sub + + '鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行） + Private IsMouseDown As Boolean = False + Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown + IsMouseDown = True + Focus() + '指向 + AniStart(AaScaleTransform(PanBack, 0.8 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 400,, New AniEaseOutFluent(AniEasePower.Strong)), "MyIconButton Scale " & Uuid) + End Sub + Private Sub Button_MouseUp() Handles Me.MouseLeftButtonUp + If IsMouseDown Then + IsMouseDown = False + AniStart({ + AaScaleTransform(PanBack, 1.05 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 250,, New AniEaseOutBack(AniEasePower.Weak)), + AaScaleTransform(PanBack, -0.05, 250,, New AniEaseOutFluent(AniEasePower.Strong)) + }, "MyIconButton Scale " & Uuid) + End If + RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave + End Sub + Private Sub Button_MouseLeave() Handles Me.MouseLeave + IsMouseDown = False + AniStart({ + AaScaleTransform(PanBack, 1 - CType(PanBack.RenderTransform, ScaleTransform).ScaleX, 250,, New AniEaseOutFluent) + }, "MyIconButton Scale " & Uuid) + RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave + End Sub + + '自定义事件 + '务必放在 IsMouseDown 更新之后 + Private Const AnimationColorIn As Integer = 120 + Private Const AnimationColorOut As Integer = 150 + Public Sub RefreshAnim() Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded + Try + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + + If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255) + If Path.Fill Is Nothing AndAlso Theme = Themes.Black Then Path.Fill = New MyColor(140, 0, 0, 0) + If IsMouseOver Then + '指向 + Dim AnimList As New List(Of AniData) + Select Case Theme + Case Themes.Color + AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush2", AnimationColorIn)) + Case Themes.White + AnimList.Add(AaColor(PanBack, BackgroundProperty, New MyColor(50, 255, 255, 255) - PanBack.Background, AnimationColorIn)) + Case Themes.Black + AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(230, 0, 0, 0) - Path.Fill, AnimationColorIn)) + Case Themes.Custom + AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(255, Foreground) - Path.Fill, AnimationColorIn)) + End Select + AniStart(AnimList, "MyIconButton Color " & Uuid) + Else + '普通 + Dim AnimList As New List(Of AniData) + Select Case Theme + Case Themes.Color + AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush4", AnimationColorOut)) + PanBack.Background = New MyColor(0, 255, 255, 255) + Case Themes.White + AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush8", AnimationColorOut)) + AnimList.Add(AaColor(PanBack, BackgroundProperty, New MyColor(0, 255, 255, 255) - PanBack.Background, AnimationColorOut)) + Case Themes.Black + AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(160, 0, 0, 0) - Path.Fill, AnimationColorOut)) + PanBack.Background = New MyColor(0, 255, 255, 255) + Case Themes.Custom + AnimList.Add(AaColor(Path, Shape.FillProperty, New MyColor(160, Foreground) - Path.Fill, AnimationColorOut)) + PanBack.Background = New MyColor(0, 255, 255, 255) + End Select + AniStart(AnimList, "MyIconButton Color " & Uuid) + End If + + Else + + AniStop("MyIconButton Color " & Uuid) + Select Case Theme + Case Themes.Color + Path.SetResourceReference(Shape.FillProperty, "ColorBrush5") + Case Themes.White + Path.SetResourceReference(Shape.FillProperty, "ColorBrush8") + Case Themes.Black + Path.Fill = New MyColor(160, 0, 0, 0) + Case Themes.Custom + Path.Fill = New MyColor(160, Foreground) + End Select + PanBack.Background = New MyColor(0, 255, 255, 255) + + End If + Catch ex As Exception + Log(ex, "刷新图标按钮动画状态出错") + End Try + End Sub + +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 + Control.IsHitTestVisible = False + AniStart({ + AaScaleTransform(Control, -1.5, 200,, New AniEaseInFluent), + AaCode(Sub() + If RemoveFromChildren Then + CType(Control.Parent, Object).Children.Remove(Control) + Else + Control.Visibility = Visibility.Collapsed + End If + If CallBack IsNot Nothing Then CallBack(Control) + End Sub,, True) + }, "MyIconButton Dispose " & Control.Uuid) + End Sub +End Module diff --git a/Plain Craft Launcher 2/Controls/MyListItem.xaml b/Plain Craft Launcher 2/Controls/MyListItem.xaml new file mode 100644 index 0000000..8bcf167 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyListItem.xaml @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb new file mode 100644 index 0000000..d1842c1 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb @@ -0,0 +1,668 @@ +Public Class MyListItem + Implements IMyRadio + + Public Event Click(sender As Object, e As MouseButtonEventArgs) + Public Event LogoClick(sender As Object, e As MouseButtonEventArgs) + Public Event Check(sender As Object, e As RouteEventArgs) Implements IMyRadio.Check + Public Event Changed(sender As Object, e As RouteEventArgs) Implements IMyRadio.Changed + +#Region "后加载控件" + + '指向背景 + Private _RectBack As Border = Nothing + Public ReadOnly Property RectBack As Border + Get + If _RectBack Is Nothing Then + Dim Rect As New Border With { + .Name = "RectBack", + .CornerRadius = New CornerRadius(If(IsScaleAnimationEnabled, 6, 0)), + .RenderTransform = If(IsScaleAnimationEnabled, New ScaleTransform(0.8, 0.8), Nothing), + .RenderTransformOrigin = New Point(0.5, 0.5), + .BorderThickness = New Thickness(GetWPFSize(1)), + .SnapsToDevicePixels = True, + .IsHitTestVisible = False, + .Opacity = 0 + } + Rect.SetResourceReference(Border.BackgroundProperty, "ColorBrush7") + Rect.SetResourceReference(Border.BorderBrushProperty, "ColorBrush6") + SetColumnSpan(Rect, 999) + SetRowSpan(Rect, 999) + Children.Insert(0, Rect) + _RectBack = Rect + ' + End If + Return _RectBack + End Get + End Property + + '按钮 + Public ButtonStack As FrameworkElement + + '图标 + Public PathLogo As FrameworkElement + + '勾选条 + Public RectCheck As Border + + '副文本 + Private _LabInfo As TextBlock = Nothing + Public ReadOnly Property LabInfo As TextBlock + Get + If _LabInfo Is Nothing Then + Dim Lab As New TextBlock With { + .Name = "LabInfo", + .SnapsToDevicePixels = False, + .UseLayoutRounding = False, + .HorizontalAlignment = HorizontalAlignment.Left, + .IsHitTestVisible = False, + .TextTrimming = TextTrimming.CharacterEllipsis, + .Visibility = Visibility.Collapsed, + .FontSize = 12, + .Margin = New Thickness(4, 0, 0, 0), + .Opacity = 0.6 + } + SetColumn(Lab, 3) + SetRow(Lab, 2) + Children.Add(Lab) + _LabInfo = Lab + ' + End If + Return _LabInfo + End Get + End Property + +#End Region + +#Region "自定义属性" + + 'Uuid + Public Uuid As Integer = GetUuid() + + ''' + ''' 是否启用缩放动画。 + ''' + Public Property IsScaleAnimationEnabled As Boolean + Get + Return _IsScaleAnimationEnabled + End Get + Set + _IsScaleAnimationEnabled = Value + If _RectBack IsNot Nothing Then RectBack.CornerRadius = New CornerRadius(If(Value, 6, 0)) + End Set + End Property + Private _IsScaleAnimationEnabled As Boolean = True + + '边距 + Public Property PaddingLeft As Integer + Get + Return ColumnPaddingLeft.Width.Value + End Get + Set(value As Integer) + ColumnPaddingLeft.Width = New GridLength(value) + End Set + End Property + Public Property PaddingRight As Integer + Get + Return ColumnPaddingRight.Width.Value + End Get + Set(value As Integer) + ColumnPaddingRight.Width = New GridLength(value) + End Set + End Property + + '按钮 + Private _Buttons As IEnumerable + Public Property Buttons As IEnumerable + Get + Return _Buttons + End Get + Set(value As IEnumerable) + _Buttons = value + '没有特殊按钮，移除原 Stack + If Not IsNothing(ButtonStack) Then + Children.Remove(ButtonStack) + ButtonStack = Nothing + End If + '获取按钮数量 + Dim Count As Integer = 0 + For Each Counter In value + Count += 1 + Next + '添加新 Stack + Select Case Count + Case 0 + '没有按钮，不添加新的 + Case 1 + '只有一个按钮 + For Each Btn As MyIconButton In value + If Btn.Height.Equals(Double.NaN) Then Btn.Height = 23 + If Btn.Width.Equals(Double.NaN) Then Btn.Width = 23 + With Btn + .Opacity = 0 + .Margin = New Thickness(0, 0, 5, 0) + .SnapsToDevicePixels = False + .HorizontalAlignment = HorizontalAlignment.Right + .VerticalAlignment = VerticalAlignment.Center + .SnapsToDevicePixels = False + .UseLayoutRounding = False + End With + SetColumn(Btn, 4) + SetColumnSpan(Btn, 4) + SetRowSpan(Btn, 4) + Children.Add(Btn) + ButtonStack = Btn + Next + Case Else + '有复数按钮，使用 StackPanel + ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False} + SetColumn(ButtonStack, 4) + SetColumnSpan(ButtonStack, 4) + SetRowSpan(ButtonStack, 4) + '构造按钮 + For Each Btn As MyIconButton In value + If Btn.Height.Equals(Double.NaN) Then Btn.Height = 23 + If Btn.Width.Equals(Double.NaN) Then Btn.Width = 23 + CType(ButtonStack, StackPanel).Children.Add(Btn) + Next + Children.Add(ButtonStack) + End Select + End Set + End Property + + '标题 + Public Property Title As String + Get + Return GetValue(TitleProperty) + End Get + Set(value As String) + SetValue(TitleProperty, value) + End Set + End Property + Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyListItem)) + + '字号 + Public Property FontSize As Double + Get + Return GetValue(FontSizeProperty) + End Get + Set(value As Double) + SetValue(FontSizeProperty, value) + End Set + End Property + Public Shared ReadOnly FontSizeProperty As DependencyProperty = DependencyProperty.Register("FontSize", GetType(Double), GetType(MyListItem), New PropertyMetadata(CType(14, Double))) + + '信息 + Private _Info As String = "" + Public Property Info As String + Get + Return _Info + End Get + Set(value As String) + If _Info = value Then Exit Property + value = value.Replace(vbCr, "").Replace(vbLf, "") + _Info = value + LabInfo.Text = value + LabInfo.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible) + End Set + End Property + + '图片 + Private _Logo As String = "" + Public Property Logo As String + Get + Return _Logo + End Get + Set(value As String) + If _Logo = value Then Exit Property + _Logo = value + '删除旧 Logo + If Not IsNothing(PathLogo) Then Children.Remove(PathLogo) + '添加新 Logo + If Not _Logo = "" Then + If _Logo.ToLower.StartsWith("http") Then + '网络图片 + PathLogo = New Image With { + .IsHitTestVisible = LogoClickable, + .Source = New ImageSourceConverter().ConvertFromString(_Logo), + .RenderTransformOrigin = New Point(0.5, 0.5), + .RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}, + .SnapsToDevicePixels = True, .UseLayoutRounding = False} + RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear) + ElseIf _Logo.ToLower.EndsWith(".png") Then + '位图 + Dim Bitmap = New MyBitmap(_Logo) + PathLogo = New Canvas With { + .IsHitTestVisible = LogoClickable, + .Background = Bitmap, + .RenderTransformOrigin = New Point(0.5, 0.5), + .RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}, + .SnapsToDevicePixels = True, .UseLayoutRounding = False} + 'If Bitmap.Pic.Width = 16 AndAlso Bitmap.Pic.Height = 16 Then + ' '使用最适合 16x16 物品图片显示的大小 + ' RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.NearestNeighbor) + ' PathLogo.HorizontalAlignment = HorizontalAlignment.Center : PathLogo.VerticalAlignment = VerticalAlignment.Center + ' PathLogo.Width = GetWPFSize(Math.Floor(GetPixelSize(32) / 16) * 16) : PathLogo.Height = PathLogo.Width + 'Else + PathLogo.HorizontalAlignment = HorizontalAlignment.Stretch : PathLogo.VerticalAlignment = VerticalAlignment.Stretch + RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.HighQuality) + 'End If + Else + '矢量图 + PathLogo = New Shapes.Path With { + .IsHitTestVisible = LogoClickable, .HorizontalAlignment = HorizontalAlignment.Center, .VerticalAlignment = VerticalAlignment.Center, .Stretch = Stretch.Uniform, + .Data = (New GeometryConverter).ConvertFromString(_Logo), + .RenderTransformOrigin = New Point(0.5, 0.5), + .RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}, + .SnapsToDevicePixels = False, .UseLayoutRounding = False} + PathLogo.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = Me}) + End If + SetColumn(PathLogo, 2) + SetRowSpan(PathLogo, 4) + OnSizeChanged() '设置边距 + Children.Add(PathLogo) + '图标的点击事件 + If LogoClickable Then + AddHandler PathLogo.MouseLeave, Sub(sender, e) IsLogoDown = False + AddHandler PathLogo.MouseLeftButtonDown, Sub(sender, e) IsLogoDown = True + AddHandler PathLogo.MouseLeftButtonUp, Sub(sender, e) If IsLogoDown Then IsLogoDown = False : RaiseEvent LogoClick(sender, e) + End If + End If + '改变行距 + ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4)) + End Set + End Property + Private _LogoScale As Double = 1 + Public Property LogoScale() As Double + Get + Return _LogoScale + End Get + Set(value As Double) + _LogoScale = value + If Not IsNothing(PathLogo) Then PathLogo.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale} + End Set + End Property + + '图标的点击 + Public Property LogoClickable As Boolean = False + Private IsLogoDown As Boolean = False + + '勾选选项 + Public Enum CheckType + None + Clickable + RadioBox + CheckBox + End Enum + Private _Type As CheckType = CheckType.None + Public Property Type As CheckType + Get + Return _Type + End Get + Set(value As CheckType) + If _Type = value Then Exit Property + _Type = value + '切换左栏大小 + ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6)) + '切换竖条控件 + If _Type = CheckType.None OrElse _Type = CheckType.Clickable Then + '移除竖条控件 + If Not IsNothing(RectCheck) Then + Children.Remove(RectCheck) + RectCheck = Nothing + End If + SetChecked(False, False, False) + Else + '添加竖条控件 + If IsNothing(RectCheck) Then + RectCheck = New Border With {.Width = 5, .Height = If(Checked, Double.NaN, 0), .CornerRadius = New CornerRadius(2, 2, 2, 2), + .VerticalAlignment = If(Checked, VerticalAlignment.Stretch, VerticalAlignment.Center), .HorizontalAlignment = HorizontalAlignment.Left, .UseLayoutRounding = False, .SnapsToDevicePixels = False, + .Margin = If(Checked, New Thickness(-1, 6, 0, 6), New Thickness(-1, 0, 0, 0))} + RectCheck.SetResourceReference(Border.BackgroundProperty, "ColorBrush3") + SetRowSpan(RectCheck, 4) + Children.Add(RectCheck) + End If + End If + End Set + End Property + + '适应尺寸 + Private Sub OnSizeChanged() Handles Me.SizeChanged + ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6)) + ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4)) + If Not IsNothing(PathLogo) Then + If _Logo.EndsWith(".png") Then + PathLogo.Margin = New Thickness(4, 5, 3, 5) + Else + PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8) + End If + End If + LabTitle.Margin = New Thickness(4, 0, 0, If(Height < 40, 0, 2)) + End Sub + + '勾选状态 + Private _Checked As Boolean = False + Public Property Checked As Boolean + Get + Return _Checked + End Get + Set(value As Boolean) + SetChecked(value, False, True) + End Set + End Property + ''' + ''' 手动设置 Checked 属性。 + ''' + ''' 新的 Checked 属性。 + ''' 是否由用户引发。 + ''' 是否执行动画。 + Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean) + Try + + '自定义属性基础 + + Dim ChangedEventArgs As New RouteEventArgs(user) + Dim RawValue = _Checked + If Type = CheckType.RadioBox Then + If IsInitialized AndAlso Not value = _Checked Then + _Checked = value + RaiseEvent Changed(Me, ChangedEventArgs) + If ChangedEventArgs.Handled Then + _Checked = RawValue + Exit Sub + End If + End If + _Checked = value + Else + If value = _Checked Then Exit Sub + _Checked = value + If IsInitialized Then + RaiseEvent Changed(Me, ChangedEventArgs) + If ChangedEventArgs.Handled Then + _Checked = RawValue + Exit Sub + 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 + End If + + '保证只有一个单选 ListItem 选中 + + If Type = CheckType.RadioBox Then + If IsNothing(Parent) Then Exit Sub + Dim RadioboxList As New List(Of MyListItem) + Dim CheckedCount As Integer = 0 + '收集控件列表与选中个数 + For Each Control In CType(Parent, Object).Children + If TypeOf Control Is MyListItem AndAlso CType(Control, MyListItem).Type = CheckType.RadioBox Then + RadioboxList.Add(Control) + If Control.Checked Then CheckedCount += 1 + End If + Next + '判断选中情况 + Select Case CheckedCount + Case 0 + '没有任何单选框被选中，选择第一个 + RadioboxList(0).Checked = True + Case Is > 1 + '选中项目多于 1 个 + If Me.Checked Then + '如果本控件选中，则取消其他所有控件的选中 + For Each Control As MyListItem In RadioboxList + If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False + Next + Else + '如果本控件未选中，则只保留第一个选中的控件 + Dim FirstChecked = False + For Each Control As MyListItem In RadioboxList + If Control.Checked Then + If FirstChecked Then + Control.Checked = False '修改 Checked 会自动触发 Change 事件，所以不用额外触发 + Else + FirstChecked = True + End If + End If + Next + End If + End Select + End If + + '更改动画 + + If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画 + Dim Anim As New List(Of AniData) + If Checked Then + '由无变有 + If Not IsNothing(RectCheck) Then + Dim Delta = ActualHeight - RectCheck.ActualHeight - 12 + Anim.Add(AaHeight(RectCheck, Delta * 0.4, 200,, New AniEaseOutFluent(AniEasePower.Weak))) + Anim.Add(AaHeight(RectCheck, Delta * 0.6, 300,, New AniEaseOutBack(AniEasePower.Weak))) + Anim.Add(AaOpacity(RectCheck, 1 - RectCheck.Opacity, 30)) + RectCheck.VerticalAlignment = VerticalAlignment.Center + RectCheck.Margin = New Thickness(-1, 0, 0, 0) + End If + Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush3", 200)) + Else + '由有变无 + If Not IsNothing(RectCheck) Then + 'Anim.Add(AaWidth(RectCheck, -RectCheck.Width, 120,, New AniEaseInFluent)) + Anim.Add(AaHeight(RectCheck, -RectCheck.ActualHeight, 120,, New AniEaseInFluent(AniEasePower.Weak))) + Anim.Add(AaOpacity(RectCheck, -RectCheck.Opacity, 70, 40)) + RectCheck.VerticalAlignment = VerticalAlignment.Center + End If + Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush1", 120)) + End If + AniStart(Anim, "MyListItem Checked " & Uuid) + Else + '不使用动画 + If Checked Then + 'If Not IsNothing(RectCheck) Then RectCheck.Width = 4 + If Not IsNothing(RectCheck) Then + RectCheck.Height = Double.NaN + RectCheck.Margin = New Thickness(-1, 6, 0, 6) + RectCheck.Opacity = 1 + RectCheck.VerticalAlignment = VerticalAlignment.Stretch + End If + SetResourceReference(ForegroundProperty, "ColorBrush3") + Else + 'If Not IsNothing(RectCheck) Then RectCheck.Width = 0 + If Not IsNothing(RectCheck) Then + RectCheck.Height = 0 + RectCheck.Margin = New Thickness(-1, 0, 0, 0) + RectCheck.Opacity = 0 + RectCheck.VerticalAlignment = VerticalAlignment.Center + End If + SetResourceReference(ForegroundProperty, "ColorBrush1") + End If + End If + + Catch ex As Exception + Log(ex, "设置 Checked 失败") + End Try + End Sub + + '前景色绑定 + Public Property Foreground As Brush + Get + Return GetValue(ForegroundProperty) + End Get + Set(value As Brush) + SetValue(ForegroundProperty, value) + End Set + End Property + Public Shared ReadOnly ForegroundProperty As DependencyProperty = DependencyProperty.Register("Foreground", GetType(Brush), GetType(MyListItem), New PropertyMetadata(CType(Color1, SolidColorBrush))) + + '菜单与按钮绑定 + Public ContentHandler As Action(Of MyListItem, EventArgs) + +#End Region + +#Region "点击" + + '触发点击事件 + 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 Not String.IsNullOrEmpty(EventType) Then + ModEvent.TryStartEvent(EventType, EventData) + e.Handled = True + End If + If e.Handled Then Exit Sub + '实际的单击处理 + Select Case Type + Case CheckType.Clickable + Log("[Control] 按下单击列表项：" & Title) + Case CheckType.RadioBox + Log("[Control] 按下单选列表项：" & Title) + If Not Checked Then SetChecked(True, True, True) + Case CheckType.CheckBox + Log("[Control] 按下复选列表项（" & (Not Checked).ToString & "）：" & Title) + SetChecked(Not Checked, True, True) + End Select + End If + 'AniStart({ + ' AaScaleTransform(Me, 1.004 - CType(RenderTransform, ScaleTransform).ScaleX, 150,, New AniEaseOutFluent), + ' AaScaleTransform(Me, -0.004, 100, 150, New AniEaseInFluent) + ' }, "MyListItem Scale " & Uuid) + End Sub + + '鼠标点击判定 + Private IsMouseDown As Boolean = False + Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown + If IsMouseDirectlyOver AndAlso Not Type = CheckType.None Then + IsMouseDown = True + If Not IsNothing(ButtonStack) Then ButtonStack.IsHitTestVisible = False + End If + 'AniStart({ + ' AaScaleTransform(Me, 0.985 - CType(RenderTransform, ScaleTransform).ScaleX, 50,, New AniEaseOutFluent) + ' }, "MyListItem Scale " & Uuid) + End Sub + Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp + IsMouseDown = False + If Not IsNothing(ButtonStack) Then ButtonStack.IsHitTestVisible = True + End Sub + + '实现自定义事件 + Public Property EventType As String + Get + Return GetValue(EventTypeProperty) + End Get + Set(value As String) + SetValue(EventTypeProperty, value) + End Set + End Property + Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyListItem), New PropertyMetadata(Nothing)) + Public Property EventData As String + Get + Return GetValue(EventDataProperty) + End Get + Set(value As String) + SetValue(EventDataProperty, value) + End Set + End Property + Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyListItem), New PropertyMetadata(Nothing)) + +#End Region + + Private StateLast As String + Public IsMouseOverAnimationEnabled As Boolean = True + Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp + '菜单虚拟化检测 + If ContentHandler IsNot Nothing Then + ContentHandler(sender, e) + ContentHandler = Nothing + End If + '判断当前颜色 + Dim StateNew As String, Time As Integer + If IsMouseDown AndAlso Not (Type = CheckType.RadioBox AndAlso Checked) Then + StateNew = "MouseDown" + Time = 120 + Else + If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then + StateNew = "MouseOver" + Time = 120 + Else + StateNew = "Idle" + Time = 180 + End If + End If + If StateLast = StateNew Then Exit Sub + StateLast = StateNew + '触发颜色动画 + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + '有动画 + Dim Ani As New List(Of AniData) + If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then + If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3)) + Ani.AddRange({ + AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush9"), Time), + AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent) + }) + If IsScaleAnimationEnabled Then + Ani.Add(AaScaleTransform(RectBack, 1 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.6,, New AniEaseOutFluent)) + If IsMouseDown Then + Ani.Add(AaScaleTransform(Me, 0.98 - CType(Me.RenderTransform, ScaleTransform).ScaleX, Time * 0.9,, New AniEaseOutFluent)) + Else + Ani.Add(AaScaleTransform(Me, 1 - CType(Me.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent)) + End If + End If + Else + If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.5)) + Ani.Add(AaOpacity(RectBack, -RectBack.Opacity, Time)) + If IsScaleAnimationEnabled Then Ani.AddRange({ + AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time), + AaScaleTransform(Me, 1 - CType(Me.RenderTransform, ScaleTransform).ScaleX, Time * 3,, New AniEaseOutFluent), + AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent), + AaScaleTransform(RectBack, -0.246, 1,,, True) + }) + End If + AniStart(Ani, "ListItem Color " & Uuid) + Else + '无动画 + If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then + If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 1 + '由于鼠标已经移入，所以直接实例化 RectBack + RectBack.Background = Color9 + RectBack.Opacity = 1 + RectBack.RenderTransform = New ScaleTransform(1, 1) + Me.RenderTransform = New ScaleTransform(1, 1) + Else + If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 0 + Me.RenderTransform = New ScaleTransform(1, 1) + If _RectBack IsNot Nothing Then + If IsScaleAnimationEnabled Then RectBack.Background = Color7 + RectBack.Opacity = 0 + RectBack.RenderTransform = New ScaleTransform(0.75, 0.75) + End If + End If + AniStop("ListItem Color " & Uuid) + End If + End Sub + + Private Sub MyListItem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + If Checked Then + SetResourceReference(ForegroundProperty, "ColorBrush3") + Else + SetResourceReference(ForegroundProperty, "ColorBrush1") + End If + If EventType = "打开帮助" Then + Try + Dim NewElem = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me) + Catch ex As Exception + Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox) + End Try + End If + End Sub + Public Overrides Function ToString() As String + Return Title + End Function + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyLoading.xaml b/Plain Craft Launcher 2/Controls/MyLoading.xaml new file mode 100644 index 0000000..5084046 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyLoading.xaml @@ -0,0 +1,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MyLoading.xaml.vb b/Plain Craft Launcher 2/Controls/MyLoading.xaml.vb new file mode 100644 index 0000000..8fca7bd --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyLoading.xaml.vb @@ -0,0 +1,313 @@ +Imports PCL.MyLoading + +Public Class MyLoading + + Public Event IsErrorChanged(sender As Object, isError As Boolean) + Public Event StateChanged(sender As Object, newState As MyLoadingState, oldState As MyLoadingState) + Public Event Click(sender As Object, e As MouseButtonEventArgs) + + Public Property AutoRun As Boolean = True + Private Uuid As Integer = GetUuid() + +#Region "颜色" + + Public Property Foreground As SolidColorBrush + Get + Return GetValue(ForegroundProperty) + End Get + Set(value As SolidColorBrush) + SetValue(ForegroundProperty, value) + End Set + End Property + Public Shared ReadOnly ForegroundProperty As DependencyProperty = DependencyProperty.Register("Foreground", GetType(SolidColorBrush), GetType(MyLoading)) + Public Sub New() + InitializeComponent() + SetResourceReference(ForegroundProperty, "ColorBrush3") + End Sub + +#End Region + +#Region "文本" + + Private Property _ShowProgress As Boolean = False + Public Property ShowProgress As Boolean + Get + Return _ShowProgress + End Get + Set(value As Boolean) + If _ShowProgress = value Then Exit Property + _ShowProgress = value + RefreshText() + End Set + End Property + + Private _Text As String = "加载中" + Public Property Text As String + Get + Return _Text + End Get + Set(ByVal value As String) + _Text = value + RefreshText() + End Set + End Property + + Private _TextError As String = "加载失败" + Public Property TextError As String + Get + Return _TextError + End Get + Set(ByVal value As String) + _TextError = value + RefreshText() + End Set + End Property + ''' + ''' 是否在使用 Loader 时使用 Loader 的错误输出来替换默认的错误文本显示。 + ''' + Public Property TextErrorInherit As Boolean = True + + Private Sub RefreshText() Handles Me.IsErrorChanged, Me.Loaded + If InnerState = MyLoadingState.Error Then + If TextErrorInherit AndAlso State.IsLoader Then + Dim Ex As Exception = CType(State, Object).Error + If Ex Is Nothing Then + LabText.Text = "未知错误" + Else + Do While Ex.InnerException IsNot Nothing + Ex = Ex.InnerException + Loop + LabText.Text = StrTrim(Ex.Message) + If LabText.Text.Contains("远程主机强迫关闭了一个现有的连接") OrElse LabText.Text.Contains("操作已超时") OrElse LabText.Text.Contains("操作超时") OrElse LabText.Text.Contains("服务器超时") OrElse LabText.Text.Contains("连接超时") Then LabText.Text = "网络环境不佳，请重试或尝试使用 VPN" + End If + Else + LabText.Text = TextError + End If + Else + If ShowProgress AndAlso State.IsLoader Then + LabText.Text = Text & " - " & Math.Floor(CType(State, Object).Progress * 100) & "%" + Else + LabText.Text = Text + End If + End If + End Sub + +#End Region + +#Region "状态改变" + + '状态枚举 + Public Enum MyLoadingState + Unloaded = -1 + Run = 0 + [Stop] = 1 + [Error] = 2 + End Enum + + '用于外部改变的公开状态 + Private WithEvents _State As ILoadingTrigger + Public Property State As ILoadingTrigger + Get + InitState() + Return _State + End Get + Set(value As ILoadingTrigger) + _State = value + RefreshState() + End Set + End Property + Private Sub InitState() Handles Me.Loaded + If _State Is Nothing Then + _State = New MyLoadingStateSimulator + If AutoRun Then _State.LoadingState = MyLoadingState.Run + End If + End Sub + Private Sub RefreshState() Handles _State.LoadingStateChanged, Me.Loaded, Me.Unloaded + If _State.LoadingState = MyLoadingState.Run AndAlso Not IsLoaded Then InnerState = MyLoadingState.Stop + InnerState = _State.LoadingState + OuterState = _State.LoadingState + AniLoop() + End Sub + + '用于引发外部事件的状态 + Private Property _OuterState As MyLoadingState = MyLoadingState.Unloaded + Private Property OuterState As MyLoadingState + Get + Return _OuterState + End Get + Set(value As MyLoadingState) + If _OuterState = value Then Exit Property + Dim OldValue = _OuterState + _OuterState = value + '引发事件 + RaiseEvent StateChanged(Me, value, OldValue) + If (OldValue = MyLoadingState.Error) <> (value = MyLoadingState.Error) Then RaiseEvent IsErrorChanged(Me, value = MyLoadingState.Error) + End Set + End Property + + + '用于引发内部动画事件的状态 + Private Property _InnerState As MyLoadingState = MyLoadingState.Unloaded + Private Property InnerState As MyLoadingState + Get + Return _InnerState + End Get + Set(value As MyLoadingState) + If _InnerState = value Then Exit Property + Dim OldValue = _InnerState + _InnerState = value + '引发事件 + AniLoop() + If (OldValue = MyLoadingState.Error) <> (value = MyLoadingState.Error) Then ErrorAnimation(Me, value = MyLoadingState.Error) + End Set + End Property + +#End Region + +#Region "动画" + + ''' + ''' 是否需要动画。 + ''' + Public Property HasAnimation As Boolean = True + + ''' + ''' 主动画循环是否正在运行中。 + ''' + 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 + IsLooping = True + ErrorAnimationWaiting = True + If ShowProgress Then + RefreshText() + AniStart({ + AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)), + AaCode(AddressOf RefreshText, 100), '这是为了省下一个 Timer 线程…… + AaCode(AddressOf RefreshText, 200), + AaCode(AddressOf RefreshText, 300), + AaCode(AddressOf RefreshText, 400), + AaCode(AddressOf RefreshText, 500), + AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True), + AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)), + AaCode(Sub() + PathLeft.Opacity = 1 + PathLeft.Margin = New Thickness(7, 41, 0, 0) + PathRight.Opacity = 1 + PathRight.Margin = New Thickness(14, 41, 0, 0) + ErrorAnimationWaiting = False + RefreshText() + End Sub), + AaCode(AddressOf RefreshText, 100), + AaCode(AddressOf RefreshText, 200), + AaCode(AddressOf RefreshText, 300), + AaCode(AddressOf RefreshText, 400), + AaCode(AddressOf RefreshText, 500), + AaCode(AddressOf RefreshText, 600), + AaCode(AddressOf RefreshText, 700), + AaCode(AddressOf RefreshText, 800), + AaOpacity(PathLeft, -1, 100, 70), + AaX(PathLeft, -5, 180, 20, New AniEaseOutFluent), + AaY(PathLeft, -6, 180, 20, New AniEaseOutFluent), + AaOpacity(PathRight, -1, 100, 70), + AaX(PathRight, 5, 180, 20, New AniEaseOutFluent), + AaY(PathRight, -6, 180, 20, New AniEaseOutFluent), + AaCode(Sub() + IsLooping = False + AniLoop() + End Sub,, True) + }, "MyLoader Loop " & Uuid & "/" & GetUuid()) + Else + AniStart({ + AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)), + AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True), + AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)), + AaCode(Sub() + PathLeft.Opacity = 1 + PathLeft.Margin = New Thickness(7, 41, 0, 0) + PathRight.Opacity = 1 + PathRight.Margin = New Thickness(14, 41, 0, 0) + ErrorAnimationWaiting = False + End Sub), + AaOpacity(PathLeft, -1, 100, 50), + AaX(PathLeft, -5, 180,, New AniEaseOutFluent), + AaY(PathLeft, -6, 180,, New AniEaseOutFluent), + AaOpacity(PathRight, -1, 100, 50), + AaX(PathRight, 5, 180,, New AniEaseOutFluent), + AaY(PathRight, -6, 180,, New AniEaseOutFluent), + AaCode(Sub() + IsLooping = False + AniLoop() + End Sub,, True) + }, "MyLoader Loop " & Uuid & "/" & GetUuid()) + End If + End Sub + + ''' + ''' 镐子是否还没挥下去，要求错误动画等待。 + ''' + Private ErrorAnimationWaiting As Boolean = False + Private Sub ErrorAnimation(sender As Object, isError As Boolean) + If isError Then + '非错误变为错误 + Dim Wait As Integer = If(ErrorAnimationWaiting, 400, 0) + AniStart({ + AaColor(PanBack, ForegroundProperty, "ColorBrushRedLight", 300), + AaOpacity(PathError, 1 - PathError.Opacity, 100, 300 + Wait), + AaScaleTransform(PathError, 1 - CType(PathError.RenderTransform, ScaleTransform).ScaleX, 400, 300 + Wait, New AniEaseOutBack) + }, "MyLoader Error " & Uuid) + Else + '错误变为非错误 + AniStart({ + AaOpacity(PathError, -PathError.Opacity, 100), + AaScaleTransform(PathError, 0.5 - CType(PathError.RenderTransform, ScaleTransform).ScaleX, 200), + AaColor(PanBack, ForegroundProperty, "ColorBrush3", 300) + }, "MyLoader Error " & Uuid) + End If + End Sub + +#End Region + +#Region "点击事件" + + Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp + RaiseEvent Click(sender, e) + End Sub + Private IsMouseDown As Boolean = False + Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown + '鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行） + IsMouseDown = True + End Sub + Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.MouseLeftButtonUp + IsMouseDown = False + End Sub + +#End Region + +End Class + +Public Interface ILoadingTrigger + ReadOnly Property IsLoader As Boolean + Property LoadingState As MyLoadingState + Event LoadingStateChanged(NewState As MyLoadingState, OldState As MyLoadingState) +End Interface + +Public Class MyLoadingStateSimulator + Implements ILoadingTrigger + Private Property _LoadingState As MyLoadingState = MyLoadingState.Unloaded + Public Property LoadingState As MyLoadingState Implements ILoadingTrigger.LoadingState + Get + Return _LoadingState + End Get + Set(value As MyLoadingState) + If _LoadingState = value Then Exit Property + Dim OldState = _LoadingState + _LoadingState = value + RaiseEvent LoadingStateChanged(value, OldState) + End Set + End Property + Public ReadOnly Property IsLoader As Boolean = False Implements ILoadingTrigger.IsLoader + + Public Event LoadingStateChanged(NewState As MyLoadingState, OldState As MyLoadingState) Implements ILoadingTrigger.LoadingStateChanged +End Class diff --git a/Plain Craft Launcher 2/Controls/MyMenuItem.vb b/Plain Craft Launcher 2/Controls/MyMenuItem.vb new file mode 100644 index 0000000..fbf8082 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyMenuItem.vb @@ -0,0 +1,55 @@ +Public Class MyMenuItem + Inherits MenuItem + + Private Sub MyMenuItem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + If Icon IsNot Nothing Then + Dim IconControl As Shapes.Path = GetTemplateChild("Icon") + If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon) + End If + End Sub + + '基础 + + Public Uuid As Integer = GetUuid() + + '指向动画 + + Private Const AnimationTimeIn As Integer = 100 + Private Const AnimationTimeOut As Integer = 200 + Private ColorName As String + Private Sub RefreshColor() Handles Me.MouseEnter, Me.MouseLeave, Me.IsEnabledChanged + '判断当前颜色 + Dim BackName As String, ForeName As String + Dim Time As Integer + If Not IsEnabled Then + BackName = "ColorBrushTransparent" + ForeName = "ColorBrushGray5" + Time = AnimationTimeOut + ElseIf IsMouseOver Then + BackName = "ColorBrush6" + ForeName = "ColorBrush2" + Time = AnimationTimeIn + Else + BackName = "ColorBrushTransparent" + ForeName = "ColorBrush1" + Time = AnimationTimeOut + End If + '重复性验证 + If ColorName = BackName Then Exit Sub + ColorName = BackName + '触发颜色动画 + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + '有动画 + AniStart({ + AaColor(Me, BackgroundProperty, BackName, Time), + AaColor(Me, ForegroundProperty, ForeName, Time) + }, "MyMenuItem Color " & Uuid) + Else + '无动画 + AniStop("MyMenuItem Color " & Uuid) + SetResourceReference(BackgroundProperty, BackName) + SetResourceReference(ForegroundProperty, ForeName) + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml new file mode 100644 index 0000000..f3767ab --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml @@ -0,0 +1,23 @@ + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb new file mode 100644 index 0000000..6ddfa8f --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgInput.xaml.vb @@ -0,0 +1,134 @@ +Public Class MyMsgInput + + Private ReadOnly MyConverter As MyMsgBoxConverter + Private ReadOnly Uuid As Integer = GetUuid() + + Public Sub New(Converter As MyMsgBoxConverter) + Try + + InitializeComponent() + Btn1.Name = Btn1.Name & GetUuid() + Btn2.Name = Btn2.Name & GetUuid() + Btn3.Name = Btn3.Name & GetUuid() + MyConverter = Converter + LabTitle.Text = Converter.Title + TextCaption.Text = Converter.Content + TextCaption.HintText = Converter.HintText + TextCaption.ValidateRules = Converter.ValidateRules + Btn1.Text = Converter.Button1 + If Converter.IsWarn Then + Btn1.ColorType = MyButton.ColorState.Red + LabTitle.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrushRedLight") + ShapeLine.SetResourceReference(Rectangle.FillProperty, "ColorBrushRedLight") + End If + Btn2.Text = Converter.Button2 + Btn3.Text = Converter.Button3 + Btn2.Visibility = If(Converter.Button2 = "", Visibility.Collapsed, Visibility.Visible) + Btn3.Visibility = If(Converter.Button3 = "", Visibility.Collapsed, Visibility.Visible) + 'If Converter.Caption > 0 Then + ' TextCaption.Focus() + ' TextCaption.Select(Converter.Caption.Length - 1, 0) + 'End If + + Catch ex As Exception + Log(ex, "输入弹窗初始化失败", LogLevel.Hint) + End Try + End Sub + + Private Sub Load(sender As Object, e As EventArgs) Handles MyBase.Loaded + Try + + 'UI 初始化 + If Btn2.IsVisible AndAlso Not Btn1.ColorType = MyButton.ColorState.Red Then Btn1.ColorType = MyButton.ColorState.Highlight + ShapeLine.StrokeThickness = GetWPFSize(1) + Measure(New Size(FrmMain.Width, FrmMain.Height)) + Arrange(New Rect(0, 0, FrmMain.Width, FrmMain.Height)) + If FrmMain.Width - ActualWidth < 20 Then Width = FrmMain.Width - GetWPFSize(2) + TextCaption.Focus() + '动画 + AniStart({ + AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(60, 0, 0, 0), 250, , New AniEaseInFluent), + AaColor(PanBorder, Border.BackgroundProperty, New MyColor(255, 0, 0, 0), 150, , New AniEaseInFluent), + AaOpacity(EffectShadow, 0.75, 400, 50), + AaWidth(ShapeLine, ShapeLine.ActualWidth, 250, 100, New AniEaseOutFluent), + AaOpacity(ShapeLine, 1, 200, 100), + AaWidth(LabTitle, LabTitle.ActualWidth, 200, 100, New AniEaseOutFluent), + AaOpacity(LabTitle, 1, 150, 150), + AaOpacity(PanCaption, 1, 150, 150), + AaOpacity(Btn1, 1, 150, 100), + AaOpacity(Btn2, 1, 150, 150), + AaOpacity(Btn3, 1, 150, 200), + AaCode(Sub() + ShapeLine.MinWidth = ShapeLine.ActualWidth + ShapeLine.HorizontalAlignment = HorizontalAlignment.Stretch + ShapeLine.Width = Double.NaN + LabTitle.Width = Double.NaN + LabTitle.TextTrimming = TextTrimming.CharacterEllipsis + End Sub, 350) + }, "MyMsgBox Start " & Uuid) + '动画初始化 + ShapeLine.Width = 0 + ShapeLine.HorizontalAlignment = HorizontalAlignment.Center + LabTitle.Width = 0 + LabTitle.Opacity = 0 + LabTitle.TextWrapping = TextWrapping.NoWrap + PanCaption.Opacity = 0 + '记录日志 + Log("[Control] 输入弹窗：" & LabTitle.Text) + + Catch ex As Exception + Log(ex, "输入弹窗加载失败", LogLevel.Hint) + End Try + End Sub + Private Sub Close() + '结束线程阻塞 + MyConverter.WaitFrame.Continue = False + Interop.ComponentDispatcher.PopModal() + '弹窗动画 + LabTitle.TextTrimming = TextTrimming.None + LabTitle.TextWrapping = TextWrapping.NoWrap + AniStart({ + AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(-60, 0, 0, 0), 350, , New AniEaseInFluent), + AaColor(PanBorder, Border.BackgroundProperty, New MyColor(-255, 0, 0, 0), 300, 100, New AniEaseInFluent), + AaOpacity(EffectShadow, -0.75, 150), + AaWidth(ShapeLine, -ShapeLine.ActualWidth, 250, , New AniEaseInFluent), + AaOpacity(ShapeLine, -1, 150, 100), + AaWidth(LabTitle, -LabTitle.ActualWidth, 250), + AaOpacity(LabTitle, -1, 200), + AaOpacity(PanCaption, -1, 200), + AaOpacity(Btn1, -1, 150), + AaOpacity(Btn2, -1, 150, 50), + AaOpacity(Btn3, -1, 150, 100), + AaCode(Sub() CType(Parent, Grid).Children.Remove(Me), , True) + }, "MyMsgBox Close " & Uuid) + End Sub + + Public Sub Btn1_Click() Handles Btn1.Click + If MyConverter.IsExited OrElse Not TextCaption.ValidateResult = "" Then Exit Sub + MyConverter.IsExited = True + MyConverter.Result = TextCaption.Text + Close() + End Sub + Private Sub Btn2_Click() Handles Btn2.Click + If MyConverter.IsExited Then Exit Sub + MyConverter.IsExited = True + MyConverter.Result = Nothing + Close() + End Sub + Private Sub Btn3_Click() Handles Btn3.Click + If MyConverter.IsExited Then Exit Sub + MyConverter.IsExited = True + MyConverter.Result = Nothing + Close() + End Sub + + Private Sub TextCaption_ValidateChanged(sender As Object, e As EventArgs) Handles TextCaption.ValidateChanged + Btn1.IsEnabled = TextCaption.ValidateResult = "" + End Sub + + Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown + On Error Resume Next + If e.GetPosition(ShapeLine).Y <= 2 Then FrmMain.DragMove() + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml new file mode 100644 index 0000000..6965e8f --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb new file mode 100644 index 0000000..6174649 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb @@ -0,0 +1,138 @@ +Public Class MyMsgSelect + + Private ReadOnly MyConverter As MyMsgBoxConverter + Private ReadOnly Uuid As Integer = GetUuid() + + Public Sub New(Converter As MyMsgBoxConverter) + Try + + InitializeComponent() + Btn1.Name = Btn1.Name & GetUuid() + Btn2.Name = Btn2.Name & GetUuid() + Btn3.Name = Btn3.Name & GetUuid() + MyConverter = Converter + LabTitle.Text = Converter.Title + Btn1.Text = Converter.Button1 + If Converter.IsWarn Then + Btn1.ColorType = MyButton.ColorState.Red + LabTitle.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrushRedLight") + ShapeLine.SetResourceReference(Rectangle.FillProperty, "ColorBrushRedLight") + End If + Btn2.Text = Converter.Button2 + Btn3.Text = Converter.Button3 + Btn2.Visibility = If(Converter.Button2 = "", Visibility.Collapsed, Visibility.Visible) + Btn3.Visibility = If(Converter.Button3 = "", Visibility.Collapsed, Visibility.Visible) + '添加选择控件 + For Each Selection As IMyRadio In Converter.Content + PanSelection.Children.Add(Selection) + AddHandler Selection.Check, AddressOf OnChecked + If TypeOf Selection Is MyListItem Then + CType(Selection, MyListItem).Type = MyListItem.CheckType.RadioBox + CType(Selection, MyListItem).MinHeight = 24 + Else + CType(Selection, MyRadioBox).MinHeight = 26 + End If + Next + + Catch ex As Exception + Log(ex, "选择弹窗初始化失败", LogLevel.Hint) + End Try + End Sub + + Private Sub Load(sender As Object, e As EventArgs) Handles MyBase.Loaded + Try + + 'UI 初始化 + If Btn2.IsVisible AndAlso Not Btn1.ColorType = MyButton.ColorState.Red Then Btn1.ColorType = MyButton.ColorState.Highlight + ShapeLine.StrokeThickness = GetWPFSize(1) + Measure(New Size(FrmMain.Width, FrmMain.Height)) + Arrange(New Rect(0, 0, FrmMain.Width, FrmMain.Height)) + If FrmMain.Width - ActualWidth < 20 Then Width = FrmMain.Width - GetWPFSize(2) + '动画 + AniStart({ + AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(60, 0, 0, 0), 250, , New AniEaseInFluent), + AaColor(PanBorder, Border.BackgroundProperty, New MyColor(255, 0, 0, 0), 150, , New AniEaseInFluent), + AaOpacity(EffectShadow, 0.75, 400, 50), + AaWidth(ShapeLine, ShapeLine.ActualWidth, 250, 100, New AniEaseOutFluent), + AaOpacity(ShapeLine, 1, 200, 100), + AaWidth(LabTitle, LabTitle.ActualWidth, 200, 100, New AniEaseOutFluent), + AaOpacity(LabTitle, 1, 150, 150), + AaOpacity(PanCaption, 1, 150, 150), + AaOpacity(Btn1, 1, 150, 100), + AaOpacity(Btn2, 1, 150, 150), + AaOpacity(Btn3, 1, 150, 200), + AaCode(Sub() + ShapeLine.MinWidth = ShapeLine.ActualWidth + ShapeLine.HorizontalAlignment = HorizontalAlignment.Stretch + ShapeLine.Width = Double.NaN + LabTitle.Width = Double.NaN + LabTitle.TextTrimming = TextTrimming.CharacterEllipsis + End Sub, 350) + }, "MyMsgBox Start " & Uuid) + '动画初始化 + ShapeLine.Width = 0 + ShapeLine.HorizontalAlignment = HorizontalAlignment.Center + LabTitle.Width = 0 + LabTitle.Opacity = 0 + LabTitle.TextWrapping = TextWrapping.NoWrap + PanCaption.Opacity = 0 + '记录日志 + Log("[Control] 选择弹窗：" & LabTitle.Text) + + Catch ex As Exception + Log(ex, "选择弹窗加载失败", LogLevel.Hint) + End Try + End Sub + Private Sub Close() + '结束线程阻塞 + MyConverter.WaitFrame.Continue = False + Interop.ComponentDispatcher.PopModal() + '弹窗动画 + LabTitle.TextTrimming = TextTrimming.None + LabTitle.TextWrapping = TextWrapping.NoWrap + AniStart({ + AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(-60, 0, 0, 0), 350, , New AniEaseInFluent), + AaColor(PanBorder, Border.BackgroundProperty, New MyColor(-255, 0, 0, 0), 300, 100, New AniEaseInFluent), + AaOpacity(EffectShadow, -0.75, 150), + AaWidth(ShapeLine, -ShapeLine.ActualWidth, 250, , New AniEaseInFluent), + AaOpacity(ShapeLine, -1, 150, 100), + AaWidth(LabTitle, -LabTitle.ActualWidth, 250), + AaOpacity(LabTitle, -1, 200), + AaOpacity(PanCaption, -1, 200), + AaOpacity(Btn1, -1, 150), + AaOpacity(Btn2, -1, 150, 50), + AaOpacity(Btn3, -1, 150, 100), + AaCode(Sub() CType(Parent, Grid).Children.Remove(Me), , True) + }, "MyMsgBox Close " & Uuid) + End Sub + + Public Sub Btn1_Click() Handles Btn1.Click + If MyConverter.IsExited OrElse SelectedIndex = -1 Then Exit Sub + MyConverter.IsExited = True + MyConverter.Result = SelectedIndex + Close() + End Sub + Private Sub Btn2_Click() Handles Btn2.Click + If MyConverter.IsExited Then Exit Sub + MyConverter.IsExited = True + MyConverter.Result = Nothing + Close() + End Sub + Private Sub Btn3_Click() Handles Btn3.Click + If MyConverter.IsExited Then Exit Sub + MyConverter.IsExited = True + MyConverter.Result = Nothing + Close() + End Sub + + Private SelectedIndex As Integer = -1 + Private Sub OnChecked(sender As IMyRadio, e As EventArgs) + Btn1.IsEnabled = True + SelectedIndex = PanSelection.Children.IndexOf(sender) + End Sub + Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown + On Error Resume Next + If e.GetPosition(ShapeLine).Y <= 2 Then FrmMain.DragMove() + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml new file mode 100644 index 0000000..0a198de --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb new file mode 100644 index 0000000..a554fd8 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyMsg/MyMsgText.xaml.vb @@ -0,0 +1,125 @@ +Public Class MyMsgText + + Private ReadOnly MyConverter As MyMsgBoxConverter + Private ReadOnly Uuid As Integer = GetUuid() + + Public Sub New(Converter As MyMsgBoxConverter) + Try + + InitializeComponent() + Btn1.Name = Btn1.Name & GetUuid() + Btn2.Name = Btn2.Name & GetUuid() + Btn3.Name = Btn3.Name & GetUuid() + MyConverter = Converter + LabTitle.Text = Converter.Title + LabCaption.Text = Converter.Content + Btn1.Text = Converter.Button1 + If Converter.IsWarn Then + Btn1.ColorType = MyButton.ColorState.Red + LabTitle.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrushRedLight") + ShapeLine.SetResourceReference(Rectangle.FillProperty, "ColorBrushRedLight") + End If + Btn2.Text = Converter.Button2 + Btn3.Text = Converter.Button3 + Btn2.Visibility = If(Converter.Button2 = "", Visibility.Collapsed, Visibility.Visible) + Btn3.Visibility = If(Converter.Button3 = "", Visibility.Collapsed, Visibility.Visible) + ShapeLine.StrokeThickness = GetWPFSize(1) + + Catch ex As Exception + Log(ex, "普通弹窗初始化失败", LogLevel.Hint) + End Try + End Sub + + Private Sub Load(sender As Object, e As EventArgs) Handles MyBase.Loaded + Try + + 'UI 初始化 + If Btn2.IsVisible AndAlso Not Btn1.ColorType = MyButton.ColorState.Red Then Btn1.ColorType = MyButton.ColorState.Highlight + Measure(New Size(FrmMain.Width - 20, FrmMain.Height - 20)) + Arrange(New Rect(0, 0, FrmMain.Width - 20, FrmMain.Height - 20)) + Btn1.Focus() + '动画 + AniStart({ + AaColor(FrmMain.PanMsg, BackgroundProperty, New MyColor(60, 0, 0, 0), 250, , New AniEaseInFluent), + AaColor(PanBorder, Border.BackgroundProperty, New MyColor(255, 0, 0, 0), 150, , New AniEaseInFluent), + AaOpacity(EffectShadow, 0.75, 400, 50), + AaWidth(ShapeLine, ShapeLine.ActualWidth, 250, 100, New AniEaseOutFluent), + AaOpacity(ShapeLine, 1, 200, 100), + AaWidth(LabTitle, LabTitle.ActualWidth, 200, 150, New AniEaseOutFluent), + AaOpacity(LabTitle, 1, 150, 150), + AaOpacity(PanCaption, 1, 150, 150), + AaOpacity(Btn1, 1, 150, 100), + AaOpacity(Btn2, 1, 150, 150), + AaOpacity(Btn3, 1, 150, 200), + AaCode(Sub() + ShapeLine.MinWidth = ShapeLine.ActualWidth + ShapeLine.HorizontalAlignment = HorizontalAlignment.Stretch + ShapeLine.Width = Double.NaN + LabTitle.Width = Double.NaN + LabTitle.TextTrimming = TextTrimming.CharacterEllipsis + End Sub, 350) + }, "MyMsgBox Start " & Uuid) + '动画初始化 + ShapeLine.Width = 0 + ShapeLine.HorizontalAlignment = HorizontalAlignment.Center + LabTitle.Width = 0 + LabTitle.Opacity = 0 + LabTitle.TextWrapping = TextWrapping.NoWrap + PanCaption.Opacity = 0 + '记录日志 + Log("[Control] 普通弹窗：" & LabTitle.Text & vbCrLf & LabCaption.Text) + + Catch ex As Exception + Log(ex, "普通弹窗加载失败", LogLevel.Hint) + End Try + End Sub + Private Sub Close() + '结束线程阻塞 + If MyConverter.ForceWait OrElse Not MyConverter.Button2 = "" Then MyConverter.WaitFrame.Continue = False + Interop.ComponentDispatcher.PopModal() + '弹窗动画 + LabTitle.TextTrimming = TextTrimming.None + LabTitle.TextWrapping = TextWrapping.NoWrap + AniStart({ + AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(-60, 0, 0, 0), 350, , New AniEaseInFluent), + AaColor(PanBorder, Border.BackgroundProperty, New MyColor(-255, 0, 0, 0), 300, 100, New AniEaseInFluent), + AaOpacity(EffectShadow, -0.75, 150), + AaWidth(ShapeLine, -ShapeLine.ActualWidth, 250, , New AniEaseInFluent(AniEasePower.Weak)), + AaOpacity(ShapeLine, -1, 200), + AaWidth(LabTitle, -LabTitle.ActualWidth, 250), + AaOpacity(LabTitle, -1, 200), + AaOpacity(PanCaption, -1, 200), + AaOpacity(Btn1, -1, 150), + AaOpacity(Btn2, -1, 150, 50), + AaOpacity(Btn3, -1, 150, 100), + AaCode(Sub() CType(Parent, Grid).Children.Remove(Me), , True) + }, "MyMsgBox Close " & Uuid) + '动画初始化 + ShapeLine.MinWidth = 0 + End Sub + + Public Sub Btn1_Click() Handles Btn1.Click + If MyConverter.IsExited Then Exit Sub + MyConverter.IsExited = True + MyConverter.Result = 1 + Close() + End Sub + Private Sub Btn2_Click() Handles Btn2.Click + If MyConverter.IsExited Then Exit Sub + MyConverter.IsExited = True + MyConverter.Result = 2 + Close() + End Sub + Private Sub Btn3_Click() Handles Btn3.Click + If MyConverter.IsExited Then Exit Sub + MyConverter.IsExited = True + MyConverter.Result = 3 + Close() + End Sub + + Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown + On Error Resume Next + If e.GetPosition(ShapeLine).Y <= 2 Then FrmMain.DragMove() + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyPageLeft.vb b/Plain Craft Launcher 2/Controls/MyPageLeft.vb new file mode 100644 index 0000000..c43e56e --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyPageLeft.vb @@ -0,0 +1,100 @@ +Public Class MyPageLeft + Inherits Grid + Private Uuid As Integer = GetUuid() + + '执行逐个进入动画的控件 + Public Property AnimatedControl As FrameworkElement + Get + Return GetValue(AnimatedControlProperty) + End Get + Set(value As FrameworkElement) + SetValue(AnimatedControlProperty, value) + End Set + End Property + Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.Register("AnimatedControl", GetType(FrameworkElement), GetType(MyPageLeft), New PropertyMetadata(Nothing)) + + Public Sub TriggerShowAnimation() + If AnimatedControl Is Nothing Then + '缩放动画 + If TypeOf RenderTransform IsNot ScaleTransform Then + RenderTransform = New ScaleTransform(0.96, 0.96) + RenderTransformOrigin = New Point(0.5, 0.5) + End If + Opacity = 0 + AniStart({ + AaScaleTransform(Me, 1 - CType(RenderTransform, ScaleTransform).ScaleX, 400,, New AniEaseOutBack(2)), + AaOpacity(Me, 1, 100) + }, "PageLeft PageChange " & Uuid) + Else + '逐个进入动画 + Dim AniList As New List(Of AniData) + Dim Id As Integer = 0, Delay As Integer = 0 + Dim Controls = GetAllAnimControls() + For Each Element As FrameworkElement In Controls + Element.Opacity = 0 + Element.RenderTransform = New TranslateTransform(-25, 0) + AniList.Add(AaOpacity(Element, If(TypeOf Element Is TextBlock, 0.6, 1), 200, 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() + 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 + Id += 1 + Next + AniStart(AniList, "PageLeft PageChange " & Uuid) + End If + End Sub + Public Sub TriggerHideAnimation() + If AnimatedControl Is Nothing Then + '缩放动画 + If TypeOf RenderTransform IsNot ScaleTransform Then + RenderTransform = New ScaleTransform(1, 1) + 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) + }, "PageLeft PageChange " & Uuid) + Else + '逐个退出动画 + Dim AniList As New List(Of AniData) + 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)) + Id += 1 + Next + AniStart(AniList, "PageLeft PageChange " & Uuid) + End If + End Sub + + '遍历获取所有需要生成动画的控件 + Private Function GetAllAnimControls() As List(Of FrameworkElement) + Dim AllControls As New List(Of FrameworkElement) + GetAllAnimControls(AnimatedControl, AllControls) + Return AllControls + End Function + Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement)) + If Element.Visibility = Visibility.Collapsed Then Exit Sub + If TypeOf Element Is MyTextButton Then + AllControls.Add(Element) + ElseIf TypeOf Element Is MyListItem Then + CType(Element, MyListItem).IsMouseOverAnimationEnabled = False + AllControls.Add(Element) + ElseIf TypeOf Element Is ContentControl Then + GetAllAnimControls(CType(Element, ContentControl).Content, AllControls) + ElseIf TypeOf Element Is Panel Then + For Each Element2 As FrameworkElement In CType(Element, Panel).Children + GetAllAnimControls(Element2, AllControls) + Next + Else + AllControls.Add(Element) + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyPageRight.vb b/Plain Craft Launcher 2/Controls/MyPageRight.vb new file mode 100644 index 0000000..8881357 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyPageRight.vb @@ -0,0 +1,376 @@ +Public Class MyPageRight + Inherits AdornerDecorator + Public PageUuid As Integer = GetUuid() + + '当前状态 + Public Enum PageStates + Empty '默认状态，页面全空 + LoaderWait '加载环初始等待 + LoaderEnter '加载环进入动画 + LoaderStayForce '加载环正常显示（强制等待） + LoaderStay '加载环正常显示 + LoaderExit '加载环退出动画 + ContentEnter '内容进入动画 + ContentStay '内容正常显示 + ReloadExit '刷新导致的全部退出动画 + PageExit '切换页面导致的全部退出动画 + End Enum + Private _PageState As PageStates = PageStates.Empty + Public Property PageState As PageStates + Get + Return _PageState + End Get + Set(value As PageStates) + If _PageState = value Then Exit Property + _PageState = value + If ModeDebug Then Log("[UI] 页面状态切换为 " & GetStringFromEnum(value)) + End Set + End Property + +#Region "加载器" + + Private PageLoader As LoaderBase + Private PageLoaderInputInvoke + Private PageLoaderUi As MyLoading + Private PanLoader As FrameworkElement + Private PanContent As FrameworkElement + Private PanAlways As FrameworkElement + Private PageLoaderAutoRun As Boolean + + '初始化 + ''' + ''' 表明页面存在需要在后台执行的加载器。 + ''' + ''' MyLoading 控件。 + ''' MyLoading 控件对应的卡片。 + ''' 加载结束后出现的内容容器。 + ''' 无论是否在加载总是要显示的容器。可以为 Nothing。 + ''' 在工作线程执行的加载器。 + ''' 当加载器执行完成，在 UI 线程触发的 UI 初始化事件。 + Public Sub PageLoaderInit(LoaderUi As MyLoading, PanLoader As FrameworkElement, PanContent As FrameworkElement, PanAlways As FrameworkElement, + RealLoader As LoaderBase, FinishedInvoke As Action(Of LoaderBase), Optional InputInvoke As Func(Of Object) = Nothing, + Optional AutoRun As Boolean = True) + '初始化参数 + Me.PanLoader = PanLoader + Me.PanContent = PanContent + Me.PanAlways = PanAlways + Me.PageLoader = RealLoader + Me.PageLoaderUi = LoaderUi + Me.PageLoaderInputInvoke = InputInvoke + Me.PageLoaderAutoRun = AutoRun + '添加结束 Invoke + AddHandler RealLoader.PreviewFinish, + Sub() + Do While PageState = MyPageRight.PageStates.PageExit OrElse PageState = MyPageRight.PageStates.ReloadExit + Thread.Sleep(10) '不在退出动画时执行 UI 线程操作，避免退出动画被重置 + Loop + RunInUiWait(Sub() FinishedInvoke(RealLoader)) + Thread.Sleep(20) '由于大量初始化控件会导致掉帧，延迟触发 State 改变事件 + End Sub + AddHandler RealLoader.OnStateChangedUi, Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) RunInUi(Sub() PageLoaderState(Loader, NewState, OldState)) + '隐藏 UI + PanLoader.Visibility = Visibility.Collapsed + PanContent.Visibility = Visibility.Collapsed + If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed + '初次运行加载器 + If PageLoaderAutoRun Then + If PageLoader.GetType.Name.StartsWith("LoaderTask") Then + PageLoader.Start(CType(PageLoader, Object).StartGetInput(Nothing, PageLoaderInputInvoke)) + Else + Dim Input = Nothing + If PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke() + PageLoader.Start(Input) + End If + End If + If PageLoader.State = LoadState.Finished Then + RunInUiWait(Sub() FinishedInvoke(RealLoader)) '加载器已提前完成，直接触发事件 + End If + '设置加载环 + PageLoaderUi.State = RealLoader + AddHandler PageLoaderUi.Click, Sub() If RealLoader.State = LoadState.Failed Then PageLoaderRestart() '点击重试事件 + End Sub + + '重试 + Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试 + If Not PageLoaderAutoRun Then Exit Sub + If PageLoader.GetType.Name.StartsWith("LoaderTask") Then + PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart) + Else + If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke() + PageLoader.Start(Input, IsForceRestart:=IsForceRestart) + End If + End Sub + +#End Region + +#Region "事件" + + '外部触发的事件 + ''' + ''' 需要切换到当前页面，并且原本的 Loaded 事件已执行完成。 + ''' 需要根据加载器状态，从 Empty 切换到 ContentEnter、LoaderWait、LoaderEnter。 + ''' + Public Sub PageOnEnter() + If ModeDebug Then Log("[UI] 已触发 PageOnEnter") + RaiseEvent OnPageEnter() + + Select Case PageState + Case PageStates.Empty + If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished Then + PageState = PageStates.ContentEnter + TriggerEnterAnimation(PanAlways, If(PanContent, Child)) + ElseIf PageLoader.State = LoadState.Loading Then + PageState = PageStates.LoaderWait + AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid) + ElseIf PageLoader.State = LoadState.Failed Then + PageState = PageStates.LoaderEnter + TriggerEnterAnimation(PanAlways, PanLoader) + ElseIf PageLoader.State = LoadState.Waiting Then + '由于 “页面加载器 Minecraft Version List 不应在 PageOnEnter 事件出现 Waiting 状态” 的神秘反馈添加的临时修复 + PageState = PageStates.LoaderWait + AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid) + Log("[Anim] 警告：页面加载器 " & PageLoader.Name & " 不应在 PageOnEnter 事件出现 " & GetStringFromEnum(PageLoader.State) & " 状态", LogLevel.Debug) + Else + Throw New Exception("页面加载器 " & PageLoader.Name & " 不应在 PageOnEnter 事件出现 " & GetStringFromEnum(PageLoader.State) & " 状态。") + End If + Case Else + Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnter 事件。") + End Select + End Sub + Public Event OnPageEnter() + ''' + ''' 需要切换到其他页面。 + ''' 需要立即切换至 PageExit 或 Empty。 + ''' + Public Sub PageOnExit() + If ModeDebug Then Log("[UI] 已触发 PageOnExit") + Select Case PageState + Case PageStates.ContentEnter, PageStates.ContentStay + PageState = PageStates.PageExit + TriggerExitAnimation(PanAlways, If(PanContent, Child)) + Case PageStates.LoaderEnter, PageStates.LoaderStayForce, PageStates.LoaderStay + PageState = PageStates.PageExit + TriggerExitAnimation(PanAlways, PanLoader) + Case PageStates.LoaderWait + PageState = PageStates.PageExit + TriggerExitAnimation(PanAlways) + Case PageStates.LoaderExit, PageStates.ReloadExit + PageState = PageStates.PageExit + If PanAlways IsNot Nothing Then TriggerExitAnimation(PanAlways, If(PanContent, Child)) + Case PageStates.PageExit, PageStates.Empty + End Select + End Sub + ''' + ''' 即将切换到其他页面，需要强制完成页面状态清理。 + ''' 需要立即切换至 Empty。 + ''' + Public Sub PageOnForceExit() + If PageState = PageStates.Empty Then Exit Sub + If ModeDebug Then Log("[UI] 已触发 PageOnForceExit") + PageState = PageStates.Empty + AniStop("PageRight PageChange " & PageUuid) + '由于动画会被强制中止，所以需要手动进行隐藏 + If PageLoader Is Nothing Then + Child.Visibility = Visibility.Collapsed + Else + PanContent.Visibility = Visibility.Collapsed + PanLoader.Visibility = Visibility.Collapsed + If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed + End If + End Sub + + '内部触发的事件 + ''' + ''' 逐个进入动画已执行完成。 + ''' 需要根据目前状态，从 ContentEnter 切换到 ContentStay，或从 LoaderEnter 切换到 LoaderStayForce。 + ''' + Private Sub PageOnEnterAnimationFinished() + If ModeDebug Then Log("[UI] 已触发 PageOnEnterAnimationFinished") + Select Case PageState + Case PageStates.ContentEnter + PageState = PageStates.ContentStay + Case PageStates.LoaderEnter + PageState = PageStates.LoaderStayForce + AniStart(AaCode(AddressOf PageOnLoaderStayFinished, 400), "PageRight PageChange " & PageUuid) + Case Else + Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnterAnimationFinished 事件。") + End Select + End Sub + ''' + ''' 逐个退出动画已执行完成。 + ''' 需要根据目前状态，从 AllExit 切换到 Empty，或从 LoaderExit 切换到 ContentEnter，或从 ContentExit 重新触发 PageOnEnter。 + ''' + Private Sub PageOnExitAnimationFinished() + If ModeDebug Then Log("[UI] 已触发 PageOnExitAnimationFinished") + Select Case PageState + Case PageStates.PageExit + PageState = PageStates.Empty + Case PageStates.ReloadExit + PageState = PageStates.Empty + PageOnEnter() + Case PageStates.LoaderExit + PageState = PageStates.ContentEnter + TriggerEnterAnimation(PanContent) + Case Else + Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnExitAnimationFinished 事件。") + End Select + End Sub + ''' + ''' 加载环进入等待已结束。 + ''' 需要从 LoaderWait 切换到 LoaderEnter。 + ''' + Private Sub PageOnLoaderWaitFinished() + If ModeDebug Then Log("[UI] 已触发 PageOnLoaderWaitFinished") + Select Case PageState + Case PageStates.LoaderWait + PageState = PageStates.LoaderEnter + If PanAlways IsNot Nothing AndAlso PanAlways.Visibility = Visibility.Collapsed Then + TriggerEnterAnimation(PanAlways, PanLoader) + Else + TriggerEnterAnimation(PanLoader) + End If + Case Else + Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。") + End Select + End Sub + ''' + ''' 加载环展示等待已结束。 + ''' 需要从 LoaderStayForce 切换到 LoaderStay 或 LoaderExit。 + ''' + Private Sub PageOnLoaderStayFinished() + If ModeDebug Then Log("[UI] 已触发 PageOnLoaderStayFinished") + Select Case PageState + Case PageStates.LoaderStayForce + If PageLoader.State = LoadState.Finished Then + PageState = PageStates.LoaderExit + TriggerExitAnimation(PanLoader) + Else + PageState = PageStates.LoaderStay + End If + Case Else + Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnLoaderWaitFinished 事件。") + End Select + End Sub + + ''' + ''' 全局加载状态已改变。 + ''' + Private Sub PageLoaderState(sender As Object, NewState As LoadState, OldState As LoadState) + Select Case NewState + Case LoadState.Failed, LoadState.Loading + If Not OldState = LoadState.Finished Then Exit Sub + If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Refresh)") + '重新开始运行 + '需要从部分状态切换到 ReloadExit + Select Case PageState + Case PageStates.ContentEnter, PageStates.ContentStay + PageState = PageStates.ReloadExit + TriggerExitAnimation(PanContent) + Case PageStates.LoaderExit, PageStates.ReloadExit + PageState = PageStates.ReloadExit + End Select + Case LoadState.Finished + If Not OldState = LoadState.Loading Then Exit Sub + If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop)") + '运行结束 + '需要从 LoaderWait 切换到 ContentEnter，或从 LoaderStay 切换到 LoaderExit + Select Case PageState + Case PageStates.LoaderWait + PageState = PageStates.ContentEnter + If PanAlways IsNot Nothing AndAlso PanAlways.Visibility = Visibility.Collapsed Then + TriggerEnterAnimation(PanAlways, PanContent) + Else + TriggerEnterAnimation(PanContent) + End If + Case PageStates.LoaderStay + PageState = PageStates.LoaderExit + TriggerExitAnimation(PanLoader) + End Select + End Select + End Sub + +#End Region + +#Region "动画" + + '逐个进入动画 + Public Sub TriggerEnterAnimation(ParamArray Elements As FrameworkElement()) + '去除 Nothing 项 + Dim RealElements As New List(Of FrameworkElement) + For Each Element In Elements + If Element IsNot Nothing Then RealElements.Add(Element) + Next + + For Each Element In RealElements + Element.Visibility = Visibility.Visible '页面均处于默认的隐藏状态 + Next + Dim AniList As New List(Of AniData) + Dim Delay As Integer = 0 + For Each Element In RealElements + For Each Control As FrameworkElement In GetAllAnimControls(Element, True) + '还原被隐藏的卡片的消失动画 + Control.IsHitTestVisible = True + If Control.RenderTransform IsNot Nothing AndAlso TypeOf Control.RenderTransform Is TranslateTransform Then Control.RenderTransform = Nothing + Next + For Each Control As FrameworkElement In GetAllAnimControls(Element) + Control.Opacity = 0 + Control.RenderTransform = New TranslateTransform(0, -16) + AniList.Add(AaOpacity(Control, 1, 150, 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 + Next + Next + AniList.Add(AaCode(Sub() PageOnEnterAnimationFinished(),, True)) + AniStart(AniList, "PageRight PageChange " & PageUuid) + End Sub + + '逐个退出动画 + Public Sub TriggerExitAnimation(ParamArray Elements As FrameworkElement()) + '去除 Nothing 项 + Dim RealElements As New List(Of FrameworkElement) + For Each Element In Elements + If Element IsNot Nothing Then RealElements.Add(Element) + Next + + Dim AniList As New List(Of AniData) + Dim Delay As Integer = 0 + For Each Element In RealElements + For Each Control As FrameworkElement In GetAllAnimControls(Element) + Control.IsHitTestVisible = False + AniList.Add(AaOpacity(Control, -1, 90, Delay)) + AniList.Add(AaTranslateY(Control, -6, 90, Delay)) + Delay += 20 + Next + Next + AniList.Add(AaCode(Sub() + For Each Element In RealElements + Element.Visibility = Visibility.Collapsed + Next + PageOnExitAnimationFinished() + End Sub,, True)) + AniStart(AniList, "PageRight PageChange " & PageUuid) + End Sub + + '遍历获取所有需要生成动画的控件 + Friend Function GetAllAnimControls(Element As FrameworkElement, Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement) + Dim AllControls As New List(Of FrameworkElement) + GetAllAnimControls(Element, AllControls, IgnoreInvisibility) + 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 TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint Then + AllControls.Add(Element) + ElseIf TypeOf Element Is ContentControl Then + GetAllAnimControls(CType(Element, ContentControl).Content, AllControls, IgnoreInvisibility) + ElseIf TypeOf Element Is Panel Then + For Each Element2 As FrameworkElement In CType(Element, Panel).Children + GetAllAnimControls(Element2, AllControls, IgnoreInvisibility) + Next + End If + End Sub + +#End Region + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyRadioBox.xaml b/Plain Craft Launcher 2/Controls/MyRadioBox.xaml new file mode 100644 index 0000000..93783fe --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyRadioBox.xaml @@ -0,0 +1,9 @@ + + + + + diff --git a/Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb b/Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb new file mode 100644 index 0000000..1ce74c8 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyRadioBox.xaml.vb @@ -0,0 +1,231 @@ +Public Class MyRadioBox + Implements IMyRadio + + '基础 + + Public Uuid As Integer = GetUuid() + Public Event PreviewCheck(sender As Object, e As RouteEventArgs) + Public Event PreviewChange(sender As Object, e As RouteEventArgs) + Public Event Check(sender As Object, e As RouteEventArgs) Implements IMyRadio.Check + Public Event Changed(sender As Object, e As RouteEventArgs) Implements IMyRadio.Changed + + '自定义属性 + + Private _Checked As Boolean = False '是否选中 + Public Property Checked As Boolean + Get + Return _Checked + End Get + Set(value As Boolean) + SetChecked(value, False, True) + End Set + End Property + ''' + ''' 手动设置 Checked 属性。 + ''' + ''' 新的 Checked 属性。 + ''' 是否由用户引发。 + ''' 是否执行动画。 + Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean) + Try + + 'Preview 事件 + + If value AndAlso user Then + Dim e = New RouteEventArgs(user) + RaiseEvent PreviewCheck(Me, e) + If e.Handled Then + Radiobox_MouseLeave() + Exit Sub + End If + End If + + '自定义属性基础 + + Dim IsChanged As Boolean = False + If IsLoaded AndAlso Not value = _Checked Then RaiseEvent PreviewChange(Me, New RouteEventArgs(user)) + If Not value = _Checked Then + _Checked = value + IsChanged = True + End If + + '保证只有一个单选框选中 + + If Parent Is Nothing Then Exit Sub + Dim RadioboxList As New List(Of MyRadioBox) + Dim CheckedCount As Integer = 0 + '收集控件列表与选中个数 + For Each Control In CType(Parent, Object).Children + If TypeOf Control Is MyRadioBox Then + RadioboxList.Add(Control) + If Control.Checked Then CheckedCount += 1 + End If + Next + '判断选中情况 + Select Case CheckedCount + Case 0 + '没有任何单选框被选中，选择第一个 + RadioboxList(0).Checked = True + Case Is > 1 + '选中项目多于 1 个 + If Checked Then + '如果本控件选中，则取消其他所有控件的选中 + For Each Control As MyRadioBox In RadioboxList + If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False + Next + Else + '如果本控件未选中，则只保留第一个选中的控件 + Dim FirstChecked = False + For Each Control As MyRadioBox In RadioboxList + If Control.Checked Then + If FirstChecked Then + Control.Checked = False '修改 Checked 会自动触发 Change 事件，所以不用额外触发 + Else + FirstChecked = True + End If + End If + Next + End If + End Select + 'End If + + '更改动画 + + If Not IsChanged Then Exit Sub + If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画 + If Checked Then + '由无变有 + If ShapeDot.Opacity < 0.01 Then ShapeDot.Opacity = 1 + AniStart({ + AaScale(ShapeBorder, 10 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent(AniEasePower.Weak), , True), + AaScale(ShapeBorder, 8, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.6, New AniEaseOutBack, , True) + }, "MyRadioBox Border " & Uuid) + AniStart({ + AaScale(ShapeDot, 9 - ShapeDot.Width, AnimationTimeOfCheck * 2.6,, New AniEaseOutBack(AniEasePower.Weak), , True), + AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6) + }, "MyRadioBox Dot " & Uuid) + AniStart({ + AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray4")), AnimationTimeOfCheck) + }, "MyRadioBox BorderColor " & Uuid) + Else + '由有变无 + AniStart({ + AaScale(ShapeBorder, 18 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True) + }, "MyRadioBox Border " & Uuid) + AniStart({ + AaScale(ShapeDot, -ShapeDot.Width, AnimationTimeOfCheck, , New AniEaseInFluent, , True), + AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2) + }, "MyRadioBox Dot " & Uuid) + AniStart({ + AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray4")), AnimationTimeOfCheck) + }, "MyRadioBox BorderColor " & Uuid) + End If + Else + '不使用动画 + AniStop("MyRadioBox Border " & Uuid) + AniStop("MyRadioBox Dot " & Uuid) + AniStop("MyRadioBox BorderColor " & Uuid) + If Checked Then + ShapeDot.Width = 9 + ShapeDot.Height = 9 + ShapeDot.Opacity = 1 + ShapeDot.Margin = New Thickness(5.5, 0, 0, 0) + ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4")) + Else + ShapeDot.Width = 0 + ShapeDot.Height = 0 + ShapeDot.Opacity = 0 + ShapeDot.Margin = New Thickness(10, 0, 0, 0) + ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4")) + End If + End If + + '触发事件 + If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user)) + RaiseEvent Changed(Me, New RouteEventArgs(user)) + + Catch ex As Exception + Log(ex, "单选框勾选改变错误", LogLevel.Hint) + End Try + End Sub + Public Property Text As String + Get + Return GetValue(TextProperty) + End Get + Set(value As String) + SetValue(TextProperty, value) + End Set + End Property '内容 + Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioBox), New PropertyMetadata(New PropertyChangedCallback( + Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs) + If Not IsNothing(sender) Then CType(sender, MyRadioBox).LabText.Text = e.NewValue + End Sub))) + + '点击事件 + + Private MouseDowned As Boolean = False + Private AllowMouseDown As Boolean = True + Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp + If Not MouseDowned Then Exit Sub + MouseDowned = False + Log("[Control] 按下单选框：" & Text) + SetChecked(True, True, True) + AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid) + End Sub + Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown + MouseDowned = True + Focus() + AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrush9", 100), "MyRadioBox Background " & Uuid) + If Not Checked Then + AniStart(AaScale(ShapeBorder, 16.5 - ShapeBorder.Width, 1000, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyRadioBox Border " & Uuid) + End If + End Sub + Private Sub Radiobox_MouseLeave() Handles Me.MouseLeave + If Not MouseDowned Then Exit Sub + MouseDowned = False + AniStart(AaColor(ShapeBorder, Shapes.Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid) + If Not Checked Then + AniStart(AaScale(ShapeBorder, 18 - ShapeBorder.Width, 400, , New AniEaseOutFluent(AniEasePower.Strong), Absolute:=True), "MyRadioBox Border " & Uuid) + End If + End Sub + + '指向动画 + + Private Const AnimationTimeOfMouseIn As Integer = 100 '鼠标指向动画长度 + Private Const AnimationTimeOfMouseOut As Integer = 200 '鼠标指向动画长度 + Private Const AnimationTimeOfCheck As Integer = 150 '勾选状态变更动画长度 + Private Sub Radiobox_IsEnabledChanged() Handles Me.IsEnabledChanged + If Me.IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + '有动画 + If Me.IsEnabled Then + '可用 + Radiobox_MouseLeaveAnimation() + Else + '不可用 + AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, ColorGray4 - ShapeBorder.Stroke, AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid) + AniStart(AaColor(LabText, TextBlock.ForegroundProperty, ColorGray4 - LabText.Foreground, AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid) + End If + Else + '无动画 + AniStop("MyRadioBox BorderColor " & Uuid) + AniStop("MyRadioBox TextColor " & Uuid) + LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4")) + ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4")) + End If + End Sub + Private Sub Radiobox_MouseEnterAnimation() Handles Me.MouseEnter + AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, "ColorBrush3", AnimationTimeOfMouseIn), "MyRadioBox BorderColor " & Uuid) + 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 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) + Else + ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4")) + LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4")) + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyRadioButton.xaml b/Plain Craft Launcher 2/Controls/MyRadioButton.xaml new file mode 100644 index 0000000..aa42f53 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyRadioButton.xaml @@ -0,0 +1,9 @@ + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb b/Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb new file mode 100644 index 0000000..e1587f6 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyRadioButton.xaml.vb @@ -0,0 +1,255 @@ +Public Class MyRadioButton + + '基础 + + Public Uuid As Integer = GetUuid() + Public Event Check(sender As Object, raiseByMouse As Boolean) + Public Event Change(sender As Object, raiseByMouse As Boolean) + Public Sub RaiseChange() + RaiseEvent Change(Me, False) + End Sub '使外部程序可以引发本控件的 Change 事件 + + '自定义属性 + + Public Property Logo As String + Get + Return ShapeLogo.Data.ToString + End Get + Set(value As String) + ShapeLogo.Data = (New GeometryConverter).ConvertFromString(value) + End Set + End Property + Private _LogoScale As Double = 1 + Public Property LogoScale() As Double + Get + Return _LogoScale + End Get + Set(value As Double) + _LogoScale = value + If Not IsNothing(ShapeLogo) Then ShapeLogo.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale} + End Set + End Property + + Private _Checked As Boolean = False '是否选中 + Public Property Checked As Boolean + Get + Return _Checked + End Get + Set(value As Boolean) + SetChecked(value, False, True) + End Set + End Property + ''' + ''' 手动设置 Checked 属性。 + ''' + ''' 新的 Checked 属性。 + ''' 是否由用户引发。 + ''' 是否执行动画。 + Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean) + Try + + '自定义属性基础 + + Dim IsChanged As Boolean = False + If IsLoaded AndAlso Not value = _Checked Then RaiseEvent Change(Me, user) + If Not value = _Checked Then + _Checked = value + IsChanged = True + End If + + '保证只有一个单选框选中 + + If IsNothing(Parent) Then Exit Sub + Dim RadioboxList As New List(Of MyRadioButton) + Dim CheckedCount As Integer = 0 + '收集控件列表与选中个数 + For Each Control In CType(Parent, Object).Children + If TypeOf Control Is MyRadioButton Then + RadioboxList.Add(Control) + If Control.Checked Then CheckedCount += 1 + End If + Next + '判断选中情况 + Select Case CheckedCount + Case 0 + '没有任何单选框被选中，选择第一个 + RadioboxList(0).Checked = True + Case Is > 1 + '选中项目多于 1 个 + If Me.Checked Then + '如果本控件选中，则取消其他所有控件的选中 + For Each Control As MyRadioButton In RadioboxList + If Control.Checked AndAlso Not Control.Equals(Me) Then Control.Checked = False + Next + Else + '如果本控件未选中，则只保留第一个选中的控件 + Dim FirstChecked = False + For Each Control As MyRadioButton In RadioboxList + If Control.Checked Then + If FirstChecked Then + Control.Checked = False '修改 Checked 会自动触发 Change 事件，所以不用额外触发 + Else + FirstChecked = True + End If + End If + Next + End If + End Select + + '更改动画 + + If Not IsChanged Then Exit Sub + RefreshColor(Nothing, anime) + + '触发事件 + If Checked Then RaiseEvent Check(Me, user) + + Catch ex As Exception + Log(ex, "单选按钮勾选改变错误", LogLevel.Hint) + End Try + End Sub + Public Property Text As String + Get + Return GetValue(TextProperty) + End Get + Set(value As String) + SetValue(TextProperty, value) + End Set + End Property '内容 + Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioButton), New PropertyMetadata(New PropertyChangedCallback( + Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs) + If Not IsNothing(sender) Then CType(sender, MyRadioButton).LabText.Text = e.NewValue + End Sub))) + Public Enum ColorState + White + Highlight + End Enum + Private _ColorType As ColorState = ColorState.White + Public Property ColorType As ColorState + Get + Return _ColorType + End Get + Set(value As ColorState) + _ColorType = value + RefreshColor() + End Set + End Property '颜色类别 + + '点击事件 + + Private IsMouseDown As Boolean = False + Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp + If Checked Then Exit Sub + If Not IsMouseDown Then Exit Sub + Log("[Control] 按下单选按钮：" & Text) + IsMouseDown = False + SetChecked(True, True, True) + End Sub + Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown + If Checked Then Exit Sub + IsMouseDown = True + RefreshColor() + End Sub + Private Sub Radiobox_MouseLeave() Handles Me.MouseLeave + IsMouseDown = False + End Sub + + '动画 + + Private Const AnimationTimeOfMouseIn As Integer = 90 '鼠标指向动画长度 + Private Const AnimationTimeOfMouseOut As Integer = 150 '鼠标移出动画长度 + Private Const AnimationTimeOfCheck As Integer = 120 '勾选状态变更动画长度 + Private Sub RefreshColor(Optional obj = Nothing, Optional e = Nothing) Handles Me.MouseEnter, Me.MouseLeave, Me.Loaded + Try + If IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not False.Equals(e) Then '防止默认属性变更触发动画，若强制不执行动画，则 e 为 False + + Select Case ColorType + Case ColorState.White + If Checked Then + '勾选 + AniStart({ + AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfCheck), + AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfCheck) + }, "MyRadioButton Checked " & Uuid) + AniStart(AaColor(Me, BackgroundProperty, New MyColor(255, 255, 255) - Background, AnimationTimeOfCheck), "MyRadioButton Color " & Uuid) + ElseIf IsMouseDown Then + '按下 + AniStart(AaColor(Me, BackgroundProperty, New MyColor(120, Color8) - Background, 60), "MyRadioButton Color " & Uuid) + ElseIf IsMouseOver Then + '指向 + AniStart({ + AaColor(ShapeLogo, Shapes.Path.FillProperty, New MyColor(255, 255, 255) - ShapeLogo.Fill, AnimationTimeOfMouseIn), + AaColor(LabText, TextBlock.ForegroundProperty, New MyColor(255, 255, 255) - LabText.Foreground, AnimationTimeOfMouseIn) + }, "MyRadioButton Checked " & Uuid) + AniStart(AaColor(Me, BackgroundProperty, New MyColor(50, Color8) - Background, AnimationTimeOfMouseIn), "MyRadioButton Color " & Uuid) + Else + '正常 + AniStart({ + AaColor(ShapeLogo, Shapes.Path.FillProperty, New MyColor(255, 255, 255) - ShapeLogo.Fill, AnimationTimeOfMouseOut), + AaColor(LabText, TextBlock.ForegroundProperty, New MyColor(255, 255, 255) - LabText.Foreground, AnimationTimeOfMouseOut) + }, "MyRadioButton Checked " & Uuid) + AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyRadioButton Color " & Uuid) + End If + Case ColorState.Highlight + If Checked Then + '勾选 + AniStart({ + AaColor(ShapeLogo, Shapes.Path.FillProperty, New MyColor(255, 255, 255) - ShapeLogo.Fill, AnimationTimeOfCheck), + AaColor(LabText, TextBlock.ForegroundProperty, New MyColor(255, 255, 255) - LabText.Foreground, AnimationTimeOfCheck) + }, "MyRadioButton Checked " & Uuid) + AniStart(AaColor(Me, BackgroundProperty, "ColorBrush3", AnimationTimeOfCheck), "MyRadioButton Color " & Uuid) + ElseIf IsMouseDown Then + '按下 + AniStart(AaColor(Me, BackgroundProperty, "ColorBrush6", AnimationTimeOfMouseIn), "MyRadioButton Color " & Uuid) + ElseIf IsMouseOver Then + '指向 + AniStart({ + AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfMouseIn), + AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseIn) + }, "MyRadioButton Checked " & Uuid) + AniStart(AaColor(Me, BackgroundProperty, "ColorBrush7", AnimationTimeOfMouseIn), "MyRadioButton Color " & Uuid) + Else + '正常 + AniStart({ + AaColor(ShapeLogo, Shapes.Path.FillProperty, "ColorBrush3", AnimationTimeOfMouseOut), + AaColor(LabText, TextBlock.ForegroundProperty, "ColorBrush3", AnimationTimeOfMouseOut) + }, "MyRadioButton Checked " & Uuid) + AniStart(AaColor(Me, BackgroundProperty, ColorSemiTransparent - Background, AnimationTimeOfMouseOut), "MyRadioButton Color " & Uuid) + End If + End Select + + Else + + '不使用动画 + AniStop("MyRadioButton Checked " & Uuid) + AniStop("MyRadioButton Color " & Uuid) + Select Case ColorType + Case ColorState.White + If Checked Then + Background = New MyColor(255, 255, 255) + ShapeLogo.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush3") + LabText.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush3") + Else + Background = ColorSemiTransparent + ShapeLogo.Fill = New MyColor(255, 255, 255) + LabText.Foreground = New MyColor(255, 255, 255) + End If + Case ColorState.Highlight + If Checked Then + SetResourceReference(BackgroundProperty, "ColorBrush3") + ShapeLogo.Fill = New MyColor(255, 255, 255) + LabText.Foreground = New MyColor(255, 255, 255) + Else + Background = ColorSemiTransparent + ShapeLogo.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush3") + LabText.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush3") + End If + End Select + + End If + Catch ex As Exception + Log(ex, "刷新按钮颜色出错") + End Try + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyResizer.vb b/Plain Craft Launcher 2/Controls/MyResizer.vb new file mode 100644 index 0000000..28afd44 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyResizer.vb @@ -0,0 +1,315 @@ +Imports System.Runtime.InteropServices +Imports System.Windows.Interop +Imports System.Windows.Threading + +Public Class MyResizer + + Private Delegate Sub RefreshDelegate() + + Private Structure POINT + Public x As Integer + Public y As Integer + Public Sub New(x As Integer, y As Integer) + Me.x = x + Me.y = y + End Sub + End Structure + Private Structure MINMAXINFO + Public ptReserved As POINT + Public ptMaxSize As POINT + Public ptMaxPosition As POINT + Public ptMinTrackSize As POINT + Public ptMaxTrackSize As POINT + End Structure + Private Structure RECT + Public left As Integer + Public top As Integer + Public right As Integer + Public bottom As Integer + Public Shared Empty As RECT = Nothing + + Public ReadOnly Property Width() As Integer + Get + Return Math.Abs(Me.right - Me.left) + End Get + End Property + Public ReadOnly Property Height() As Integer + Get + Return Me.bottom - Me.top + End Get + End Property + + Public Sub New(left As Integer, top As Integer, right As Integer, bottom As Integer) + Me.left = left + Me.top = top + Me.right = right + Me.bottom = bottom + End Sub + Public Sub New(rcSrc As RECT) + Me.left = rcSrc.left + Me.top = rcSrc.top + Me.right = rcSrc.right + Me.bottom = rcSrc.bottom + End Sub + End Structure + + + Private Class MONITORINFO + Public cbSize As Integer = Marshal.SizeOf(GetType(MONITORINFO)) + Public rcMonitor As RECT = Nothing + Public rcWork As RECT = Nothing + Public dwFlags As Integer = 0 + End Class + + Private Structure PointAPI + Public X As Integer + Public Y As Integer + End Structure + + Private ReadOnly target As Window = Nothing + + Private resizeRight As Boolean = False + Private resizeLeft As Boolean = False + Private resizeUp As Boolean = False + Private resizeDown As Boolean = False + + Private ReadOnly leftElements As New Dictionary(Of UIElement, Short)() + Private ReadOnly rightElements As New Dictionary(Of UIElement, Short)() + Private ReadOnly upElements As New Dictionary(Of UIElement, Short)() + Private ReadOnly downElements As New Dictionary(Of UIElement, Short)() + + Private startMousePoint As PointAPI = Nothing + Private startWindowSize As Size = Nothing + Private startWindowLeftUpPoint As POINT = Nothing + + Private Shared workAreaMaxHeight As Integer = -1 + + Private hs As HwndSource + + Public Sub New(target As Window) + Me.target = target + If IsNothing(target) Then Throw New Exception("Invalid Window handle") + AddHandler target.SourceInitialized, AddressOf Me.MyMacClass_SourceInitialized + End Sub + + Private Sub MyMacClass_SourceInitialized(sender As Object, e As EventArgs) + Me.hs = (TryCast(PresentationSource.FromVisual(CType(sender, Visual)), HwndSource)) + Me.hs.AddHook(AddressOf Me.WndProc) + End Sub + + Private Function WndProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr + If msg = 36 Then + WmGetMinMaxInfo(hwnd, lParam) + handled = True + End If + Return CType(0, IntPtr) + End Function + + Private Shared Sub WmGetMinMaxInfo(hwnd As IntPtr, lParam As IntPtr) + Dim mINMAXINFO As MINMAXINFO = CType(Marshal.PtrToStructure(lParam, GetType(MINMAXINFO)), MINMAXINFO) + Dim flags As Integer = 2 + Dim intPtr As IntPtr = MonitorFromWindow(hwnd, flags) + Dim flag As Boolean = intPtr <> IntPtr.Zero + If flag Then + Dim mONITORINFO As New MONITORINFO() + GetMonitorInfo(intPtr, mONITORINFO) + Dim rcWork As RECT = mONITORINFO.rcWork + Dim rcMonitor As RECT = mONITORINFO.rcMonitor + mINMAXINFO.ptMaxPosition.x = Math.Abs(rcWork.left - rcMonitor.left) + mINMAXINFO.ptMaxPosition.y = Math.Abs(rcWork.top - rcMonitor.top) + mINMAXINFO.ptMaxSize.y = Math.Abs(rcWork.bottom - rcWork.top) + workAreaMaxHeight = mINMAXINFO.ptMaxSize.y + If rcWork.Height = rcMonitor.Height Then + mINMAXINFO.ptMaxSize.y -= 2 + End If + End If + Marshal.StructureToPtr(mINMAXINFO, lParam, True) + End Sub + + Private Declare Function GetMonitorInfo Lib "user32" (hMonitor As IntPtr, lpmi As MONITORINFO) As Boolean + + Friend Declare Function MonitorFromWindow Lib "User32" (handle As IntPtr, flags As Integer) As IntPtr + + Private Sub connectMouseHandlers(element As UIElement) + AddHandler element.MouseLeftButtonDown, AddressOf Me.element_MouseLeftButtonDown + End Sub + + Public Sub addResizerRight(element As UIElement) + Me.connectMouseHandlers(element) + Me.rightElements.Add(element, 0) + End Sub + + Public Sub addResizerLeft(element As UIElement) + Me.connectMouseHandlers(element) + Me.leftElements.Add(element, 0) + End Sub + + Public Sub addResizerUp(element As UIElement) + Me.connectMouseHandlers(element) + Me.upElements.Add(element, 0) + End Sub + + Public Sub addResizerDown(element As UIElement) + Me.connectMouseHandlers(element) + Me.downElements.Add(element, 0) + End Sub + + Public Sub addResizerRightDown(element As UIElement) + Me.connectMouseHandlers(element) + Me.rightElements.Add(element, 0) + Me.downElements.Add(element, 0) + End Sub + + Public Sub addResizerLeftDown(element As UIElement) + Me.connectMouseHandlers(element) + Me.leftElements.Add(element, 0) + Me.downElements.Add(element, 0) + End Sub + + Public Sub addResizerRightUp(element As UIElement) + Me.connectMouseHandlers(element) + Me.rightElements.Add(element, 0) + Me.upElements.Add(element, 0) + End Sub + + Public Sub addResizerLeftUp(element As UIElement) + Me.connectMouseHandlers(element) + Me.leftElements.Add(element, 0) + Me.upElements.Add(element, 0) + End Sub + + Private Sub element_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) + GetCursorPos(startMousePoint) + startMousePoint.X = GetWPFSize(startMousePoint.X) + startMousePoint.Y = GetWPFSize(startMousePoint.Y) + startWindowSize = New Size(target.Width, target.Height) + startWindowLeftUpPoint = New POINT(target.Left, target.Top) + Dim key As UIElement = CType(sender, UIElement) + If leftElements.ContainsKey(key) Then resizeLeft = True + If rightElements.ContainsKey(key) Then resizeRight = True + If upElements.ContainsKey(key) Then resizeUp = True + If downElements.ContainsKey(key) Then resizeDown = True + RunInNewThread(AddressOf updateSizeLoop, "窗口大小调整检测") + End Sub + + Private Sub updateSizeLoop() + Try + While resizeDown OrElse resizeLeft OrElse resizeRight OrElse resizeUp + target.Dispatcher.Invoke(AddressOf updateSize, DispatcherPriority.Render) + target.Dispatcher.Invoke(AddressOf updateMouseDown, DispatcherPriority.Render) + Thread.Sleep(0) + End While + Catch + End Try + End Sub + + Private Sub updateSize() + Dim pointAPI As PointAPI = Nothing + GetCursorPos(pointAPI) + pointAPI.X = GetWPFSize(pointAPI.X) + pointAPI.Y = GetWPFSize(pointAPI.Y) + Try + + Dim NewWidth As Double = -1 + Dim NewHeight As Double = -1 + Dim NewLeft As Double = -10000 + Dim NewTop As Double = -10000 + + If resizeRight Then + If target.Width = target.MinWidth Then + If startMousePoint.X < pointAPI.X Then + NewWidth = startWindowSize.Width - (startMousePoint.X - pointAPI.X) + End If + Else + If startWindowSize.Width - ((startMousePoint.X - pointAPI.X)) >= target.MinWidth Then + NewWidth = startWindowSize.Width - (startMousePoint.X - pointAPI.X) + Else + NewWidth = target.MinWidth + End If + End If + End If + + If resizeDown Then + If target.Height = target.MinHeight Then + If startMousePoint.Y < pointAPI.Y Then + If workAreaMaxHeight > 0 Then + NewHeight = If((startWindowSize.Height - (startMousePoint.Y - pointAPI.Y) + target.Top <= workAreaMaxHeight), (startWindowSize.Height - ((startMousePoint.Y - pointAPI.Y))), ((workAreaMaxHeight) - target.Top)) + Else + NewHeight = startWindowSize.Height - (startMousePoint.Y - pointAPI.Y) + End If + End If + Else + If startWindowSize.Height - (startMousePoint.Y - pointAPI.Y) >= target.MinHeight Then + If workAreaMaxHeight > 0 Then + NewHeight = If((startWindowSize.Height - (startMousePoint.Y - pointAPI.Y) + target.Top <= (workAreaMaxHeight)), (startWindowSize.Height - (startMousePoint.Y - pointAPI.Y)), ((workAreaMaxHeight) - target.Top)) + Else + NewHeight = startWindowSize.Height - (startMousePoint.Y - pointAPI.Y) + End If + Else + NewHeight = target.MinHeight + End If + End If + End If + + If resizeLeft Then + If target.Width = target.MinWidth Then + If startMousePoint.X > pointAPI.X Then + NewWidth = startWindowSize.Width + startMousePoint.X - pointAPI.X + NewLeft = startWindowLeftUpPoint.x - (startMousePoint.X - pointAPI.X) + Else + NewWidth = target.MinWidth + NewLeft = startWindowLeftUpPoint.x + startWindowSize.Width - target.Width + End If + Else + If startWindowSize.Width + (startMousePoint.X - pointAPI.X) >= target.MinWidth Then + NewWidth = startWindowSize.Width + (startMousePoint.X - pointAPI.X) + NewLeft = startWindowLeftUpPoint.x - (startMousePoint.X - pointAPI.X) + Else + NewWidth = target.MinWidth + NewLeft = startWindowLeftUpPoint.x + startWindowSize.Width - target.Width + End If + End If + End If + + If resizeUp Then + If target.Height = target.MinHeight Then + If startMousePoint.Y > pointAPI.Y Then + NewHeight = startWindowSize.Height + startMousePoint.Y - pointAPI.Y + NewTop = startWindowLeftUpPoint.y - (startMousePoint.Y - pointAPI.Y) + Else + NewHeight = target.MinHeight + NewTop = startWindowLeftUpPoint.y + startWindowSize.Height - target.Height + End If + Else + If startWindowSize.Height + (startMousePoint.Y - pointAPI.Y) >= target.MinHeight Then + NewHeight = startWindowSize.Height + startMousePoint.Y - pointAPI.Y + NewTop = startWindowLeftUpPoint.y - (startMousePoint.Y - pointAPI.Y) + Else + NewHeight = target.MinHeight + NewTop = startWindowLeftUpPoint.y + startWindowSize.Height - target.Height + End If + End If + End If + + If NewWidth > 10 AndAlso Math.Abs(NewWidth - target.Width) > 0.7 Then target.Width = NewWidth + If NewHeight > 10 AndAlso Math.Abs(NewHeight - target.Height) > 0.7 Then target.Height = NewHeight + If NewLeft > -9999 AndAlso Math.Abs(NewLeft - target.Left) > 0.7 Then target.Left = NewLeft + If NewTop > -9999 AndAlso Math.Abs(NewTop - target.Top) > 0.7 Then target.Top = NewTop + + Catch + End Try + End Sub + + Private Sub updateMouseDown() + Dim flag As Boolean = Mouse.LeftButton = MouseButtonState.Released + If flag Then + resizeRight = False + resizeLeft = False + resizeUp = False + resizeDown = False + End If + End Sub + + Private Declare Function GetCursorPos Lib "user32.dll" ( ByRef lpPoint As PointAPI) As Boolean + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyScrollBar.vb b/Plain Craft Launcher 2/Controls/MyScrollBar.vb new file mode 100644 index 0000000..21f4de3 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyScrollBar.vb @@ -0,0 +1,51 @@ +Public Class MyScrollBar + Inherits Primitives.ScrollBar + + '基础 + + Public Uuid As Integer = GetUuid() + + '指向动画 + + Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.GotMouseCapture, Me.LostMouseCapture, Me.MouseEnter, Me.MouseLeave, Me.IsVisibleChanged + Try + + '判断当前颜色 + Dim NewOpacity As Double, NewColor As String, Time As Integer + If Not IsVisible Then + NewOpacity = 0 + Time = 20 '防止错误的尺寸判断导致闪烁 + NewColor = "ColorBrush4" + ElseIf IsMouseCaptureWithin Then + NewOpacity = 1 + NewColor = "ColorBrush4" + Time = 50 + ElseIf IsMouseOver Then + NewOpacity = 0.9 + NewColor = "ColorBrush3" + Time = 130 + Else + NewOpacity = 0.5 + NewColor = "ColorBrush4" + Time = 180 + End If + '触发颜色动画 + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + '有动画 + AniStart({ + AaColor(Me, ForegroundProperty, NewColor, Time), + AaOpacity(Me, NewOpacity - Opacity, Time) + }, "MyScrollBar Color " & Uuid) + Else + '无动画 + AniStop("MyScrollBar Color " & Uuid) + SetResourceReference(ForegroundProperty, NewColor) + Opacity = NewOpacity + End If + + Catch ex As Exception + Log(ex, "滚动条颜色改变出错") + End Try + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyScrollViewer.vb b/Plain Craft Launcher 2/Controls/MyScrollViewer.vb new file mode 100644 index 0000000..83b1245 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyScrollViewer.vb @@ -0,0 +1,27 @@ +Public Class MyScrollViewer + Inherits ScrollViewer + + Public Property DeltaMuity As Double = 1 + 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 + Dim SourceTypeName As String = e.Source.GetType.Name + If Content.TemplatedParent Is Nothing AndAlso (SourceTypeName.Contains("Combo") OrElse SourceTypeName = "MyTextBox") Then Exit Sub '确定可视树，防止滚动问题 + PerformVerticalOffsetDelta(-e.Delta) + e.Handled = True + End Sub + Public Sub PerformVerticalOffsetDelta(Delta As Double) + AniStart(AaDouble(Sub(AnimDelta As Double) + RealOffset = MathRange(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight) + ScrollToVerticalOffset(RealOffset) + End Sub, Delta * DeltaMuity, 300,, New AniEaseOutFluent(6))) + End Sub + Private Sub MyScrollViewer_ScrollChanged(sender As Object, e As ScrollChangedEventArgs) Handles Me.ScrollChanged + RealOffset = VerticalOffset + If FrmMain IsNot Nothing AndAlso (e.VerticalChange OrElse e.ViewportHeightChange) Then FrmMain.BtnExtraBack.ShowRefresh() + End Sub + Private Sub MyScrollViewer_IsVisibleChanged(sender As Object, e As DependencyPropertyChangedEventArgs) Handles Me.IsVisibleChanged + FrmMain.BtnExtraBack.ShowRefresh() + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MySearchBox.xaml b/Plain Craft Launcher 2/Controls/MySearchBox.xaml new file mode 100644 index 0000000..63b0e67 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MySearchBox.xaml @@ -0,0 +1,15 @@ + + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MySearchBox.xaml.vb b/Plain Craft Launcher 2/Controls/MySearchBox.xaml.vb new file mode 100644 index 0000000..c8ccf8d --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MySearchBox.xaml.vb @@ -0,0 +1,42 @@ +Class MySearchBox + Inherits MyCard + + Public Event TextChanged(ByVal sender As Object, ByVal e As EventArgs) + Private Sub MySearchBox_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + TextBox.Focus() + End Sub + + '属性 + Public Property HintText() As String + Get + Return TextBox.HintText + End Get + Set(ByVal value As String) + TextBox.HintText = value + End Set + End Property + Public Property Text() As String + Get + Return TextBox.Text + End Get + Set(ByVal value As String) + TextBox.Text = value + End Set + End Property + + Private Sub Text_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextBox.TextChanged + If String.IsNullOrEmpty(TextBox.Text) Then + AniStart(AaOpacity(BtnClear, -BtnClear.Opacity, 90), "MySearchBox ClearBtn " & Uuid) + BtnClear.IsHitTestVisible = False + Else + AniStart(AaOpacity(BtnClear, 1 - BtnClear.Opacity, 90), "MySearchBox ClearBtn " & Uuid) + BtnClear.IsHitTestVisible = True + End If + RaiseEvent TextChanged(sender, e) + End Sub + Private Sub BtnClear_Click(sender As Object, e As EventArgs) Handles BtnClear.Click + TextBox.Text = "" + TextBox.Focus() + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MySlider.xaml b/Plain Craft Launcher 2/Controls/MySlider.xaml new file mode 100644 index 0000000..402465e --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MySlider.xaml @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MySlider.xaml.vb b/Plain Craft Launcher 2/Controls/MySlider.xaml.vb new file mode 100644 index 0000000..1a2f278 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MySlider.xaml.vb @@ -0,0 +1,177 @@ +Public Class MySlider + + '基础 + + Public Uuid As Integer = GetUuid() + Public Event Change(sender As Object, user As Boolean) + Public Event PreviewChange(sender As Object, e As RouteEventArgs) + + '自定义属性 + + Private _MaxValue As Integer = 100 + Public Property MaxValue As Integer + Get + Return _MaxValue + End Get + Set(value As Integer) + If value = _MaxValue Then Exit Property + _MaxValue = value + RefreshWidth(Nothing, Nothing) + End Set + End Property + Private ChangeByKey As Boolean = False + Private _Value As Integer = 0 + Public Property Value As Integer + Get + Return _Value + End Get + Set(newValue As Integer) + Try + + newValue = MathRange(newValue, 0, MaxValue) + If _Value = newValue Then Exit Property + + '触发 Preview 事件，修改新值 + Dim OldValue = _Value + _Value = newValue + If AniControlEnabled = 0 Then + Dim e = New RouteEventArgs(False) + RaiseEvent PreviewChange(Me, e) + If e.Handled Then + _Value = OldValue + DragStop() + Exit Property + End If + End If + + If IsLoaded AndAlso AniControlEnabled = 0 Then + If ActualWidth < 16 Then Exit Property + Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - 16) + Dim DeltaProcess As Double = Math.Abs(LineFore.Width / (ActualWidth - 16) - _Value / MaxValue) + Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 300 + If(ChangeByKey, 100, 0) + AniStart({ + AaWidth(LineFore, Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5)) - LineFore.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)), + AaWidth(LineBack, Math.Max(0, ActualWidth - 16 - NewWidth + If(ActualWidth - 16 - NewWidth < 0.5, 0, 0.5)) - LineBack.Width, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)), + AaX(ShapeDot, NewWidth - ShapeDot.Margin.Left, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)) + }, "MySlider Progress " & Uuid) + Else + RefreshWidth(Nothing, Nothing) + End If + If AniControlEnabled = 0 Then RaiseEvent Change(Me, False) + + Catch ex As Exception + Log(ex, "滑动条进度改变出错", LogLevel.Hint) + End Try + End Set + End Property + Private Sub RefreshWidth(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged + If Not IsNothing(e) Then PanMain.Width = e.NewSize.Width + AniStop("MySlider Progress " & Uuid) + Dim NewWidth As Double = _Value / MaxValue * (ActualWidth - 16) + LineFore.Width = Math.Max(0, NewWidth + If(NewWidth < 0.5, 0, 0.5)) + LineBack.Width = Math.Max(0, ActualWidth - 16 - NewWidth + If(ActualWidth - 16 - NewWidth < 0.5, 0, 0.5)) + SetLeft(ShapeDot, NewWidth) + End Sub + + '拖动 + + Public GetHintText As [Delegate] + Private Sub DragStart(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown + e.Handled = True '防止 ScrollViewer 失焦问题 + DragControl = Me + FrmMain.DragDoing() + AniStart({ + AaScaleTransform(ShapeDot, 0.8 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 75,, New AniEaseOutFluent) + }, "MySlider Scale " & Uuid) + '更新 Popup + If GetHintText IsNot Nothing Then + TextHint.Text = GetHintText.DynamicInvoke(Value) + Popup.IsOpen = True + AniStop("MySlider KeyPopup " & Uuid) + End If + End Sub + Public Sub DragDoing() + Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).X - 8) / (ActualWidth - 16), 0, 1) + Dim NewValue As Integer = Percent * MaxValue + If Not NewValue = Value Then + Value = NewValue + End If + '更新 Popup + If GetHintText IsNot Nothing Then TextHint.Text = GetHintText.DynamicInvoke(NewValue) + End Sub + Public Sub DragStop() + RefreshColor() + AniStart({ + AaScaleTransform(ShapeDot, 1 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 200,, New AniEaseOutFluent) + }, "MySlider Scale " & Uuid) + If GetHintText IsNot Nothing Then Popup.IsOpen = False + End Sub + + '指向动画 + + Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave + Try + + '判断当前颜色 + Dim ColorName As String + Dim AnimationTime As Integer + If IsEnabled Then + If IsMouseOver OrElse (Not IsNothing(DragControl) AndAlso DragControl.Equals(Me)) Then + ColorName = "ColorBrush3" + AnimationTime = 100 + Else + ColorName = "ColorBrush1" + AnimationTime = 200 + End If + Else + ColorName = "ColorBrushGray4" + AnimationTime = 200 + End If + '触发颜色动画 + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + '有动画 + AniStart({AaColor(Me, BorderBrushProperty, ColorName, AnimationTime)}, "MySlider Color " & Uuid) + Else + '无动画 + AniStop("MySlider Color " & Uuid) + SetResourceReference(BorderBrushProperty, ColorName) + End If + + Catch ex As Exception + Log(ex, "滑动条颜色改变出错") + End Try + End Sub + + '按键改变 + + Public Property ValueByKey As UInteger = 1 + Private Sub MySlider_MouseEnter() Handles Me.MouseEnter + Focus() '确保按键能改变值 + End Sub + Private Sub MySlider_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown + '拒绝一边拖动一边用按键改变 + If ReferenceEquals(Me, DragControl) Then Exit Sub + '改变值 + If e.Key = Key.Left Then + ChangeByKey = True + Value -= ValueByKey + ChangeByKey = False + e.Handled = True + ElseIf e.Key = Key.Right Then + ChangeByKey = True + Value += ValueByKey + ChangeByKey = False + e.Handled = True + Else + Exit Sub + End If + '更新 Popup + If GetHintText IsNot Nothing Then + TextHint.Text = GetHintText.DynamicInvoke(Value) + Popup.IsOpen = True + AniStop("MySlider KeyPopup " & Uuid) + AniStart(AaCode(Sub() Popup.IsOpen = False, 700 * AniSpeed), "MySlider KeyPopup " & Uuid) + End If + End Sub + +End Class \ No newline at end of file diff --git a/Plain Craft Launcher 2/Controls/MySliderDot.xaml b/Plain Craft Launcher 2/Controls/MySliderDot.xaml new file mode 100644 index 0000000..625d76d --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MySliderDot.xaml @@ -0,0 +1,19 @@ + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Controls/MySliderDot.xaml.vb b/Plain Craft Launcher 2/Controls/MySliderDot.xaml.vb new file mode 100644 index 0000000..e5edbc7 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MySliderDot.xaml.vb @@ -0,0 +1,169 @@ +Public Class MySliderDot + + '基础 + + Public Uuid As Integer = GetUuid() + Public Event Change(sender As Object, user As Boolean) + Public Event PreviewChange(sender As Object, e As RouteEventArgs) + + '自定义属性 + + Private _MaxValue As Integer = 100 + Public Property MaxValue As Integer + Get + Return _MaxValue + End Get + Set(value As Integer) + If value = _MaxValue Then Exit Property + _MaxValue = value + RefreshHeight(Nothing, Nothing) + End Set + End Property + Private ChangeByKey As Boolean = False + Private _Value As Integer = 0 + Public Property Value As Integer + Get + Return _Value + End Get + Set(newValue As Integer) + Try + + newValue = MathRange(newValue, 0, MaxValue) + If _Value = newValue Then Exit Property + + '触发前瞻事件，修改新值 + Dim OldValue = _Value + _Value = newValue + If AniControlEnabled = 0 Then + Dim e = New RouteEventArgs(False) + RaiseEvent PreviewChange(Me, e) + If e.Handled Then + _Value = OldValue + Exit Property + End If + End If + + If IsLoaded AndAlso AniControlEnabled = 0 Then + If ActualHeight < 16 Then Exit Property + Dim NewHeight As Double = _Value / MaxValue * (ActualHeight - 16) + Dim DeltaProcess As Double = Math.Abs(LineFore.Height / (ActualHeight - 16) - _Value / MaxValue) + Dim Time As Double = (1 - Math.Pow(1 - DeltaProcess, 3)) * 400 + If(ChangeByKey, 100, 0) + AniStart({ + AaHeight(LineFore, Math.Max(0, NewHeight + If(NewHeight < 0.5, 0, 0.5)) - LineFore.Height, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)), + AaHeight(LineBack, Math.Max(0, ActualHeight - 16 - NewHeight + If(ActualHeight - 16 - NewHeight < 0.5, 0, 0.5)) - LineBack.Height, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)), + AaY(ShapeDot, NewHeight - ShapeDot.Margin.Top, Time,, If(Time > 50, New AniEaseOutFluent, New AniEaseLinear)) + }, "MySlider Progress " & Uuid) + Else + RefreshHeight(Nothing, Nothing) + End If + If AniControlEnabled = 0 Then RaiseEvent Change(Me, False) + + Catch ex As Exception + Log(ex, "滑动条进度改变出错", LogLevel.Hint) + End Try + End Set + End Property + Private Sub RefreshHeight(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged + If Not IsNothing(e) Then PanMain.Height = e.NewSize.Height + AniStop("MySlider Progress " & Uuid) + Dim NewHeight As Double = _Value / MaxValue * (ActualHeight - 16) + LineFore.Height = Math.Max(0, NewHeight + If(NewHeight < 0.5, 0, 0.5)) + LineBack.Height = Math.Max(0, ActualHeight - 16 - NewHeight + If(ActualHeight - 16 - NewHeight < 0.5, 0, 0.5)) + SetTop(ShapeDot, NewHeight) + End Sub + + '拖动 + + Public GetHintText As [Delegate] + Private Sub DragStart(sender As Object, e As MouseButtonEventArgs) Handles ShapeDot.MouseLeftButtonDown + e.Handled = True '防止 ScrollViewer 失焦问题 + DragControl = Me + AniStart({ + AaScaleTransform(ShapeDot, 2 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseOutFluent) + }, "MySlider Scale " & Uuid) + End Sub + Public Sub DragDoing() + Dim Percent As Double = MathRange((Mouse.GetPosition(PanMain).Y - 8) / (ActualHeight - 16), 0, 1) + Dim NewValue As Integer = Percent * MaxValue + If Not NewValue = Value Then Value = NewValue + End Sub + Public Sub DragStop() + RefreshColor() + AniStart({ + AaScaleTransform(ShapeDot, 2.3 - CType(ShapeDot.RenderTransform, ScaleTransform).ScaleX, 200,, New AniEaseOutFluent) + }, "MySlider Scale " & Uuid) + If Value > 0 Then + Value = MaxValue + Else + FrmMain.SliderDrag_Finish() + End If + End Sub + + '指向动画 + + Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave + 'Try + + ' '判断当前颜色 + ' Dim ColorName As String + ' Dim AnimationTime As Integer + ' If IsEnabled Then + ' If IsMouseOver OrElse (Not IsNothing(DragControl) AndAlso DragControl.Equals(Me)) Then + ' ColorName = "ColorBrush3" + ' AnimationTime = 100 + ' Else + ' ColorName = "ColorBrush1" + ' AnimationTime = 200 + ' End If + ' Else + ' ColorName = "ColorBrushGray4" + ' AnimationTime = 200 + ' End If + ' '触发颜色动画 + ' If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + ' '有动画 + ' AniStart({AaColor(Me, BorderBrushProperty, ColorName, AnimationTime)}, "MySlider Color " & Uuid) + ' Else + ' '无动画 + ' AniStop("MySlider Color " & Uuid) + ' SetResourceReference(BorderBrushProperty, ColorName) + ' End If + + 'Catch ex As Exception + ' Log(ex, "滑动条颜色改变出错") + 'End Try + End Sub + + '按键改变 + + 'Public Property ValueByKey As UInteger = 1 + 'Private Sub MySlider_MouseEnter() Handles Me.MouseEnter + ' Focus() '确保按键能改变值 + 'End Sub + 'Private Sub MySlider_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown + ' '拒绝一边拖动一边用按键改变 + ' If ReferenceEquals(Me, DragControl) Then Exit Sub + ' '改变值 + ' If e.Key = Key.Left Then + ' ChangeByKey = True + ' Value -= ValueByKey + ' ChangeByKey = False + ' e.Handled = True + ' ElseIf e.Key = Key.Right Then + ' ChangeByKey = True + ' Value += ValueByKey + ' ChangeByKey = False + ' e.Handled = True + ' Else + ' Exit Sub + ' End If + ' '更新 Popup + ' If GetHintText IsNot Nothing Then + ' TextHint.Text = GetHintText.DynamicInvoke(Value) + ' Popup.IsOpen = True + ' AniStop("MySlider KeyPopup " & Uuid) + ' AniStart(AaCode(Sub() Popup.IsOpen = False, 700 * AniSpeed), "MySlider KeyPopup " & Uuid) + ' End If + 'End Sub + +End Class \ No newline at end of file diff --git a/Plain Craft Launcher 2/Controls/MyTextBox.vb b/Plain Craft Launcher 2/Controls/MyTextBox.vb new file mode 100644 index 0000000..ec3b9cf --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyTextBox.vb @@ -0,0 +1,277 @@ +Public Class MyTextBox + Inherits TextBox + + '自定义属性 + + Public Property HasAnimation As Boolean = True + Public Property ShowValidateResult As Boolean = True + + '额外控件初始化 + + Private _labWrong As TextBlock = Nothing + Private ReadOnly Property labWrong As TextBlock + Get + If Template Is Nothing Then Return Nothing + If _labWrong Is Nothing Then _labWrong = Template.FindName("labWrong", Me) + Return _labWrong + End Get + End Property + Private _labHint As TextBlock = Nothing + Private ReadOnly Property labHint As TextBlock + Get + If Template Is Nothing Then Return Nothing + If _labHint Is Nothing Then _labHint = Template.FindName("labHint", Me) + Return _labHint + End Get + End Property + Public Overrides Sub OnApplyTemplate() + MyBase.OnApplyTemplate() + If HintText = "" OrElse labHint.Text <> "" Then Exit Sub + labHint.Text = If(Text = "", HintText, "") + End Sub + + '事件 + + Public Uuid As Integer = GetUuid() + Public Shared Event ValidateChanged(sender As Object, e As EventArgs) + Public ChangedEventList As New List(Of RoutedEventHandler) + Public Custom Event ValidatedTextChanged As RoutedEventHandler + AddHandler(value As RoutedEventHandler) + ChangedEventList.Add(value) + End AddHandler + RemoveHandler(value As RoutedEventHandler) + ChangedEventList.Remove(value) + End RemoveHandler + RaiseEvent(sender As Object, e As TextChangedEventArgs) + For Each handler As RoutedEventHandler In ChangedEventList + If Not IsNothing(handler) Then handler.Invoke(sender, e) + Next + End RaiseEvent + End Event + + '输入验证 + + ''' + ''' 输入验证结果。若为空字符串则无错误，否则为第一个错误原因。 + ''' + Public Property ValidateResult As String + Get + Return GetValue(ValidateResultProperty) + End Get + Set(value As String) + SetValue(ValidateResultProperty, value) + End Set + End Property + Public Shared ReadOnly ValidateResultProperty As DependencyProperty = DependencyProperty.Register("ValidateResult", GetType(String), GetType(MyTextBox), New PropertyMetadata("")) + ''' + ''' 输入验证的规则。 + ''' + Public Property ValidateRules As ObjectModel.Collection(Of Validate) + Get + Return _ValidateRules + End Get + Set(Value As ObjectModel.Collection(Of Validate)) + _ValidateRules = Value + Validate() + End Set + End Property + Private _ValidateRules As New ObjectModel.Collection(Of Validate) + ''' + ''' 进行输入验证。 + ''' + Public Sub Validate() Handles Me.Loaded + '执行输入验证 + ValidateResult = "" + For Each ValidateRule As Validate In ValidateRules + ValidateResult = ValidateRule.Validate(Text) + If IsNothing(ValidateResult) OrElse Not ValidateResult = "" Then Exit For + Next + Dim NewResult As Integer = If(ValidateResult = "", 0, 1) + '根据结果改变样式 + If ShownValidateResult <> NewResult Then + If IsLoaded AndAlso labWrong IsNot Nothing Then + ChangeValidateResult(ValidateResult = "", True) + Else + RunInNewThread(Sub() + Thread.Sleep(30) + RunInUi(Sub() ChangeValidateResult(NewResult, False)) + End Sub, "DelayedValidate Change") + End If + End If + '更新错误信息 + If ShowValidateResult AndAlso Not ValidateResult = "" Then + If IsLoaded AndAlso labWrong IsNot Nothing Then + labWrong.Text = ValidateResult + Else + RunInNewThread(Sub() + Dim IsFinished As Boolean = False + Do Until IsFinished + Thread.Sleep(20) + RunInUiWait(Sub() + If labWrong IsNot Nothing Then + labWrong.Text = ValidateResult + IsFinished = True + End If + If Not IsLoaded Then IsFinished = True + End Sub) + Loop + End Sub, "DelayedValidate Text") + End If + End If + End Sub + Private ShownValidateResult As Integer = -1 + Private Sub ChangeValidateResult(NewResult As Boolean, IsLoaded As Boolean) + If IsLoaded AndAlso AniControlEnabled = 0 AndAlso IsTextChanged AndAlso labWrong IsNot Nothing Then + If NewResult Then + '变为正确 + ShownValidateResult = 0 + AniStart({ + AaOpacity(labWrong, -labWrong.Opacity, 150), + AaHeight(labWrong, -labWrong.Height, 150,, New AniEaseOutFluent), + AaCode(Sub() labWrong.Visibility = Visibility.Collapsed,, True) + }, "MyTextBox Validate " & Uuid) + ElseIf ShowValidateResult Then + '变为错误 + ShownValidateResult = 1 + labWrong.Visibility = Visibility.Visible + AniStart({ + AaOpacity(labWrong, 1 - labWrong.Opacity, 170), + AaHeight(labWrong, 21 - labWrong.Height, 300,, New AniEaseOutBack(AniEasePower.Weak)) + }, "MyTextBox Validate " & Uuid) + Else + '变为错误，但不显示文本 + ShownValidateResult = 2 + End If + Else + ShownValidateResult = 3 + 'AniStop("MyTextBox Validate " & Uuid) + 'If NewResult Then + ' '变为正确 + ' labWrong.Opacity = 0 + ' labWrong.Height = 0 + ' labWrong.Visibility = Visibility.Collapsed + 'Else + ' '变为错误 + ' labWrong.Visibility = Visibility.Visible + ' labWrong.Text = ValidateResult + ' labWrong.Opacity = 1 + ' labWrong.Height = 20.5 + 'End If + 'Dim OriginalEnabled As Integer = AniControlEnabled + 'AniControlEnabled += 1 + 'RefreshColor() + 'AniControlEnabled = OriginalEnabled + End If + RefreshColor() + RaiseEvent ValidateChanged(Me, New EventArgs) + End Sub + + '提示文本 + + ''' + ''' 是否已经由用户输入过文本，若尚未输入过，则不显示输入检查的失败。 + ''' + Private IsTextChanged As Boolean = False + Private _HintText As String = "" + Public Property HintText As String + Get + Return _HintText + End Get + Set(value As String) + _HintText = value + If labHint IsNot Nothing Then labHint.Text = If(Text = "", HintText, "") + End Set + End Property + Private Sub MyTextBox_TextChanged(sender As MyTextBox, e As TextChangedEventArgs) Handles Me.TextChanged + Try + '改变提示文本 + If labHint IsNot Nothing Then labHint.Text = If(Text = "", HintText, "") + '改变输入记录 + IsTextChanged = IsLoaded + '进行输入验证 + Validate() + If Not ValidateResult = "" Then Exit Sub + '改变文本 + RaiseEvent ValidatedTextChanged(sender, e) + Catch ex As Exception + Log(ex, "进行输入验证时出错", LogLevel.Assert) + End Try + End Sub + + '颜色 + + Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.GotFocus, Me.LostFocus + Try + '手动关闭动画 + If Not HasAnimation Then Exit Sub + '不对 ComboBox 从属进行动画 + If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Exit Sub + '判断当前颜色 + Dim ForeColorName As String, BackColorName As String + Dim AnimationTime As Integer + If IsEnabled Then + If ValidateResult = "" OrElse Not IsTextChanged Then + If IsFocused Then + ForeColorName = "ColorBrush4" + BackColorName = "ColorBrush9" + AnimationTime = 60 + ElseIf IsMouseOver Then + ForeColorName = "ColorBrush3" + BackColorName = "ColorBrushHalfWhite" + AnimationTime = 100 + Else + ForeColorName = "ColorBrush1" + BackColorName = "ColorBrushHalfWhite" + AnimationTime = 200 + End If + Else + ForeColorName = "ColorBrushRedLight" + BackColorName = "ColorBrushRedBack" + AnimationTime = 200 + 'If IsFocused OrElse IsMouseOver Then + ' ForeColorName = "ColorBrushRedLight" + ' BackColorName = "ColorBrushRedBack" + ' AnimationTime = 100 + 'Else + ' ForeColorName = "ColorBrushRedDark" + ' BackColorName = "ColorBrushHalfWhite" + ' AnimationTime = 200 + 'End If + End If + Else + ForeColorName = "ColorBrushGray4" + BackColorName = "ColorBrushHalfWhite" + AnimationTime = 200 + End If + '触发颜色动画 + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + '有动画 + AniStart({ + AaColor(Me, BorderBrushProperty, ForeColorName, AnimationTime)， + AaColor(Me, BackgroundProperty, BackColorName, AnimationTime) + }, "MyTextBox Color " & Uuid) + Else + '无动画 + AniStop("MyTextBox Color " & Uuid) + SetResourceReference(BorderBrushProperty, ForeColorName) + SetResourceReference(BackgroundProperty, BackColorName) + End If + + Catch ex As Exception + Log(ex, "文本框颜色改变出错") + End Try + 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 IsLoaded AndAlso AniControlEnabled = 0 AndAlso Not Text = "" Then + '有动画 + AniStart({AaColor(Me, ForegroundProperty, If(IsEnabled, "ColorBrushGray1", "ColorBrushGray4"), 200)}, "MyTextBox TextColor " & Uuid) + Else + '无动画 + AniStop("MyTextBox TextColor " & Uuid) + Foreground = NewColor + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Controls/MyTextButton.vb b/Plain Craft Launcher 2/Controls/MyTextButton.vb new file mode 100644 index 0000000..9b56fa8 --- /dev/null +++ b/Plain Craft Launcher 2/Controls/MyTextButton.vb @@ -0,0 +1,110 @@ +Public Class MyTextButton + Inherits Label + + Public Event Click(sender As Object, e As EventArgs) + + '基础 + + Public Uuid As Integer = GetUuid() + Public Sub New() + SetResourceReference(ForegroundProperty, "ColorBrush1") + Background = ColorSemiTransparent + End Sub + + '文本 + + Public Property Text As String + Get + Return GetValue(TextProperty) + End Get + Set(value As String) + SetValue(TextProperty, value) + End Set + End Property + Public Shared ReadOnly TextProperty As DependencyProperty = + DependencyProperty.Register("Text", GetType(String), GetType(MyTextButton), New PropertyMetadata("", Sub(sender As MyTextButton, e As DependencyPropertyChangedEventArgs) + If Not e.OldValue = e.NewValue Then + AniStart({ + AaOpacity(sender, -sender.Opacity, 50), + AaCode(Sub() sender.Content = e.NewValue,, True), + AaOpacity(sender, 1, 170) + }, "MyTextButton Text " & sender.Uuid) + End If + End Sub)) + + '鼠标事件 + + Public IsMouseDown As Boolean = False + Private Sub MyTextButton_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown + IsMouseDown = True + e.Handled = True + End Sub + Private Sub MyTextButton_MouseLeave() Handles Me.MouseLeave + IsMouseDown = False + End Sub + Private Sub MyTextButton_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp + If IsMouseDown Then + IsMouseDown = False + Log("[Control] 按下文本按钮：" & Text) + RaiseEvent Click(Me, Nothing) + ModEvent.TryStartEvent(EventType, EventData) + e.Handled = True + End If + End Sub + + '指向动画 + + Private Const AnimationTimeIn As Integer = 100 + Private Const AnimationTimeOut As Integer = 200 + Private ColorName As String + Private Sub RefreshColor() Handles Me.MouseEnter, Me.MouseLeave, Me.IsEnabledChanged, Me.MouseLeftButtonDown， Me.MouseLeftButtonUp + '判断当前颜色 + Dim ForeName As String + Dim Time As Integer + If IsMouseDown Then + ForeName = "ColorBrush4" + Time = 30 + ElseIf IsMouseOver Then + ForeName = "ColorBrush3" + Time = AnimationTimeIn + Else + ForeName = "ColorBrush1" + Time = AnimationTimeOut + End If + '重复性验证 + If ColorName = ForeName Then Exit Sub + ColorName = ForeName + '触发颜色动画 + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + '有动画 + AniStart(AaColor(Me, ForegroundProperty, ForeName, Time), "MyTextButton Color " & Uuid) + Else + '无动画 + AniStop("MyTextButton Color " & Uuid) + SetResourceReference(ForegroundProperty, ForeName) + End If + End Sub + + '实现自定义事件 + Public Property EventType As String + Get + Return GetValue(EventTypeProperty) + End Get + + Set(ByVal value As String) + SetValue(EventTypeProperty, value) + End Set + End Property + Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing)) + Public Property EventData As String + Get + Return GetValue(EventDataProperty) + End Get + + Set(ByVal value As String) + SetValue(EventDataProperty, value) + End Set + End Property + Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing)) + +End Class diff --git a/Plain Craft Launcher 2/FormMain.xaml b/Plain Craft Launcher 2/FormMain.xaml new file mode 100644 index 0000000..a003ce7 --- /dev/null +++ b/Plain Craft Launcher 2/FormMain.xaml @@ -0,0 +1,179 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb new file mode 100644 index 0000000..a31d532 --- /dev/null +++ b/Plain Craft Launcher 2/FormMain.xaml.vb @@ -0,0 +1,1509 @@ +Imports System.ComponentModel + +Public Class FormMain + +#Region "基础" + + '更新日志 + Private Sub ShowUpdateLog(LastVersion As Integer) + Dim FeatureCount As Integer = 0, BugCount As Integer = 0 + Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) + '统计更新日志条目 +#If BETA Then + If LastVersion < 257 Then 'Release 2.3.0 + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复下载部分 Mod、整合包的 Bug")) + FeatureCount += 4 + BugCount += 4 + End If + If LastVersion < 255 Then 'Release 2.2.14 + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动 Minecraft 1.19-Pre1 的 Bug")) + FeatureCount += 5 + BugCount += 3 + End If + If LastVersion < 253 Then 'Release 2.2.13 + FeatureList.Add(New KeyValuePair(Of Integer, String)(7, "支持在安装菜单中直接安装 OptiFabric")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持调整 Mod 文件名中中文译名的位置")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "崩溃分析优化，支持分析更多 Forge 相关的崩溃")) + FeatureCount += 13 + BugCount += 27 + End If + If LastVersion < 250 Then 'Release 2.2.11 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "支持将 Mod 文件拖入窗口进行安装")) + If LastVersion = 246 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法使用中文搜索 Mod 的 Bug")) + FeatureCount += 8 + BugCount += 33 + End If + If LastVersion < 246 Then 'Release 2.2.9 + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "Mod 下载支持筛选 Forge Mod 与 Fabric Mod")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "大幅修改联机页面布局（作为联机优化的第二个阶段）")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod、整合包下载的综合优化")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复使用离线登录进入 Forge 的存档可能导致游戏崩溃")) + FeatureCount += 13 + BugCount += 11 + End If + If LastVersion < 242 Then 'Release 2.2.7 + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复 MC 所包含的一个严重安全漏洞")) + If LastVersion >= 236 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复可能无法更改登录信息的 Bug")) + End If + If LastVersion < 238 Then 'Release 2.2.6 + If LastVersion = 236 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法使用联机模块的 Bug")) + FeatureCount += 1 + BugCount += 2 + End If + If LastVersion < 236 Then 'Release 2.2.5 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "网络状态检测支持检测 Windows 防火墙与网络延迟")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "重制右侧页面的切换动画，卡片与提示条将逐个进入退出，并具有独特的位移动画")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "添加 MC 1.18 中要求 Java 17 的检测与提醒")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化页面切换、下载的性能")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "允许拖拽按钮的设置第三方登录")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复网络状态检测的结果总为 A 级的 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法下载新版本的 Forge 的 Bug")) + FeatureCount += 25 + BugCount += 22 + End If + If LastVersion < 233 Then 'Release 2.2.3 + FeatureList.Add(New KeyValuePair(Of Integer, String)(7, "微软账号支持更换皮肤与披风")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "支持拖拽整合包文件到 PCL2 进行快捷安装")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "Mod 下载支持显示对应的 MC 版本与 Mod 加载器，且可以跳转到 MCBBS 介绍页")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持安装 1.17 OptiFine + Forge")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "使用 Mojang 账号登录将会显示迁移提醒")) + FeatureCount += 12 + BugCount += 26 + End If + If LastVersion < 231 Then 'Release 2.2.1, Also 229 + FeatureList.Add(New KeyValuePair(Of Integer, String)(9, "联机功能的早期测试（尚未完成，延迟很高，之后会优化的）")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "添加 1.18 实验性快照 5 的特供下载，且支持列表的联网更新")) + FeatureCount += 11 + BugCount += 3 + End If + If LastVersion < 226 Then 'Release 2.1.4 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "支持 1.17.1 Forge、Fabric 的安装与启动")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化 Forge 下载与安装速度，提高安装稳定性")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "更新内置帮助库，添加数个指南页面与整合包、存档的安装教程")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持将游戏文件夹压缩包作为游戏整合包导入")) + FeatureCount += 12 + BugCount += 13 + End If + If LastVersion < 224 Then 'Release 2.1.3 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "界面与动画综合优化，重新制作主题配色")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "添加 1.18 实验性快照的特供下载")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "更新内置帮助库，添加光影、数据包、Mod 等资源的安装教程")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "游戏崩溃分析优化")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "若设置为自动更新，PCL2 会在关闭时才替换文件")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "追加大量千万████的可能性")) + 'FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持 1.17 Forge 的安装与启动")) + FeatureCount += 33 + BugCount += 20 + End If + If LastVersion < 217 Then 'Release 2.0.5 + FeatureList.Add(New KeyValuePair(Of Integer, String)(7, "可以根据游戏版本自动选择所需的 Java")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "允许在 Java 版本检测不通过时强制指定使用 Java")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "允许为不同版本独立设置 Java")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "Java 选择与搜索的综合优化")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法使用 Mod、整合包搜索功能的 Bug")) + FeatureCount += 8 + BugCount += 20 + End If + If LastVersion < 214 Then 'Release 2.0.2 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "添加一键关闭所有运行中的 Minecraft 的按钮")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "增加对 MC 1.17 需要 Java 16 的检测与说明")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Minecraft 崩溃分析优化")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法修改部分个性化设置的严重 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 Windows 7 可能无法登录微软账号的严重 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复网络不稳定时安装整合包极易失败的严重 Bug")) + FeatureCount += 10 + BugCount += 13 + End If + If LastVersion < 212 Then 'Release 2.0.0 + FeatureList.Add(New KeyValuePair(Of Integer, String)(9, "添加帮助页面，且可以自行添加、删除其中的内容")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "支持安装 MCBBS 格式的整合包")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "自定义主页/帮助页面的 XAML 功能扩展")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "同时安装 OptiFine 与 Forge 时，OptiFine 将作为 Mod 安装")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化 CurseForge 搜索")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化多个报错提示，更加人性化")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "适配适用于快照版 MC 的 OptiFine")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复进入 OptiFine 下载页面导致卡死的严重 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动部分 OptiFine+Forge 版本的 Bug")) + FeatureCount += 20 + BugCount += 42 + End If +#Else + '9：大+ + '8：中大+ + '7：中+，大* + '6：中小型+，中大* + '5：小型+，中* + '4：中小* + '3：小* + '2：极度严重的 Bug + '1：严重的 Bug + If LastVersion < 259 Then 'Snapshot 2.3.1 + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题")) + FeatureCount += 14 + End If + If LastVersion < 258 Then 'Snapshot 2.3.0 + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复下载部分 Mod、整合包的 Bug")) + FeatureCount += 4 + BugCount += 4 + End If + If LastVersion < 256 Then 'Snapshot 2.2.14 + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动 Minecraft 1.19-Pre1 的 Bug")) + FeatureCount += 5 + BugCount += 3 + End If + If LastVersion < 254 Then 'Snapshot 2.2.13 + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持调整 Mod 文件名中中文译名的位置")) + FeatureCount += 3 + BugCount += 17 + End If + If LastVersion < 252 Then 'Snapshot 2.2.12 + FeatureList.Add(New KeyValuePair(Of Integer, String)(7, "支持在安装菜单中直接安装 OptiFabric")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "崩溃分析优化，支持分析更多 Forge 相关的崩溃")) + If LastVersion = 251 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复同时安装 Forge 和 OptiFine 时 OptiFine 无效的 Bug")) + FeatureCount += 10 + BugCount += 10 + End If + If LastVersion < 251 Then 'Snapshot 2.2.11 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "支持将 Mod 文件拖入窗口进行安装")) + FeatureCount += 2 + BugCount += 16 + End If + If LastVersion < 249 Then 'Snapshot 2.2.10 + If LastVersion = 247 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法使用中文搜索 Mod 的 Bug")) + FeatureCount += 6 + BugCount += 17 + End If + If LastVersion < 247 Then 'Snapshot 2.2.9 + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "Mod 下载支持筛选 Forge Mod 与 Fabric Mod")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod、整合包下载的综合优化")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复使用离线登录进入 Forge 的存档可能导致游戏崩溃")) + FeatureCount += 8 + BugCount += 4 + End If + If LastVersion < 245 Then 'Snapshot 2.2.8 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "大幅修改联机页面布局（作为联机优化的第二个阶段）")) + FeatureCount += 5 + BugCount += 7 + End If + If LastVersion < 243 Then 'Snapshot 2.2.7 + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复 MC 所包含的一个严重安全漏洞")) + If LastVersion >= 236 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复可能无法更改登录信息的 Bug")) + End If + If LastVersion < 239 Then 'Snapshot 2.2.6 + If LastVersion >= 235 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复自动更新由于路径错误失败的 Bug")) + If LastVersion = 237 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法使用联机模块的 Bug")) + FeatureCount += 1 + BugCount += 1 + End If + If LastVersion < 237 Then 'Snapshot 2.2.5 + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "允许拖拽按钮的设置第三方登录")) + If LastVersion = 235 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复在启动游戏时有可能卡死的 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法下载新版本的 Forge 的 Bug")) + FeatureCount += 2 + BugCount += 3 + End If + If LastVersion < 235 Then 'Snapshot 2.2.4 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "网络状态检测支持检测 Windows 防火墙与网络延迟")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "重制右侧页面的切换动画，卡片与提示条将逐个进入退出，并具有独特的位移动画")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "添加 MC 1.18 中要求 Java 17 的检测与提醒")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化页面切换、下载的性能")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复网络状态检测的结果总为 A 级的 Bug")) + FeatureCount += 23 + BugCount += 19 + End If + If LastVersion < 234 Then 'Snapshot 2.2.3 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "支持拖拽整合包文件到 PCL2 进行快捷安装")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持安装 1.17 OptiFine + Forge")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "Mod 详情页面支持跳转 MCBBS 介绍页")) + FeatureCount += 10 + BugCount += 17 + End If + If LastVersion < 232 Then 'Snapshot 2.2.2 + FeatureList.Add(New KeyValuePair(Of Integer, String)(7, "微软账号支持更换皮肤与披风")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "支持显示 Mod 与整合包对应的 MC 版本与 Mod 加载器名称")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "使用 Mojang 账号登录将会显示迁移提醒")) + FeatureCount += 2 + BugCount += 9 + End If + If LastVersion < 230 Then 'Snapshot 2.2.1, Also 228 + If LastVersion = 227 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "联机功能的小优化")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "添加 1.18 实验性快照 5 的特供下载，且支持列表的联网更新")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复 Win7 上使用联机功能导致日志文件极大，占用硬盘空间的 Bug")) + FeatureCount += 12 + BugCount += 4 + End If + If LastVersion < 227 Then 'Snapshot 2.2.0 + FeatureList.Add(New KeyValuePair(Of Integer, String)(9, "新增联机功能的早期测试版本")) + FeatureCount += 2 + BugCount += 2 + End If + If LastVersion < 225 Then 'Snapshot 2.1.4 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "支持 1.17.1 Forge、Fabric 的安装与启动")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化 Forge 下载与安装速度，提高安装稳定性")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "更新内置帮助库，添加数个指南页面与整合包、存档的安装教程")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持将游戏文件夹压缩包作为游戏整合包导入")) + FeatureCount += 12 + BugCount += 13 + End If + If LastVersion < 223 Then 'Snapshot 2.1.3 + BugCount += 4 + End If + If LastVersion < 222 Then 'Snapshot 2.1.2 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "更新内置帮助库，添加光影、数据包、Mod 的安装教程")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "游戏崩溃分析优化")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复登录微软账号启动游戏时报错的 Bug")) + FeatureCount += 8 + BugCount += 11 + End If + If LastVersion < 221 Then 'Snapshot 2.1.1 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "界面与动画综合优化，重新制作主题配色")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "若识别码不变，更新密钥在输入一次后会一直有效")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "若设置为自动更新，PCL2 会在关闭时才替换文件")) + FeatureCount += 10 + BugCount += 5 + End If + If LastVersion < 220 Then 'Snapshot 2.1.0 + 'FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "界面与动画综合优化")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "追加大量千万████的可能性")) + FeatureCount += 15 + End If + If LastVersion < 219 Then 'Snapshot 2.0.5 + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法使用 Mod、整合包搜索功能的 Bug")) + BugCount += 2 + End If + If LastVersion < 218 Then 'Snapshot 2.0.4 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "允许为不同版本独立设置 Java")) + BugCount += 12 + End If + If LastVersion < 216 Then 'Snapshot 2.0.3 + FeatureList.Add(New KeyValuePair(Of Integer, String)(7, "可以根据游戏版本自动选择所需的 Java")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "允许在 Java 版本检测不通过时强制指定使用 Java")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "Java 选择与搜索的综合优化")) + FeatureCount += 8 + BugCount += 7 + End If + If LastVersion < 215 Then 'Snapshot 2.0.2 + If LastVersion = 213 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复账号切换、版本选择下拉框无法展开的严重 Bug")) + If LastVersion = 213 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复误判部分客户端需要 Java 16，导致无法启动游戏的严重 Bug")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 Windows 7 可能无法登录微软账号的严重 Bug")) + BugCount += 1 + End If + If LastVersion < 213 Then 'Snapshot 2.0.1 + FeatureList.Add(New KeyValuePair(Of Integer, String)(6, "添加一键关闭所有运行中的 Minecraft 的按钮")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "增加对 MC 1.17 需要 Java 16 的检测与说明")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Minecraft 崩溃分析优化")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复网络不稳定时安装整合包极易失败的严重 Bug")) + FeatureCount += 10 + BugCount += 12 + End If + If LastVersion < 211 Then 'Snapshot 2.0.0 + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "适配适用于快照版 MC 的 OptiFine")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复进入 OptiFine 下载页面导致卡死的严重 Bug")) + BugCount += 3 + End If +#End If + '整理更新日志文本 + Dim ContentList As New List(Of String) + Dim SortedFeatures = Sort(FeatureList, Function(Left As KeyValuePair(Of Integer, String), Right As KeyValuePair(Of Integer, String)) As Boolean + Return Left.Key > Right.Key + End Function) + If SortedFeatures.Count = 0 AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then + ContentList.Add("龙猫忘记写更新日志啦！可以去提醒他一下……") + End If + For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项 + ContentList.Add(SortedFeatures(i).Value) + Next + If SortedFeatures.Count > 10 Then FeatureCount += SortedFeatures.Count - 10 + If FeatureCount > 0 OrElse BugCount > 0 Then + ContentList.Add(If(FeatureCount > 0, "其他 " & FeatureCount & " 项小调整与修改", "") & + If(FeatureCount > 0 AndAlso BugCount > 0, "，", "") & + If(BugCount > 0, "修复了 " & BugCount & " 个 Bug", "") & + "，详见完整更新日志") + End If + Dim Content As String = "· " & Join(ContentList, vbCrLf & "· ") + '输出更新日志 + RunInNewThread(Sub() + If MyMsgBox(Content, "PCL2 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then + OpenWebsite("https://afdian.net/@LTCat?tab=feed") + End If + End Sub, "UpdateLog Output") + End Sub + + '窗口加载 + Private IsWindowLoadFinished As Boolean = False + Public Shared IsLinkRestart As Boolean = False '是否为联机提权后自动重启 + Public Sub New() + ApplicationStartTick = GetTimeTick() + '窗体参数初始化 + FrmMain = Me + FrmLaunchLeft = New PageLaunchLeft + FrmLaunchRight = New PageLaunchRight + '版本号改变 + Dim LastVersion As Integer = Setup.Get("SystemLastVersionReg") + If LastVersion < VersionCode Then + '触发升级 + UpgradeSub(LastVersion) + ElseIf LastVersion > VersionCode Then + '触发降级 + DowngradeSub(LastVersion) + End If + ''刷新语言 + 'Lang = ReadReg("Lang", "zh_CN") + 'Application.Current.Resources.MergedDictionaries(1) = New ResourceDictionary With {.Source = New Uri("Resources\Language\" & Lang & ".xaml", UriKind.Relative)} + '刷新主题 + ThemeCheckAll(False) + Setup.Load("UiLauncherTheme") + '加载 UI + InitializeComponent() + Opacity = 0 + '切换到首页 + If Not IsNothing(FrmLaunchLeft.Parent) Then FrmLaunchLeft.SetValue(ContentPresenter.ContentProperty, Nothing) + If Not IsNothing(FrmLaunchRight.Parent) Then FrmLaunchRight.SetValue(ContentPresenter.ContentProperty, Nothing) + PanMainLeft.Child = FrmLaunchLeft + PanMainRight.Child = FrmLaunchRight + FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay + If IsLinkRestart Then PageChange(PageType.Link) + '模式提醒 +#If DEBUG Then + Hint("[开发者模式] PCL 正以开发者模式运行，这可能会造成严重的性能下降，请务必立即向开发者反馈此问题！", HintType.Critical) +#End If + If ModeDebug Then Hint("[调试模式] PCL 正以调试模式运行，这可能会造成性能的下降，若无必要请不要开启！") + '尽早执行的加载池 + McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行，必须跑一次；为了让启动按钮尽快可用，需要尽早执行；为了与 PageLaunchLeft 联动，需要为 0 而不是 GetUuid + + Log("[Start] 第二阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms") + End Sub + Private Sub FormMain_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + ApplicationStartTick = GetTimeTick() + Handle = New Interop.WindowInteropHelper(Me).Handle + '读取设置 + Setup.Load("UiBackgroundOpacity") + Setup.Load("UiBackgroundBlur") + Setup.Load("UiLogoType") + Setup.Load("UiHiddenPageDownload") + BackgroundRefresh(False, True) + MusicRefreshPlay(False, True) + JavaListInit() + '扩展按钮 + BtnExtraDownload.ShowCheck = AddressOf BtnExtraDownload_ShowCheck + BtnExtraBack.ShowCheck = AddressOf BtnExtraBack_ShowCheck + BtnExtraApril.ShowCheck = AddressOf BtnExtraApril_ShowCheck + BtnExtraShutdown.ShowCheck = AddressOf BtnExtraShutdown_ShowCheck + BtnExtraApril.ShowRefresh() + '初始化尺寸改变 + Dim Resizer As New MyResizer(Me) + Resizer.addResizerDown(ResizerB) + Resizer.addResizerLeft(ResizerL) + Resizer.addResizerLeftDown(ResizerLB) + Resizer.addResizerLeftUp(ResizerLT) + Resizer.addResizerRight(ResizerR) + Resizer.addResizerRightDown(ResizerRB) + Resizer.addResizerRightUp(ResizerRT) + Resizer.addResizerUp(ResizerT) + '#If DEBUG Then + ' MinWidth = 200 + ' MinHeight = 150 + '#End If + 'PLC 彩蛋 + If RandomInteger(1, 1000) = 23 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") + End If + '加载窗口 + ThemeRefreshMain() + Height = ReadReg("WindowHeight", MinHeight + 50) + Width = ReadReg("WindowWidth", MinWidth + 50) + Topmost = False + If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed)) + '更改窗口 + Top = (GetWPFSize(My.Computer.Screen.WorkingArea.Height) - Height) / 2 + Left = (GetWPFSize(My.Computer.Screen.WorkingArea.Width) - Width) / 2 + IsSizeSaveable = True + ShowWindowToTop() + Dim HwndSource As Interop.HwndSource = PresentationSource.FromVisual(Me) + HwndSource.AddHook(New Interop.HwndSourceHook(AddressOf WndProc)) + AniStart({ + AaCode(Sub() AniControlEnabled -= 1, 50), + AaOpacity(Me, Setup.Get("UiLauncherTransparent") / 1000 + 0.4, 300, 100), + AaScaleTransform(PanBack, 0.05, 500, 100, New AniEaseOutBack(AniEasePower.Weak)), + AaCode(Sub() + PanBack.RenderTransform = Nothing + 'If OsVersion > New Version(10, 1, 0, 0) Then RectForm.RadiusX = 5 : RectForm.RadiusY = 5 'Win11 下圆角 + IsWindowLoadFinished = True + Log("[System] DPI：" & DPI & "，工作区尺寸：" & My.Computer.Screen.WorkingArea.Width & " x " & My.Computer.Screen.WorkingArea.Height & "，系统版本：" & OsVersion.ToString) + End Sub, , True) + }, "Form Show") + 'Timer 启动 + AniStartRun() + TimerMainStartRun() + '加载池 + RunInNewThread(Sub() + If Not Setup.Get("SystemEula") Then +Reopen: + Select Case MyMsgBox("在使用 PCL2 前，请同意 PCL2 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "打开用户协议与免责声明页面") + Case 1 + Setup.Set("SystemEula", True) + Case 2 + EndProgram(False) + Case 3 + OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW") + GoTo Reopen + End Select + End If + Try + Thread.Sleep(200) + If Setup.Get("LinkAuto") Then PageLinkIoi.InitLoader.Start() + If Not Setup.Get("HintFeedback") = "" Then FeedbackLoader.Start() + DlClientListMojangLoader.Start(1) + RunCountSub() + ServerLoader.Start(1) + Catch ex As Exception + Log(ex, "初始化加载池运行失败", LogLevel.Feedback) + End Try + Try + If File.Exists(Path & "PCL\Plain Craft Launcher 2.exe") Then File.Delete(Path & "PCL\Plain Craft Launcher 2.exe") + Catch ex As Exception + Log(ex, "清理自动更新文件失败") + End Try + End Sub, "Start Loader", ThreadPriority.Lowest) + + Log("[Start] 第三阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms") + End Sub + '根据打开次数触发的事件 + Private Sub RunCountSub() + Setup.Set("SystemCount", Setup.Get("SystemCount") + 1) +#If Not BETA Then + Select Case Setup.Get("SystemCount") + Case 1 + MyMsgBox("欢迎使用 PCL2 快照版！" & vbCrLf & + "快照版包含尚未在正式版发布的测试性功能，仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦！" & vbCrLf & + "如果你并非通过赞助或赞助者本人邀请进群获得的本程序，那么可能是有人在违规传播，记得提醒他一下啦。", "快照版使用说明") + End Select + If Setup.Get("SystemCount") >= 99 Then + If ThemeUnlock(6, False) Then + MyMsgBox("你已经使用了 99 次 PCL2 啦，感谢你长期以来的支持！" & vbCrLf & + "隐藏主题 铁杆粉 已解锁！", "提示") + End If + End If +#End If + End Sub + '升级与降级事件 + Private Sub UpgradeSub(LastVersionCode As Integer) + Log("[Start] 版本号从 " & LastVersionCode & " 升高到 " & VersionCode) + Setup.Set("SystemLastVersionReg", VersionCode) + '检查有记录的最高版本号 + Dim LowerVersionCode As Integer +#If BETA Then + LowerVersionCode = Setup.Get("SystemHighestBetaVersionReg") + If LowerVersionCode < VersionCode Then + Setup.Set("SystemHighestBetaVersionReg", VersionCode) + Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode) + End If +#Else + LowerVersionCode = Setup.Get("SystemHighestAlphaVersionReg") + If LowerVersionCode < VersionCode Then + Setup.Set("SystemHighestAlphaVersionReg", VersionCode) + Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode) + End If +#End If + '修改主题设置项名称 + If LowerVersionCode <= 207 Then + Dim UnlockedTheme As New List(Of String) From {"2"} + UnlockedTheme.AddRange(New List(Of String)(Setup.Get("UiLauncherThemeHide").ToString.Split("|"))) + UnlockedTheme.AddRange(New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|"))) + Setup.Set("UiLauncherThemeHide2", Join(ArrayNoDouble(UnlockedTheme), "|")) + End If + '重置欧皇彩 + If LastVersionCode <= 115 AndAlso Setup.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("13") Then + Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|")) + UnlockedTheme.Remove("13") + Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|")) + MyMsgBox("由于新版 PCL2 修改了欧皇彩的解锁方式，你需要重新解锁欧皇彩。" & vbCrLf & + "多谢各位的理解啦！", "重新解锁提醒") + End If + '重置滑稽彩 + If LastVersionCode <= 152 AndAlso Setup.Get("UiLauncherThemeHide2").ToString.Split("|").Contains("12") Then + Dim UnlockedTheme As New List(Of String)(Setup.Get("UiLauncherThemeHide2").ToString.Split("|")) + UnlockedTheme.Remove("12") + Setup.Set("UiLauncherThemeHide2", Join(UnlockedTheme, "|")) + MyMsgBox("由于新版 PCL2 修改了滑稽彩的解锁方式，你需要重新解锁滑稽彩。" & vbCrLf & + "多谢各位的理解啦！", "重新解锁提醒") + End If + '移动自定义皮肤 + If LastVersionCode <= 161 AndAlso File.Exists(Path & "PCL\CustomSkin.png") AndAlso Not File.Exists(PathTemp & "CustomSkin.png") Then + File.Copy(Path & "PCL\CustomSkin.png", PathTemp & "CustomSkin.png") + Log("[Start] 已移动离线自定义皮肤") + End If + '解除帮助页面的隐藏 + If LastVersionCode <= 205 Then + Setup.Set("UiHiddenOtherHelp", False) + Log("[Start] 已解除帮助页面的隐藏") + End If + '输出更新日志 + If LastVersionCode = 0 Then Exit Sub + If LowerVersionCode >= VersionCode Then Exit Sub + ShowUpdateLog(LowerVersionCode) + End Sub + Private Sub DowngradeSub(LastVersionCode As Integer) + Log("[Start] 版本号从 " & LastVersionCode & " 降低到 " & VersionCode) + Setup.Set("SystemLastVersionReg", VersionCode) + End Sub + +#End Region + +#Region "自定义窗口" + + '关闭 + Private Sub FormMain_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing + EndProgram(True) + e.Cancel = True + End Sub + ''' + ''' 正常关闭程序。程序将在执行此方法后约 0.3s 退出。 + ''' + ''' 是否在还有下载任务未完成时发出警告。 + Public Sub EndProgram(SendWarning As Boolean) + '发出警告 + If SendWarning AndAlso HasDownloadingTask() Then + If MyMsgBox("还有下载任务尚未完成，是否确定退出？", "提示", "确定", "取消") = 1 Then + '强行结束下载任务 + RunInNewThread(Sub() + Log("[System] 正在强行停止任务") + For Each Task As LoaderBase In LoaderTaskbar.ToArray + Task.Abort() + Next + End Sub, "强行停止下载任务") + Else + Exit Sub + End If + End If + '关闭 + RunInUiWait(Sub() + IsHitTestVisible = False + If PanBack.RenderTransform Is Nothing Then + PanBack.RenderTransform = New ScaleTransform + AniStart({ + AaOpacity(Me, -Opacity, 100, 100), + AaScaleTransform(PanBack, -0.05, 200,, New AniEaseInBack), + AaCode(Sub() + IsHitTestVisible = False + Top = -10000 + ShowInTaskbar = False + End Sub, 225), + AaCode(AddressOf EndProgramForce, 250) + }, "Form Close") + Else + EndProgramForce() + End If + Log("[System] 收到关闭指令") + End Sub) + End Sub + Private Shared IsLogShown As Boolean = False + Public Shared Sub EndProgramForce(Optional ReturnCode As Result = Result.Success) + On Error Resume Next + IsProgramEnded = True + AniControlEnabled += 1 + PageLinkIoi.IoiStop(False) + If IsUpdateWaitingRestart Then UpdateRestart(False) + If ReturnCode = Result.Exception Then + If Not IsLogShown Then + FeedbackInfo() + Log("请在 https://jinshuju.net/f/rP4b6E?x_field_1=crash 提交错误报告，以便于作者解决此问题！") + IsLogShown = True + ShellAndGetExitCode(Path & "PCL\Log1.txt") + End If + Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉 + End If + Log("[System] 程序已退出，返回值：" & GetStringFromEnum(CType(ReturnCode, [Enum]))) + LogFlush() + If ReturnCode = Result.Success Then + Process.GetCurrentProcess.Kill() + Else + Environment.Exit(ReturnCode) + End If + End Sub + Private Sub BtnTitleClose_Click(sender As Object, e As RoutedEventArgs) Handles BtnTitleClose.Click + EndProgram(True) + End Sub + + '移动 + Private Sub FormDragMove(sender As Object, e As MouseButtonEventArgs) Handles PanTitle.MouseLeftButtonDown, PanMsg.MouseLeftButtonDown + On Error Resume Next + If sender.IsMouseDirectlyOver Then DragMove() + End Sub + + '改变大小 + ''' + ''' 是否可以向注册表储存尺寸改变信息。以此避免初始化时误储存。 + ''' + Public IsSizeSaveable As Boolean = False + Private Sub FormMain_SizeChanged() Handles Me.SizeChanged, Me.Loaded + If IsSizeSaveable Then + WriteReg("WindowHeight", Height) + WriteReg("WindowWidth", Width) + End If + RectForm.Rect = New Rect(0, 0, BorderForm.ActualWidth, BorderForm.ActualHeight) + PanForm.Width = BorderForm.ActualWidth + 0.001 + PanForm.Height = BorderForm.ActualHeight + 0.001 + PanMain.Width = PanForm.Width + PanMain.Height = Math.Max(0, PanForm.Height - PanTitle.ActualHeight) + End Sub + + '最小化 + Private Sub BtnTitleMin_Click() Handles BtnTitleMin.Click + WindowState = WindowState.Minimized + End Sub + +#End Region + +#Region "窗体事件" + + '按键事件 + Private Sub FormMain_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown + If e.IsRepeat Then Exit Sub + '调用弹窗回车 + If e.Key = Key.Enter AndAlso PanMsg.Children.Count > 0 Then + CType(PanMsg.Children(0), Object).Btn1_Click() + Exit Sub + End If + '更改隐藏版本可见性 + 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 + End If + '更改功能隐藏可见性 + If e.Key = Key.F12 Then + PageSetupUI.HiddenForceShow = Not PageSetupUI.HiddenForceShow + If PageSetupUI.HiddenForceShow Then + Hint("功能隐藏设置已暂时关闭！", HintType.Finish) + Else + Hint("功能隐藏设置已重新开启！", HintType.Finish) + End If + PageSetupUI.HiddenRefresh() + Exit Sub + End If + '调用启动游戏 + If e.Key = Key.Enter AndAlso PageCurrent = FormMain.PageType.Launch Then + If IsAprilEnabled AndAlso Not IsAprilGiveup Then + Hint("木大！") + Else + FrmLaunchLeft.LaunchButtonClick() + End If + End If + '修复按下 Alt 后误认为弹出系统菜单导致的冻结 + If e.SystemKey = Key.LeftAlt OrElse e.SystemKey = Key.RightAlt Then e.Handled = True + '按 ESC 返回上一级 + If e.Key = Key.Escape Then TriggerPageBack() + End Sub + Private Sub FormMain_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseDown + '鼠标侧键返回上一级 + If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack() + End Sub + Private Sub TriggerPageBack() + If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall Then + FrmDownloadInstall.ExitSelectPage() + Else + PageBack() + End If + End Sub + + '切回窗口 + Private Sub FormMain_Activated() Handles Me.Activated + Try + If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then + 'Mod 管理自动刷新 + FrmVersionMod.RefreshList() + ElseIf PageCurrent = PageType.VersionSelect Then + '版本选择自动刷新 + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") + End If + Catch ex As Exception + Log(ex, "切回窗口时出错", LogLevel.Feedback) + End Try + 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 + End If + End Sub + Private Sub FrmMain_Drop(sender As Object, e As DragEventArgs) Handles Me.PreviewDrop + Try + If e.Data.GetDataPresent(DataFormats.Text) Then + '获取文本 + Try + Dim Str As String = e.Data.GetData(DataFormats.Text) + Log("[System] 接受文本拖拽：" & Str) + If Str.StartsWith("authlib-injector:yggdrasil-server:") Then + 'Authlib 拖拽 + e.Handled = True + 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 + End If + If McVersionCurrent Is Nothing Then + Hint("请先下载游戏，再设置第三方登录！", HintType.Critical) + Exit Sub + End If + If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then + 'Little Skin + If MyMsgBox("是否要在版本 " & McVersionCurrent.Name & " 中开启 Little Skin 登录？" & vbCrLf & + "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then + Exit Sub + End If + Setup.Set("VersionServerLogin", 4, Version:=McVersionCurrent) + Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Version:=McVersionCurrent) + Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Version:=McVersionCurrent) + Setup.Set("VersionServerAuthName", "Little Skin 登录", Version:=McVersionCurrent) + Else + '第三方 Authlib 服务器 + If MyMsgBox("是否要在版本 " & McVersionCurrent.Name & " 中开启第三方登录？" & vbCrLf & + "登录服务器：" & AuthlibServer & vbCrLf & vbCrLf & + "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then + Exit Sub + End If + Setup.Set("VersionServerLogin", 4, Version:=McVersionCurrent) + Setup.Set("VersionServerAuthServer", AuthlibServer, Version:=McVersionCurrent) + Setup.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Version:=McVersionCurrent) + Setup.Set("VersionServerAuthName", "", Version:=McVersionCurrent) + End If + If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionSetup Then + '正在服务器选项页，需要刷新设置项显示 + FrmVersionSetup.Reload() + ElseIf PageCurrent = PageType.Launch Then + '正在主页，需要刷新左边栏 + FrmLaunchLeft.RefreshPage(True, False) + End If + End If + Catch ex As Exception + Log(ex, "无法接取文本拖拽事件", LogLevel.Developer) + Exit Sub + End Try + ElseIf e.Data.GetDataPresent(DataFormats.FileDrop) Then + '获取文件并检查 + Dim FilePathList As New List(Of String)(CType(e.Data.GetData(DataFormats.FileDrop), Array)) + e.Handled = True + If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then + Hint("请拖入一个文件，而非文件夹！", HintType.Critical) + Exit Sub + End If + '多文件拖拽 + If FilePathList.Count > 1 Then + '必须要求全部为 jar 文件 + For Each File In FilePathList + If File.Split(".").Last.ToLower <> "jar" Then + Hint("一次请只拖入一个文件！", HintType.Critical) + Exit Sub + End If + Next + End If + '实际执行事件 + Dim FilePath As String = FilePathList.First + Log("[System] 接受文件拖拽：" & FilePath, LogLevel.Developer) + RunInNewThread(Sub() + 'Mod 安装 + If FilePath.Split(".").Last.ToLower = "jar" Then + Log("[System] 文件为 jar 格式，尝试作为 Mod 安装") + '获取并检查目标版本 + Dim TargetVersion As McVersion = McVersionCurrent + If PageCurrent = PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version + If PageCurrent = PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Version.Modable Then + '正在选择版本，或当前版本不能安装 Mod + Hint("若要安装 Mod，请先选择一个可以安装 Mod 的版本！") + ElseIf Not (PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod) Then + '未处于 Mod 管理页面 + If MyMsgBox("是否要将这些文件作为 Mod 安装到 " & TargetVersion.Name & "？", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install + Else + '处于 Mod 管理页面 +Install: + Try + For Each ModFile In FilePathList + File.Copy(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile), True) + Next + If FilePathList.Count = 1 Then + Hint("已安装 " & GetFileNameFromPath(FilePathList.First) & "！", HintType.Finish) + Else + Hint("已安装 " & FilePathList.Count & " 个 Mod！", HintType.Finish) + End If + '刷新列表 + If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then + LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun) + End If + Catch ex As Exception + Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox) + End Try + End If + Exit Sub + End If + '安装整合包 + If {"zip", "rar"}.Contains(FilePath.Split(".").Last.ToLower) Then '部分压缩包是 zip 格式但后缀为 rar，总之试一试 + Log("[System] 文件为压缩包，尝试作为整合包安装") + If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub + End If + 'RAR 处理 + If FilePath.Split(".").Last.ToLower = "rar" Then + Hint("PCL2 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试！") + Exit Sub + End If + '错误报告分析 + Try + Log("[System] 尝试进行错误报告分析") + Dim Analyzer As New CrashAnalyzer(GetUuid()) + Analyzer.Import(FilePath) + If Analyzer.Prepare() = 0 Then Exit Try + Analyzer.Analyze() + Analyzer.Output(True, New List(Of String)) + Exit Sub + Catch ex As Exception + Log(ex, "自主错误报告分析失败", LogLevel.Feedback) + End Try + '未知操作 + Hint("PCL2 无法确定应当执行的文件拖拽操作……") + End Sub, "文件拖拽") + End If + Catch ex As Exception + Log(ex, "接取拖拽事件失败", LogLevel.Feedback) + End Try + End Sub + + '接受到 Windows 窗体事件 + Public IsSystemTimeChanged As Boolean = False + Private Function WndProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr + If msg = 30 Then + Dim NowDate = Date.Now + If NowDate.Date = ApplicationOpenTime.Date Then + Log("[System] 系统时间微调为：" & NowDate.ToLongDateString & " " & NowDate.ToLongTimeString) + IsSystemTimeChanged = False + Else + Log("[System] 系统时间修改为：" & NowDate.ToLongDateString & " " & NowDate.ToLongTimeString) + IsSystemTimeChanged = True + End If + ElseIf msg = 400 * 16 + 2 Then + Log("[System] 收到置顶信息：" & hwnd.ToInt64) + If Not IsWindowLoadFinished Then + Log("[System] 窗口尚未加载完成，忽略置顶请求") + Return IntPtr.Zero + End If + ShowWindowToTop() + handled = True + End If + Return IntPtr.Zero + End Function + + '窗口隐藏与置顶 + Private _Hidden As Boolean = False + Public Property Hidden As Boolean + Get + Return _Hidden + End Get + Set(ByVal value As Boolean) + If _Hidden = value Then Exit Property + _Hidden = value + If value Then + '隐藏 + Left -= 10000 + ShowInTaskbar = False + Visibility = Visibility.Hidden + 'SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW) + Log("[System] 窗口已隐藏，位置：(" & Left & "," & Top & ")") + Else + '取消隐藏 + If Left < -2000 Then Left += 10000 + ShowWindowToTop() + End If + End Set + End Property + ''' + ''' 把当前窗口拖到最前面。 + ''' + Public Sub ShowWindowToTop() + RunInUi(Sub() + '这一坨乱七八糟的，别改，改了指不定就炸了，自己电脑还复现不出来 + Visibility = Visibility.Visible + ShowInTaskbar = True + WindowState = WindowState.Normal + Hidden = False + Topmost = True '偶尔 SetForegroundWindow 失效 + Topmost = False + SetForegroundWindow(Handle) + Focus() + 'ShowWindow(Handle, 1) 'SW_RESTORE + 'SetWindowPos(Handle, 0, 0, 0, 0, 0, 3) 'InsertAfter: TOP, NOMOVE & NOSIZE + 'SetFocus(Handle) + Log("[System] 窗口已置顶，位置：(" & Left & ", " & Top & "), " & Width & " x " & Height) + End Sub) + End Sub + 'Private Declare Function SetFocus Lib "user32" (hWnd As IntPtr) As IntPtr + 'Private Declare Function SetWindowPos Lib "user32" (hWnd As IntPtr, hWndInsertAfter As IntPtr, x As Integer, y As Integer, cx As Integer, cy As Integer, flags As UInteger) As Boolean + 'Private Declare Function AttachThreadInput Lib "user32" (attachFrom As IntPtr, attachTo As IntPtr, isAttach As Boolean) As Boolean + 'Private Declare Function SendMessage Lib "user32" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As IntPtr + +#End Region + +#Region "切换页面" + + '页面种类与属性 + ''' + ''' 页面种类。 + ''' + Public Enum PageType + ''' + ''' 启动。 + ''' + Launch + ''' + ''' 下载。 + ''' + Download + ''' + ''' 联机。 + ''' + Link + ''' + ''' 设置。 + ''' + Setup + ''' + ''' 更多。 + ''' + Other + ''' + ''' 版本选择。这是一个副页面。 + ''' + VersionSelect + ''' + ''' 下载管理。这是一个副页面。 + ''' + DownloadManager + ''' + ''' 版本设置。这是一个副页面。 + ''' + VersionSetup + ''' + ''' CurseForge 工程详情。这是一个副页面。 + ''' + CfDetail + ''' + ''' 帮助详情。这是一个副页面。 + ''' + HelpDetail + End Enum + ''' + ''' 次要页面种类。其数值必须与 StackPanel 中的下标一致。 + ''' + Public Enum PageSubType + [Default] = 0 + DownloadInstall = 1 + DownloadClient = 4 + DownloadOptiFine = 5 + DownloadForge = 6 + DownloadFabric = 7 + DownloadLiteLoader = 8 + DownloadMod = 10 + DownloadPack = 11 + SetupLaunch = 0 + SetupUI = 1 + SetupSystem = 2 + SetupLink = 3 + LinkCato = 2 + LinkIoi = 3 + LinkSetup = 5 + LinkHelp = 6 + LinkFeedback = 7 + OtherHelp = 0 + OtherAbout = 1 + OtherTest = 2 + OtherFeedback = 3 + VersionOverall = 0 + VersionSetup = 1 + VersionMod = 2 + VersionModDisabled = 3 + End Enum + ''' + ''' 获取次级页面的名称。若并非次级页面则返回空字符串，故可以以此判断是否为次级页面。 + ''' + Private Function PageNameGet(Stack As PageStackData) As String + Select Case Stack.Page + Case PageType.VersionSelect + Return "版本选择" + Case PageType.DownloadManager + Return "下载管理" + Case PageType.VersionSetup + Return "版本设置 - " & If(PageVersionLeft.Version Is Nothing, "未知版本", PageVersionLeft.Version.Name) + Case PageType.CfDetail + If Stack.Additional Is Nothing Then + Log("[Control] CurseForge 工程详情页面未提供关键项", LogLevel.Feedback) + Return "未知页面" + Else + Dim Project As DlCfProject = Stack.Additional + Return If(Project.IsModPack, "整合包下载 - ", "Mod 下载 - ") & Project.ChineseName + End If + Case PageType.HelpDetail + If Stack.Additional Is Nothing Then + Log("[Control] 帮助详情页面未提供关键项", LogLevel.Msgbox) + Return "未知页面" + Else + Dim Entry As HelpEntry = Stack.Additional(0) + Return Entry.Title + End If + Case Else + Return "" + End Select + End Function + ''' + ''' 刷新次级页面的名称。 + ''' + Public Sub PageNameRefresh(Type As PageStackData) + LabTitleInner.Text = PageNameGet(Type) + End Sub + ''' + ''' 刷新次级页面的名称。 + ''' + Public Sub PageNameRefresh() + PageNameRefresh(PageCurrent) + End Sub + + '页面状态存储 + ''' + ''' 当前的主页面。 + ''' + Public PageCurrent As PageStackData = PageType.Launch + ''' + ''' 当前的子页面。 + ''' + Public ReadOnly Property PageCurrentSub As PageSubType + Get + Select Case PageCurrent + Case PageType.Download + If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft + Return FrmDownloadLeft.PageID + Case PageType.Link + If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft + Return FrmLinkLeft.PageID + Case PageType.Setup + If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft + Return FrmSetupLeft.PageID + Case PageType.Other + If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft + Return FrmOtherLeft.PageID + Case PageType.VersionSetup + If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft + Return FrmVersionLeft.PageID + Case Else + Return 0 '没有子页面 + End Select + End Get + End Property + ''' + ''' 上层页面的编号堆栈，用于返回。 + ''' + Private ReadOnly PageStack As New List(Of PageStackData) + Public Class PageStackData + + Public Page As PageType + Public Additional As Object + + Public Overrides Function Equals(other As Object) As Boolean + If other Is Nothing Then Return False + If TypeOf other Is PageStackData Then + Dim PageOther As PageStackData = other + If Page <> PageOther.Page Then Return False + If Additional Is Nothing Then + Return PageOther.Additional Is Nothing + Else + Return PageOther.Additional IsNot Nothing AndAlso Additional.Equals(PageOther.Additional) + End If + ElseIf TypeOf other Is Integer Then + If Page <> other Then Return False + Return Additional Is Nothing + Else + Return False + End If + End Function + Public Shared Operator =(left As PageStackData, right As PageStackData) As Boolean + Return EqualityComparer(Of PageStackData).Default.Equals(left, right) + End Operator + Public Shared Operator <>(left As PageStackData, right As PageStackData) As Boolean + Return Not left = right + End Operator + Public Shared Widening Operator CType(Value As PageType) As PageStackData + Return New PageStackData With {.Page = Value} + End Operator + Public Shared Widening Operator CType(Value As PageStackData) As PageType + Return Value.Page + End Operator + End Class + Public PageLeft As MyPageLeft, PageRight As MyPageRight + + '引发实际页面切换的入口 + Private IsChangingPage As Boolean = False + ''' + ''' 切换页面，并引起对应选择 UI 的改变。 + ''' + Public Sub PageChange(Stack As PageStackData, Optional SubType As PageSubType = PageSubType.Default) + If PageNameGet(Stack) = "" Then + '切换到主页面 + PageChangeExit() + IsChangingPage = True '防止下面的勾选直接触发了 PageChangeActual + CType(PanTitleSelect.Children(Stack), MyRadioButton).SetChecked(True, True, PageNameGet(PageCurrent) = "") + IsChangingPage = False + Select Case Stack.Page + Case PageType.Link + If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft + CType(FrmLinkLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent) + Case PageType.Download + If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft + CType(FrmDownloadLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent) + Case PageType.Setup + If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft + CType(FrmSetupLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent) + Case PageType.Other + If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft + CType(FrmOtherLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent) + End Select + PageChangeActual(Stack, SubType) + Else + '切换到次页面 + Select Case Stack.Page + Case PageType.VersionSetup + If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft + CType(FrmVersionLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent) + End Select + PageChangeActual(Stack, SubType) + End If + End Sub + ''' + ''' 通过点击导航栏改变页面。 + ''' + 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 + PageChangeActual(Val(sender.Tag)) + End Sub + ''' + ''' 通过点击返回按钮或手动触发返回来改变页面。 + ''' + Public Sub PageBack() Handles BtnTitleInner.Click + If PageStack.Count = 0 Then Exit Sub + PageChangeActual(PageStack(0)) + End Sub + + '实际处理页面切换 + ''' + ''' 切换现有页面的实际方法。 + ''' + Private Sub PageChangeActual(Stack As PageStackData, Optional SubType As PageSubType = -1) + If PageCurrent = Stack AndAlso (PageCurrentSub = SubType OrElse SubType = -1) Then Exit Sub + AniControlEnabled += 1 + Try + +#Region "子页面处理" + Dim PageName As String = PageNameGet(Stack) + If PageName = "" Then + '即将切换到一个顶级页面 + PageChangeExit() + Else + '即将切换到一个子页面 + If PageStack.Count = 0 Then + '主页面 → 子页面，进入 + PanTitleInner.Visibility = Visibility.Visible + PanTitleMain.IsHitTestVisible = False + PanTitleInner.IsHitTestVisible = True + PageNameRefresh(Stack) + AniStart({ + AaOpacity(PanTitleMain, -PanTitleMain.Opacity, 150), + AaX(PanTitleMain, 12 - PanTitleMain.Margin.Left, 150,, New AniEaseInFluent(AniEasePower.Weak)), + AaOpacity(PanTitleInner, 1 - PanTitleInner.Opacity, 150, 200), + AaX(PanTitleInner, -PanTitleInner.Margin.Left, 350, 200, New AniEaseOutBack), + AaCode(Sub() PanTitleMain.Visibility = Visibility.Collapsed,, True) + }, "FrmMain Titlebar FirstLayer") + PageStack.Insert(0, PageCurrent) + Else + '子页面 → 另一个子页面，更新 + AniStart({ + AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130), + AaCode(Sub() LabTitleInner.Text = PageName,, True), + AaOpacity(LabTitleInner, 1, 150, 30) + }, "FrmMain Titlebar SubLayer") + If PageStack.Contains(Stack) Then + '返回到更上层的子页面 + Do While PageStack.Contains(Stack) + PageStack.RemoveAt(0) + Loop + Else + '进入更深层的子页面 + PageStack.Insert(0, PageCurrent) + End If + End If + End If +#End Region + +#Region "实际更改页面框架 UI" + PageCurrent = Stack + Select Case Stack.Page + Case PageType.Launch '启动 + PageChangeAnim(FrmLaunchLeft, FrmLaunchRight) + Case PageType.Download '下载 + If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft + 'PageGet 方法会在未设置 SubType 时指定默认值，并建立相关页面的实例 + PageChangeAnim(FrmDownloadLeft, FrmDownloadLeft.PageGet(SubType)) + Case PageType.Link '联机 + If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft + If FrmLinkIoi Is Nothing Then FrmLinkIoi = New PageLinkIoi + PageChangeAnim(FrmLinkLeft, FrmLinkLeft.PageGet(SubType)) + Case PageType.Setup '设置 + If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft + PageChangeAnim(FrmSetupLeft, FrmSetupLeft.PageGet(SubType)) + Case PageType.Other '更多 + If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft + PageChangeAnim(FrmOtherLeft, FrmOtherLeft.PageGet(SubType)) + Case PageType.VersionSelect '版本选择 + If FrmSelectLeft Is Nothing Then FrmSelectLeft = New PageSelectLeft + If FrmSelectRight Is Nothing Then FrmSelectRight = New PageSelectRight + PageChangeAnim(FrmSelectLeft, FrmSelectRight) + Case PageType.DownloadManager '下载管理 + If FrmSpeedLeft Is Nothing Then FrmSpeedLeft = New PageSpeedLeft + If FrmSpeedRight Is Nothing Then FrmSpeedRight = New PageSpeedRight + PageChangeAnim(FrmSpeedLeft, FrmSpeedRight) + Case PageType.VersionSetup '版本设置 + If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft + PageChangeAnim(FrmVersionLeft, FrmVersionLeft.PageGet(SubType)) + Case PageType.CfDetail 'Mod 信息 + If FrmDownloadCfDetail Is Nothing Then FrmDownloadCfDetail = New PageDownloadCfDetail + PageChangeAnim(New MyPageLeft, FrmDownloadCfDetail) + Case PageType.HelpDetail '帮助详情 + PageChangeAnim(New MyPageLeft, Stack.Additional(1)) + End Select +#End Region + +#Region "设置为最新状态" + BtnExtraDownload.ShowRefresh() + BtnExtraApril.ShowRefresh() +#End Region + + Log("[Control] 切换主要页面：" & GetStringFromEnum(Stack) & ", " & SubType) + Catch ex As Exception + Log(ex, "切换主要页面失败（ID " & PageCurrent.Page & "）", LogLevel.Feedback) + Finally + AniControlEnabled -= 1 + End Try + End Sub + Private Sub PageChangeAnim(TargetLeft As FrameworkElement, TargetRight As FrameworkElement) + AniStop("FrmMain LeftChange") + AniStop("PageLeft PageChange") '停止左边栏变更导致的右页面切换动画，防止它与本动画一起触发多次 PageOnEnter + AniControlEnabled += 1 + '清除新页面关联性 + If Not IsNothing(TargetLeft.Parent) Then TargetLeft.SetValue(ContentPresenter.ContentProperty, Nothing) + If Not IsNothing(TargetRight) AndAlso Not IsNothing(TargetRight.Parent) Then TargetRight.SetValue(ContentPresenter.ContentProperty, Nothing) + PageLeft = TargetLeft + PageRight = TargetRight + '触发页面通用动画 + CType(PanMainLeft.Child, MyPageLeft).TriggerHideAnimation() + CType(PanMainRight.Child, MyPageRight).PageOnExit() + AniControlEnabled -= 1 + '执行动画 + AniStart({ + AaCode(Sub() + AniControlEnabled += 1 + CType(PanMainRight.Child, MyPageRight).PageOnForceExit() + '把新页面添加进容器 + PanMainLeft.Child = PageLeft + PageLeft.Opacity = 0 + PanMainLeft.Background = Nothing + AniControlEnabled -= 1 + RunInUi(Sub() PanMainLeft_Resize(PanMainLeft.ActualWidth), True) + End Sub, 130), + AaCode(Sub() + '延迟触发页面通用动画，以使得在 Loaded 事件中加载的控件得以处理 + PageLeft.Opacity = 1 + PageLeft.TriggerShowAnimation() + End Sub, 30, True) + }, "FrmMain PageChangeLeft") + AniStart({ + AaCode(Sub() + AniControlEnabled += 1 + CType(PanMainRight.Child, MyPageRight).PageOnForceExit() + '把新页面添加进容器 + PanMainRight.Child = PageRight + PageRight.Opacity = 0 + PanMainRight.Background = Nothing + AniControlEnabled -= 1 + RunInUi(Sub() BtnExtraBack.ShowRefresh(), True) + End Sub, 130), + AaCode(Sub() + '延迟触发页面通用动画，以使得在 Loaded 事件中加载的控件得以处理 + PageRight.Opacity = 1 + PageRight.PageOnEnter() + End Sub, 30, True) + }, "FrmMain PageChangeRight") + End Sub + ''' + ''' 退出子界面。 + ''' + Private Sub PageChangeExit() + If PageStack.Count = 0 Then + '主页面 → 主页面，无事发生 + Else + '子页面 → 主页面，退出 + PanTitleMain.Visibility = Visibility.Visible + PanTitleMain.IsHitTestVisible = True + PanTitleInner.IsHitTestVisible = False + AniStart({ + AaOpacity(PanTitleInner, -PanTitleInner.Opacity, 150), + AaX(PanTitleInner, -18 - PanTitleInner.Margin.Left, 150,, New AniEaseInFluent), + AaOpacity(PanTitleMain, 1 - PanTitleMain.Opacity, 150, 200), + AaX(PanTitleMain, -PanTitleMain.Margin.Left, 350, 200, New AniEaseOutBack(AniEasePower.Weak)), + AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True) + }, "FrmMain Titlebar FirstLayer") + PageStack.Clear() + End If + End Sub + + '左边栏改变 + Private Sub PanMainLeft_SizeChanged(sender As Object, e As SizeChangedEventArgs) Handles PanMainLeft.SizeChanged + If Not e.WidthChanged Then Exit Sub + PanMainLeft_Resize(e.NewSize.Width) + End Sub + Private Sub PanMainLeft_Resize(NewWidth As Double) + Dim Delta As Double = NewWidth - RectLeftBackground.Width + If Math.Abs(Delta) < 0.1 Then Exit Sub + If AniControlEnabled = 0 Then + If PanMain.Opacity < 0.1 Then PanMainLeft.IsHitTestVisible = False '避免左边栏指向背景未能完美覆盖左边栏 + 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) + }, "FrmMain LeftChange", True) + Else + '宽度不足，隐藏 + AniStart({ + AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent), + AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200), + AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170) + }, "FrmMain LeftChange", True) + End If + Else + RectLeftBackground.Width = NewWidth + PanMainLeft.IsHitTestVisible = True + AniStop("FrmMain LeftChange") + End If + End Sub + +#End Region + +#Region "控件拖动" + + '在时钟中调用，使得即使鼠标在窗口外松开，也可以释放控件 + Public Sub DragTick() + If DragControl Is Nothing Then Exit Sub + 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 Mouse.LeftButton = MouseButtonState.Pressed Then + DragControl.DragDoing() + Else + DragStop() + End If + End Sub + Public Sub DragStop() + '存在其他线程调用的可能性，因此需要确保在 UI 线程运行 + RunInUi(Sub() + If DragControl Is Nothing Then Exit Sub + Dim Control = DragControl + DragControl = Nothing + Control.DragStop() '控件会在该事件中判断 DragControl，所以得放在后面 + End Sub) + End Sub + +#End Region + +#Region "附加按钮" + + '音乐 + Private Sub BtnExtraMusic_Click(sender As Object, e As EventArgs) Handles BtnExtraMusic.Click + MusicControlPause() + End Sub + Private Sub BtnExtraMusic_RightClick(sender As Object, e As EventArgs) Handles BtnExtraMusic.RightClick + MusicControlNext() + End Sub + + '下载管理 + Private Sub BtnExtraDownload_Click(sender As Object, e As EventArgs) Handles BtnExtraDownload.Click + PageChange(PageType.DownloadManager) + End Sub + Private Function BtnExtraDownload_ShowCheck() As Boolean + Return HasDownloadingTask() AndAlso Not PageCurrent = PageType.DownloadManager + End Function + + '投降 + Public Sub AprilGiveup() Handles BtnExtraApril.Click + If IsAprilEnabled AndAlso Not IsAprilGiveup Then + Hint("=D", HintType.Finish) + IsAprilGiveup = True + FrmLaunchLeft.AprilScaleTrans.ScaleX = 1 + FrmLaunchLeft.AprilScaleTrans.ScaleY = 1 + BtnExtraApril.ShowRefresh() + End If + End Sub + Public Function BtnExtraApril_ShowCheck() As Boolean + Return IsAprilEnabled AndAlso Not IsAprilGiveup AndAlso PageCurrent = PageType.Launch + End Function + + '关闭 Minecraft + Public Sub BtnExtraShutdown_Click() Handles BtnExtraShutdown.Click + Try + If McLaunchLoaderReal IsNot Nothing Then McLaunchLoaderReal.Abort() + For Each Watcher In McWatcherList + Watcher.Kill() + Next + Hint("已关闭运行中的 Minecraft！", HintType.Finish) + Catch ex As Exception + Log(ex, "强制关闭所有 Minecraft 失败", LogLevel.Feedback) + End Try + End Sub + Public Function BtnExtraShutdown_ShowCheck() As Boolean + Return HasRunningMinecraft + End Function + + '返回顶部 + Private Sub BtnExtraBack_Click(sender As Object, e As EventArgs) Handles BtnExtraBack.Click + Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild() + RealScroll.PerformVerticalOffsetDelta(-RealScroll.VerticalOffset) + End Sub + Private Function BtnExtraBack_ShowCheck() As Boolean + Dim RealScroll As MyScrollViewer = BtnExtraBack_GetRealChild() + Return RealScroll IsNot Nothing AndAlso RealScroll.Visibility = Visibility.Visible AndAlso RealScroll.VerticalOffset > Height + If(BtnExtraBack.Show, 0, 1500) + End Function + Private Function BtnExtraBack_GetRealChild() As MyScrollViewer + If PanMainRight.Child Is Nothing Then Return Nothing + Dim RightChild = CType(PanMainRight.Child, AdornerDecorator).Child + If RightChild Is Nothing Then + Return Nothing + ElseIf TypeOf RightChild Is MyScrollViewer Then + Return RightChild + ElseIf TypeOf RightChild Is Grid AndAlso TypeOf CType(RightChild, Grid).Children(0) Is MyScrollViewer Then + Return CType(RightChild, Grid).Children(0) + Else + Return Nothing + End If + End Function + +#End Region + + '愚人节鼠标位置 + Public lastMouseArg As MouseEventArgs = Nothing + Private Sub FormMain_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove + lastMouseArg = e + End Sub + +End Class diff --git a/Plain Craft Launcher 2/GlobalSuppressions.vb b/Plain Craft Launcher 2/GlobalSuppressions.vb new file mode 100644 index 0000000..3fe2e04 --- /dev/null +++ b/Plain Craft Launcher 2/GlobalSuppressions.vb @@ -0,0 +1,12 @@ +' This file is used by Code Analysis to maintain SuppressMessage +' attributes that are applied to this project. +' Project-level suppressions either have no target or are given +' a specific target and scoped to a namespace, type, member, etc. + +Imports System.Diagnostics.CodeAnalysis + + + + + + diff --git a/Plain Craft Launcher 2/Images/Blocks/Anvil.png b/Plain Craft Launcher 2/Images/Blocks/Anvil.png new file mode 100644 index 0000000..4a0df3e Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/Anvil.png differ diff --git a/Plain Craft Launcher 2/Images/Blocks/CobbleStone.png b/Plain Craft Launcher 2/Images/Blocks/CobbleStone.png new file mode 100644 index 0000000..f1cac18 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/CobbleStone.png differ diff --git a/Plain Craft Launcher 2/Images/Blocks/CommandBlock.png b/Plain Craft Launcher 2/Images/Blocks/CommandBlock.png new file mode 100644 index 0000000..ace887c Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/CommandBlock.png differ diff --git a/Plain Craft Launcher 2/Images/Blocks/Egg.png b/Plain Craft Launcher 2/Images/Blocks/Egg.png new file mode 100644 index 0000000..886d6b5 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/Egg.png differ diff --git a/Plain Craft Launcher 2/Images/Blocks/Fabric.png b/Plain Craft Launcher 2/Images/Blocks/Fabric.png new file mode 100644 index 0000000..064d3e6 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/Fabric.png differ diff --git a/Plain Craft Launcher 2/Images/Blocks/GoldBlock.png b/Plain Craft Launcher 2/Images/Blocks/GoldBlock.png new file mode 100644 index 0000000..417a3c0 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/GoldBlock.png differ diff --git a/Plain Craft Launcher 2/Images/Blocks/Grass.png b/Plain Craft Launcher 2/Images/Blocks/Grass.png new file mode 100644 index 0000000..dce7c14 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/Grass.png differ diff --git a/Plain Craft Launcher 2/Images/Blocks/GrassPath.png b/Plain Craft Launcher 2/Images/Blocks/GrassPath.png new file mode 100644 index 0000000..9ced72e Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/GrassPath.png differ diff --git a/Plain Craft Launcher 2/Images/Blocks/OptiFabric.png b/Plain Craft Launcher 2/Images/Blocks/OptiFabric.png new file mode 100644 index 0000000..3765dbe Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/OptiFabric.png differ diff --git a/Plain Craft Launcher 2/Images/Blocks/RedstoneBlock.png b/Plain Craft Launcher 2/Images/Blocks/RedstoneBlock.png new file mode 100644 index 0000000..088e56b Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/RedstoneBlock.png differ diff --git a/Plain Craft Launcher 2/Images/Blocks/RedstoneLampOff.png b/Plain Craft Launcher 2/Images/Blocks/RedstoneLampOff.png new file mode 100644 index 0000000..82ac557 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/RedstoneLampOff.png differ diff --git a/Plain Craft Launcher 2/Images/Blocks/RedstoneLampOn.png b/Plain Craft Launcher 2/Images/Blocks/RedstoneLampOn.png new file mode 100644 index 0000000..5f9e052 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Blocks/RedstoneLampOn.png differ diff --git a/Plain Craft Launcher 2/Images/Heads/00ll00.png b/Plain Craft Launcher 2/Images/Heads/00ll00.png new file mode 100644 index 0000000..687b441 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/00ll00.png differ diff --git a/Plain Craft Launcher 2/Images/Heads/DoodleHuang.png b/Plain Craft Launcher 2/Images/Heads/DoodleHuang.png new file mode 100644 index 0000000..803e812 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/DoodleHuang.png differ diff --git a/Plain Craft Launcher 2/Images/Heads/Hao_Tian.jpg b/Plain Craft Launcher 2/Images/Heads/Hao_Tian.jpg new file mode 100644 index 0000000..da8f987 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/Hao_Tian.jpg differ diff --git a/Plain Craft Launcher 2/Images/Heads/LTCat.jpg b/Plain Craft Launcher 2/Images/Heads/LTCat.jpg new file mode 100644 index 0000000..c8807f4 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/LTCat.jpg differ diff --git a/Plain Craft Launcher 2/Images/Heads/Logo.png b/Plain Craft Launcher 2/Images/Heads/Logo.png new file mode 100644 index 0000000..51badd7 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/Logo.png differ diff --git a/Plain Craft Launcher 2/Images/Heads/MCBBS.png b/Plain Craft Launcher 2/Images/Heads/MCBBS.png new file mode 100644 index 0000000..b76dd5a Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/MCBBS.png differ diff --git a/Plain Craft Launcher 2/Images/Heads/PCL2.png b/Plain Craft Launcher 2/Images/Heads/PCL2.png new file mode 100644 index 0000000..87e1afb Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/PCL2.png differ diff --git a/Plain Craft Launcher 2/Images/Heads/Patrick.png b/Plain Craft Launcher 2/Images/Heads/Patrick.png new file mode 100644 index 0000000..583449d Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/Patrick.png differ diff --git a/Plain Craft Launcher 2/Images/Heads/bangbang93.png b/Plain Craft Launcher 2/Images/Heads/bangbang93.png new file mode 100644 index 0000000..79246ef Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/bangbang93.png differ diff --git a/Plain Craft Launcher 2/Images/Heads/noin.png b/Plain Craft Launcher 2/Images/Heads/noin.png new file mode 100644 index 0000000..d0b9afd Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/noin.png differ diff --git a/Plain Craft Launcher 2/Images/Heads/wiki.png b/Plain Craft Launcher 2/Images/Heads/wiki.png new file mode 100644 index 0000000..b91f0e4 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Heads/wiki.png differ diff --git a/Plain Craft Launcher 2/Images/Icons/A.png b/Plain Craft Launcher 2/Images/Icons/A.png new file mode 100644 index 0000000..58b23d4 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Icons/A.png differ diff --git a/Plain Craft Launcher 2/Images/Icons/B.png b/Plain Craft Launcher 2/Images/Icons/B.png new file mode 100644 index 0000000..d483f2f Binary files /dev/null and b/Plain Craft Launcher 2/Images/Icons/B.png differ diff --git a/Plain Craft Launcher 2/Images/Icons/NoIcon.png b/Plain Craft Launcher 2/Images/Icons/NoIcon.png new file mode 100644 index 0000000..cf4a0ce Binary files /dev/null and b/Plain Craft Launcher 2/Images/Icons/NoIcon.png differ diff --git a/Plain Craft Launcher 2/Images/Icons/R.png b/Plain Craft Launcher 2/Images/Icons/R.png new file mode 100644 index 0000000..00cae1b Binary files /dev/null and b/Plain Craft Launcher 2/Images/Icons/R.png differ diff --git a/Plain Craft Launcher 2/Images/Skins/Alex.png b/Plain Craft Launcher 2/Images/Skins/Alex.png new file mode 100644 index 0000000..0193041 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Skins/Alex.png differ diff --git a/Plain Craft Launcher 2/Images/Skins/Steve.png b/Plain Craft Launcher 2/Images/Skins/Steve.png new file mode 100644 index 0000000..90d4fa2 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Skins/Steve.png differ diff --git a/Plain Craft Launcher 2/Images/Themes/10.png b/Plain Craft Launcher 2/Images/Themes/10.png new file mode 100644 index 0000000..91b0982 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Themes/10.png differ diff --git a/Plain Craft Launcher 2/Images/Themes/11.png b/Plain Craft Launcher 2/Images/Themes/11.png new file mode 100644 index 0000000..3a2e30b Binary files /dev/null and b/Plain Craft Launcher 2/Images/Themes/11.png differ diff --git a/Plain Craft Launcher 2/Images/Themes/12.png b/Plain Craft Launcher 2/Images/Themes/12.png new file mode 100644 index 0000000..ccd53a0 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Themes/12.png differ diff --git a/Plain Craft Launcher 2/Images/Themes/13.png b/Plain Craft Launcher 2/Images/Themes/13.png new file mode 100644 index 0000000..1444b4c Binary files /dev/null and b/Plain Craft Launcher 2/Images/Themes/13.png differ diff --git a/Plain Craft Launcher 2/Images/Themes/42.png b/Plain Craft Launcher 2/Images/Themes/42.png new file mode 100644 index 0000000..465f129 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Themes/42.png differ diff --git a/Plain Craft Launcher 2/Images/Themes/5.png b/Plain Craft Launcher 2/Images/Themes/5.png new file mode 100644 index 0000000..8b376be Binary files /dev/null and b/Plain Craft Launcher 2/Images/Themes/5.png differ diff --git a/Plain Craft Launcher 2/Images/Themes/6.png b/Plain Craft Launcher 2/Images/Themes/6.png new file mode 100644 index 0000000..08c3d3f Binary files /dev/null and b/Plain Craft Launcher 2/Images/Themes/6.png differ diff --git a/Plain Craft Launcher 2/Images/Themes/7.png b/Plain Craft Launcher 2/Images/Themes/7.png new file mode 100644 index 0000000..7a25da1 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Themes/7.png differ diff --git a/Plain Craft Launcher 2/Images/Themes/8.png b/Plain Craft Launcher 2/Images/Themes/8.png new file mode 100644 index 0000000..8e30ec5 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Themes/8.png differ diff --git a/Plain Craft Launcher 2/Images/Themes/9.png b/Plain Craft Launcher 2/Images/Themes/9.png new file mode 100644 index 0000000..c33fd63 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Themes/9.png differ diff --git a/Plain Craft Launcher 2/Images/icon.ico b/Plain Craft Launcher 2/Images/icon.ico new file mode 100644 index 0000000..d665268 Binary files /dev/null and b/Plain Craft Launcher 2/Images/icon.ico differ diff --git a/Plain Craft Launcher 2/Modules/Base/ModAnimation.vb b/Plain Craft Launcher 2/Modules/Base/ModAnimation.vb new file mode 100644 index 0000000..b2b9f0e --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Base/ModAnimation.vb @@ -0,0 +1,1003 @@ +'动画引擎模块 +'使用 Ani 作为方法或属性的开头，使用 Aa 作为单个动画对象的开头（便于自动补全） + +Public Module ModAnimation + +#Region "声明" + + ''' + ''' 动画速度。最大为 200。 + ''' + Public AniSpeed As Double = 1 + ''' + ''' 动画组列表。 + ''' + Public AniGroups As New Dictionary(Of String, AniGroupEntry) + Public Class AniGroupEntry + Public Data As List(Of AniData) + Public StartTick As Long + Public Uuid As Integer = GetUuid() + End Class + ''' + ''' 上一次记刻的时间。 + ''' + Private AniLastTick As Long + ''' + ''' 动画模块是否正在运行。 + ''' + Public AniRunning As Boolean = False + Private _AniControlEnabled As Integer = 0 + Private ReadOnly AniControlEnabledLock As New Object + ''' + ''' 控件动画执行是否开启。先 +1，再 -1。 + ''' + Public Property AniControlEnabled() As Integer + Get + Return _AniControlEnabled + End Get + Set(value As Integer) + SyncLock AniControlEnabledLock + _AniControlEnabled = value + End SyncLock + End Set + End Property + +#End Region + +#Region "类与枚举" + + ''' + ''' 单个动画对象。 + ''' + ''' + Public Structure AniData + + ''' + ''' 动画种类。 + ''' + ''' + Public TypeMain As AniType + ''' + ''' 动画副种类。 + ''' + ''' + Public TypeSub As AniTypeSub + + ''' + ''' 动画总长度。 + ''' + ''' + Public TimeTotal As Integer + ''' + ''' 已经执行的动画长度。如果为负数则为延迟。 + ''' + ''' + Public TimeFinished As Integer + ''' + ''' 已经完成的百分比。 + ''' + ''' + Public TimePercent As Double + + ''' + ''' 是否为“以后”。 + ''' + ''' + Public IsAfter As Boolean + + ''' + ''' 插值器类型。 + ''' + ''' + Public Ease As AniEase + ''' + ''' 动画对象。 + ''' + ''' + Public Obj As Object + ''' + ''' 动画值。 + ''' + ''' + Public Value As Object + ''' + ''' 上次执行时的动画值。 + ''' + ''' + Public ValueLast As Object + + Public Overrides Function ToString() As String + Return GetStringFromEnum(TypeMain) & " | " & TimeFinished & "/" & TimeTotal & "(" & Math.Round(TimePercent * 100) & "%)" & If(Obj Is Nothing, "", " | " & Obj.ToString & "(" & Obj.GetType.Name & ")") + End Function + + End Structure + + ''' + ''' 动画基础种类。 + ''' + Public Enum AniType + ''' + ''' 单个Double的动画，包括位置、长宽、透明度等。这需要附属类型。 + ''' + ''' + Number + ''' + ''' 颜色属性的动画。这需要附属类型。 + ''' + ''' + Color + ''' + ''' 缩放控件大小。比起4个DoubleAnimation来说效率更高。 + ''' + ''' + Scale + ''' + ''' 文字一个个出现。 + ''' + ''' + TextAppear + ''' + ''' 执行代码。 + ''' + ''' + Code + ''' + ''' 以 WPF 方式缩放控件。 + ''' + ScaleTransform + ''' + ''' 以 WPF 方式旋转控件。 + ''' + RotateTransform + End Enum + ''' + ''' 动画扩展种类。 + ''' + Public Enum AniTypeSub + X + Y + Width + Height + Opacity + Value + Radius + BorderThickness + StrokeThickness + TranslateX + TranslateY + [Double] + DoubleParam + GridLengthWidth + End Enum + +#End Region + +#Region "种类" + + 'DoubleAnimation + + ''' + ''' 移动X轴的动画。 + ''' + ''' 动画的对象。 + ''' 进行移动的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaX(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.X, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + ''' + ''' 移动Y轴的动画。 + ''' + ''' 动画的对象。 + ''' 进行移动的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaY(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.Y, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + ''' + ''' 改变宽度的动画。 + ''' + ''' 动画的对象。 + ''' 宽度改变的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaWidth(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.Width, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + ''' + ''' 改变高度的动画。 + ''' + ''' 动画的对象。 + ''' 高度改变的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaHeight(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.Height, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + ''' + ''' 改变透明度的动画。 + ''' + ''' 动画的对象。 + ''' 透明度改变的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaOpacity(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.Opacity, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + ''' + ''' 改变对象的Value属性的动画。 + ''' + ''' 动画的对象。 + ''' Value属性改变的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaValue(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.Value, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + ''' + ''' 改变对象的Radius属性的动画。 + ''' + ''' 动画的对象。 + ''' Radius属性改变的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaRadius(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.Radius, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + ''' + ''' 改变对象的BorderThickness属性的动画。 + ''' + ''' 动画的对象。 + ''' BorderThickness属性改变的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaBorderThickness(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.BorderThickness, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + ''' + ''' 改变对象的StrokeThickness属性的动画。 + ''' + ''' 动画的对象。 + ''' StrokeThickness属性改变的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + Public Function AaStrokeThickness(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.StrokeThickness, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + ''' + ''' 改变 Width 的 GridLength 属性的动画。必须为 Star。 + ''' + ''' 动画的对象。 + ''' GridLength.Value 改变的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + Public Function AaGridLengthWidth(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.GridLengthWidth, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + + 'DoubleAnimation（Obj, Prop, [Res]） + + ''' + ''' 改变数字属性的动画。 + ''' + ''' 动画的对象。 + ''' 动画的依赖属性。 + ''' 改变的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaDouble(Obj As Object, Prop As DependencyProperty, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.Double, .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = {Obj, Prop, ""}, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + ''' + ''' 获取数字动画值。 + ''' + ''' 改变的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaDouble(Lambda As ParameterizedThreadStart, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.DoubleParam, .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Lambda, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + + 'ColorAnimation（Obj, Prop, [Res]） + + ''' + ''' 改变颜色属性的动画。 + ''' + ''' 动画的对象。 + ''' 动画的依赖属性。 + ''' 颜色改变的值。以RGB加减法进行计算。不用担心超额。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaColor(Obj As FrameworkElement, Prop As DependencyProperty, Value As MyColor, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Color, .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = {Obj, Prop, ""}, .Value = Value, .IsAfter = After, .TimeFinished = -Delay, .ValueLast = New MyColor(0, 0, 0, 0)} + End Function + ''' + ''' 改变颜色属性为一个资源的动画。 + ''' + ''' 动画的对象。 + ''' 动画的依赖属性。 + ''' 要将颜色改变为该资源值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaColor(Obj As FrameworkElement, Prop As DependencyProperty, Res As String, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Color, .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = {Obj, Prop, Res}, .Value = New MyColor(Application.Current.FindResource(Res)) - New MyColor(Obj.GetValue(Prop)), .IsAfter = After, .TimeFinished = -Delay, .ValueLast = New MyColor(0, 0, 0, 0)} + End Function + + 'Scale + + ''' + ''' 缩放控件的动画。 + ''' + ''' 动画的对象。 + ''' 大小改变的百分比（如-0.6）或值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' 大小改变是否为绝对值。若为 True 则为绝对像素，若为 False 则为相对百分比。 + ''' + ''' + Public Function AaScale(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False, Optional Absolute As Boolean = False) As AniData + Dim ChangeRect As MyRect + If Absolute Then + ChangeRect = New MyRect(-0.5 * Value, -0.5 * Value, Value, Value) + Else + ChangeRect = New MyRect(-0.5 * Obj.ActualWidth * Value, -0.5 * Obj.ActualHeight * Value, Obj.ActualWidth * Value, Obj.ActualHeight * Value) + End If + Return New AniData With {.TypeMain = AniType.Scale, .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = ChangeRect, .IsAfter = After, .TimeFinished = -Delay} + End Function + + 'TextAppear + + ''' + ''' 让一段文字一个个字出现或消失的动画。 + ''' + ''' 动画的对象。必须是Label或TextBlock。 + ''' 是否为一个个字隐藏。默认为False（一个个字出现）。这些字必须已经存在了。 + ''' 是否采用根据文本长度决定时间的方式。 + ''' 动画长度（毫秒）。若TimePerText为True，这代表每个字所占据的时间。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaTextAppear(Obj As Object, Optional Hide As Boolean = False, Optional TimePerText As Boolean = True, Optional Time As Integer = 70, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + 'Are we cool yet？ + Return New AniData With {.TypeMain = AniType.TextAppear, .Ease = If(Ease, New AniEaseLinear), .TimeTotal = If(TimePerText, Time * If(TypeOf Obj Is TextBlock, Obj.Text, Obj.Context.ToString).ToString.Length, Time), .Obj = Obj, .Value = {If(TypeOf Obj Is TextBlock, Obj.Text, Obj.Context.ToString), Hide}, .IsAfter = After, .TimeFinished = -Delay} + End Function + + 'Code + + ''' + ''' 执行代码。 + ''' + ''' 一个ThreadStart。这将会在执行时在主线程调用。 + ''' 代码延迟执行的时间（毫秒）。 + ''' 是否等到以前的动画完成后才执行。 + ''' + ''' + Public Function AaCode(Code As ThreadStart, Optional Delay As Integer = 0, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Code, + .TimeTotal = 1, .Value = Code, .IsAfter = After, .TimeFinished = -Delay} + End Function + + 'ScaleTransform + + ''' + ''' 按照 WPF 方式缩放控件的动画。 + ''' + ''' 动画的对象。它必须已经拥有了单一的 ScaleTransform 值。 + ''' 大小改变的百分比（如-0.6）。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaScaleTransform(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.ScaleTransform, .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + + 'RotateTransform + + ''' + ''' 按照 WPF 方式旋转控件的动画。 + ''' + ''' 动画的对象。它必须已经拥有了单一的 ScaleTransform 值。 + ''' 大小改变的百分比（如-0.6）。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + ''' + ''' + Public Function AaRotateTransform(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.RotateTransform, .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + + 'TranslateTransform + + ''' + ''' 利用 TranslateTransform 移动 X 轴的动画，这不会造成布局更新。 + ''' + ''' 动画的对象。 + ''' 进行移动的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + Public Function AaTranslateX(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.TranslateX, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + ''' + ''' 利用 TranslateTransform 移动 Y 轴的动画，这不会造成布局更新。 + ''' + ''' 动画的对象。 + ''' 进行移动的值。 + ''' 动画长度（毫秒）。 + ''' 动画延迟执行的时间（毫秒）。 + ''' 插值器类型。 + ''' 是否等到以前的动画完成后才继续本动画。 + Public Function AaTranslateY(Obj As Object, Value As Double, Optional Time As Integer = 400, Optional Delay As Integer = 0, Optional Ease As AniEase = Nothing, Optional After As Boolean = False) As AniData + Return New AniData With {.TypeMain = AniType.Number, .TypeSub = AniTypeSub.TranslateY, + .TimeTotal = Time, .Ease = If(Ease, New AniEaseLinear), .Obj = Obj, .Value = Value, .IsAfter = After, .TimeFinished = -Delay} + End Function + + '特殊 + + ''' + ''' 将一个StackPanel中的各个项目依次显示。 + ''' + ''' + Public Function AaStack(Stack As StackPanel, Optional Time As Integer = 100, Optional Delay As Integer = 25) As List(Of AniData) + AaStack = New List(Of AniData) + Dim AniDelay As Integer = 0 + For Each Item In Stack.Children + Item.Opacity = 0 + AaStack.Add(AaOpacity(Item, 1, Time, AniDelay)) + AniDelay += Delay + Next + End Function + +#End Region + +#Region "缓动函数" + + '基类 + Public Enum AniEasePower As Integer + Weak = 2 + Middle = 3 + Strong = 4 + ExtraStrong = 5 + End Enum + ''' + ''' 缓动函数基类。 + ''' + Public MustInherit Class AniEase + ''' + ''' 获取函数值。 + ''' + ''' 时间百分比。 + Public MustOverride Function GetValue(t As Double) As Double + ''' + ''' 获取增量值。 + ''' + ''' 较大的 X。 + ''' 较小的 X。 + Public Overridable Function GetDelta(t1 As Double, t0 As Double) As Double + Return GetValue(t1) - GetValue(t0) + End Function + End Class + ''' + ''' 渐入渐出组合。 + ''' + Public Class AniEaseInout + Inherits AniEase + Private ReadOnly EaseIn As AniEase, EaseOut As AniEase, EaseInPercent As Double + Public Sub New(EaseIn As AniEase, EaseOut As AniEase, Optional EaseInPercent As Double = 0.5) + Me.EaseIn = EaseIn : Me.EaseOut = EaseOut : Me.EaseInPercent = EaseInPercent + End Sub + Public Overrides Function GetValue(t As Double) As Double + If t < EaseInPercent Then + Return EaseInPercent * EaseIn.GetValue(t / EaseInPercent) + Else + Return (1 - EaseInPercent) * EaseOut.GetValue((t - EaseInPercent) / (1 - EaseInPercent)) + EaseInPercent + End If + End Function + End Class + + 'Linear / 线性 + ''' + ''' 线性，无缓动。 + ''' + Public Class AniEaseLinear + Inherits AniEase + Public Overrides Function GetValue(t As Double) As Double + Return MathRange(t, 0, 1) + End Function + Public Overrides Function GetDelta(t1 As Double, t0 As Double) As Double + Return MathRange(t1, 0, 1) - MathRange(t0, 0, 1) + End Function + End Class + + 'Fluent / 平滑 + ''' + ''' 平滑开始。 + ''' + Public Class AniEaseInFluent + Inherits AniEase + Private ReadOnly p As AniEasePower + Public Sub New(Optional Power As AniEasePower = AniEasePower.Middle) + p = Power + End Sub + Public Overrides Function GetValue(t As Double) As Double + Return MathRange(t, 0, 1) ^ p + End Function + End Class + ''' + ''' 平滑结束。 + ''' + Public Class AniEaseOutFluent + Inherits AniEase + Private ReadOnly p As AniEasePower + Public Sub New(Optional Power As AniEasePower = AniEasePower.Middle) + p = Power + End Sub + Public Overrides Function GetValue(t As Double) As Double + Return 1 - MathRange(1 - t, 0, 1) ^ p + End Function + End Class + ''' + ''' 平滑开始与结束。 + ''' + Public Class AniEaseInoutFluent + Inherits AniEase + Private Ease As AniEaseInout + Public Sub New(Optional Power As AniEasePower = AniEasePower.Middle, Optional Middle As Double = 0.5) + Ease = New AniEaseInout(New AniEaseInFluent(Power), New AniEaseOutFluent(Power), Middle) + End Sub + Public Overrides Function GetValue(t As Double) As Double + Return Ease.GetValue(t) + End Function + End Class + + 'Back / 回弹 + ''' + ''' 回弹开始。有效时间为 1/3。 + ''' + Public Class AniEaseInBack + Inherits AniEase + Private ReadOnly p As Double + Public Sub New(Optional Power As AniEasePower = AniEasePower.Middle) + p = 3 - Power * 0.5 + End Sub + Public Overrides Function GetValue(t As Double) As Double + t = MathRange(t, 0, 1) + Return t ^ p * Math.Cos(1.5 * Math.PI * (1 - t)) + End Function + End Class + ''' + ''' 回弹结束。有效时间为 1/3。 + ''' + Public Class AniEaseOutBack + Inherits AniEase + Private ReadOnly p As Double + Public Sub New(Optional Power As AniEasePower = AniEasePower.Middle) + p = 3 - Power * 0.5 + End Sub + Public Overrides Function GetValue(t As Double) As Double + t = MathRange(t, 0, 1) + Return 1 - (1 - t) ^ p * Math.Cos(1.5 * Math.PI * t) + End Function + End Class + + 'Car / 平滑-回弹 + ''' + ''' 回弹开始，短平滑结束。 + ''' + Public Class AniEaseInCar + Inherits AniEase + Private Ease As AniEaseInout + Public Sub New(Optional Middle As Double = 0.7, Optional Power As AniEasePower = AniEasePower.Middle) + Ease = New AniEaseInout(New AniEaseInBack(Power), New AniEaseOutFluent(Power), Middle) + End Sub + Public Overrides Function GetValue(t As Double) As Double + Return Ease.GetValue(t) + End Function + End Class + ''' + ''' 短平滑开始，回弹结束。 + ''' + Public Class AniEaseOutCar + Inherits AniEase + Private Ease As AniEaseInout + Public Sub New(Optional Middle As Double = 0.3, Optional Power As AniEasePower = AniEasePower.Middle) + Ease = New AniEaseInout(New AniEaseInFluent(Power), New AniEaseOutBack(Power), Middle) + End Sub + Public Overrides Function GetValue(t As Double) As Double + Return Ease.GetValue(t) + End Function + End Class + + 'Elastic / 弹簧 + ''' + ''' 弹簧开始。约在 60% 到达最小值。 + ''' + Public Class AniEaseInElastic + Inherits AniEase + Private ReadOnly p As Integer '6~9 + Public Sub New(Optional Power As AniEasePower = AniEasePower.Middle) + p = Power + 4 + End Sub + Public Overrides Function GetValue(t As Double) As Double + t = MathRange(t, 0, 1) + Return t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5) + End Function + End Class + ''' + ''' 弹簧结束。约在 40% 到达最大值。 + ''' + Public Class AniEaseOutElastic + Inherits AniEase + Private ReadOnly p As Integer + Public Sub New(Optional Power As AniEasePower = AniEasePower.Middle) + p = Power + 4 + End Sub + Public Overrides Function GetValue(t As Double) As Double + t = 1 - MathRange(t, 0, 1) + Return 1 - t ^ ((p - 1) * 0.25) * Math.Cos((p - 3.5) * Math.PI * (1 - t) ^ 1.5) + End Function + End Class + +#End Region + +#Region "接口（开始、中断、检测）" + + ''' + ''' 开始一个动画组。 + ''' + ''' 由 Aa 开头的函数初始化的 AniData 对象集合。 + ''' 动画组的名称。如果重复会直接停止同名动画组。 + Public Sub AniStart(AniGroup As IList, Optional Name As String = "", Optional RefreshTime As Boolean = False) + If RefreshTime Then AniLastTick = GetTimeTick() '避免处理动画时已经造成了极大的延迟，导致动画突然结束 + '添加到正在执行的动画组 + Dim NewEntry As New AniGroupEntry With {.Data = GetFullList(Of AniData)(AniGroup), .StartTick = GetTimeTick()} + If Name = "" Then + Name = NewEntry.Uuid + Else + AniStop(Name) + End If + AniGroups.Add(Name, NewEntry) + End Sub + ''' + ''' 开始一个动画组。 + ''' + Public Sub AniStart(AniGroup As AniData, Optional Name As String = "", Optional RefreshTime As Boolean = False) + AniStart(New List(Of AniData) From {AniGroup}, Name, RefreshTime) + End Sub + ''' + ''' 直接停止一个动画组。 + ''' + ''' 需要停止的动画组的名称。 + Public Sub AniStop(Name As String) + AniGroups.Remove(Name) + End Sub + ''' + ''' 获取动画是否正在进行中。 + ''' + Public Function AniIsRun(Name As String) As Boolean + Return AniGroups.ContainsKey(Name) + End Function + +#End Region + + Private AniCount As Integer = 0 + Private AniFPSCounter As Integer = 0 + Private AniFPSTimer As Long = 0 + ''' + ''' 当前的动画 FPS。 + ''' + Public AniFPS As Integer = 0 + + ''' + ''' 开始动画执行。 + ''' + Public Sub AniStartRun() + '初始化计时器 + AniLastTick = GetTimeTick() + AniFPSTimer = AniLastTick + AniRunning = True '标记动画执行开始 + + RunInNewThread(Sub() + Try + Log("[Animation] 动画线程开始") + Do While True + '两帧之间的间隔时间 + Dim DeltaTime As Long = MathRange(GetTimeTick() - AniLastTick, 0, 10000) + If DeltaTime < 3 Then GoTo Sleeper + AniLastTick = GetTimeTick() + '记录 FPS + If ModeDebug Then + If MathRange(AniLastTick - AniFPSTimer, 0, 10000) >= 500 Then + AniFPS = AniFPSCounter + AniFPSCounter = 0 + AniFPSTimer = AniLastTick + End If + AniFPSCounter += 2 + End If + '执行动画 + RunInUiWait(Sub() + AniCount = 0 + AniTimer(DeltaTime * AniSpeed) + '#If DEBUG Then + ' FrmMain.Title = "F " & AniFPS & ", A " & AniCount & ", R " & NetManage.FileRemain + '#Else + ' If ModeDebug Then FrmMain.Title = "FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManage.FileRemain + '#End If + If RandomInteger(0, 64 * If(ModeDebug, 5, 30)) = 0 AndAlso ((AniFPS < 62 AndAlso AniFPS > 0) OrElse AniCount > 4 OrElse NetManager.FileRemain <> 0) Then + Log("[Report] FPS " & AniFPS & ", 动画 " & AniCount & ", 下载中 " & NetManager.FileRemain & "（" & GetString(NetManager.Speed) & "/s）") + End If + End Sub) +Sleeper: + '控制 FPS + Thread.Sleep(1) + Loop + Catch ex As Exception + Log(ex, "动画帧执行失败", LogLevel.Assert) + End Try + End Sub, "Animation", ThreadPriority.AboveNormal) + End Sub + + ''' + ''' 动画定时器事件。 + ''' + Public Sub AniTimer(DeltaTick As Integer) + Try + + If DeltaTick / AniSpeed > 200 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", LogLevel.Developer) + Dim i As Integer = -1 + '循环每个动画组 + Do While i + 1 < AniGroups.Count + i += 1 + '初始化 + Dim Entry As AniGroupEntry = AniGroups.Values(i) + If Entry.StartTick > AniLastTick Then Continue Do '跳过本刻之后开始的动画 + Dim CanRemoveAfter = True '是否应该去除“之后”标记 + Dim ii = 0 + + '循环每个动画 + Do While ii < Entry.Data.Count + Dim Anim As AniData = Entry.Data(ii) + '执行种类 + If Anim.IsAfter = False Then '之前 + CanRemoveAfter = False '取消“之后”标记 + '增加执行时间 + Anim.TimeFinished += DeltaTick + '执行动画 + If Anim.TimeFinished > 0 Then + Anim = AniRun(Anim) + AniCount += 1 + End If + '如果当前动画已执行完毕 + If Anim.TimeFinished >= Anim.TimeTotal Then + '如果是去向颜色资源的动画，设置引用 + If Anim.TypeMain = AniType.Color AndAlso Not Anim.Obj(2) = "" Then Anim.Obj(0).SetResourceReference(Anim.Obj(1), Anim.Obj(2)) + '删除 + Entry.Data.RemoveAt(ii) + GoTo NextAni + End If + Entry.Data(ii) = Anim + Else '之后 + If CanRemoveAfter Then + '之后改为之前 + CanRemoveAfter = False + Anim.IsAfter = False + Entry.Data(ii) = Anim + '重新循环该动画 + GoTo NextAni + Else + '不能去除该“之后”标记，结束该动画组 + Exit Do + End If + End If + ii += 1 +NextAni: + Loop + + '如果当前动画组都执行完毕则删除 + If Entry.Data.Count = 0 Then + '为了避免新添加的动画影响顺序，不能 RemoveAt(i) + '为了允许动画在执行中添加同名动画组，不能按名字移除 + For Current = 0 To AniGroups.Count - 1 + If AniGroups.ElementAt(Current).Value.Uuid = Entry.Uuid Then + AniGroups.Remove(AniGroups.ElementAt(Current).Key) + Exit For + End If + Next + i -= 1 + End If + Loop + + Catch ex As Exception + Log(ex, "动画刻执行失败", LogLevel.Hint) + End Try + End Sub + + ''' + ''' 执行一个动画。 + ''' + ''' 执行的动画对象。 + Private Function AniRun(Ani As AniData) As AniData + Try + Select Case Ani.TypeMain + + Case AniType.Number + Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) + If Delta <> 0 Then + Select Case Ani.TypeSub + Case AniTypeSub.X + DeltaLeft(Ani.Obj, Delta) + Case AniTypeSub.Y + DeltaTop(Ani.Obj, Delta) + Case AniTypeSub.Opacity + Ani.Obj.Opacity = MathRange(Ani.Obj.Opacity + Delta, 0, 1) + Case AniTypeSub.Width + Dim Obj As FrameworkElement = Ani.Obj + Obj.Width = Math.Max(If(Double.IsNaN(Obj.Width), Obj.ActualWidth, Obj.Width) + Delta, 0) + Case AniTypeSub.Height + Dim Obj As FrameworkElement = Ani.Obj + Obj.Height = Math.Max(If(Double.IsNaN(Obj.Height), Obj.ActualHeight, Obj.Height) + Delta, 0) + Case AniTypeSub.Value + Ani.Obj.Value += Delta + Case AniTypeSub.Radius + Ani.Obj.Radius += Delta + Case AniTypeSub.StrokeThickness + Ani.Obj.StrokeThickness = Math.Max(Ani.Obj.StrokeThickness + Delta, 0) + Case AniTypeSub.BorderThickness + Ani.Obj.BorderThickness = New Thickness(CType(Ani.Obj.BorderThickness, Thickness).Bottom + Delta) + Case AniTypeSub.TranslateX + If IsNothing(Ani.Obj.RenderTransform) OrElse TypeOf Ani.Obj.RenderTransform IsNot TranslateTransform Then Ani.Obj.RenderTransform = New TranslateTransform(0, 0) + CType(Ani.Obj.RenderTransform, TranslateTransform).X += Delta + Case AniTypeSub.TranslateY + If IsNothing(Ani.Obj.RenderTransform) OrElse TypeOf Ani.Obj.RenderTransform IsNot TranslateTransform Then Ani.Obj.RenderTransform = New TranslateTransform(0, 0) + CType(Ani.Obj.RenderTransform, TranslateTransform).Y += Delta + Case AniTypeSub.Double + Ani.Obj(0).SetValue(Ani.Obj(1), Ani.Obj(0).GetValue(Ani.Obj(1)) + Delta) + Case AniTypeSub.DoubleParam + CType(Ani.Obj, ParameterizedThreadStart)(Delta) + Case AniTypeSub.GridLengthWidth + Ani.Obj.Width = New GridLength(Math.Max(Ani.Obj.Width.Value + Delta, 0), GridUnitType.Star) + End Select + End If + + Case AniType.Color + '利用 Last 记录了余下的小数值 + Dim Delta As MyColor = MathPercent(New MyColor(0, 0, 0, 0), Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) + Ani.ValueLast + Dim Obj As FrameworkElement = Ani.Obj(0) + Dim Prop As DependencyProperty = Ani.Obj(1) + Dim NewColor As MyColor = New MyColor(Obj.GetValue(Prop)) + Delta + Obj.SetValue(Prop, If(Prop.PropertyType.Name = "Color", CType(NewColor, Color), CType(NewColor, SolidColorBrush))) + Ani.ValueLast = NewColor - New MyColor(Obj.GetValue(Prop)) + + Case AniType.Scale + Dim Obj As FrameworkElement = Ani.Obj + Dim Delta As Double = Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent) + Obj.Margin = New Thickness(Obj.Margin.Left + MathPercent(0, Ani.Value.Left, Delta), Obj.Margin.Top + MathPercent(0, Ani.Value.Top, Delta), Obj.Margin.Right + MathPercent(0, Ani.Value.Left, Delta), Obj.Margin.Bottom + MathPercent(0, Ani.Value.Top, Delta)) + Obj.Width = Math.Max(Obj.Width + MathPercent(0, Ani.Value.Width, Delta), 0) + Obj.Height = Math.Max(Obj.Height + MathPercent(0, Ani.Value.Height, Delta), 0) + + Case AniType.TextAppear + Dim TextCount As Integer = If(Ani.Value(1), Ani.Value(0).ToString.Length, 0) + + Math.Round(Ani.Value(0).ToString.Length * If(Ani.Value(1), -1, 1) * Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, 0)) + Dim NewText As String = Mid(Ani.Value(0), 1, TextCount) + '添加乱码 + If TextCount < Ani.Value(0).ToString.Length Then + Dim NextText As String = Mid(Ani.Value(0), TextCount + 1, 1) + If Convert.ToInt32(Convert.ToChar(NextText)) >= Convert.ToInt32(Convert.ToChar(128)) Then + NewText &= Encoding.GetEncoding("GB18030").GetString({RandomInteger(16 + 160, 87 + 160), RandomInteger(1 + 160, 89 + 160)}) + Else + NewText &= RandomOne("0123456789./*-+\[]{};':/?,!@#$%^&*()_+-=qwwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM".ToCharArray) + End If + End If + '设置文本 + If TypeOf Ani.Obj Is TextBlock Then + Ani.Obj.Text = NewText + Else + Ani.Obj.Context = NewText + End If + + Case AniType.Code + CType(Ani.Value, ThreadStart)() + + Case AniType.ScaleTransform + Dim Obj As FrameworkElement = Ani.Obj + If TypeOf Obj.RenderTransform IsNot ScaleTransform Then + Obj.RenderTransformOrigin = New Point(0.5, 0.5) + Obj.RenderTransform = New ScaleTransform(1, 1) + End If + Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) + CType(Obj.RenderTransform, ScaleTransform).ScaleX = Math.Max(CType(Obj.RenderTransform, ScaleTransform).ScaleX + Delta, 0) + CType(Obj.RenderTransform, ScaleTransform).ScaleY = Math.Max(CType(Obj.RenderTransform, ScaleTransform).ScaleY + Delta, 0) + + Case AniType.RotateTransform + Dim Obj As FrameworkElement = Ani.Obj + If TypeOf Obj.RenderTransform IsNot RotateTransform Then + Obj.RenderTransformOrigin = New Point(0.5, 0.5) + Obj.RenderTransform = New RotateTransform(0) + End If + Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) + CType(Obj.RenderTransform, RotateTransform).Angle = CType(Obj.RenderTransform, RotateTransform).Angle + Delta + + End Select + Ani.TimePercent = Ani.TimeFinished / Ani.TimeTotal '修改执行百分比 + Catch ex As Exception + Log(ex, "执行动画失败：" & Ani.ToString, LogLevel.Hint) + End Try + Return Ani + End Function + +End Module diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb new file mode 100644 index 0000000..32d8230 --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb @@ -0,0 +1,2471 @@ +Imports System.IO.Compression +Imports System.Management +Imports System.Security.Cryptography +Imports System.Security.Principal +Imports System.Windows.Markup +Imports Newtonsoft.Json + +Public Module ModBase + +#Region "声明" + + '下列版本信息由更新器自动修改 + Public Const VersionBaseName As String = "2.3.1" '不含分支前缀的显示用版本名 + Public Const VersionStandardCode As String = "2.3.1." & VersionBranchCode '标准格式的四段式版本号 +#If BETA Then + Public Const VersionCode As Integer = 257 'Release +#Else + Public Const VersionCode As Integer = 259 'Snapshot +#End If + '自动生成的版本信息 + Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName +#If RELEASE Then + Public Const VersionBranchName As String = "Snapshot" + Public Const VersionBranchCode As String = "0" +#ElseIf BETA Then + Public Const VersionBranchName As String = "Release" + Public Const VersionBranchCode As String = "50" +#ElseIf DEBUG Then + Public Const VersionBranchName As String = "Debug" + Public Const VersionBranchCode As String = "100" +#End If + + ''' + ''' 主窗口句柄。 + ''' + Public Handle As IntPtr + ''' + ''' 程序的启动路径，以“\”结尾。 + ''' + Public Path As String = AppDomain.CurrentDomain.SetupInformation.ApplicationBase + ''' + ''' 包含程序名的完整路径。 + ''' + Public PathWithName As String = Path & AppDomain.CurrentDomain.SetupInformation.ApplicationName + ''' + ''' 程序内嵌图片文件夹路径，以“/”结尾。 + ''' + Public PathImage As String = "pack://application:,,,/images/" + ''' + ''' 当前程序的语言。 + ''' + Public Lang As String = "zh_CN" + ''' + ''' 设置对象。 + ''' + Public Setup As New ModSetup + ''' + ''' 程序的打开计时。 + ''' + Public ApplicationStartTick As Long + ''' + ''' 程序打开时的时间。 + ''' + Public ApplicationOpenTime As Date = Date.Now + ''' + ''' 设备唯一标识符。 + ''' + Public UniqueAddress As String = SecretGetUniqueAddress() + ''' + ''' 程序是否已结束。 + ''' + Public IsProgramEnded As Boolean = False + ''' + ''' 是否为 32 位系统。 + ''' + Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem + ''' + ''' 操作系统版本。Win10 为 10.0。 + ''' + Public OsVersion As Version = Environment.OSVersion.Version + ''' + ''' 程序的缓存文件夹路径，以“\”结尾。 + ''' + Public PathTemp As String = If(Setup.Get("SystemSystemCache") = "", IO.Path.GetTempPath() & "PCL\", Setup.Get("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\" + +#End Region + +#Region "矢量图标" + + Public Class Logo + ''' + ''' 图标按钮，心（空心），1.1x + ''' + Public Const IconButtonLikeLine As String = "M512 896a42.666667 42.666667 0 0 1-30.293333-12.373333l-331.52-331.946667a224.426667 224.426667 0 0 1 0-315.733333 223.573333 223.573333 0 0 1 315.733333 0L512 282.026667l46.08-46.08a223.573333 223.573333 0 0 1 315.733333 0 224.426667 224.426667 0 0 1 0 315.733333l-331.52 331.946667A42.666667 42.666667 0 0 1 512 896zM308.053333 256a136.533333 136.533333 0 0 0-97.28 40.106667 138.24 138.24 0 0 0 0 194.986666L512 792.746667l301.226667-301.653334a138.24 138.24 0 0 0 0-194.986666 141.653333 141.653333 0 0 0-194.56 0l-76.373334 76.8a42.666667 42.666667 0 0 1-60.586666 0L405.333333 296.106667A136.533333 136.533333 0 0 0 308.053333 256z" + ''' + ''' 图标按钮，心（实心），1.1x + ''' + Public Const IconButtonLikeFill As String = "M700.856 155.543c-74.769 0-144.295 72.696-190.046 127.26-45.737-54.576-115.247-127.26-190.056-127.26-134.79 0-244.443 105.78-244.443 235.799 0 77.57 39.278 131.988 70.845 175.713C238.908 694.053 469.62 852.094 479.39 858.757c9.41 6.414 20.424 9.629 31.401 9.629 11.006 0 21.998-3.215 31.398-9.63 9.782-6.662 240.514-164.703 332.238-291.701 31.587-43.724 70.874-98.143 70.874-175.713-0.001-130.02-109.656-235.8-244.445-235.8z m0 0" + ''' + ''' 图标按钮，垃圾桶，1.1x + ''' + Public Const IconButtonDelete As String = "M520.192 0C408.43 0 317.44 82.87 313.563 186.734H52.736c-29.038 0-52.663 21.943-52.663 49.079s23.625 49.152 52.663 49.152h58.075v550.473c0 103.35 75.118 187.757 167.717 187.757h472.43c92.599 0 167.716-83.894 167.716-187.757V285.477h52.59c29.038 0 52.59-21.943 52.663-49.08-0.073-27.135-23.625-49.151-52.663-49.151H726.235C723.237 83.017 631.955 0 520.192 0zM404.846 177.957c3.803-50.03 50.176-89.015 107.447-89.015 57.197 0 103.57 38.985 106.788 89.015H404.92zM284.379 933.669c-33.353 0-69.997-39.351-69.997-95.525v-549.01H833.39v549.522c0 56.247-36.645 95.525-69.998 95.525H284.379v-0.512z M357.23 800.695a48.274 48.274 0 0 0 47.616-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.69 49.006V751.69c0 27.282 20.846 49.006 47.617 49.006z m166.62 0a48.274 48.274 0 0 0 47.688-49.006V471.7a48.274 48.274 0 0 0-47.689-49.08 48.274 48.274 0 0 0-47.543 49.006V751.69c0 27.282 21.431 49.006 47.543 49.006z m142.92 0a48.274 48.274 0 0 0 47.543-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.616 49.006V751.69c0 27.282 20.773 49.006 47.543 49.006z" + ''' + ''' 图标按钮，笔，1x + ''' + Public Const IconButtonEdit As String = "M732.64 64.32C688.576 21.216 613.696 21.216 569.6 64.32L120.128 499.52c-17.6 12.896-26.432 30.144-30.848 51.68L32 870.048c0 25.856 8.8 56 26.432 73.248 17.632 17.216 17.632 48.704 88.64 48.704h13.248l326.08-56c22.016-4.32 39.68-12.928 52.864-30.176l449.472-435.2c22.048-21.536 35.264-47.36 35.264-77.536 0-30.176-13.216-56-35.264-77.568l-256.096-251.2zM139.712 903.776l56-326.912 311.04-295.136 267.104 269.44-310.976 295.168-323.168 57.44zM844.576 467.84l-273.984-260.672 61.856-59.84c8.832-8.512 26.528-8.512 39.776 0l234.24 226.496c4.384 4.288 8.832 12.8 8.832 17.088s-4.416 8.544-8.864 12.8l-61.856 64.128z" + ''' + ''' 图标按钮，齿轮，1.1x + ''' + Public Const IconButtonSetup As String = "M651.946667 1001.813333c-22.186667 0-42.666667-10.24-61.44-27.306666-23.893333-23.893333-49.493333-35.84-75.093334-35.84-29.013333 0-56.32 11.946667-73.386666 30.72v3.413333c-17.066667 17.066667-42.666667 27.306667-66.56 27.306667h-6.826667c-6.826667 0-11.946667-1.706667-15.36-1.706667l-6.826667-1.706667c-64.853333-20.48-121.173333-54.613333-168.96-98.986666-29.013333-23.893333-37.546667-63.146667-25.6-95.573334 8.533333-23.893333 5.12-51.2-10.24-75.093333-15.36-27.306667-34.133333-40.96-59.733333-47.786667h-1.706667l-5.12-1.706666c-35.84-8.533333-61.44-34.133333-66.56-69.973334C1.706667 575.146667 0 537.6 0 512c0-32.426667 3.413333-63.146667 8.533333-93.866667v-6.826666l3.413334-8.533334c10.24-23.893333 23.893333-40.96 44.373333-51.2 5.12-3.413333 11.946667-6.826667 20.48-8.533333 27.306667-8.533333 51.2-25.6 63.146667-44.373333 13.653333-23.893333 17.066667-52.906667 10.24-81.92-11.946667-34.133333 0-71.68 30.72-93.866667 44.373333-37.546667 97.28-68.266667 158.72-93.866667l3.413333-1.706666c44.373333-13.653333 75.093333 3.413333 92.16 20.48 23.893333 23.893333 49.493333 35.84 75.093333 35.84 30.72 0 56.32-10.24 71.68-30.72l3.413334-3.413334c27.306667-27.306667 63.146667-35.84 93.866666-22.186666 63.146667 22.186667 117.76 54.613333 165.546667 97.28 29.013333 23.893333 37.546667 63.146667 25.6 95.573333-8.533333 23.893333-5.12 51.2 10.24 75.093333 15.36 27.306667 34.133333 40.96 59.733333 47.786667h1.706667l5.12 1.706667c35.84 8.533333 61.44 34.133333 66.56 71.68 6.826667 30.72 10.24 63.146667 11.946667 93.866666v3.413334c0 32.426667-3.413333 63.146667-8.533334 93.866666v6.826667l-3.413333 8.533333c-10.24 23.893333-23.893333 40.96-44.373333 51.2-5.12 3.413333-11.946667 6.826667-20.48 8.533334-27.306667 8.533333-51.2 25.6-63.146667 46.08-13.653333 23.893333-17.066667 52.906667-10.24 81.92 11.946667 35.84-1.706667 75.093333-30.72 95.573333-44.373333 35.84-95.573333 66.56-157.013333 92.16-15.36 3.413333-27.306667 3.413333-35.84 3.413333z m3.413333-83.626666z m1.706667 0zM517.12 853.333333c47.786667 0 93.866667 20.48 134.826667 59.733334 1.706667 1.706667 3.413333 1.706667 3.413333 3.413333 52.906667-22.186667 97.28-49.493333 136.533333-80.213333l1.706667-1.706667v-3.413333c-13.653333-52.906667-8.533333-104.106667 17.066667-148.48 23.893333-39.253333 64.853333-69.973333 114.346666-85.333334 1.706667 0 3.413333-1.706667 6.826667-6.826666 5.12-25.6 8.533333-51.2 8.533333-78.506667-1.706667-29.013333-3.413333-56.32-10.24-81.92v-5.12h-1.706666c-51.2-11.946667-90.453333-39.253333-119.466667-87.04-27.306667-44.373333-34.133333-100.693333-17.066667-148.48l-1.706666-1.706667h-3.413334c-39.253333-35.84-85.333333-63.146667-136.533333-80.213333H648.533333s-1.706667 1.706667-3.413333 1.706667c-32.426667 39.253333-80.213333 59.733333-136.533333 59.733333-47.786667 0-93.866667-20.48-134.826667-59.733333l-1.706667-1.706667h-1.706666c-54.613333 22.186667-98.986667 49.493333-136.533334 80.213333l-1.706666 1.706667v3.413333c13.653333 52.906667 8.533333 104.106667-17.066667 148.48-23.893333 39.253333-64.853333 69.973333-114.346667 85.333334-1.706667 0-3.413333 1.706667-6.826666 6.826666-6.826667 25.6-8.533333 51.2-8.533334 78.506667 0 30.72 3.413333 58.026667 6.826667 76.8l1.706667 5.12h1.706666c51.2 11.946667 90.453333 39.253333 119.466667 87.04 27.306667 44.373333 34.133333 100.693333 17.066667 148.48l1.706666 1.706667 1.706667 1.706666c37.546667 35.84 83.626667 63.146667 134.826667 80.213334 1.706667 0 3.413333 0 3.413333 1.706666h1.706667s1.706667 0 5.12-1.706666c34.133333-37.546667 81.92-59.733333 136.533333-59.733334z m-6.826667-146.773333c-110.933333 0-199.68-85.333333-199.68-196.266667 0-109.226667 87.04-196.266667 199.68-196.266666s199.68 85.333333 199.68 196.266666c-1.706667 109.226667-88.746667 196.266667-199.68 196.266667z m0-307.2c-63.146667 0-114.346667 49.493333-114.346666 110.933333 0 63.146667 49.493333 110.933333 114.346666 110.933334 30.72 0 59.733333-11.946667 80.213334-32.426667 20.48-20.48 32.426667-49.493333 32.426666-78.506667 0-63.146667-49.493333-110.933333-112.64-110.933333z" + ''' + ''' 图标按钮，重置，0.9x + ''' + Public Const IconButtonReset As String = "M667.6817627 313.65283203l-45.28564454 55.76660156L858.06933594 391.27124023 787.61950684 165.93066406l-56.01379395 69.01611328A354.47387695 354.47387695 0 0 0 520.89892578 165.93066406C324.87536621 165.93066406 165.93066406 324.43041992 165.93066406 519.91015625c0 195.52917481 158.94470215 353.97949219 354.96826172 353.97949219a355.06713867 355.06713867 0 0 0 331.73217774-227.66418458 50.52612305 50.52612305 0 0 0-29.21813966-65.25878905 50.77331543 50.77331543 0 0 0-65.50598144 29.16870117A253.61938477 253.61938477 0 0 1 520.94836426 772.78796387c-140.05920411 0-253.61938477-113.21411133-253.61938477-252.87780762 0-139.61425781 113.56018067-252.82836914 253.61938477-252.82836914 53.59130859 0 104.46350098 16.61132813 146.73339843 46.57104492" + ''' + ''' 图标按钮，刷新，0.85x + ''' + Public Const IconButtonRefresh As String = "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" + ''' + ''' 图标按钮，软盘，1x + ''' + Public Const IconButtonSave As String = "M819.392 0L1024 202.752v652.16a168.96 168.96 0 0 1-168.832 168.768h-104.192a47.296 47.296 0 0 1-10.752 0H283.776a47.232 47.232 0 0 1-10.752 0H168.832A168.96 168.96 0 0 1 0 854.912V168.768A168.96 168.96 0 0 1 168.832 0h650.56z m110.208 854.912V242.112l-149.12-147.776H168.896c-41.088 0-74.432 33.408-74.432 74.432v686.144c0 41.024 33.344 74.432 74.432 74.432h62.4v-190.528c0-33.408 27.136-60.544 60.544-60.544h440.448c33.408 0 60.544 27.136 60.544 60.544v190.528h62.4c41.088 0 74.432-33.408 74.432-74.432z m-604.032 74.432h372.864v-156.736H325.568v156.736z m403.52-596.48a47.168 47.168 0 1 1 0 94.336H287.872a47.168 47.168 0 1 1 0-94.336h441.216z m0-153.728a47.168 47.168 0 1 1 0 94.4H287.872a47.168 47.168 0 1 1 0-94.4h441.216z" + ''' + ''' 图标按钮，信息，1.05x + ''' + Public Const IconButtonInfo As String = "M512 917.333333c223.861333 0 405.333333-181.472 405.333333-405.333333S735.861333 106.666667 512 106.666667 106.666667 288.138667 106.666667 512s181.472 405.333333 405.333333 405.333333z m0 106.666667C229.226667 1024 0 794.773333 0 512S229.226667 0 512 0s512 229.226667 512 512-229.226667 512-512 512z m-32-597.333333h64a21.333333 21.333333 0 0 1 21.333333 21.333333v320a21.333333 21.333333 0 0 1-21.333333 21.333333h-64a21.333333 21.333333 0 0 1-21.333333-21.333333V448a21.333333 21.333333 0 0 1 21.333333-21.333333z m0-192h64a21.333333 21.333333 0 0 1 21.333333 21.333333v64a21.333333 21.333333 0 0 1-21.333333 21.333333h-64a21.333333 21.333333 0 0 1-21.333333-21.333333v-64a21.333333 21.333333 0 0 1 21.333333-21.333333z" + ''' + ''' 图标按钮，列表，1x + ''' + Public Const IconButtonList As String = "M384 128h640v128H384zM160 192m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 448h640v128H384zM160 512m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 768h640v128H384zM160 832m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0Z" + ''' + ''' 图标按钮，文件夹，1.15x + ''' + Public Const IconButtonOpen As String = "M889.018182 418.909091H884.363636V316.509091a93.090909 93.090909 0 0 0-99.607272-89.832727h-302.545455l-93.090909-76.334546A46.545455 46.545455 0 0 0 358.865455 139.636364H146.152727A93.090909 93.090909 0 0 0 46.545455 229.469091V837.818182a46.545455 46.545455 0 0 0 46.545454 46.545454 46.545455 46.545455 0 0 0 16.756364-3.258181 109.381818 109.381818 0 0 0 25.134545 3.258181h586.472727a85.178182 85.178182 0 0 0 87.04-63.301818l163.374546-302.545454a46.545455 46.545455 0 0 0 5.585454-21.876364A82.385455 82.385455 0 0 0 889.018182 418.909091z m-744.727273-186.181818h198.283636l93.09091 76.334545a46.545455 46.545455 0 0 0 29.323636 10.705455h319.301818a12.101818 12.101818 0 0 1 6.516364 0V418.909091H302.545455a85.178182 85.178182 0 0 0-87.04 63.301818L139.636364 622.778182V232.727273a19.549091 19.549091 0 0 1 6.516363 0z m578.094546 552.029091a27.461818 27.461818 0 0 0-2.792728 6.516363H154.530909l147.083636-272.290909a27.461818 27.461818 0 0 0 2.792728-6.981818h565.061818z" + ''' + ''' 图标按钮，名片，1.1x + ''' + Public Const IconButtonCard As String = "M834.5 684.1c-31.2-70.4-98.9-120.9-179.1-127.3 63.5-8.5 112.6-63 112.6-128.8 0-71.8-58.2-130-130-130s-130 58.2-130 130c0 65.9 49 120.3 112.6 128.8-80.2 6.4-148 57-179.1 127.3-8.7 19.7 6 42 27.6 42 12.1 0 22.7-7.5 27.7-18.5 24.3-53.9 78.5-91.5 141.3-91.5s117 37.6 141.3 91.5c5 11.1 15.6 18.5 27.7 18.5 21.4 0 36.1-22.3 27.4-42zM567.9 427.9c0-38.6 31.4-70 70-70s70 31.4 70 70-31.4 70-70 70-70-31.4-70-70zM460.3 347.9H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h243.3c16.6 0 30-13.4 30-30 0.1-16.5-13.4-30-29.9-30zM367.4 459.6H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h150.4c16.6 0 30-13.4 30-30 0.1-16.6-13.4-30-29.9-30zM297.4 571.2H217c-16.6 0-30 13.4-30 30s13.4 30 30 30h80.4c16.6 0 30-13.4 30-30 0-16.5-13.5-30-30-30zM900 236v552H124V236h776m0-60H124c-33.1 0-60 26.9-60 60v552c0 33.1 26.9 60 60 60h776c33.1 0 60-26.9 60-60V236c0-33.1-26.9-60-60-60z" + ''' + ''' 图标按钮，×，0.85x + ''' + Public Const IconButtonCross As String = "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" + ''' + ''' 图标按钮，Mojang，1.1x + ''' + Public Const IconButtonMojang As String = "M9.183,18.967c-0.109-2.239,1.336-5.119,3.92-4.96c3.657-0.027,7.319-0.044,10.977,0.005 c3.712,0.214,6.596,2.759,9.652,4.533c0.181-1.697-0.197-3.717,1.237-4.982c1.899,2.091,3.143,4.894,5.677,6.334 c1.577,0.805,2.973-0.668,4.221-1.44c1.55,2.305,2.108,5.075,2.622,7.752c0.657,3.438,0.947,6.925,1.111,10.413 c-1.734-0.733-3.355-1.708-4.971-2.671c-1.396-4.933-5.349-8.656-9.723-11.059c-3.46-1.817-7.752-2.185-11.338-0.52 c-3.761,1.593-6.285,5.666-5.891,9.75c0.121,4.577,3.17,8.765,7.391,10.456c7.746,3.285,16.407,2.234,24.521,1.243 c0.454,2.315-1.511,4.527-3.695,4.889c-10.577,0.038-21.148-0.011-31.725,0.022c-2.217,0.279-4.079-1.879-3.964-4.008 C9.167,36.141,9.216,27.556,9.183,18.967z M40.114,8.09c0.294-0.801,0.872-1.417,1.542-1.924c1.379,2.589,2.742,5.482,2.311,8.491 c-0.332,2.54-4.42,2.507-5.052,0.163C38.349,12.527,39.209,10.178,40.114,8.09z M0,53 l0.1,0 z" + ''' + ''' 图标按钮，用户，0.95x + ''' + Public Const IconButtonUser As String = "M660.338 528.065c63.61-46.825 105.131-121.964 105.131-206.83 0-141.7-115.29-256.987-256.997-256.987-141.706 0-256.998 115.288-256.998 256.987 0 85.901 42.52 161.887 107.456 208.562-152.1 59.92-260.185 207.961-260.185 381.077 0 21.276 17.253 38.53 38.53 38.53 21.278 0 38.53-17.254 38.53-38.53 0-183.426 149.232-332.671 332.667-332.671 1.589 0 3.113-0.207 4.694-0.244 0.8 0.056 1.553 0.244 2.362 0.244 183.434 0 332.664 149.245 332.664 332.671 0 21.276 17.255 38.53 38.533 38.53 21.277 0 38.53-17.254 38.53-38.53 0-174.885-110.354-324.13-264.917-382.809z m-331.803-206.83c0-99.22 80.72-179.927 179.935-179.927s179.937 80.708 179.937 179.927c0 99.203-80.721 179.91-179.937 179.91s-179.935-80.708-179.935-179.91z" + ''' + ''' 图标，音符，1x + ''' + Public Const IconMusic As String = "M348.293565 716.53287V254.797913c0-41.672348 28.004174-78.358261 68.919652-90.37913L815.994435 40.826435c62.775652-18.610087 125.907478 26.579478 125.907478 89.933913v539.158261c8.013913 42.25113-8.94887 89.177043-47.014956 127.109565a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c21.014261 1.024 40.514783 5.164522 57.878261 12.065391V233.338435c0-12.109913-10.551652-20.034783-20.569044-20.034783a24.620522 24.620522 0 0 0-5.787826 0.934957L439.785739 338.18713a19.545043 19.545043 0 0 0-14.825739 19.144348v438.984348H423.846957c11.53113 43.987478-5.164522 94.208-45.412174 134.322087a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c20.791652 1.024 40.069565 5.075478 57.299478 11.842783z" + ''' + ''' 图标，播放，0.8x + ''' + Public Const IconPlay As String = "M803.904 463.936a55.168 55.168 0 0 1 0 96.128l-463.616 264.448C302.848 845.888 256 819.136 256 776.448V247.616c0-42.752 46.848-69.44 84.288-48.064l463.616 264.384z" + End Class + +#End Region + +#Region "自定义类" + + ''' + ''' 支持小数与常见类型隐式转换的颜色。 + ''' + Public Class MyColor + + Public A As Double = 255 + Public R As Double = 0 + Public G As Double = 0 + Public B As Double = 0 + + '类型转换 + Public Shared Widening Operator CType(str As String) As MyColor + Return New MyColor(str) + End Operator + Public Shared Widening Operator CType(col As Color) As MyColor + Return New MyColor(col) + End Operator + Public Shared Widening Operator CType(conv As MyColor) As Color + Return Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B)) + End Operator + Public Shared Widening Operator CType(conv As MyColor) As System.Drawing.Color + Return System.Drawing.Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B)) + End Operator + Public Shared Widening Operator CType(bru As SolidColorBrush) As MyColor + Return New MyColor(bru.Color) + End Operator + Public Shared Widening Operator CType(conv As MyColor) As SolidColorBrush + Return New SolidColorBrush(Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B))) + End Operator + Public Shared Widening Operator CType(bru As Brush) As MyColor + Return New MyColor(bru) + End Operator + Public Shared Widening Operator CType(conv As MyColor) As Brush + Return New SolidColorBrush(Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B))) + End Operator + + '颜色运算 + Public Shared Operator +(a As MyColor, b As MyColor) As MyColor + Return New MyColor With {.A = a.A + b.A, .B = a.B + b.B, .G = a.G + b.G, .R = a.R + b.R} + End Operator + Public Shared Operator -(a As MyColor, b As MyColor) As MyColor + Return New MyColor With {.A = a.A - b.A, .B = a.B - b.B, .G = a.G - b.G, .R = a.R - b.R} + End Operator + Public Shared Operator *(a As MyColor, b As Double) As MyColor + Return New MyColor With {.A = a.A * b, .B = a.B * b, .G = a.G * b, .R = a.R * b} + End Operator + Public Shared Operator /(a As MyColor, b As Double) As MyColor + Return New MyColor With {.A = a.A / b, .B = a.B / b, .G = a.G / b, .R = a.R / b} + End Operator + Public Shared Operator =(a As MyColor, b As MyColor) As Boolean + If IsNothing(a) AndAlso IsNothing(b) Then Return True + If IsNothing(a) OrElse IsNothing(b) Then Return False + Return a.A = b.A AndAlso a.R = b.R AndAlso a.G = b.G AndAlso a.B = b.B + End Operator + Public Shared Operator <>(a As MyColor, b As MyColor) As Boolean + If IsNothing(a) AndAlso IsNothing(b) Then Return False + If IsNothing(a) OrElse IsNothing(b) Then Return True + Return Not (a.A = b.A AndAlso a.R = b.R AndAlso a.G = b.G AndAlso a.B = b.B) + End Operator + + '构造函数 + Public Sub New() + End Sub + Public Sub New(col As Color) + Me.A = col.A + Me.R = col.R + Me.G = col.G + Me.B = col.B + End Sub + Public Sub New(HexString As String) + Dim StringColor As Media.Color = ColorConverter.ConvertFromString(HexString) + A = StringColor.A + R = StringColor.R + G = StringColor.G + B = StringColor.B + End Sub + Public Sub New(newA As Double, col As MyColor) + Me.A = newA + Me.R = col.R + Me.G = col.G + Me.B = col.B + End Sub + Public Sub New(newR As Double, newG As Double, newB As Double) + Me.A = 255 + Me.R = newR + Me.G = newG + Me.B = newB + End Sub + Public Sub New(newA As Double, newR As Double, newG As Double, newB As Double) + Me.A = newA + Me.R = newR + Me.G = newG + Me.B = newB + End Sub + Public Sub New(brush As Brush) + Dim Color As Color = CType(brush, SolidColorBrush).Color + A = Color.A + R = Color.R + G = Color.G + B = Color.B + End Sub + Public Sub New(brush As SolidColorBrush) + Dim Color As Color = brush.Color + A = Color.A + R = Color.R + G = Color.G + B = Color.B + End Sub + Public Sub New(obj As Object) + If obj Is Nothing Then + A = 255 : R = 255 : G = 255 : B = 255 + Else + If TypeOf obj Is SolidColorBrush Then + '避免反复获取 Color 对象造成性能下降 + Dim Color As Color = CType(obj, SolidColorBrush).Color + A = Color.A + R = Color.R + G = Color.G + B = Color.B + Else + A = obj.A + R = obj.R + G = obj.G + B = obj.B + End If + End If + End Sub + + 'HSL + Public Function Hue(v1 As Double, v2 As Double, vH As Double) As Double + If vH < 0 Then vH += 1 + If vH > 1 Then vH -= 1 + If vH < 0.16667 Then Return v1 + (v2 - v1) * 6 * vH + If vH < 0.5 Then Return v2 + If vH < 0.66667 Then Return v1 + (v2 - v1) * (4 - vH * 6) + Return v1 + End Function + Public Function FromHSL(sH As Double, sS As Double, sL As Double) As MyColor + If sS = 0 Then + R = sL * 2.55 + G = R + B = R + Else + Dim H = sH / 360 + Dim S = sS / 100 + Dim L = sL / 100 + S = If(L < 0.5, S * L + L, S * (1.0 - L) + L) + L = 2 * L - S + R = 255 * Hue(L, S, H + 1 / 3) + G = 255 * Hue(L, S, H) + B = 255 * Hue(L, S, H - 1 / 3) + End If + A = 255 + Return Me + End Function + Public Function FromHSL2(sH As Double, sS As Double, sL As Double) As MyColor + If sS = 0 Then + R = sL * 2.55 : G = R : B = R + Else + '初始化 + sH = (sH + 3600000) Mod 360 + Dim cent As Double() = { + +0.1, -0.06, -0.3, '0, 30, 60 + -0.19, -0.15, -0.24, '90, 120, 150 + -0.32, -0.09, +0.18, '180, 210, 240 + +0.05, -0.12, -0.02, '270, 300, 330 + +0.1, -0.06} '最后两位与前两位一致，加是变亮，减是变暗 + '计算色调对应的亮度片区 + Dim center As Double = sH / 30.0 + Dim intCenter As Integer = Math.Floor(center) '亮度片区编号 + center = 50 - ( + (1 - center + intCenter) * cent(intCenter) + (center - intCenter) * cent(intCenter + 1) + ) * sS + 'center = 50 + (cent(intCenter) + (center - intCenter) * (cent(intCenter + 1) - cent(intCenter))) * sS + sL = If(sL < center, sL / center, 1 + (sL - center) / (100 - center)) * 50 + FromHSL(sH, sS, sL) + End If + A = 255 + Return Me + End Function + + Public Overrides Function ToString() As String + Return "(" & A & "," & R & "," & G & "," & B & ")" + End Function + Public Overrides Function Equals(obj As Object) As Boolean + Return Me = obj + End Function + + End Class + + ''' + ''' 支持负数与浮点数的矩形。 + ''' + Public Class MyRect + + '属性 + Public Property Width As Double = 0 + Public Property Height As Double = 0 + Public Property Left As Double = 0 + Public Property Top As Double = 0 + + '构造函数 + Public Sub New() + End Sub + Public Sub New(left As Double, top As Double, width As Double, height As Double) + Me.Left = left + Me.Top = top + Me.Width = width + Me.Height = height + End Sub + + End Class + + ''' + ''' 模块加载状态枚举。 + ''' + Public Enum LoadState + Waiting + Loading + Finished + Failed + Aborted + End Enum + + ''' + ''' 执行返回值。 + ''' + Public Enum Result + ''' + ''' 执行成功，或进程被中断。 + ''' + Aborted = -1 + ''' + ''' 执行成功。 + ''' + Success = 0 + ''' + ''' 执行失败。 + ''' + Fail + ''' + ''' 执行时出现未经处理的异常。 + ''' + Exception + ''' + ''' 执行超时。 + ''' + Timeout + ''' + ''' 取消执行。可能是由于不满足执行的前置条件。 + ''' + Cancel + End Enum + + ''' + ''' 可以使用 Equals 和等号的 List。 + ''' + Public Class EqualableList(Of T) + Inherits List(Of T) + Public Overrides Function Equals(obj As Object) As Boolean + If TryCast(obj, List(Of T)) Is Nothing Then + '类型不同 + Return False + Else + '类型相同 + Dim objList As List(Of T) = obj + If objList.Count <> Count Then Return False + For i = 0 To objList.Count - 1 + If Not objList(i).Equals(Me(i)) Then Return False + Next + Return True + End If + End Function + Public Shared Operator =(left As EqualableList(Of T), right As EqualableList(Of T)) As Boolean + Return EqualityComparer(Of EqualableList(Of T)).Default.Equals(left, right) + End Operator + Public Shared Operator <>(left As EqualableList(Of T), right As EqualableList(Of T)) As Boolean + Return Not left = right + End Operator + End Class + +#End Region + +#Region "数学" + + ''' + ''' 计算二阶贝塞尔曲线。 + ''' + Public Function MathBezier(x As Double, x1 As Double, y1 As Double, x2 As Double, y2 As Double, Optional acc As Double = 0.01) As Double + If x <= 0 OrElse Double.IsNaN(x) Then Return 0 + If x >= 1 Then Return 1 + Dim a, b + a = x + Do + b = 3 * a * ((0.33333333 + x1 - x2) * a * a + (x2 - 2 * x1) * a + x1) + a += (x - b) * 0.5 + Loop Until Math.Abs(b - x) < acc '精度 + Return 3 * a * ((0.33333333 + y1 - y2) * a * a + (y2 - 2 * y1) * a + y1) + End Function + + ''' + ''' 将一个数字限制为 0~255 的 Byte 值。 + ''' + Public Function MathByte(d As Double) As Byte + If d < 0 Then d = 0 + If d > 255 Then d = 255 + Return Math.Round(d) + End Function + + ''' + ''' 提供 MyColor 类型支持的 Math.Round。 + ''' + Public Function MathRound(col As MyColor, Optional w As Integer = 0) As MyColor + Return New MyColor With {.A = Math.Round(col.A, w), .R = Math.Round(col.R, w), .G = Math.Round(col.G, w), .B = Math.Round(col.B, w)} + End Function + + ''' + ''' 获取两数间的百分比。小数点精确到 6 位。 + ''' + ''' + ''' + Public Function MathPercent(ValueA As Double, ValueB As Double, Percent As Double) As Double + Return Math.Round(ValueA * (1 - Percent) + ValueB * Percent, 6) '解决 Double 计算错误 + End Function + ''' + ''' 获取两颜色间的百分比，根据 RGB 计算。小数点精确到 6 位。 + ''' + Public Function MathPercent(ValueA As MyColor, ValueB As MyColor, Percent As Double) As MyColor + Return MathRound(ValueA * (1 - Percent) + ValueB * Percent, 6) '解决Double计算错误 + End Function + + ''' + ''' 将数值限定在某个范围内。 + ''' + Public Function MathRange(value As Double, min As Double, max As Double) As Double + Return Math.Max(min, Math.Min(max, value)) + End Function + + ''' + ''' 符号函数。 + ''' + Public Function MathSgn(Value As Double) As Integer + If Value = 0 Then + Return 0 + ElseIf Value > 0 Then + Return 1 + Else + Return -1 + End If + End Function + +#End Region + +#Region "文件" + + '注册表 + ''' + ''' 重命名一个注册表子键。不可用于包含子键的子键。 + ''' + Public Sub RegRename(parentKey As Microsoft.Win32.RegistryKey, subKeyName As String, newSubKeyName As String) + If parentKey.GetSubKeyNames().Contains(newSubKeyName) Then parentKey.DeleteSubKeyTree(newSubKeyName, False) + Dim SourceKey As Microsoft.Win32.RegistryKey = parentKey.OpenSubKey(subKeyName) + If IsNothing(SourceKey) Then Exit Sub '没有目标项 + Dim NewKey As Microsoft.Win32.RegistryKey = parentKey.CreateSubKey(newSubKeyName) + If SourceKey.GetSubKeyNames().Length > 0 Then Throw New NotSupportedException("不支持对包含子键的子键进行重命名：" & SourceKey.GetSubKeyNames()(0) & "。") + For Each valueName As String In SourceKey.GetValueNames() + Dim objValue As Object = SourceKey.GetValue(valueName) + Dim valKind As Microsoft.Win32.RegistryValueKind = SourceKey.GetValueKind(valueName) + NewKey.SetValue(valueName, objValue, valKind) + Next + parentKey.DeleteSubKeyTree(subKeyName, False) + End Sub + ''' + ''' 读取程序所属注册表。 + ''' + Public Function ReadReg(Key As String, Optional DefaultValue As String = "") As String + Try + Dim parentKey As Microsoft.Win32.RegistryKey, softKey As Microsoft.Win32.RegistryKey + parentKey = My.Computer.Registry.CurrentUser + softKey = parentKey.OpenSubKey("Software\PCL", True) + If softKey Is Nothing Then + ReadReg = DefaultValue '不存在则返回默认值 + Else + Dim readValue As New Text.StringBuilder + readValue.AppendLine(softKey.GetValue(Key)) + Dim value = readValue.ToString.Replace(vbCrLf, "") '去除莫名的回车 + Return If(value = "", DefaultValue, value) '错误则返回默认值 + End If + Catch ex As Exception + Log(ex, "读取注册表出错：" & Key, LogLevel.Hint) + Return DefaultValue + End Try + End Function + ''' + ''' 写入程序所属注册表。 + ''' + Public Sub WriteReg(Key As String, Value As String, Optional ShowException As Boolean = False) + Try + Dim parentKey As Microsoft.Win32.RegistryKey, softKey As Microsoft.Win32.RegistryKey + parentKey = My.Computer.Registry.CurrentUser + softKey = parentKey.OpenSubKey("Software\PCL", True) + If softKey Is Nothing Then softKey = parentKey.CreateSubKey("Software\PCL") '如果不存在就创建 + softKey.SetValue(Key, Value) + Catch ex As Exception + Log(ex, "写入注册表出错：" & Key, If(ShowException, LogLevel.Hint, LogLevel.Developer)) + If ShowException Then Throw '如果显示错误就丢一个 + End Try + End Sub + + 'Ini 文件 + Private Class IniCache + Public FileContent As String = "" + Public KVCache As New Dictionary(Of String, String) + End Class + Private ReadOnly IniCacheList As New Dictionary(Of String, IniCache) + ''' + ''' 清除某 Ini 文件的运行时缓存。 + ''' + ''' 文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。 + Public Sub IniClearCache(FileName As String) + '还原文件路径 + If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini" + '检索缓存 + If IniCacheList.ContainsKey(FileName) Then IniCacheList.Remove(FileName) + End Sub + ''' + ''' 获取 Ini 文件内容，这可能会使用到缓存。 + ''' + ''' 文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。 + Private Function IniGetContent(FileName As String) As IniCache + Try + '还原文件路径 + If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini" + '检索缓存 + If IniCacheList.ContainsKey(FileName) Then + '返回缓存中的信息 + Dim Cache As New IniCache + IniCacheList.TryGetValue(FileName, Cache) + Return Cache '防止ByRef导致缓存变更 + Else + Dim Ini As IniCache + If File.Exists(FileName) Then + '返回文件信息并且记入缓存 + Dim Cache As String = (vbCrLf & ReadFile(FileName) & vbCrLf).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).Replace(vbCrLf & vbCrLf, vbCrLf).Replace(vbNullChar, "") + Ini = New IniCache With {.FileContent = Cache} + Else + '返回空文件信息 + Ini = New IniCache With {.FileContent = ""} + End If + If Not IniCacheList.ContainsKey(FileName) Then IniCacheList.Add(FileName, Ini) '避免多线程异步执行此方法时造成多次添加项 + Return Ini + End If + Catch ex As Exception + Log(ex, "读取文件失败：" & FileName, LogLevel.Hint) + Return New IniCache With {.FileContent = ""} + End Try + End Function + ''' + ''' 读取Ini文件，这可能会使用到缓存。 + ''' + ''' 文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。 + ''' 键。 + ''' 没有找到键时返回的默认值。 + Public Function ReadIni(FileName As String, Key As String, Optional DefaultValue As String = "") As String + Try + '获取目前文件 + Dim NowIni As IniCache = IniGetContent(FileName) + If IsNothing(NowIni) Then Return DefaultValue + '使用缓存 + If NowIni.KVCache.ContainsKey(Key) Then Return If(NowIni.KVCache(Key), DefaultValue) + '没有缓存，读取文件 + If NowIni.FileContent.Contains(vbCrLf & Key & ":") Then + Dim Ret As String = Mid(NowIni.FileContent, NowIni.FileContent.IndexOf(vbCrLf & Key & ":") + 3) + Ret = If(Ret.Contains(vbCrLf), Mid(Ret, 1, Ret.IndexOf(vbCrLf)), Ret).Replace(Key & ":", "") + NowIni.KVCache.Add(Key, If(Ret = vbLf, "", Ret)) + Return If(Ret = vbLf, "", Ret) + Else + Return DefaultValue + End If + Catch ex As Exception + '读取失败 + Return DefaultValue + End Try + End Function + ''' + ''' 写入ini文件，这会更新缓存。 + ''' + ''' 文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。 + ''' 键。 + ''' 值。 + ''' + Public Sub WriteIni(FileName As String, Key As String, Value As String) + Try + + '还原文件路径 + If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini" + If IsNothing(Value) Then Value = "" + Value = Value.Replace(vbCrLf, "") + '创建文件夹 + If Not Directory.Exists(GetPathFromFullPath(FileName)) Then Directory.CreateDirectory(GetPathFromFullPath(FileName)) + '获取目前文件 + Dim NowFile As String = IniGetContent(FileName).FileContent + If Not NowFile.EndsWith(vbCrLf) Then NowFile += vbCrLf + '如果值一样就不处理 + If NowFile.Contains(vbCrLf & Key & ":" & Value & vbCrLf) Then Exit Sub + '处理文件 + Dim FindResult As String = ReadIni(FileName, Key) + If FindResult = "" AndAlso Not NowFile.Contains(vbCrLf & Key & ":") Then + '不存在这个键 + NowFile = NowFile & vbCrLf & Key & ":" & Value & vbCrLf + Else + '存在这个键 + NowFile = NowFile.Replace(vbCrLf & Key & ":" & FindResult & vbCrLf, vbCrLf & Key & ":" & Value & vbCrLf) + End If + WriteFile(FileName, NowFile) + '刷新目前缓存 + IniCacheList(FileName).FileContent = NowFile + IniCacheList(FileName).KVCache.Remove(Key) + IniCacheList(FileName).KVCache.Add(Key, Value) + + Catch ex As Exception + Log(ex, "写入文件失败：" & FileName & "/" & Key & ": " & Value) + End Try + End Sub + + '路径处理 + ''' + ''' 从文件路径或者 Url 获取不包含文件名的路径，或获取文件夹的父文件夹路径。不包含路径将会抛出异常。 + ''' + Public Function GetPathFromFullPath(FilePath As String) As String + If Not (FilePath.Contains("\") OrElse FilePath.Contains("/")) Then Throw New Exception("不包含路径：" & FilePath) + If FilePath.EndsWith("\") OrElse FilePath.EndsWith("/") Then + '是文件夹路径 + Dim IsRight As Boolean = FilePath.EndsWith("\") + 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) + If GetPathFromFullPath = "" Then Throw New Exception("不包含路径：" & FilePath) + End If + End Function + ''' + ''' 从文件路径或者 Url 获取不包含路径的文件名。不包含文件名将会抛出异常。 + ''' + Public Function GetFileNameFromPath(FilePath As String) As String + If FilePath.EndsWith("\") OrElse FilePath.EndsWith("/") Then Throw New Exception("不包含文件名：" & FilePath) + If Not (FilePath.Contains("\") OrElse FilePath.Contains("/")) Then Return FilePath + If FilePath.Contains("?") Then FilePath = Left(FilePath, FilePath.LastIndexOf("?")) '去掉网络参数后的 ? + GetFileNameFromPath = Mid(FilePath, FilePath.LastIndexOfAny({"\", "/"}) + 2) + If GetFileNameFromPath = "" Then Throw New Exception("不包含文件名：" & FilePath) + End Function + ''' + ''' 从文件路径或者 Url 获取不包含路径与扩展名的文件名。不包含文件名将会抛出异常。 + ''' + Public Function GetFileNameWithoutExtentionFromPath(FilePath As String) As String + Dim Name As String = GetFileNameFromPath(FilePath) + If Name.Contains(".") Then + Return Name.Substring(0, Name.LastIndexOf(".")) + Else + Return Name + End If + End Function + ''' + ''' 从文件夹路径获取文件夹名。 + ''' + Public Function GetFolderNameFromPath(FolderPath As String) As String + If FolderPath.EndsWith(":\") OrElse FolderPath.EndsWith(":\\") Then Return FolderPath.Substring(0, 1) + If FolderPath.EndsWith("\") OrElse FolderPath.EndsWith("/") Then FolderPath = Left(FolderPath, FolderPath.Length - 1) + Return GetFileNameFromPath(FolderPath) + End Function + + '读取、写入文件 + ''' + ''' 读取文件，如果失败则返回空字符串。 + ''' + ''' 文件完整或相对路径。 + Public Function ReadFile(FilePath As String) As String + Try + '还原文件路径 + If Not FilePath.Contains(":\") Then FilePath = Path & FilePath + If File.Exists(FilePath) Then + ReadFile = DecodeBytes(File.ReadAllBytes(FilePath)) + Else + Log("[System] 欲读取的文件不存在，已返回空字符串：" & FilePath) + Return "" + End If + Catch ex As Exception + Log(ex, "读取文件出错：" & FilePath) + Return "" + End Try + End Function + ''' + ''' 读取流中的所有文本。 + ''' + Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String + Try + Dim srcBuf As Byte() = New Byte(16384) {} + Dim DataCount As Integer = Stream.Read(srcBuf, 0, 16384) + Dim Result As New List(Of Byte) + While DataCount > 0 + If DataCount > 0 Then Result.AddRange(srcBuf.ToList.GetRange(0, DataCount)) + DataCount = Stream.Read(srcBuf, 0, 16384) + End While + Dim Bts = Result.ToArray + Return If(Encoding, GetEncoding(Bts)).GetString(Bts) + Catch ex As Exception + Log(ex, "读取流出错") + Return "" + End Try + End Function + ''' + ''' 写入文件。 + ''' + ''' 文件完整或相对路径。 + ''' 文件内容。 + ''' 是否将文件内容追加到当前文件，而不是覆盖它。 + Public Function WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing) As Boolean + Try + '还原文件路径 + If Not FilePath.Contains(":\") Then FilePath = Path & FilePath + '确保目录存在 + Directory.CreateDirectory(GetPathFromFullPath(FilePath)) + '写入文件 + If File.Exists(FilePath) Then + '如果文件存在，刷新目前文件 + Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(FilePath))) + writer.Write(Text) + writer.Flush() + writer.Close() + End Using + Else + '如果文件不存在，则新建并写入 + File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False))) + End If + Return True + Catch ex As Exception + Log(ex, "写入文件时出错：" & FilePath) + Return False + End Try + End Function + ''' + ''' 写入文件。 + ''' + ''' 文件完整或相对路径。 + ''' 文件内容。 + ''' 是否将文件内容追加到当前文件，而不是覆盖它。 + Public Function WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False) As Boolean + Try + '还原文件路径 + If Not FilePath.Contains(":\") Then FilePath = Path & FilePath + '确保目录存在 + Directory.CreateDirectory(GetPathFromFullPath(FilePath)) + '写入文件 + File.WriteAllBytes(FilePath, Content) + 'File.Exists 的写法只会写入 System.Byte[]（无法进行转码，Write 不支持写入 Byte[]） + 'If File.Exists(FilePath) Then + ' '如果文件存在，刷新目前文件 + ' Using writer As New StreamWriter(FilePath, Append, GetEncoding(FilePath)) + ' writer.Write(Content) + ' writer.Flush() + ' writer.Close() + ' End Using + 'Else + ' '如果文件不存在，则新建并写入 + ' File.WriteAllBytes(FilePath, Content) + 'End If + Return True + Catch ex As Exception + Log(ex, "写入文件时出错：" & FilePath) + Return False + End Try + End Function + ''' + ''' 将流写入文件。 + ''' + ''' 文件完整或相对路径。 + Public Function WriteFile(FilePath As String, Stream As Stream) As Boolean + Try + '还原文件路径 + If Not FilePath.Contains(":\") Then FilePath = Path & FilePath + '确保目录存在 + Directory.CreateDirectory(GetPathFromFullPath(FilePath)) + '读取流 + Using fs As New FileStream(FilePath, FileMode.Create, FileAccess.Write) + Dim srcBuf As Byte() = New Byte(16384) {} + Dim DataCount As Integer = Stream.Read(srcBuf, 0, 16384) + While DataCount > 0 + If DataCount > 0 Then fs.Write(srcBuf, 0, DataCount) + DataCount = Stream.Read(srcBuf, 0, 16384) + End While + fs.Close() + End Using + Return True + Catch ex As Exception + Log(ex, "保存流出错") + Return False + End Try + End Function + + '文件编码 + ''' + ''' 获取文件编码。 + ''' + ''' 文件完整或相对路径。 + Public Function GetEncoding(FilePath As String) As Encoding + '还原文件路径 + If Not FilePath.Contains(":\") Then FilePath = Path & FilePath + '获取编码 + GetEncoding = GetEncoding(File.ReadAllBytes(FilePath)) + End Function + ''' + ''' 获取 Bytes 的编码。 + ''' + Public Function GetEncoding(Bytes As Byte()) As Encoding + Dim Length As Integer = Bytes.Count + If Length <= 2 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8 + '根据 BOM 判断编码 + If Bytes(0) >= &HEF Then + '有 BOM 类型 + If Bytes(0) = &HEF AndAlso Bytes(1) = &HBB Then + Return New UTF8Encoding(True) '带 BOM 的 UTF8 + ElseIf Bytes(0) = &HFE AndAlso Bytes(1) = &HFF Then + Return Encoding.BigEndianUnicode + ElseIf Bytes(0) = &HFF AndAlso Bytes(1) = &HFE Then + Return Encoding.Unicode + Else + Return Encoding.GetEncoding("GB18030") + End If + End If + '无 BOM 文件：GB18030（ANSI）或 UTF8 + Dim UTF8 = Encoding.UTF8.GetString(Bytes) + Dim ErrorChar As Char = Encoding.UTF8.GetString({239, 191, 189}).ToCharArray()(0) + If UTF8.Contains(ErrorChar) Then + Return Encoding.GetEncoding("GB18030") + Else + Return New UTF8Encoding(False) '不带 BOM 的 UTF8 + End If + End Function + ''' + ''' 解码 Bytes。 + ''' + Public Function DecodeBytes(Bytes As Byte()) As String + Dim Length As Integer = Bytes.Length + If Length < 3 Then Return Encoding.UTF8.GetString(Bytes) + '根据 BOM 判断编码 + If Bytes(0) >= &HEF Then + '有 BOM 类型 + If Bytes(0) = &HEF AndAlso Bytes(1) = &HBB Then + Return Encoding.UTF8.GetString(Bytes, 3, Length - 3) + ElseIf Bytes(0) = &HFE AndAlso Bytes(1) = &HFF Then + Return Encoding.BigEndianUnicode.GetString(Bytes, 3, Length - 3) + ElseIf Bytes(0) = &HFF AndAlso Bytes(1) = &HFE Then + Return Encoding.Unicode.GetString(Bytes, 3, Length - 3) + Else + Return Encoding.GetEncoding("GB18030").GetString(Bytes, 3, Length - 3) + End If + End If + '无 BOM 文件：GB18030（ANSI）或 UTF8 + Dim UTF8 = Encoding.UTF8.GetString(Bytes) + Dim ErrorChar As Char = Encoding.UTF8.GetString({239, 191, 189}).ToCharArray()(0) + If UTF8.Contains(ErrorChar) Then + Return Encoding.GetEncoding("GB18030").GetString(Bytes) + Else + Return UTF8 + End If + End Function + + '对话框 + ''' + ''' 弹出保存对话框并且要求保存位置，返回用户输入的完整路径。 + ''' + ''' 要求的格式。如：“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。 + ''' 弹窗的标题。 + ''' 默认的文件名。 + Public Function SelectAs(Title As String, FileName As String, Optional FileFilter As String = Nothing, Optional DefaultDir As String = Nothing) As String + Using fileDialog As New Forms.SaveFileDialog + fileDialog.AddExtension = True + fileDialog.AutoUpgradeEnabled = True + fileDialog.Title = Title + fileDialog.FileName = FileName + If FileFilter IsNot Nothing Then fileDialog.Filter = FileFilter + If DefaultDir IsNot Nothing Then fileDialog.InitialDirectory = DefaultDir + fileDialog.ShowDialog() + SelectAs = If(fileDialog.FileName.Contains(":\"), fileDialog.FileName, "") + Log("[UI] 选择文件返回：" & SelectAs) + End Using + End Function + ''' + ''' 弹出选取文件对话框并且要求选取文件。 + ''' + ''' 要求的格式。如：“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。 + ''' 弹窗的标题。 + Public Function SelectFile(FileFilter As String, Title As String) As String + Using fileDialog As New Forms.OpenFileDialog + fileDialog.AddExtension = True + fileDialog.AutoUpgradeEnabled = True + fileDialog.CheckFileExists = True + fileDialog.Filter = FileFilter + fileDialog.Multiselect = False + fileDialog.Title = Title + fileDialog.ValidateNames = True + fileDialog.ShowDialog() + SelectFile = fileDialog.FileName + Log("[UI] 选择文件返回：" & SelectFile) + End Using + End Function + ''' + ''' 弹出选取文件夹对话框并且要求选取文件夹。如果没有选择就返回空字符串。 + ''' + Public Function SelectFolder(Optional Title As String = "选择文件夹") As String + Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True} + folderDialog.ShowDialog() + SelectFolder = If(String.IsNullOrEmpty(folderDialog.SelectedPath), "", folderDialog.SelectedPath & If(folderDialog.SelectedPath.EndsWith("\"), "", "\")) + Log("[UI] 选择文件夹返回：" & SelectFolder) + End Function + + '文件校验 + ''' + ''' 检查是否拥有某一文件夹的 I/O 权限。如果文件夹不存在，会返回 False。 + ''' + Public Function CheckPermission(Path As String) As Boolean + Try + If Path = "" Then Return False + If Not Path.EndsWith("\") Then Path += "\" + If Path.EndsWith(":\System Volume Information\") OrElse Path.EndsWith(":\$RECYCLE.BIN\") Then Return False + If Not Directory.Exists(Path) Then Return False + Dim FileName As String = "CheckPermission" & GetUuid() + If File.Exists(Path & FileName) Then File.Delete(Path & FileName) + File.Create(Path & FileName).Dispose() + File.Delete(Path & FileName) + Return True + Catch ex As Exception + Log(ex, "没有对文件夹 " & Path & " 的权限，请尝试以管理员权限运行 PCL") + Return False + End Try + End Function + ''' + ''' 检查是否拥有某一文件夹的 I/O 权限。如果出错，则抛出异常。 + ''' + Public Sub CheckPermissionWithException(Path As String) + If String.IsNullOrWhiteSpace(Path) Then Throw New ArgumentNullException("文件夹名不能为空！") + If Not Path.EndsWith("\") Then Path += "\" + If Not Directory.Exists(Path) Then Throw New DirectoryNotFoundException("文件夹不存在！") + If File.Exists(Path & "CheckPermission") Then File.Delete(Path & "CheckPermission") + File.Create(Path & "CheckPermission").Dispose() + File.Delete(Path & "CheckPermission") + End Sub + ''' + ''' 获取文件 MD5，若失败则返回空字符串。 + ''' + Public Function GetAuthMD5(FilePath As String) As String + Dim Retry As Boolean = False +Re: + Try + '获取 MD5 + Dim Result As New StringBuilder() + Dim File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) + Dim MD5 As MD5 = New MD5CryptoServiceProvider() + Dim Retval As Byte() = MD5.ComputeHash(File) + File.Close() + For i = 0 To Retval.Length - 1 + Result.Append(Retval(i).ToString("x2")) + Next + Return Result.ToString + Catch ex As Exception + If Not Retry Then + Retry = True + Log(ex, "获取文件 MD5 可重试失败：" & FilePath, LogLevel.Normal) + Thread.Sleep(RandomInteger(200, 500)) + GoTo Re + Else + Log(ex, "获取文件 MD5 失败：" & FilePath) + Return "" + End If + End Try + End Function + ''' + ''' 获取文件 SHA256，若失败则返回空字符串。 + ''' + Public Function GetAuthSHA256(FilePath As String) As String + Dim Retry As Boolean = False +Re: + Try + ''检测该文件是否在下载中，若在下载则放弃检测 + 'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return "" + '获取 SHA256 + Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) + Dim sha1 As SHA256 = New SHA256CryptoServiceProvider() + Dim retval As Byte() = sha1.ComputeHash(file) + file.Close() + Dim Result As New StringBuilder() + For i As Integer = 0 To retval.Length - 1 + Result.Append(retval(i).ToString("x2")) + Next + Return Result.ToString + Catch ex As Exception + If Not Retry Then + Retry = True + Log(ex, "获取文件 SHA256 可重试失败：" & FilePath, LogLevel.Normal) + Thread.Sleep(RandomInteger(200, 500)) + GoTo Re + Else + Log(ex, "获取文件 SHA256 失败：" & FilePath) + Return "" + End If + End Try + End Function + ''' + ''' 获取文件 SHA1，若失败则返回空字符串。 + ''' + Public Function GetAuthSHA1(FilePath As String) As String + Dim Retry As Boolean = False +Re: + Try + ''检测该文件是否在下载中，若在下载则放弃检测 + 'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return "" + '获取 SHA1 + Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) + Dim sha1 As SHA1 = New SHA1CryptoServiceProvider() + Dim retval As Byte() = sha1.ComputeHash(file) + file.Close() + Dim Result As New StringBuilder() + For i As Integer = 0 To retval.Length - 1 + Result.Append(retval(i).ToString("x2")) + Next + Return Result.ToString + Catch ex As Exception + If Not Retry Then + Retry = True + Log(ex, "获取文件 SHA1 可重试失败：" & FilePath, LogLevel.Normal) + Thread.Sleep(RandomInteger(200, 500)) + GoTo Re + Else + Log(ex, "获取文件 SHA1 失败：" & FilePath) + Return "" + End If + End Try + End Function + ''' + ''' 获取流 SHA1，若失败则返回空字符串。 + ''' + Public Function GetAuthSHA1(Stream As Stream) As String + Try + Dim sha1 As SHA1 = New SHA1CryptoServiceProvider() + Dim retval As Byte() = sha1.ComputeHash(Stream) + Dim Result As New StringBuilder() + For i As Integer = 0 To retval.Length - 1 + Result.Append(retval(i).ToString("x2")) + Next + Return Result.ToString + Catch ex As Exception + Log(ex, "获取流 SHA1 失败") + Return "" + End Try + End Function + ''' + ''' 文件的校验规则。 + ''' + Public Class FileChecker + ''' + ''' 文件的准确大小。 + ''' + Public ActualSize As Long = -1 + ''' + ''' 文件的最小大小。 + ''' + Public MinSize As Long = -1 + ''' + ''' 文件的 MD5、SHA1 或 SHA256。会根据输入字符串的长度自动判断种类。 + ''' + Public Hash As String = Nothing + ''' + ''' 是否可以使用已经存在的文件。 + ''' + Public CanUseExistsFile As Boolean = True + ''' + ''' 是否为 Json 文件。 + ''' + Public IsJson As Boolean = False + Public Sub New(Optional MinSize As Long = -1, Optional ActualSize As Long = -1, Optional Hash As String = Nothing, Optional CanUseExistsFile As Boolean = True, Optional IsJson As Boolean = False) + Me.ActualSize = ActualSize + Me.MinSize = MinSize + Me.Hash = Hash + Me.CanUseExistsFile = CanUseExistsFile + Me.IsJson = IsJson + End Sub + ''' + ''' 检查文件。若成功则返回 Nothing，失败则返回错误的描述文本，描述文本不以句号结尾。不会抛出错误。 + ''' + Public Function Check(LocalPath As String) As String + Try + Dim Info As New FileInfo(LocalPath) + If Not Info.Exists Then Return "文件不存在：" & LocalPath + Dim FileSize As Long = Info.Length + If ActualSize >= 0 AndAlso ActualSize <> FileSize Then Return "文件大小应为 " & ActualSize & " B，实际为 " & FileSize & " B" + If MinSize >= 0 AndAlso MinSize > FileSize Then Return "文件大小应大于 " & MinSize & " B，实际为 " & FileSize & " B" + If Not String.IsNullOrEmpty(Hash) Then + If Hash.Length < 35 Then 'MD5 + If Hash <> GetAuthMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & "，实际为 " & GetAuthMD5(LocalPath) + ElseIf Hash.Length = 64 Then 'SHA256 + If Hash <> GetAuthSHA256(LocalPath) Then Return "文件 SHA256 应为 " & Hash & "，实际为 " & GetAuthSHA256(LocalPath) + Else 'SHA1 + If Hash <> GetAuthSHA1(LocalPath) Then Return "文件 SHA1 应为 " & Hash & "，实际为 " & GetAuthSHA1(LocalPath) + End If + End If + If IsJson Then + Dim Content As String = ReadFile(LocalPath) + If Content = "" Then Throw New Exception("读取到的文件为空") + Try + GetJson(Content) + Catch ex As Exception + Throw New Exception("不是有效的 Json 文件", ex) + End Try + End If + Return Nothing + Catch ex As Exception + Log(ex, "检查文件出错") + Return GetString(ex) + End Try + End Function + End Class + + ''' + ''' 尝试根据后缀名判断文件种类并解压文件，支持 gz 与 zip，会尝试将 jar 以 zip 方式解压。 + ''' 会尝试创建，但不会清空目标文件夹。 + ''' 成功返回 True，并非压缩文件或失败返回 False。 + ''' + Public Function ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) As Boolean + Try + Directory.CreateDirectory(DestDirectory) + If CompressFilePath.EndsWith(".zip") OrElse CompressFilePath.EndsWith(".jar") Then + '以 zip 方式解压 + ZipFile.ExtractToDirectory(CompressFilePath, DestDirectory, If(Encode, Encoding.Default)) + Return True + ElseIf CompressFilePath.EndsWith(".gz") Then + '以 gz 方式解压 + Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress) + Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write) + Dim data As Integer = stream.ReadByte() + While data <> -1 + decompressedFile.WriteByte(data) + data = stream.ReadByte() + End While + decompressedFile.Close() + stream.Close() + Return True + Else + Return False + End If + Catch ex As Exception + Log(ex, "尝试解压文件失败") + Return False + End Try + End Function + + ''' + ''' 删除文件夹。失败会抛出异常。 + ''' + Public Sub DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) + If Not Directory.Exists(Path) Then Exit Sub + Dim Temp As String() + Temp = Directory.GetFiles(Path) + For Each str As String In Temp + Try + File.Delete(str) + Catch ex As Exception + If IgnoreIssue Then + Log(ex, "删除单个文件可忽略地失败") + Else + Throw + End If + End Try + Next + Temp = Directory.GetDirectories(Path) + For Each str As String In Temp + DeleteDirectory(str) + Next + Try + Directory.Delete(Path, True) + Catch ex As Exception + If IgnoreIssue Then + Log(ex, "删除单个文件夹可忽略地失败") + Else + Throw + End If + End Try + '这个也不靠谱，目录不是空的警告 + 'My.Computer.FileSystem.DeleteDirectory(Path, FileIO.DeleteDirectoryOption.DeleteAllContents) + End Sub + ''' + ''' 遍历文件夹中的所有文件。 + ''' + Public Function EnumerateFiles(Directory As String) As List(Of FileInfo) + Dim Dir As New DirectoryInfo(Directory) + Dim ResultList As New List(Of FileInfo) + '添加文件 + ResultList.AddRange(Dir.EnumerateFiles) + '添加文件夹中的文件 + For Each SubDir In Dir.EnumerateDirectories + ResultList.AddRange(EnumerateFiles(SubDir.FullName)) + Next + Return ResultList + End Function + +#End Region + +#Region "文本" + Public vbLQ As Char = Convert.ToChar(8220) + Public vbRQ As Char = Convert.ToChar(8221) + + ''' + ''' 提取 Exception 摘要。 + ''' + ''' 输出是否强制为单行，单行模型下不会输出调用堆栈。 + Public Function GetString(Ex As Exception, Optional IsLine As Boolean = True, Optional ShowAllTrace As Boolean = False) As String + If Ex Is Nothing Then Return "无可用错误信息！" + Dim Desc As New List(Of String) + + '自动错误判断 + Dim RealEx = Ex + Do Until RealEx.InnerException Is Nothing + RealEx = RealEx.InnerException + Loop + If TypeOf RealEx Is TypeLoadException OrElse TypeOf RealEx Is MissingMethodException OrElse TypeOf RealEx Is NotImplementedException OrElse TypeOf RealEx Is TypeInitializationException Then + Desc.Add("系统环境存在问题，请尝试重装 .Net Framework 4.6.2 后再试") + ElseIf TypeOf RealEx Is UnauthorizedAccessException Then + Desc.Add("PCL2 权限不足，请尝试右键 PCL2，选择以管理员身份运行") + ElseIf TypeOf RealEx Is OutOfMemoryException Then + Desc.Add("电脑运行内存不足，PCL2 无法继续运行") + End If + + If IsLine Then + '无内部错误的快速处理 + If Ex.InnerException Is Nothing Then + If Desc.Count = 0 Then + Return Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, " ") + Else + Return Desc.First + End If + End If + '构造输出信息 + Do Until Ex Is Nothing + Desc.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, " ")) + Ex = Ex.InnerException + Loop + Desc.Reverse() '让最深层错误在最左边 + GetString = Join(Desc, " → ") + Else + Dim Stack As New List(Of String) + '逐级追加描述与堆栈 + Do Until Ex Is Nothing + Desc.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, vbCrLf)) + If Ex.StackTrace IsNot Nothing Then + For Each St As String In Ex.StackTrace.Split(vbCrLf) + If ShowAllTrace OrElse St.ToLower.Contains("pcl") Then Stack.Add(St.Replace(vbCr, String.Empty).Replace(vbLf, String.Empty)) + Next + End If + Ex = Ex.InnerException + Loop + '构造输出信息 + Dim TypeName As String = RealEx.GetType.FullName + GetString = Join(Desc, vbCrLf & "Caused By: ") & If(Stack.Count > 0, vbCrLf & Join(Stack, vbCrLf), "") & If(TypeName = "System.Exception", "", vbCrLf & "错误类型：" & TypeName) + End If + End Function + ''' + ''' 返回一个枚举对应的字符串。 + ''' + ''' 一个已经实例化的枚举类型。 + Public Function GetStringFromEnum(EnumData As [Enum]) As String + Return [Enum].GetName(EnumData.GetType, EnumData) + End Function + ''' + ''' 将文件大小转化为适合的文本形式，如“1.28 M”。 + ''' + ''' 以字节为单位的大小表示。 + Public Function GetString(FileSize As Long) As String + If FileSize < 1000 Then + 'B 级 + Return FileSize & " B" + ElseIf FileSize < 1024 * 1000 Then + 'K 级 + Dim RoundResult As String = Math.Round(FileSize / 1024) + Return Math.Round(FileSize / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " K" + ElseIf FileSize < 1024 * 1024 * 1000 Then + 'M 级 + Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024) + Return Math.Round(FileSize / 1024 / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " M" + Else + 'G 级 + Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024 / 1024) + Return Math.Round(FileSize / 1024 / 1024 / 1024, CInt(MathRange(3 - RoundResult.Length, 0, 2))) & " G" + End If + End Function + + ''' + ''' 获取 Json 对象。 + ''' + Public Function GetJson(Data As String) + Try + Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local}) + Catch ex As Exception + Throw New Exception("格式化 Json 对象失败：" & If(If(Data, "").Length > 10000, Data.Substring(0, 100) & "...", Data)) + End Try + End Function + + ''' + ''' 将字符串统一至某个长度，过短则以 Code 将其右侧填充，过长则截取靠左的指定长度。 + ''' + Public Function StrFill(Str As String, Code As String, Length As Byte) As String + If Str.Length > Length Then Return Mid(Str, 1, Length) + Return Mid(Str.PadRight(Length, Code), Str.Length + 1) & Str + End Function + ''' + ''' 将一个小数显示为固定的小数点后位数形式，将向零取整。 + ''' 如 12 保留 2 位则输出 12.00，而 95.678 保留 2 位则输出 95.67。 + ''' + Public Function StrFillNum(Num As Double, Length As Integer) As String + Num = Math.Round(Num, Length, MidpointRounding.AwayFromZero) + StrFillNum = Num + If Not StrFillNum.Contains(".") Then Return (StrFillNum & ".").PadRight(StrFillNum.Length + 1 + Length, "0") + Return StrFillNum.PadRight(StrFillNum.Split(".")(0).Length + 1 + Length, "0") + End Function + ''' + ''' 移除字符串首尾的标点符号、回车，以及括号中、冒号后的补充说明内容。 + ''' + Public Function StrTrim(Str As String, Optional RemoveQuote As Boolean = True) + If RemoveQuote Then Str = Str.Split("（")(0).Split("：")(0).Split("(")(0).Split(":")(0) + Return Str.Trim(".", "。", "！", " ", "!", "?", "？", vbCr, vbLf) + End Function + ''' + ''' 连接字符串。 + ''' + Public Function Join(List As ICollection, Split As String) As String + Dim Builder As New StringBuilder + Dim LastCount As Integer = List.Count - 1 + For i = 0 To LastCount + If List(i) IsNot Nothing Then Builder.Append(List(i)) + If i <> LastCount Then Builder.Append(Split) + Next + Return Builder.ToString + End Function + + ''' + ''' 获取字符串哈希值。 + ''' + Public Function GetHash(Str As String) As ULong + GetHash = 5381 + For i = 0 To Str.Length - 1 + GetHash = (GetHash << 5) Xor GetHash Xor CType(AscW(Str(i)), ULong) + Next + Return GetHash Xor &HA98F501BC684032FUL + End Function + ''' + ''' 获取字符串 MD5。 + ''' + Public Function GetStringMD5(Str As String) As String + Dim md5Hasher As New MD5CryptoServiceProvider + Dim hashedDataBytes As Byte() + hashedDataBytes = md5Hasher.ComputeHash(Encoding.GetEncoding("gb2312").GetBytes(Str)) + Dim tmp As New StringBuilder() + For Each i As Byte In hashedDataBytes + tmp.Append(i.ToString("x2")) + Next + Return tmp.ToString() + End Function + + ''' + ''' 输入 And 字符不会报错的 Val。 + ''' + Public Function Val(Str As Object) As Double + Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str)) + End Function + + '转义 + ''' + ''' 为字符串进行 XML 转义。 + ''' + Public Function EscapeXML(Str As String) As String + Return Str.Replace("&", "&").Replace("<", "<").Replace(">", ">").Replace("'", "'").Replace("""", """) + End Function + + '正则 + ''' + ''' 搜索字符串中的所有正则匹配项。 + ''' + Public Function RegexSearch(str As String, regex As String, Optional options As RegularExpressions.RegexOptions = RegularExpressions.RegexOptions.None) As List(Of String) + Try + RegexSearch = New List(Of String) + Dim RegexSearchRes = New RegularExpressions.Regex(regex, options).Matches(str) + If RegexSearchRes Is Nothing Then Return RegexSearch + For Each item As RegularExpressions.Match In RegexSearchRes + RegexSearch.Add(item.Value) + Next + Catch ex As Exception + Log(ex, "正则匹配全部项出错") + Return New List(Of String) + End Try + End Function + ''' + ''' 获取字符串中的第一个正则匹配项，若无匹配则返回 Nothing。 + ''' + Public Function RegexSeek(str As String, regex As String, Optional options As RegularExpressions.RegexOptions = RegularExpressions.RegexOptions.None) As String + Try + Dim Result = RegularExpressions.Regex.Match(str, regex, options).Value + Return If(Result = "", Nothing, Result) + Catch ex As Exception + Log(ex, "正则匹配第一项出错") + Return Nothing + End Try + End Function + ''' + ''' 检查字符串是否匹配某正则模式。 + ''' + Public Function RegexCheck(str As String, regex As String, Optional options As RegularExpressions.RegexOptions = RegularExpressions.RegexOptions.None) As Boolean + Try + Return RegularExpressions.Regex.IsMatch(str, regex, options) + Catch ex As Exception + Log(ex, "正则检查出错") + Return False + End Try + End Function + ''' + ''' 进行正则替换，会抛出错误。 + ''' + Public Function RegexReplace(Input As String, Replacement As String, Regex As String, Optional options As RegularExpressions.RegexOptions = RegularExpressions.RegexOptions.None) As String + Return RegularExpressions.Regex.Replace(Input, Regex, Replacement, options) + End Function + +#End Region + +#Region "搜索" + + ''' + ''' 获取搜索文本的相似度。 + ''' + ''' 被搜索的长内容。 + ''' 用户输入的搜索文本。 + Private Function SearchSimilarity(Source As String, Query As String) As Double + Dim qp As Integer = 0, lenSum As Double = 0 + Source = Source.ToLower.Replace(" ", "") + Query = Query.ToLower.Replace(" ", "") + Dim sourceLength As Integer = Source.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存 + Do While qp < Query.Length + '对 qp 作为开始位置计算 + Dim sp As Integer = 0, lenMax As Integer = 0, spMax As Integer = 0 + '查找以 qp 为头的最大子串 + Do While sp < Source.Length + '对每个 sp 作为开始位置计算最大子串 + Dim len As Integer = 0 + Do While (qp + len) < Query.Length AndAlso (sp + len) < Source.Length AndAlso Source(sp + len) = Query(qp + len) + len += 1 + Loop + '存储 len + If len > lenMax Then + lenMax = len + spMax = sp + End If + '根据结果增加 sp + sp += Math.Max(1, len) + Loop + If lenMax > 0 Then + Source = Source.Substring(0, spMax) & If(Source.Count > spMax + lenMax, Source.Substring(spMax + lenMax), String.Empty) '将源中的对应字段替换空 + '存储 lenSum + Dim IncWeight = (Math.Pow(1.4, 3 + lenMax) - 3.6) '根据长度加成 + IncWeight *= (1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax))) '根据位置加成 + lenSum += IncWeight + End If + '根据结果增加 qp + qp += Math.Max(1, lenMax) + Loop + '计算结果：重复字段量 × 源长度影响比例 + Return (lenSum / queryLength) * (3 / Math.Pow(sourceLength + 15, 0.5)) * If(queryLength <= 2, 3 - queryLength, 1) + End Function + ''' + ''' 获取多段文本加权后的相似度。 + ''' + Private Function SearchSimilarityWeighted(Source As List(Of KeyValuePair(Of String, Double)), Query As String) As Double + Dim TotalWeight As Double = 0 + Dim Sum As Double = 0 + For Each Pair In Source + Sum += SearchSimilarity(Pair.Key, Query) * Pair.Value + TotalWeight += Pair.Value + Next + Return Sum / TotalWeight + End Function + ''' + ''' 用于搜索的项目。 + ''' + Public Class SearchEntry(Of T) + ''' + ''' 该项目对应的源数据。 + ''' + Public Item As T + ''' + ''' 该项目用于搜索的源。 + ''' + Public SearchSource As List(Of KeyValuePair(Of String, Double)) + ''' + ''' 相似度。 + ''' + Public Similarity As Double + ''' + ''' 是否完全匹配。 + ''' + Public AbsoluteRight As Boolean + End Class + ''' + ''' 进行多段文本加权搜索，获取相似度较高的数项结果。 + ''' + ''' 返回的最大模糊结果数。 + ''' 返回结果要求的最低相似度。 + Public Function Search(Of T)(Entries As List(Of SearchEntry(Of T)), Query As String, Optional MaxBlurCount As Integer = 5, Optional MinBlurSimilarity As Double = 0.1) As List(Of SearchEntry(Of T)) + '初始化 + Dim ResultList As New List(Of SearchEntry(Of T)) + If Entries.Count = 0 Then Return ResultList + '进行搜索，获取相似信息 + For Each Entry In Entries + Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query) + Entry.AbsoluteRight = False + For Each Pair In Entry.SearchSource + If Pair.Key.ToLower.Replace(" ", "").Contains(Query.ToLower.Replace(" ", "")) Then Entry.AbsoluteRight = True + Next + Next + '按照相似度进行排序 + Entries = Sort(Entries, Function(Left As SearchEntry(Of T), Right As SearchEntry(Of T)) As Boolean + If Left.AbsoluteRight Xor Right.AbsoluteRight Then + Return Left.AbsoluteRight + Else + Return Left.Similarity > Right.Similarity + End If + End Function) + '返回结果 + Dim BlurCount As Integer = 0 + For Each Entry In Entries + If Entry.AbsoluteRight Then + ResultList.Add(Entry) '完全匹配，直接加入 + Else + If Entry.Similarity < MinBlurSimilarity OrElse BlurCount = MaxBlurCount Then Exit For '模糊结果边界条件 + ResultList.Add(Entry) + BlurCount += 1 '模糊结果计数 + End If + Next + Return ResultList + End Function + +#End Region + +#Region "系统" + + ''' + ''' 当前程序是否拥有管理员权限。 + ''' + Public Function IsAdmin() As Boolean + Dim id As WindowsIdentity = WindowsIdentity.GetCurrent() + Dim principal As New WindowsPrincipal(id) + Return principal.IsInRole(WindowsBuiltInRole.Administrator) + End Function + ''' + ''' 以管理员权限重新运行当前程序。返回是否成功。 + ''' + Public Function RerunAsAdmin(Argument As String) As Boolean + Try + Process.Start(New ProcessStartInfo(PathWithName) With {.Verb = "runas", .Arguments = Argument}) + Return True + Catch ex As Exception + Log(ex, "以管理员权限运行程序失败") + Return False + End Try + End Function + + Private Uuid As Integer = 1 + Private UuidLock As Object + ''' + ''' 获取一个全程序内不会重复的数字（伪 Uuid）。 + ''' + Public Function GetUuid() As Integer + If UuidLock Is Nothing Then UuidLock = New Object + SyncLock UuidLock + Uuid += 1 + Return Uuid + End SyncLock + End Function + + ''' + ''' 将元素与 List 的混合体拆分为元素组。 + ''' + Public Function GetFullList(Of T)(data As IList) As List(Of T) + GetFullList = New List(Of T) + For i = 0 To data.Count - 1 + If TypeOf data(i) Is ICollection Then + GetFullList.AddRange(data(i)) + Else + GetFullList.Add(data(i)) + End If + Next i + End Function + ''' + ''' 数组去重。 + ''' + Public Function ArrayNoDouble(Of T)(Arr As T(), Optional IsEqual As CompareThreadStart = Nothing) As T() + Dim ResultArray As New List(Of T) + For i = 0 To UBound(Arr) + For ii = i + 1 To UBound(Arr) + If IsEqual Is Nothing Then + If Arr(i).Equals(Arr(ii)) Then GoTo NextElement + Else + If IsEqual(Arr(i), Arr(ii)) Then GoTo NextElement + End If + Next + ResultArray.Add(Arr(i)) +NextElement: + Next i + Return ResultArray.ToArray + End Function + ''' + ''' 数组去重。 + ''' + Public Function ArrayNoDouble(Of T)(Arr As List(Of T), Optional IsEqual As CompareThreadStart = Nothing) As List(Of T) + Dim ResultArray As New List(Of T) + For i = 0 To Arr.Count - 1 + For ii = i + 1 To Arr.Count - 1 + If IsEqual Is Nothing Then + If Arr(i).Equals(Arr(ii)) Then GoTo NextElement + Else + If IsEqual(Arr(i), Arr(ii)) Then GoTo NextElement + End If + Next + ResultArray.Add(Arr(i)) +NextElement: + Next i + Return ResultArray + End Function + ''' + ''' 若 Key 不存在于辞典，则加入辞典。 + ''' 若 Key 已存在于辞典，则更新 Value。 + ''' + Public Sub DictionaryAdd(Of TKey, TValue)(ByRef Dict As Dictionary(Of TKey, TValue), Key As TKey, Value As TValue) + If Dict.ContainsKey(Key) Then + Dict(Key) = Value + Else + Dict.Add(Key, Value) + End If + End Sub + + ''' + ''' 获取格式类似于“11:08:52.037”的当前时间的字符串。 + ''' + Public Function GetTimeNow() As String + Return Date.Now.ToString("HH:mm:ss.fff") + End Function + ''' + ''' 获取系统运行时间（毫秒），保证为正 Long 且大于 1，但可能突变减小。 + ''' + Public Function GetTimeTick() As Long + Return My.Computer.Clock.TickCount + 2147483651L + End Function + ''' + ''' 将时间间隔转换为类似“5 分 10 秒前”的易于阅读的形式。 + ''' + Public Function GetTimeSpanString(Span As TimeSpan) As String + Dim EndFix = If(Span.TotalMilliseconds > 0, "后", "前") + If Span.TotalMilliseconds < 0 Then Span = -Span + Dim TotalMonthes = Math.Floor(Span.Days / 30) + If TotalMonthes >= 61 Then + '5+ 年，“5 年” + GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年" + ElseIf TotalMonthes >= 12 Then + '12~60 月，“1 年 2 个月” + GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年" & If((TotalMonthes Mod 12) > 0, " " & (TotalMonthes Mod 12) & " 个月", "") + ElseIf TotalMonthes >= 4 Then + '4~11 月，“5 月” + GetTimeSpanString = TotalMonthes & " 月" + ElseIf TotalMonthes >= 1 Then + '1~4 月，“2 月 13 天” + GetTimeSpanString = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "") + ElseIf Span.TotalDays >= 4 Then + '4~30 天，“23 天” + GetTimeSpanString = Span.Days & " 天" + ElseIf Span.TotalDays >= 1 Then + '1~3 天，“2 天 20 小时” + GetTimeSpanString = Span.Days & " 天" & If(Span.Hours > 0, " " & Span.Hours & " 小时", "") + ElseIf Span.TotalHours >= 10 Then + '10 小时 ~ 1 天，“15 小时” + GetTimeSpanString = Span.Hours & " 小时" + ElseIf Span.TotalHours >= 1 Then + '1~10 小时，“1 小时 20 分钟” + GetTimeSpanString = Span.Hours & " 小时" & If(Span.Minutes > 0, " " & Span.Minutes & " 分钟", "") + ElseIf Span.TotalMinutes >= 10 Then + '10 分钟 ~ 1 小时，“49 分钟” + GetTimeSpanString = Span.Minutes & " 分钟" + ElseIf Span.TotalMinutes >= 1 Then + '1~10 分钟，“9 分 23 秒” + GetTimeSpanString = Span.Minutes & " 分" & If(Span.Seconds > 0, " " & Span.Seconds & " 秒", "") + ElseIf Span.TotalSeconds >= 1 Then + '1 秒 ~ 1 分钟，“23 秒” + GetTimeSpanString = Span.Seconds & " 秒" + Else + '不到 1 秒 + GetTimeSpanString = "1 秒" + End If + GetTimeSpanString += EndFix + End Function + ''' + ''' 获取十进制 Unix 时间戳。 + ''' + Public Function GetUnixTimestamp() As Long + Return (Now.ToUniversalTime().Ticks - 621355968000000000) / 10000000 + End Function + + ''' + ''' 用于储存 RaiseByMouse 的 EventArgs。 + ''' + Public NotInheritable Class RouteEventArgs + Inherits EventArgs + Public RaiseByMouse As Boolean + Public Handled As Boolean = False + Public Sub New(Optional RaiseByMouse As Boolean = False) + Me.RaiseByMouse = RaiseByMouse + End Sub + End Class + + ''' + ''' 前台运行文件并返回返回值。 + ''' + ''' 文件名。可以为“notepad”等缩写。 + ''' 运行参数。 + ''' 是否等待该程序结束。默认为 False。 + ''' 等待该程序结束的最长时间（毫秒）。超时会返回 Result.Timeout。 + Public Function ShellAndGetExitCode(FileName As String, Optional Arguments As String = "", Optional WaitForExit As Boolean = False, Optional Timeout As Integer = 1000000) As Result + Try + Using Program As New Process + Program.StartInfo.Arguments = Arguments + Program.StartInfo.FileName = FileName + Log("[System] 执行外部命令并等待返回码：" & FileName & " " & Arguments) + Program.Start() + If WaitForExit Then + If Program.WaitForExit(Timeout) Then + Return Program.ExitCode + Else + Return Result.Timeout + End If + Else + Return Result.Success + End If + End Using + Catch ex As Exception + Log(ex, "执行命令失败：" & FileName, LogLevel.Msgbox) + Return Result.Fail + End Try + End Function + ''' + ''' 静默运行文件并返回输出流字符串。执行失败会抛出异常。 + ''' + ''' 文件名。可以为“notepad”等缩写。 + ''' 运行参数。 + ''' 等待该程序结束的最长时间（毫秒）。超时会抛出错误。 + Public Function ShellAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000, Optional WorkingDirectory As String = Nothing) As String + Dim Info = New ProcessStartInfo With { + .Arguments = Arguments, + .FileName = FileName, + .UseShellExecute = False, + .CreateNoWindow = True, + .RedirectStandardError = True, + .RedirectStandardOutput = True, + .WorkingDirectory = If(WorkingDirectory, Path.TrimEnd("\"c)) + } + If WorkingDirectory IsNot Nothing Then + If Info.EnvironmentVariables.ContainsKey("appdata") Then + Info.EnvironmentVariables("appdata") = WorkingDirectory + Else + Info.EnvironmentVariables.Add("appdata", WorkingDirectory) + End If + End If + Log("[System] 执行外部命令并等待返回结果：" & FileName & " " & Arguments) + Using Program As New Process() With {.StartInfo = Info} + Program.Start() + Program.WaitForExit(Timeout) + Return Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd + ' Dim Result As New StringBuilder() + ' AddHandler process.OutputDataReceived, Function(sender As Object, e As DataReceivedEventArgs) + ' Try + ' If e.Data IsNot Nothing Then Result.AppendLine(e.Data) + ' Finally + ' End Try + ' Return Nothing + ' End Function + ' AddHandler process.ErrorDataReceived, Function(sender As Object, e As DataReceivedEventArgs) + ' Try + ' If e.Data IsNot Nothing Then Result.AppendLine(e.Data) + ' Finally + ' End Try + ' Return Nothing + ' End Function + ' process.Start() + ' process.BeginOutputReadLine() + ' process.BeginErrorReadLine() + ' If process.WaitForExit(Timeout) Then + ' process.Close() + ' Return Result.ToString + ' Else + ' process.Close() + ' Throw New TimeoutException("程序执行超时，已有返回值：" & Result.ToString) + ' End If + End Using + End Function + + ''' + ''' 在新的工作线程中执行代码。 + ''' + Public Function RunInNewThread(Action As Action, Name As String, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread + Dim th As New Thread(Sub() + Try + Action() + Catch ex As ThreadInterruptedException + Log(Name & "：线程已中止") + Catch ex As Exception + Log(ex, Name & "：线程执行失败", LogLevel.Feedback) + End Try + End Sub) With {.Name = Name, .Priority = Priority} + th.Start() + Return th + End Function + ''' + ''' 确保在 UI 线程中执行代码。 + ''' 如果当前并非 UI 线程，则会阻断当前线程，直至 UI 线程执行完毕。 + ''' 为防止线程互锁，请仅在开始加载动画、从 UI 获取输入时使用！ + ''' + Public Sub RunInUiWait(Action As Action) + If RunInUi() Then + Action() + Else + Application.Current.Dispatcher.Invoke(Action) + End If + End Sub + ''' + ''' 确保在 UI 线程中执行代码，代码按触发顺序执行。 + ''' 如果当前并非 UI 线程，也不阻断当前线程的执行。 + ''' + Public Sub RunInUi(Action As Action, Optional ForceWaitUntilLoaded As Boolean = False) + If ForceWaitUntilLoaded Then + Application.Current.Dispatcher.InvokeAsync(Action, Threading.DispatcherPriority.Loaded) + ElseIf RunInUi() Then + Action() + Else + Application.Current.Dispatcher.InvokeAsync(Action) + End If + End Sub + ''' + ''' 确保在工作线程中执行代码。 + ''' + Public Sub RunInThread(Action As Action) + If RunInUi() Then + RunInNewThread(Action, "Runtime Invoke " & GetUuid() & "#") + Else + Action() + End If + End Sub + + ''' + ''' 按照既定的函数进行选择排序。 + ''' + ''' 传入两个对象，若第一个对象应该排在前面，则返回 True。 + Public Function Sort(Of T)(List As IList(Of T), SortRule As CompareThreadStart) As List(Of T) + Dim NewList As New List(Of T) + While List.Count > 0 + Dim Highest = List(0) + For i = 1 To List.Count - 1 + If SortRule(List(i), Highest) Then Highest = List(i) + Next + List.Remove(Highest) + NewList.Add(Highest) + End While + Return NewList + End Function + Public Delegate Function CompareThreadStart(Left, Right) As Boolean + + ''' + ''' 获取程序启动参数。 + ''' + ''' 参数名。 + ''' 默认值。 + Public Function GetProgramArgument(Name As String, Optional DefaultValue As Object = "") + Dim AllArguments() As String = Command.Split(" ") + For i = 0 To AllArguments.Length - 1 + If AllArguments(i) = "-" & Name Then + If AllArguments.Length = i + 1 OrElse AllArguments(i + 1).StartsWith("-") Then Return True + Return AllArguments(i + 1) + End If + Next + Return DefaultValue + End Function + + ''' + ''' 时间戳转化为日期。 + ''' + Public Function GetDate(timeStamp As Integer) As Date + Dim dtStart As Date = TimeZone.CurrentTimeZone.ToLocalTime(New Date(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc)) + Dim lTime As Long = (CLng(timeStamp) * 10000000) + Return dtStart.Add(New TimeSpan(lTime)) + End Function + ''' + ''' 将 UTC 时间转化为当前时区的时间。 + ''' + Public Function GetLocalTime(UtcDate As Date) As Date + Return DateTime.SpecifyKind(UtcDate, DateTimeKind.Utc).ToLocalTime + End Function + + ''' + ''' 打开网页。 + ''' + Public Sub OpenWebsite(Url As String) + Try + Log("[System] 正在打开网页：" & Url) + Process.Start(Url) + Catch ex As Exception + Log(ex, "无法打开网页（" & Url & "）") + ClipboardSet(Url, False) + MyMsgBox("可能由于浏览器未正确配置，PCL2 无法为你打开网页。" & vbCrLf & "网址已经复制到剪贴板，若有需要可以手动粘贴访问。", "无法打开网页") + End Try + End Sub + ''' + ''' 打开 explorer。 + ''' + Public Sub OpenExplorer(Argument As String) + Try + Process.Start("explorer.exe", Argument) + Catch ex As Exception + Log(ex, "打开资源管理器失败，请尝试关闭安全软件（如 360 安全卫士）", LogLevel.Msgbox) + End Try + End Sub + + ''' + ''' 设置剪贴板。将在另一线程运行，且不会抛出异常。 + ''' + Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True) + RunInThread(Sub() + Dim RetryCount As Integer = 0 +Retry: + Try + RunInUi(Sub() + My.Computer.Clipboard.Clear() + My.Computer.Clipboard.SetText(Text) + End Sub) + Catch ex As Exception + RetryCount += 1 + If RetryCount <= 5 Then + Thread.Sleep(20) + GoTo Retry + Else + Log(ex, "可能由于剪贴板被其他程序占用，文本复制失败", LogLevel.Hint) + End If + End Try + If ShowSuccessHint Then Hint("已成功复制！", HintType.Finish) + End Sub) + End Sub + + ''' + ''' 以 Byte() 形式获取程序中的资源。 + ''' + Public Function GetResources(ResourceName As String) As Byte() + Log("[System] 获取资源：" & ResourceName) + Dim Raw As Byte() = My.Resources.ResourceManager.GetObject(ResourceName) + Return Raw + End Function + +#End Region + +#Region "UI" + + '边距改变 + ''' + ''' 相对增减控件的左边距。 + ''' + Public Sub DeltaLeft(control As FrameworkElement, newValue As Double) + '安全性检查 + DebugAssert(Not Double.IsNaN(newValue)) + DebugAssert(Not Double.IsInfinity(newValue)) + + If TypeOf control Is Window Then + '窗口改变 + CType(control, Window).Left += newValue + Else + '根据 HorizontalAlignment 改变数值 + Select Case control.HorizontalAlignment + Case HorizontalAlignment.Left, HorizontalAlignment.Stretch + control.Margin = New Thickness(control.Margin.Left + newValue, control.Margin.Top, control.Margin.Right, control.Margin.Bottom) + Case HorizontalAlignment.Right + control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right - newValue, control.Margin.Bottom) + 'control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, CType(control.Parent, Object).ActualWidth - control.ActualWidth - newValue, control.Margin.Bottom) + Case Else + DebugAssert(False) + End Select + End If + End Sub + ''' + ''' 设置控件的左边距。（仅针对置左控件） + ''' + Public Sub SetLeft(control As FrameworkElement, newValue As Double) + DebugAssert(control.HorizontalAlignment = HorizontalAlignment.Left) + control.Margin = New Thickness(newValue, control.Margin.Top, control.Margin.Right, control.Margin.Bottom) + End Sub + ''' + ''' 相对增减控件的上边距。 + ''' + Public Sub DeltaTop(control As FrameworkElement, newValue As Double) + '安全性检查 + DebugAssert(Not Double.IsNaN(newValue)) + DebugAssert(Not Double.IsInfinity(newValue)) + + If TypeOf control Is Window Then + '窗口改变 + CType(control, Window).Top += newValue + Else + '根据 VerticalAlignment 改变数值 + Select Case control.VerticalAlignment + Case VerticalAlignment.Top + control.Margin = New Thickness(control.Margin.Left, control.Margin.Top + newValue, control.Margin.Right, control.Margin.Bottom) + Case VerticalAlignment.Bottom + control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right, control.Margin.Bottom - newValue) + 'control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, CType(control.Parent, Object).ActualWidth - control.ActualWidth - newValue, control.Margin.Bottom) + Case Else + DebugAssert(False) + End Select + End If + + 'If Double.IsNaN(newValue) OrElse Double.IsInfinity(newValue) Then Exit Sub '安全性检查 + '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) + ' Case VerticalAlignment.Bottom + ' control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right, -newValue) + ' 'control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right, CType(control.Parent, Object).ActualHeight - control.ActualHeight - newValue) + 'End Select + End Sub + ''' + ''' 设置控件的顶边距。（仅针对置上控件） + ''' + Public Sub SetTop(control As FrameworkElement, newValue As Double) + DebugAssert(control.VerticalAlignment = VerticalAlignment.Top) + control.Margin = New Thickness(control.Margin.Left, newValue, control.Margin.Right, control.Margin.Bottom) + End Sub + + 'DPI 转换 + Public ReadOnly DPI As Integer = System.Drawing.Graphics.FromHwnd(IntPtr.Zero).DpiX + ''' + ''' 将经过 DPI 缩放的 WPF 尺寸转化为实际的像素尺寸。 + ''' + Public Function GetPixelSize(WPFSize As Double) As Double + Return WPFSize / 96 * DPI + End Function + ''' + ''' 将实际的像素尺寸转化为经过 DPI 缩放的 WPF 尺寸。 + ''' + Public Function GetWPFSize(PixelSize As Double) As Double + Return PixelSize * 96 / DPI + End Function + + 'UI 截图 + ''' + ''' 将某个控件的呈现转换为图片。 + ''' + Public Function ControlBrush(UI As FrameworkElement) As ImageBrush + Dim Width = UI.ActualWidth, Height = UI.ActualHeight + If Width < 1 OrElse Height < 1 Then Return New ImageBrush + Dim bmp As New RenderTargetBitmap(GetPixelSize(Width), GetPixelSize(Height), DPI, DPI, PixelFormats.Pbgra32) + bmp.Render(UI) + Return New ImageBrush(bmp) + End Function + ''' + ''' 将某个控件的模拟呈现转换为图片。 + ''' + Public Function ControlBrush(UI As FrameworkElement, Width As Double, Height As Double, Optional Left As Double = 0, Optional Top As Double = 0) As ImageBrush + UI.Measure(New Size(Width, Height)) + UI.Arrange(New Rect(0, 0, Width, Height)) + Dim bmp As New RenderTargetBitmap(GetPixelSize(Width), GetPixelSize(Height), DPI, DPI, PixelFormats.Default) + bmp.Render(UI) + If Not (Left = 0 AndAlso Top = 0) Then UI.Arrange(New Rect(Left, Top, Width, Height)) + Return New ImageBrush(bmp) + End Function + ''' + ''' 将 UI 内容固定为图片并进行 Clear。 + ''' + Public Sub ControlFreeze(UI As Panel) + UI.Background = ControlBrush(UI) + UI.Children.Clear() + End Sub + ''' + ''' 将 UI 内容固定为图片并进行 Clear。 + ''' + Public Sub ControlFreeze(UI As Border) + UI.Background = ControlBrush(UI) + UI.Child = Nothing + End Sub + + ''' + ''' 将 XML 转换为对应 UI 对象。 + ''' + Public Function GetObjectFromXML(Str As XElement) + Return GetObjectFromXML(Str.ToString) + End Function + ''' + ''' 将 XML 转换为对应 UI 对象。 + ''' + Public Function GetObjectFromXML(Str As String) + Using Stream As New MemoryStream + Using Writer As New StreamWriter(Stream) + Writer.Write(Str) + Writer.Flush() + Stream.Position = 0 + Return XamlReader.Load(Stream) + End Using + End Using + End Function + + Private ReadOnly UiThreadId As Integer = Thread.CurrentThread.ManagedThreadId + ''' + ''' 当前线程是否为主线程。 + ''' + Public Function RunInUi() As Boolean + Return Thread.CurrentThread.ManagedThreadId = UiThreadId + End Function + +#End Region + +#Region "Debug" + + Public ModeDebug As Boolean = False + + 'Log + Public Enum LogLevel + ''' + ''' 不提示，只记录日志。 + ''' + Normal = 0 + ''' + ''' 只提示开发者。 + ''' + Developer = 1 + ''' + ''' 只提示开发者与调试模式用户。 + ''' + Debug = 2 + ''' + ''' 弹出提示所有用户。 + ''' + Hint = 3 + ''' + ''' 弹窗，不要求反馈。 + ''' + Msgbox = 4 + ''' + ''' 弹窗，要求反馈。 + ''' + Feedback = 5 + ''' + ''' 弹窗，结束程序。 + ''' + Assert = 6 + End Enum + ''' + ''' 记录程序是否递交了错误提示，以确保运行测试正确。 + ''' + Public IsErrorTriggered As Boolean = False + Private LogList As New StringBuilder + Private LogWritter As StreamWriter + Public Sub LogStart() + RunInNewThread(Sub() + Dim IsInitSuccess As Boolean = True + Try + For i = 4 To 1 + If File.Exists(Path & "PCL\Log" & i & ".txt") Then + If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt") + File.Copy(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt") + End If + Next + File.Create(Path & "PCL\Log1.txt").Dispose() + Catch ex As IOException + IsInitSuccess = False + Hint("可能同时开启了多个 PCL2，程序可能会出现未知问题！", HintType.Critical) + Log(ex, "日志初始化失败（疑似文件占用问题）") + Catch ex As Exception + IsInitSuccess = False + Log(ex, "日志初始化失败", LogLevel.Hint) + End Try + Try + LogWritter = New StreamWriter(Path & "PCL\Log1.txt", True) With {.AutoFlush = True} + Catch ex As Exception + LogWritter = Nothing + Log(ex, "日志写入失败", LogLevel.Hint) + End Try + While True + If IsInitSuccess Then + LogFlush() + Else + LogList = New StringBuilder '清空 LogList 避免内存爆炸 + End If + Thread.Sleep(50) + End While + End Sub, "Log Writer", ThreadPriority.Lowest) + End Sub + Private ReadOnly LogFlushLock As New Object '防止外部调用 LogFlush 时同时输出多次日志 + Public Sub LogFlush() + On Error Resume Next + If LogWritter Is Nothing Then Exit Sub + Dim Log As String = Nothing + SyncLock LogFlushLock + If LogList.Length > 0 Then + Dim LogListCache As StringBuilder + LogListCache = LogList + LogList = New StringBuilder + Log = LogListCache.ToString + End If + End SyncLock + If Log IsNot Nothing Then + LogWritter.Write(Log) + End If + End Sub + + Private ReadOnly LogListLock As New Object '防止日志乱码，只在调试模式下启用 + ''' + ''' 输出 Log。 + ''' + ''' 如果要求弹窗，指定弹窗的标题。 + Public Sub Log(Text As String, Optional Level As LogLevel = LogLevel.Normal, Optional Title As String = "出现错误") + On Error Resume Next + '放在最后会导致无法显示极端错误下的弹窗（如无法写入日志文件） + '处理错误会导致再次调用 Log() 导致无限循环 + + '输出日志 + Dim AppendText As String = "[" & GetTimeNow() & "] " & Text & vbCrLf '减轻同步锁占用 + If ModeDebug Then + SyncLock LogListLock + LogList.Append(AppendText) + End SyncLock + Else + LogList.Append(AppendText) + End If +#If DEBUG Then + Console.Write(AppendText) +#End If + If IsProgramEnded OrElse Level = LogLevel.Normal Then Exit Sub + + '去除前缀 + Text = RegexReplace(Text, "", "\[[^\]]+?\] ") + + '输出提示 + Select Case Level +#If DEBUG Then + Case LogLevel.Developer + Hint("[开发者模式] " & Text, HintType.Info, False) + Case LogLevel.Debug + Hint("[调试模式] " & Text, HintType.Info, False) +#Else + Case LogLevel.Developer + Case LogLevel.Debug + If ModeDebug Then Hint("[调试模式] " & Text, HintType.Info, False) +#End If + Case LogLevel.Hint + IsErrorTriggered = True + Hint(Text, HintType.Critical, False) + Case LogLevel.Msgbox + IsErrorTriggered = True + MyMsgBox(Text, Title) + Case LogLevel.Feedback + IsErrorTriggered = True + If MyMsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", Title, "反馈", "取消") = 1 Then Feedback("exlog", False, True) + Case LogLevel.Assert + IsErrorTriggered = True + Dim Time As Long = GetTimeTick() + If MsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback("exlog", False, True) + If GetTimeTick() - Time < 1500 Then + '弹窗无法保留 + Log("[System] PCL 已崩溃：" & vbCrLf & Text) + FormMain.EndProgramForce(Result.Exception) + Else + FormMain.EndProgramForce(Result.Fail) + End If + End Select + + End Sub + ''' + ''' 输出错误信息。 + ''' + ''' 错误描述。会在处理时在末尾加入冒号。 + 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 + IsErrorTriggered = True + + '获取错误信息 + Dim ExFull As String = Desc & "：" & GetString(Ex, False) + + '输出日志 + Dim AppendText As String = "[" & GetTimeNow() & "] " & Desc & "：" & GetString(Ex, False, True) & vbCrLf '减轻同步锁占用 + If ModeDebug Then + SyncLock LogListLock + LogList.Append(AppendText) + End SyncLock + Else + LogList.Append(AppendText) + End If +#If DEBUG Then + Console.Write(AppendText) +#End If + If IsProgramEnded Then Exit Sub + + '输出提示 + Select Case Level + Case LogLevel.Normal +#If DEBUG Then + Case LogLevel.Developer + Dim ExLine As String = Desc & "：" & GetString(Ex, True) + Hint("[开发者模式] " & ExLine, HintType.Info, False) + Case LogLevel.Debug + Dim ExLine As String = Desc & "：" & GetString(Ex, True) + Hint("[调试模式] " & ExLine, HintType.Info, False) +#Else + Case LogLevel.Developer + Case LogLevel.Debug + Dim ExLine As String = Desc & "：" & GetString(Ex, True) + If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Info, False) +#End If + Case LogLevel.Hint + Dim ExLine As String = Desc & "：" & GetString(Ex, True) + Hint(ExLine, HintType.Critical, False) + Case LogLevel.Msgbox + MyMsgBox(ExFull, Title) + Case LogLevel.Feedback + If MyMsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", Title, "反馈", "取消") = 1 Then Feedback("exlog", False, True) + Case LogLevel.Assert + Dim Time As Long = GetTimeTick() + If MsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题？如果不反馈，这个问题可能永远无法得到解决！", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback("exlog", False, True) + If GetTimeTick() - Time < 1500 Then + '弹窗无法保留 + Log("[System] PCL 已崩溃：" & vbCrLf & ExFull) + FormMain.EndProgramForce(Result.Exception) + Else + FormMain.EndProgramForce(Result.Fail) + End If + End Select + + End Sub + + '反馈 + Public Sub Feedback(Source As String, Optional ShowMsgbox As Boolean = True, Optional ForceOpenLog As Boolean = False) + On Error Resume Next + FeedbackInfo() + If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug，请点击 打开文件夹 按钮，并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关，请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then + OpenExplorer("""" & Path & "PCL\""") + End If + OpenWebsite("https://jinshuju.net/f/rP4b6E?x_field_1=" & Source) + If Setup.Get("HintFeedback") = "" Then Setup.Set("HintFeedback", "/") '确保反馈报告会被加载 + End Sub + ''' + ''' 在日志中输出系统诊断信息。 + ''' + Public Sub FeedbackInfo() + On Error Resume Next + Log("[System] 诊断信息：" & vbCrLf & + "操作系统：" & My.Computer.Info.OSFullName & vbCrLf & + "剩余内存：" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf & + "DPI：" & DPI & "（" & Math.Round(DPI / 96, 2) * 100 & "%）" & vbCrLf & + "文件位置：" & Path) + End Sub + + '断言 + Public Sub DebugAssert(Exp As Boolean) + If Not Exp Then Throw New Exception("断言命中") + End Sub + +#End Region + +#Region "随机" + + Private ReadOnly Random As New Random + + ''' + ''' 随机选择其一。 + ''' + Public Function RandomOne(Of T)(objects As ICollection(Of T)) As T + Return objects(RandomInteger(0, objects.Count - 1)) + End Function + + ''' + ''' 取随机整数。 + ''' + Public Function RandomInteger(min As Integer, max As Integer) As Integer + Return Math.Floor((max - min + 1) * Random.NextDouble) + min + End Function + + ''' + ''' 将数组随机打乱。 + ''' + Public Function RandomChaos(Of T)(array As IList(Of T)) As IList(Of T) + RandomChaos = New List(Of T) + Do While array.Count > 0 + Dim i As Integer = RandomInteger(0, array.Count - 1) + RandomChaos.Add(array(i)) + array.RemoveAt(i) + Loop + End Function + +#End Region + +End Module \ No newline at end of file diff --git a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb new file mode 100644 index 0000000..d3ea71c --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb @@ -0,0 +1,700 @@ +Public Module ModLoader + + '各类加载器 + ''' + ''' 加载器的统一基类。 + ''' + Public MustInherit Class LoaderBase + Implements ILoadingTrigger + + Public ReadOnly Property IsLoader As Boolean = True Implements ILoadingTrigger.IsLoader + + '基础属性 + ''' + ''' 加载器的标识编号。 + ''' + Public Uuid As Integer = GetUuid() + ''' + ''' 加载器的名称。 + ''' + Public Name As String = "未命名任务 " & Uuid & "#" + ''' + ''' 用于状态改变检测的同步锁。 + ''' + Public ReadOnly LockState As New Object + ''' + ''' 父加载器。 + ''' + Public Parent As LoaderBase = Nothing + ''' + ''' 最上级的加载器。 + ''' + Public ReadOnly Property RealParent As LoaderBase + Get + Try + RealParent = Parent + While RealParent IsNot Nothing AndAlso RealParent.Parent IsNot Nothing + RealParent = RealParent.Parent + End While + Catch ex As Exception + Log(ex, "获取父加载器失败（" & Name & "）", LogLevel.Feedback) + Return Nothing + End Try + End Get + End Property + + Public Overridable Sub InitParent(Parent As LoaderBase) + Me.Parent = Parent + End Sub + + '事件 + + ''' + ''' 当状态改变时，在工作线程触发代码。在添加事件后，必须将 HasOnStateChangedThread 设为 True。 + ''' + Public Event OnStateChangedThread(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) + Public HasOnStateChangedThread As Boolean = False + + ''' + ''' 当状态改变时，在 UI 线程触发代码。 + ''' + Public Event OnStateChangedUi(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) + ''' + ''' 简易的在 UI 线程添加触发事件的方式。主要用于在新建 Loader 时直接使用 With 绑定事件，以及进行老代码兼容。 + ''' + Public WriteOnly Property OnStateChanged As Action(Of LoaderBase) + Set(value As Action(Of LoaderBase)) + AddHandler OnStateChangedUi, Sub(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) value(Loader) + End Set + End Property + + ''' + ''' 在加载器目标事件执行完成，加载器状态即将变为 Finish 时调用。可以视为扩展加载器目标事件。 + ''' + Public Event PreviewFinish(Loader As LoaderBase) + Protected Sub RaisePreviewFinish() + RaiseEvent PreviewFinish(Me) + End Sub + + '状态监控 + ''' + ''' 加载器的状态。 + ''' + Public Property State As LoadState + Get + Return _State + End Get + Set(value As LoadState) + If _State = value Then Exit Property + Dim OldState = _State + If value = LoadState.Finished AndAlso Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000)) + _State = value + Log("[Loader] 加载器 " & Name & " 状态改变：" & GetStringFromEnum(value)) + '实现 ILoadingTrigger 接口与 OnStateChanged 回调 + RunInUi(Sub() + Select Case value + Case LoadState.Loading + LoadingState = MyLoading.MyLoadingState.Run + Case LoadState.Failed + LoadingState = MyLoading.MyLoadingState.Error + Case Else + LoadingState = MyLoading.MyLoadingState.Stop + End Select + RaiseEvent OnStateChangedUi(Me, value, OldState) + End Sub) + If HasOnStateChangedThread Then RunInThread(Sub() RaiseEvent OnStateChangedThread(Me, value, OldState)) + End Set + End Property + Private _State As LoadState = LoadState.Waiting + Public Property LoadingState As MyLoading.MyLoadingState Implements ILoadingTrigger.LoadingState + Get + Return _LoadingState + End Get + Set(value As MyLoading.MyLoadingState) + If _LoadingState = value Then Exit Property + Dim OldState = _LoadingState + _LoadingState = value + RaiseEvent LoadingStateChanged(value, OldState) + End Set + End Property + Private _LoadingState As MyLoading.MyLoadingState = MyLoading.MyLoadingState.Stop + Public Event LoadingStateChanged(NewState As MyLoading.MyLoadingState, OldState As MyLoading.MyLoadingState) Implements ILoadingTrigger.LoadingStateChanged + ''' + ''' 若加载器出错，可提供给外部参考的异常。 + ''' + Public Property [Error] As Exception = Nothing + ''' + ''' 使用 LoaderCombo 加载时，该任务是否会阻碍后续任务的进行。 + ''' + Public Block As Boolean = True + ''' + ''' 该加载器是否显示在列表中。 + ''' + Public Show As Boolean = True + ''' + ''' 当前加载器是否由 IsForceRestart 强制调起。 + ''' 这个属性自身不会干任何事，而是提供给加载器执行的函数，使得加载器调用另一个加载器时，可以继承强制重启属性。 + ''' + Public IsForceRestarting As Boolean = False + + '进度监控 + ''' + ''' 加载器的执行进度，为 0 至 1 的小数。 + ''' + Public Overridable Property Progress As Double + Get + Select Case State + Case LoadState.Waiting + Return 0 + Case LoadState.Loading + Return If(_Progress = -1, 0.02, _Progress) + Case Else + Return 1 + End Select + End Get + Set(value As Double) + _Progress = value + End Set + End Property + Private _Progress As Double = -1 + ''' + ''' 计算总进度时的权重。它应该为预计时间（秒）。 + ''' + Public Property ProgressWeight As Double = 1 + + '状态变化 + Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) + Public MustOverride Sub Abort() + + '等待结束 + Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。" + + ''' + ''' 无限期地等待加载器完成，直到结束或抛出异常。若加载器尚未开始，则会开始执行。 + ''' + Public Sub WaitForExit(Optional Input As Object = Nothing, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional IsForceRestart As Boolean = False) + Start(Input, IsForceRestart) + Do While State = LoadState.Loading + If LoaderToSyncProgress IsNot Nothing Then LoaderToSyncProgress.Progress = Progress + Thread.Sleep(10) + Loop + If State = LoadState.Finished Then + Exit Sub + ElseIf State = LoadState.Aborted Then + Throw New ThreadInterruptedException("加载器执行已中断。") + ElseIf IsNothing([Error]) Then + Throw New Exception("未知错误！") + Else + Throw New Exception([Error].Message, [Error]) '保留调用堆栈，同时不影响信息输出与单元测试 + End If + End Sub + ''' + ''' 等待加载器完成，直到结束、抛出异常或超时。若加载器尚未开始，则会开始执行。 + ''' + ''' 等待的超时时间，以毫秒为单位。 + ''' 若执行超时，将会抛出的异常信息。 + Public Sub WaitForExitTime(Timeout As Integer, Optional Input As Object = Nothing, Optional TimeoutMessage As String = WaitForExitTimeoutMessage, Optional LoaderToSyncProgress As Object = Nothing, Optional IsForceRestart As Boolean = False) + Start(Input, IsForceRestart) + Do While State = LoadState.Loading + If LoaderToSyncProgress IsNot Nothing Then LoaderToSyncProgress.Progress = Progress + Thread.Sleep(10) + Timeout -= 10 + If Timeout < 0 Then Throw New TimeoutException(TimeoutMessage) + Loop + If State = LoadState.Finished Then + Exit Sub + ElseIf State = LoadState.Aborted Then + Throw New ThreadInterruptedException("加载器执行已中断。") + ElseIf IsNothing([Error]) Then + Throw New Exception("未知错误！") + Else + Throw [Error] + End If + End Sub + + '相同重载 + Public Overrides Function Equals(obj As Object) As Boolean + Dim base = TryCast(obj, LoaderBase) + Return base IsNot Nothing AndAlso Uuid = base.Uuid + End Function + + End Class + ''' + ''' 用于异步执行并监控单一函数的加载器。 + ''' + Public Class LoaderTask(Of InputType, OutputType) + Inherits LoaderBase + + '线程设定 + Protected Friend ThreadPriority As ThreadPriority + '执行事件 + Protected Friend LoadDelegate As Action(Of LoaderTask(Of InputType, OutputType)) + Protected Friend InputDelegate As Func(Of Object) + '状态指示 + ''' + ''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断，不可跨线程调用。 + ''' + Public ReadOnly Property IsAborted As Boolean + Get + Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread.CurrentThread, LastRunningThread) + End Get + End Property + ''' + ''' 在输入相同时使用原有结果的超时，单位为毫秒。 + ''' + Public ReloadTimeout As Integer = -1 + ''' + ''' 上次完成加载时的时间。 + ''' + Public LastFinishedTime As Long = 0 + ''' + ''' 最后一次运行加载器的线程。可能为 Nothing，或线程已结束。 + ''' + Public LastRunningThread As Thread = Nothing + '输入输出 + Public Input As InputType = Nothing + Public Output As OutputType = Nothing + + '获取输入 + Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType + If InputDelegate Is Nothing Then InputDelegate = Me.InputDelegate + Dim NewInput As InputType = Nothing '若 InputType 不能为 Nothing，则会导致 Input Is Nothing 永远失败，因此需要额外判断 + If (Input Is Nothing OrElse (NewInput IsNot Nothing AndAlso Input.Equals(NewInput))) AndAlso InputDelegate IsNot Nothing Then + RunInUiWait(Sub() Input = InputDelegate()) + End If + Return Input + End Function + '代码执行 + Public Function ShouldStart(ByRef Input As Object, Optional IsForceRestart As Boolean = False, Optional IgnoreReloadTimeout As Boolean = False) As Boolean + '获取输入 + Try + Input = StartGetInput(Input) + Catch ex As Exception + Log(ex, "加载输入获取失败（" & Name & "）", LogLevel.Hint) + [Error] = ex + SyncLock LockState + State = LoadState.Failed + End SyncLock + End Try + '检验输入以确定情况 + If (Not IsForceRestart) AndAlso '不要求强行重启 + ((Input IsNot Nothing AndAlso Input.Equals(Me.Input)) OrElse (Input Is Nothing AndAlso Me.Input Is Nothing)) AndAlso '输入相同 + (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已加载成功 + (IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时 + '如果输入相同且未出错则不重试 + Return False + Else + '需要开始 + Return True + End If + End Function + Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) + '确认是否开始加载 + If ShouldStart(Input, IsForceRestart) Then + '输入不同或失败，开始加载 + If State = LoadState.Loading Then TriggerThreadAbort() + Me.Input = Input + SyncLock LockState + State = LoadState.Loading + End SyncLock + Else + Exit Sub + End If + + LastRunningThread = New Thread( + Sub() + Try + IsForceRestarting = IsForceRestart + If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已启动") + LoadDelegate(Me) + If IsAborted Then + Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已中断但线程正常运行至结束，输出被弃用（最新线程：" & If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId) & "）", LogLevel.Developer) + Else + RaisePreviewFinish() + State = LoadState.Finished + LastFinishedTime = GetTimeTick() '未中断，本次输出有效 + End If + Catch ex As ThreadInterruptedException + If ModeDebug Then Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已触发线程中断") + '如果线程是因为判断到 IsAborted 而提前中止，则代表已有新线程被重启，此时不应当改为 Aborted + '如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException，则代表没有重启线程，这通常代表用户手动取消，应当改为 Aborted + If Not IsAborted Then State = LoadState.Aborted + Catch ex As Exception + If IsAborted Then Exit Sub + Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 发生运行时错误", LogLevel.Developer) + [Error] = ex + State = LoadState.Failed + End Try + End Sub) With {.Name = Name, .Priority = ThreadPriority} + LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsAborted + End Sub + Public Overrides Sub Abort() + If State <> LoadState.Loading Then Exit Sub + SyncLock LockState + State = LoadState.Aborted + End SyncLock + TriggerThreadAbort() + End Sub + Private Sub TriggerThreadAbort() + If LastRunningThread Is Nothing Then Exit Sub + If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & LastRunningThread.ManagedThreadId & ") 已中断") + If LastRunningThread.IsAlive Then LastRunningThread.Interrupt() + LastRunningThread = Nothing + End Sub + + Public Sub New() + '仅仅是为了避免一些智障报错（继承类必须重写 New 的情况） + End Sub + Public Sub New(Name As String, LoadDelegate As Action(Of LoaderTask(Of InputType, OutputType)), Optional InputDelegate As Func(Of InputType) = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal) + Me.Name = Name + Me.LoadDelegate = LoadDelegate + Me.InputDelegate = InputDelegate + ThreadPriority = Priority + End Sub + + End Class + ''' + ''' 支持多个加载器连续运作的复合加载器。 + ''' + Public Class LoaderCombo(Of InputType) + Inherits LoaderBase + + Public Overrides Property Progress() As Double + Get + Select Case State + Case LoadState.Waiting + Return 0 + Case LoadState.Loading + Dim Total As Double = 0, Finished As Double = 0 + For Each Loader In Loaders + Total += Loader.ProgressWeight + Finished += Loader.ProgressWeight * Loader.Progress + Next + If Total = 0 Then Return 0 + Return Finished / Total + Case Else + Return 1 + End Select + End Get + Set(value As Double) + Throw New Exception("多重加载器不支持设置进度") + End Set + End Property + + Public Loaders As New List(Of LoaderBase) + Public Input As InputType + Public Sub New(Name As String, Loaders As IEnumerable(Of LoaderBase)) + Me.Loaders.Clear() + For Each Loader As LoaderBase In Loaders + If Loader IsNot Nothing Then + Me.Loaders.Add(Loader) + AddHandler Loader.OnStateChangedThread, AddressOf SubTaskStateChanged + Loader.HasOnStateChangedThread = True + End If + Next + InitParent(Nothing) + Me.Name = Name + End Sub + Public Overrides Sub InitParent(Parent As LoaderBase) + Me.Parent = Parent + For Each Loader In Loaders + Loader.InitParent(Me) + Next + End Sub + Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) + IsForceRestarting = IsForceRestart + '改变状态 + SyncLock LockState + If State = LoadState.Loading Then + Exit Sub + Else + State = LoadState.Loading + End If + End SyncLock + '启动加载 + Me.Input = Input + If IsForceRestart Then + For Each Loader In Loaders + Loader.State = LoadState.Waiting + Next + End If + Update() + End Sub + Public Overrides Sub Abort() + '改变状态 + SyncLock LockState + If State = LoadState.Loading OrElse State = LoadState.Waiting Then + State = LoadState.Aborted + Else + Exit Sub + End If + End SyncLock + RunInThread(Sub() + '中断加载器 + For Each Loader In Loaders + Loader.Abort() + Next + '从列表删除 + SyncLock LoaderTaskbarLock + If LoaderTaskbar.Contains(Me) Then LoaderTaskbar.Remove(Me) + End SyncLock + End Sub) + End Sub + + ''' + ''' 子任务状态变更。 + ''' + Private Sub SubTaskStateChanged(Loader As LoaderBase, NewState As LoadState, OldState As LoadState) + Select Case NewState + Case LoadState.Loading + '开始，啥都不干 + Case LoadState.Waiting + '子加载器可能由于外部输入改变而暂时变为 Waiting，之后会立即重新启动 + '所以啥都不干就行 + Case LoadState.Finished + '正常结束，触发刷新 + Update() + Case LoadState.Aborted + '被中断，这个任务也中断 + Abort() + Case Else + '完蛋，出错了 + SyncLock LockState + If State >= LoadState.Finished Then Exit Sub + [Error] = New Exception(Loader.Name & "失败", Loader.Error) + State = Loader.State + End SyncLock + For Each Loader In Loaders + Loader.Abort() + Next + FrmMain.BtnExtraDownload.ShowRefresh() + Exit Sub + End Select + End Sub + ''' + ''' 触发一次更新，以启动新加载器或完成。 + ''' + Private Sub Update() + If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Exit Sub + Dim IsFinished As Boolean = True + Dim Ignore As Boolean = False + Dim Input As Object = Me.Input + For Each Loader In Loaders + Select Case Loader.State + Case LoadState.Finished + '检查是否需要重启 + If Loader.GetType.Name.StartsWith("LoaderTask") Then '类型名后面带有泛型，必须用 StartsWith + If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then + If ModeDebug Then Log("[Loader] 由于输入条件变更，重启已完成的加载器 " & Loader.Name) + GoTo Restart + End If + '更新下一个加载器的输入 + Input = CType(Loader, Object).Output + End If + Case LoadState.Loading + '检查是否需要重启 + If Loader.GetType.Name.StartsWith("LoaderTask") Then + If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then + If ModeDebug Then Log("[Loader] 由于输入条件变更，重启进行中的加载器 " & Loader.Name, LogLevel.Developer) + GoTo Restart + End If + End If + '已经有正在加载中的了，不需要再启动了 + IsFinished = False + Ignore = True + Case Else +Restart: + '未启动，则启动加载器 + IsFinished = False + If Ignore Then Continue For + If Input IsNot Nothing Then + '若输入类型与下一个加载器相同才继续 + Dim LoaderType As String = Loader.GetType.Name + If LoaderType.StartsWith("LoaderTask") OrElse LoaderType.StartsWith("LoaderCombo") Then + Loader.Start(If(Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IsForceRestarting) + ElseIf LoaderType.StartsWith("LoaderDownload") Then + Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting) + Else + Throw New Exception("未知的加载器类型（" & LoaderType & "）") + End If + Else + Loader.Start(IsForceRestart:=IsForceRestarting) + End If + '如果不让继续启动，那就不启动呗 + If Loader.Block Then Ignore = True + End Select + Next + If IsFinished Then + '顺利完成，贼棒 + RaisePreviewFinish() + State = LoadState.Finished + FrmMain.BtnExtraDownload.ShowRefresh() + End If + End Sub + + ''' + ''' 获得最底层的，应被显示给用户的加载器列表，并追加于 List。 + ''' + Public Shared Sub GetLoaderList(Loader As Object, ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True) + For Each SubLoader In Loader.Loaders + If SubLoader.Show OrElse Not RequireShow Then List.Add(SubLoader) + If SubLoader.GetType.Name.StartsWith("LoaderCombo") Then GetLoaderList(SubLoader, List) + Next + End Sub + ''' + ''' 获得最底层的，应被显示给用户的加载器列表，并追加于 List。 + ''' + Public Sub GetLoaderList(ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True) + GetLoaderList(Me, List, RequireShow) + End Sub + ''' + ''' 获得最底层的，应被显示给用户的加载器列表。 + ''' + Public Function GetLoaderList(Optional RequireShow As Boolean = True) As List(Of LoaderBase) + Dim List As New List(Of LoaderBase) + GetLoaderList(List, RequireShow) + Return List + End Function + + End Class + + '任务栏进度条 + Public LoaderTaskbarLock As New Object + Public LoaderTaskbar As New List(Of LoaderBase) + Public LoaderTaskbarProgress As Double = 0 '平滑后的进度 + Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None + + Public Sub LoaderTaskbarAdd(Loader As LoaderBase) + If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader) + SyncLock LoaderTaskbarLock + LoaderTaskbar.Add(Loader) + End SyncLock + End Sub + Public Sub LoaderTaskbarProgressRefresh() + Try + Dim NewState As Shell.TaskbarItemProgressState + Dim NewProgress As Double = LoaderTaskbarProgressGet() + '检查任务是否完成，若完成则移除 + SyncLock LoaderTaskbarLock + '外显任务是否已经全部完成 + Dim IsAllDownloadTaskCompleted As Boolean = True + For Each Loader In LoaderTaskbar + If Loader.Show AndAlso Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False + Next + '若单个任务已中止或全部任务已完成，则刷新并移除 + Dim RemovedTask As New List(Of LoaderBase) + For i = 0 To LoaderTaskbar.Count - 1 + If (IsAllDownloadTaskCompleted OrElse LoaderTaskbar(i).State = LoadState.Aborted) AndAlso LoaderTaskbar(i).Show Then + If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(LoaderTaskbar(i)) + RemovedTask.Add(LoaderTaskbar(i)) + End If + Next + For Each Task In RemovedTask + LoaderTaskbar.Remove(Task) + Next + End SyncLock + '更新平滑后的进度 + If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then + LoaderTaskbarProgress = NewProgress + Else + LoaderTaskbarProgress = LoaderTaskbarProgress * 0.9 + NewProgress * 0.1 + End If + '更新任务栏信息 + If LoaderTaskbar.Count = 0 OrElse LoaderTaskbarProgress = 1 Then + NewState = Shell.TaskbarItemProgressState.None + ElseIf LoaderTaskbarProgress < 0.015 Then + NewState = Shell.TaskbarItemProgressState.Indeterminate + Else + NewState = Shell.TaskbarItemProgressState.Normal + FrmMain.TaskbarItemInfo.ProgressValue = LoaderTaskbarProgress + End If + If LoaderTaskbarProgressLast <> NewState Then + LoaderTaskbarProgressLast = NewState + FrmMain.TaskbarItemInfo.ProgressState = NewState + FrmMain.BtnExtraDownload.ShowRefresh() + End If + Catch ex As Exception + Log(ex, "刷新任务栏进度显示失败", LogLevel.Feedback) + End Try + End Sub + Public Function LoaderTaskbarProgressGet() As Double + Try + Dim Total As Double = 0, Count As Integer = 0 + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + Total += LoaderTaskbar(i).Progress + Count += 1 '避免多线程影响导致计数出错 + Next + End SyncLock + If Count = 0 Then Return 1 + Return MathRange(Total / Count, 0, 1) + Catch ex As Exception + Log(ex, "获取任务栏进度出错", LogLevel.Feedback) + Return 0.5 + End Try + End Function + + '文件夹刷新类委托 + Private LoaderFolderDictionary As New Dictionary(Of LoaderBase, LoaderFolderDictionaryEntry) + Private Structure LoaderFolderDictionaryEntry + Public LastCheckTime As Date? + Public FolderPath As String + Public Overrides Function Equals(obj As Object) As Boolean + If TypeOf obj IsNot LoaderFolderDictionaryEntry Then Return False + Dim entry = DirectCast(obj, LoaderFolderDictionaryEntry) + Return EqualityComparer(Of Date?).Default.Equals(LastCheckTime, entry.LastCheckTime) AndAlso + FolderPath = entry.FolderPath + End Function + End Structure + Public Enum LoaderFolderRunType + RunOnUpdated + ForceRun + UpdateOnly + End Enum + ''' + ''' 执行以文件夹检测作为输入的加载器。加载器需以文件夹路径为输入值。 + ''' 返回是否执行了加载器。 + ''' + ''' 用于检查文件夹修改的额外路径。该路径不会传入加载器。 + Public Function LoaderFolderRun(Loader As LoaderBase, FolderPath As String, Type As LoaderFolderRunType, Optional MaxDepth As Integer = 0, Optional ExtraPath As String = "", Optional WaitForExit As Boolean = False) As Boolean + Dim FolderInfo As DirectoryInfo + Dim Value As New LoaderFolderDictionaryEntry With {.FolderPath = FolderPath & ExtraPath, .LastCheckTime = Nothing} + Try + '获取数据 + FolderInfo = New DirectoryInfo(FolderPath & ExtraPath) + Value.LastCheckTime = If(FolderInfo.Exists, GetActualLastWriteTimeUtc(FolderInfo, MaxDepth), DirectCast(Nothing, Date?)) + '如果已经检查过，则跳过 + If Type = LoaderFolderRunType.RunOnUpdated AndAlso LoaderFolderDictionary.ContainsKey(Loader) Then + If FolderInfo.Exists Then + If LoaderFolderDictionary(Loader).LastCheckTime IsNot Nothing AndAlso + Value.Equals(LoaderFolderDictionary(Loader)) Then Return False + Else + If LoaderFolderDictionary(Loader).LastCheckTime Is Nothing Then Return False + End If + End If + Catch ex As Exception + Log(ex, "文件夹加载器启动检测出错") + End Try + '写入检查数据 + DictionaryAdd(LoaderFolderDictionary, Loader, Value) + '开始检查 + If Type = LoaderFolderRunType.UpdateOnly Then Return False + If WaitForExit Then + Loader.WaitForExit(FolderPath, IsForceRestart:=True) + Else + Loader.Start(FolderPath, IsForceRestart:=True) + End If + Return True + End Function + Private Function GetActualLastWriteTimeUtc(FolderInfo As DirectoryInfo, MaxDepth As Integer) As Date + Dim Time As Date = FolderInfo.LastWriteTimeUtc + If MaxDepth > 0 Then + For Each Folder In FolderInfo.EnumerateDirectories + Dim FolderTime As Date = GetActualLastWriteTimeUtc(Folder, MaxDepth - 1) + If FolderTime > Time Then Time = FolderTime + Next + End If + Return Time + End Function + +End Module diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb new file mode 100644 index 0000000..bd8e731 --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb @@ -0,0 +1,2054 @@ +Imports System.Net + +Public Module ModNet + + Public Const NetDownloadEnd As String = ".PCLDownloading" + + ''' + ''' 以 WebClient 获取网页源代码。会进行至多 45 秒 3 次的尝试，允许最长 30s 的超时。 + ''' + ''' 网页的 Url。 + ''' 网页的编码，通常为 UTF-8。 + Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Optional Accept As String = "application/json, text/javascript, */*; q=0.01") As String + Dim RetryCount As Integer = 0 + Dim RetryException As Exception = Nothing + Dim StartTime As Long = GetTimeTick() + Try +Retry: + Select Case RetryCount + Case 0 '正常尝试 + Return NetGetCodeByClient(Url, Encoding, 10000, Accept) + Case 1 '慢速重试 + Thread.Sleep(500) + Return NetGetCodeByClient(Url, Encoding, 30000, Accept) + Case Else '快速重试 + If GetTimeTick() - StartTime > 5500 Then + '若前两次加载耗费 5 秒以上，才进行重试 + Thread.Sleep(500) + Return NetGetCodeByClient(Url, Encoding, 4000, Accept) + Else + Throw RetryException + End If + End Select + Catch ex As Exception + Select Case RetryCount + Case 0 + RetryException = ex + RetryCount += 1 + GoTo Retry + Case 1 + RetryCount += 1 + GoTo Retry + Case Else + Throw + End Select + End Try + End Function + Public Function NetGetCodeByClient(Url As String, Encoding As Encoding, Timeout As Integer, Accept As String) As String + Url = SecretCdnSign(Url) + Log("[Net] 获取客户端网络结果：" & Url & "，最大超时 " & Timeout) + Dim Request As CookieWebClient + Dim res As HttpWebResponse = Nothing + Dim HttpStream As Stream = Nothing + Try + Request = New CookieWebClient With { + .Encoding = Encoding, + .Timeout = Timeout + } + Request.Headers("Accept") = Accept + Request.Headers("Accept-Language") = "en-US,en;q=0.5" + Request.Headers("X-Requested-With") = "XMLHttpRequest" + SecretHeadersSign(Url, Request) + Return Request.DownloadString(Url) + Catch ex As Exception + If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then + Throw New TimeoutException("连接服务器超时（" & Url & "）", ex) + Else + Throw New WebException("获取结果失败，" & ex.Message & "（" & Url & "）", ex) + End If + Finally + If Not IsNothing(HttpStream) Then HttpStream.Dispose() + If Not IsNothing(res) Then res.Dispose() + End Try + End Function + + ''' + ''' 以 WebRequest 获取网页源代码或 Json。会进行至多 45 秒 3 次的尝试，允许最长 30s 的超时。 + ''' + ''' 网页的 Url。 + ''' 网页的编码，通常为 UTF-8。 + Public Function NetGetCodeByRequestRetry(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False) + Dim RetryCount As Integer = 0 + Dim RetryException As Exception = Nothing + Dim StartTime As Long = GetTimeTick() + Try +Retry: + Select Case RetryCount + Case 0 '正常尝试 + Return NetGetCodeRequest(Url, Encode, 10000, IsJson, Accept) + Case 1 '慢速重试 + Thread.Sleep(500) + Return NetGetCodeRequest(Url, Encode, 30000, IsJson, Accept) + Case Else '快速重试 + If GetTimeTick() - StartTime > 5500 Then + '若前两次加载耗费 5 秒以上，才进行重试 + Thread.Sleep(500) + Return NetGetCodeRequest(Url, Encode, 4000, IsJson, Accept) + Else + Throw RetryException + End If + End Select + Catch ex As ThreadInterruptedException + Throw + Catch ex As Exception + Select Case RetryCount + Case 0 + RetryException = ex + RetryCount += 1 + GoTo Retry + Case 1 + RetryCount += 1 + GoTo Retry + Case Else + Throw + End Select + End Try + End Function + ''' + ''' 以 WebRequest 获取网页源代码或 Json。会逐渐生成 4 个尝试线程，并在 60s 后超时。 + ''' + ''' 网页的 Url。 + ''' 网页的编码，通常为 UTF-8。 + Public Function NetGetCodeByRequestMuity(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False) + Dim Threads As New List(Of Thread) + Dim RequestResult = Nothing + Dim RequestEx As Exception = Nothing + Dim FailCount As Integer = 0 + For i = 1 To 4 + Dim th As New Thread(Sub() + Try + RequestResult = NetGetCodeRequest(Url, Encode, 30000, IsJson, Accept) + Catch ex As Exception + FailCount += 1 + RequestEx = ex + End Try + End Sub) + th.Start() + Threads.Add(th) + Thread.Sleep(i * 250) + If RequestResult IsNot Nothing Then GoTo RequestFinished + Next + Do While True + If RequestResult IsNot Nothing Then +RequestFinished: + Try + For Each th In Threads + If th.IsAlive Then th.Interrupt() + Next + Catch + End Try + Return RequestResult + ElseIf FailCount = 4 Then + Try + For Each th In Threads + If th.IsAlive Then th.Interrupt() + Next + Catch + End Try + Throw RequestEx + End If + Thread.Sleep(20) + Loop + Throw New Exception("未知错误") + End Function + Private Function NetGetCodeRequest(Url As String, Encode As Encoding, Timeout As Integer, IsJson As Boolean, Accept As String) + If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求") + Url = SecretCdnSign(Url) + Log("[Net] 获取网络结果：" & Url & "，最大超时 " & Timeout) + Dim Request As HttpWebRequest = WebRequest.Create(Url) + Dim Result As New List(Of Byte) + Try + If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Request.ProtocolVersion = HttpVersion.Version11 + Request.Timeout = Timeout + Request.Accept = Accept + Request.KeepAlive = False + SecretHeadersSign(Url, Request) + Using res As HttpWebResponse = Request.GetResponse() + Using HttpStream As Stream = res.GetResponseStream() + HttpStream.ReadTimeout = Timeout + Dim HttpData As Byte() = New Byte(16384) {} + Using Reader As New StreamReader(HttpStream, If(Encode, Encoding.UTF8)) + Dim ResultString As String = Reader.ReadToEnd + Return If(IsJson, GetJson(ResultString), ResultString) + End Using + End Using + End Using + Catch ex As ThreadInterruptedException + Throw + Catch ex As Exception + If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then + Throw New TimeoutException("连接服务器超时，已接收 " & Result.Count & " B（" & Url & "）") + Else + Throw New WebException("获取结果失败，" & ex.Message & "（" & Url & "）", ex) + End If + Finally + Request.Abort() + End Try + End Function + + ''' + ''' 以多线程下载网页文件的方式获取网页源代码。 + ''' + ''' 网页的 Url。 + Public Function NetGetCodeByDownload(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False) As String + Dim Temp As String = PathTemp & "Cache\Code\" & Url.GetHashCode() & "_" & GetUuid() + Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson})}) + Try + NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（" & Url & "）") + NetGetCodeByDownload = ReadFile(Temp) + File.Delete(Temp) + Finally + NewTask.Abort() + End Try + End Function + ''' + ''' 以多线程下载网页文件的方式获取网页源代码。 + ''' + ''' 网页的 Url 列表。 + Public Function NetGetCodeByDownload(Urls As String(), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False) As String + Dim Temp As String = PathTemp & "Cache\Code\" & Urls(0).GetHashCode() & "_" & GetUuid() + Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson})}) + Try + NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls(0) & "）") + NetGetCodeByDownload = ReadFile(Temp) + File.Delete(Temp) + Finally + NewTask.Abort() + End Try + End Function + + ''' + ''' 从网络中直接下载文件。这不能下载 CDN 中的文件。 + ''' + ''' 网络 Url。 + ''' 下载的本地地址。 + Public Sub NetDownload(Url As String, LocalFile As String) + Log("[Net] 直接下载文件：" & Url) + + '初始化 + Try + '建立目录 + Directory.CreateDirectory(GetPathFromFullPath(LocalFile)) + '尝试删除原文件 + File.Delete(LocalFile) + Catch ex As Exception + Throw New WebException("预处理下载文件路径失败（" & LocalFile & "）。", ex) + End Try + + '下载 + Using Client As New WebClient + Try + Client.DownloadFile(Url, LocalFile) + Catch ex As Exception + Throw New WebException("直接下载文件失败（" & Url & "）。", ex) + End Try + End Using + + End Sub + + ''' + ''' 发送一个网络请求并获取返回内容，会重试三次并在最长 45s 后超时。 + ''' + ''' 请求的服务器地址。 + ''' 请求方式（POST 或 GET）。 + ''' 请求的内容。 + ''' 请求的套接字类型。 + ''' 当返回 40x 时不重试。 + Public Function NetRequestRetry(Url As String, Method As String, Data As Object, ContentType As String, Optional DontRetryOnRefused As Boolean = True, Optional Headers As Dictionary(Of String, String) = Nothing) As String + Dim RetryCount As Integer = 0 + Dim RetryException As Exception = Nothing + Dim StartTime As Long = GetTimeTick() + Try +Retry: + Select Case RetryCount + Case 0 '正常尝试 + Return NetRequestOnce(Url, Method, Data, ContentType, 15000, Headers) + Case 1 '慢速重试 + Thread.Sleep(500) + Return NetRequestOnce(Url, Method, Data, ContentType, 25000, Headers) + Case Else '快速重试 + If GetTimeTick() - StartTime > 5500 Then + '若前两次加载耗费 5 秒以上，才进行重试 + Thread.Sleep(500) + Return NetRequestOnce(Url, Method, Data, ContentType, 4000, Headers) + Else + Throw RetryException + End If + End Select + Catch ex As ThreadInterruptedException + Throw + Catch ex As Exception + If ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message.Contains("(40") AndAlso DontRetryOnRefused Then RetryCount = 999 + Select Case RetryCount + Case 0 + If ModeDebug Then Log(ex, "[Net] 网络请求第一次失败（" & Url & "）") + RetryException = ex + RetryCount += 1 + GoTo Retry + Case 1 + If ModeDebug Then Log(ex, "[Net] 网络请求第二次失败（" & Url & "）") + RetryCount += 1 + GoTo Retry + Case Else + Throw + End Select + End Try + End Function + ''' + ''' 同时发送多个网络请求并要求返回内容。 + ''' + Public Function NetRequestMuity(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing) + Dim Threads As New List(Of Thread) + Dim RequestResult = Nothing + Dim RequestEx As Exception = Nothing + Dim FailCount As Integer = 0 + For i = 1 To RequestCount + Dim th As New Thread(Sub() + Try + RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers) + Catch ex As Exception + FailCount += 1 + RequestEx = ex + End Try + End Sub) + th.Start() + Threads.Add(th) + Thread.Sleep(i * 250) + If RequestResult IsNot Nothing Then GoTo RequestFinished + Next + Do While True + If RequestResult IsNot Nothing Then +RequestFinished: + For Each th In Threads + If th.IsAlive Then th.Interrupt() + Next + Return RequestResult + ElseIf FailCount = RequestCount Then + For Each th In Threads + If th.IsAlive Then th.Interrupt() + Next + Throw RequestEx + End If + Thread.Sleep(20) + Loop + Throw New Exception("未知错误") + End Function + ''' + ''' 发送一次网络请求并获取返回内容。 + ''' + Public Function NetRequestOnce(Url As String, Method As String, Data As Object, ContentType As String, Optional Timeout As Integer = 25000, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True) As String + If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求") + Url = SecretCdnSign(Url) + If MakeLog Then Log("[Net] 发起网络请求（" & Method & "，" & Url & "），最大超时 " & Timeout) + Dim DataStream As Stream = Nothing + Dim Resp As WebResponse = Nothing + Dim Req As HttpWebRequest + Try + Req = WebRequest.Create(New Uri(Url)) + Req.Method = Method + Dim SendData As Byte() + If TypeOf Data Is Byte() Then + SendData = Data + Else + SendData = New UTF8Encoding(False).GetBytes(Data.ToString) + End If + If Headers IsNot Nothing Then + For Each Pair In Headers + Req.Headers.Add(Pair.Key, Pair.Value) + Next + End If + Req.ContentType = ContentType + Req.Timeout = Timeout + Req.KeepAlive = False + SecretHeadersSign(Url, Req) + If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Req.ProtocolVersion = HttpVersion.Version11 + If Method = "POST" OrElse Method = "PUT" Then + Req.ContentLength = SendData.Length + DataStream = Req.GetRequestStream() + DataStream.WriteTimeout = Timeout + DataStream.ReadTimeout = Timeout + DataStream.Write(SendData, 0, SendData.Length) + DataStream.Close() + End If + Resp = Req.GetResponse() + DataStream = Resp.GetResponseStream() + DataStream.WriteTimeout = Timeout + DataStream.ReadTimeout = Timeout + Using Reader As New StreamReader(DataStream) + Return Reader.ReadToEnd() + End Using + Catch ex As ThreadInterruptedException + Throw + Catch ex As WebException + If ex.Status = WebExceptionStatus.Timeout Then + Throw New TimeoutException("连接服务器超时，请检查你的网络环境是否良好（" & Url & "）", ex) + Else + '获取请求失败的返回 + Dim Res As String = "" + Try + If ex.Response Is Nothing Then Exit Try + DataStream = ex.Response.GetResponseStream() + DataStream.WriteTimeout = Timeout + DataStream.ReadTimeout = Timeout + Using Reader As New StreamReader(DataStream) + Res = Reader.ReadToEnd() + End Using + Catch + End Try + Throw New WebException("网络请求失败（" & Url & "，" & ex.Message & "）" & If(String.IsNullOrEmpty(Res), "", vbCrLf & Res), ex) + End If + Catch ex As Exception + Throw New WebException("网络请求失败（" & Url & "）", ex) + Finally + If DataStream IsNot Nothing Then DataStream.Dispose() + If Resp IsNot Nothing Then Resp.Dispose() + End Try + End Function + + ''' + ''' 最大线程数。 + ''' + Public NetTaskThreadLimit As Integer + ''' + ''' 速度下限。 + ''' + Public NetTaskSpeedLimitLow As Long = 1024 * 1024L + ''' + ''' 速度上限。若无限制则为 -1。 + ''' + Public NetTaskSpeedLimitHigh As Long = -1 + ''' + ''' 基于限速，当前可以下载的剩余量。 + ''' + Public NetTaskSpeedLimitLeft As Long = -1 + Private ReadOnly NetTaskSpeedLimitLeftLock As New Object + Private NetTaskSpeedLimitLeftLast As Long + ''' + ''' 正在运行中的线程数。 + ''' + Public NetTaskThreadCount As Integer = 0 + Private ReadOnly NetTaskThreadCountLock As New Object + + ''' + ''' 下载源。 + ''' + Public Class NetSource + Public Id As Integer + Public Url As String + Public FailCount As Integer + Public Ex As Exception + Public Thread As NetThread + Public IsFailed As Boolean + Public Overrides Function ToString() As String + Return Url + End Function + End Class + ''' + ''' 下载进度标示。 + ''' + Public Enum NetState + ''' + ''' 尚未进行已存在检查。 + ''' + WaitForCheck = -1 + ''' + ''' 尚未开始。 + ''' + WaitForDownload = 0 + ''' + ''' 正在连接，尚未获取文件大小。 + ''' + Connect = 1 + ''' + ''' 已获取文件大小，尚未有有效下载。 + ''' + [Get] = 2 + ''' + ''' 正在下载。 + ''' + Download = 3 + ''' + ''' 正在合并文件。 + ''' + Merge = 4 + ''' + ''' 不进行下载，因为已发现现存的文件。 + ''' + WaitForCopy = 5 + ''' + ''' 已完成。 + ''' + Finish = 6 + ''' + ''' 已失败。 + ''' + [Error] = 7 + End Enum + ''' + ''' 预下载检查行为。 + ''' + Public Enum NetPreDownloadBehaviour + ''' + ''' 当文件已存在时，显示提示以提醒用户是否继续下载。 + ''' + HintWhileExists + ''' + ''' 当文件已存在或正在下载时，直接退出下载函数执行，不对用户进行提示。 + ''' + ExitWhileExistsOrDownloading + ''' + ''' 不进行已存在检查。 + ''' + IgnoreCheck + End Enum + + ''' + ''' 下载线程。 + ''' + Public Class NetThread + Implements IEnumerable(Of NetThread) + + ''' + ''' 对应的下载任务。 + ''' + Public Task As NetFile + ''' + ''' 对应的线程。 + ''' + Public Thread As Thread + ''' + ''' 链表中的下一个线程。 + ''' + Public NextThread As NetThread + Private ReadOnly Iterator Property [Next]() As IEnumerable(Of NetThread) + Get + Dim CurrentChain As NetThread = Me + While CurrentChain IsNot Nothing + Yield CurrentChain + CurrentChain = CurrentChain.NextThread + End While + End Get + End Property + Public Function GetEnumerator() As IEnumerator(Of NetThread) Implements IEnumerable(Of NetThread).GetEnumerator + Return [Next].GetEnumerator() + End Function + Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator + Return [Next].GetEnumerator() + End Function + + ''' + ''' 分配给任务中每个线程（无论其是否失败）的编号。 + ''' + Public Uuid As Integer + ''' + ''' 是否为第一个线程。 + ''' + Public ReadOnly Property IsFirstThread As Boolean + Get + Return DownloadStart = 0 AndAlso Task.FileSize = -2 + End Get + End Property + ''' + ''' 该线程的缓存文件。 + ''' + Public Temp As String + + ''' + ''' 线程下载起始位置。 + ''' + Public DownloadStart As Long + ''' + ''' 线程下载结束位置。 + ''' + Public ReadOnly Property DownloadEnd As Long + Get + SyncLock Task.LockChain + If NextThread Is Nothing Then + If Task.IsUnknownSize Then + Return 1024 * 1024 * 1024 '1G + Else + Return Task.FileSize - 1 + End If + Else + Return NextThread.DownloadStart - 1 + End If + End SyncLock + End Get + End Property + ''' + ''' 线程未下载的文件大小。 + ''' + Public ReadOnly Property DownloadUndone As Long + Get + Return DownloadEnd + 1 - (DownloadStart + DownloadDone) + End Get + End Property + ''' + ''' 线程已下载的文件大小。 + ''' + Public DownloadDone As Long = 0 + + ''' + ''' 上次记速时的时间。 + ''' + Private SpeedLastTime As Long = GetTimeTick() + ''' + ''' 上次记速时的已下载大小。 + ''' + Private SpeedLastDone As Long = 0 + ''' + ''' 当前的下载速度，单位为 Byte / 秒。 + ''' + Public ReadOnly Property Speed As Long + Get + If GetTimeTick() - SpeedLastTime > 200 Then + Dim DeltaTime As Long = GetTimeTick() - SpeedLastTime + _Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000) + SpeedLastDone = DownloadDone + SpeedLastTime += DeltaTime + End If + Return _Speed + End Get + End Property + Private _Speed As Long = 0 + + ''' + ''' 线程初始化时的时间。 + ''' + Public InitTime As Long = GetTimeTick() + ''' + ''' 上次接受到有效数据的时间，-1 表示尚未有有效数据。 + ''' + Public LastReceiveTime As Long = -1 + + ''' + ''' 当前线程的状态。 + ''' + Public State As NetState = NetState.WaitForDownload + ''' + ''' 是否已经结束。 + ''' + Public ReadOnly Property IsEnded As Boolean + Get + Return State = NetState.Finish OrElse State = NetState.Error + End Get + End Property + + ''' + ''' 当前选取的是哪一个 Url。 + ''' + Public Source As NetSource + + End Class + ''' + ''' 下载单个文件。 + ''' + Public Class NetFile + +#Region "属性" + + ''' + ''' 所属的文件列表任务。 + ''' + Public Tasks As New List(Of LoaderDownload) + + ''' + ''' 所有下载源。 + ''' + Public Sources As NetSource() + ''' + ''' 用于在第一个线程出错时切换下载源。 + ''' + Private FirstThreadSource As Integer = 0 + ''' + ''' 所有已经被标记为失败的，但未完整尝试过的，不允许断点续传的下载源。 + ''' + Public SourcesOnce As New List(Of NetSource) + ''' + ''' 获取从某个源开始，第一个可用的源。 + ''' + Private Function GetSource(Optional Id As Integer = 0) As NetSource + If Id >= Sources.Count OrElse Id < 0 Then Id = 0 + SyncLock LockSource + If Not IsSourceFailed(False) Then + '存在多线程可用源 + Dim CurrentSource As NetSource = Sources(Id) + While CurrentSource.IsFailed + Id += 1 + If Id >= Sources.Count Then Id = 0 + CurrentSource = Sources(Id) + End While + Return CurrentSource + ElseIf SourcesOnce.Count > 0 Then + '仅存在单线程可用源 + Return SourcesOnce(0) + Else + '没有可用源 + Return Nothing + End If + End SyncLock + End Function + ''' + ''' 是否已经没有可用源了。 + ''' + Public Function IsSourceFailed(Optional AllowOnceSource As Boolean = True) As Boolean + If AllowOnceSource AndAlso SourcesOnce.Count > 0 Then Return False + SyncLock LockSource + For Each Source As NetSource In Sources + If Not Source.IsFailed Then Return False + Next + End SyncLock + Return True + End Function + + ''' + ''' 存储在本地的带文件名的地址。 + ''' + Public LocalPath As String = Nothing + ''' + ''' 存储在本地的文件名。 + ''' + Public LocalName As String = Nothing + + ''' + ''' 当前的下载状态。 + ''' + Public State As NetState = NetState.WaitForCheck + ''' + ''' 导致下载失败的原因。 + ''' + Public Ex As New List(Of Exception) + '''' + '''' 文件进行整体重试的计数。 + '''' + 'Private RetryCount As Integer = 0 + + ''' + ''' 作为文件组成部分的线程链表。 + ''' + Private Threads As NetThread + + ''' + ''' 文件的总大小。若为 -2 则为未获取，若为 -1 则为无法获取准确大小。 + ''' + Public FileSize As Long = -2 + ''' + ''' 该文件是否无法获取准确大小。 + ''' + Public IsUnknownSize As Boolean = False + ''' + ''' 该文件是否不需要分割。 + ''' + Public ReadOnly Property IsNoSplit As Boolean + Get + Return IsUnknownSize OrElse FileSize < FilePieceLimit + End Get + End Property + ''' + ''' 为不需要分割的小文件进行临时存储。 + ''' + Private SmailFileCache As List(Of Byte) + + ''' + ''' 文件的已下载大小。 + ''' + Public DownloadDone As Long = 0 + Private ReadOnly LockDone As New Object + ''' + ''' 文件的校验规则。 + ''' + Public Check As FileChecker + + ''' + ''' 上次记速时的时间。 + ''' + Private SpeedLastTime As Long = GetTimeTick() + ''' + ''' 上次记速时的已下载大小。 + ''' + Private SpeedLastDone As Long = 0 + ''' + ''' 当前的下载速度，单位为 Byte / 秒。 + ''' + Public ReadOnly Property Speed As Long + Get + If GetTimeTick() - SpeedLastTime > 200 Then + Dim DeltaTime As Long = GetTimeTick() - SpeedLastTime + _Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000) + SpeedLastDone = DownloadDone + SpeedLastTime += DeltaTime + End If + Return _Speed + End Get + End Property + Private _Speed As Long = 0 + + ''' + ''' 该文件是否由本地文件直接拷贝完成。 + ''' + Public IsCopy As Boolean = False + ''' + ''' 本文件的显示进度。 + ''' + Public ReadOnly Property Progress As Double + Get + Select Case State + Case NetState.WaitForCheck + Return 0 + Case NetState.WaitForCopy + Return 0.2 + Case NetState.WaitForDownload + Return 0.01 + Case NetState.Connect + Return 0.02 + Case NetState.Get + Return 0.04 + Case NetState.Download + '正在下载中，对应 5% ~ 99% + Dim OriginalProgress As Double = If(IsUnknownSize, 0.5, DownloadDone / Math.Max(FileSize, 1)) + OriginalProgress = 1 - (1 - OriginalProgress) ^ 0.9 + Return OriginalProgress * 0.94 + 0.05 + Case NetState.Merge + Return 0.99 + Case NetState.Finish, NetState.Error + Return 1 + Case Else + Throw New ArgumentOutOfRangeException("文件状态未知：" & State) + End Select + End Get + End Property + + ''' + ''' 各个线程建立连接成功的总次数。 + ''' + Private ConnectCount As Integer = 0 + ''' + ''' 各个线程建立连接成功的总时间。 + ''' + Private ConnectTime As Long = 0 + ''' + ''' 各个线程建立连接成功的平均时间，单位为毫秒，-1 代表尚未有成功连接。 + ''' + Private ReadOnly Property ConnectAverage As Integer + Get + SyncLock LockCount + Return If(ConnectCount = 0, -1, ConnectTime / ConnectCount) + End SyncLock + End Get + End Property + + Private Const FilePieceLimit As Long = 256 * 1024 + Public ReadOnly RandomCode As Integer = RandomInteger(0, 999999) + Public ReadOnly LockCount As New Object + Public ReadOnly LockState As New Object + Public ReadOnly LockChain As New Object + Public ReadOnly LockSource As New Object + Public ReadOnly LockTasks As New Object + + Private ReadOnly Uuid As Integer = GetUuid() + Public Overrides Function Equals(obj As Object) As Boolean + Dim file = TryCast(obj, NetFile) + Return file IsNot Nothing AndAlso Uuid = file.Uuid + End Function + +#End Region + + ''' + ''' 新建一个需要下载的文件。 + ''' + ''' 包含文件名的本地地址。 + Public Sub New(Urls As String(), LocalPath As String, Optional Check As FileChecker = Nothing) + Dim Sources As New List(Of NetSource) + Dim Count As Integer = 0 + Urls = ArrayNoDouble(Urls) + For Each Source As String In Urls + Sources.Add(New NetSource With {.FailCount = 0, .Url = SecretCdnSign(Source.Replace(vbCr, "").Replace(vbLf, "").Trim), .Id = Count, .IsFailed = False, .Ex = Nothing}) + Count += 1 + Next + Me.Sources = Sources.ToArray + Me.LocalPath = LocalPath + Me.Check = Check + Me.LocalName = GetFileNameFromPath(LocalPath) + End Sub + + ''' + ''' 尝试开始一个新的下载线程。 + ''' + Public Function TryBeginThread() As Boolean + Try + + '条件检测 + If NetTaskThreadCount >= NetTaskThreadLimit OrElse IsSourceFailed() OrElse + (IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return False + If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return False + SyncLock LockState + If State < NetState.Connect Then State = NetState.Connect + End SyncLock + '初始化参数 + Dim StartPosition As Long, StartSource As NetSource = Nothing + Dim Th As Thread, ThreadInfo As NetThread + SyncLock LockChain + + '获取线程起点与下载源 + '不分割 + If IsNoSplit Then GoTo Capture + '单线程 + If IsSourceFailed(False) Then + '确认没有其他线程正使用此点 + If SourcesOnce(0).Thread IsNot Nothing AndAlso SourcesOnce(0).Thread.State <> NetState.Error Then Return False + '占用此点 +Capture: + SmailFileCache = Nothing + Threads = Nothing + NetManager.DownloadDone -= DownloadDone + SyncLock LockDone + DownloadDone = 0 + End SyncLock + SpeedLastDone = 0 + State = NetState.Get + End If + '首个开始点 + If Threads Is Nothing Then + StartPosition = 0 + StartSource = GetSource(FirstThreadSource) + If StartSource Is Nothing Then + '没有可用源了 + Throw New Exception("无可用源，请反馈此问题。") + Else + '有可用源 + FirstThreadSource = StartSource.Id + 1 + GoTo StartThread + End If + End If + '寻找失败点 + For Each Thread As NetThread In Threads + If Thread.State = NetState.Error AndAlso Thread.DownloadUndone > 0 Then + StartPosition = Thread.DownloadStart + Thread.DownloadDone + StartSource = GetSource(Thread.Source.Id + 1) + GoTo StartThread + End If + Next + '是否禁用多线程，以及规定碎片大小 + Dim TargetUrl As String = GetSource().Url + If TargetUrl.Contains("pcl2-server") Then Return False + Dim RealFilePieceLimit = If(TargetUrl.Contains("download.mcbbs.net"), FilePieceLimit * 5, FilePieceLimit) + '寻找最大碎片 + Dim FilePieceMax As NetThread = Threads + For Each Thread As NetThread In Threads + If Thread.DownloadUndone > FilePieceMax.DownloadUndone Then FilePieceMax = Thread + Next + If FilePieceMax Is Nothing OrElse FilePieceMax.DownloadUndone < RealFilePieceLimit Then Return False + StartPosition = FilePieceMax.DownloadEnd - FilePieceMax.DownloadUndone * 0.4 + StartSource = GetSource() + + '开始线程 +StartThread: + If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return False + '构建线程 + Dim ThreadUuid As Integer = GetUuid() + SyncLock LockTasks + If Tasks.Count = 0 Then Return False '由于中断，已没有可用任务 + Th = New Thread(AddressOf Thread) With {.Name = "NetTask " & Tasks(0).Uuid & "/" & Uuid & " Download " & ThreadUuid & "#", .Priority = ThreadPriority.BelowNormal} + End SyncLock + ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload} + '链表处理 + If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then + Threads = ThreadInfo + Else + Dim CurrentChain As NetThread = Threads + While CurrentChain.DownloadEnd <= StartPosition + CurrentChain = CurrentChain.NextThread + End While + ThreadInfo.NextThread = CurrentChain.NextThread + CurrentChain.NextThread = ThreadInfo + End If + + End SyncLock + '开始线程 + SyncLock NetTaskThreadCountLock + NetTaskThreadCount += 1 + End SyncLock + SyncLock LockSource + If IsSourceFailed(False) Then SourcesOnce(0).Thread = ThreadInfo + End SyncLock + Th.Start(ThreadInfo) + Return True + + Catch ex As Exception + Log(ex, "尝试开始下载线程失败（" & If(LocalName, "Nothing") & "）", LogLevel.Hint) + Return False + End Try + End Function + ''' + ''' 每个下载线程执行的代码。 + ''' + Private Sub Thread(Info As NetThread) + If ModeDebug OrElse Info.DownloadStart = 0 Then Log("[Download] " & LocalName & " " & Info.Uuid & "#：开始，起始点 " & Info.DownloadStart & "，" & Info.Source.Url) + Dim HttpRequest As HttpWebRequest + Dim ResultStream As Stream = Nothing + '部分下载源真的特别慢，并且只需要一个请求，例如 Ping 为 20s，如果增长太慢，就会造成类似 2.5s 5s 7.5s 10s 12.5s... 的极大延迟 + '延迟过长会导致某些特别慢的链接迟迟不被掐死，即使 MCBBS 源在 10s 下也会出现类似情况 + Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 6000) * (1 + Info.Source.FailCount), 30000) + Info.State = NetState.Connect + Try + Dim HttpDataCount As Integer = 0 + If SourcesOnce.Contains(Info.Source) AndAlso Not Info.Equals(Info.Source.Thread) Then GoTo SourceBreak + '请求头 + HttpRequest = WebRequest.Create(Info.Source.Url) + If Info.Source.Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then HttpRequest.ProtocolVersion = HttpVersion.Version11 + 'HttpRequest.Proxy = Nothing 'new WebProxy(Ip, Port) + HttpRequest.Timeout = Timeout + HttpRequest.AddRange(Info.DownloadStart) + SecretHeadersSign(Info.Source.Url, HttpRequest) + Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse() + '文件大小校验 + Dim ThreadFileSize = HttpResponse.ContentLength + If ThreadFileSize = -1 Then + If FileSize > 1 Then + Log("[Download] " & LocalName & " " & Info.Uuid & "#：文件大小未知，但已从其他下载源获取，不作处理") + Else + FileSize = -1 : IsUnknownSize = True + Log("[Download] " & LocalName & " " & Info.Uuid & "#：文件大小未知") + End If + ElseIf ThreadFileSize < 0 Then + Throw New Exception("获取片大小失败，结果为 " & ThreadFileSize & "。") + ElseIf Info.IsFirstThread Then + If Check IsNot Nothing Then + If ThreadFileSize < Check.MinSize AndAlso Check.MinSize > 0 Then + Throw New Exception("文件大小不足，获取结果为 " & ThreadFileSize & "，要求至少为 " & Check.MinSize & "。") + End If + If ThreadFileSize <> Check.ActualSize AndAlso Check.ActualSize > 0 Then + Throw New Exception("文件大小不一致，获取结果为 " & ThreadFileSize & "，要求必须为 " & Check.ActualSize & "。") + End If + End If + FileSize = ThreadFileSize : IsUnknownSize = False + Log("[Download] " & LocalName & "：文件大小 " & ThreadFileSize & " B" & "（" & GetString(ThreadFileSize) & "）") + '若文件大小大于 50 M，进行剩余磁盘空间校验 + If ThreadFileSize > 50 * 1024 * 1024 Then + For Each Drive As DriveInfo In DriveInfo.GetDrives + Dim DriveName As String = Drive.Name.First.ToString + Dim RequiredSpace = If(PathTemp.StartsWith(DriveName), ThreadFileSize * 1.1, 0) + + If(LocalPath.StartsWith(DriveName), ThreadFileSize + 5 * 1024 * 1024, 0) + If Drive.TotalFreeSpace < RequiredSpace Then + Throw New Exception(DriveName & " 盘空间不足，无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间，但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" & + If(PathTemp.StartsWith(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存，你可以在设置中调整缓存文件夹的位置。", "")) + End If + Next + End If + ElseIf FileSize < 0 Then + Throw New Exception("非首线程运行时，尚未获取文件大小。") + ElseIf Info.DownloadStart > 0 AndAlso ThreadFileSize = FileSize Then + SyncLock LockSource + If SourcesOnce.Contains(Info.Source) Then + GoTo SourceBreak + Else + SourcesOnce.Add(Info.Source) + End If + End SyncLock + Throw New WebException("该下载源不支持断点续传。") + ElseIf Not FileSize - Info.DownloadStart = ThreadFileSize Then + Throw New WebException("获取到的片大小不一致：线程结果为 " & ThreadFileSize & " B，任务结果为 " & FileSize & "B，起点为 " & Info.DownloadStart & "B。") + End If + Info.State = NetState.Get + SyncLock LockState + If State < NetState.Get Then State = NetState.Get + End SyncLock + '创建缓存文件 + If IsNoSplit Then + Info.Temp = Nothing + SmailFileCache = New List(Of Byte) + Else + Info.Temp = PathTemp & "Download\" & Uuid & "_" & Info.Uuid & "_" & RandomInteger(0, 999999) & ".tmp" + ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read) + End If + '开始下载 + Using HttpStream = HttpResponse.GetResponseStream() + HttpStream.ReadTimeout = Timeout + If Setup.Get("SystemDebugDelay") Then Threading.Thread.Sleep(RandomInteger(50, 3000)) + Dim HttpData As Byte() = New Byte(16384) {} + HttpDataCount = HttpStream.Read(HttpData, 0, 16384) + While (IsUnknownSize OrElse Info.DownloadUndone > 0) AndAlso '判断是否下载完成 + HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Info.Source.IsFailed OrElse Info.Equals(Info.Source.Thread)) + '限速 + While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0 + Threading.Thread.Sleep(16) + End While + Dim RealDataCount As Integer = If(IsUnknownSize, HttpDataCount, Math.Min(HttpDataCount, Info.DownloadUndone)) + SyncLock NetTaskSpeedLimitLeftLock + If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount + End SyncLock + Dim DeltaTime = GetTimeTick() - Info.LastReceiveTime + If DeltaTime > 1000000 Then DeltaTime = 0 '时间刻反转导致出现极大值 + If RealDataCount > 0 Then + '有数据 + If Info.DownloadDone = 0 Then + '第一次接受到数据 + Info.State = NetState.Download + SyncLock LockState + If State < NetState.Download Then State = NetState.Download + End SyncLock + SyncLock LockCount + ConnectCount += 1 + ConnectTime += GetTimeTick() - Info.InitTime + End SyncLock + End If + SyncLock LockCount + Info.Source.FailCount = 0 + SyncLock LockTasks + For Each Task In Tasks + Task.FailCount = 0 + Next + End SyncLock + End SyncLock + NetManager.DownloadDone += RealDataCount + SyncLock LockDone + DownloadDone += RealDataCount + End SyncLock + Info.DownloadDone += RealDataCount + If IsNoSplit Then + If HttpData.Count = RealDataCount Then + SmailFileCache.AddRange(HttpData) + Else + SmailFileCache.AddRange(HttpData.ToList.GetRange(0, RealDataCount)) + End If + Else + ResultStream.Write(HttpData, 0, RealDataCount) + End If + '检查速度是否过慢 + If DeltaTime > 1000 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1s，且速度小于 1K/s + Throw New TimeoutException("由于速度过慢断开链接，下载 " & RealDataCount & " B，消耗 " & DeltaTime & " ms。") + End If + Info.LastReceiveTime = GetTimeTick() + '已完成 + If Info.DownloadUndone = 0 AndAlso Not IsUnknownSize Then Exit While + ElseIf Info.LastReceiveTime > 0 AndAlso DeltaTime > Timeout Then + '无数据，且已超时 + Throw New TimeoutException("操作超时，无数据。") + End If + HttpDataCount = HttpStream.Read(HttpData, 0, 16384) + End While + End Using + End Using +SourceBreak: + If HttpDataCount = 0 AndAlso Info.DownloadUndone > 0 AndAlso Not IsUnknownSize Then + '服务器无返回数据 + Throw New Exception("服务器无返回数据，但下载尚未完成") + ElseIf State = NetState.Error OrElse Info.Source.IsFailed OrElse (Info.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then + '被外部中断 + Info.State = NetState.Error + Log("[Download] " & LocalName & " " & Info.Uuid & "#：中断") + Else + '本线程完成 + Info.State = NetState.Finish + If ModeDebug Then Log("[Download] " & LocalName & " " & Info.Uuid & "#：完成，已下载 " & GetString(Info.DownloadDone)) + End If + Catch ex As Exception + '状态变更 + SyncLock LockCount + Info.Source.FailCount += 1 + SyncLock LockTasks + For Each Task In Tasks + Task.FailCount += 1 + Next + End SyncLock + End SyncLock + Dim IsTimeoutString As String = GetString(ex, False).ToLower.Replace(" ", "") + Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse + IsTimeoutString.Contains("超时") OrElse IsTimeoutString.Contains("timeout") OrElse IsTimeoutString.Contains("timedout") + Log("[Download] " & LocalName & " " & Info.Uuid & If(IsTimeout, "#：超时（" & (Timeout * 0.001) & "s）", "#：出错，" & GetString(ex, False))) + Info.State = NetState.Error + ''使用该下载源的线程是否没有速度 + ''下载超时也会导致没有速度，容易误判下载失败，所以已弃用此方法 + 'Dim IsNoSpeed As Boolean = True + 'SyncLock LockChain + ' If Threads IsNot Nothing Then + ' For Each Thread As NetThread In Threads + ' If Thread.Source.Id = Info.Source.Id AndAlso Thread.Speed > 0 Then + ' IsNoSpeed = False + ' Exit For + ' End If + ' Next + ' End If + 'End SyncLock + Info.Source.Ex = ex + '根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传） + If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(403)") OrElse ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse + (Info.Source.FailCount >= MathRange(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse + Info.Source.FailCount > NetTaskThreadLimit Then + Dim IsThisFail As Boolean = False + SyncLock LockSource + If Info.Source.Thread IsNot Nothing AndAlso Info.Source.Thread.Equals(Info) Then + '单线程下，本线程出错 + SourcesOnce.RemoveAt(0) + GoTo Wrong + ElseIf Not Info.Source.IsFailed Then + '多线程下，本线程出错 +Wrong: + Info.Source.IsFailed = True + IsThisFail = True + End If + End SyncLock + '本线程引发下载源被禁用 + If IsThisFail Then + Log("[Download] " & LocalName & " " & Uuid & "#：下载源被禁用（" & Info.Source.Id & "）：" & Info.Source.Url) + Log(ex, "下载源 " & Info.Source.Id & " 已被禁用", If(ex.Message.Contains("不支持断点续传") OrElse ex.Message.Contains("404") OrElse ex.Message.Contains("416"), LogLevel.Developer, LogLevel.Debug)) + If IsSourceFailed() Then + '没有可用源 + Log("[Download] 文件 " & LocalName & " 已无可用下载源") + Dim ExampleEx As Exception = Nothing + SyncLock LockSource + For Each Source As NetSource In Sources + Log("[Download] 已禁用的下载源：" & Source.Url) + If Source.Ex IsNot Nothing Then + ExampleEx = Source.Ex + Log(Source.Ex, "下载源禁用原因", LogLevel.Developer) + End If + Next + End SyncLock + Fail(ExampleEx) + ElseIf ex.Message.Contains("空间不足") Then + '没有空间 + Fail(ex) + End If + End If + End If + '首线程错误 + If FileSize = -2 Then + SyncLock LockChain + Threads = Nothing + End SyncLock + End If + Finally + If ResultStream IsNot Nothing Then ResultStream.Dispose() + SyncLock NetTaskThreadCountLock + NetTaskThreadCount -= 1 + End SyncLock + If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge() + End Try + End Sub + + '下载文件的最终收束事件 + ''' + ''' 下载完成。合并文件。 + ''' + Private Sub Merge() + '状态判断 + SyncLock LockState + If State < NetState.Merge Then + State = NetState.Merge + Else + Exit Sub + End If + End SyncLock + Dim RetryCount As Integer = 0 + Dim MergeFile As Stream = Nothing, AddWriter As BinaryWriter = Nothing + Try +Retry: + SyncLock LockChain + ''大小检测 + 'If DownloadDone <> FileSize AndAlso Not IsUnknownSize Then + ' For Each Th As NetThread In Threads + ' Log("[Download] " & "File size detail: ") + ' Log("[Download] " & Th.Uuid & "#, State " & GetStringFromEnum(CType(Th.State, [Enum])) & ", Range " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & ", Left " & Th.DownloadUndone) + ' Next + ' Throw New Exception("文件大小应为 " & FileSize & " B，实际下载为 " & DownloadDone & " B。") + 'End If + If ModeDebug Then Log("[Download] " & LocalName & "：正在合并文件") + '创建文件夹 + If File.Exists(LocalPath) Then File.Delete(LocalPath) + Dim Info As New FileInfo(LocalPath) + Info.Directory.Create() + '合并文件 + If IsNoSplit Then + '仅有一个线程，从缓存中输出 + MergeFile = New FileStream(LocalPath, FileMode.Create) + AddWriter = New BinaryWriter(MergeFile) + AddWriter.Write(SmailFileCache.ToArray) + AddWriter.Dispose() : AddWriter = Nothing + MergeFile.Dispose() : MergeFile = Nothing + ElseIf Threads.DownloadDone = DownloadDone Then + '仅有一个文件，直接复制 + File.Copy(Threads.Temp, LocalPath, True) + Else + '有多个线程，合并 + MergeFile = New FileStream(LocalPath, FileMode.Create) + AddWriter = New BinaryWriter(MergeFile) + For Each Thread As NetThread In Threads + If Thread.DownloadDone = 0 Then Continue For + Using fs As New FileStream(Thread.Temp, FileMode.Open, FileAccess.Read, FileShare.Read) + Dim TempReader As New BinaryReader(fs) + AddWriter.Write(TempReader.ReadBytes(fs.Length)) + TempReader.Close() + End Using + Next + AddWriter.Dispose() : AddWriter = Nothing + MergeFile.Dispose() : MergeFile = Nothing + End If + '写入大小要求 + If Not IsUnknownSize AndAlso Check IsNot Nothing Then + If Check.ActualSize = -1 Then + Check.ActualSize = FileSize + ElseIf Check.ActualSize <> FileSize Then + Throw New Exception("文件大小不一致：任务要求为 " & Check.ActualSize & " B，网络获取结果为 " & FileSize & "B") + End If + End If + '检查文件 + Dim CheckResult As String = Check?.Check(LocalPath) + If CheckResult IsNot Nothing Then + Log("[Download] " & "File size detail of " & Uuid & "# :") + For Each Th As NetThread In Threads + Log("[Download] " & Th.Uuid & "#, State " & GetStringFromEnum(CType(Th.State, [Enum])) & ", Range " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & ", Left " & Th.DownloadUndone) + Next + Throw New Exception(CheckResult) + End If + '后处理 + If IsNoSplit Then + SmailFileCache = Nothing + Else + For Each Thread As NetThread In Threads + If Thread.Temp IsNot Nothing Then File.Delete(Thread.Temp) + Next + End If + Finish() + End SyncLock + Catch ex As Exception + Log(ex, "合并文件出错（" & LocalName & "）") + If MergeFile IsNot Nothing Then + MergeFile.Dispose() : MergeFile = Nothing + End If + If AddWriter IsNot Nothing Then + AddWriter.Dispose() : AddWriter = Nothing + End If + '重试 + If RetryCount <= 3 Then + Threading.Thread.Sleep(RandomInteger(500, 1000)) + RetryCount += 1 + GoTo Retry + End If + Fail(ex) + End Try + End Sub + ''' + ''' 下载失败。 + ''' + Private Sub Fail(Optional RaiseEx As Exception = Nothing) + SyncLock LockState + If State >= NetState.Finish Then Exit Sub + If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx) + '凉凉 + State = NetState.Error + End SyncLock + Try + If File.Exists(LocalPath) Then File.Delete(LocalPath) + Catch + End Try + SyncLock NetManager.LockRemain + NetManager.FileRemain -= 1 + Log("[Download] " & LocalName & "：已失败，剩余文件 " & NetManager.FileRemain) + 'If NetManage.FileRemainList.Contains(LocalPath) Then + ' NetManage.FileRemainList.Remove(LocalPath) + 'Else + ' Log("ERROR " & LocalPath) + 'End If + End SyncLock + For Each Task In Tasks + Task.OnFileFail(Me) + Next + End Sub + ''' + ''' 下载中断。 + ''' + Public Sub Abort(CausedByTask As LoaderDownload) + '确认任务移除 + SyncLock LockTasks + Tasks.Remove(CausedByTask) + If Tasks.Count > 0 Then Exit Sub + End SyncLock + '确认中断 + SyncLock LockState + If State >= NetState.Finish Then Exit Sub + State = NetState.Error + End SyncLock + SyncLock NetManager.LockRemain + NetManager.FileRemain -= 1 + If ModeDebug Then Log("[Download] " & LocalName & "：已取消，剩余文件 " & NetManager.FileRemain) + 'If NetManage.FileRemainList.Contains(LocalPath) Then + ' NetManage.FileRemainList.Remove(LocalPath) + 'Else + ' Log("ERROR " & LocalPath) + 'End If + End SyncLock + End Sub + + '状态改变接口 + ''' + ''' 将该文件设置为已下载完成。 + ''' + Public Sub Finish(Optional PrintLog As Boolean = True) + SyncLock LockState + If State >= NetState.Finish Then Exit Sub + State = NetState.Finish + End SyncLock + SyncLock NetManager.LockRemain + NetManager.FileRemain -= 1 + If PrintLog Then Log("[Download] " & LocalName & "：已完成，剩余文件 " & NetManager.FileRemain) + 'If NetManage.FileRemainList.Contains(LocalPath) Then + ' NetManage.FileRemainList.Remove(LocalPath) + 'Else + ' Log("ERROR " & LocalPath) + 'End If + End SyncLock + SyncLock LockTasks + For Each Task In Tasks + Task.OnFileFinish(Me) + Next + End SyncLock + End Sub + + End Class + ''' + ''' 下载一系列文件的加载器。 + ''' + Public Class LoaderDownload + Inherits LoaderBase + +#Region "属性" + + ''' + ''' 需要下载的文件。 + ''' + Public Files As List(Of NetFile) + Private ReadOnly FilesLock As New Object + ''' + ''' 剩余未完成的文件数。（用于减轻 FilesLock 的占用） + ''' + Private FileRemain As Integer + Private ReadOnly FileRemainLock As New Object + + ''' + ''' 用于显示的百分比进度。 + ''' + Public Overrides Property Progress As Double + Get + If State >= LoadState.Finished Then Return 1 + If Files.Count = 0 Then Return 0 '必须返回 0，否则在获取列表的时候会错觉已经下载完了 + Return _Progress + End Get + Set(value As Double) + Throw New Exception("文件下载不允许指定进度") + End Set + End Property + Private _Progress As Double = 0 + + ''' + ''' 任务中的文件的连续失败计数。 + ''' + Public Property FailCount As Integer + Get + Return _FailCount + End Get + Set(value As Integer) + _FailCount = value + If State = LoadState.Loading AndAlso value >= Math.Min(2000, Math.Max(FileRemain * 5.5, NetTaskThreadLimit * 5.5 + 3)) Then + Log("[Download] 由于同加载器中失败次数过多引发强制失败：连续失败了 " & value & " 次", LogLevel.Debug) + On Error Resume Next + Dim ExList As New List(Of Exception) + SyncLock FilesLock + For Each File In Files + For Each Source In File.Sources + If Source.Ex IsNot Nothing Then + ExList.Add(Source.Ex) + If ExList.Count > 10 Then GoTo FinishExCatch + End If + Next + Next + End SyncLock +FinishExCatch: + OnFail(ExList) + End If + End Set + End Property + Private _FailCount As Integer = 0 + +#End Region + + ''' + ''' 刷新公开属性。由 NetManager 每 0.2 秒调用一次。 + ''' + Public Sub RefreshStat() + '计算进度 + Dim NewProgress As Double = 0 + Dim TotalProgress As Double = 0 + SyncLock FilesLock + For Each File In Files + If File.IsCopy Then + NewProgress += File.Progress * 0.2 + TotalProgress += 0.2 + Else + NewProgress += File.Progress '* If(File.Progress < 1, 0.9, 1) + TotalProgress += 1 + End If + Next + End SyncLock + If TotalProgress > 0 Then NewProgress /= TotalProgress + '刷新进度 + If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 1 - (1 - NewProgress) ^ 0.9 'MathBezier(NewProgress, 0, 0.05, 1, 0.8, 0.0001) + _Progress = NewProgress * 0.99 + 0.01 + End Sub + + Public Sub New(Name As String, FileTasks As List(Of NetFile)) + Me.Name = Name + Files = FileTasks + End Sub + Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) + SyncLock FilesLock + If Input IsNot Nothing Then Files = Input + '去重 + Dim ResultArray As New List(Of NetFile) + For i = 0 To Files.Count - 1 + For ii = i + 1 To Files.Count - 1 + If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement + Next + ResultArray.Add(Files(i)) +NextElement: + Next i + Files = ResultArray + '设置剩余文件数 + SyncLock FileRemainLock + For Each File In Files + If File.State <> NetState.Finish Then FileRemain += 1 + Next + End SyncLock + End SyncLock + State = LoadState.Loading + '开始执行 + RunInNewThread(Sub() + Try + '输入检测 + If Files.Count = 0 Then + OnFinish() + Exit Sub + End If + For Each File As NetFile In Files + If File Is Nothing Then Throw New ArgumentException("存在空文件请求！") + For Each Source As NetSource In File.Sources + If Not (Source.Url.ToLower.StartsWith("https://") OrElse Source.Url.ToLower.StartsWith("http://")) Then + Source.Ex = New ArgumentException("输入的下载链接不正确！") + Source.IsFailed = True + End If + Next + If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确！") + If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确！") + If File.LocalPath.EndsWith("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径！") + '文件夹检测 + Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName + If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath) + Next + '接入下载管理器 + NetManager.Start(Me) + '将文件分配给多个线程以进行已存在查找 + Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表 + Dim FoldersFinal As New List(Of String) '最终用于查找的列表 + If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制 + Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里 + For Each Folder In McFolderList + Folders.Add(Folder.Path) + Next + Folders = ArrayNoDouble(Folders) + For Each Folder In Folders + If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder) + Next + End If + '最多 5 个线程，最少每个线程分配 10 个文件 + SyncLock FilesLock + Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1) + Dim FilesInThread As New List(Of NetFile) + For Each File In Files + FilesInThread.Add(File) + If FilesInThread.Count = FilesPerThread Then + Dim FilesToRun As New List(Of NetFile) + FilesToRun.AddRange(FilesInThread) + RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid) + FilesInThread.Clear() + End If + Next + If FilesInThread.Count > 0 Then + Dim FilesToRun As New List(Of NetFile) + FilesToRun.AddRange(FilesInThread) + RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid) + FilesInThread.Clear() + End If + End SyncLock + Catch ex As Exception + OnFail(New List(Of Exception) From {ex}) + End Try + End Sub, "NetTask " & Uuid & " Main") + End Sub + Private Sub StartCopy(Files As List(Of NetFile), FolderList As List(Of String)) + Try + If ModeDebug Then Log("[Download] 检查线程分配文件数：" & Files.Count) + '试图从已存在的 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.StartsWith(PathMcFolder) Then + Dim Relative = File.LocalPath.Replace(PathMcFolder, "") + For Each Folder In FolderList + Dim Target = Folder & Relative + If File.Check.Check(Target) Is Nothing Then + ExistFilePath = Target + Exit For + End If + Next + End If + '若存在，则改变状态 + SyncLock LockState + If ExistFilePath IsNot Nothing Then + File.State = NetState.WaitForCopy + File.IsCopy = True + ExistFiles.Add(New KeyValuePair(Of NetFile, String)(File, ExistFilePath)) + Else + File.State = NetState.WaitForDownload + File.IsCopy = False + End If + End SyncLock + Next + '复制已存在的文件 + For Each FileToken In ExistFiles + Dim File As NetFile = FileToken.Key + Dim LocalPath As String = FileToken.Value + Dim RetryCount As Integer = 0 +Retry: + Try + Log("[Download] 复制已存在的文件（" & LocalPath & "）") + FileIO.FileSystem.CopyFile(LocalPath, File.LocalPath, True) + File.Finish(False) + Catch ex As Exception + RetryCount += 1 + Log(ex, String.Format("复制已存在的文件失败，重试第 {2} 次（{0} -> {1}）", LocalPath, File.LocalPath, RetryCount)) + If RetryCount < 3 Then + Thread.Sleep(200) + GoTo Retry + End If + File.State = NetState.WaitForDownload + File.IsCopy = False + End Try + Next + Catch ex As Exception + Log(ex, "下载已存在文件查找失败", LogLevel.Feedback) + End Try + End Sub + + Public Sub OnFileFinish(File As NetFile) + '要求全部文件完成 + SyncLock FileRemainLock + FileRemain -= 1 + If FileRemain > 0 Then Exit Sub + End SyncLock + OnFinish() + End Sub + Public Sub OnFinish() + RaisePreviewFinish() + SyncLock LockState + If State > LoadState.Loading Then Exit Sub + State = LoadState.Finished + End SyncLock + End Sub + Public Sub OnFileFail(File As NetFile) + '将下载源的错误加入主错误列表 + For Each Source In File.Sources + If Not IsNothing(Source.Ex) Then File.Ex.Add(Source.Ex) + Next + OnFail(File.Ex) + End Sub + Public Sub OnFail(ExList As List(Of Exception)) + SyncLock LockState + If State > LoadState.Loading Then Exit Sub + If ExList Is Nothing OrElse ExList.Count = 0 Then ExList = New List(Of Exception) From {New Exception("未知错误！")} + [Error] = ExList(0) + '获取实际失败的文件 + SyncLock FilesLock + For Each File In Files + If File.State = NetState.Error Then + [Error] = New Exception("文件下载失败：" & File.LocalPath & "（第一下载源：" & File.Sources(0).Url & "）", ExList(0)) + Exit For + End If + Next + End SyncLock + '在设置 Error 对象后再更改为失败，避免 WaitForExit 无法捕获错误 + State = LoadState.Failed + End SyncLock + '中断所有文件 + SyncLock FilesLock + For Each TaskFile In Files + If TaskFile.State < NetState.Merge Then TaskFile.State = NetState.Error + Next + End SyncLock + '在退出同步锁后再进行日志输出 + Dim ErrOutput As New List(Of String) + For Each Ex As Exception In ExList + ErrOutput.Add(GetString(Ex, False)) + Next + Log("[Download] " & Join(ArrayNoDouble(ErrOutput.ToArray), vbCrLf)) + End Sub + Public Overrides Sub Abort() + SyncLock LockState + If State >= LoadState.Finished Then Exit Sub + State = LoadState.Aborted + End SyncLock + Log("[Download] " & Name & " 已取消！") + '中断所有文件 + SyncLock FilesLock + For Each TaskFile In Files + TaskFile.Abort(Me) + Next + End SyncLock + End Sub + + End Class + + Public NetManager As New NetManagerClass + ''' + ''' 下载文件管理。 + ''' + Public Class NetManagerClass + +#Region "属性" + + ''' + ''' 需要下载的文件。为“本地地址 - 文件对象”键值对。 + ''' + Public Files As New Dictionary(Of String, NetFile) + Public ReadOnly LockFiles As New Object + + ''' + ''' 当前的所有下载任务。 + ''' + Public Tasks As New List(Of LoaderDownload) + Private ReadOnly LockTasks As New Object + + ''' + ''' 已下载完成的大小。 + ''' + Public Property DownloadDone As Long + Get + Return _DownloadDone + End Get + Set(value As Long) + SyncLock LockDone + _DownloadDone = value + End SyncLock + End Set + End Property + Private _DownloadDone As Long = 0 + Private ReadOnly LockDone As New Object + + + ''' + ''' 尚未完成下载的文件数。 + ''' + Public FileRemain As Integer = 0 + Public ReadOnly LockRemain As New Object + + ''' + ''' 上次记速时的已下载大小。 + ''' + Private SpeedLastDone As Long = 0 + ''' + ''' 最近 10 次下载速度的记录，较新的在后面。间隔为 0.2 秒，故记录了 2 秒的速度。 + ''' + Public SpeedLast As New List(Of Long) From {0, 0, 0, 0, 0, 0, 0, 0, 0, 0} + '这些属性由 RefreshStat 刷新 + ''' + ''' 当前的全局下载速度，单位为 Byte / 秒。 + ''' + Public Speed As Long = 0 + + Public ReadOnly Uuid As Integer = GetUuid() + +#End Region + + ''' + ''' 进度与下载速度由下载管理线程每隔约 0.2 秒刷新一次。 + ''' + Private Sub RefreshStat() + Try + Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast + RefreshStatLast += DeltaTime +#Region "刷新整体速度" + '计算即时速度 + Dim ActualSpeed As Double = Math.Max(0, (DownloadDone - SpeedLastDone) / (DeltaTime / 1000)) + SpeedLast.Add(ActualSpeed) + SpeedLast.RemoveAt(0) + SpeedLastDone = DownloadDone + '计算用于显示的速度 + 'If SpeedLast(9) = 0 Then + ' Speed = 0 + 'Else + Speed = (SpeedLast(9) + SpeedLast(8) * 0.9 + SpeedLast(7) * 0.8 + SpeedLast(6) * 0.7 + SpeedLast(5) * 0.6 + SpeedLast(4) * 0.5 + SpeedLast(3) * 0.4 + SpeedLast(2) * 0.3 + SpeedLast(1) * 0.2 + SpeedLast(0) * 0.1) / 5.5 + 'End If + '计算新的速度下限 + SpeedLast.Add(ActualSpeed) + SpeedLast.RemoveAt(0) + Dim Limit As Long = Math.Min(Math.Min(Math.Min(Math.Min(SpeedLast(5), SpeedLast(6)), SpeedLast(7)), SpeedLast(8)), SpeedLast(9)) * 0.9 + If Limit > NetTaskSpeedLimitLow Then + NetTaskSpeedLimitLow = Limit + Log("[Download] " & "速度下限已提升到 " & GetString(Limit)) + End If +#End Region +#Region "刷新下载任务属性" + SyncLock LockTasks + For Each Task In Tasks + Task.RefreshStat() + Next + End SyncLock +#End Region + Catch ex As Exception + Log(ex, "刷新下载公开属性失败") + End Try + End Sub + Private RefreshStatLast As Long + + ''' + ''' 启动监控线程，用于新增下载线程。 + ''' + Private Sub StartManager() + If IsManagerStarted Then Exit Sub + IsManagerStarted = True + RunInNewThread(Sub() + Try + Dim LastLoopTime As Long + While True + LastLoopTime = GetTimeTick() + '若已完成，则清空 + If FileRemain = 0 AndAlso Files.Count > 0 Then + SyncLock LockFiles + Files.Clear() + End SyncLock + End If + '开启新线程 + If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then + '速度小于下限或剩余文件还贼多，尝试开启线程 + Dim IsSuccess As Boolean = False + Dim NewThreadCount As Integer + '确定最大线程追加数 + NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4)) + NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半 + NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit) + '循环追加 + Do + IsSuccess = False + '启动 Wait 的文件后立即会变成 Connect，导致第二次循环再次调用，所以需要先暂时存储进去…… + '此外为了减少 LockFiles 的占用时间，所以先遍历列表再开始 + Dim FilesWaiting As New List(Of NetFile) + Dim FilesLoading As New List(Of NetFile) + SyncLock LockFiles + For Each File As NetFile In Files.Values + If File.RandomCode Mod 2 = 0 Then Continue For + If File.State = NetState.WaitForDownload Then + FilesWaiting.Add(File) + ElseIf File.State < NetState.Merge Then + FilesLoading.Add(File) + End If + Next + End SyncLock + '为文件列表中的文件开始线程 + For Each File As NetFile In FilesWaiting + If NewThreadCount = 0 Then Exit For + If File.TryBeginThread() Then + IsSuccess = True + NewThreadCount -= 1 + End If + Next + For Each File As NetFile In FilesLoading + If NewThreadCount = 0 Then Exit For + If File.TryBeginThread() Then + IsSuccess = True + NewThreadCount -= 1 + End If + Next + Loop While NewThreadCount > 0 AndAlso IsSuccess + End If + '等待直至 120 ms + Do While GetTimeTick() - LastLoopTime < 120 + Thread.Sleep(10) + Loop + End While + Catch ex As Exception + Log(ex, "下载管理启动线程 1 出错", LogLevel.Assert) + End Try + End Sub, "NetManager ThreadStarter Single") + RunInNewThread(Sub() + Try + Dim LastLoopTime As Long + While True + LastLoopTime = GetTimeTick() + '开启新线程 + If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then + '速度小于下限或剩余文件还贼多，尝试开启线程 + Dim IsSuccess As Boolean = False + Dim NewThreadCount As Integer + '确定最大线程追加数 + NewThreadCount = Math.Max(FileRemain, MathRange(NetTaskThreadCount / 2, 1, 4)) + NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半 + NewThreadCount = MathRange(NewThreadCount, 1, NetTaskThreadLimit) + '循环追加 + Do + IsSuccess = False + '启动 Wait 的文件后立即会变成 Connect，导致第二次循环再次调用，所以需要先暂时存储进去…… + '此外为了减少 LockFiles 的占用时间，所以先遍历列表再开始 + Dim FilesWaiting As New List(Of NetFile) + Dim FilesLoading As New List(Of NetFile) + SyncLock LockFiles + For Each File As NetFile In Files.Values + If File.RandomCode Mod 2 = 1 Then Continue For + If File.State = NetState.WaitForDownload Then + FilesWaiting.Add(File) + ElseIf File.State < NetState.Merge Then + FilesLoading.Add(File) + End If + Next + End SyncLock + '为文件列表中的文件开始线程 + For Each File As NetFile In FilesWaiting + If NewThreadCount = 0 Then Exit For + If File.TryBeginThread() Then + IsSuccess = True + NewThreadCount -= 1 + End If + Next + For Each File As NetFile In FilesLoading + If NewThreadCount = 0 Then Exit For + If File.TryBeginThread() Then + IsSuccess = True + NewThreadCount -= 1 + End If + Next + Loop While NewThreadCount > 0 AndAlso IsSuccess + End If + '等待直至 120 ms + Do While GetTimeTick() - LastLoopTime < 120 + Thread.Sleep(10) + Loop + End While + Catch ex As Exception + Log(ex, "下载管理启动线程 2 出错", LogLevel.Assert) + End Try + End Sub, "NetManager ThreadStarter Odd") + RunInNewThread(Sub() + Try + Dim LastLoopTime As Long + NetTaskSpeedLimitLeftLast = GetTimeTick() + While True + Dim TimeNow = GetTimeTick() + LastLoopTime = TimeNow + '增加限速余量 + If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast) + NetTaskSpeedLimitLeftLast = TimeNow + '刷新公开属性 + RefreshStat() + '等待直至 170 ms + Do While GetTimeTick() - LastLoopTime < 170 + Thread.Sleep(10) + Loop + End While + Catch ex As Exception + Log(ex, "下载管理刷新线程出错", LogLevel.Assert) + End Try + End Sub, "NetManager StatRefresher") + End Sub + Private IsManagerStarted As Boolean = False + + 'Public FileRemainList As New List(Of String) + Private IsDownloadCacheCleared As Boolean = False + ''' + ''' 开始一个下载任务。 + ''' + Public Sub Start(Task As LoaderDownload) + StartManager() + '清理缓存 + If Not IsDownloadCacheCleared Then + Try + DeleteDirectory(PathTemp & "Download") + Catch ex As Exception + Log(ex, "清理下载缓存失败") + End Try + IsDownloadCacheCleared = True + End If + Directory.CreateDirectory(PathTemp & "Download") + '文件处理 + SyncLock LockFiles + '添加每个文件 + For i = 0 To Task.Files.Count - 1 + Dim File = Task.Files(i) + If Files.ContainsKey(File.LocalPath) Then + '已有该文件 + If Files(File.LocalPath).State >= NetState.Finish Then + '该文件已经下载过一次，且下载完成 + '将已下载的文件替换成当前文件，重新下载 + SyncLock File.LockTasks + File.Tasks.Add(Task) + End SyncLock + Files(File.LocalPath) = File + SyncLock LockRemain + FileRemain += 1 + If ModeDebug Then Log("[Download] " & File.LocalName & "：已替换列表，剩余文件 " & FileRemain) + 'FileRemainList.Add(File.LocalPath) + End SyncLock + Else + '该文件正在下载中 + '将当前文件替换成下载中的文件，即两个任务指向同一个文件 + File = Files(File.LocalPath) + SyncLock File.LockTasks + File.Tasks.Add(Task) + End SyncLock + End If + Else + '没有该文件 + SyncLock File.LockTasks + File.Tasks.Add(Task) + End SyncLock + Files.Add(File.LocalPath, File) + SyncLock LockRemain + FileRemain += 1 + If ModeDebug Then Log("[Download] " & File.LocalName & "：已加入列表，剩余文件 " & FileRemain) + 'FileRemainList.Add(File.LocalPath) + End SyncLock + End If + Task.Files(i) = File '回设 + Next + End SyncLock + SyncLock LockTasks + Tasks.Add(Task) + End SyncLock + End Sub + + End Class + + ''' + ''' 是否有正在进行中、需要在下载管理页面显示的下载任务？ + ''' + Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean + SyncLock LoaderTaskbarLock + For Each Task In LoaderTaskbar + If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso + (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then + Return True + End If + Next + End SyncLock + Return False + End Function + +End Module diff --git a/Plain Craft Launcher 2/Modules/Base/ModValidate.vb b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb new file mode 100644 index 0000000..8d9b118 --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb @@ -0,0 +1,315 @@ +'提供不同的输入验证方法，名称以 Validate 开头 + +''' +''' 输入验证规则基类。要查看所有的输入验证规则，可在输入 Validate 后查看自动补全。 +''' +Public MustInherit Class Validate + ''' + ''' 验证某字符串是否符合验证要求。若符合，返回空字符串；若不符合，返回错误原因。 + ''' + Public MustOverride Function Validate(Str As String) As String +End Class + +''' +''' 若为空则直接通过检查。 +''' +Public Class ValidateNullable + Inherits Validate + Public Overrides Function Validate(Str As String) As String + If IsNothing(Str) OrElse String.IsNullOrEmpty(Str) Then Return Nothing + Return "" + End Function +End Class + +''' +''' 不能为 Nothing 或空字符串（不包括全空格检查）。 +''' +Public Class ValidateNullOrEmpty + Inherits Validate + Public Overrides Function Validate(Str As String) As String + If IsNothing(Str) OrElse String.IsNullOrEmpty(Str) Then Return "输入内容不能为空！" + Return "" + End Function +End Class + +''' +''' 不能为 Nothing 或空字符串（包括全空格检查）。 +''' +Public Class ValidateNullOrWhiteSpace + Inherits Validate + Public Overrides Function Validate(Str As String) As String + If IsNothing(Str) OrElse String.IsNullOrWhiteSpace(Str) Then Return "输入内容不能为空！" + Return "" + End Function +End Class + +''' +''' 必须满足正则表达式。 +''' +Public Class ValidateRegex + Inherits Validate + Public Property Regex As String + Public Property ErrorDescription As String = "" + Public Sub New() + End Sub '用于 XAML 初始化 + Public Sub New(Regex As String, Optional ErrorDescription As String = "") + Me.Regex = Regex + Me.ErrorDescription = ErrorDescription + End Sub + Public Overrides Function Validate(Str As String) As String + If Not RegexCheck(Str, Regex) Then Return ErrorDescription + Return "" + End Function +End Class + +''' +''' 必须是一个完整网址。 +''' +Public Class ValidateHttp + Inherits Validate + Public Sub New() + End Sub '用于 XAML 初始化 + Public Overrides Function Validate(Str As String) As String + If Str.EndsWith("/") Then Str = Str.Substring(0, Str.Length - 1) + If Not RegexCheck(Str, "^(http[s]?)\://") Then Return "输入的网址无效！" + Return "" + End Function +End Class + +''' +''' 必须为整数。 +''' +Public Class ValidateInteger + Inherits Validate + Public Property Min As Integer + Public Property Max As Integer = Integer.MaxValue + Public Sub New() + End Sub '用于 XAML 初始化 + Public Sub New(Min As Integer, Max As Integer) + Me.Min = Min + Me.Max = Max + End Sub + Public Overrides Function Validate(Str As String) As String + If Str.Length > 9 Then Return "请输入一个大小合理的数字！" + Dim Valed As Integer = Val(Str) + If Valed.ToString <> Str Then Return "请输入一个整数！" + If Val(Str) > Max Then Return "不可超过 " & Max & "！" + If Val(Str) < Min Then Return "不可低于 " & Min & "！" + Return "" + End Function +End Class + +''' +''' 长度限制。 +''' +Public Class ValidateLength + Inherits Validate + Public Property Min As Integer = 0 + Public Property Max As Integer = Integer.MaxValue + Public Sub New() + End Sub '用于 XAML 初始化 + Public Sub New(Min As Integer, Optional Max As Integer = Integer.MaxValue) + Me.Min = Min + 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 & " 个字符！" + Return "" + End Function +End Class + +''' +''' 不能包含某些特定字符串。忽略大小写。 +''' +Public Class ValidateExcept + Inherits Validate + Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String) + Public Property ErrorMessage As String + Public Sub New() + ErrorMessage = "输入内容不能包含 %！" + End Sub '用于 XAML 初始化 + 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 = "输入内容不能包含 %！") + Me.Excepts = New ObjectModel.Collection(Of String) + Me.ErrorMessage = ErrorMessage + For Each Data As String In Excepts + Me.Excepts.Add(Data) + Next + End Sub + Public Overrides Function Validate(Str As String) As String + For Each Ch As String In Excepts + If Str.IndexOf(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then + If IsNothing(ErrorMessage) Then ErrorMessage = "" + Return ErrorMessage.Replace("%", Ch) + End If + Next + Return "" + End Function + +End Class + +''' +''' 不能与某些特定字符串相同。 +''' +Public Class ValidateExceptSame + Inherits Validate + Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String) + Public Property ErrorMessage As String + Public Property 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) + Me.Excepts = New ObjectModel.Collection(Of String) + For Each Data As String In Excepts + Me.Excepts.Add(Data) + Next + Me.ErrorMessage = ErrorMessage + Me.IgnoreCase = IgnoreCase + End Sub + Public Overrides Function Validate(Str As String) As String + If Str Is Nothing Then Return ErrorMessage.Replace("%", "null") + For Each Ch As String In Excepts + If IgnoreCase Then + If Str.ToLower = Ch.ToLower Then Return ErrorMessage.Replace("%", Ch) + Else + If Str.Equals(Ch) Then Return ErrorMessage.Replace("%", Ch) '使用 = 不确定是否会忽略大小写 + End If + Next + Return "" + End Function + +End Class + +''' +''' 对文件夹名的粗略的特化检测。 +''' +Public Class ValidateFolderName + Inherits Validate + Public Property Path As String + Public Property UseMinecraftCharCheck As Boolean = True + Public Property IgnoreCase As Boolean = True + Private ReadOnly PathIgnore As IEnumerable(Of DirectoryInfo) + Public Sub New(Path As String, Optional UseMinecraftCharCheck As Boolean = True, Optional IgnoreCase As Boolean = True) + Me.Path = Path + Me.IgnoreCase = IgnoreCase + Me.UseMinecraftCharCheck = UseMinecraftCharCheck + On Error Resume Next + PathIgnore = New DirectoryInfo(Path).EnumerateDirectories + End Sub + Public Overrides Function Validate(Str As String) As String + Try + '检查是否为空 + Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str) + If Not LengthCheck = "" Then Return LengthCheck + '检查空格 + If Str.StartsWith(" ") Then Return "文件夹名不能以空格开头！" + If Str.EndsWith(" ") Then Return "文件夹名不能以空格结尾！" + '检查长度 + LengthCheck = New ValidateLength(1, 100).Validate(Str) + If Not LengthCheck = "" Then Return LengthCheck + '检查尾部小数点 + If Str.EndsWith(".") Then Return "文件夹名不能以小数点结尾！" + '检查特殊字符 + Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符！").Validate(Str) + If Not 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"}, "文件夹名不可为 %！").Validate(Str) + If Not InvalidStrCheck = "" Then Return InvalidStrCheck + '检查文件夹重名 + Dim Arr As New List(Of String) + If PathIgnore IsNot Nothing Then + For Each Folder As DirectoryInfo In PathIgnore + Arr.Add(Folder.Name) + Next + End If + Dim SameNameCheck = New ValidateExceptSame(Arr, "不可与现有文件夹重名！", IgnoreCase).Validate(Str) + If Not SameNameCheck = "" Then Return SameNameCheck + Return "" + Catch ex As Exception + Log(ex, "检查文件夹名出错") + Return "错误：" & ex.Message + End Try + End Function +End Class + +''' +''' 要求输入一个可用的文件夹路径。 +''' +Public Class ValidateFolderPath + Inherits Validate + Public Property UseMinecraftCharCheck As Boolean = True + Public Sub New() + End Sub + Public Sub New(UseMinecraftCharCheck As Boolean) + Me.UseMinecraftCharCheck = UseMinecraftCharCheck + End Sub + Public Overrides Function Validate(Str As String) As String + '去除尾部斜线，统一为 \ + Str = Str.Replace("/", "\") + If Not Str.TrimEnd("\").EndsWith(":") Then Str = Str.TrimEnd("\") + '检查是否为空 + Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str) + If Not LengthCheck = "" Then Return LengthCheck + '检查长度 + LengthCheck = New ValidateLength(1, 254).Validate(Str) + If Not LengthCheck = "" Then Return LengthCheck + '检查开头 + If Str.StartsWith("\\Mac\") Then GoTo Fin + For Each Drive As DriveInfo In My.Computer.FileSystem.Drives + If Str.ToUpper = Drive.Name Then Return "" + If Str.ToUpper.StartsWith(Drive.Name) Then GoTo Fin + Next + Return "文件夹路径头存在错误！" +Fin: + '对首层以外的路径检查 + For i = If(Str.StartsWith("\\Mac\"), 2, 1) To Str.Split("\").Count - 1 + Dim SubStr As String = Str.Split("\")(i) + '检查是否为空 + Dim SubLengthCheck As String = New ValidateNullOrWhiteSpace().Validate(SubStr) + If Not SubLengthCheck = "" Then Return "文件夹路径存在错误！" + '检查特殊字符 + Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符！").Validate(SubStr) + If Not CharactCheck = "" Then Return CharactCheck + '检查头部空格 + If SubStr.StartsWith(" ") Then Return "文件夹名不能以空格开头！" + If SubStr.EndsWith(" ") Then Return "文件夹名不能以空格结尾！" + '检查尾部小数点 + If SubStr.EndsWith(".") Then Return "文件夹名不能以小数点结尾！" + '检查特殊字符串 + Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %！").Validate(SubStr) + If Not InvalidStrCheck = "" Then Return InvalidStrCheck + Next + Return "" + End Function +End Class + +''' +''' 敏感词过滤。 +''' +Public Class ValidateFilter + Inherits Validate + Private Shared Excepts As String() = SecretDecrypt(SecretSensitiveWordsRaw).Split("|") + Public Sub New() + End Sub '用于 XAML 初始化 + Public Overrides Function Validate(Str As String) As String + '提取无间隔符的字符串 + Dim RealStr As String = "" + For Each St In If(Str, "").ToLower + If String.IsNullOrWhiteSpace(St.ToString) OrElse ("!@#$%^&*()_+-={}[]|\;':"",./<>? ~　·！￥…（）—，。、《》？‘；：【】｛｝" & vbLQ & vbRQ).ToCharArray.Contains(St) Then Continue For + RealStr += St + Next + '检查 + For Each Except In Excepts + If RealStr.Contains(Except) Then Return "存在敏感内容！" + Next + Return "" + End Function +End Class diff --git a/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb b/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb new file mode 100644 index 0000000..12e78cc --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb @@ -0,0 +1,158 @@ +'一个万能的自动图片类型转换工具类 + +Public Class MyBitmap + + ''' + ''' 位图缓存。 + ''' + Public Shared BitmapCache As New Dictionary(Of String, MyBitmap) + + ''' + ''' 存储的图片 + ''' + Public Pic As System.Drawing.Bitmap + + '自动类型转换 + '支持的类：Image，ImageSource，Bitmap，ImageBrush，BitmapSource + Public Shared Widening Operator CType(Image As System.Drawing.Image) As MyBitmap + Return New MyBitmap(Image) + End Operator + Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Image + Return Image.Pic + End Operator + Public Shared Widening Operator CType(Image As ImageSource) As MyBitmap + Return New MyBitmap(Image) + End Operator + Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource + Dim Bitmap = Image.Pic + Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height) + Dim bitmapData = Bitmap.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format32bppArgb) + Try + Dim size = rect.Width * rect.Height * 4 + Return BitmapSource.Create(Bitmap.Width, Bitmap.Height, DPI, DPI, PixelFormats.Bgra32, Nothing, bitmapData.Scan0, size, bitmapData.Stride) + Finally + Bitmap.UnlockBits(bitmapData) + End Try + End Operator + Public Shared Widening Operator CType(Image As System.Drawing.Bitmap) As MyBitmap + Return New MyBitmap(Image) + End Operator + Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Bitmap + Return Image.Pic + End Operator + Public Shared Widening Operator CType(Image As ImageBrush) As MyBitmap + Return New MyBitmap(Image) + End Operator + Public Shared Widening Operator CType(Image As MyBitmap) As ImageBrush + Return New ImageBrush(New MyBitmap(Image.Pic)) + End Operator + + '构造函数 + Public Sub New() + End Sub + Public Sub New(FilePathOrResourceName As String) + Try + If FilePathOrResourceName.StartsWith(PathImage) Then + '使用缓存 + If BitmapCache.ContainsKey(FilePathOrResourceName) Then + Pic = BitmapCache(FilePathOrResourceName).Pic + Else + Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource)) + BitmapCache.Add(FilePathOrResourceName, Pic) + End If + Else + '使用这种自己接管 FileStream 的方法加载才能解除文件占用 + Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open) + Pic = New System.Drawing.Bitmap(InputStream) + InputStream.Dispose() + End Using + End If + Catch ex As Exception + Pic = My.Application.TryFindResource(FilePathOrResourceName) + If Pic Is Nothing Then + Pic = New System.Drawing.Bitmap(1, 1) + Log(ex, "加载位图失败（" & FilePathOrResourceName & "）") + Throw + Else + Log(ex, "指定类型有误的位图加载（" & FilePathOrResourceName & "）", LogLevel.Developer) + Exit Try + End If + End Try + End Sub + Public Sub New(Image As ImageSource) + Using MS = New MemoryStream() + Dim Encoder = New PngBitmapEncoder() + Encoder.Frames.Add(BitmapFrame.Create(Image)) + Encoder.Save(MS) + Pic = New System.Drawing.Bitmap(MS) + End Using + End Sub + Public Sub New(Image As System.Drawing.Image) + Pic = Image + End Sub + Public Sub New(Image As System.Drawing.Bitmap) + Pic = Image + End Sub + Public Sub New(Image As ImageBrush) + Using MS = New MemoryStream() + Dim Encoder = New BmpBitmapEncoder() + Encoder.Frames.Add(BitmapFrame.Create(Image.ImageSource)) + Encoder.Save(MS) + Pic = New System.Drawing.Bitmap(MS) + End Using + End Sub + + ''' + ''' 获取旋转的图片，这个方法不会导致原对象改变且会返回一个新的对象。图片长宽必须相等。 + ''' + ''' 旋转角度（单位为角度）。 + Public Function Rotation(angle As Double) As System.Drawing.Bitmap + With Me + Dim img As System.Drawing.Image = Me.Pic + Dim bitSize As Single = img.Width + Dim bmp As New System.Drawing.Bitmap(CInt(bitSize), CInt(bitSize)) + Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp) + g.TranslateTransform(bitSize / 2, bitSize / 2) + g.RotateTransform(angle) + g.TranslateTransform(-bitSize / 2, -bitSize / 2) + g.DrawImage(img, New System.Drawing.Rectangle(0, 0, img.Width, img.Width)) + End Using + Return bmp + End With + End Function + + ''' + ''' 获取裁切的图片，这个方法不会导致原对象改变且会返回一个新的对象。 + ''' + Public Function Clip(rect As System.Drawing.Rectangle) As System.Drawing.Bitmap + With Me + Dim img As System.Drawing.Image = Pic + Dim bmp As New System.Drawing.Bitmap(rect.Width, rect.Height) + Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bmp) + g.DrawImageUnscaled(img, rect) + End Using + Return bmp + End With + End Function + + ''' + ''' 获取左右翻转的图片，这个方法不会导致原对象改变。 + ''' + Public Function LeftRightFilp() As System.Drawing.Bitmap + Dim bmp As New System.Drawing.Bitmap(Pic) + bmp.RotateFlip(System.Drawing.RotateFlipType.RotateNoneFlipX) + Return bmp + End Function + + ''' + ''' 将图像保存到文件。 + ''' + Public Sub Save(FilePath As String) + Dim encoder As BitmapEncoder = New PngBitmapEncoder() + encoder.Frames.Add(BitmapFrame.Create(Me)) + Using fileStream = New System.IO.FileStream(FilePath, FileMode.Create) + encoder.Save(fileStream) + End Using + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb new file mode 100644 index 0000000..f19d556 --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb @@ -0,0 +1,887 @@ +Public Class CrashAnalyzer + Private Shared IsAnalyzeCacheCleared As Boolean = False + Private Shared IsAnalyzeCacheClearedLock As New Object + + '构造函数 + Private TempFolder As String + Public Sub New(UUID As Integer) + '清理缓存 + SyncLock IsAnalyzeCacheClearedLock + If Not IsAnalyzeCacheCleared Then + Try + DeleteDirectory(PathTemp & "CrashAnalyzer") + Catch ex As Exception + Log(ex, "清理崩溃分析缓存失败") + End Try + IsAnalyzeCacheCleared = True + End If + End SyncLock + '构建文件结构 + TempFolder = PathTemp & "CrashAnalyzer\" & UUID & RandomInteger(0, 99999999) & "\" + DeleteDirectory(TempFolder) + Directory.CreateDirectory(TempFolder & "Temp\") + Directory.CreateDirectory(TempFolder & "Report\") + Log("[Crash] 崩溃分析暂存文件夹：" & TempFolder) + End Sub + + '1：准备用于分析的 Log 文件 + Private AnalyzeRawFiles As New List(Of KeyValuePair(Of String, String())) '暂存的日志文件：文件完整路径 -> 文件内容 + ''' + ''' 将可用于分析的日志存储到 AnalyzeRawFiles。 + ''' + ''' 从 PCL2 捕获到的最后 200 行程序输出。 + Public Sub Collect(VersionPathIndie As String, Optional LatestLog As IList(Of String) = Nothing) + Log("[Crash] 步骤 1：收集日志文件") + + '简单收集可能的日志文件路径 + Dim PossibleLogs As New List(Of String) + Try + Dim DirInfo As New DirectoryInfo(VersionPathIndie & "crash-reports\") + If DirInfo.Exists Then + For Each File In DirInfo.EnumerateFiles + PossibleLogs.Add(File.FullName) + Next + End If + Catch ex As Exception + Log(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败") + End Try + Try + For Each File In New DirectoryInfo(VersionPathIndie).Parent.Parent.EnumerateFiles + If If(File.Extension, "") <> ".log" Then Continue For + PossibleLogs.Add(File.FullName) + Next + Catch ex As Exception + Log(ex, "收集 Minecraft 主文件夹下的日志失败") + End Try + Try + For Each File In New DirectoryInfo(VersionPathIndie).EnumerateFiles + If If(File.Extension, "") <> ".log" Then Continue For + PossibleLogs.Add(File.FullName) + Next + Catch ex As Exception + Log(ex, "收集 Minecraft 隔离文件夹下的日志失败") + End Try + PossibleLogs.Add(VersionPathIndie & "logs\latest.log") 'Minecraft 日志 + PossibleLogs.Add(VersionPathIndie & "logs\debug.log") 'Minecraft Debug 日志 + PossibleLogs = ArrayNoDouble(PossibleLogs) + + '确定最新的日志文件 + Dim RightLogs As New List(Of String) + For Each LogFile In PossibleLogs + Try + Dim Info As New FileInfo(LogFile) + If Not Info.Exists Then Continue For + Dim Time = Math.Abs((Info.LastWriteTime - Date.Now).TotalMinutes) + If Time < 3 AndAlso Info.Length > 0 Then + RightLogs.Add(LogFile) + Log("[Crash] 可能可用的日志文件：" & LogFile & "（" & Math.Round(Time, 1) & " 分钟）") + End If + Catch ex As Exception + Log(ex, "确认崩溃日志时间失败（" & LogFile & "）") + End Try + Next + If RightLogs.Count = 0 Then Log("[Crash] 未发现可能可用的日志文件") + + '将可能可用的日志文件导出 + For Each FilePath In RightLogs + Try + If FilePath.Contains("crash-") Then + AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, ReadFile(FilePath).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr))) + Else + AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(FilePath, File.ReadAllLines(FilePath, Encoding.UTF8))) + End If + Catch ex As Exception + Log(ex, "读取可能的崩溃日志文件失败（" & FilePath & "）") + End Try + Next + If LatestLog IsNot Nothing AndAlso LatestLog.Count > 0 Then + Dim RawOutput As String = Join(LatestLog, vbCrLf) + Log("[Crash] 以下为游戏输出的最后一段内容：" & vbCrLf & RawOutput) + WriteFile(TempFolder & "RawOutput.log", RawOutput) + AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray)) + LatestLog.Clear() + End If + + Log("[Crash] 步骤 1：收集日志文件完成，收集到 " & AnalyzeRawFiles.Count & " 个文件") + End Sub + ''' + ''' 从文件路径直接导入日志文件或崩溃报告压缩包。 + ''' + Public Sub Import(FilePath As String) + Log("[Crash] 步骤 1：自主导入日志文件") + + '解压压缩包 + Try + Dim Info As New FileInfo(FilePath) + If Not Info.Exists OrElse Info.Length = 0 Then Exit Try + If Not FilePath.ToLower.EndsWith(".jar") AndAlso ExtractFile(FilePath, TempFolder & "Temp\") Then + '解压成功 + Log("[Crash] 已解压导入的日志文件：" & FilePath) + Else + '解压失败 + File.Copy(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath)) + Log("[Crash] 已复制导入的日志文件：" & FilePath) + End If + Catch ex As Exception + Log(ex, "解压导入文件中的压缩包失败") + End Try + + '导入其中的日志文件 + For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles + Try + 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.StartsWith("crash-") Then + AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Split(vbCr))) + Else + AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, File.ReadAllLines(TargetFile.FullName, Encoding.UTF8))) + End If + End If + Catch ex As Exception + Log(ex, "导入单个日志文件失败") + End Try + Next + + Log("[Crash] 步骤 1：自主导入日志文件，收集到 " & AnalyzeRawFiles.Count & " 个文件") + End Sub + + '2：确认实际用于分析的 Log 文本 + Private Enum AnalyzeFileType + HsErr + MinecraftLog + ExtraLog + CrashReport + End Enum + ''' + ''' 从 AnalyzeRawFiles 中提取实际有用的文本片段存储到 AnalyzeFiles，并整理可用于生成报告的文件。 + ''' 返回找到的用于分析的项目数。 + ''' + Public Function Prepare() As Integer + Log("[Crash] 步骤 2：准备日志文本") + + '对日志文件进行分类 + Dim TotalFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))) + For Each LogFile In AnalyzeRawFiles + Dim FileName As String = GetFileNameFromPath(LogFile.Key) + Dim TargetType As AnalyzeFileType + If FileName.StartsWith("hs_err") Then + TargetType = AnalyzeFileType.HsErr + ElseIf FileName.StartsWith("crash-") Then + TargetType = AnalyzeFileType.CrashReport + ElseIf FileName = "latest.log" OrElse FileName = "latest log.txt" OrElse + FileName = "debug.log" OrElse FileName = "debug log.txt" OrElse FileName = "游戏崩溃前的输出.txt" OrElse + FileName = "rawoutput.log" OrElse FileName = "启动器日志.txt" OrElse FileName = "PCL2 启动器日志.txt" OrElse FileName = "log1.txt" Then + TargetType = AnalyzeFileType.MinecraftLog + ElseIf FileName.EndsWith(".log") OrElse FileName.EndsWith(".txt") Then + TargetType = AnalyzeFileType.ExtraLog + Else + Log("[Crash] " & FileName & " 分类为 Ignore") + Continue For + End If + If LogFile.Value.Count = 0 Then + Log("[Crash] " & FileName & " 由于内容为空跳过") + Else + TotalFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile)) + Log("[Crash] " & FileName & " 分类为 " & GetStringFromEnum(TargetType)) + End If + Next + + '将分类后的文件分别写入 + For Each SelectType In {AnalyzeFileType.MinecraftLog, AnalyzeFileType.HsErr, AnalyzeFileType.ExtraLog, AnalyzeFileType.CrashReport} + '获取该种类的所有文件 {文件路径 -> 文件内容行} + Dim SelectedFiles As New List(Of KeyValuePair(Of String, String())) + For Each File In TotalFiles + If SelectType = File.Key Then SelectedFiles.Add(File.Value) + Next + If SelectedFiles.Count = 0 Then Continue For + Try + '根据文件类别判断 + Select Case SelectType + Case AnalyzeFileType.HsErr, AnalyzeFileType.CrashReport + '获取文件的修改日期 + Dim DatedFiles As New SortedList(Of Date, KeyValuePair(Of String, String()))() + For Each File In SelectedFiles + Try + DatedFiles.Add(New FileInfo(File.Key).LastWriteTime, File) + Catch ex As Exception + Log(ex, "获取日志文件修改时间失败") + DatedFiles.Add(New Date(1900, 1, 1), File) + End Try + Next + '输出最新的文件 + Dim NewestFile As KeyValuePair(Of String, String()) = DatedFiles.Last.Value + OutputFiles.Add(NewestFile.Key) + If SelectType = AnalyzeFileType.HsErr Then + LogHs = GetHeadTailLines(NewestFile.Value, 200, 100) + Log("[Crash] 输出报告：" & NewestFile.Key & "，作为虚拟机错误信息") + Log("[Crash] 导入分析：" & NewestFile.Key & "，作为虚拟机错误信息") + Else + LogCrash = GetHeadTailLines(NewestFile.Value, 300, 700) + Log("[Crash] 输出报告：" & NewestFile.Key & "，作为 Minecraft 崩溃报告") + Log("[Crash] 导入分析：" & NewestFile.Key & "，作为 Minecraft 崩溃报告") + End If + Case AnalyzeFileType.MinecraftLog + LogMc = "" + '创建文件名词典 + Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String())) + For Each SelectedFile In SelectedFiles + DictionaryAdd(FileNameDict, GetFileNameFromPath(SelectedFile.Key).ToLower, SelectedFile) + OutputFiles.Add(SelectedFile.Key) + Log("[Crash] 输出报告：" & SelectedFile.Key & "，作为 Minecraft 或启动器日志") + Next + '选择一份最佳的来自启动器的游戏日志 + For Each FileName As String In {"rawoutput.log", "启动器日志.txt", "log1.txt", "游戏崩溃前的输出.txt", "PCL2 启动器日志.txt"} + If FileNameDict.ContainsKey(FileName) Then + Dim CurrentLog = FileNameDict(FileName) + '截取 “以下为游戏输出的最后一段内容” 后的内容 + Dim HasLauncherMark As Boolean = False + For Each Line In CurrentLog.Value + If HasLauncherMark Then + LogMc += Line & vbLf + ElseIf Line.Contains("以下为游戏输出的最后一段内容") Then + HasLauncherMark = True + Log("[Crash] 找到 PCL2 输出的游戏实时日志头") + End If + Next + '导入后 500 行 + If Not HasLauncherMark Then LogMc += GetHeadTailLines(CurrentLog.Value, 0, 500) + LogMc = LogMc.TrimEnd(vbCrLf.ToCharArray) & vbLf & "[" '路径包含中文且存在编码问题导致找不到或无法加载主类的末端检测 + 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 + Dim CurrentLog = FileNameDict(FileName) + LogMc += GetHeadTailLines(CurrentLog.Value, 250, 500) & vbLf & "[" + Log("[Crash] 导入分析：" & CurrentLog.Key & "，作为 Minecraft 日志") + Exit For + End If + Next + '检查错误 + If LogMc = "" Then + LogMc = Nothing + Throw New Exception("无法找到匹配的 Minecraft Log") + End If + Case AnalyzeFileType.ExtraLog + '全部丢过去 + For Each SelectedFile In SelectedFiles + OutputFiles.Add(SelectedFile.Key) + Log("[Crash] 输出报告：" & SelectedFile.Key & "，作为额外日志") + Next + End Select + Catch ex As Exception + Log(ex, "分类处理日志文件时出错") + 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 + Log(("[Crash] 步骤 2：准备日志文本完成，找到" & If(LogMc Is Nothing, "", "游戏日志、") & If(LogHs Is Nothing, "", "虚拟机日志、") & If(LogCrash Is Nothing, "", "崩溃日志、")).TrimEnd("、") & "用作分析") + End If + Return ResultCount + + End Function + ''' + ''' 输出字符串的前后某些行，并统一行尾为 vbLf (\r)、删除空行。 + ''' + Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String + If Raw.Length <= HeadLines + TailLines Then Return Join(Raw, vbLf) + Dim Result As New StringBuilder + For i = 0 To Raw.Count - 1 + If i < HeadLines OrElse Raw.Count - i < TailLines Then + If Raw(i) = "" Then Continue For + Result.Append(Raw(i) & vbLf) + End If + Next + Return Result.ToString + End Function + + '3：根据文本分析崩溃原因 + Private LogMc As String = Nothing, LogHs As String = Nothing, LogCrash As String = Nothing + Private LogAll As String + '可能导致崩溃的原因与附加信息 + Private CrashReasons As New Dictionary(Of CrashReason, List(Of String)) + ''' + ''' 导致崩溃的原因枚举。 + ''' + Private Enum CrashReason + Mod文件被解压 + 内存不足 + 使用JDK + 显卡不支持OpenGL + 使用OpenJ9 + Java版本过高 + 显卡驱动不支持导致无法设置像素格式 + 路径包含中文且存在编码问题导致找不到或无法加载主类 + Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION 'https://bugs.mojang.com/browse/MC-32606 + AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION 'https://bugs.mojang.com/browse/MC-31618 + Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION + 玩家手动触发调试崩溃 + 光影或资源包导致OpenGL1282错误 + 文件或内容校验失败 + 确定Mod导致游戏崩溃 + Mod配置文件导致游戏崩溃 + ModMixin失败 + Mod加载器报错 + Mod初始化失败 + 崩溃日志堆栈分析发现关键字 + 崩溃日志堆栈分析发现Mod名称 + MC日志堆栈分析发现关键字 + OptiFine导致无法加载世界 'https://www.minecraftforum.net/forums/support/java-edition-support/3051132-exception-ticking-world + 特定方块导致崩溃 + 特定实体导致崩溃 + 材质过大或显卡配置不足 + 没有可用的分析文件 + 使用32位Java导致JVM无法分配足够多的内存 + Mod重复安装 + Fabric报错 + Fabric报错并给出解决方案 + Forge报错 + 低版本Forge与高版本Java不兼容 + 版本Json中存在多个Forge + Mod过多导致超出ID限制 + End Enum + ''' + ''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。 + ''' + Public Sub Analyze(Optional Version As McVersion = Nothing) + Log("[Crash] 步骤 3：分析崩溃原因") + LogAll = (If(LogMc, "") & If(LogHs, "") & If(LogCrash, "")).ToLower + + '1. 精准日志匹配 1 + AnalyzeCrit1() + If CrashReasons.Count > 0 Then GoTo Done + + '2. 堆栈分析 + If LogAll.Contains("forge") OrElse LogAll.Contains("fabric") OrElse LogAll.Contains("liteloader") Then + '来源崩溃日志的分析 + If LogCrash IsNot Nothing Then + Log("[Crash] 开始进行崩溃日志堆栈分析") + Dim Keywords = AnalyzeStackKeyword(LogCrash.Replace("A detailed walkthrough of the error", "¨").Split("¨").First) + If Keywords.Count > 0 Then + Dim Names = AnalyzeModName(Keywords) + If Names Is Nothing Then + AppendReason(CrashReason.崩溃日志堆栈分析发现关键字, Keywords) + Else + AppendReason(CrashReason.崩溃日志堆栈分析发现Mod名称, Names) + End If + GoTo Done + End If + End If + '来自 Minecraft 日志的分析 + If LogMc IsNot Nothing Then + Dim Fatals = RegexSearch(LogMc, "/FATAL] [\w\W]+?(?=[\n]+\[)") + Log("[Crash] 开始进行 Minecraft 日志堆栈分析，发现 " & Fatals.Count & " 个报错项") + If Fatals.Count > 0 Then + Dim Keywords As New List(Of String) + For Each Fatal In Fatals + Keywords.AddRange(AnalyzeStackKeyword(Fatal)) + Next + If Keywords.Count > 0 Then + AppendReason(CrashReason.MC日志堆栈分析发现关键字, ArrayNoDouble(Keywords)) + GoTo Done + End If + End If + End If + Else + Log("[Crash] 可能并未安装 Mod，不进行堆栈分析") + End If + + '3. 精准日志匹配 2 + AnalyzeCrit2() + + '输出到日志 +Done: + If CrashReasons.Count = 0 Then + Log("[Crash] 步骤 3：分析崩溃原因完成，未找到可能的原因") + Else + Log("[Crash] 步骤 3：分析崩溃原因完成，找到 " & CrashReasons.Count & " 条可能的原因") + For Each Reason In CrashReasons + Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Count > 0, "（" & Join(Reason.Value, "；") & "）", "")) + Next + End If + End Sub + ''' + ''' 增加一个可能的崩溃原因。 + ''' + Private Sub AppendReason(Reason As CrashReason, Optional Additional As ICollection(Of String) = Nothing) + If CrashReasons.ContainsKey(Reason) Then + If Additional IsNot Nothing Then + CrashReasons(Reason).AddRange(Additional) + CrashReasons(Reason) = ArrayNoDouble(CrashReasons(Reason)) + End If + Else + CrashReasons.Add(Reason, New List(Of String)(If(Additional, {}))) + End If + Log("[Crash] 可能的崩溃原因：" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Count > 0, "（" & Join(Additional, "；") & "）", "")) + End Sub + Private Sub AppendReason(Reason As CrashReason, Additional As String) + AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional})) + End Sub + + '具体的分析代码 + ''' + ''' 进行精准日志匹配。匹配优先级高于堆栈分析的崩溃。 + ''' + Private Sub AnalyzeCrit1() + + '空白分析 + If LogMc Is Nothing AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing Then + AppendReason(CrashReason.没有可用的分析文件) + Exit Sub + End If + + '崩溃报告分析，高优先级 + If LogCrash IsNot Nothing Then + If LogCrash.Contains("Unable to make protected final java.lang.Class java.lang.ClassLoader.defineClass") Then AppendReason(CrashReason.Java版本过高) + End If + + '游戏日志分析 + If LogMc IsNot Nothing Then + If LogMc.Contains("Found multiple arguments for option fml.forgeVersion, but you asked for only one") Then AppendReason(CrashReason.版本Json中存在多个Forge) + If LogMc.Contains("The driver does not appear to support OpenGL") Then AppendReason(CrashReason.显卡不支持OpenGL) + If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK) + If LogMc.Contains("java.lang.ClassCastException: class jdk.") Then AppendReason(CrashReason.使用JDK) + If LogMc.Contains("Open J9 is not supported") OrElse LogMc.Contains("OpenJ9 is incompatible") OrElse LogMc.Contains(".J9VMInternals.") Then AppendReason(CrashReason.使用OpenJ9) + If LogMc.Contains("because module java.base does not export") Then AppendReason(CrashReason.Java版本过高) + If LogMc.Contains("java.lang.ClassNotFoundException: java.lang.invoke.LambdaMetafactory") Then AppendReason(CrashReason.Java版本过高) + If LogMc.Contains("The directories below appear to be extracted jar files. Fix this before you continue.") Then AppendReason(CrashReason.Mod文件被解压) + If LogMc.Contains("Extracted mod jars found, loading will NOT continue") Then AppendReason(CrashReason.Mod文件被解压) + If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式) + If LogMc.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足) + If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容) + If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误) + If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf)) + If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, If(RegexSeek(LogMc, "(?<=the game will display an error screen and halt[\s\S]+?Exception: )[\s\S]+?(?=\n\tat)"), "").TrimEnd(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("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足) + If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界) + If LogMc.Contains("Could not reserve enough space") Then + If LogMc.Contains("for 1048576KB object heap") Then + AppendReason(CrashReason.使用32位Java导致JVM无法分配足够多的内存) + Else + AppendReason(CrashReason.内存不足) + End If + End If + 'Mod 重复安装 + If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase)) + If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) + If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) + '找不到或无法加载主类 + If (RegexCheck(LogMc, "^[^\n.]+.\w+.[^\n]+\n\[$") OrElse RegexCheck(LogMc, "^\[[^\]]+\] [^\n.]+.\w+.[^\n]+\n\[")) AndAlso + Not (LogMc.Contains("at net.") OrElse LogMc.Contains("/INFO]")) AndAlso + LogHs Is Nothing AndAlso LogCrash Is Nothing Then + AppendReason(CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类) + End If + 'Mod 导致的崩溃 + If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("mixin.injection.throwables.InjectionError") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then + Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)") + If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)") + If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )") + AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray))) + End If + If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "[^\n]+?(?)"), "").TrimEnd((vbCrLf & " ").ToCharArray))) + If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf))) + End If + + '虚拟机日志分析 + If LogHs IsNot Nothing Then + If LogHs.Contains("The system is out of physical RAM or swap space") Then AppendReason(CrashReason.内存不足) + If LogHs.Contains("Out of Memory Error") Then AppendReason(CrashReason.内存不足) + If LogHs.Contains("EXCEPTION_ACCESS_VIOLATION") Then + If LogHs.Contains("# C [ig") Then AppendReason(CrashReason.Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION) + If LogHs.Contains("# C [atio") Then AppendReason(CrashReason.AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION) + If LogHs.Contains("# C [nvoglv") Then AppendReason(CrashReason.Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION) + End If + End If + + '崩溃报告分析 + If LogCrash IsNot Nothing Then + If LogCrash.Contains("maximum id range exceeded") Then AppendReason(CrashReason.Mod过多导致超出ID限制) + If LogCrash.Contains("Entity being rendered") AndAlso LogCrash.Contains(vbTab & "Entity's Exact location: ") Then AppendReason(CrashReason.特定实体导致崩溃, If(RegexSeek(LogCrash, "(?<=\tEntity Type: )[^\n]+(?= \()"), "") & " (" & If(RegexSeek(LogCrash, "(?<=\tEntity's Exact location: )[^\n]+"), "").TrimEnd(vbCrLf.ToCharArray) & ")") + If LogCrash.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足) + If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式) + If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃) + 'Mod 导致的崩溃 + If LogCrash.Contains("-- MOD ") Then + Dim LogLeft = LogCrash.Split("-- MOD").Last + If LogLeft.Contains("Failure message: MISSING") Then + AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrash, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray)) + Else + AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray)) + End If + End If + If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) + If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) + If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)}) + End If + + End Sub + ''' + ''' 进行精准日志匹配。匹配优先级低于堆栈分析的崩溃。 + ''' + Private Sub AnalyzeCrit2() + + '游戏日志分析 + If LogMc IsNot Nothing Then + If LogMc.Contains("]: Warnings were found!") Then AppendReason(CrashReason.Fabric报错, If(RegexSeek(LogMc, "(?<=\]: Warnings were found! ?[\n]+)[\w\W]+?(?=[\n]+\[)"), "").Trim(vbCrLf.ToCharArray)) + End If + + '崩溃报告分析 + If LogCrash IsNot Nothing Then + If LogCrash.Contains(vbTab & "Block location: World: ") Then AppendReason(CrashReason.特定方块导致崩溃, If(RegexSeek(LogCrash, "(?<=\tBlock: Block\{)[^\}]+"), "") & " " & If(RegexSeek(LogCrash, "(?<=\tBlock location: World: )\([^\)]+\)"), "")) + If LogCrash.Contains(vbTab & "Entity's Exact location: ") Then AppendReason(CrashReason.特定实体导致崩溃, If(RegexSeek(LogCrash, "(?<=\tEntity Type: )[^\n]+(?= \()"), "") & " (" & If(RegexSeek(LogCrash, "(?<=\tEntity's Exact location: )[^\n]+"), "").TrimEnd(vbCrLf.ToCharArray) & ")") + End If + + End Sub + ''' + ''' 从堆栈中提取 Mod ID 关键字。若失败则返回空列表。 + ''' + Private Function AnalyzeStackKeyword(ErrorStack As String) As List(Of String) + + '进行正则匹配 + Dim StackSearchResults As List(Of String) = RegexSearch(If(ErrorStack, "") & vbCrLf, "(?<=\n[^{]+)[a-zA-Z]+\w+\.[a-zA-Z]+[\w\.]+(?=\.[\w\.$]+\.)") + + '检查堆栈开头 + Dim PossibleStacks As New List(Of String) + For Each Stack As String In StackSearchResults + 'If Not Stack.Contains(".") Then Continue For + For Each IgnoreStack In { + "java", "sun", "javax", "jdk", + "org.lwjgl", "com.sun", "net.minecraftforge", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey", + "com.electronwill.nightconfig", + "MojangTricksIntelDriversForPerformance_javaw"} + If Stack.StartsWith(IgnoreStack) Then GoTo NextStack + Next + PossibleStacks.Add(Stack.Trim) '.Split("$").First) +NextStack: + Next + PossibleStacks = ArrayNoDouble(PossibleStacks) + Log("[Crash] 找到 " & PossibleStacks.Count & " 条可能的堆栈信息") + If PossibleStacks.Count = 0 Then Return New List(Of String) + For Each Stack As String In PossibleStacks + Log("[Crash] - " & Stack) + Next + + '检查堆栈关键词 + Dim PossibleWords As New List(Of String) + For Each Stack As String In PossibleStacks + Dim Splited = Stack.Split(".") + For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节 + Dim Word As String = Splited(i) + If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For + If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", + "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", + "forge", "setup", "block", "model", "mixin", "event", + "common", "server", "config", "loader", "launch", "entity", "assist", "client", "modapi", "mojang", "shader", "events", "github", + "preinit", "preload", "machine", "reflect", "channel", "general", "handler", + "optifine", "minecraft", "transformers", "universal", "internal", "multipart", "minecraftforge", "override" + }.Contains(Word.ToLower) Then Continue For + PossibleWords.Add(Word.Trim) + Next + Next + PossibleWords = ArrayNoDouble(PossibleWords) + Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词") + If PossibleWords.Count > 0 Then Log("[Crash] - " & Join(PossibleWords, ", ")) + If PossibleWords.Count > 10 Then + Log("[Crash] 关键词过多，考虑匹配出错，不纳入考虑") + Return New List(Of String) + Else + Return PossibleWords + End If + + End Function + ''' + ''' 根据 Mod 关键词与详细信息（崩溃报告第二部分）与，获取实际的 Mod 名称。 + ''' 若失败则返回 Nothing。 + ''' + Private Function AnalyzeModName(Keywords As List(Of String)) As List(Of String) + Dim ModFileNames As New List(Of String) + + '预处理关键词（分割括号） + Dim RealKeywords As New List(Of String) + For Each Keyword In Keywords + For Each SubKeyword In Keyword.Split("(") + RealKeywords.Add(SubKeyword.Trim(" )".ToCharArray)) + Next + Next + Keywords = RealKeywords + + '获取崩溃报告对应部分 + If LogCrash Is Nothing Then Return Nothing + If Not LogCrash.Contains("A detailed walkthrough of the error") Then Return Nothing + Dim Details As String = LogCrash.Replace("A detailed walkthrough of the error", "¨") + Dim IsFabricDetail As Boolean = Details.Contains("Fabric Mods") '是否为 Fabric 信息格式 + If IsFabricDetail Then + Details = Details.Replace("Fabric Mods", "¨") + Log("[Crash] 检测到 Fabric Mod 信息格式") + End If + Details = Details.Split("¨").Last + + '[Forge] 获取所有包含 .jar 的行 + '[Fabric] 获取所有包含 Mod 信息的行 + Dim ModNameLines As New List(Of String) + For Each Line In Details.Split(vbLf) + If Line.ToLower.Contains(".jar") OrElse + (IsFabricDetail AndAlso Line.StartsWith(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line) + Next + Log("[Crash] 找到 " & ModNameLines.Count & " 个可能的 Mod 项目行") + + '获取 Mod ID 与关键词的匹配行 + Dim HintLines As New List(Of String) + For Each KeyWord As String In Keywords + For Each ModString As String In ModNameLines + Dim RealModString As String = ModString.ToLower.Replace("_", "") + If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For + If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") Then Continue For + HintLines.Add(ModString.Trim(vbCrLf.ToCharArray)) + Exit For + Next + Next + HintLines = ArrayNoDouble(HintLines) + Log("[Crash] 找到 " & HintLines.Count & " 个可能的崩溃 Mod 匹配行") + For Each ModName As String In HintLines + Log("[Crash] - " & ModName) + Next + + '从 Mod 匹配行中提取 .jar 文件的名称 + For Each Line As String In HintLines + Dim Name As String + If IsFabricDetail Then + Name = RegexSeek(Line, "(?<=: )[^\n]+(?= [^\n]+)") + Else + Name = RegexSeek(Line, "(?<=\()[^\t]+.jar(?=\))|(?<=(\t\t)|(\| ))[^\t\|]+.jar", RegularExpressions.RegexOptions.IgnoreCase) + End If + If Name IsNot Nothing Then ModFileNames.Add(Name) + Next + ModFileNames = ArrayNoDouble(ModFileNames) + Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名") + For Each ModFileName As String In ModFileNames + Log("[Crash] - " & ModFileName) + Next + + Return If(ModFileNames.Count = 0, Nothing, ModFileNames) + End Function + ''' + ''' 尝试获取 Mod 名称，若失败则返回原关键字。 + ''' + Private Function TryAnalyzeModName(Keywords As String) As List(Of String) + Dim RawList As New List(Of String) From {Keywords} + If String.IsNullOrEmpty(Keywords) Then Return RawList + Return If(AnalyzeModName(RawList), RawList) + End Function + + '4：根据原因输出信息 + Private OutputFiles As New List(Of String) + ''' + ''' 弹出崩溃弹窗，并指导导出崩溃报告。 + ''' + Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing) + '弹窗提示 + FrmMain.ShowWindowToTop() + Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"), "确定", If(IsHandAnalyze, "", "导出错误报告")) + Case 2 + Dim FileAddress As String = Nothing + Try + '获取文件路径 + RunInUiWait(Sub() FileAddress = SelectAs("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip")) + If String.IsNullOrEmpty(FileAddress) Then Exit Sub + Directory.CreateDirectory(GetPathFromFullPath(FileAddress)) + If File.Exists(FileAddress) Then File.Delete(FileAddress) + '输出诊断信息 + FeedbackInfo() + LogFlush() + '复制文件 + If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles) + For Each OutputFile In OutputFiles + Try + Dim FileName As String = GetFileNameFromPath(OutputFile) + Select Case FileName + Case "LatestLaunch.bat" + FileName = "启动脚本.bat" + Case "Log1.txt" + FileName = "PCL2 启动器日志.txt" + Case "RawOutput.log" + FileName = "游戏崩溃前的输出.txt" + End Select + File.Copy(OutputFile, TempFolder & "Report\" & FileName, True) + Catch ex As Exception + Log(ex, "复制错误报告文件失败（" & OutputFile & "）") + End Try + Next + '导出报告 + Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress) + DeleteDirectory(TempFolder & "Report\") + Hint("错误报告已导出！", HintType.Finish) + Catch ex As Exception + Log(ex, "导出错误报告失败", LogLevel.Feedback) + Exit Sub + End Try + Try + Process.Start("explorer", "/select," & FileAddress) + Catch ex As Exception + Log(ex, "打开错误报告的存放文件夹失败") + End Try + End Select + End Sub + ''' + ''' 获取崩溃分析的结果描述。 + ''' + Private Function GetAnalyzeResult(IsHandAnalyze As Boolean) As String + + '非一个结果的处理 + Dim ResultString As String + If CrashReasons.Count = 0 Then + If IsHandAnalyze Then + Return "很抱歉，PCL2 无法确定错误原因。" + Else + Return "很抱歉，你的游戏出现了一些问题……" & vbCrLf & + "如果要寻求帮助，请向他人发送错误报告文件，而不是发送这个窗口的截图。" & vbCrLf & + "你也可以查看错误报告，其中可能会有出错的原因。" + End If + ElseIf CrashReasons.Count >= 2 Then + Hint("错误分析时发现数个可能的原因，窗口中仅显示了第一条，你可以在启动器日志中检查更多可能的原因！", HintType.Finish) + End If + + '根据不同原因判断 + Dim Additional As List(Of String) = CrashReasons.First.Value + Select Case CrashReasons.First.Key + Case CrashReason.Mod文件被解压 + ResultString = "由于 Mod 文件被解压了，导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可，若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod，然后再启动游戏。" + Case CrashReason.内存不足 + ResultString = "Minecraft 内存不足，导致其无法继续运行。\n这很可能是由于你为游戏分配的内存不足，或是游戏的配置要求过高。\n\n你可以在启动设置中增加为游戏分配的内存，删除配置要求较高的材质、Mod、光影。\n如果这依然不奏效，请在开始游戏前尽量关闭其他软件，或者……换台电脑？\h" + Case CrashReason.使用OpenJ9 + ResultString = "游戏因为使用 Open J9 而崩溃了。\n请在启动设置的 Java 选择一项中改用非 OpenJ9 的 Java 8，然后再启动游戏。\n如果你没有安装 JRE 8，你可以从网络中下载、安装一个。" + Case CrashReason.使用JDK + ResultString = "游戏似乎因为使用 JDK，或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8（Java 8），然后再启动游戏。\n如果你没有安装 JRE 8，你可以从网络中下载、安装一个。" + Case CrashReason.Java版本过高 + ResultString = "游戏似乎因为你所使用的 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8（Java 8），然后再启动游戏。\n如果你没有安装 JRE 8，你可以从网络中下载、安装一个。" + Case CrashReason.使用32位Java导致JVM无法分配足够多的内存 + If Environment.Is64BitOperatingSystem Then + ResultString = "你似乎正在使用 32 位 Java，这会导致 Minecraft 无法使用 1GB 以上的内存，进而造成崩溃。\n\n请在启动设置的 Java 选择一项中改用 64 位的 Java 再启动游戏，然后再启动游戏。\n如果你没有安装 64 位的 Java，你可以从网络中下载、安装一个。" + Else + ResultString = "你正在使用 32 位的操作系统，这会导致 Minecraft 无法使用 1GB 以上的内存，进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内，那或许只能换台电脑了……\h" + End If + Case CrashReason.崩溃日志堆栈分析发现关键字, CrashReason.MC日志堆栈分析发现关键字 + If Additional.Count = 1 Then + ResultString = "你的游戏遇到了一些问题，这可能是某些 Mod 所引起的，PCL2 找到了一个可疑的关键词：" & Additional.First & "。\n\n如果你知道它对应的 Mod，那么有可能就是它引起的错误，你也可以查看错误报告获取详情。\h" + Else + ResultString = "你的游戏遇到了一些问题，这可能是某些 Mod 所引起的，PCL2 找到了以下可疑的关键词：\n - " & Join(Additional, ", ") & "\n\n如果你知道这些关键词对应的 Mod，那么有可能就是它引起的错误，你也可以查看错误报告获取详情。\h" + End If + Case CrashReason.崩溃日志堆栈分析发现Mod名称 + If Additional.Count = 1 Then + ResultString = "名为 " & Additional.First & " 的 Mod 可能导致了游戏出错。\n\e\h" + Else + ResultString = "可能是以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n\e\h" + End If + Case CrashReason.确定Mod导致游戏崩溃 + If Additional.Count = 1 Then + ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h" + Else + ResultString = "以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n\e\h" + End If + Case CrashReason.ModMixin失败 + If Additional.Count = 1 Then + ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 注入失败，导致游戏出错。\n这一般代表着该 Mod 存在 Bug，或与当前环境不兼容。\n\e\h" + Else + ResultString = "以下 Mod 导致了游戏出错：\n - " & Join(Additional, "\n - ") & "\n这一般代表着这些 Mod 存在 Bug，或与当前环境不兼容。\n\e\h" + End If + Case CrashReason.Mod配置文件导致游戏崩溃 + If Additional(1) Is Nothing Then + ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h" + Else + ResultString = "名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错：\n其配置文件 " & Additional(1) & " 存在异常，无法读取。" + End If + Case CrashReason.Mod初始化失败 + If Additional.Count = 1 Then + ResultString = "名为 " & Additional.First & " 的 Mod 初始化失败，导致游戏无法继续加载。\n\e\h" + Else + ResultString = "以下 Mod 初始化失败，导致游戏无法继续加载：\n - " & Join(Additional, "\n - ") & "\n\e\h" + End If + Case CrashReason.特定方块导致崩溃 + If Additional.Count = 1 Then + ResultString = "游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界，并观察游戏的运行情况：\n - 若正常运行，则是该方块导致出错，你或许需要使用一些方式删除此方块。\n - 若仍然出错，问题就可能来自其他原因……\h" + Else + ResultString = "游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界，并观察游戏的运行情况：\n - 若正常运行，则是某些方块导致出错，你或许需要删除该世界。\n - 若仍然出错，问题就可能来自其他原因……\h" + End If + Case CrashReason.Mod重复安装 + If Additional.Count >= 2 Then + ResultString = "你重复安装了多个相同的 Mod：\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次，请删除重复的 Mod，然后再启动游戏。" + Else + ResultString = "你可能重复安装了多个相同的 Mod，导致游戏无法继续加载。\n\n每个 Mod 只能出现一次，请删除重复的 Mod，然后再启动游戏。\e\h" + End If + Case CrashReason.特定实体导致崩溃 + If Additional.Count = 1 Then + ResultString = "游戏似乎因为实体 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界，并生成一个该实体，然后观察游戏的运行情况：\n - 若正常运行，则是该实体导致出错，你或许需要使用一些方式删除此实体。\n - 若仍然出错，问题就可能来自其他原因……\h" + Else + ResultString = "游戏似乎因为世界中的某些实体出现了问题。\n\n你可以创建一个新世界，并生成各种实体，观察游戏的运行情况：\n - 若正常运行，则是某些实体导致出错，你或许需要删除该世界。\n - 若仍然出错，问题就可能来自其他原因……\h" + End If + Case CrashReason.低版本Forge与高版本Java不兼容 + ResultString = "由于低版本 Forge 与当前 Java 不兼容，导致了游戏崩溃。\n\n请尝试以下解决方案：\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 8.0.320 的 Java" + Case CrashReason.版本Json中存在多个Forge + ResultString = "可能由于使用其他启动器修改了 Forge 版本，当前版本的文件存在异常，导致了游戏崩溃。\n请尝试重新全新安装 Forge，而非使用其他启动器修改 Forge 版本。" + Case CrashReason.玩家手动触发调试崩溃 + ResultString = "* 事实上，你的游戏没有任何问题，这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗？" + Case CrashReason.路径包含中文且存在编码问题导致找不到或无法加载主类 + ResultString = "由于游戏路径含有中文字符，且 Java 或系统编码存在错误，导致游戏无法运行。\n\n解决这一问题的最简单方法是检查游戏的完整路径，并删除各个文件夹名中的中文字符。\n这包括了游戏的版本名、它所处的 .minecraft 文件夹及其之前的文件夹名。\h" + Case CrashReason.OptiFine导致无法加载世界 'https://www.minecraftforum.net/forums/support/java-edition-support/3051132-exception-ticking-world + ResultString = "你所使用的 OptiFine 可能导致了你的游戏出现问题。\n\n该问题只在特定 OptiFine 版本中出现，你可以尝试更换 OptiFine 的版本。\h" + Case CrashReason.显卡驱动不支持导致无法设置像素格式, CrashReason.Intel驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.AMD驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.Nvidia驱动不兼容导致EXCEPTION_ACCESS_VIOLATION, CrashReason.显卡不支持OpenGL + If LogAll.Contains("hd graphics ") Then + ResultString = "你的显卡驱动存在问题，或未使用独立显卡，导致游戏无法正常运行。\n\n如果你的电脑存在独立显卡，请使用独立显卡而非 Intel 核显启动 PCL2 与 Minecraft。\n如果问题依然存在，请尝试升级你的显卡驱动到最新版本，或回退到出厂版本。\n如果还是不行，还可以尝试使用 8.0.51 或更低版本的 Java。\h" + Else + ResultString = "你的显卡驱动存在问题，导致游戏无法正常运行。\n\n请尝试升级你的显卡驱动到最新版本，或回退到出厂版本，然后再启动游戏。\n如果还是不行，可以尝试使用 8.0.51 或更低版本的 Java。\n如果问题依然存在，那么你可能需要换个更好的显卡……\h" + End If + Case CrashReason.材质过大或显卡配置不足 + ResultString = "你所使用的材质分辨率过高，或显卡配置不足，导致游戏无法继续运行。\n\n如果你正在使用高清材质，请将它移除。\n如果你没有使用材质，那么你可能需要更新显卡驱动，或者换个更好的显卡……\h" + Case CrashReason.光影或资源包导致OpenGL1282错误 + ResultString = "你所使用的光影或材质导致游戏出现了一些问题……\n\n请尝试删除你所添加的这些额外资源。\h" + Case CrashReason.Mod过多导致超出ID限制 + ResultString = "你所安装的 Mod 过多，超出了游戏的 ID 限制，导致了游戏崩溃。\n请尝试安装 JEID 等修复 Mod，或删除部分大型 Mod。" + Case CrashReason.文件或内容校验失败 + ResultString = "部分文件或内容校验失败，导致游戏出现了问题。\n\n请尝试删除游戏（包括 Mod）并重新下载，或尝试在重新下载时使用 VPN。\h" + Case CrashReason.Fabric报错 + If Additional.Count = 1 Then + ResultString = "Fabric 提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。" + Else + ResultString = "Fabric 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h" + End If + Case CrashReason.Mod加载器报错 + If Additional.Count = 1 Then + ResultString = "Mod 加载器提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。" + Else + ResultString = "Mod 加载器可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h" + End If + Case CrashReason.Fabric报错并给出解决方案 + If Additional.Count = 1 Then + ResultString = "Fabric 提供了以下解决方案：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。" + Else + ResultString = "Fabric 可能已经提供了解决方案，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h" + End If + Case CrashReason.Forge报错 + If Additional.Count = 1 Then + ResultString = "Forge 提供了以下错误信息：\n" & Additional.First & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。" + Else + ResultString = "Forge 可能已经提供了错误信息，请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息，可以查看错误报告了解错误具体是如何发生的。\h" + End If + Case CrashReason.没有可用的分析文件 + ResultString = "你的游戏出现了一些问题，但 PCL2 未能找到相关记录文件，因此无法进行分析。\h" + Case Else + ResultString = "PCL2 获取到了没有详细信息的错误原因（" & CrashReasons.First.Key & "），请向 PCL2 作者提交反馈以获取详情。\h" + End Select + + ResultString = ResultString. + Replace("\n", vbCrLf). + Replace("\h", If(IsHandAnalyze, "", vbCrLf & "如果要寻求帮助，请向他人发送错误报告文件，而不是发送这个窗口的截图。")). + Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")). + Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf) + Return ResultString.Trim(vbCrLf.ToCharArray) + End Function + +End Class diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb new file mode 100644 index 0000000..47acc39 --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb @@ -0,0 +1,1670 @@ +Public Module ModDownload + +#Region "DlClient* | Minecraft 客户端" + + ''' + ''' 返回某 Minecraft 版本对应的原版主 Jar 文件的下载信息，要求对应依赖版本已存在。 + ''' 失败则抛出异常，不需要下载则返回 Nothing。 + ''' + Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile + '获取底层继承版本 + Do While Not String.IsNullOrEmpty(Version.InheritVersion) + Version = New McVersion(Version.InheritVersion) + Loop + '检查 Json 是否标准 + If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then + Throw New Exception("底层版本 " & Version.Name & " 中无 Jar 文件下载信息") + End If + '检查文件 + Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1")) + If ReturnNothingOnFileUseable Then + '是否跳过 + Dim IsSetupSkip As Boolean = Setup.Get("LaunchAdvanceAssets") + Select Case Setup.Get("VersionAdvanceAssets", Version:=Version) + Case 0 '使用全局设置 + Case 1 '开启 + IsSetupSkip = False + Case 2 '关闭 + IsSetupSkip = True + End Select + If IsSetupSkip AndAlso File.Exists(Version.Path & Version.Name & ".jar") Then Return Nothing '跳过校验 + If Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验 + End If + '返回下载信息 + Dim JarUrl As String = Version.JsonObject("downloads")("client")("url") + Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker) + End Function + + ''' + ''' 返回某 Minecraft 版本对应的原版主 AssetIndex 文件的下载信息，要求对应依赖版本已存在。 + ''' 若未找到，则会返回 Legacy 资源文件或 Nothing。 + ''' + Public Function DlClientAssetIndexGet(Version As McVersion) As NetFile + '获取底层继承版本 + Do While Not String.IsNullOrEmpty(Version.InheritVersion) + Version = New McVersion(Version.InheritVersion) + Loop + '获取信息 + Dim IndexInfo = McAssetsGetIndex(Version, True, True) + Dim IndexAddress As String = PathMcFolder & "assets\indexes\" & IndexInfo("id").ToString & ".json" + Log("[Download] 版本 " & Version.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString) + Dim IndexUrl As String = If(IndexInfo("url"), "") + If IndexUrl = "" Then + Return Nothing + Else + Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl, False), IndexAddress, New FileChecker(CanUseExistsFile:=False, IsJson:=True)) + End If + End Function + + ''' + ''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。 + ''' + Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour, SkipAssetsDownloadWhileSetupRequired As Boolean) As List(Of LoaderBase) + Dim Loaders As New List(Of LoaderBase) + +#Region "下载支持库文件" + Dim LoadersLib As New List(Of LoaderBase) From { + New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1}, + New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15} + } + '构造加载器 + Loaders.Add(New LoaderCombo(Of String)("下载支持库文件（主加载器）", LoadersLib) With {.Block = False, .Show = False, .ProgressWeight = 16}) +#End Region + +#Region "下载资源文件" + Dim IsSetupSkip As Boolean = Setup.Get("LaunchAdvanceAssets") + Select Case Setup.Get("VersionAdvanceAssets", Version:=Version) + Case 0 + '使用全局设置 + Case 1 + '开启 + IsSetupSkip = False + Case 2 + '关闭 + IsSetupSkip = True + End Select + If IsSetupSkip Then Log("[Download] 已跳过 Assets 下载") + If (Not SkipAssetsDownloadWhileSetupRequired) OrElse Not IsSetupSkip Then + Dim LoadersAssets As New List(Of LoaderBase) + '获取资源文件索引地址 + LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + Try + Dim IndexFile = DlClientAssetIndexGet(Version) + Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath) + If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then + Task.Output = New List(Of NetFile) + Else + Task.Output = New List(Of NetFile) From {IndexFile} + End If + Catch ex As Exception + Throw New Exception("分析资源文件索引地址失败", ex) + End Try + End Sub) With {.ProgressWeight = 0.5, .Show = False}) + '下载资源文件索引 + LoadersAssets.Add(New LoaderDownload("下载资源文件索引", New List(Of NetFile)) With {.ProgressWeight = 2}) + '要求独立更新索引 + If AssetsIndexBehaviour = AssetsIndexExistsBehaviour.DownloadInBackground Then + Dim LoadersAssetsUpdate As New List(Of LoaderBase) + Dim TempAddress As String = Nothing + Dim RealAddress As String = Nothing + LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址", Sub(Task As LoaderTask(Of String, List(Of NetFile))) + Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version) + RealAddress = BackAssetsFile.LocalPath + TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName + BackAssetsFile.LocalPath = TempAddress + Task.Output = New List(Of NetFile) From {BackAssetsFile} + End Sub)) + LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile))) + LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引", Sub(Task As LoaderTask(Of List(Of NetFile), String)) + Try + File.Copy(TempAddress, RealAddress, True) + McLaunchLog("后台更新资源文件索引成功：" & TempAddress) + Catch ex As Exception + Log(ex, "后台更新资源文件索引失败", LogLevel.Debug) + McLaunchLog("后台更新资源文件索引失败：" & TempAddress) + End Try + End Sub)) + Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate) + Log("[Download] 开始后台更新资源文件索引") + Updater.Start() + End If + '获取资源文件地址 + LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task) + End Sub) With {.ProgressWeight = 3}) + '下载资源文件 + LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25}) + '构造加载器 + Loaders.Add(New LoaderCombo(Of String)("下载资源文件（主加载器）", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 30.5}) + End If +#End Region + + Return Loaders + End Function + Public Enum AssetsIndexExistsBehaviour + ''' + ''' 如果文件存在，则不进行下载。 + ''' + DontDownload + ''' + ''' 如果文件存在，则启动新的下载加载器进行独立的更新。 + ''' + DownloadInBackground + ''' + ''' 如果文件存在，也同样进行下载。 + ''' + AlwaysDownload + End Enum + +#End Region + +#Region "DlClientList | Minecraft 客户端 版本列表" + + '主加载器 + Public Structure DlClientListResult + ''' + ''' 数据来源名称，如“Mojang”，“BMCLAPI”。 + ''' + Public SourceName As String + ''' + ''' 是否为官方的实时数据。 + ''' + Public IsOfficial As Boolean + ''' + ''' 获取到的 Json 数据。 + ''' + Public Value As JObject + '''' + '''' 官方源的失败原因。若没有则为 Nothing。 + '''' + 'Public OfficialError As Exception + End Structure + ''' + ''' Minecraft 客户端 版本列表，主加载器。 + ''' + Public DlClientListLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain) + Private Sub DlClientListMain(Loader As LoaderTask(Of Integer, DlClientListResult)) + Select Case Setup.Get("ToolDownloadVersion") + Case 0 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30), + New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60) + }, Loader.IsForceRestarting) + Case 1 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 5), + New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 35) + }, Loader.IsForceRestarting) + Case Else + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60), + New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60) + }, Loader.IsForceRestarting) + End Select + End Sub + + '各个下载源的分加载器 + ''' + ''' Minecraft 客户端 版本列表，Mojang 官方源加载器。 + ''' + Public DlClientListMojangLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain) + Private IsNewClientVersionHinted As Boolean = False + Private Sub DlClientListMojangMain(Loader As LoaderTask(Of Integer, DlClientListResult)) + 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 & "）") + '添加 PCL2 特供项 + If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json"))) + '返回 + Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json} + '解析更新提示（Release） + Dim Version As String = Json("latest")("release") + If Setup.Get("ToolUpdateRelease") AndAlso Not Setup.Get("ToolUpdateReleaseLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateReleaseLast") = Version Then + McDownloadClientUpdateHint(Version, Json) + IsNewClientVersionHinted = True + End If + Setup.Set("ToolUpdateReleaseLast", Version) + '解析更新提示（Snapshot） + Version = Json("latest")("snapshot") + If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = Version AndAlso Not IsNewClientVersionHinted Then + McDownloadClientUpdateHint(Version, Json) + End If + Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing")) + Catch ex As Exception + Throw New Exception("版本列表解析失败", ex) + End Try + End Sub + ''' + ''' Minecraft 客户端 版本列表，BMCLAPI 源加载器。 + ''' + Public DlClientListBmclapiLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain) + Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of Integer, DlClientListResult)) + Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.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 & "）") + '添加 PCL2 特供项 + If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json"))) + '返回 + Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json} + Catch ex As Exception + Throw New Exception("版本列表解析失败（" & Json.ToString & "）", ex) + End Try + End Sub + + ''' + ''' 获取某个版本的 Json 下载地址，若失败则返回 Nothing。必须在工作线程执行。 + ''' + Public Function DlClientListGet(Id As String) + Try + '确认 Minecraft 版本列表已完成获取 + Select Case DlClientListLoader.State + Case LoadState.Loading + DlClientListLoader.WaitForExit() + Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting + DlClientListLoader.WaitForExit(IsForceRestart:=True) + End Select + '确认版本格式标准 + Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4 + If Id <> "1.0" AndAlso Id.EndsWith(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题，显示版本为 1.8.0 + '查找版本并开始 + For Each Version As JObject In DlClientListLoader.Output.Value("versions") + If Version("id") = Id Then + Return Version("url").ToString + End If + Next + Log("未发现版本 " & Id & " 的 Json 下载地址，版本列表返回为：" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug) + Return Nothing + Catch ex As Exception + Log(ex, "获取版本 " & Id & " 的 Json 下载地址失败") + Return Nothing + End Try + End Function + +#End Region + +#Region "DlOptiFineList | OptiFine 版本列表" + + Public Structure DlOptiFineListResult + ''' + ''' 数据来源名称，如“Official”，“BMCLAPI”。 + ''' + Public SourceName As String + ''' + ''' 是否为官方的实时数据。 + ''' + Public IsOfficial As Boolean + ''' + ''' 获取到的数据。 + ''' + Public Value As List(Of DlOptiFineListEntry) + End Structure + Public Class DlOptiFineListEntry + ''' + ''' 显示名称，已去除 HD_U 字样，如“1.12.2 C8”。 + ''' + Public NameDisplay As String + ''' + ''' 原始文件名称，如“preview_OptiFine_1.11_HD_U_E1_pre.jar”。 + ''' + Public NameFile As String + ''' + ''' 对应的版本名称，如“1.13.2-OptiFine_HD_U_E6”。 + ''' + Public NameVersion As String + ''' + ''' 是否为测试版。 + ''' + Public IsPreview As Boolean + ''' + ''' 对应的 Minecraft 版本，如“1.12.2”。 + ''' + Public Property Inherit As String + Get + Return _inherit + End Get + Set(value As String) + If value.EndsWith(".0") Then value = Left(value, value.Length - 2) + _inherit = value + End Set + End Property + Private _inherit As String + ''' + ''' 发布时间，格式为“yyyy/mm/dd”。OptiFine 源无此数据。 + ''' + Public ReleaseTime As String + End Class + + ''' + ''' OptiFine 版本列表，主加载器。 + ''' + Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain) + Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult)) + Select Case Setup.Get("ToolDownloadVersion") + Case 0 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30), + New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60) + }, Loader.IsForceRestarting) + Case 1 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 5), + New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 35) + }, Loader.IsForceRestarting) + Case Else + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60), + New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60) + }, Loader.IsForceRestarting) + End Select + End Sub + + ''' + ''' OptiFine 版本列表，官方源。 + ''' + Public DlOptiFineListOfficialLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Official", AddressOf DlOptiFineListOfficialMain) + Private Sub DlOptiFineListOfficialMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult)) + Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default) + If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）") + '获取所有版本信息 + Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=Date'>)[^<]+") + Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")") + If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应") + If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）") + '转化为列表输出 + Dim Versions As New List(Of DlOptiFineListEntry) + For i = 0 To ReleaseTime.Count - 1 + Name(i) = Name(i).Replace("_", " ") + Dim Entry As New DlOptiFineListEntry With { + .NameDisplay = Name(i).ToString.Replace("HD U ", "").Replace(".0 ", " "), + .ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"), + .IsPreview = Name(i).ToString.ToLower.Contains("pre"), + .Inherit = Name(i).ToString.Split(" ")(0), + .NameFile = If(Name(i).ToString.ToLower.Contains("pre"), "preview_", "") & + "OptiFine_" & Name(i).ToString.Replace(" ", "_") & ".jar"} + Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "") + Versions.Add(Entry) + Next + Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions} + End Sub + + ''' + ''' OptiFine 版本列表，BMCLAPI。 + ''' + Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain) + Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult)) + Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList", IsJson:=True) + Try + Dim Versions As New List(Of DlOptiFineListEntry) + For Each Token As JObject In Json + Dim Entry As New DlOptiFineListEntry With { + .NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "), + .ReleaseTime = "", + .IsPreview = Token("patch").ToString.ToLower.Contains("pre"), + .Inherit = Token("mcversion").ToString, + .NameFile = Token("filename").ToString + } + Entry.NameVersion = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "") + Versions.Add(Entry) + Next + Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions} + Catch ex As Exception + Throw New Exception("版本列表解析失败（" & Json.ToString & "）", ex) + End Try + End Sub + +#End Region + +#Region "DlForgeList | Forge Minecraft 版本列表" + + Public Structure DlForgeListResult + ''' + ''' 数据来源名称，如“Official”，“BMCLAPI”。 + ''' + Public SourceName As String + ''' + ''' 是否为官方的实时数据。 + ''' + Public IsOfficial As Boolean + ''' + ''' 获取到的数据。 + ''' + Public Value As List(Of String) + End Structure + + ''' + ''' Forge 版本列表，主加载器。 + ''' + Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain) + Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult)) + Select Case Setup.Get("ToolDownloadVersion") + Case 0 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30), + New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60) + }, Loader.IsForceRestarting) + Case 1 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 5), + New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 35) + }, Loader.IsForceRestarting) + Case Else + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60), + New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60) + }, Loader.IsForceRestarting) + End Select + End Sub + + ''' + ''' Forge 版本列表，官方源。 + ''' + Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain) + Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult)) + Dim Result As String = NetGetCodeByRequestRetry("http://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html") + If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）") + '获取所有版本信息 + Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)") + Names.Add("1.2.4") '1.2.4 不会被匹配上 + If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）") + Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names} + End Sub + + ''' + ''' Forge 版本列表，BMCLAPI。 + ''' + Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain) + Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult)) + Dim Result As String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default) + If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）") + '获取所有版本信息 + Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?") + If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）") + Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names} + End Sub + +#End Region + +#Region "DlForgeVersion | Forge 版本列表" + + Public Class DlForgeVersionEntry + ''' + ''' 完整的版本名，如 “14.22.1.2478”。 + ''' + Public Version As String + ''' + ''' 对应的 Minecraft 版本，如“1.12.2”。 + ''' + Public Inherit As String + ''' + ''' 发布时间，格式为“yyyy/MM/dd HH:mm”。 + ''' + Public ReleaseTime As String + ''' + ''' 文件的 MD5 或 SHA1（BMCLAPI 的老版本是 MD5，新版本是 SHA1；官方源总是 MD5）。 + ''' + Public Hash As String = Nothing + ''' + ''' 是否为推荐版本。 + ''' + Public IsRecommended As Boolean + ''' + ''' 安装类型。有 installer、client、universal 三种。 + ''' + Public Category As String + ''' + ''' 版本分支。若无分支则为 Nothing。 + ''' + Public Branch As String = Nothing + ''' + ''' 是否为新版 Forge。（即为 Minecraft 1.13+） + ''' + Public ReadOnly Property IsNewType As Boolean + Get + Return Version.Split(".")(0) >= 20 + End Get + End Property + ''' + ''' 构建数。 + ''' + Public ReadOnly Property Build As Integer + Get + Dim Version = Me.Version.Split(".") + If Version(0) < 15 Then + Return Version(Version.Count - 1) + Else + Return Version(Version.Count - 1) + 10000 + End If + End Get + End Property + ''' + ''' 用于下载的文件版本名。可能在 Version 的基础上添加了分支。 + ''' + Public ReadOnly Property FileVersion As String + Get + Return Version & If(Branch Is Nothing, ""， "-" & Branch) + End Get + End Property + ''' + ''' 即将下载的文件全名。 + ''' + Public ReadOnly Property FileName As String + Get + Return "forge-" & Inherit & "-" & FileVersion & "-" & Category & "." & FileSuffix + End Get + End Property + ''' + ''' 文件扩展名。 + ''' + Public ReadOnly Property FileSuffix As String + Get + If Category = "installer" Then + Return "jar" + Else + Return "zip" + End If + End Get + End Property + End Class + + ''' + ''' Forge 版本列表，主加载器。 + ''' + Public Sub DlForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) + Dim DlForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Official", AddressOf DlForgeVersionOfficialMain) + Dim DlForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Bmclapi", AddressOf DlForgeVersionBmclapiMain) + Select Case Setup.Get("ToolDownloadVersion") + Case 0 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From { + New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30), + New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60) + }, Loader.IsForceRestarting) + Case 1 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From { + New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 5), + New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 35) + }, Loader.IsForceRestarting) + Case Else + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From { + New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60), + New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60) + }, Loader.IsForceRestarting) + End Select + End Sub + + ''' + ''' Forge 版本列表，官方源。 + ''' + Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) + Dim Result As String + Try + Result = NetGetCodeByDownload("http://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html") + Catch ex As Exception + If GetString(ex).Contains("(404)") Then + Throw New Exception("没有可用版本") + Else + Throw + End If + End Try + If Result.Length < 1000 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）") + Dim Versions As New List(Of DlForgeVersionEntry) + Try + '分割版本信息 + Dim VersionCodes = Mid(Result, 1, Result.LastIndexOf("")).Replace("[\s]*)[^<]+") + Branch = RegexSeek(If(Branch, ""), "[^\s]+") + If String.IsNullOrWhiteSpace(Branch) Then Branch = Nothing + If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9" + If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10" + '发布时间获取 + Dim ReleaseTimeOriginal = RegexSeek(VersionCode, "(?<=""download-time"" title="")[^""]+") + Dim ReleaseTimeSplit = ReleaseTimeOriginal.Split(" -:".ToCharArray) '原格式："2021-02-15 03:24:02" + Dim ReleaseDate As New Date(ReleaseTimeSplit(0), ReleaseTimeSplit(1), ReleaseTimeSplit(2), '年月日 + ReleaseTimeSplit(3), ReleaseTimeSplit(4), ReleaseTimeSplit(5), '时分秒 + 0, DateTimeKind.Utc) '以 UTC 时间作为标准 + Dim ReleaseTime As String = ReleaseDate.ToLocalTime.ToString("yyyy/MM/dd HH:mm") '时区与格式转换 + '分类与 MD5 获取 + Dim MD5 As String, Category As String + If VersionCode.Contains("classifier-installer""") Then + '类型为 installer.jar，支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部) + VersionCode = VersionCode.Substring(VersionCode.IndexOf("installer.jar")) + MD5 = RegexSeek(VersionCode, "(?<=MD5: )[^<]+") + Category = "installer" + ElseIf VersionCode.Contains("classifier-universal""") Then + '类型为 universal.zip，支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分) + VersionCode = VersionCode.Substring(VersionCode.IndexOf("universal.zip")) + MD5 = RegexSeek(VersionCode, "(?<=MD5: )[^<]+") + Category = "universal" + Else + '类型为 client.zip，支持范围 182~ (1.3.2 部分 ~) + VersionCode = VersionCode.Substring(VersionCode.IndexOf("client.zip")) + MD5 = RegexSeek(VersionCode, "(?<=MD5: )[^<]+") + Category = "client" + End If + '添加进列表 + Versions.Add(New DlForgeVersionEntry With {.Category = Category, .Version = Name, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .Inherit = Inherit, .ReleaseTime = ReleaseTime, .Branch = Branch}) + Catch ex As Exception + Throw New Exception("版本信息提取失败（" & VersionCode & "）", ex) + End Try + Next + Catch ex As Exception + Throw New Exception("版本列表解析失败（" & Result & "）", ex) + End Try + If Versions.Count = 0 Then Throw New Exception("没有可用版本") + Loader.Output = Versions + End Sub + + ''' + ''' Forge 版本列表，BMCLAPI。 + ''' + Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) + Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input, IsJson:=True) + Dim Versions As New List(Of DlForgeVersionEntry) + Try + Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input) + For Each Token As JObject In Json + '分类与 Hash 获取 + Dim Hash As String = Nothing, Category As String = "unknown", Proi As Integer = -1 + For Each File As JObject In Token("files") + Select Case File("category").ToString + Case "installer" + If File("format").ToString = "jar" Then + '类型为 installer.jar，支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部) + Hash = File("hash") + Category = "installer" + Proi = 2 + End If + Case "universal" + If Proi <= 1 AndAlso File("format").ToString = "zip" Then + '类型为 universal.zip，支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分) + Hash = File("hash") + Category = "universal" + Proi = 1 + End If + Case "client" + If Proi <= 0 AndAlso File("format").ToString = "zip" Then + '类型为 client.zip，支持范围 182~ (1.3.2 部分 ~) + Hash = File("hash") + Category = "client" + Proi = 0 + End If + End Select + Next + '获取 Entry + Dim Inherit As String = Loader.Input + Dim Branch As String = Token("branch") + Dim Name As String = Token("version") + If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9" + If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10" + '基础信息获取 + Dim Entry = New DlForgeVersionEntry With {.Hash = Hash, .Category = Category, .Version = Name, .Branch = Branch, .Inherit = Inherit, .IsRecommended = Recommended = Name} + Dim TimeSplit = Token("modified").ToString.Split("-"c, "T"c, ":"c, "."c, " "c, "/"c) + Entry.ReleaseTime = Token("modified").ToObject(Of Date).ToLocalTime.ToString("yyyy/MM/dd HH:mm") + '添加项 + Versions.Add(Entry) + Next + Catch ex As Exception + Throw New Exception("版本列表解析失败（" & Json.ToString & "）", ex) + End Try + If Versions.Count = 0 Then Throw New Exception("没有可用版本") + Loader.Output = Versions + End Sub + +#End Region + +#Region "DlLiteLoaderList | LiteLoader 版本列表" + + Public Structure DlLiteLoaderListResult + ''' + ''' 数据来源名称，如“Official”，“BMCLAPI”。 + ''' + Public SourceName As String + ''' + ''' 是否为官方的实时数据。 + ''' + Public IsOfficial As Boolean + ''' + ''' 获取到的数据。 + ''' + Public Value As List(Of DlLiteLoaderListEntry) + ''' + ''' 官方源的失败原因。若没有则为 Nothing。 + ''' + Public OfficialError As Exception + End Structure + Public Class DlLiteLoaderListEntry + ''' + ''' 实际的文件名，如“liteloader-installer-1.12-00-SNAPSHOT.jar”。 + ''' + Public FileName As String + ''' + ''' 是否为测试版。 + ''' + Public IsPreview As Boolean + ''' + ''' 对应的 Minecraft 版本，如“1.12.2”。 + ''' + Public Inherit As String + ''' + ''' 是否为 1.7 及更早的远古版。 + ''' + Public IsLegacy As Boolean + ''' + ''' 发布时间，格式为“yyyy/mm/dd HH:mm:ss”。 + ''' + Public ReleaseTime As String + ''' + ''' 文件的 MD5。 + ''' + Public MD5 As String + ''' + ''' 对应的 Json 项。 + ''' + Public JsonToken As JToken + End Class + + ''' + ''' LiteLoader 版本列表，主加载器。 + ''' + Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain) + Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult)) + Select Case Setup.Get("ToolDownloadVersion") + Case 0 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30), + New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60) + }, Loader.IsForceRestarting) + Case 1 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 5), + New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 35) + }, Loader.IsForceRestarting) + Case Else + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60), + New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60) + }, Loader.IsForceRestarting) + End Select + End Sub + + ''' + ''' LiteLoader 版本列表，官方源。 + ''' + Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain) + Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult)) + Dim Result As JObject = NetGetCodeByRequestRetry("http://dl.liteloader.com/versions/versions.json", IsJson:=True) + Try + Dim Json As JObject = Result("versions") + Dim Versions As New List(Of DlLiteLoaderListEntry) + For Each Pair As KeyValuePair(Of String, JToken) In Json + If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For + Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest") + Versions.Add(New DlLiteLoaderListEntry With { + .Inherit = Pair.Key, + .IsLegacy = Pair.Key.Split(".")(1) < 8, + .IsPreview = RealEntry("stream").ToString.ToLower = "snapshot", + .FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar", + .MD5 = RealEntry("md5"), + .ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm:ss"), + .JsonToken = RealEntry + }) + Next + Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = True, .SourceName = "LiteLoader 官方源", .Value = Versions} + Catch ex As Exception + Throw New Exception("版本列表解析失败（" & Result.ToString & "）", ex) + End Try + End Sub + + ''' + ''' LiteLoader 版本列表，BMCLAPI。 + ''' + Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain) + Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult)) + Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", IsJson:=True) + Try + Dim Json As JObject = Result("versions") + Dim Versions As New List(Of DlLiteLoaderListEntry) + For Each Pair As KeyValuePair(Of String, JToken) In Json + If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For + Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest") + Versions.Add(New DlLiteLoaderListEntry With { + .Inherit = Pair.Key, + .IsLegacy = Pair.Key.Split(".")(1) < 8, + .IsPreview = RealEntry("stream").ToString.ToLower = "snapshot", + .FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar", + .MD5 = RealEntry("md5"), + .ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm:ss"), + .JsonToken = RealEntry + }) + Next + Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions} + Catch ex As Exception + Throw New Exception("版本列表解析失败（" & Result.ToString & "）", ex) + End Try + End Sub + +#End Region + +#Region "DlFabricList | Fabric 列表" + + Public Structure DlFabricListResult + ''' + ''' 数据来源名称，如“Official”，“BMCLAPI”。 + ''' + Public SourceName As String + ''' + ''' 是否为官方的实时数据。 + ''' + Public IsOfficial As Boolean + ''' + ''' 获取到的数据。 + ''' + Public Value As JObject + End Structure + + ''' + ''' Fabric 列表，主加载器。 + ''' + Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain) + Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult)) + Select Case Setup.Get("ToolDownloadVersion") + Case 0 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30), + New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60) + }, Loader.IsForceRestarting) + Case 1 + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 5), + New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 35) + }, Loader.IsForceRestarting) + Case Else + DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From { + New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60), + New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60) + }, Loader.IsForceRestarting) + End Select + End Sub + + ''' + ''' Fabric 列表，官方源。 + ''' + Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain) + Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult)) + Dim Result As JObject = NetGetCodeByRequestRetry("https://meta.fabricmc.net/v2/versions", IsJson:=True) + Try + Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result} + If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项") + Loader.Output = Output + Catch ex As Exception + Throw New Exception("列表解析失败（" & Result.ToString & "）", ex) + End Try + End Sub + + ''' + ''' Fabric 列表，BMCLAPI。 + ''' + Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain) + Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult)) + Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", IsJson:=True) + Try + Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result} + If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项") + Loader.Output = Output + Catch ex As Exception + Throw New Exception("列表解析失败（" & Result.ToString & "）", ex) + End Try + End Sub + + ''' + ''' Fabric API 列表，官方源。 + ''' + Public DlFabricApiLoader As New LoaderTask(Of Integer, List(Of DlCfFile))("Fabric API List Loader", + Sub(Task As LoaderTask(Of Integer, List(Of DlCfFile))) Task.Output = DlCfGetFiles(306612, False)) + + ''' + ''' OptiFabric 列表，官方源。 + ''' + Public DlOptiFabricLoader As New LoaderTask(Of Integer, List(Of DlCfFile))("OptiFabric List Loader", + Sub(Task As LoaderTask(Of Integer, List(Of DlCfFile))) Task.Output = DlCfGetFiles(322385, False)) + +#End Region + +#Region "DlCfProject | CurseForge 工程" + + Private DlCfProjectDb As JObject = Nothing + Private DlCfProjectCache As New Dictionary(Of Integer, DlCfProject) + + ''' + ''' CurseForge 工程列表获取、搜索请求。 + ''' + Public Class DlCfProjectRequest + Public CategoryId As Integer = 0 '421: Mod(?), 4780: Fabric + Public IsModPack As Boolean = False + Public GameVersion As String = Nothing + Public PageSize As String = 50 + Public SearchFilter As String = Nothing + Public Index As Integer? = Nothing + Public ModLoader As Integer? = Nothing + Public Function GetAddress() As String + GetAddress = "https://api.curseforge.com/v1/mods/search?gameId=432&sortField=Featured&sortOrder=desc" & + "&pageSize=" & PageSize & + "&categoryId=" & CategoryId & + If(IsModPack, "&classId=4471", "&classId=6") & + If(String.IsNullOrEmpty(GameVersion), "", "&gameVersion=" & GameVersion) & + If(String.IsNullOrEmpty(SearchFilter), "", "&searchFilter=" & Net.WebUtility.UrlEncode(SearchFilter)) & + If(Index IsNot Nothing, "&index=" & Index, "") & + If(ModLoader IsNot Nothing AndAlso ModLoader > 0, "&modLoaderType=" & ModLoader, "") + End Function + +#Region "相同判断" + + Public Overrides Function Equals(obj As Object) As Boolean + Dim request = TryCast(obj, DlCfProjectRequest) + Return request IsNot Nothing AndAlso request.GetAddress = GetAddress() + End Function + Public Shared Operator =(left As DlCfProjectRequest, right As DlCfProjectRequest) As Boolean + Return EqualityComparer(Of DlCfProjectRequest).Default.Equals(left, right) + End Operator + Public Shared Operator <>(left As DlCfProjectRequest, right As DlCfProjectRequest) As Boolean + Return Not left = right + End Operator + +#End Region + + End Class + + ''' + ''' CurseForge 工程信息。 + ''' + Public Class DlCfProject + + Public Id As Integer + Public Name As String + Public McWikiId As Integer = 0 + Public Description As String + Public Website As String + Public DateUpdate As Date + Public DownloadCount As Integer + Public ModLoaders As New List(Of String) + Public GameVersionDesc As String + Private CategoryDesc As List(Of String) + Private Thumb As String + Public IsModPack As Boolean + Public FileIndexes As New List(Of Integer) + Public Files As List(Of DlCfFile) + Private _MCBBS As String + Public Property MCBBS As String + Get + If DlCfProjectDb Is Nothing Then + DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData"))) + End If + If _MCBBS Is Nothing Then + If Website IsNot Nothing Then + Dim Keyword As String = Website.TrimEnd("/").Split("/").Last + If DlCfProjectDb.ContainsKey(Keyword) Then + Dim Result As String() = DlCfProjectDb(Keyword).ToString.Split("|") + If Result.Length = 3 Then _MCBBS = Result.Last + End If + End If + End If + Return _MCBBS + End Get + Set(value As String) + _MCBBS = value + End Set + End Property + Private _ChineseName As String + Public Property ChineseName As String + Get + If DlCfProjectDb Is Nothing Then + DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData"))) + End If + If _ChineseName Is Nothing Then + _ChineseName = Name + If Website IsNot Nothing Then + Dim Keyword As String = Website.TrimEnd("/").Split("/").Last + If DlCfProjectDb.ContainsKey(Keyword) Then + Dim Result As String = DlCfProjectDb(Keyword) + McWikiId = Result.Split("|")(0) + If Not Result.Split("|")(1) = "~" Then '使用原名 + _ChineseName = Result.Split("|")(1) '& " (" & Name & ")" + End If + End If + End If + End If + Return _ChineseName + End Get + Set(ByVal value As String) + _ChineseName = value + End Set + End Property + + ''' + ''' 从 CurseForge 工程 Json 项中初始化实例。若出错会抛出异常。 + ''' + Public Sub New(Data As JObject) + 'https://api.curseforge.com/v1/mods/search?gameId=432&pageSize=5&categoryID=421 + Id = Data("id") + Name = Data("name") + Description = Data("summary") + Website = Data("links")("websiteUrl") + DateUpdate = Data("dateModified") + DownloadCount = Data("downloadCount") + IsModPack = Not Website.Contains("/mc-mods/") + '获取常见文件 + For Each File In If(Data("latestFiles"), {}) + Dim NewFile As New DlCfFile(File, IsModPack) + If Not NewFile.IsAvailable Then Continue For + Next + '获取游戏版本、Mod Loader + Dim GameVersions As New List(Of Integer) + ModLoaders = New List(Of String) + For Each File In If(Data("latestFilesIndexes"), {}) + Dim Version As String = File("gameVersion") + If Not Version.Contains("1.") Then Continue For + GameVersions.Add(Version.Split(".")(1).Split("-").First) + Select Case If(File("modLoader"), "0").ToString + Case 1 + ModLoaders.Add("Forge") + Case 2 + ModLoaders.Add("Cauldron") + Case 3 + ModLoaders.Add("LiteLoader") + Case 4 + ModLoaders.Add("Fabric") + End Select + FileIndexes.Add(File("fileId")) + Next + GameVersions = Sort(GameVersions.Distinct.ToList, AddressOf VersionSortBoolean) + ModLoaders = ModLoaders.Distinct.ToList + ModLoaders.Sort() + If GameVersions.Count = 0 Then + GameVersionDesc = "" + Else + Dim SpaVersions As New List(Of String) + For i = 0 To GameVersions.Count - 1 + Dim StartVersion As Integer = GameVersions(i), EndVersion As Integer = GameVersions(i) + For ii = i + 1 To GameVersions.Count - 1 + If GameVersions(ii) = EndVersion - 1 Then + EndVersion = GameVersions(ii) + i = ii + Else + Exit For + End If + Next + If StartVersion = EndVersion Then + SpaVersions.Add("1." & StartVersion) + Else + SpaVersions.Add("1." & StartVersion & "-1." & EndVersion) + End If + Next + GameVersionDesc = "[" & Join(SpaVersions, ", ") & "] " + End If + '获取分类 + Dim Categories = Data("categories") + Dim CategoryId As New List(Of Integer) + For Each CategoryToken In Categories + CategoryId.Add(CategoryToken("id")) + Next + CategoryId = ArrayNoDouble(CategoryId) + CategoryId.Sort() + CategoryDesc = New List(Of String) + For Each Category In CategoryId + Dim Desc As String + Select Case Category + + Case 406 : Desc = "世界生成" + Case 407 : Desc = "生物群系" + Case 409 : Desc = "天然结构" + Case 410 : Desc = "维度" + Case 411 : Desc = "生物" + Case 412 : Desc = "科技" + Case 414 : Desc = "交通与移动" + Case 415 : Desc = "管道与物流" + Case 417 : Desc = "能源" + Case 4558 : Desc = "红石" + Case 420 : Desc = "仓储" + Case 416 : Desc = "农业" + Case 436 : Desc = "食物" + Case 419 : Desc = "魔法" + Case 434 : Desc = "装备与工具" + Case 422 : Desc = "冒险与探索" + Case 424 : Desc = "建筑与装饰" + Case 423 : Desc = "信息显示" + Case 425 : Desc = "杂项" + Case 421 : Desc = "支持库" + Case 435 : Desc = "服务器" + + Case 4471 : Desc = "科幻" + Case 4483 : Desc = "战斗" + Case 4477 : Desc = "小游戏" + Case 4478 : Desc = "任务" + Case 4484 : Desc = "多人" + Case 4476 : Desc = "探索" + Case 4736 : Desc = "空岛" + Case 4475 : Desc = "冒险" + Case 4487 : Desc = "FTB" + Case 4480 : Desc = "基于地图" + Case 4479 : Desc = "硬核" + Case 4472 : Desc = "科技" + Case 4473 : Desc = "魔法" + Case 4481 : Desc = "小型整合" + Case 4482 : Desc = "大型整合" + + Case Else : Continue For + End Select + CategoryDesc.Add(Desc) + Next + If CategoryDesc.Count = 0 Then CategoryDesc.Add("杂类") + '获取图片 + If Data("logo").Count > 0 Then + If GetPixelSize(1) > 1.25 Then + Thumb = Data("logo")("thumbnailUrl").ToString '使用 256x256 图标 + Else + Thumb = Data("logo")("thumbnailUrl").ToString.Replace("/256/256/", "/64/64/") '使用 64x64 图标 + End If + End If + '保存缓存 + If Not DlCfProjectCache.ContainsKey(Id) OrElse DlCfProjectCache(Id).Files Is Nothing Then DictionaryAdd(DlCfProjectCache, Id, Me) + End Sub + + Public Function ToCfItem(ShowVersionDesc As Boolean, ShowLoaderDesc As Boolean, Optional OnClick As MyCfItem.ClickEventHandler = Nothing) As MyCfItem + Dim NewItem As New MyCfItem With {.Tag = Me} + NewItem.LabTitle.Text = ChineseName + NewItem.LabInfo.Text = Description.Replace(vbCr, "").Replace(vbLf, "") + NewItem.LabLeft.Text = If(ModLoaders.Count > 0 AndAlso ShowLoaderDesc, "[" & Join(ModLoaders, " & ") & "] ", "") & + If(ShowVersionDesc, GameVersionDesc, "") & + Join(CategoryDesc, "，") & " (" & + GetTimeSpanString(DateUpdate - Date.Now) & "更新" & + If(DownloadCount > 0, "，" & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载）", DownloadCount & " 次下载）"), "") + If Thumb Is Nothing Then + NewItem.Logo = "pack://application:,,,/images/Icons/NoIcon.png" + Else + NewItem.Logo = Thumb + End If + If OnClick IsNot Nothing Then + AddHandler NewItem.Click, OnClick + NewItem.HasAnimation = True + Else + NewItem.HasAnimation = False + End If + '结束 + Return NewItem + End Function + + Public Overrides Function Equals(obj As Object) As Boolean + Dim project = TryCast(obj, DlCfProject) + Return project IsNot Nothing AndAlso Id = project.Id + End Function + Public Shared Operator =(left As DlCfProject, right As DlCfProject) As Boolean + Return EqualityComparer(Of DlCfProject).Default.Equals(left, right) + End Operator + Public Shared Operator <>(left As DlCfProject, right As DlCfProject) As Boolean + Return Not left = right + End Operator + End Class + + Public Class DlCfProjectResult + Public Projects As List(Of DlCfProject) + Public Index As Integer + Public RealCount As Long + End Class + ''' + ''' CurseForge 工程列表获取事件。 + ''' + Public Sub DlCfProjectSub(Task As LoaderTask(Of DlCfProjectRequest, DlCfProjectResult)) + Dim RawFilter As String = If(Task.Input.SearchFilter, "") + Task.Input.SearchFilter = RawFilter + Log("[Download] CurseForge 工程列表搜索原始文本：" & RawFilter) + '中文请求关键字处理 + Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]") + If IsChineseSearch AndAlso Not String.IsNullOrEmpty(RawFilter) Then + If Task.Input.IsModPack Then Throw New Exception("整合包搜索仅支持英文") + '释放资料库文件 + If DlCfProjectDb Is Nothing Then + DlCfProjectDb = GetJson(DecodeBytes(GetResources("ModData"))) + End If + '构造搜索请求 + Dim SearchEntries As New List(Of SearchEntry(Of String)) + For Each Entry In DlCfProjectDb + If Entry.Value.ToString.Contains("动态的树") Then Continue For '傻逼 Mod 的附属太多了 + SearchEntries.Add(New SearchEntry(Of String) With { + .Item = Entry.Value.ToString.Split("|")(1), + .SearchSource = New List(Of KeyValuePair(Of String, Double)) From { + New KeyValuePair(Of String, Double)(Entry.Value.ToString.Replace(" (", "|").Split("|")(1), 1) + } + }) + Next + '获取搜索结果 + Dim SearchResults = Search(SearchEntries, Task.Input.SearchFilter, 3) + If SearchResults.Count = 0 Then Throw New Exception("无搜索结果，请尝试搜索英文名称") + Dim SearchResult As String = "" + For i = 0 To SearchResults.Count - 1 + If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度 + SearchResult += SearchResults(i).Item.Replace(" (", "|").Split("|").Last.TrimEnd(")") & " " + Next + Log("[Download] CurseForge 工程列表中文搜索原始关键词：" & SearchResult, LogLevel.Developer) + '去除常见连接词 + Dim RealFilter As String = "" + For Each Word In SearchResult.Split(" ") + If {"the", "of", "a", "mod"}.Contains(Word.ToLower) Then Continue For + If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For + RealFilter += Word & " " + Next + Task.Input.SearchFilter = RealFilter + Log("[Download] CurseForge 工程列表中文搜索最终关键词：" & RealFilter, LogLevel.Developer) + End If + '驼峰英文请求关键字处理 + Dim SpacedKeywords = RegexReplace(Task.Input.SearchFilter, "$& ", "([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)") + Dim ConnectedKeywords = Task.Input.SearchFilter.Replace(" ", "") + Dim AllPossibleKeywords = SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchFilter, ConnectedKeywords & " " & RawFilter) + '最终处理关键字：分割、去重 + Dim RightKeywords As New List(Of String) + For Each Keyword In AllPossibleKeywords.Split(" ") + If Keyword.Trim = "" Then Continue For + RightKeywords.Add(Keyword) + Next + Task.Input.SearchFilter = Join(ArrayNoDouble(RightKeywords), " ").ToLower + Log("[Download] CurseForge 工程列表搜索最终文本：" & Task.Input.SearchFilter, LogLevel.Developer) + '正式获取 + Dim Url = Task.Input.GetAddress() + Log("[Download] 开始获取 CurseForge 工程列表：" & Url) + Dim RequestResult As JObject = NetGetCodeByRequestRetry(Url, IsJson:=True, Encode:=Encoding.UTF8) + Dim FileList = GetCfProjectListFromJson(RequestResult("data"), Task.Input.IsModPack) + If FileList.Count = 0 Then Throw New Exception("无搜索结果") + '重新排序 + If Not String.IsNullOrEmpty(Task.Input.SearchFilter) Then + '排序分 = 搜索相对相似度 + 默认排序相对活跃度 + Dim Scores As New Dictionary(Of DlCfProject, Double) + Dim Entry As New List(Of SearchEntry(Of DlCfProject)) + For i = 1 To FileList.Count + Dim File = FileList(i - 1) + Scores.Add(File, (1 - (i / FileList.Count))) + Entry.Add(New SearchEntry(Of DlCfProject) With {.Item = File, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From { + New KeyValuePair(Of String, Double)(If(IsChineseSearch, File.ChineseName, File.Name), 1), + New KeyValuePair(Of String, Double)(File.Description, 0.05)}}) + Next + Dim SearchResult = Search(Entry, RawFilter, 101, -1) + For Each OneResult In SearchResult + Scores(OneResult.Item) += OneResult.Similarity / SearchResult(0).Similarity + Next + '根据排序分得出结果 + Dim ResultList = Sort(Scores.ToList, Function(Left As KeyValuePair(Of DlCfProject, Double), Right As KeyValuePair(Of DlCfProject, Double)) + Return Left.Value > Right.Value + End Function) + FileList = New List(Of DlCfProject) + For Each Result In ResultList + FileList.Add(Result.Key) + Next + End If + Task.Output = New DlCfProjectResult With {.Projects = FileList, .Index = RequestResult("pagination")("index"), .RealCount = RequestResult("pagination")("totalCount")} + End Sub + ''' + ''' 从 API 返回的 Json 数组中获取工程信息数组。 + ''' + Private Function GetCfProjectListFromJson(Json As JArray, IsModPack As Boolean) As List(Of DlCfProject) + Dim FileList As New List(Of DlCfProject) + For Each JsonEntry As JObject In Json + Dim Result = GetCfProjectFromJson(JsonEntry, IsModPack) + If Result IsNot Nothing Then FileList.Add(Result) + Next + Return FileList + End Function + ''' + ''' 从 API 返回的 Json 中获取工程信息。 + ''' + Private Function GetCfProjectFromJson(Json As JObject, IsModPack As Boolean) As DlCfProject + If Json("links")("websiteUrl") Is Nothing Then + Log("[Download] 发现关键项为 Nothing 的工程：" & If(Json, "").ToString, LogLevel.Debug) + Return Nothing + End If + If IsModPack = Json("links")("websiteUrl").ToString.Contains("curseforge.com/minecraft/mc-mods") Then + Log("[Download] 返回的工程与要求的类别不一致：" & Json("links")("websiteUrl").ToString, LogLevel.Debug) + Return Nothing + End If + Return New DlCfProject(Json) + End Function + +#End Region + +#Region "DlCfFile | CurseForge Files" + + Public DlCfFileLoader As New LoaderTask(Of KeyValuePair(Of Integer, Boolean), List(Of DlCfFile))("DlCfFile Main", Sub(Task As LoaderTask(Of KeyValuePair(Of Integer, Boolean), List(Of DlCfFile))) Task.Output = DlCfGetFiles(Task.Input.Key, Task.Input.Value)) + + ''' + ''' CurseForge 工程下的单一版本文件。 + ''' + Public Class DlCfFile + + Public IsModPack As Boolean + Public FileId As Integer + Public DisplayName As String + Public [Date] As Date + Public GameVersion As String() + Public ReleaseType As Integer + Public FileName As String + Public DownloadCount As Integer + Public Dependencies As New List(Of Integer) + Private DownloadAddress As String() + + Public ReadOnly Property ReleaseTypeString As String + Get + Select Case ReleaseType + Case 1 + Return "正式版" + Case 2 + Return If(ModeDebug, "Beta 测试版", "测试版") + Case Else + Return If(ModeDebug, "Alpha 测试版", "测试版") + End Select + End Get + End Property + Public ReadOnly Property IsAvailable As Boolean + Get + Return DisplayName IsNot Nothing AndAlso GameVersion IsNot Nothing AndAlso FileName IsNot Nothing AndAlso DownloadAddress(0).StartsWith("http") + End Get + End Property + + ''' + ''' 从 CurseForge 文件 Json 项中初始化实例。若出错会抛出异常。 + ''' + Public Sub New(Data As JObject, IsModPack As Boolean) + FileId = Data("id") + DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ") + [Date] = Data("fileDate") + ReleaseType = Data("releaseType") + DownloadCount = Data("downloadCount") + FileName = Data("fileName") + Me.IsModPack = IsModPack + '获取下载地址 + Dim Url = Data("downloadUrl").ToString + If Url = "" Then Url = "https://media.forgecdn.net/files/" & FileId.ToString.Substring(0, 4) & "/" & FileId.ToString.Substring(4).TrimStart("0") & "/" & FileName + Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码 + DownloadAddress = ArrayNoDouble({Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"), Url.Replace("-service.overwolf.wtf", ".forgecdn.net"), Url.Replace("://edge", "://media"), Url}) + '获取前置 Mod 的 Addon ID + If Not IsModPack Then + For Each Dep In Data("dependencies") + If Dep("relationType").ToObject(Of Integer) = 3 AndAlso '是一个依赖 + Dep("modId").ToObject(Of Integer) <> 306612 Then '排除 Fabric API + Dependencies.Add(Dep("modId")) + End If + Next + End If + '获取游戏版本 + Dim Versions As New List(Of String) + For Each Version In Data("gameVersions") + If Version.ToString.StartsWith("1.") OrElse Version.ToString.Contains("w") Then + Versions.Add(Version.ToString.Trim.ToLower) + End If + Next + If Versions.Count > 1 Then + GameVersion = Sort(Versions, AddressOf VersionSortBoolean).ToArray + If IsModPack Then GameVersion = {GameVersion(0)} + ElseIf Versions.Count = 1 Then + GameVersion = Versions.ToArray + 'ElseIf Data("gameVersion").Count = 1 AndAlso Not Data("gameVersion")(0).ToString.Contains("1.") Then + ' GameVersion = {"1.16.4"} + Else + GameVersion = {"未知版本"} + End If + End Sub + + ''' + ''' 获取对应的下载文件信息。 + ''' + ''' 本地文件夹或文件地址。 + Public Function GetDownloadFile(LocalAddress As String, IsFullPath As Boolean) As NetFile + Return New NetFile(DownloadAddress, LocalAddress & If(IsFullPath, "", FileName)) + End Function + + Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing) As MyListItem + + '获取描述信息 + Dim Info As String = "" + If Not IsModPack Then + Info += "适用于 " & Join(GameVersion, "、").Replace("-snapshot", " 快照") & + If(ModeDebug AndAlso Dependencies.Count > 0, "，" & Dependencies.Count & " 个前置，", "，") + End If + Info += If(DownloadCount > 0, If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载，", DownloadCount & " 次下载，"), "") + Info += GetTimeSpanString([Date] - Date.Now) & "更新" + Info += If(ReleaseType <> 1, "，" & ReleaseTypeString, "") + + '建立控件 + Dim NewItem As New MyListItem With { + .Title = DisplayName, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me, + .Info = Info + } + Select Case ReleaseType + Case 1 'R + NewItem.Logo = "pack://application:,,,/images/Icons/R.png" + Case 2 'B + NewItem.Logo = "pack://application:,,,/images/Icons/B.png" + Case Else 'A + NewItem.Logo = "pack://application:,,,/images/Icons/A.png" + End Select + AddHandler NewItem.Click, OnClick + + '建立另存为按钮 + If OnSaveClick IsNot Nothing Then + Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} + ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnSave, 30) + ToolTipService.SetHorizontalOffset(BtnSave, 2) + AddHandler BtnSave.Click, OnSaveClick + NewItem.Buttons = {BtnSave} + NewItem.PaddingRight = 35 + End If + + '结束 + Return NewItem + End Function + Public Overrides Function ToString() As String + Return DisplayName + End Function + + End Class + + ''' + ''' 获取某个 CurseForge 工程下的全部文件列表。 + ''' 必须在工作线程执行，失败会抛出异常。 + ''' + Public Function DlCfGetFiles(ProjectId As Integer, IsModPack As Boolean) As List(Of DlCfFile) + '获取工程对象 + Dim TargetProject As DlCfProject + If DlCfProjectCache.ContainsKey(ProjectId) Then + TargetProject = DlCfProjectCache(ProjectId) + Else + TargetProject = GetCfProjectFromJson(NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)("data"), IsModPack) + End If + '获取工程对象的文件列表 + If TargetProject.Files Is Nothing Then + Log("[Download] 开始获取 CurseForge 工程 ID 为 " & ProjectId & " 的文件列表") + Dim Json As JArray + If TargetProject.IsModPack Then + '整合包使用全部文件 + Json = NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId & "/files?pageSize=999", Accept:="application/json", IsJson:=True)("data") + Else + 'Mod 使用每个版本最新的文件 + 'TODO: 完整 Mod 文件列表支持 + Json = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.FileIndexes, ",") & "]}", "application/json"))("data") + End If + Dim Files As New Dictionary(Of Integer, DlCfFile) + For Each JsonEntry As JObject In Json + Dim NewFile As New DlCfFile(JsonEntry, IsModPack) + If NewFile.IsAvailable AndAlso Not Files.ContainsKey(NewFile.FileId) Then Files.Add(NewFile.FileId, NewFile) + Next + TargetProject.Files = Files.Values.ToList + End If + '获取前置 Mod 列表 + If IsModPack Then GoTo ExitSub + Dim Deps As New List(Of Integer) + For Each File In TargetProject.Files + For Each AddonId In File.Dependencies + If Not Deps.Contains(AddonId) AndAlso Not DlCfProjectCache.ContainsKey(AddonId) Then Deps.Add(AddonId) + Next + Next + If Deps.Count > 0 Then + '获取前置 Mod 工程信息 + Log("[Download] 文件列表中需要获取的前置 Mod：" & Join(Deps, "，")) + GetCfProjectListFromJson(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST", "{""modIds"": [" & Join(Deps, ",") & "]}", "application/json"))("data"), False) + End If + '返回 +ExitSub: + Return TargetProject.Files + End Function + + Public Sub DlCfFilesPreload(Stack As StackPanel, Entrys As List(Of DlCfFile), OnClick As MyListItem.ClickEventHandler) + '获取卡片对应的前置 ID + '如果为整合包就不会有 Dependencies 信息，所以不用管 + Dim Deps As New List(Of Integer) + For Each File In Entrys + For Each AddonId In If(File.Dependencies, New List(Of Integer)) + If Not Deps.Contains(AddonId) Then + If Not DlCfProjectCache.ContainsKey(AddonId) Then + Log("[Download] 未找到 ID 为 " & AddonId & " 的前置 Mod 信息", LogLevel.Developer) + Continue For + End If + Deps.Add(AddonId) + End If + Next + Next + Deps.Remove(306612) '移除 Fabric API + If Deps.Count = 0 Then Exit Sub + Deps.Sort() + '添加开头间隔 + Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)}) + '添加前置 Mod 列表 + For Each Dep In Deps + Dim Item = DlCfProjectCache(Dep).ToCfItem(False, True, AddressOf FrmDownloadMod.ProjectClick) + 'Item.Margin = New Thickness(5, 0, 0, 0) + Stack.Children.Add(Item) + Next + '添加结尾间隔 + Stack.Children.Add(New TextBlock With {.Text = "可选版本", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 12, 0, 5)}) + End Sub + +#End Region + +#Region "DlSource | 镜像下载源" + + Public Function DlSourceResourceGet(MojangBase As String) As String() + Return {MojangBase.Replace("http://resources.download.minecraft.net", "https://download.mcbbs.net/assets"), + MojangBase, + MojangBase.Replace("http://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets") + } + End Function + + Public Function DlSourceLibraryGet(MojangBase As String) As String() + Return {MojangBase.Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/maven"), + MojangBase.Replace("https://libraries.minecraft.net", "https://download.mcbbs.net/libraries"), + MojangBase, + MojangBase.Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"), + MojangBase.Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries") + } + End Function + + Public Function DlSourceLauncherOrMetaGet(MojangBase As String, Optional IsStatic As Boolean = True) As String() + If MojangBase Is Nothing Then Throw New Exception("无对应的 Json 下载地址") + If IsStatic Then + Return {MojangBase.Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"), + MojangBase, + MojangBase.Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com") + } + Else + Return {MojangBase.Replace("https://launcher.mojang.com", "https://download.mcbbs.net").Replace("https://launchermeta.mojang.com", "https://download.mcbbs.net"), + MojangBase, + MojangBase.Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com") + } + End If + End Function + + 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) + Dim WaitCycle As Integer = 0 + Do While True + '检查加载结束 + Dim IsAllFailed As Boolean = True + For Each SubLoader In LoaderList + If WaitCycle = 0 Then + '如果要强制刷新，就不使用已经加载好的值 + If IsForceRestart Then Exit For + '如果输入不一样，就不使用已经加载好的值 + If (SubLoader.Key.Input Is Nothing Xor MainLoader.Input Is Nothing) OrElse + (SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For + End If + If SubLoader.Key.State <> LoadState.Failed Then IsAllFailed = False + If SubLoader.Key.State = LoadState.Finished Then + MainLoader.Output = SubLoader.Key.Output + DlSourceLoaderAbort(LoaderList) + Exit Sub + ElseIf IsAllFailed Then + If WaitCycle < SubLoader.Value * 100 Then WaitCycle = SubLoader.Value * 100 + End If + '由于 Forge BMCLAPI 没有可用版本导致强制失败 + '在没有可用版本时，官方源会一直卡住，直接使用 BMCLAPI 判定失败即可 + If SubLoader.Key.Error IsNot Nothing AndAlso SubLoader.Key.Error.Message.Contains("没有可用版本") Then + For Each SubLoader2 In LoaderList + If WaitCycle < SubLoader2.Value * 100 Then WaitCycle = SubLoader2.Value * 100 + Next + End If + Next + '启动加载源 + If WaitCycle = 0 Then + '启动第一个源 + LoaderList(0).Key.Start(MainLoader.Input, IsForceRestart) + End If + For i = 0 To LoaderList.Count - 1 + If WaitCycle = LoaderList(i).Value * 100 Then + If i < LoaderList.Count - 1 Then + '启动下一个源 + LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart) + Else + '失败 + Dim ErrorInfo As Exception = Nothing + For ii = 0 To LoaderList.Count - 1 + LoaderList(ii).Key.Input = Nothing '重置输入，以免以同样的输入“重试加载”时直接失败 + If LoaderList(ii).Key.Error IsNot Nothing Then + If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("没有可用版本") Then + ErrorInfo = LoaderList(ii).Key.Error + End If + End If + Next + If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时") + DlSourceLoaderAbort(LoaderList) + Throw ErrorInfo + End If + Exit For + End If + Next + '计时 + If MainLoader.IsAborted Then + DlSourceLoaderAbort(LoaderList) + Exit Sub + End If + Thread.Sleep(10) + WaitCycle += 1 + Loop + End Sub + Private Sub DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer))) + For Each Loader In LoaderList + If Loader.Key.State = LoadState.Loading Then Loader.Key.Abort() + Next + End Sub + +#End Region + +End Module diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb new file mode 100644 index 0000000..09089ce --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb @@ -0,0 +1,1826 @@ +Imports System.IO.Compression + +Public Module ModLaunch + +#Region "开始" + + ''' + ''' 记录启动日志。 + ''' + Public Sub McLaunchLog(Text As String) + RunInUi(Sub() + FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text + End Sub) + Log("[Launch] " & Text) + End Sub + + '启动状态切换 + Public McLaunchLoader As New LoaderTask(Of String, Object)("Loader Launch", AddressOf McLaunchStart) With {.OnStateChanged = AddressOf McLaunchState, .ReloadTimeout = 1} + Public McLaunchLoaderReal As LoaderCombo(Of Object) + Public McLaunchProcess As Process + Public McLaunchWatcher As Watcher + Private Sub McLaunchState(Loader As LoaderTask(Of String, Object)) + Select Case McLaunchLoader.State + Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Aborted + FrmLaunchLeft.PageChangeToLogin() + Case LoadState.Loading + '在预检测结束后再触发动画 + FrmLaunchRight.LabLog.Text = "" + End Select + End Sub + Private Sub McLaunchStart(Loader As LoaderTask(Of String, Object)) + '开始动画 + RunInUiWait(AddressOf FrmLaunchLeft.PageChangeToLaunching) + '预检测（预检测的错误将直接抛出） + Try + McLaunchPrecheck() + McLaunchLog("预检测已通过") + Catch ex As Exception + Hint(ex.Message, HintType.Critical) + Throw + End Try + '正式加载 + Try + '构造主加载器 + Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", { + New LoaderCombo(Of Integer)("Java 处理", { + New LoaderTask(Of Integer, List(Of NetFile))("Java 验证", AddressOf McLaunchJavaValidate) With {.ProgressWeight = 2} + }) With {.ProgressWeight = 2, .Show = False, .Block = False}, + McLoginLoader, + New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False, .Block = True}, + New LoaderTask(Of Integer, String)("提供参数中的服务器 IP", Sub(InnerLoader As LoaderTask(Of Integer, String)) InnerLoader.Output = Loader.Input) With {.ProgressWeight = 0.01, .Show = False}, + New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2}, + New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2}, + New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1}, + New LoaderTask(Of Integer, Process)("启动进程", AddressOf McLaunchRun) With {.ProgressWeight = 2}, + New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1}, + New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1} + }) With {.Show = False} + '等待加载器执行并更新 UI + McLaunchLoaderReal = LaunchLoader + LaunchLoader.Start() + '任务栏进度条 + LoaderTaskbarAdd(LaunchLoader) + Do While LaunchLoader.State = LoadState.Loading + FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh) + Thread.Sleep(200) + Loop + FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh) + '成功与失败处理 + Select Case LaunchLoader.State + Case LoadState.Finished + Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish) + Case LoadState.Aborted + Hint("已取消启动！", HintType.Info) + Case LoadState.Failed + Throw LaunchLoader.Error + Case Else + Throw New Exception("错误的状态改变：" & GetStringFromEnum(CType(LaunchLoader.State, [Enum]))) + End Select + Catch ex As Exception + Dim CurrentEx = ex +NextInner: + If CurrentEx.Message.StartsWith("$") Then + '若有以 $ 开头的错误信息，则以此为准显示提示 + '若错误信息为 $$，则不提示 + If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), "启动失败") + Throw + ElseIf CurrentEx.InnerException IsNot Nothing Then + '检查下一级错误 + CurrentEx = CurrentEx.InnerException + GoTo NextInner + Else + '没有特殊处理过的错误信息 + McLaunchLog("错误：" & GetString(ex, False)) + Log(ex, "Minecraft 启动失败", LogLevel.Msgbox, "启动失败") + Throw + End If + End Try + End Sub + +#End Region + +#Region "预检测" + + Private Sub McLaunchPrecheck() + '检查路径 + If McVersionCurrent.PathIndie.Contains("!") OrElse McVersionCurrent.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.PathIndie & "）") + If McVersionCurrent.Path.Contains("!") OrElse McVersionCurrent.Path.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.Path & "）") + '检查输入信息 + Dim CheckResult As String = Nothing + RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput)) + If CheckResult <> "" Then Throw New ArgumentException(CheckResult) + '检查版本 + If McVersionCurrent Is Nothing Then Throw New Exception("未选择 Minecraft 版本！") + McVersionCurrent.Load() + If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题：" & McVersionCurrent.Info) + '求赞助 + If ThemeCheckGold() Then Exit Sub + RunInNewThread(Sub() + Select Case Setup.Get("SystemLaunchCount") + Case 20, 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800, 1900, 2000 + If MyMsgBox("PCL2 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦！" & vbCrLf & + "如果觉得 PCL2 还算好用的话，也可以考虑小小地赞助一下作者呢 qwq……" & vbCrLf & + "毕竟一个人开发也不容易（小声）……", + "求赞助啦……", "这就赞助！", "但是我拒绝") = 1 Then + OpenWebsite("https://afdian.net/@LTCat/plan") + End If + End Select + End Sub, "Donate") + End Sub + +#End Region + +#Region "主登录模块" + + '登录方式 + Public Enum McLoginType + Legacy = 0 + Mojang = 1 + Nide = 2 + Auth = 3 + Ms = 5 + End Enum + + '各个登录方式的对应数据 + Public MustInherit Class McLoginData + ''' + ''' 登录方式。 + ''' + Public Type As McLoginType + Public Overrides Function Equals(obj As Object) As Boolean + Return obj IsNot Nothing AndAlso obj.GetHashCode() = GetHashCode() + End Function + End Class + Public Class McLoginServer + Inherits McLoginData + + ''' + ''' 登录用户名。 + ''' + Public UserName As String + ''' + ''' 登录密码。 + ''' + Public Password As String + ''' + ''' 登录服务器基础地址。 + ''' + Public BaseUrl As String + ''' + ''' 登录所使用的标识符，如 “Mojang”、“Nide”，用于存储缓存等。 + ''' + Public Token As String + ''' + ''' 登录方式的描述字符串，如 “正版”、“统一通行证”。 + ''' + Public Description As String + ''' + ''' 是否在本次登录中强制要求玩家重新选择角色，目前仅对 Authlib-Injector 生效。 + ''' + Public ForceReselectProfile As Boolean = False + + Public Sub New(Type As McLoginType) + Me.Type = Type + End Sub + Public Overrides Function GetHashCode() As Integer + Return GetHash(UserName & Password & BaseUrl & Token & Type) Mod Integer.MaxValue + End Function + + End Class + Public Class McLoginMs + Inherits McLoginData + + ''' + ''' 缓存的 OAuth Refresh Token。若没有则为空字符串。 + ''' + Public OAuthRefreshToken As String = "" + Public AccessToken As String = "" + Public Uuid As String = "" + Public UserName As String = "" + + Public Sub New() + Type = McLoginType.Ms + End Sub + Public Overrides Function GetHashCode() As Integer + Return GetHash(OAuthRefreshToken & AccessToken & Uuid & UserName) Mod Integer.MaxValue + End Function + End Class + Public Class McLoginLegacy + Inherits McLoginData + ''' + ''' 登录用户名。 + ''' + Public UserName As String + ''' + ''' 皮肤种类。 + ''' + Public SkinType As Integer + ''' + ''' 若采用正版皮肤，则为该皮肤名。 + ''' + Public SkinName As String + + Public Sub New() + Type = McLoginType.Legacy + End Sub + Public Overrides Function GetHashCode() As Integer + Return GetHash(UserName & SkinType & SkinName & Type) Mod Integer.MaxValue + End Function + End Class + + '登录返回结果 + Public Structure McLoginResult + Public Name As String + Public Uuid As String + Public AccessToken As String + Public Type As String + ''' + ''' 仅用于登录方式为 Mojang 正版时的 Refresh Login，其余时间为一个无意义的 ID（一般为玩家的 UUID）。 + ''' + Public ClientToken As String + ''' + ''' 用于登录的邮箱。仅用于登录方式为 Mojang 正版时的 launcher_profile 更新。 + ''' + Public Email As String + ''' + ''' 进行微软登录时返回的 profile 信息。 + ''' + Public ProfileJson As String + End Structure + + ''' + ''' 根据登录信息获取玩家的 MC 用户名。如果无法获取则返回 Nothing。 + ''' + Public Function McLoginName() As String + '根据当前登录方式优先返回 + Select Case Setup.Get("LoginType") + Case McLoginType.Mojang + If Setup.Get("CacheMojangName") <> "" Then Return Setup.Get("CacheMojangName") + Case McLoginType.Ms + If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName") + Case McLoginType.Legacy + If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Split("¨")(0) + Case McLoginType.Nide + If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName") + Case McLoginType.Auth + If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName") + End Select + '查找所有可能的项 + If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName") + If Setup.Get("CacheMojangName") <> "" Then Return Setup.Get("CacheMojangName") + If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName") + If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName") + If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Split("¨")(0) + Return Nothing + End Function + ''' + ''' 当前是否可以进行登录。若不可以则会返回错误原因。 + ''' + Public Function McLoginAble() As String + Select Case Setup.Get("LoginType") + Case McLoginType.Mojang + If Setup.Get("CacheMojangAccess") = "" Then + Return FrmLoginMojang.IsVaild() + Else + Return "" + End If + Case McLoginType.Ms + If Setup.Get("CacheMsOAuthRefresh") = "" Then + Return FrmLoginMs.IsVaild() + Else + Return "" + End If + Case McLoginType.Legacy + Return FrmLoginLegacy.IsVaild() + Case McLoginType.Nide + If Setup.Get("CacheNideAccess") = "" Then + Return FrmLoginNide.IsVaild() + Else + Return "" + End If + Case McLoginType.Auth + If Setup.Get("CacheAuthAccess") = "" Then + Return FrmLoginAuth.IsVaild() + Else + Return "" + End If + Case Else + Return "未知的登录方式" + End Select + End Function + ''' + ''' 登录输入是否可以进行登录。若不可以则会返回错误原因。 + ''' + Public Function McLoginAble(LoginData As McLoginData) As String + Select Case LoginData.Type + Case McLoginType.Mojang + Return PageLoginMojang.IsVaild(LoginData) + Case McLoginType.Ms + Return PageLoginMs.IsVaild(LoginData) + Case McLoginType.Legacy + Return PageLoginLegacy.IsVaild(LoginData) + Case McLoginType.Nide + Return PageLoginNide.IsVaild(LoginData) + Case McLoginType.Auth + Return PageLoginAuth.IsVaild(LoginData) + Case Else + Return "未知的登录方式" + End Select + End Function + + '登录主模块加载器 + Public McLoginLoader As New LoaderTask(Of McLoginData, McLoginResult)("登录", AddressOf McLoginStart, AddressOf McLoginInput, ThreadPriority.BelowNormal) With {.ReloadTimeout = 1, .ProgressWeight = 15, .Block = False} + Public Function McLoginInput() As McLoginData + Dim LoginData As McLoginData = Nothing + Dim LoginType As McLoginType = Setup.Get("LoginType") + Try + Select Case LoginType + Case McLoginType.Legacy + LoginData = PageLoginLegacy.GetLoginData() + Case McLoginType.Mojang + If Setup.Get("CacheMojangAccess") = "" Then + LoginData = PageLoginMojang.GetLoginData() + Else + LoginData = PageLoginMojangSkin.GetLoginData() + End If + Case McLoginType.Ms + If Setup.Get("CacheMsOAuthRefresh") = "" Then + LoginData = PageLoginMs.GetLoginData() + Else + LoginData = PageLoginMsSkin.GetLoginData() + End If + Case McLoginType.Nide + If Setup.Get("CacheNideAccess") = "" Then + LoginData = PageLoginNide.GetLoginData() + Else + LoginData = PageLoginNideSkin.GetLoginData() + End If + Case McLoginType.Auth + If Setup.Get("CacheAuthAccess") = "" Then + LoginData = PageLoginAuth.GetLoginData() + Else + LoginData = PageLoginAuthSkin.GetLoginData() + End If + End Select + Catch ex As Exception + Log(ex, "获取登录输入信息失败（" & GetStringFromEnum(LoginType) & "）", LogLevel.Feedback) + End Try + Return LoginData + End Function + Private Sub McLoginStart(Data As LoaderTask(Of McLoginData, McLoginResult)) + McLaunchLog("登录线程已启动") + '校验登录信息 + Dim CheckResult As String = McLoginAble(Data.Input) + If Not CheckResult = "" Then Throw New ArgumentException(CheckResult) + '获取对应加载器 + Dim Loader As LoaderBase = Nothing + Select Case Data.Input.Type + Case McLoginType.Mojang + Loader = McLoginMojangLoader + Case McLoginType.Ms + Loader = McLoginMsLoader + Case McLoginType.Legacy + Loader = McLoginLegacyLoader + Case McLoginType.Nide + Loader = McLoginNideLoader + Case McLoginType.Auth + Loader = McLoginAuthLoader + End Select + '尝试加载 + Loader.WaitForExit(Data.Input, McLoginLoader, Data.IsForceRestarting) + Data.Output = CType(Loader, Object).Output + RunInUi(Sub() FrmLaunchLeft.RefreshPage(True, False)) '刷新自动填充列表 + End Sub + +#End Region +#Region "分方式登录模块" + + '各个登录方式的主对象与输入构造 + Public McLoginMojangLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Mojang", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000} + Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 300000} + Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart) + Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000} + Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000} + + '主加载函数，返回所有需要的登录信息 + Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult)) + Dim Input As McLoginMs = Data.Input + Dim LogUsername As String = Input.UserName + McLaunchLog("登录方式：微软正版（" & If(LogUsername = "", "尚未登录", LogUsername) & "）") + Data.Progress = 0.05 + '检查是否已经登录完成 + If Input.AccessToken <> "" AndAlso Not Data.IsForceRestarting Then + Data.Output = New McLoginResult With {.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid} + GoTo SkipLogin + End If + '尝试登录 + Dim OAuthTokens As String() + If Setup.Get("CacheMsOAuthRefresh") = "" Then + '无 RefreshToken +Relogin: + Dim OAuthCode As String = MsLoginStep1(Data) + If Data.IsAborted Then Throw New ThreadInterruptedException + Data.Progress = 0.2 + OAuthTokens = MsLoginStep2(OAuthCode, False) + Else + '有 RefreshToken + OAuthTokens = MsLoginStep2(Setup.Get("CacheMsOAuthRefresh"), True) + End If + '要求重新打开登录网页认证 + If OAuthTokens(0) = "Relogin" Then GoTo Relogin + Data.Progress = 0.35 + If Data.IsAborted Then Throw New ThreadInterruptedException + Dim OAuthAccessToken As String = OAuthTokens(0) + Dim OAuthRefreshToken As String = OAuthTokens(1) + Dim XBLToken As String = MsLoginStep3(OAuthAccessToken) + Data.Progress = 0.5 + If Data.IsAborted Then Throw New ThreadInterruptedException + Dim Tokens = MsLoginStep4(XBLToken) + Data.Progress = 0.65 + If Data.IsAborted Then Throw New ThreadInterruptedException + Dim AccessToken As String = MsLoginStep5(Tokens) + Data.Progress = 0.8 + If Data.IsAborted Then Throw New ThreadInterruptedException + Dim Result = MsLoginStep6(AccessToken) + '输出登录结果 + Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken) + Setup.Set("CacheMsAccess", AccessToken) + Setup.Set("CacheMsUuid", Result(0)) + Setup.Set("CacheMsName", Result(1)) + Data.Output = New McLoginResult With {.AccessToken = AccessToken, .Name = Result(1), .Uuid = Result(0), .Type = "Microsoft", .ClientToken = Result(0), .ProfileJson = Result(2)} + '解锁主题 +SkipLogin: + McLaunchLog("微软登录完成") + Data.Progress = 0.95 + If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持！" & vbCrLf & "隐藏主题 跳票红 已解锁！", "提示") + End Sub + Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult)) + Dim Input As McLoginServer = Data.Input + Dim NeedRefresh 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 & "）") + Data.Progress = 0.05 + '尝试登录 + If (Not Data.Input.ForceReselectProfile) AndAlso Setup.Get("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso Setup.Get("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso Not Setup.Get("Cache" & Input.Token & "Access") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Client") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Uuid") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Name") = "" Then + '尝试验证登录 + Try + If Data.IsAborted Then Throw New ThreadInterruptedException + McLoginRequestValidate(Data) + GoTo LoginFinish + Catch ex As Exception + Dim AllMessage = GetString(ex) + McLaunchLog("验证登录失败：" & AllMessage) + If (AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout")) AndAlso Not AllMessage.Contains("403") Then + McLaunchLog("已触发超时登录失败") + Throw New Exception("$登录失败：连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好，或尝试使用 VPN！") + End If + End Try + Data.Progress = 0.25 + '尝试刷新登录 +Refresh: + Try + If Data.IsAborted Then Throw New ThreadInterruptedException + McLoginRequestRefresh(Data, NeedRefresh) + GoTo LoginFinish + Catch ex As Exception + McLaunchLog("刷新登录失败：" & GetString(ex)) + End Try + Data.Progress = If(NeedRefresh, 0.85, 0.45) + End If + '尝试普通登录 + Try + If Data.IsAborted Then Throw New ThreadInterruptedException + NeedRefresh = McLoginRequestLogin(Data) + Catch ex As Exception + McLaunchLog("登录失败：" & GetString(ex)) + Throw + End Try + If NeedRefresh Then + Data.Progress = 0.65 + GoTo Refresh + End If +LoginFinish: + Data.Progress = 0.95 + '保存启动记录 + Dim Dict As New Dictionary(Of String, String) + Dim Emails As New List(Of String) + Dim Passwords As New List(Of String) + Try + If Not Setup.Get("Login" & Input.Token & "Email") = "" Then Emails.AddRange(Setup.Get("Login" & Input.Token & "Email").ToString.Split("¨")) + If Not Setup.Get("Login" & Input.Token & "Pass") = "" Then Passwords.AddRange(Setup.Get("Login" & Input.Token & "Pass").ToString.Split("¨")) + For i = 0 To Emails.Count - 1 + Dict.Add(Emails(i), Passwords(i)) + Next + Dict.Remove(Input.UserName) + Emails = New List(Of String)(Dict.Keys) + Emails.Insert(0, Input.UserName) + Passwords = New List(Of String)(Dict.Values) + Passwords.Insert(0, Input.Password) + Setup.Set("Login" & Input.Token & "Email", Join(Emails, "¨")) + Setup.Set("Login" & Input.Token & "Pass", Join(Passwords, "¨")) + Catch ex As Exception + Log(ex, "保存启动记录失败", LogLevel.Hint) + Setup.Set("Login" & Input.Token & "Email", "") + Setup.Set("Login" & Input.Token & "Pass", "") + End Try + End Sub + Private Sub McLoginLegacyStart(Data As LoaderTask(Of McLoginLegacy, McLoginResult)) + Dim Input As McLoginLegacy = Data.Input + McLaunchLog("登录方式：离线（" & Input.UserName & "）") + Data.Progress = 0.1 + With Data.Output + .Name = Input.UserName + .Uuid = McLoginLegacyUuid(Input.UserName) + .Type = "Legacy" + End With + '根据离线皮肤获取实际使用的 Uuid + Select Case Input.SkinType + Case 0 + '默认，不需要处理 + Case 1 + 'Steve + Do Until McSkinSex(Data.Output.Uuid) = "Steve" + If Data.Output.Uuid.EndsWith("FFFFF") Then Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & "00000" + Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & (Long.Parse(Right(Data.Output.Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X") + Loop + Case 2 + 'Alex + Do Until McSkinSex(Data.Output.Uuid) = "Alex" + If Data.Output.Uuid.EndsWith("FFFFF") Then Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & "00000" + Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & (Long.Parse(Right(Data.Output.Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X") + Loop + Case 3 + '使用正版用户名 + Try + If Not Input.SkinName = "" Then + Log("[Skin] 由于离线皮肤设置，使用正版 UUID：" & Input.SkinName) + Data.Output.Uuid = McLoginMojangUuid(Input.SkinName, False) + End If + Catch ex As Exception + Log(ex, "离线启动时使用的正版皮肤获取失败") + MyMsgBox("由于设置的离线启动时使用的正版皮肤获取失败，游戏将以无皮肤的方式启动。" & vbCrLf & "请检查你的网络是否通畅，或尝试使用 VPN！" & vbCrLf & vbCrLf & "详细的错误信息：" & ex.Message, "皮肤获取失败") + End Try + Case 4 + '自定义 + Do Until McSkinSex(Data.Output.Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve") + If Data.Output.Uuid.EndsWith("FFFFF") Then Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & "00000" + Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & (Long.Parse(Right(Data.Output.Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X") + Loop + End Select + '将结果扩展到所有项目中 + 'Data.Output.AccessToken = Setup.Get("CacheMojangAccess") '不能优先使用缓存的 AccessToken，这会导致离线用户名设置失效 + 'If Data.Output.AccessToken.Length < 300 Then + Data.Output.AccessToken = Data.Output.Uuid + 'Data.Output.ClientToken = Setup.Get("CacheMojangClient") + 'If Data.Output.AccessToken.Length <> 32 Then + Data.Output.ClientToken = Data.Output.Uuid + '保存启动记录 + Dim Names As New List(Of String) + If Not Setup.Get("LoginLegacyName") = "" Then Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨")) + Names.Remove(Input.UserName) + Names.Insert(0, Input.UserName) + Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨")) + End Sub + + 'Server 登录：三种验证方式的请求 + Private Sub McLoginRequestValidate(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult)) + McLaunchLog("验证登录开始（Validate, " & Data.Input.Token & "）") + '提前缓存信息，否则如果在登录请求过程中退出登录，设置项目会被清空，导致输出存在空值 + Dim AccessToken As String = Setup.Get("Cache" & Data.Input.Token & "Access") + Dim ClientToken As String = Setup.Get("Cache" & Data.Input.Token & "Client") + Dim Uuid As String = Setup.Get("Cache" & Data.Input.Token & "Uuid") + Dim Name As String = Setup.Get("Cache" & Data.Input.Token & "Name") + '发送登录请求 + NetRequestRetry( + Url:=Data.Input.BaseUrl & "/validate", + Method:="POST", + Data:="{""accessToken"":""" & AccessToken & """,""clientToken"":""" & ClientToken & """,""requestUser"":true}", + ContentType:="application/json; charset=utf-8") '没有返回值的 + '将登录结果输出 + Data.Output.AccessToken = AccessToken + Data.Output.ClientToken = ClientToken + Data.Output.Uuid = Uuid + Data.Output.Name = Name + Data.Output.Type = Data.Input.Token + Data.Output.Email = Data.Input.UserName + '不更改缓存，直接结束 + McLaunchLog("验证登录成功（Validate, " & Data.Input.Token & "）") + End Sub + Private Sub McLoginRequestRefresh(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult), RequestUser As Boolean) + McLaunchLog("刷新登录开始（Refresh, " & Data.Input.Token & "）") + Dim LoginJson As JObject = GetJson(NetRequestRetry( + Url:=Data.Input.BaseUrl & "/refresh", + Method:="POST", + Data:="{" & + If(RequestUser, " + ""requestUser"": true, + ""selectedProfile"": { + ""id"":""" & Setup.Get("Cache" & Data.Input.Token & "Uuid") & """, + ""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & " + ""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """, + ""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}", + ContentType:="application/json; charset=utf-8")) + '将登录结果输出 + If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效！") + Data.Output.AccessToken = LoginJson("accessToken").ToString + Data.Output.ClientToken = LoginJson("clientToken").ToString + Data.Output.Uuid = LoginJson("selectedProfile")("id").ToString + Data.Output.Name = LoginJson("selectedProfile")("name").ToString + Data.Output.Type = Data.Input.Token + Data.Output.Email = Data.Input.UserName + '保存缓存 + Setup.Set("Cache" & Data.Input.Token & "Access", Data.Output.AccessToken) + Setup.Set("Cache" & Data.Input.Token & "Client", Data.Output.ClientToken) + Setup.Set("Cache" & Data.Input.Token & "Uuid", Data.Output.Uuid) + Setup.Set("Cache" & Data.Input.Token & "Name", Data.Output.Name) + Setup.Set("Cache" & Data.Input.Token & "Username", Data.Input.UserName) + Setup.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password) + McLaunchLog("刷新登录成功（Refresh, " & Data.Input.Token & "）") + End Sub + Private Function McLoginRequestLogin(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult)) As Boolean + Try + Dim NeedRefresh As Boolean = False + McLaunchLog("登录开始（Login, " & Data.Input.Token & "）") + Dim LoginJson As JObject = GetJson(NetRequestRetry( + Url:=Data.Input.BaseUrl & "/authenticate", + Method:="POST", + Data:="{""agent"": {""name"": ""Minecraft"",""version"": 1},""username"":""" & Data.Input.UserName & """,""password"":""" & Data.Input.Password & """,""requestUser"":true}", + ContentType:="application/json; charset=utf-8")) + '检查登录结果 + If LoginJson("availableProfiles").Count = 0 Then + If Data.Input.Type = McLoginType.Auth Then + If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色，无法更换！", HintType.Critical) + Throw New Exception("$你还没有创建角色，请在创建角色后再试！") + Else + Throw New Exception("$你还没有购买 Minecraft 正版，请在购买后再试！") + End If + ElseIf Data.Input.ForceReselectProfile AndAlso LoginJson("availableProfiles").Count = 1 Then + Hint("你的账户中只有一个角色，无法更换！", HintType.Critical) + End If + Dim SelectedName As String = Nothing + Dim SelectedId As String = Nothing + If (LoginJson("selectedProfile") Is Nothing OrElse Data.Input.ForceReselectProfile) AndAlso LoginJson("availableProfiles").Count > 1 Then + '要求选择档案；优先从缓存读取 + NeedRefresh = True + Dim CacheId As String = Setup.Get("Cache" & Data.Input.Token & "Uuid") + For Each Profile In LoginJson("availableProfiles") + If Profile("id").ToString = CacheId Then + SelectedName = Profile("name").ToString + SelectedId = Profile("id").ToString + McLaunchLog("根据缓存选择的角色：" & SelectedName) + End If + Next + '缓存无效，要求玩家选择 + If SelectedName Is Nothing Then + McLaunchLog("要求玩家选择角色") + RunInUiWait(Sub() + Dim SelectionControl As New List(Of IMyRadio) + Dim SelectionJson As New List(Of JToken) + For Each Profile In LoginJson("availableProfiles") + SelectionControl.Add(New MyRadioBox With {.Text = Profile("name").ToString}) + SelectionJson.Add(Profile) + Next + Dim SelectedIndex As Integer = MyMsgBoxSelect(SelectionControl, "选择使用的角色") + SelectedName = SelectionJson(SelectedIndex)("name").ToString + SelectedId = SelectionJson(SelectedIndex)("id").ToString + End Sub) + McLaunchLog("玩家选择的角色：" & SelectedName) + End If + Else + SelectedName = LoginJson("selectedProfile")("name").ToString + SelectedId = LoginJson("selectedProfile")("id").ToString + End If + '将登录结果输出 + Data.Output.AccessToken = LoginJson("accessToken").ToString + Data.Output.ClientToken = LoginJson("clientToken").ToString + Data.Output.Name = SelectedName + Data.Output.Uuid = SelectedId + Data.Output.Type = Data.Input.Token + Data.Output.Email = Data.Input.UserName + '保存缓存 + Setup.Set("Cache" & Data.Input.Token & "Access", Data.Output.AccessToken) + Setup.Set("Cache" & Data.Input.Token & "Client", Data.Output.ClientToken) + Setup.Set("Cache" & Data.Input.Token & "Uuid", Data.Output.Uuid) + Setup.Set("Cache" & Data.Input.Token & "Name", Data.Output.Name) + Setup.Set("Cache" & Data.Input.Token & "Username", Data.Input.UserName) + Setup.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password) + McLaunchLog("登录成功（Login, " & Data.Input.Token & "）") + Return NeedRefresh + Catch ex As Exception + Dim AllMessage As String = GetString(ex) + Log(ex, "登录失败原始错误信息", LogLevel.Normal) + If AllMessage.Contains("410") AndAlso AllMessage.Contains("Migrated") Then + Throw New Exception("$登录失败：该 Mojang 账号已迁移至微软账号，请在上方的登录方式中选择 微软 并再次尝试登录！") + ElseIf AllMessage.Contains("403") Then + Select Case Data.Input.Type + Case McLoginType.Auth + Throw New Exception("$登录失败，以下为可能的原因：" & vbCrLf & + " - 输入的账号或密码错误。" & vbCrLf & + " - 登录尝试过于频繁，导致被暂时屏蔽。请不要操作，等待 10 分钟后再试。" & vbCrLf & + " - 只注册了账号，但没有在皮肤站新建角色。") + Case McLoginType.Legacy + Throw + Case McLoginType.Mojang + If AllMessage.Contains("Invalid username or password") Then + Throw New Exception("$登录失败：输入的账号或密码有误。") + Else + Throw New Exception("$登录尝试过于频繁，导致被 Mojang 暂时屏蔽。请不要操作，等待 10 分钟后再试。") + End If + Case McLoginType.Ms + Throw New Exception("$登录失败，以下为可能的原因：" & vbCrLf & + " - 登录尝试过于频繁，导致被暂时屏蔽。请不要操作，等待 10 分钟后再试。" & vbCrLf & + " - 账号类别错误。如果你在使用 Mojang 账号，请将登录方式切换为 Mojang。") + Case McLoginType.Nide + Throw New Exception("$登录失败，以下为可能的原因：" & vbCrLf & + " - 输入的账号或密码错误。" & vbCrLf & + " - 密码错误次数过多，导致被暂时屏蔽。请不要操作，等待 10 分钟后再试。" & vbCrLf & + If(Data.Input.UserName.Contains("@"), "", " - 登录账号应为邮箱或统一通行证账号，而非游戏角色 ID。" & vbCrLf) & + " - 只注册了账号，但没有加入对应服务器。") + End Select + ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") Then + Throw New Exception("$登录失败：连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好，或尝试使用 VPN！") + ElseIf AllMessage.Contains("网络请求失败") Then + Throw New Exception("$登录失败：连接登录服务器失败。" & vbCrLf & "请检查你的网络状况是否良好，或尝试使用 VPN！") + ElseIf ex.Message.StartsWith("$") Then + Throw + Else + Throw New Exception("登录失败：" & ex.Message, ex) + End If + Return False + End Try + End Function + + '微软登录步骤 1：打开网页认证，获取 OAuth Code + Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String + McLaunchLog("开始微软登录步骤 1") + If OsVersion <= New Version(10, 0, 17763, 0) Then 'TODO: 添加设置以强制使用网页中继登录 + 'Windows 7 或老版 Windows 10 登录 + MyMsgBox("PCL2 即将打开登录网页。登录后会转到一个空白页面（这代表登录成功了），请将该空白页面的网址复制到 PCL2。" & vbCrLf & + "如果网络环境不佳，登录网页可能一直加载不出来，此时请尝试使用 VPN 或代理服务器，然后再试。", "登录说明", "开始", ForceWait:=True) + OpenWebsite(FormLoginOAuth.LoginUrl1) + Dim Result As String = MyMsgBoxInput("", New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")}, "https://login.live.com/oauth20_desktop.srf?code=XXXXXX", "输入登录返回码", "确定", "取消") + If Result Is Nothing Then + McLaunchLog("微软登录已在步骤 1 被取消") + Throw New ThreadInterruptedException("$$") + Else + Return RegexSeek(Result, "(?<=code\=)[^&]+") + End If + Else + 'Windows 10 登录 + Dim ReturnCode As String = Nothing + Dim ReturnEx As Exception = Nothing + Dim IsFinished As LoadState = LoadState.Loading + Dim LoginForm As FormLoginOAuth = Nothing + RunInUi(Sub() + Try + LoginForm = New FormLoginOAuth + LoginForm.Show() + AddHandler LoginForm.OnLoginSuccess, Sub(Code As String) + ReturnCode = Code + IsFinished = LoadState.Finished + End Sub + AddHandler LoginForm.OnLoginCanceled, Sub() IsFinished = LoadState.Aborted + Catch ex As Exception + ReturnEx = ex + IsFinished = LoadState.Failed + End Try + End Sub) + Do While IsFinished = LoadState.Loading AndAlso Not Data.IsAborted + Thread.Sleep(20) + Loop + RunInUi(Sub() If LoginForm IsNot Nothing Then LoginForm.Close()) + If IsFinished = LoadState.Finished Then + Return ReturnCode + ElseIf IsFinished = LoadState.Failed Then + Throw ReturnEx + Else + McLaunchLog("微软登录已在步骤 1 被取消") + Throw New ThreadInterruptedException("$$") + End If + End If + End Function + '微软登录步骤 2：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken} + Private Function MsLoginStep2(Code As String, IsRefresh As Boolean) As String() + McLaunchLog("开始微软登录步骤 2（" & If(IsRefresh, "", "非") & "刷新登录）") + + Dim Request As String + If IsRefresh Then + Request = "client_id=00000000402b5328" & "&" & + "refresh_token=" & Uri.EscapeDataString(Code) & "&" & + "grant_type=refresh_token" & "&" & + "redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" & + "scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL") + Else + Request = "client_id=00000000402b5328" & "&" & + "code=" & Uri.EscapeDataString(Code) & "&" & + "grant_type=authorization_code" & "&" & + "redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" & + "scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL") + End If + Dim Result As String + Try + Result = NetRequestMuity("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 1) + Catch ex As Exception + If ex.Message.Contains("must sign in again") Then + Return {"Relogin", ""} + Else + Throw + End If + End Try + + Dim ResultJson As JObject = GetJson(Result) + Dim AccessToken As String = ResultJson("access_token").ToString + Dim RefreshToken As String = ResultJson("refresh_token").ToString + Return {AccessToken, RefreshToken} + End Function + '微软登录步骤 3：从 OAuth AccessToken 获取 XBLToken + Private Function MsLoginStep3(AccessToken As String) As String + McLaunchLog("开始微软登录步骤 3") + + Dim Request As String = "{ + ""Properties"": { + ""AuthMethod"": ""RPS"", + ""SiteName"": ""user.auth.xboxlive.com"", + ""RpsTicket"": """ & AccessToken & """ + }, + ""RelyingParty"": ""http://auth.xboxlive.com"", + ""TokenType"": ""JWT"" + }" + Dim Result As String = NetRequestMuity("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3) + + Dim ResultJson As JObject = GetJson(Result) + Dim XBLToken As String = ResultJson("Token").ToString + Return XBLToken + End Function + '微软登录步骤 4：从 XBLToken 获取 {XSTSToken, UHS} + Private Function MsLoginStep4(XBLToken As String) As String() + McLaunchLog("开始微软登录步骤 4") + + Dim Request As String = "{ + ""Properties"": { + ""SandboxId"": ""RETAIL"", + ""UserTokens"": [ + """ & XBLToken & """ + ] + }, + ""RelyingParty"": ""rp://api.minecraftservices.com/"", + ""TokenType"": ""JWT"" + }" + Dim Result As String + Try + Result = NetRequestMuity("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3) + Catch ex As Net.WebException + If ex.Message.Contains("2148916233") Then + Throw New Exception("$该微软账号尚未购买 Minecraft Java 版或注册 XBox 账户！") + ElseIf ex.Message.Contains("2148916238") Then + If MyMsgBox("该账号年龄不足，你需要先修改出生日期，然后才能登录。" & vbCrLf & + "该账号目前填写的年龄是否在 13 岁以上？", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then + OpenWebsite("https://account.live.com/editprof.aspx") + MyMsgBox("请在打开的网页中修改账号的出生日期（至少改为 18 岁以上）。" & vbCrLf & + "在修改成功后等待一分钟，然后再回到 PCL2，就可以正常登录了！", "登录提示") + Else + OpenWebsite("https://support.microsoft.com/zh-cn/account-billing/如何更改-microsoft-帐户上的出生日期-837badbc-999e-54d2-2617-d19206b9540a") + MyMsgBox("请根据打开的网页的说明，修改账号的出生日期（至少改为 18 岁以上）。" & vbCrLf & + "在修改成功后等待一分钟，然后再回到 PCL2，就可以正常登录了！", "登录提示") + End If + Throw New Exception("$$") + Else + Throw + End If + End Try + + Dim ResultJson As JObject = GetJson(Result) + Dim XSTSToken As String = ResultJson("Token").ToString + Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString + Return {XSTSToken, UHS} + End Function + '微软登录步骤 5：从 {XSTSToken, UHS} 获取 Minecraft AccessToken + Private Function MsLoginStep5(Tokens As String()) As String + McLaunchLog("开始微软登录步骤 5") + + Dim Request As String = "{""identityToken"": ""XBL3.0 x=" & Tokens(1) & ";" & Tokens(0) & """}" + Dim Result As String + Try + Result = NetRequestMuity("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json", 2) + Catch ex As Net.WebException + Dim Message As String = GetString(ex) + If Message.Contains("(429)") Then + Log(ex, "微软登录第 5 步汇报 429") + Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！") + ElseIf Message.Contains("(403)") Then + Log(ex, "微软登录第 5 步汇报 403") + Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器，请把它们关掉或更换节点后再试！") + Else + Throw + End If + End Try + + Dim ResultJson As JObject = GetJson(Result) + Dim AccessToken As String = ResultJson("access_token").ToString + Return AccessToken + End Function + '微软登录步骤 6：从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson} + Private Function MsLoginStep6(AccessToken As String) As String() + McLaunchLog("开始微软登录步骤 6") + + Dim Result As String + Try + Result = NetRequestMuity("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}}) + Catch ex As Net.WebException + Dim Message As String = GetString(ex) + If Message.Contains("(429)") Then + Log(ex, "微软登录第 6 步汇报 429") + Throw New Exception("$登录尝试太过频繁，请等待几分钟后再试！") + ElseIf Message.Contains("(404)") Then + Log(ex, "微软登录第 6 步汇报 404") + Throw New Exception("$你可能没有在购买后去 Minecraft 官网创建游戏档案，或者没有购买 Minecraft。") + Else + Throw + End If + End Try + Dim ResultJson As JObject = GetJson(Result) + Dim UUID As String = ResultJson("id").ToString + Dim UserName As String = ResultJson("name").ToString + Return {UUID, UserName, Result} + End Function + + '根据用户名返回对应 Uuid，需要多线程 + Public Function McLoginMojangUuid(Name As String, ThrowOnNotFound As Boolean) + If Name.Trim.Length = 0 Then Return StrFill("", "0", 32) + '从缓存获取 + Dim Uuid As String = ReadIni(PathTemp & "Cache\Uuid\Mojang.ini", Name, "") + If Len(Uuid) = 32 Then Return Uuid + '从官网获取 + Try + Dim GotJson As JObject = NetGetCodeByRequestRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, IsJson:=True) + If GotJson Is Nothing Then Throw New FileNotFoundException("正版玩家档案不存在（" & Name & "）") + Uuid = If(GotJson("id"), "") + Catch ex As Exception + Log(ex, "从官网获取正版 Uuid 失败（" & Name & "）") + If Not ThrowOnNotFound AndAlso ex.GetType.Name = "FileNotFoundException" Then + Uuid = McLoginLegacyUuid(Name) '玩家档案不存在 + Else + Throw New Exception("从官网获取正版 Uuid 失败", ex) + End If + End Try + '写入缓存 + If Not Len(Uuid) = 32 Then Throw New Exception("获取的正版 Uuid 长度不足（" & Uuid & "）") + WriteIni(PathTemp & "Cache\Uuid\Mojang.ini", Name, Uuid) + Return Uuid + End Function + Public Function McLoginLegacyUuid(Name As String) + Dim FullUuid As String = StrFill(Name.Length.ToString("X"), "0", 16) & StrFill(GetHash(Name).ToString("X"), "0", 16) + Return FullUuid.Substring(0, 12) & "3" & FullUuid.Substring(13, 3) & "9" & FullUuid.Substring(17, 15) + End Function + +#End Region + +#Region "Java 处理" + + Private McLaunchJavaSelected As JavaEntry = Nothing + Private Sub McLaunchJavaValidate() + Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999) + + 'MC 大版本检测 + If (McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse + (McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain <> 99) 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 + '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.Year >= 2001 Then '避免某些版本的 1960 癌 + '1.11-：最高 Java 12 + MaxVer = New Version(1, 12, 999, 999) + End If + + 'Forge 检测 + If McVersionCurrent.Version.HasForge Then + If McVersionCurrent.Version.McName = "1.7.2" Then + '1.7.2：必须 Java 7 + MinVer = New Version(1, 7, 0, 0) : MaxVer = New Version(1, 7, 999, 999) + ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain <> -1 AndAlso VersionSortBoolean("14.23.5.2855", McVersionCurrent.Version.ForgeVersion) Then + '1.12，Forge 14.23.5.2855 及更低：Java 8 + MaxVer = New Version(1, 8, 999, 999) + ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain <> -1 AndAlso VersionSortBoolean("28.2.23", McVersionCurrent.Version.ForgeVersion) Then + '1.13 - 1.14，Forge 28.2.23 及更低：Java 8 - 10 + MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 10, 999, 999) + ElseIf McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then + '1.15 - 1.16：Java 8 - 12， 12 - 15未测试 + MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999) + End If + End If + + '统一通行证检测 + If Setup.Get("LoginType") = McLoginType.Nide Then + '至少 Java 8.101 (1.8.0.101) + MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer) + End If + + '选择 Java + McLaunchLog("Java 版本需求：最低 " & MinVer.ToString & "，最高 " & MaxVer.ToString) + McLaunchJavaSelected = JavaSelect(MinVer, MaxVer, McVersionCurrent) + If McLaunchJavaSelected IsNot Nothing Then + McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString) + Exit Sub + End If + + '无合适的 Java + McLaunchLog("无合适的 Java，取消启动") + If MinVer >= New Version(1, 17, 0, 0) Then + '缺少 Java 17 + JavaMissing(17) + ElseIf MinVer >= New Version(1, 16, 0, 0) Then + '缺少 Java 16 + JavaMissing(16) + ElseIf MaxVer < New Version(1, 8, 0, 0) Then + '缺少 Java 7 + JavaMissing(7) + Else + '缺少 Java 8 较新版 + JavaMissing(8) + End If + Throw New Exception("$$") + + End Sub + +#End Region + +#Region "启动参数" + + Private McLaunchArgument As String + + '主方法，合并 Jvm、Game、Replace 三部分的参数数据 + Private Sub McLaunchArgumentMain(Loader As LoaderTask(Of String, List(Of McLibToken))) + McLaunchLog("开始获取 Minecraft 启动参数") + '获取基准字符串与参数信息 + Dim Arguments As String + If McVersionCurrent.JsonObject("arguments") IsNot Nothing AndAlso McVersionCurrent.JsonObject("arguments")("jvm") IsNot Nothing Then + McLaunchLog("获取新版 JVM 参数") + Arguments = McLaunchArgumentsJvmNew(McVersionCurrent) + McLaunchLog("新版 JVM 参数获取成功：") + McLaunchLog(Arguments) + Else + McLaunchLog("获取旧版 JVM 参数") + Arguments = McLaunchArgumentsJvmOld(McVersionCurrent) + McLaunchLog("旧版 JVM 参数获取成功：") + McLaunchLog(Arguments) + End If + If McVersionCurrent.JsonObject("minecraftArguments") IsNot Nothing Then + McLaunchLog("获取旧版 Game 参数") + Arguments += " " & McLaunchArgumentsGameOld(McVersionCurrent) + McLaunchLog("旧版 Game 参数获取成功") + End If + If McVersionCurrent.JsonObject("arguments") IsNot Nothing AndAlso McVersionCurrent.JsonObject("arguments")("game") IsNot Nothing Then + McLaunchLog("获取新版 Game 参数") + Arguments += " " & McLaunchArgumentsGameNew(McVersionCurrent) + McLaunchLog("新版 Game 参数获取成功") + End If + '替换参数 + Dim ReplaceArguments = McLaunchArgumentsReplace(McVersionCurrent, Loader) + If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then + '若自定义信息为空，则去掉该部分 + Arguments = Arguments.Replace(" --versionType ${version_type}", "") + ReplaceArguments("${version_type}") = """""" + End If + For Each entry As KeyValuePair(Of String, String) In ReplaceArguments + Arguments = Arguments.Replace(entry.Key, If(entry.Value.Contains(" ") OrElse entry.Value.Contains(":\"), """" & entry.Value & """", entry.Value)) + Next + 'MJSB + Arguments = Arguments.Replace(" -Dos.name=Windows 10", " -Dos.name=""Windows 10""") + '全屏 + If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen" + '进服 + Dim Server As String = If(String.IsNullOrEmpty(Loader.Input), Setup.Get("VersionServerEnter", McVersionCurrent), Loader.Input) + If Server.Length > 0 Then + If Server.Contains(":") Then + '包含端口号 + Arguments += " --server " & Server.Split(":")(0) & " --port " & Server.Split(":")(1) + Else + '不包含端口号 + Arguments += " --server " & Server & " --port 25565" + End If + 'OptiFine 警告 + If McVersionCurrent.Version.HasOptiFine Then + Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Critical) + End If + End If + '自定义 + Dim ArgumentGame As String = Setup.Get("VersionAdvanceGame", Version:=McVersionCurrent) + Arguments += " " & If(ArgumentGame = "", Setup.Get("LaunchAdvanceGame"), ArgumentGame) + '输出 + McLaunchLog("Minecraft 启动参数：") + McLaunchLog(Arguments.Replace(McLoginLoader.Output.AccessToken, McLoginLoader.Output.AccessToken.Substring(0, 22) & "[数据删除]" & McLoginLoader.Output.AccessToken.Substring(30))) + McLaunchArgument = Arguments + End Sub + + 'Jvm 部分（第一段） + Private Function McLaunchArgumentsJvmOld(Version As McVersion) As String + '存储以空格为间隔的启动参数列表 + Dim DataList As New List(Of String) + + '输出固定参数 + DataList.Add("-XX:HeapDumpPath=MojangTricksIntelDriversForPerformance_javaw.exe_minecraft.exe.heapdump") + Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent) + If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm") + If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true" + DataList.Insert(0, ArgumentJvm) '可变 JVM 参数 + DataList.Add("-Xmn256m") + DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & "m") + DataList.Add("""-Djava.library.path=" & Version.Path & Version.Name & "-natives""") + DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表 + + '统一通行证 + If McLoginLoader.Output.Type = "Nide" Then + DataList.Insert(0, "-Dnide8auth.client=true -javaagent:nide8auth.jar=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent)) + End If + 'Authlib-Injector + If McLoginLoader.Output.Type = "Auth" Then + Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent) + Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8) + DataList.Insert(0, "-javaagent:authlib-injector.jar=" & Server & + " -Dauthlibinjector.side=client" & + " -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response))) + End If + + '添加 MainClass + If Version.JsonObject("mainClass") Is Nothing Then + Throw New Exception("版本 Json 中没有 mainClass 项！") + Else + DataList.Add(Version.JsonObject("mainClass")) + End If + + Return Join(DataList, " ") + End Function + Private Function McLaunchArgumentsJvmNew(Version As McVersion) As String + Dim DataList As New List(Of String) + + '获取 Json 中的 DataList + Dim CurrentVersion As McVersion = Version +NextVersion: + If CurrentVersion.JsonObject("arguments") IsNot Nothing AndAlso CurrentVersion.JsonObject("arguments")("jvm") IsNot Nothing Then + For Each SubJson As JToken In CurrentVersion.JsonObject("arguments")("jvm") + If SubJson.Type = JTokenType.String Then + '字符串类型 + DataList.Add(SubJson.ToString) + Else + '非字符串类型 + If McJsonRuleCheck(SubJson("rules")) Then + '满足准则 + If SubJson("value").Type = JTokenType.String Then + DataList.Add(SubJson("value").ToString) + Else + For Each value As JToken In SubJson("value") + DataList.Add(value.ToString) + Next + End If + End If + End If + Next + End If + If CurrentVersion.InheritVersion <> "" Then + CurrentVersion = New McVersion(CurrentVersion.InheritVersion) + GoTo NextVersion + End If + + '内存、Log4j 防御参数等 + SecretLaunchJvmArgs(DataList) + + '统一通行证 + If McLoginLoader.Output.Type = "Nide" Then + DataList.Insert(0, "-javaagent:nide8auth.jar=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent)) + End If + 'Authlib-Injector + If McLoginLoader.Output.Type = "Auth" Then + Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent) + Try + Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8) + DataList.Insert(0, "-javaagent:authlib-injector.jar=" & Server & + " -Dauthlibinjector.side=client" & + " -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response))) + Catch ex As Exception + Throw New Exception("无法连接到第三方登录服务器（" & If(Server, Nothing) & "）") + End Try + End If + + '将 "-XXX" 与后面 "XXX" 合并到一起 + '如果不合并，会导致 Forge 1.17 启动无效，它有两个 --add-exports，进一步导致其中一个在后面被去重 + Dim DeDuplicateDataList As New List(Of String) + For i = 0 To DataList.Count - 1 + Dim CurrentEntry As String = DataList(i) + If DataList(i).StartsWith("-") Then + Do While i < DataList.Count - 1 + If DataList(i + 1).StartsWith("-") Then + Exit Do + Else + i += 1 + CurrentEntry += " " + DataList(i) + End If + Loop + End If + DeDuplicateDataList.Add(CurrentEntry.Trim.Replace("McEmu= ", "McEmu=")) + Next + + '去重 + Dim Result As String = Join(ArrayNoDouble(DeDuplicateDataList), " ") + + '添加 MainClass + If Version.JsonObject("mainClass") Is Nothing Then + Throw New Exception("版本 Json 中没有 mainClass 项！") + Else + Result += " " & Version.JsonObject("mainClass").ToString + End If + + Return Result + End Function + + 'Game 部分（第二段） + Private Function McLaunchArgumentsGameOld(Version As McVersion) As String + Dim DataList As New List(Of String) + + '本地化 Minecraft 启动信息 + Dim BasicString As String = Version.JsonObject("minecraftArguments").ToString + If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}" + DataList.Add(BasicString) + + McLaunchArgumentsGameOld = Join(DataList, " ") + + '特别改变 OptiFineTweaker + If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then + '把 OptiFineForgeTweaker 放在最后，不然会导致崩溃！ + If McLaunchArgumentsGameOld.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then + Log("[Launch] 发现正确的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameOld) + McLaunchArgumentsGameOld = McLaunchArgumentsGameOld.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "").Replace("--tweakClass optifine.OptiFineForgeTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker" + End If + If McLaunchArgumentsGameOld.Contains("--tweakClass optifine.OptiFineTweaker") Then + Log("[Launch] 发现错误的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameOld) + McLaunchArgumentsGameOld = McLaunchArgumentsGameOld.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker" + Try + WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker")) + Catch ex As Exception + Log(ex, "替换 OptiFineForge TweakClass 失败") + End Try + End If + End If + End Function + Private Function McLaunchArgumentsGameNew(Version As McVersion) As String + Dim DataList As New List(Of String) + + '获取 Json 中的 DataList + Dim CurrentVersion As McVersion = Version +NextVersion: + If CurrentVersion.JsonObject("arguments") IsNot Nothing AndAlso CurrentVersion.JsonObject("arguments")("game") IsNot Nothing Then + For Each SubJson As JToken In CurrentVersion.JsonObject("arguments")("game") + If SubJson.Type = JTokenType.String Then + '字符串类型 + DataList.Add(SubJson.ToString) + Else + '非字符串类型 + If McJsonRuleCheck(SubJson("rules")) Then + '满足准则 + If SubJson("value").Type = JTokenType.String Then + DataList.Add(SubJson("value").ToString) + Else + For Each value As JToken In SubJson("value") + DataList.Add(value.ToString) + Next + End If + End If + End If + Next + End If + If CurrentVersion.InheritVersion <> "" Then + CurrentVersion = New McVersion(CurrentVersion.InheritVersion) + GoTo NextVersion + End If + + '将 "-XXX" 与后面 "XXX" 合并到一起 + '如果不进行合并 Impact 会启动无效，它有两个 --tweakclass + Dim DeDuplicateDataList As New List(Of String) + For i = 0 To DataList.Count - 1 + Dim CurrentEntry As String = DataList(i) + If DataList(i).StartsWith("-") Then + Do While i < DataList.Count - 1 + If DataList(i + 1).StartsWith("-") Then + Exit Do + Else + i += 1 + CurrentEntry += " " + DataList(i) + End If + Loop + End If + DeDuplicateDataList.Add(CurrentEntry) + Next + '去重 + McLaunchArgumentsGameNew = Join(ArrayNoDouble(DeDuplicateDataList), " ") + + '特别改变 OptiFineTweaker + If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then + '把 OptiFineForgeTweaker 放在最后，不然会导致崩溃！ + If McLaunchArgumentsGameNew.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then + Log("[Launch] 发现正确的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameNew) + McLaunchArgumentsGameNew = McLaunchArgumentsGameNew.Replace(" --tweakClass optifine.OptiFineForgeTweaker", "").Replace("--tweakClass optifine.OptiFineForgeTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker" + End If + If McLaunchArgumentsGameNew.Contains("--tweakClass optifine.OptiFineTweaker") Then + Log("[Launch] 发现错误的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameNew) + McLaunchArgumentsGameNew = McLaunchArgumentsGameNew.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker" + Try + WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker")) + Catch ex As Exception + Log(ex, "替换 OptiFineForge TweakClass 失败") + End Try + End If + End If + End Function + + '替换 Arguments + Private Function McLaunchArgumentsReplace(Version As McVersion, ByRef Loader As LoaderTask(Of String, List(Of McLibToken))) As Dictionary(Of String, String) + Dim GameArguments As New Dictionary(Of String, String) + + '基础参数 + GameArguments.Add("${classpath_separator}", ";") + GameArguments.Add("${natives_directory}", Version.Path & Version.Name & "-natives") + GameArguments.Add("${library_directory}", PathMcFolder & "libraries") + GameArguments.Add("${libraries_directory}", PathMcFolder & "libraries") + GameArguments.Add("${launcher_name}", "PCL2") + GameArguments.Add("${launcher_version}", VersionCode) + GameArguments.Add("${version_name}", Version.Name) + Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Version:=McVersionCurrent) + GameArguments.Add("${version_type}", If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo)) + GameArguments.Add("${game_directory}", Left(McVersionCurrent.PathIndie, McVersionCurrent.PathIndie.Count - 1)) + GameArguments.Add("${assets_root}", PathMcFolder & "assets") + GameArguments.Add("${user_properties}", "{}") + GameArguments.Add("${auth_player_name}", McLoginLoader.Output.Name) + GameArguments.Add("${auth_uuid}", McLoginLoader.Output.Uuid) + GameArguments.Add("${auth_access_token}", McLoginLoader.Output.AccessToken) + GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken) + GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken) + GameArguments.Add("${user_type}", If(McLoginLoader.Output.Type = "Legacy", "Legacy", "Mojang")) + Dim GameSize As Size = Setup.GetLaunchArgumentWindowSize() + GameArguments.Add("${resolution_width}", GameSize.Width) + GameArguments.Add("${resolution_height}", GameSize.Height) + + 'Assets 相关参数 + GameArguments.Add("${game_assets}", PathMcFolder & "assets\virtual\legacy") '1.5.2 的 pre-1.6 资源索引应与 legacy 合并 + GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Version)) + + '支持库参数 + Dim LibList As List(Of McLibToken) = McLibListGet(Version, Not (Version.Version.HasForge AndAlso Version.Version.McCodeMain >= 17)) + Loader.Output = LibList + Dim CpStrings As New List(Of String) + Dim OptiFineCp As String = Nothing + For Each Library As McLibToken In LibList + If Library.IsNatives Then Continue For + If Library.Name IsNot Nothing AndAlso Library.Name = "optifine:OptiFine" Then + OptiFineCp = Library.LocalPath + Else + CpStrings.Add(Library.LocalPath) + End If + Next + If OptiFineCp IsNot Nothing Then CpStrings.Insert(CpStrings.Count - 2, OptiFineCp) + GameArguments.Add("${classpath}", Join(CpStrings, ";")) + + Return GameArguments + End Function + +#End Region + +#Region "解压 Natives" + + Private Sub McLaunchNatives(Loader As LoaderTask(Of List(Of McLibToken), Integer)) + + '创建文件夹 + Directory.CreateDirectory(McVersionCurrent.Path & McVersionCurrent.Name & "-natives") + + '解压文件 + McLaunchLog("正在解压 Natives 文件") + Dim ExistFiles As New List(Of String) + For Each Native As McLibToken In Loader.Input + If Not Native.IsNatives Then Continue For + Dim Zip As ZipArchive + Try + Zip = New ZipArchive(New FileStream(Native.LocalPath, FileMode.Open)) + Catch ex As InvalidDataException + Log(ex, "打开 Natives 文件失败（" & Native.LocalPath & "）") + File.Delete(Native.LocalPath) + Throw New Exception("无法打开 Natives 文件（" & Native.LocalPath & "），该文件可能已损坏，请重新尝试启动游戏") + End Try + For Each Entry In Zip.Entries + Dim FileName As String = Entry.FullName + If FileName.EndsWith(".dll") Then + '实际解压文件的步骤 + Dim FilePath As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives\" & FileName + ExistFiles.Add(FilePath) + Dim OriginalFile As New FileInfo(FilePath) + If OriginalFile.Exists Then + If OriginalFile.Length = Entry.Length Then + If ModeDebug Then McLaunchLog("无需解压：" & FilePath) + Continue For + End If + '删除原文件 + Try + File.Delete(FilePath) + Catch ex As UnauthorizedAccessException + McLaunchLog("删除原 dll 访问被拒绝，这通常代表有一个 MC 正在运行，跳过解压：" & FilePath) + McLaunchLog("实际的错误信息：" & GetString(ex)) + Exit For + End Try + End If + '解压新文件 + WriteFile(FilePath, Entry.Open) + McLaunchLog("已解压：" & FilePath) + End If + Next + If Zip IsNot Nothing Then Zip.Dispose() + Next + + '删除多余文件 + For Each FileName As String In Directory.GetFiles(McVersionCurrent.Path & McVersionCurrent.Name & "-natives") + If ExistFiles.Contains(FileName) Then Continue For + Try + McLaunchLog("删除：" & FileName) + File.Delete(FileName) + Catch ex As UnauthorizedAccessException + McLaunchLog("删除多余文件访问被拒绝，跳过删除步骤") + McLaunchLog("实际的错误信息：" & GetString(ex)) + Exit Sub + End Try + Next + + End Sub + +#End Region + +#Region "启动与前后处理" + + Private Sub McLaunchPrerun() + + '更新 launcher_profiles.json + Try + '确保可用 + If Not (McLoginLoader.Output.Type = "Mojang" OrElse McLoginLoader.Output.Type = "Microsoft") Then Exit Try + McFolderLauncherProfilesJsonCreate(PathMcFolder) + '构建需要替换的 Json 对象 + Dim ReplaceJsonString As String = " + { + ""authenticationDatabase"": { + ""00000111112222233333444445555566"": { + ""accessToken"": """ & McLoginLoader.Output.AccessToken & """, + ""username"": """ & If(McLoginLoader.Output.Email, McLoginLoader.Output.Name).Replace("""", "-") & """, + ""profiles"": { + ""66666555554444433333222221111100"": { + ""displayName"": """ & McLoginLoader.Output.Name & """ + } + } + } + }, + ""clientToken"": """ & McLoginLoader.Output.ClientToken & """, + ""selectedUser"": { + ""account"": ""00000111112222233333444445555566"", + ""profile"": ""66666555554444433333222221111100"" + } + }" + Dim ReplaceJson As JObject = GetJson(ReplaceJsonString) + '更新文件 + Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json")) + Profiles.Merge(ReplaceJson) + WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.Default) + McLaunchLog("已更新 launcher_profiles.json") + Catch ex As Exception + Log(ex, "更新 launcher_profiles.json 失败，将在删除文件后重试") + Try + File.Delete(PathMcFolder & "launcher_profiles.json") + McFolderLauncherProfilesJsonCreate(PathMcFolder) + '构建需要替换的 Json 对象 + Dim ReplaceJsonString As String = " + { + ""authenticationDatabase"": { + ""00000111112222233333444445555566"": { + ""accessToken"": """ & McLoginLoader.Output.AccessToken & """, + ""username"": """ & If(McLoginLoader.Output.Email, McLoginLoader.Output.Name).Replace("""", "-") & """, + ""profiles"": { + ""66666555554444433333222221111100"": { + ""displayName"": """ & McLoginLoader.Output.Name & """ + } + } + } + }, + ""clientToken"": """ & McLoginLoader.Output.ClientToken & """, + ""selectedUser"": { + ""account"": ""00000111112222233333444445555566"", + ""profile"": ""66666555554444433333222221111100"" + } + }" + Dim ReplaceJson As JObject = GetJson(ReplaceJsonString) + '更新文件 + Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json")) + Profiles.Merge(ReplaceJson) + WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.Default) + McLaunchLog("已在删除后更新 launcher_profiles.json") + Catch exx As Exception + Log(exx, "更新 launcher_profiles.json 失败", LogLevel.Feedback) + End Try + End Try + + '更新 options.txt + Dim SetupFileAddress As String = McVersionCurrent.PathIndie & "options.txt" + Try + '语言 + If Setup.Get("ToolHelpChinese") Then + If Not File.Exists(SetupFileAddress) OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves") Then + McLaunchLog("已根据设置自动修改语言为中文") + WriteIni(SetupFileAddress, "lang", "-") '触发缓存更改，避免删除后重新下载残留缓存 + If McVersionCurrent.Version.McCodeMain >= 12 Then + WriteIni(SetupFileAddress, "lang", "zh_cn") + Else + WriteIni(SetupFileAddress, "lang", "zh_CN") + End If + WriteIni(SetupFileAddress, "forceUnicodeFont", "true") + Else + McLaunchLog("并非首次启动，不修改语言") + End If + End If + '窗口 + Select Case Setup.Get("LaunchArgumentWindowType") + Case 0 '全屏 + WriteIni(SetupFileAddress, "fullscreen", "true") + Case 5 '保持默认 + Case Else '其他 + WriteIni(SetupFileAddress, "fullscreen", "false") + End Select + Catch ex As Exception + Log(ex, "更新 options.txt 失败", LogLevel.Hint) + End Try + + '离线皮肤 Alex 警告 + Try + If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.7 ~ 1.2 + McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录 + (Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex + (Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤 + Hint("此 Minecraft 版本尚不支持 Alex 皮肤，你的皮肤可能会显示为 Steve！", HintType.Critical) + End If + Catch ex As Exception + Log(ex, "检查离线皮肤失效失败") + End Try + + '离线皮肤资源包 + Try + Directory.CreateDirectory(McVersionCurrent.PathIndie & "resourcepacks\") + Dim ZipFileAddress As String = McVersionCurrent.PathIndie & "resourcepacks\PCL2 Skin.zip" + Dim NewTypeSetup As Boolean = McVersionCurrent.Version.McCodeMain >= 13 OrElse McVersionCurrent.Version.McCodeMain < 6 + If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Setup.Get("LaunchSkinType") = 4 AndAlso File.Exists(PathTemp & "CustomSkin.png") Then + Directory.CreateDirectory(PathTemp) + Dim MetaFileAddress As String = PathTemp & "pack.mcmeta" + Dim PackPicAddress As String = PathTemp & "pack.png" + Dim PackFormat As Integer + Select Case McVersionCurrent.Version.McCodeMain + Case 0, 1, 2, 3, 4, 5 + '更早的版本没有资源包；如果判断失败该值为 -1，不会跑到这 + McLaunchLog("Minecraft 版本过老，尚不支持自定义离线皮肤") + GoTo IgnoreCustomSkin + Case 6, 7, 8 + PackFormat = 1 + Case 9, 10 + PackFormat = 2 + Case 11, 12 + PackFormat = 3 + Case 13, 14 + PackFormat = 4 + Case 15 + PackFormat = 5 + Case 16 + PackFormat = 6 + Case 17 + PackFormat = 7 + Case 18 + If McVersionCurrent.Version.McCodeSub <= 2 Then + PackFormat = 8 + Else + PackFormat = 9 + End If + Case 19 + PackFormat = 9 + Case Else + PackFormat = 10 + End Select + McLaunchLog("正在构建自定义皮肤资源包，格式为：" & PackFormat) + '准备文件 + Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png") + Bit.Save(PackPicAddress) + WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL2 自定义离线皮肤资源包""}}") + Dim Skin As New MyBitmap(PathTemp & "CustomSkin.png") + If (McVersionCurrent.Version.McCodeMain = 6 OrElse McVersionCurrent.Version.McCodeMain = 7) AndAlso Skin.Pic.Height = 64 Then + McLaunchLog("该 Minecraft 版本不支持双层皮肤，已进行裁剪") + Skin = Skin.Clip(New System.Drawing.Rectangle(0, 0, 64, 32)) + End If + Skin.Save(Path & "PCL\CustomSkin_Cliped.png") + '构建压缩文件 + Using ZipFile As New FileStream(ZipFileAddress, FileMode.Create) + Using ZipAr As New ZipArchive(ZipFile, ZipArchiveMode.Create) + ZipAr.CreateEntryFromFile(MetaFileAddress, "pack.mcmeta") + ZipAr.CreateEntryFromFile(PackPicAddress, "pack.png") + ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Setup.Get("LaunchSkinSlim"), "alex.png", "steve.png")) + End Using + End Using + File.Delete(Path & "PCL\CustomSkin_Cliped.png") + '更改设置文件 + IniClearCache(SetupFileAddress) + Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]") + If NewTypeSetup Then + If EnabledResourcePack = "" Then EnabledResourcePack = """vanilla""" + Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(",")) + Dim NewResourcePacks As New List(Of String) + For Each Res In EnabledResourcePacks + If Res <> """file/PCL2 Skin.zip""" AndAlso Res <> "" Then NewResourcePacks.Add(Res) + Next + NewResourcePacks.Add("""file/PCL2 Skin.zip""") + Dim Result As String = "[" & Join(NewResourcePacks, ",") & "]" + WriteIni(SetupFileAddress, "resourcePacks", Result) + Else + Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(",")) + Dim NewResourcePacks As New List(Of String) + For Each Res In EnabledResourcePacks + If Res <> """PCL2 Skin.zip""" AndAlso Res <> "" Then NewResourcePacks.Add(Res) + Next + NewResourcePacks.Add("""PCL2 Skin.zip""") + Dim Result As String = "[" & Join(NewResourcePacks, ",") & "]" + WriteIni(SetupFileAddress, "resourcePacks", Result) + End If +IgnoreCustomSkin: + ElseIf File.Exists(ZipFileAddress) Then + McLaunchLog("正在清空自定义皮肤资源包") + '删除压缩文件 + File.Delete(ZipFileAddress) + '更改设置文件 + IniClearCache(SetupFileAddress) + Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]") + If NewTypeSetup Then + If EnabledResourcePack = "" Then EnabledResourcePack = """vanilla""" + Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(",")) + EnabledResourcePacks.Remove("""file/PCL2 Skin.zip""") + Dim Result As String = "[" & Join(EnabledResourcePacks, ",") & "]" + WriteIni(SetupFileAddress, "resourcePacks", Result) + Else + Dim EnabledResourcePacks As New List(Of String)(EnabledResourcePack.Split(",")) + EnabledResourcePacks.Remove("""PCL2 Skin.zip""") + Dim Result As String = "[" & Join(EnabledResourcePacks, ",") & "]" + WriteIni(SetupFileAddress, "resourcePacks", Result) + End If + End If + Catch ex As Exception + Log(ex, "离线皮肤资源包设置失败", LogLevel.Hint) + End Try + + End Sub + Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process)) + + '启动信息 + Dim GameProcess = New Process() + Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJavaw) + + '设置环境变量 + If StartInfo.EnvironmentVariables.ContainsKey("appdata") Then + StartInfo.EnvironmentVariables("appdata") = PathMcFolder + Else + StartInfo.EnvironmentVariables.Add("appdata", PathMcFolder) + End If + Dim Paths As New List(Of String)(StartInfo.EnvironmentVariables("Path").Split(";")) + Paths.Add(McLaunchJavaSelected.PathFolder) + StartInfo.EnvironmentVariables("Path") = Join(ArrayNoDouble(Paths), ";") + + '设置其他参数 + StartInfo.WorkingDirectory = McVersionCurrent.PathIndie + StartInfo.UseShellExecute = False + StartInfo.RedirectStandardOutput = True + StartInfo.RedirectStandardError = True + StartInfo.CreateNoWindow = False + StartInfo.Arguments = McLaunchArgument + GameProcess.StartInfo = StartInfo + + '开始进程 + GameProcess.Start() + McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.PathJavaw) + Loader.Output = GameProcess + McLaunchProcess = GameProcess + + '输出 bat + Try + Dim CmdString As String = + "@echo off" & vbCrLf & + "title 启动 - " & McVersionCurrent.Name & vbCrLf & + "echo 游戏正在启动，请稍候。" & vbCrLf & + "set APPDATA=""" & PathMcFolder & """" & vbCrLf & + "cd /D """ & PathMcFolder & """" & vbCrLf & + """" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf & + "echo 游戏已退出。" & vbCrLf & + "pause" + WriteFile(Path & "PCL\LatestLaunch.bat", CmdString, Encoding:=Encoding.Default) + Catch ex As Exception + Log(ex, "输出启动脚本失败") + End Try + + '进程优先级处理 + Try + If GameProcess.HasExited Then Exit Try '可能在启动游戏进程的同时刚好取消了启动 + GameProcess.PriorityBoostEnabled = True + Select Case Setup.Get("LaunchArgumentPriority") + Case 0 '高 + GameProcess.PriorityClass = ProcessPriorityClass.AboveNormal + Case 2 '低 + GameProcess.PriorityClass = ProcessPriorityClass.BelowNormal + Case Else '中 + End Select + Catch ex As Exception + Log(ex, "设置进程优先级失败", LogLevel.Feedback) + End Try + + End Sub + Private Sub McLaunchWait(Loader As LoaderTask(Of Process, Integer)) + + '输出信息 + McLaunchLog("") + McLaunchLog("~ 基础参数 ~") + McLaunchLog("PCL2 版本：" & VersionDisplayName & " (" & VersionCode & ")") + McLaunchLog("游戏版本：" & McVersionCurrent.Version.ToString & "（" & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & "）") + McLaunchLog("资源版本：" & McAssetsGetIndexName(McVersionCurrent)) + McLaunchLog("版本继承：" & If(McVersionCurrent.InheritVersion = "", "无", McVersionCurrent.InheritVersion)) + McLaunchLog("分配的内存：" & PageVersionSetup.GetRam(McVersionCurrent) & " GB（" & Math.Round(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & " MB）") + McLaunchLog("MC 文件夹：" & PathMcFolder) + McLaunchLog("版本文件夹：" & McVersionCurrent.Path) + McLaunchLog("版本隔离：" & (McVersionCurrent.PathIndie = McVersionCurrent.Path)) + McLaunchLog("HMCL 格式：" & McVersionCurrent.IsHmclFormatJson) + McLaunchLog("Java 信息：" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java")) + McLaunchLog("环境变量：" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置")) + McLaunchLog("") + McLaunchLog("~ 登录参数 ~") + McLaunchLog("玩家用户名：" & McLoginLoader.Output.Name) + McLaunchLog("AccessToken：" & McLoginLoader.Output.AccessToken.Substring(0, 22) & "[数据删除]" & McLoginLoader.Output.AccessToken.Substring(30)) + McLaunchLog("ClientToken：" & McLoginLoader.Output.ClientToken) + McLaunchLog("UUID：" & McLoginLoader.Output.Uuid) + McLaunchLog("登录方式：" & McLoginLoader.Output.Type) + McLaunchLog("") + + '获取窗口标题 + Dim WindowTitle As String = Setup.Get("VersionArgumentTitle", Version:=McVersionCurrent) + If WindowTitle = "" Then WindowTitle = Setup.Get("LaunchArgumentTitle") + WindowTitle = ArgumentReplace(WindowTitle) + + '初始化等待 + Dim Watcher As New Watcher(Loader, McVersionCurrent, WindowTitle) + McLaunchWatcher = Watcher + + '等待 + Do While Watcher.State = Watcher.MinecraftState.Loading + Thread.Sleep(100) + Loop + If Watcher.State = Watcher.MinecraftState.Crashed Then + Throw New Exception("$$") + End If + + End Sub + Private Sub McLaunchEnd() + McLaunchLog("开始启动结束处理") + + '暂停或开始音乐播放 + If Setup.Get("UiMusicStop") Then + RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置，在启动后暂停音乐播放")) + ElseIf Setup.Get("UiMusicStart") Then + RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置，在启动后开始音乐播放")) + End If + + '启动器可见性 + McLaunchLog("启动器可见性：" & Setup.Get("LaunchArgumentVisible")) + Select Case Setup.Get("LaunchArgumentVisible") + Case 0 + '直接关闭 + McLaunchLog("已根据设置，在启动后关闭启动器") + RunInUi(Sub() FrmMain.EndProgram(False)) + Case 2, 3 + '隐藏 + McLaunchLog("已根据设置，在启动后隐藏启动器") + RunInUi(Sub() FrmMain.Hidden = True) + Case 4 + '最小化 + McLaunchLog("已根据设置，在启动后最小化启动器") + RunInUi(Sub() FrmMain.WindowState = WindowState.Minimized) + Case 5 + '啥都不干 + End Select + + '启动计数 + Setup.Set("SystemLaunchCount", Setup.Get("SystemLaunchCount") + 1) + + End Sub + +#End Region + +End Module diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb new file mode 100644 index 0000000..bd77ab2 --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb @@ -0,0 +1,3835 @@ +Imports System.IO.Compression + +Public Module ModMinecraft + +#Region "Java" + + '列表初始化 + + Public JavaListCacheVersion As Integer = 1 + ''' + ''' 目前所有可用的 Java。 + ''' + Public JavaList As List(Of JavaEntry) + ''' + ''' 初始化 Java 列表，但除非没有 Java，否则不进行检查。 + ''' + Public Sub JavaListInit() + JavaList = New List(Of JavaEntry) + Try + If Setup.Get("CacheJavaListVersion") < JavaListCacheVersion Then + '不使用缓存 + Log("[Java] 要求 Java 列表缓存更新") + Setup.Set("CacheJavaListVersion", JavaListCacheVersion) + Else + '使用缓存 + For Each JsonEntry In GetJson(Setup.Get("LaunchArgumentJavaAll")) + JavaList.Add(JavaEntry.FromJson(JsonEntry)) + Next + End If + If JavaList.Count = 0 Then + Log("[Java] 初始化未找到可用的 Java，将自动触发搜索", LogLevel.Developer) + JavaSearchLoader.Start(0) + Else + Log("[Java] 缓存中有 " & JavaList.Count & " 个可用的 Java") + End If + Catch ex As Exception + Log(ex, "初始化 Java 列表失败", LogLevel.Feedback) + Setup.Set("LaunchArgumentJavaAll", "[]") + End Try + End Sub + + '基础环境 + + ''' + ''' Path 环境变量。 + ''' + Private ReadOnly Property PathEnv As String + Get + If _PathEnv Is Nothing Then _PathEnv = Environment.GetEnvironmentVariable("Path") + Return _PathEnv + End Get + End Property + Private _PathEnv As String = Nothing + + Public Class JavaEntry + + '路径 + ''' + ''' Java.exe 文件的完整路径。 + ''' + Public ReadOnly Property PathJava As String + Get + Return PathFolder & "java.exe" + End Get + End Property + ''' + ''' Javaw.exe 文件的完整路径。 + ''' + Public ReadOnly Property PathJavaw As String + Get + Return PathFolder & "javaw.exe" + End Get + End Property + ''' + ''' Javaw.exe 文件所在文件夹的路径，以 \ 结尾且只含有 \。 + ''' + Public PathFolder As String + ''' + ''' 是否为用户手动导入的 Java。 + ''' + Public IsUserImport As Boolean + + '版本信息 + ''' + ''' Java 的详细版本。若不足 4 位会在前方补 1，例如 1.16.0.1。 + ''' 其大版本号为 Minor。 + ''' + Public Version As Version + ''' + ''' Java 的大版本号。 + ''' + Public ReadOnly Property VersionCode As Integer + Get + Return Version.Minor + End Get + End Property + ''' + ''' 是否为 Java Runtime Environment。 + ''' + Public IsJre As Boolean + ''' + ''' 是否为 64 位 Java。 + ''' + Public Is64Bit As Boolean + ''' + ''' 是否已设置环境变量。 + ''' + Public ReadOnly Property HasEnvironment As Boolean + Get + If PathFolder Is Nothing OrElse PathEnv Is Nothing Then Return False + Return PathEnv.Replace("\", "").Replace("/", "").ToLower.Contains(PathFolder.Replace("\", "").ToLower) + End Get + End Property + + '序列化 + Public Function ToJson() As JObject + Return New JObject({New JProperty("Path", PathFolder), New JProperty("VersionString", Version.ToString), New JProperty("IsJre", IsJre), New JProperty("Is64Bit", Is64Bit), New JProperty("IsUserImport", IsUserImport)}) + End Function + Public Shared Function FromJson(Data As JObject) As JavaEntry + Return New JavaEntry(Data("Path"), Data("IsUserImport")) With {.Version = New Version(Data("VersionString")), .IsJre = Data("IsJre"), .Is64Bit = Data("Is64Bit")} + End Function + ''' + ''' 转化为用户友好的字符串输出。 + ''' + Public Overrides Function ToString() As String + Dim VersionString = Version.ToString + If VersionString.StartsWith("1.") Then VersionString = Mid(VersionString, 3) + Return If(IsJre, "Java ", "JDK ") & VersionCode & " (" & VersionString & ")，" & If(Is64Bit, "64", "32") & " 位" & If(IsUserImport, "，手动导入", "") & "：" & PathFolder + End Function + + '构造 + ''' + ''' 输入 javaw.exe 文件所在文件夹的路径，不限制结尾。 + ''' + Public Sub New(Folder As String, IsUserImport As Boolean) + If Not Folder.EndsWith("\") Then Folder += "\" + PathFolder = Folder.Replace("/", "\") + Me.IsUserImport = IsUserImport + End Sub + + '方法 + Private IsChecked As Boolean = False + ''' + ''' 检查并获取 Java 详细信息。在 Java 存在异常时抛出错误。 + ''' + Public Sub Check() + If IsChecked Then Exit Sub + Dim Output As String = Nothing + Try + '确定文件存在 + If Not File.Exists(PathJavaw) Then + Throw New FileNotFoundException("未找到 javaw.exe 文件", PathJavaw) + End If + If Not File.Exists(PathFolder & "java.exe") Then + Throw New FileNotFoundException("未找到 java.exe 文件", PathFolder & "java.exe") + End If + IsJre = Not File.Exists(PathFolder & "javac.exe") + '运行 -version + Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 8000).ToLower + If ModeDebug Then Log("[Java] Java 检查输出：" & PathFolder & "java.exe" & vbCrLf & Output) + '获取详细信息 + Dim VersionString = If(RegexSeek(Output, "(?<=version "")[^""]+"), If(RegexSeek(Output, "(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First + Do While VersionString.Split(".").Count < 4 + If VersionString.StartsWith("1.") Then + VersionString = VersionString & ".0" + Else + VersionString = "1." & VersionString + End If + Loop + Version = New Version(VersionString) + If Version.Minor = 0 Then + Log("[Java] 疑似 X.0.X.X 格式版本号：" & Version.ToString) + Version = New Version(1, Version.Major, Version.Build, Version.Revision) + End If + Is64Bit = Output.Contains("64-bit") + If Version.Minor <= 4 OrElse Version.Minor >= 25 Then Throw New Exception("分析详细信息失败，获取的版本为 " & Version.ToString) + Catch ex As Exception + Log("[Java] 检查失败的 Java 输出：" & PathFolder & "java.exe" & vbCrLf & If(Output, "无程序输出")) + ex = New Exception("检查 Java 详细信息失败（" & If(PathJavaw, "Nothing") & "）", ex) + Throw ex + End Try + IsChecked = True + End Sub + + End Class + + '搜索 + + ''' + ''' 模糊搜索并获取所有可用的 Java，并在结束后更新设置页面显示。输出将直接写入 JavaList。 + ''' + Public JavaSearchLoader As New LoaderTask(Of Integer, Integer)("Java Search Loader", AddressOf JavaSearchLoaderSub) + Private Sub JavaSearchLoaderSub(Loader As LoaderTask(Of Integer, Integer)) + If FrmSetupLaunch IsNot Nothing Then + RunInUiWait(Sub() + FrmSetupLaunch.ComboArgumentJava.Items.Clear() + FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) + End Sub) + End If + If FrmVersionSetup IsNot Nothing Then + RunInUiWait(Sub() + FrmVersionSetup.ComboArgumentJava.Items.Clear() + FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) + End Sub) + End If + + Try + + '可能包含 Java 的文件夹列表，以 “\” 结尾，且仅包含 “\” + 'Key：文件夹地址 + 'Value: 是否为玩家手动导入 + Dim JavaPreList As New Dictionary(Of String, Boolean) + +#Region "模糊查找可能可用的 Java" + + '查找环境变量中的 Java + For Each PathInEnv As String In Split(PathEnv.Replace("\\", "\").Replace("/", "\"), ";") + PathInEnv = PathInEnv.Trim(" """.ToCharArray()) + If Not PathInEnv.EndsWith("\") Then PathInEnv += "\" + '粗略检查有效性 + If File.Exists(PathInEnv & "javaw.exe") Then DictionaryAdd(JavaPreList, PathInEnv, False) + Next + '查找磁盘中的 Java + For Each Disk As DriveInfo In DriveInfo.GetDrives() + JavaSearchFolder(Disk.Name, JavaPreList, False) + Next + '查找 APPDATA 文件夹中的 Java + JavaSearchFolder(PathAppdata, JavaPreList, False) + '查找启动器目录中的 Java + JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True) + '查找所选 Minecraft 文件夹中的 Java + If Not String.IsNullOrWhiteSpace(PathMcFolder) AndAlso Path <> PathMcFolder Then + JavaSearchFolder(PathMcFolder, JavaPreList, False, IsFullSearch:=True) + End If + + '若[不全]为符号链接，则清除符号链接的地址 + Dim JavaWithoutReparse As New Dictionary(Of String, Boolean) + For Each Pair In JavaPreList + Dim Folder As String = Pair.Key.Replace("\\", "\").Replace("/", "\") + Dim Info As FileSystemInfo = New FileInfo(Folder & "javaw.exe") + Do + If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then + Log("[Java] 位于 " & Folder & " 的 Java 包含符号链接") + Continue For + End If + Info = If(TypeOf Info Is FileInfo, CType(Info, FileInfo).Directory, CType(Info, DirectoryInfo).Parent) + Loop While Info IsNot Nothing + Log("[Java] 位于 " & Folder & " 的 Java 不含符号链接") + JavaWithoutReparse.Add(Pair.Key, Pair.Value) + Next + If JavaWithoutReparse.Count > 0 Then JavaPreList = JavaWithoutReparse + + '若不全为 javapath_target，则清除二重引用的地址 + Dim JavaWithoutInherit As New Dictionary(Of String, Boolean) + For Each Pair In JavaPreList + If Pair.Key.Contains("javapath_target_") Then + Log("[Java] 位于 " & Pair.Key & " 的 Java 包含二重引用") + Continue For + End If + Log("[Java] 位于 " & Pair.Key & " 的 Java 不含二重引用") + JavaWithoutInherit.Add(Pair.Key, Pair.Value) + Next + If JavaWithoutInherit.Count > 0 Then JavaPreList = JavaWithoutInherit + +#End Region + +#Region "添加玩家手动导入的 Java" + + Dim ImportedJava As String = Setup.Get("LaunchArgumentJavaAll") + Try + For Each JavaJsonObject In GetJson(ImportedJava) + Dim Entry = JavaEntry.FromJson(JavaJsonObject) + If Entry.IsUserImport Then DictionaryAdd(JavaPreList, Entry.PathFolder, True) + Next + Catch ex As Exception + Log(ex, "Java 列表已损坏", LogLevel.Feedback) + Setup.Set("LaunchArgumentJavaAll", "[]") + End Try + +#End Region + + '确保可用并获取详细信息，转入正式列表 + Dim NewJavaList As New List(Of JavaEntry) + For Each Entry In JavaPreList + NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value)) + Next + NewJavaList = Sort(JavaCheckList(NewJavaList), AddressOf JavaSorter) + + '修改设置项 + Dim AllList As New JArray + For Each Java In NewJavaList + AllList.Add(Java.ToJson) + Next + Setup.Set("LaunchArgumentJavaAll", AllList.ToString(Newtonsoft.Json.Formatting.None)) + JavaList = NewJavaList + + Catch ex As Exception + Log(ex, "搜索 Java 时出错", LogLevel.Feedback) + JavaList = New List(Of JavaEntry) + End Try + + Log("[Java] Java 搜索完成，发现 " & JavaList.Count & " 个 Java") + If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.RefreshJavaComboBox()) + If FrmVersionSetup IsNot Nothing Then RunInUi(Sub() FrmVersionSetup.RefreshJavaComboBox()) + End Sub + + ''' + ''' 多线程检查列表中的所有 Java 项。 + ''' + Private Function JavaCheckList(JavaEntries As List(Of JavaEntry)) As List(Of JavaEntry) + Log("[Java] 开始确认列表 Java 状态，共 " & JavaEntries.Count & " 项") + JavaCheckList = New List(Of JavaEntry) + Dim ListLock As New Object + + '启动检查线程 + Dim CheckThreads As New List(Of Thread) + For Each Entry In JavaEntries + Dim CheckThread As New Thread(Sub() + Try + Entry.Check() + Log("[Java] " & Entry.ToString) + SyncLock ListLock + JavaCheckList.Add(Entry) + End SyncLock + Catch ex As Exception + If Entry.IsUserImport Then + Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常，将被自动移除", LogLevel.Hint) + Else + Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常") + End If + End Try + End Sub) + CheckThreads.Add(CheckThread) + CheckThread.Start() + Next + + '等待构造线程完成 +Wait: + Thread.Sleep(10) + For Each CheckThread In CheckThreads + If CheckThread.IsAlive Then GoTo Wait + Next + End Function + ''' + ''' 模糊搜索指定文件夹下的 Java，并只进行粗略的检查。这不会搜索全部路径。 + ''' + ''' 开始搜索的起始路径，不限制结尾。 + ''' 搜索当前文件夹下的全部文件夹（此参数不会传递到子文件夹）。 + Private Sub JavaSearchFolder(OriginalPath As String, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False) + Try + Log("[Java] 开始" & If(IsFullSearch, "完全", "部分") & "遍历查找：" & OriginalPath) + JavaSearchFolder(New DirectoryInfo(OriginalPath), Results, Source, IsFullSearch) + Catch ex As UnauthorizedAccessException + Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath) + Catch ex As Exception + Log(ex, "遍历查找 Java 时出错（" & OriginalPath & "）") + End Try + End Sub + ''' + ''' 模糊搜索指定文件夹下的 Java，并只进行粗略的检查。这不会搜索全部路径。 + ''' + ''' 开始搜索的起始路径，不限制结尾。 + ''' 搜索当前文件夹下的全部文件夹（此参数不会传递到子文件夹）。 + 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 + Dim Path As String = OriginalPath.FullName.Replace("\\", "\") + If Not Path.EndsWith("\") Then Path += "\" + '若该目录有 Java，则加入结果 + If File.Exists(Path & "javaw.exe") Then DictionaryAdd(Results, Path, Source) + '查找其下的所有文件夹 + For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories + If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接 + Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串 + If IsFullSearch OrElse + FolderInfo.Parent.Name.ToLower = "users" OrElse + SearchEntry.Contains("java") OrElse SearchEntry.Contains("jdk") OrElse SearchEntry.Contains("env") OrElse + SearchEntry.Contains("环境") OrElse SearchEntry.Contains("run") OrElse SearchEntry.Contains("软件") OrElse + SearchEntry.Contains("jre") OrElse SearchEntry = "bin" OrElse SearchEntry.Contains("mc") OrElse + SearchEntry.Contains("software") OrElse SearchEntry.Contains("cache") OrElse SearchEntry.Contains("temp") OrElse + SearchEntry.Contains("corretto") OrElse SearchEntry.Contains("roaming") OrElse SearchEntry.Contains("users") OrElse + SearchEntry.Contains("craft") OrElse SearchEntry.Contains("program") OrElse SearchEntry.Contains("世界") OrElse + SearchEntry.Contains("net") OrElse SearchEntry.Contains("游戏") OrElse SearchEntry.Contains("oracle") OrElse + SearchEntry.Contains("game") OrElse SearchEntry.Contains("file") OrElse SearchEntry.Contains("data") OrElse + SearchEntry.Contains("jvm") OrElse SearchEntry.Contains("服务") OrElse SearchEntry.Contains("server") OrElse + SearchEntry.Contains("客户") OrElse SearchEntry.Contains("client") OrElse SearchEntry.Contains("整合") OrElse + SearchEntry.Contains("应用") OrElse SearchEntry.Contains("运行") OrElse SearchEntry.Contains("前置") OrElse + SearchEntry.Contains("mojang") OrElse SearchEntry.Contains("官启") OrElse SearchEntry.Contains("新建文件夹") OrElse + SearchEntry.Contains("eclipse") OrElse SearchEntry.Contains("microsoft") OrElse SearchEntry.Contains("hotspot") OrElse + SearchEntry.Contains("runtime") OrElse SearchEntry.Contains("x86") OrElse SearchEntry.Contains("x64") OrElse + SearchEntry.Contains("forge") OrElse SearchEntry.Contains("原版") OrElse SearchEntry.Contains("optifine") OrElse + SearchEntry.Contains("官方") OrElse SearchEntry.Contains("启动") OrElse SearchEntry.Contains("hmcl") OrElse + SearchEntry.Contains("mod") OrElse SearchEntry.Contains("高清") OrElse SearchEntry.Contains("download") OrElse + SearchEntry.Contains("launch") OrElse SearchEntry.Contains("程序") OrElse SearchEntry.Contains("path") OrElse + SearchEntry.Contains("国服") OrElse SearchEntry.Contains("网易") OrElse SearchEntry.Contains("ext") OrElse '网易 Java 文件夹名 + SearchEntry.Contains("netease") OrElse SearchEntry.Contains("1.") OrElse SearchEntry.Contains("启动") Then + JavaSearchFolder(FolderInfo, Results, Source) + End If + Next + Catch ex As UnauthorizedAccessException + Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath.FullName) + Catch ex As Exception + Log(ex, "遍历查找 Java 时出错（" & OriginalPath.FullName & "）") + End Try + End Sub + Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\" + + '获取 + + ''' + ''' 根据要求返回最适合的 Java，若找不到则返回 Nothing。 + ''' 最小与最大版本在与输入相同时也会通过。 + ''' 必须在工作线程调用。 + ''' + Public Function JavaSelect(Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing, Optional RelatedVersion As McVersion = Nothing) As JavaEntry + Try + Dim AllowedJavaList As New List(Of JavaEntry) + + '添加特定的 Java + Dim JavaPreList As New Dictionary(Of String, Boolean) + If PathMcFolder.Split("\").Count > 3 Then JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录的话） + JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹 + If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹 + Dim TargetJavaList As New List(Of JavaEntry) + For Each Entry In JavaPreList + TargetJavaList.Add(New JavaEntry(Entry.Key, Entry.Value)) + Next + If TargetJavaList.Count > 0 Then + TargetJavaList = JavaCheckList(TargetJavaList) + Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定目录下的 Java") + End If + +RetryGet: + '等待进行中的搜索结束 + If JavaSearchLoader.State <> LoadState.Finished AndAlso JavaSearchLoader.State <> LoadState.Waiting Then JavaSearchLoader.WaitForExit() + Select Case JavaSearchLoader.State + Case LoadState.Failed + Throw JavaSearchLoader.Error + Case LoadState.Aborted + Throw New ThreadInterruptedException("Java 搜索加载器已中断") + End Select + Dim AllJavaList As New List(Of JavaEntry) + AllJavaList.AddRange(TargetJavaList) + AllJavaList.AddRange(JavaList) + + '根据选定条件进行过滤 + For Each Java In AllJavaList + If MinVersion IsNot Nothing AndAlso Java.Version < MinVersion Then Continue For + If MaxVersion IsNot Nothing AndAlso Java.Version > MaxVersion Then Continue For + If Java.Is64Bit AndAlso Is32BitSystem Then Continue For + AllowedJavaList.Add(Java) + Next + + '若未找到适合的 Java，尝试触发搜索 + If AllowedJavaList.Count = 0 AndAlso JavaSearchLoader.State = LoadState.Waiting Then + Log("[Java] 未找到满足条件的 Java，尝试进行搜索") + JavaSearchLoader.Start() + GoTo RetryGet + End If + + '若依然未找到适合的 Java，直接返回 + If AllowedJavaList.Count = 0 Then Return Nothing + + '检查用户指定的 Java + Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect") + If RelatedVersion IsNot Nothing Then + Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion) + If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion + End If + If UserSetup <> "" Then + Dim UserJava As JavaEntry + Try + UserJava = JavaEntry.FromJson(GetJson(UserSetup)) + Catch ex As Exception + Setup.Set("LaunchArgumentJavaSelect", "") + Log(ex, "获取储存的 Java 失败") + GoTo UserPass + End Try + For Each Java In AllowedJavaList + If Java.PathFolder = UserJava.PathFolder Then + '直接使用指定的 Java + AllowedJavaList = New List(Of JavaEntry) From {UserJava} + GoTo UserPass + End If + Next + Log("[Java] 发现用户指定的不兼容 Java：" & UserJava.ToString) + If MyMsgBox("你在启动设置中指定了使用下列 Java：" & vbCrLf & + " - " & UserJava.ToString & vbCrLf & + vbCrLf & + "该 Java 可能不兼容当前游戏版本，游戏存在崩溃风险。是否要强制使用该 Java？", "Java 兼容性警告", "取消，让 PCL2 自动选择", "继续") = 2 Then + '强制使用指定的 Java + Log("[Java] 已强制使用用户指定的不兼容 Java") + AllowedJavaList = New List(Of JavaEntry) From {UserJava} + End If + End If + + '检查特定的 Java + For Each Java In AllowedJavaList + If TargetJavaList.Contains(Java) Then + '直接使用指定的 Java + AllowedJavaList = New List(Of JavaEntry) From {Java} + Log("[Java] 使用特定目录下的 Java：" & Java.ToString) + GoTo UserPass + End If + Next +UserPass: + + '对适合的 Java 进行排序 + AllowedJavaList = Sort(AllowedJavaList, AddressOf JavaSorter) + + '检查选定的 Java，若测试失败则尝试进行搜索 + Dim SelectedJava = AllowedJavaList.First + Try + SelectedJava.Check() + Catch ex As Exception + Log(ex, "找到的 Java 已无法使用，尝试进行搜索") + JavaSearchLoader.Start(IsForceRestart:=True) + GoTo RetryGet + End Try + + '返回 + Log("[Java] 选定的 Java：" & SelectedJava.ToString) + Return SelectedJava + + Catch ex As ThreadInterruptedException + Log(ex, "查找符合条件的 Java 时出现加载器中断") + Return Nothing + Catch ex As Exception + Log(ex, "查找符合条件的 Java 失败", LogLevel.Feedback) + Return Nothing + End Try + End Function + ''' + ''' 返回是否安装了 64 位 Java，或在强制指定的时候是否指定 64 位 Java。 + ''' + Public Function JavaUse64Bit(Optional RelatedVersion As McVersion = Nothing) As Boolean + Try + '检查强制指定 + Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect") + If RelatedVersion IsNot Nothing Then + Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion) + If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion + End If + If UserSetup <> "" Then + Dim UserJava = JavaEntry.FromJson(GetJson(UserSetup)) + For Each Java In JavaList + If Java.PathFolder = UserJava.PathFolder Then Return UserJava.Is64Bit + Next + End If + '检查列表 + For Each Java In JavaList + If Java.Is64Bit Then Return True + Next + Return False + Catch ex As Exception + Log(ex, "检查 Java 类别时出错", LogLevel.Feedback) + Setup.Set("LaunchArgumentJavaSelect", "") + Setup.Set("VersionArgumentJavaSelect", "", Version:=RelatedVersion) + Return True + End Try + End Function + ''' + ''' 用于 Java 排序的函数。 + ''' + Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean + '1. 尽量在当前文件夹或当前 Minecraft 文件夹 + Dim ProgramPathParent As String, MinecraftPathParent As String = "" + ProgramPathParent = If(New DirectoryInfo(Path).Parent, New DirectoryInfo(Path)).FullName + If PathMcFolder <> "" Then MinecraftPathParent = If(New DirectoryInfo(PathMcFolder).Parent, New DirectoryInfo(PathMcFolder)).FullName + If Left.PathFolder.StartsWith(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWith(ProgramPathParent) Then Return True + If Not Left.PathFolder.StartsWith(ProgramPathParent) AndAlso Right.PathFolder.StartsWith(ProgramPathParent) Then Return False + If PathMcFolder <> "" Then + If Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWith(MinecraftPathParent) Then Return True + If Not Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Right.PathFolder.StartsWith(MinecraftPathParent) Then Return False + End If + '2. 尽量使用 64 位 + If Left.Is64Bit AndAlso Not Right.Is64Bit Then Return True + If Not Left.Is64Bit AndAlso Right.Is64Bit Then Return False + '3. 尽量不使用 JDK + If Left.IsJre AndAlso Not Right.IsJre Then Return True + If Not Left.IsJre AndAlso Right.IsJre Then Return False + '4. Java 大版本 + If Left.VersionCode <> Right.VersionCode Then + ' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 + Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 29, 10, 11, 12, 13, 9, 8, 7, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28} + Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode) + End If + '5. 最次级版本号更接近 51 + Return Math.Abs(Left.Version.Revision - 51) <= Math.Abs(Right.Version.Revision - 51) + End Function + + '缺失 + ''' + ''' 提示 Java 缺失并跳转下载。支持 Java 7、8、16。 + ''' + Public Sub JavaMissing(VersionCode As Integer) + Select Case VersionCode + Case 7 + MyMsgBox("PCL2 未找到 Java 7。" & vbCrLf & + "请自行百度安装 Java 7，安装后在 PCL2 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入，确保安装的 Java 已列入 Java 列表。", + "未找到 Java") + Case 8 + If Is32BitSystem Then + OpenWebsite("https://wwa.lanzoui.com/i7RyXq0jbub") + Else + OpenWebsite("https://wwa.lanzoui.com/i2UyMq0jaqb") + End If + MyMsgBox("PCL2 未找到版本适宜的 Java 8。" & vbCrLf & + "请在打开的网页中下载安装包并安装，安装后在 PCL2 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入，确保安装的 Java 已列入 Java 列表。", + "未找到 Java") + Case 16, 17 + If Is32BitSystem Then + MyMsgBox("该版本的 MC 已不支持 32 位操作系统。你必须增加内存并重装为 64 位系统才能继续。", "系统兼容性提示") + Else + OpenWebsite("https://www.oracle.com/java/technologies/downloads/#jdk17-windows") + MyMsgBox("PCL2 未找到 Java " & VersionCode & "。" & vbCrLf & + "请在打开的网页中选择 x64 Installer，下载并安装。" & vbCrLf & + "安装后在 PCL2 的 设置 → 启动设置 → 游戏 Java 中通过搜索或导入，确保安装的 Java 已列入 Java 列表。", + "未找到 Java") + End If + End Select + End Sub + +#End Region + +#Region "文件夹" + + ''' + ''' 当前的 Minecraft 文件夹路径，以“\”结尾。 + ''' + Public PathMcFolder As String + ''' + ''' 当前的 Minecraft 文件夹列表。 + ''' + Public McFolderList As New List(Of McFolder) + + Public Class McFolder '必须是 Class，否则不是引用类型，在 ForEach 中不会得到刷新 + Public Name As String + Public Path As String + Public Type As McFolderType + Public VersionCount As Integer + Public Overrides Function Equals(obj As Object) As Boolean + If Not (TypeOf obj Is McFolder) Then + Return False + End If + + Dim folder = DirectCast(obj, McFolder) + Return Name = folder.Name AndAlso + Path = folder.Path AndAlso + Type = folder.Type AndAlso + VersionCount = folder.VersionCount + End Function + Public Overrides Function ToString() As String + Return Path + End Function + End Class + Public Enum McFolderType + Original + RenamedOriginal + Custom + End Enum + + ''' + ''' 加载 Minecraft 文件夹列表。 + ''' + Public McFolderListLoader As New LoaderTask(Of Integer, Integer)("Minecraft Folder List", AddressOf McFolderListLoadSub, Priority:=ThreadPriority.AboveNormal) + Private Sub McFolderListLoadSub() + Try + '初始化 + Dim CacheMcFolderList = New List(Of McFolder) + +#Region "读取默认（Original）文件夹，即当前、官启文件夹，可能没有结果" + + '扫描当前文件夹 + If CheckPermission(Path) AndAlso Directory.Exists(Path & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Path, .Type = McFolderType.Original}) + For Each Folder As DirectoryInfo In New DirectoryInfo(Path).GetDirectories + If CheckPermission(Folder.FullName) AndAlso Directory.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Folder.FullName & "\", .Type = McFolderType.Original}) + Next + + '扫描官启文件夹 + Dim MojangPath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\" + If (CacheMcFolderList.Count = 0 OrElse MojangPath <> CacheMcFolderList(0).Path) AndAlso '当前文件夹不是官启文件夹 + CheckPermission(MojangPath) AndAlso Directory.Exists(MojangPath & "versions\") Then '具有权限且存在 versions 文件夹 + CacheMcFolderList.Add(New McFolder With {.Name = "官方启动器文件夹", .Path = MojangPath, .Type = McFolderType.Original}) + End If + +#End Region + +#Region "读取自定义（Custom）文件夹，可能没有结果" + + '格式：TMZ 12>C://xxx/xx/|Test>D://xxx/xx/|名称>路径 + For Each Folder As String In Setup.Get("LaunchFolders").Split("|") + If Folder = "" Then Continue For + If Not Folder.Contains(">") OrElse Not Folder.EndsWith("\") Then + Hint("无效的 Minecraft 文件夹：" & Folder, HintType.Critical) + Continue For + End If + Dim Name As String = Folder.Split(">")(0) + Dim Path As String = Folder.Split(">")(1) + If CheckPermission(Path) Then + '若已有该文件夹，则直接重命名；没有则添加 + Dim Renamed As Boolean = False + For Each OriginalFolder As McFolder In CacheMcFolderList + If OriginalFolder.Path = Path Then + OriginalFolder.Name = Name + OriginalFolder.Type = McFolderType.RenamedOriginal + Renamed = True + End If + Next + If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Path = Path, .Type = McFolderType.Custom}) + Else + Hint("无效的 Minecraft 文件夹：" & Path, HintType.Critical) + End If + Next + + '将自定义文件夹情况同步到设置 + Dim NewSetup As New List(Of String) + For Each Folder As McFolder In CacheMcFolderList + If Not Folder.Type = McFolderType.Original Then NewSetup.Add(Folder.Name & ">" & Folder.Path) + Next + If NewSetup.Count = 0 Then NewSetup.Add("") '防止 0 元素 Join 返回 Nothing + Setup.Set("LaunchFolders", Join(NewSetup, "|")) + +#End Region + + '若没有可用文件夹，则创建 .minecraft + If CacheMcFolderList.Count = 0 Then + Directory.CreateDirectory(Path & ".minecraft\versions\") + CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Path & ".minecraft\", .Type = McFolderType.Original}) + End If + + For Each Folder As McFolder In CacheMcFolderList +#Region "获取可用版本数" + If Directory.Exists(Folder.Path & "versions\") Then + Folder.VersionCount = New DirectoryInfo(Folder.Path & "versions\").GetDirectories.Count + '减去隐藏版本的个数 + For Each Dir As DirectoryInfo In New DirectoryInfo(Folder.Path & "versions\").GetDirectories + If ReadIni(Dir.FullName & "\PCL\Setup.ini", "Hide", "False") Then Folder.VersionCount -= 1 + Next + End If +#End Region +#Region "更新 launcher_profiles.json" + McFolderLauncherProfilesJsonCreate(Folder.Path) +#End Region + Next + If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 2000)) + + '回设 + McFolderList = CacheMcFolderList + + Catch ex As Exception + Log(ex, "加载 Minecraft 文件夹列表失败", LogLevel.Feedback) + End Try + End Sub + + ''' + ''' 为 Minecraft 文件夹创建 launcher_profiles.json 文件。 + ''' + Public Sub McFolderLauncherProfilesJsonCreate(Folder As String) + Try + If File.Exists(Folder & "launcher_profiles.json") Then Exit Sub + Dim ResultJson As String = +"{ + ""profiles"": { + ""PCL2"": { + ""icon"": ""Grass"", + ""name"": ""PCL2"", + ""lastVersionId"": ""latest-release"", + ""type"": ""latest-release"", + ""lastUsed"": """ & Date.Now.ToString("yyyy-MM-dd") & "T" & Date.Now.ToString("HH:mm:ss") & ".0000Z"" + } + }, + ""selectedProfile"": ""PCL2"", + ""clientToken"": ""23323323323323323323323323323333"" +}" + WriteFile(Folder & "launcher_profiles.json", ResultJson, Encoding:=Encoding.Default) + Log("[Minecraft] 已创建 launcher_profiles.json：" & Folder) + Catch ex As Exception + Log(ex, "创建 launcher_profiles.json 失败（" & Folder & "）", LogLevel.Feedback) + End Try + End Sub + +#End Region + +#Region "版本处理" + + Public Const McVersionCacheVersion As Integer = 24 + + Private _McVersionCurrent As McVersion + Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同，使得 UI 显示可以正常初始化 + ''' + ''' 当前的 Minecraft 版本。 + ''' + Public Property McVersionCurrent As McVersion + Get + Return _McVersionCurrent + End Get + Set(value As McVersion) + If ReferenceEquals(_McVersionLast, value) Then Exit Property + _McVersionCurrent = value '由于有可能是 Nothing，导致无法初始化，才得这样弄一圈 + _McVersionLast = value + If value Is Nothing Then Exit Property + '统一通行证重判 + If AniControlEnabled = 0 AndAlso + Setup.Get("VersionServerNide", Version:=value) <> Setup.Get("CacheNideServer") AndAlso + Setup.Get("VersionServerLogin", Version:=value) = 3 Then + Setup.Set("CacheNideAccess", "") + Log("[Launch] 服务器改变，要求重新登录统一通行证") + End If + If Setup.Get("VersionServerLogin", Version:=value) = 3 Then + Setup.Set("CacheNideServer", Setup.Get("VersionServerNide", Version:=value)) + End If + 'Authlib-Injector 重判 + If AniControlEnabled = 0 AndAlso + Setup.Get("VersionServerAuthServer", Version:=value) <> Setup.Get("CacheAuthServerServer") AndAlso + Setup.Get("VersionServerLogin", Version:=value) = 4 Then + Setup.Set("CacheNideServer", "") + Log("[Launch] 服务器改变，要求重新登录 Authlib-Injector") + End If + If Setup.Get("VersionServerLogin", Version:=value) = 4 Then + Setup.Set("CacheAuthServerServer", Setup.Get("VersionServerAuthServer", Version:=value)) + Setup.Set("CacheAuthServerName", Setup.Get("VersionServerAuthName", Version:=value)) + Setup.Set("CacheAuthServerRegister", Setup.Get("VersionServerAuthRegister", Version:=value)) + End If + End Set + End Property + + Public Class McVersion + + ''' + ''' 该版本的版本文件夹，以“\”结尾。 + ''' + Public ReadOnly Property Path As String + ''' + ''' 应用版本隔离后，该版本所对应的 Minecraft 根文件夹，以“\”结尾。 + ''' + Public ReadOnly Property PathIndie As String + Get + Return GetPathIndie(Version.Modable) + End Get + End Property + ''' + ''' 在不加载版本的情况下获取版本隔离目录。 + ''' + Public Function GetPathIndie(Modable As Boolean) As String + Dim IndieType As Integer = Setup.Get("LaunchArgumentIndie") + Select Case Setup.Get("VersionArgumentIndie", Version:=Me) + Case -1 + '尚未判断 + Dim ModFolder As New DirectoryInfo(Path & "mods\") + Dim SaveFolder As New DirectoryInfo(Path & "saves\") + If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count > 0) OrElse + (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Count > 0) Then + '自动开启 + Setup.Set("VersionArgumentIndie", 1, Version:=Me) + Log("[Setup] 已自动开启单版本隔离：" & Name) + IndieType = 4 + Else + '使用全局设置 + Setup.Set("VersionArgumentIndie", 0, Version:=Me) + Log("[Setup] 版本隔离使用全局设置：" & Name) + End If + Case 0 + '使用全局设置 + Case 1 + '开启 + IndieType = 4 + Case 2 + '关闭 + IndieType = 0 + End Select + Select Case IndieType + Case 0 '关闭 + Case 1 '仅隔离可安装 Mod 的版本 + If Modable Then Return Path + Case 2 '仅隔离非正式版 + If State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot Then Return Path + Case 3 '隔离非正式版与可安装 Mod 的版本 + If Modable Then Return Path + If State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot Then Return Path + Case 4 '隔离所有版本 + Return Path + End Select + Return PathMcFolder + End Function + + ''' + ''' 该版本的版本文件夹名称。 + ''' + Public ReadOnly Property Name As String + Get + If _Name Is Nothing AndAlso Not Path = "" Then _Name = GetFolderNameFromPath(Path) + Return _Name + End Get + End Property + Private _Name As String = Nothing + + ''' + ''' 显示的描述文本。 + ''' + Public Info As String = "该版本未被加载，请向作者反馈此问题" + ''' + ''' 该版本的列表检查原始结果，不受自定义影响。 + ''' + Public State As McVersionState = McVersionState.Error + ''' + ''' 显示的版本图标。 + ''' + Public Logo As String + ''' + ''' 是否为收藏的版本。 + ''' + Public IsStar As Boolean = False + ''' + ''' 强制版本分类，0 为未启用，1 为隐藏，2 及以上为其他普通分类。 + ''' + Public DisplayType As McVersionCardType = McVersionCardType.Auto + ''' + ''' 版本信息。 + ''' + Public Property Version As McVersionInfo + Get + If _Version Is Nothing Then + _Version = New McVersionInfo +#Region "获取游戏版本" + Try + + '获取发布时间并判断是否为老版本 + Try + If JsonObject("releaseTime") Is Nothing Then + ReleaseTime = New Date(1970, 1, 1, 15, 0, 0) '未知版本也可能显示为 1970 年 + Else + ReleaseTime = JsonObject("releaseTime").ToObject(Of Date) + End If + If ReleaseTime.Year > 2000 AndAlso ReleaseTime.Year < 2013 Then + _Version.McName = "Old" + GoTo VersionSearchFinish + End If + Catch + ReleaseTime = New Date(1970, 1, 1, 15, 0, 0) + End Try + '实验性快照 + If If(JsonObject("type"), "") = "pending" Then + _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") + GoTo VersionSearchFinish + End If + '从 HMCL 下载的版本信息中获取版本号 + If JsonObject("patches") IsNot Nothing Then + For Each Patch As JObject In JsonObject("patches") + If If(Patch("id"), "").ToString = "game" AndAlso Patch("version") IsNot Nothing Then + _Version.McName = Patch("version").ToString + GoTo VersionSearchFinish + End If + Next + End If + '从 Forge Arguments 中获取版本号 + If JsonObject("arguments") IsNot Nothing AndAlso JsonObject("arguments")("game") IsNot Nothing Then + Dim Mark As Boolean = False + For Each Argument In JsonObject("arguments")("game") + If Mark Then + _Version.McName = Argument.ToString + GoTo VersionSearchFinish + End If + If Argument.ToString = "--fml.mcVersion" Then Mark = True + Next + End If + '从继承版本中获取版本号 + If Not InheritVersion = "" Then + _Version.McName = If(JsonObject("jar"), "").ToString 'LiteLoader 优先使用 Jar + If _Version.McName = "" Then _Version.McName = InheritVersion + GoTo VersionSearchFinish + End If + '从下载地址中获取版本号 + Dim Regex As String = RegexSeek(If(JsonObject("downloads"), "").ToString, "(?<=launcher.mojang.com/mc/game/)[^/]*") + If Regex IsNot Nothing Then + _Version.McName = Regex + GoTo VersionSearchFinish + End If + '从 Forge 版本中获取版本号 + Dim LibrariesString As String = JsonObject("libraries").ToString + Regex = If(RegexSeek(LibrariesString, "(?<=net.minecraftforge:forge:)1.[0-9+.]+"), RegexSeek(LibrariesString, "(?<=net.minecraftforge:fmlloader:)1.[0-9+.]+")) + If Regex IsNot Nothing Then + _Version.McName = Regex + GoTo VersionSearchFinish + End If + '从 OptiFine 版本中获取版本号 + Regex = RegexSeek(LibrariesString, "(?<=optifine:OptiFine:)1.[0-9+.]+") + If Regex IsNot Nothing Then + _Version.McName = Regex + GoTo VersionSearchFinish + End If + '从 Fabric 版本中获取版本号 + Regex = RegexSeek(LibrariesString, "(?<=((fabricmc)|(quiltmc)):intermediary:)[^""]*") + If Regex IsNot Nothing Then + _Version.McName = Regex + GoTo VersionSearchFinish + End If + 'TODO: [Quilt 支持] 从 Quilt 版本中获取版本号 + '从 jar 项中获取版本号 + If JsonObject("jar") IsNot Nothing Then + _Version.McName = JsonObject("jar").ToString + GoTo VersionSearchFinish + End If + '非准确的版本判断警告 + Log("[Minecraft] 无法完全确认 MC 版本号的版本：" & Name) + '从文件夹名中获取 + Regex = RegexSeek(Name, "([0-9w]{5}[a-z]{1})|(1\.[0-9]+(\.[0-9]+)?(-(pre|rc)[1-9]?| Pre-Release( [1-9]{1})?)?)") + If Regex IsNot Nothing Then + _Version.McName = Regex + GoTo VersionSearchFinish + End If + '从 Json 出现的版本号中获取 + Dim JsonRaw As JObject = JsonObject.DeepClone() + JsonRaw.Remove("libraries") + Dim JsonRawText As String = JsonRaw.ToString + Regex = RegexSeek(JsonRawText, "([0-9w]{5}[a-z]{1})|(1\.[0-9]+(\.[0-9]+)?(-(pre|rc)[1-9]?| Pre-Release( [1-9]{1})?)?)") + If Regex IsNot Nothing Then + _Version.McName = Regex + GoTo VersionSearchFinish + End If + '无法获取 + _Version.McName = "Unknown" + Info = "PCL 无法识别该版本，请向作者反馈此问题" + Catch ex As Exception + Log(ex, "识别 Minecraft 版本时出错") + _Version.McName = "Unknown" + Info = "无法识别：" & ex.Message + End Try +VersionSearchFinish: + '获取版本号 + If _Version.McName.StartsWith("1.") Then + Dim SplitVersion = _Version.McName.Split(" "c, "_"c, "-"c, "."c) + Dim SplitResult As String + '分割获取信息 + SplitResult = If(SplitVersion.Count >= 2, SplitVersion(1), "0") + _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 + _Version.McCodeMain = 99 + _Version.McCodeSub = 99 + End If +#End Region + End If + Return _Version + End Get + Set(value As McVersionInfo) + _Version = value + End Set + End Property + Private _Version As McVersionInfo = Nothing + + ''' + ''' 版本的发布时间。 + ''' + Public ReleaseTime As New Date(1970, 1, 1, 15, 0, 0) + + ''' + ''' 该版本的 Json 文本。 + ''' + Public Property JsonText As String + Get + If _JsonText Is Nothing Then + If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 Json 文件") + _JsonText = ReadFile(Path & Name & ".json") + '如果 ReadFile 失败会返回空字符串；这可能是由于文件被临时占用，故延时后重试 + If _JsonText.Length = 0 Then + If RunInUi() Then + Log("[Minecraft] 版本 Json 文件为空或读取失败，由于代码在主线程运行，将不再进行重试", LogLevel.Debug) + Throw New Exception("版本 Json 文件为空或读取失败") + Else + Log("[Minecraft] 版本 Json 文件为空或读取失败，将在 2s 后重试读取（" & Path & Name & ".json）", LogLevel.Debug) + Thread.Sleep(2000) + _JsonText = ReadFile(Path & Name & ".json") + If _JsonText.Length = 0 Then Throw New Exception("版本 Json 文件为空或读取失败") + End If + End If + If _JsonText.Length < 100 Then Throw New Exception("版本 Json 文件有误，内容为：" & _JsonText) + End If + Return _JsonText + End Get + Set(ByVal value As String) + _JsonText = value + End Set + End Property + Private _JsonText As String = Nothing + ''' + ''' 该版本的 Json 对象。 + ''' 若 Json 存在问题，在获取该属性时即会抛出异常。 + ''' + Public Property JsonObject As JObject + Get + If _JsonObject Is Nothing Then + Dim Text As String = JsonText '触发 JsonText 的 Get 事件 + Try + _JsonObject = GetJson(Text) + '转换 HMCL 关键项 + If _JsonObject.ContainsKey("patches") AndAlso Not _JsonObject.ContainsKey("time") Then + IsHmclFormatJson = True + '合并 Json + 'Dim HasOptiFine As Boolean = False, HasForge As Boolean = False + Dim CurrentObject As JObject = Nothing + Dim SubjsonList As New List(Of JObject) + For Each Subjson As JObject In _JsonObject("patches") + SubjsonList.Add(Subjson) + Next + SubjsonList = Sort(SubjsonList, Function(Left As JObject, Right As JObject) As Boolean + Return Val(If(Left("priority"), "0").ToString) < Val(If(Right("priority"), "0").ToString) + End Function) + For Each Subjson As JObject In SubjsonList + Dim Id As String = Subjson("id") + If Id IsNot Nothing Then + '合并 Json + Log("[Minecraft] 合并 HMCL 分支项：" & Id) + If CurrentObject IsNot Nothing Then + CurrentObject.Merge(Subjson) + Else + CurrentObject = Subjson + End If + Else + Log("[Minecraft] 存在为空的 HMCL 分支项") + End If + Next + _JsonObject = CurrentObject + '修改附加项 + _JsonObject("id") = Name + If _JsonObject.ContainsKey("inheritsFrom") Then _JsonObject.Remove("inheritsFrom") + End If + '与继承版本合并 + Dim InheritVersion = Nothing + Try + InheritVersion = If(_JsonObject("inheritsFrom") Is Nothing, "", _JsonObject("inheritsFrom").ToString) + If InheritVersion = Name Then + Log("[Minecraft] 自引用的继承版本：" & Name, LogLevel.Debug) + InheritVersion = "" + Exit Try + End If +Recheck: + If InheritVersion <> "" Then + Dim Inherit As New McVersion(InheritVersion) + '继续循环 + If Inherit.InheritVersion = InheritVersion Then Throw New Exception("版本依赖项出现嵌套：" & InheritVersion) + InheritVersion = Inherit.InheritVersion + '合并 + Inherit.JsonObject.Merge(_JsonObject) + _JsonObject = Inherit.JsonObject + GoTo Recheck + End If + Catch ex As Exception + Log(ex, "合并版本依赖项 Json 失败（" & If(InheritVersion, "null").ToString & "）") + End Try + 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).ToLower + If FileName.EndsWith(".jar") AndAlso FileName.Contains("jumploader") 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 + Set(ByVal value As JObject) + _JsonObject = value + End Set + End Property + Private _JsonObject As JObject = Nothing + ''' + ''' 是否为旧版 Json 格式。 + ''' + Public ReadOnly Property IsOldJson As Boolean + Get + Return JsonObject("minecraftArguments") IsNot Nothing + End Get + End Property + ''' + ''' Json 是否为 HMCL 格式。 + ''' + Public Property IsHmclFormatJson As Boolean = False + ''' + ''' 是否包含 JumpLoader。 + ''' + Public Property HasJumpLoader As Boolean = False + + ''' + ''' 该版本的依赖版本。若无依赖版本则为空字符串。 + ''' + Public ReadOnly Property InheritVersion As String + Get + If _InheritVersion Is Nothing Then + _InheritVersion = If(JsonObject("inheritsFrom"), "").ToString + '由于过老的 LiteLoader 中没有 Inherits（例如 1.5.2），需要手动判断以获取真实继承版本 + '此外，由于这里的加载早于版本种类判断，所以需要手动判断是否为 LiteLoader + '如果版本提供了不同的 Jar，代表所需的 Jar 可能已被更改，则跳过 Inherit 替换 + If JsonText.Contains("liteloader") AndAlso Version.McName <> Name AndAlso Not JsonText.Contains("logging") Then + If If(JsonObject("jar"), Version.McName).ToString = Version.McName Then _InheritVersion = Version.McName + End If + 'HMCL 版本无 Json + If IsHmclFormatJson Then _InheritVersion = "" + End If + Return _InheritVersion + End Get + End Property + Private _InheritVersion As String = Nothing + + ''' + ''' 版本名，或版本文件夹的完整路径（不规定是否以 \ 结尾）。 + Public Sub New(Path As String) + Me.Path = If(Path.Contains(":"), "", PathMcFolder & "versions\") & '补全完整路径 + Path & + If(Path.EndsWith("\"), "", "\") '补全右划线 + End Sub + + ''' + ''' 检查 Minecraft 版本，若检查通过 State 则为 Original 且返回 True。 + ''' + Public Function Check() As Boolean + + '检查文件夹 + If Not Directory.Exists(Path) Then + State = McVersionState.Error + Info = "该文件夹不存在" + Return False + End If + '检查权限 + Try + Directory.CreateDirectory(Path & "PCL\") + CheckPermissionWithException(Path & "PCL\") + Catch ex As Exception + State = McVersionState.Error + Info = "PCL2 没有对该文件夹的访问权限，请右键以管理员身份运行 PCL2" + Log(ex, "没有访问版本文件夹的权限") + Return False + End Try + '确认 Json 可用性 + Try + Dim JsonObjCheck = JsonObject + Catch ex As Exception + Log(ex, "版本 Json 可用性检查失败（" & Name & "）") + JsonText = "" + JsonObject = Nothing + Info = ex.Message + State = McVersionState.Error + Return False + End Try + '检查依赖版本 + Try + If Not InheritVersion = "" Then + If Not File.Exists(GetPathFromFullPath(Path) & InheritVersion & "\" & InheritVersion & ".json") Then + State = McVersionState.Error + Info = "需要安装 " & InheritVersion & " 作为前置版本" + Return False + End If + End If + Catch ex As Exception + Log(ex, "依赖版本检查出错（" & Name & "）") + State = McVersionState.Error + Info = "未知错误：" & GetString(ex) + Return False + End Try + + State = McVersionState.Original + Return True + End Function + ''' + ''' 加载 Minecraft 版本的详细信息。不使用其缓存，且会更新缓存。 + ''' + Public Function Load() As McVersion + Try + Directory.CreateDirectory(Path & "PCL") + '检查版本，若出错则跳过数据确定阶段 + If Not Check() Then GoTo ExitDataLoad +#Region "确定版本分类" + Select Case Version.McName '在获取 Version.Original 对象时会完成它的加载 + Case "Unknown" + State = McVersionState.Error + Case "Old" + State = McVersionState.Old + Case Else '根据 API 进行筛选 + Dim RealJson As String = If(JsonObject, JsonText).ToString + '愚人节与快照版本 + If If(JsonObject("type"), "").ToString = "fool" OrElse GetMcFoolName(Name) <> "" Then + State = McVersionState.Fool + ElseIf Version.McName.ToLower.Contains("w") OrElse Name.ToLower.Contains("combat") OrElse Version.McName.ToLower.Contains("rc") OrElse Version.McName.ToLower.Contains("pre") OrElse Version.McName.Contains("experimental") OrElse If(JsonObject("type"), "").ToString = "snapshot" OrElse If(JsonObject("type"), "").ToString = "pending" Then + State = McVersionState.Snapshot + End If + 'OptiFine + If RealJson.Contains("optifine") Then + State = McVersionState.OptiFine + Version.OptiFineVersion = If(RegexSeek(RealJson, "(?<=HD_U_)[^"":/]+"), "未知版本") + Version.HasOptiFine = True + End If + 'LiteLoader + If RealJson.Contains("liteloader") Then + State = McVersionState.LiteLoader + Version.HasLiteLoader = True + End If + 'Fabric、Forge + 'TODO: [Quilt 支持] 确认这里的玩意儿对不对 + If RealJson.Contains("net.fabricmc:fabric-loader") OrElse RealJson.Contains("org.quiltmc:quilt-loader") Then + State = McVersionState.Fabric + Version.FabricVersion = If(RegexSeek(RealJson, "(?<=(net.fabricmc:fabric-loader:)|(org.quiltmc:quilt-loader:))[0-9\.]+(\+build.[0-9]+)?"), "未知版本").Replace("+build", "") + Version.HasFabric = True + ElseIf RealJson.Contains("minecraftforge") Then + State = McVersionState.Forge + Version.ForgeVersion = RegexSeek(RealJson, "(?<=forge:[0-9\.]+(_pre[0-9]*)?\-)[0-9\.]+") + If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = RegexSeek(RealJson, "(?<=net\.minecraftforge:minecraftforge:)[0-9\.]+") + If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = If(RegexSeek(RealJson, "(?<=net\.minecraftforge:fmlloader:[0-9\.]+-)[0-9\.]+"), "未知版本") + Version.HasForge = True + End If + Version.IsApiLoaded = True + End Select +#End Region +ExitDataLoad: + '确定版本图标 + Logo = ReadIni(Path & "PCL\Setup.ini", "Logo", "") + If Logo = "" OrElse ReadIni(Path & "PCL\Setup.ini", "LogoCustom", "False") = "False" Then + Select Case State + Case McVersionState.Original + Logo = "pack://application:,,,/images/Blocks/Grass.png" + Case McVersionState.Snapshot + Logo = "pack://application:,,,/images/Blocks/CommandBlock.png" + Case McVersionState.Old + Logo = "pack://application:,,,/images/Blocks/CobbleStone.png" + Case McVersionState.Forge + Logo = "pack://application:,,,/images/Blocks/Anvil.png" + Case McVersionState.Fabric + Logo = "pack://application:,,,/images/Blocks/Fabric.png" + Case McVersionState.OptiFine + Logo = "pack://application:,,,/images/Blocks/GrassPath.png" + Case McVersionState.LiteLoader + Logo = "pack://application:,,,/images/Blocks/Egg.png" + Case McVersionState.Fool + Logo = "pack://application:,,,/images/Blocks/GoldBlock.png" + Case Else + Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png" + End Select + End If + '确定版本描述 + Dim CustomInfo As String = ReadIni(Path & "PCL\Setup.ini", "CustomInfo") + If CustomInfo = "" Then + Select Case State + Case McVersionState.Snapshot + If Version.McName.ToLower.Contains("pre") OrElse Version.McName.ToLower.Contains("rc") Then + Info = "预发布版 " & Version.McName + ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then + Info = "实验性快照" + Else + Info = "快照 " & Version.McName + End If + Case McVersionState.Old + Info = "远古版本" + Case McVersionState.Original, McVersionState.Forge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader + Info = Version.ToString + Case McVersionState.Fool + Info = GetMcFoolName(Name) + Case McVersionState.Error + '已有错误信息 + Case Else + 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 + Else + Info = CustomInfo + End If + '确定版本收藏状态 + IsStar = ReadIni(Path & "PCL\Setup.ini", "IsStar", False) + '确定版本显示种类 + DisplayType = ReadIni(Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto) + '写入缓存 + WriteIni(Path & "PCL\Setup.ini", "State", State) + WriteIni(Path & "PCL\Setup.ini", "Info", Info) + WriteIni(Path & "PCL\Setup.ini", "Logo", Logo) + If State <> McVersionState.Error Then + WriteIni(Path & "PCL\Setup.ini", "ReleaseTime", ReleaseTime.ToString("yyyy-MM-dd HH:mm:ss")) + WriteIni(Path & "PCL\Setup.ini", "VersionFabric", Version.FabricVersion) + WriteIni(Path & "PCL\Setup.ini", "VersionOptiFine", Version.OptiFineVersion) + WriteIni(Path & "PCL\Setup.ini", "VersionLiteLoader", Version.HasLiteLoader) + WriteIni(Path & "PCL\Setup.ini", "VersionForge", Version.ForgeVersion) + WriteIni(Path & "PCL\Setup.ini", "VersionApiCode", Version.SortCode) + WriteIni(Path & "PCL\Setup.ini", "VersionOriginal", Version.McName) + WriteIni(Path & "PCL\Setup.ini", "VersionOriginalMain", Version.McCodeMain) + WriteIni(Path & "PCL\Setup.ini", "VersionOriginalSub", Version.McCodeSub) + End If + Catch ex As Exception + Info = "未知错误：" & GetString(ex) + Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png" + State = McVersionState.Error + Log(ex, "加载版本失败（" & Name & "）", LogLevel.Feedback) + Finally + IsLoaded = True + End Try + Return Me + End Function + Public IsLoaded As Boolean = False + + Public Overrides Function Equals(obj As Object) As Boolean + Dim version = TryCast(obj, McVersion) + Return version IsNot Nothing AndAlso Path = version.Path + End Function + + End Class + Public Enum McVersionState + [Error] + Original + Snapshot + Fool + OptiFine + Old + Forge + LiteLoader + Fabric + End Enum + + ''' + ''' 某个 Minecraft 实例的版本名、附加组件信息。 + ''' + Public Class McVersionInfo + + ''' + ''' 版本的 API 信息是否已加载。 + ''' + Public IsApiLoaded As Boolean = False + + '原版 + + ''' + ''' 原版版本名。如 1.12.2，16w01a。 + ''' + Public McName As String + ''' + ''' 原版主版本号，如 12（For 1.12.2），快照则固定为 99。不可用则为 -1。 + ''' + Public McCodeMain As Integer = -1 + ''' + ''' 原版次版本号，如 2（For 1.12.2），快照则固定为 99。不可用则为 -1。 + ''' + Public McCodeSub As Integer = -1 + + 'OptiFine + + ''' + ''' 该版本是否通过 Json 安装了 OptiFine。 + ''' + Public HasOptiFine As Boolean = False + ''' + ''' OptiFine 版本号，如 C8、C9_pre10。 + ''' + Public OptiFineVersion As String = "" + + 'Forge + + ''' + ''' 该版本是否安装了 Forge。 + ''' + Public HasForge As Boolean = False + ''' + ''' Forge 版本号，如 31.1.2、14.23.5.2847。 + ''' + Public ForgeVersion As String = "" + + 'Fabric + + ''' + ''' 该版本是否安装了 Fabric。 + ''' + Public HasFabric As Boolean = False + ''' + ''' Fabric 版本号，如 0.7.2.175。 + ''' + Public FabricVersion As String = "" + + 'LiteLoader + + ''' + ''' 该版本是否安装了 LiteLoader。 + ''' + Public HasLiteLoader As Boolean = False + + 'API + + ''' + ''' 该版本是否可以安装 Mod。 + ''' + Public ReadOnly Property Modable As Boolean + Get + Return HasFabric OrElse HasForge OrElse HasLiteLoader + End Get + End Property + + ''' + ''' 生成对此版本信息的用户友好的描述性字符串。 + ''' + Public Overrides Function ToString() As String + ToString = "" + If HasForge Then ToString += ", Forge" & If(ForgeVersion = "未知版本", "", " " & ForgeVersion) + If HasFabric Then ToString += ", Fabric" & If(FabricVersion = "未知版本", "", " " & FabricVersion) + If HasOptiFine Then ToString += ", OptiFine" & If(OptiFineVersion = "未知版本", "", " " & OptiFineVersion) + If HasLiteLoader Then ToString += ", LiteLoader" + If ToString = "" Then + Return "原版 " & McName + Else + Return McName & ToString & If(ModeDebug, " (" & SortCode & "#)", "") + End If + End Function + + ''' + ''' 用于排序比较的编号。 + ''' + Public Property SortCode As Integer + Get + If _SortCode = -2 Then + '初始化 + Try + If HasFabric Then + If FabricVersion = "未知版本" Then Return 0 + Dim SubVersions = FabricVersion.Split(".") + If SubVersions.Length >= 3 Then + _SortCode = Val(SubVersions(0)) * 10000 + Val(SubVersions(1)) * 100 + Val(SubVersions(2)) + Else + Throw New Exception("无效的 Fabric 版本：" & ForgeVersion) + End If + ElseIf HasForge Then + If ForgeVersion = "未知版本" Then Return 0 + Dim SubVersions = ForgeVersion.Split(".") + If SubVersions.Length = 4 Then + _SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(3)) + ElseIf SubVersions.Length = 3 Then + _SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(2)) + Else + Throw New Exception("无效的 Forge 版本：" & ForgeVersion) + End If + ElseIf HasOptiFine Then + If OptiFineVersion = "未知版本" Then Return 0 + '由对应原版次级版本号（2 位）、字母（2 位）、末尾数字（2 位）、测试标记（2 位，正式版为 99，Pre[x] 为 50+x，Beta[x] 为 x）组成 + _SortCode = + If(McCodeSub >= 0, McCodeSub, 0) * 1000000 + '第一段：原版次级版本号（2 位） + (Asc(CType(Left(OptiFineVersion.ToUpper, 1), Char)) - Asc("A"c) + 1) * 10000 + '第二段：字母编号（2 位），如 G2 中的 G（7） + Val(RegexSeek(Right(OptiFineVersion, OptiFineVersion.Length - 1), "[0-9]+")) * 100 '第三段：末尾数字（2 位），如 C5 beta4 中的 5 + '第三段：测试标记 + If OptiFineVersion.ToLower.Contains("pre") Then _SortCode += 50 + If OptiFineVersion.ToLower.Contains("pre") OrElse OptiFineVersion.ToLower.Contains("beta") Then + If Val(Right(OptiFineVersion, 1)) = 0 AndAlso Right(OptiFineVersion, 1) <> "0" Then + _SortCode += 1 '为 pre 或 beta 结尾，视作 1 + Else + _SortCode += Val(RegexSeek(OptiFineVersion.ToLower, "(?<=((pre)|(beta)))[0-9]+")) + End If + Else + _SortCode += 99 + End If + Else + _SortCode = -1 + End If + Catch ex As Exception + _SortCode = -1 + Log(ex, "获取 API 版本信息失败：" & ToString()) + End Try + End If + Return _SortCode + End Get + Set(ByVal value As Integer) + _SortCode = value + End Set + End Property + Private _SortCode As Integer = -2 + + End Class + + ''' + ''' 根据版本名获取对应的愚人节版本描述。非愚人节版本会返回空字符串。 + ''' + Public Function GetMcFoolName(Name As String) As String + Name = Name.ToLower + If Name.StartsWith("2.0") Then + Return "这个秘密计划了两年的更新将游戏推向了一个新高度！" + ElseIf Name.StartsWith("20w14inf") OrElse Name = "20w14∞" Then + Return "我们加入了 20 亿个新的世界，让无限的想象变成了现实！" + ElseIf Name = "15w14a" Then + Return "作为一款全年龄向的游戏，我们需要和平，需要爱与拥抱。" + ElseIf Name = "1.rv-pre1" Then + Return "是时候将现代科技带入 Minecraft 了！" + ElseIf Name = "3d shareware v1.34" Then + Return "我们从地下室的废墟里找到了这个开发于 1994 年的杰作！" + ElseIf Name = "22w13oneblockatatime" Then + Return "一次一个方块更新！迎接全新的挖掘、合成与骑乘玩法吧！" + Else + Return "" + End If + End Function + + ''' + ''' 当前按卡片分类的所有版本列表。 + ''' + Public McVersionList As New Dictionary(Of McVersionCardType, List(Of McVersion)) + +#End Region + +#Region "版本列表加载" + + ''' + ''' 是否要求本次加载强制刷新版本列表。 + ''' + Public McVersionListForceRefresh As Boolean = False + ''' + ''' 加载 Minecraft 文件夹的版本列表。 + ''' + Public McVersionListLoader As New LoaderTask(Of String, Integer)("Minecraft Version List", AddressOf McVersionListLoad) With {.ReloadTimeout = 1} + + ''' + ''' 开始加载当前 Minecraft 文件夹的版本列表。 + ''' + Private Sub McVersionListLoad(Loader As LoaderTask(Of String, Integer)) + '开始加载 + Dim Path As String = Loader.Input + Try + '初始化 + McVersionList.Clear() + + '检测缓存是否需要更新 + Dim FolderList As New List(Of String) + If Directory.Exists(Path & "versions") Then '不要使用 CheckPermission，会导致写入时间改变，从而使得文件夹被强制刷新 + Try + For Each Folder As DirectoryInfo In New DirectoryInfo(Path & "versions").GetDirectories + FolderList.Add(Folder.Name) + Next + Catch ex As Exception + Throw New Exception("无法读取版本文件夹，可能是由于没有权限（" & Path & "versions）", ex) + End Try + End If + '没有可用版本 + If FolderList.Count = 0 Then + WriteIni(Path & "PCL.ini", "VersionCache", "") '清空缓存 + GoTo OnLoaded + End If + '有可用版本 + Dim FolderListCheck As Integer = GetHash(McVersionCacheVersion & "#" & Join(FolderList.ToArray, "#")) Mod (Integer.MaxValue - 1) '根据文件夹名列表生成辨识码 + If Not McVersionListForceRefresh AndAlso Val(ReadIni(Path & "PCL.ini", "VersionCache")) = FolderListCheck Then + '可以使用缓存 + Dim Result = McVersionListLoadCache(Path) + If Result Is Nothing Then + GoTo Reload + Else + McVersionList = Result + End If + Else + '文件夹列表不符 +Reload: + McVersionListForceRefresh = False + Log("[Minecraft] 文件夹列表变更，重载所有版本") + WriteIni(Path & "PCL.ini", "VersionCache", FolderListCheck) + McVersionList = McVersionListLoadNoCache(Path) + End If + If Loader.IsAborted Then Exit Sub + + '改变当前选择的版本 +OnLoaded: + If McVersionList.Count = 0 Then + McVersionCurrent = Nothing + Setup.Set("LaunchVersionSelect", "") + Log("[Minecraft] 未找到可用 Minecraft 版本") + Else + '尝试读取已储存的选择 + Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version") + If Not SavedSelection = "" Then + For Each Card As KeyValuePair(Of McVersionCardType, List(Of McVersion)) In McVersionList + For Each Version As McVersion In Card.Value + If Version.Name = SavedSelection AndAlso Not Version.State = McVersionState.Error Then + '使用已储存的选择 + McVersionCurrent = Version + Setup.Set("LaunchVersionSelect", McVersionCurrent.Name) + Log("[Minecraft] 选择该文件夹储存的 Minecraft 版本：" & McVersionCurrent.Path) + Exit Sub + End If + Next + Next + End If + If Not McVersionList.First.Value(0).State = McVersionState.Error Then + '自动选择第一项 + McVersionCurrent = McVersionList.First.Value(0) + Setup.Set("LaunchVersionSelect", McVersionCurrent.Name) + Log("[Launch] 自动选择 Minecraft 版本：" & McVersionCurrent.Path) + End If + End If + If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000)) + Catch ex As ThreadInterruptedException + Catch ex As Exception + WriteIni(Path & "PCL.ini", "VersionCache", "") '要求下次重新加载 + Log(ex, "加载 .minecraft 版本列表失败", LogLevel.Feedback) + End Try + End Sub + + '获取版本列表 + Private Function McVersionListLoadCache(Path As String) As Dictionary(Of McVersionCardType, List(Of McVersion)) + Dim ResultVersionList As New Dictionary(Of McVersionCardType, List(Of McVersion)) + Try + Dim CardCount As Integer = ReadIni(Path & "PCL.ini", "CardCount", -1) + If CardCount = -1 Then Return Nothing + For i = 0 To CardCount - 1 + Dim CardType As McVersionCardType = ReadIni(Path & "PCL.ini", "CardKey" & (i + 1), ":") + Dim VersionList As New List(Of McVersion) + + '循环读取版本 + For Each Folder As String In ReadIni(Path & "PCL.ini", "CardValue" & (i + 1), ":").Split(":") + If Folder = "" Then Continue For + Try + + '读取单个版本 + Dim Version As New McVersion(Path & "versions\" & Folder & "\") + VersionList.Add(Version) + Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "CustomInfo", "") + If Version.Info = "" Then Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "Info", Version.Info) + Version.Logo = ReadIni(Version.Path & "PCL\Setup.ini", "Logo", Version.Logo) + Version.ReleaseTime = ReadIni(Version.Path & "PCL\Setup.ini", "ReleaseTime", Version.ReleaseTime) + Version.State = ReadIni(Version.Path & "PCL\Setup.ini", "State", Version.State) + Version.IsStar = ReadIni(Version.Path & "PCL\Setup.ini", "IsStar", False) + Version.DisplayType = ReadIni(Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto) + If Version.State <> McVersionState.Error Then + Dim VersionInfo As New McVersionInfo With { + .FabricVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionFabric", ""), + .ForgeVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionForge", ""), + .OptiFineVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOptiFine", ""), + .HasLiteLoader = ReadIni(Version.Path & "PCL\Setup.ini", "VersionLiteLoader", False), + .SortCode = ReadIni(Version.Path & "PCL\Setup.ini", "VersionApiCode", -1), + .McName = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOriginal", "Unknown"), + .McCodeMain = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOriginalMain", -1), + .McCodeSub = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOriginalSub", -1), + .IsApiLoaded = True + } + VersionInfo.HasFabric = VersionInfo.FabricVersion.Count > 1 + VersionInfo.HasForge = VersionInfo.ForgeVersion.Count > 1 + VersionInfo.HasOptiFine = VersionInfo.OptiFineVersion.Count > 1 + Version.Version = VersionInfo + End If + + '重新检查错误版本 + If Version.State = McVersionState.Error Then + '重新获取版本错误信息 + Dim OldDesc As String = Version.Info + Version.State = McVersionState.Original + Version.Check() + '校验错误原因是否改变 + Dim CustomInfo As String = ReadIni(Version.Path & "PCL\Setup.ini", "CustomInfo") + If Version.State = McVersionState.Original OrElse (CustomInfo = "" AndAlso Not OldDesc = Version.Info) Then + Log("[Minecraft] 版本 " & Version.Name & " 的错误状态已变更，新的状态为：" & Version.Info) + Return Nothing + End If + End If + + '校验未加载的版本 + If Version.Logo = "" Then + Log("[Minecraft] 版本 " & Version.Name & " 未被加载") + Return Nothing + End If + + Catch ex As Exception + Log(ex, "读取版本加载缓存失败（" & Folder & "）", LogLevel.Debug) + Return Nothing + End Try + Next + + ResultVersionList.Add(CardType, VersionList) + Next + Return ResultVersionList + Catch ex As Exception + Log(ex, "读取版本缓存失败") + Return Nothing + End Try + End Function + Private Function McVersionListLoadNoCache(Path As String) As Dictionary(Of McVersionCardType, List(Of McVersion)) + Dim VersionList As New List(Of McVersion) + Dim ResultVersionList As New Dictionary(Of McVersionCardType, List(Of McVersion)) +#Region "循环加载每个版本的信息" + Dim Dirs As DirectoryInfo() = New DirectoryInfo(Path & "versions").GetDirectories + For Each Folder As DirectoryInfo In Dirs + If (Folder.Name = "cache" OrElse Folder.Name = "BLClient" OrElse Folder.Name = "PCL") AndAlso Not File.Exists(Folder.FullName & "\" & Folder.Name & ".json") Then + Log("[Minecraft] 跳过可能不是版本文件夹的项目：" & Folder.FullName) + Continue For + End If + Dim Version As New McVersion(Folder.FullName & "\") + VersionList.Add(Version) + Version.Load() + Next +#End Region +#Region "将版本分类到各个卡片" + Try + + '未经过自定义的版本列表 + Dim VersionListOriginal As New Dictionary(Of McVersionCardType, List(Of McVersion)) + + '单独列出收藏的版本 + Dim StaredVersions As New List(Of McVersion) + For Each Version As McVersion In VersionList + If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then StaredVersions.Add(Version) + Next + If StaredVersions.Count > 0 Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions) + + '预先筛选出愚人节的版本 + McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Error}, McVersionCardType.Error) + McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Fool}, McVersionCardType.Fool) + + '筛选 API 版本 + McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Forge, McVersionState.LiteLoader, McVersionState.Fabric}, McVersionCardType.API) + + '将老版本预先分类入不常用，只剩余原版、快照、OptiFine + Dim VersionUseful As New List(Of McVersion) + Dim VersionRubbish As New List(Of McVersion) + McVersionFilter(VersionList, {McVersionState.Old}, VersionRubbish) + + '确认最新版本，若为快照则加入常用列表 + Dim LargestVersion As McVersion = Nothing '最新的版本 + For Each Version As McVersion In VersionList + If Version.State = McVersionState.Original OrElse Version.State = McVersionState.Snapshot Then + If LargestVersion Is Nothing OrElse Version.ReleaseTime > LargestVersion.ReleaseTime Then LargestVersion = Version + End If + Next + If LargestVersion IsNot Nothing AndAlso LargestVersion.State = McVersionState.Snapshot Then + VersionUseful.Add(LargestVersion) + VersionList.Remove(LargestVersion) + End If + + '将剩余的快照全部拖进不常用列表 + McVersionFilter(VersionList, {McVersionState.Snapshot}, VersionRubbish) + + '获取每个大版本下最新的原版与 OptiFine + Dim NewerVersion As New Dictionary(Of String, McVersion) + Dim ExistVersion As New List(Of Integer) + For Each Version As McVersion In VersionList + If Version.Version.McCodeMain < 2 Then Continue For '未获取成功的版本 + If Not ExistVersion.Contains(Version.Version.McCodeMain) Then ExistVersion.Add(Version.Version.McCodeMain) + If NewerVersion.ContainsKey(Version.Version.McCodeMain & "-" & Version.State) Then + If Version.Version.HasOptiFine Then + 'OptiFine 根据排序识别号判断 + If Version.Version.SortCode > NewerVersion(Version.Version.McCodeMain & "-" & Version.State).Version.SortCode Then NewerVersion(Version.Version.McCodeMain & "-" & Version.State) = Version + Else + '原版根据发布时间判断 + If Version.ReleaseTime > NewerVersion(Version.Version.McCodeMain & "-" & Version.State).ReleaseTime Then NewerVersion(Version.Version.McCodeMain & "-" & Version.State) = Version + End If + Else + NewerVersion.Add(Version.Version.McCodeMain & "-" & Version.State, Version) + End If + Next + + '将每个大版本下的最常规版本加入 + For Each Code As Integer In ExistVersion + If NewerVersion.ContainsKey(Code & "-" & McVersionState.OptiFine) Then + Dim OptiFineVersion As McVersion = NewerVersion(Code & "-" & McVersionState.OptiFine) + If NewerVersion.ContainsKey(Code & "-" & McVersionState.Original) AndAlso Not NewerVersion(Code & "-" & McVersionState.Original).Version.McName = OptiFineVersion.InheritVersion Then + '同时存在 OptiFine 与原版，但 OptiFine 不是该版的依赖版本，则一定为两个不同版本，且原版较新 + VersionUseful.Add(NewerVersion(Code & "-" & McVersionState.Original)) + VersionList.Remove(NewerVersion(Code & "-" & McVersionState.Original)) + End If + VersionUseful.Add(OptiFineVersion) + VersionList.Remove(OptiFineVersion) + Else + VersionUseful.Add(NewerVersion(Code & "-" & McVersionState.Original)) + VersionList.Remove(NewerVersion(Code & "-" & McVersionState.Original)) + End If + Next + + '将剩余的东西添加进去 + VersionRubbish.AddRange(VersionList) + If VersionUseful.Count > 0 Then VersionListOriginal.Add(McVersionCardType.OriginalLike, VersionUseful) + If VersionRubbish.Count > 0 Then VersionListOriginal.Add(McVersionCardType.Rubbish, VersionRubbish) + + '按照自定义版本分类重新添加 + For Each VersionPair In VersionListOriginal + For Each Version As McVersion In VersionPair.Value + Dim RealType = If(Version.DisplayType = 0 OrElse VersionPair.Key = McVersionCardType.Star, VersionPair.Key, Version.DisplayType) + If Not ResultVersionList.ContainsKey(RealType) Then ResultVersionList.Add(RealType, New List(Of McVersion)) + ResultVersionList(RealType).Add(Version) + Next + Next + + Catch ex As Exception + ResultVersionList.Clear() + Log(ex, "分类版本列表失败", LogLevel.Feedback) + End Try +#End Region +#Region "对卡片与版本进行排序" + + '对卡片进行整体排序 + Dim SortedVersionList As New Dictionary(Of McVersionCardType, List(Of McVersion)) + For Each SortRule As String In {McVersionCardType.Star, McVersionCardType.API, McVersionCardType.OriginalLike, McVersionCardType.Rubbish, McVersionCardType.Fool, McVersionCardType.Error, McVersionCardType.Hidden} + If ResultVersionList.ContainsKey(SortRule) Then SortedVersionList.Add(SortRule, ResultVersionList(SortRule)) + Next + ResultVersionList = SortedVersionList + + '常规版本：快照放在最上面，此后按版本号从高到低排序 + If ResultVersionList.ContainsKey(McVersionCardType.OriginalLike) Then + Dim OldList As List(Of McVersion) = ResultVersionList(McVersionCardType.OriginalLike) + '提取快照 + Dim Snapshot As McVersion = Nothing + For Each Version As McVersion In OldList + If Version.State = McVersionState.Snapshot Then + Snapshot = Version + Exit For + End If + Next + If Not IsNothing(Snapshot) Then OldList.Remove(Snapshot) + '按版本号排序 + Dim NewList As List(Of McVersion) = Sort(OldList, Function(Left As McVersion, Right As McVersion) + Return Left.Version.McCodeMain > Right.Version.McCodeMain + End Function) + '回设 + If Not IsNothing(Snapshot) Then NewList.Insert(0, Snapshot) + ResultVersionList(McVersionCardType.OriginalLike) = NewList + End If + + '不常用版本：按发布时间新旧排序，如果不可用则按名称排序 + If ResultVersionList.ContainsKey(McVersionCardType.Rubbish) Then + ResultVersionList(McVersionCardType.Rubbish) = Sort(ResultVersionList(McVersionCardType.Rubbish), Function(Left As McVersion, Right As McVersion) + Dim LeftYear As Integer = Left.ReleaseTime.Year '+ If(Left.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0) + Dim RightYear As Integer = Right.ReleaseTime.Year '+ If(Right.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0) + If LeftYear > 2000 AndAlso RightYear > 2000 Then + If LeftYear <> RightYear Then + Return LeftYear > RightYear + Else + Return Left.ReleaseTime > Right.ReleaseTime + End If + ElseIf LeftYear > 2000 AndAlso RightYear < 2000 Then + Return True + ElseIf LeftYear < 2000 AndAlso RightYear > 2000 Then + Return False + Else + Return Left.Name > Right.Name + End If + End Function) + End If + + 'API 版本：优先按版本排序，此后【先放 Fabric，再放 Forge（按版本号从高到低排序），最后放 LiteLoader（按名称排序）】 + If ResultVersionList.ContainsKey(McVersionCardType.API) Then + ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API), Function(Left As McVersion, Right As McVersion) + Dim Basic = VersionSortInteger(Left.Version.McName, Right.Version.McName) + If Basic <> 0 Then + Return Basic > 0 + Else + If Left.Version.HasFabric Xor Right.Version.HasFabric Then + Return Left.Version.HasFabric + ElseIf Left.Version.HasForge Xor Right.Version.HasForge Then + Return Left.Version.HasForge + ElseIf Not Left.Version.SortCode <> Right.Version.SortCode Then + Return Left.Version.SortCode > Right.Version.SortCode + Else + Return Left.Name > Right.Name + End If + End If + End Function) + End If + +#End Region +#Region "保存卡片缓存" + WriteIni(Path & "PCL.ini", "CardCount", ResultVersionList.Count) + For i = 0 To ResultVersionList.Count - 1 + WriteIni(Path & "PCL.ini", "CardKey" & (i + 1), ResultVersionList.Keys(i)) + Dim Value As String = "" + For Each Version As McVersion In ResultVersionList.Values(i) + Value += Version.Name & ":" + Next + WriteIni(Path & "PCL.ini", "CardValue" & (i + 1), Value) + Next +#End Region + Return ResultVersionList + End Function + ''' + ''' 筛选特定种类的版本，并直接添加为卡片。 + ''' + ''' 用于筛选的列表。 + ''' 需要筛选出的版本类型。-2 代表隐藏的版本。 + ''' 卡片的名称。 + Private Sub McVersionFilter(ByRef VersionList As List(Of McVersion), ByRef Target As Dictionary(Of McVersionCardType, List(Of McVersion)), Formula As McVersionState(), CardType As McVersionCardType) + '将某种版本筛选出来 + Dim KeepList As New List(Of McVersion) + For Each Version As McVersion In VersionList + For Each Type As Integer In Formula + If Type = Version.State Then + KeepList.Add(Version) + GoTo NextVersion + End If + Next +NextVersion: + Next + '加入版本列表，并从剩余中删除 + If KeepList.Count > 0 Then + Target.Add(CardType, KeepList) + For Each Version As McVersion In KeepList + VersionList.Remove(Version) + Next + End If + End Sub + ''' + ''' 筛选特定种类的版本，并增加入一个已有列表中。 + ''' + ''' 用于筛选的列表。 + ''' 需要筛选出的版本类型。-2 代表隐藏的版本。 + ''' 传入需要增加入的列表。 + Private Sub McVersionFilter(ByRef VersionList As List(Of McVersion), Formula As McVersionState(), ByRef KeepList As List(Of McVersion)) + For Each Version As McVersion In VersionList + For Each Type As McVersionState In Formula + If Type <> Version.State Then Continue For + KeepList.Add(Version) : Exit For + Next +NextVersion: + Next + If KeepList.Count > 0 Then + For Each Version As McVersion In KeepList + VersionList.Remove(Version) + Next + End If + End Sub + Public Enum McVersionCardType + Star = -1 + Auto = 0 '仅用于强制版本分类的自动 + Hidden = 1 + API = 2 + OriginalLike = 3 + Rubbish = 4 + Fool = 5 + [Error] = 6 + End Enum + +#End Region + +#Region "皮肤" + + Public Structure McSkinInfo + Public IsSlim As Boolean + Public LocalFile As String + Public IsVaild As Boolean + End Structure + ''' + ''' 要求玩家选择一个皮肤文件，并进行相关校验。 + ''' + Public Function McSkinSelect(MustHaveTwoLayers As Boolean) As McSkinInfo + Dim FileName As String = SelectFile("皮肤文件(*.png)|*.png", "选择皮肤文件") + + '验证有效性 + If FileName = "" Then Return New McSkinInfo With {.IsVaild = False} + Try + Dim Image As New MyBitmap(FileName) + If MustHaveTwoLayers Then + If Image.Pic.Width = 64 AndAlso Image.Pic.Height = 32 Then + Hint("自定义离线皮肤只支持 64x64 像素的双层皮肤！", HintType.Critical) + Return New McSkinInfo With {.IsVaild = False} + End If + If Image.Pic.Width <> 64 OrElse Image.Pic.Height <> 64 Then + Hint("自定义离线皮肤图片大小应为 64x64 像素！", HintType.Critical) + Return New McSkinInfo With {.IsVaild = False} + End If + Else + If Image.Pic.Width <> 64 OrElse Not (Image.Pic.Height = 32 OrElse Image.Pic.Height = 64) Then + Hint("皮肤图片大小应为 64x32 像素或 64x64 像素！", HintType.Critical) + Return New McSkinInfo With {.IsVaild = False} + End If + End If + Dim FileInfo As New FileInfo(FileName) + If FileInfo.Length > 24 * 1024 Then + Hint("皮肤文件大小需小于 24 KB，而所选文件大小为 " & Math.Round(FileInfo.Length / 1024, 2) & " KB", HintType.Critical) + Return New McSkinInfo With {.IsVaild = False} + End If + Catch ex As Exception + Log(ex, "皮肤文件存在错误", LogLevel.Hint) + Return New McSkinInfo With {.IsVaild = False} + End Try + + '获取皮肤种类 + Dim IsSlim As Integer = MyMsgBox("此皮肤为 Steve 模型（粗手臂）还是 Alex 模型（细手臂）？", "选择皮肤种类", "Steve 模型", "Alex 模型", "我不知道", HighLight:=False) + If IsSlim = 3 Then + Hint("请在皮肤下载页面确认皮肤种类后再使用此皮肤！") + Return New McSkinInfo With {.IsVaild = False} + End If + + Return New McSkinInfo With {.IsVaild = True, .IsSlim = IsSlim = 2, .LocalFile = FileName} + End Function + + ''' + ''' 获取 Uuid 对应的皮肤文件地址，失败将抛出异常。 + ''' + Public Function McSkinGetAddress(Uuid As String, Type As String) As String + If Uuid = "" Then Throw New Exception("Uuid 为空。") + If Uuid.StartsWith("000000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。") + '尝试读取缓存 + Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid) + If Not CacheSkinAddress = "" Then Return CacheSkinAddress + '获取皮肤地址 + Dim Url As String + Select Case Type + Case "Mojang", "Ms" + Url = "https://sessionserver.mojang.com/session/minecraft/profile/" + Case "Nide" + Url = "https://auth.mc-user.com:233/" & If(McVersionCurrent Is Nothing, Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Version:=McVersionCurrent)) & "/sessionserver/session/minecraft/profile/" + Case "Auth" + Url = If(McVersionCurrent Is Nothing, Setup.Get("CacheAuthServerServer"), Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)) & "/sessionserver/session/minecraft/profile/" + Case Else + Throw New ArgumentException("皮肤地址种类无效：" & If(Type, "null")) + End Select + Dim SkinString = NetGetCodeByRequestRetry(Url & Uuid) + If SkinString = "" Then Throw New Exception("皮肤返回值为空，可能是未设置自定义皮肤的用户") + '处理皮肤地址 + Dim SkinValue As String + Try + For Each SkinProperty In GetJson(SkinString)("properties") + If SkinProperty("name") = "textures" Then + SkinValue = SkinProperty("value") + Exit Try + End If + Next + Throw New Exception("未从皮肤返回值中找到符合条件的 Property") + Catch ex As Exception + Log(ex, "无法完成解析的皮肤返回值，可能是未设置自定义皮肤的用户：" & SkinString, LogLevel.Developer) + Throw New Exception("皮肤返回值中不包含皮肤数据项，可能是未设置自定义皮肤的用户", ex) + End Try + SkinString = Encoding.GetEncoding("utf-8").GetString(Convert.FromBase64String(SkinValue)) + Dim SkinJson As JObject = GetJson(SkinString.ToLower) + If SkinJson("textures") Is Nothing OrElse SkinJson("textures")("skin") Is Nothing OrElse SkinJson("textures")("skin")("url") Is Nothing Then + Throw New Exception("用户未设置自定义皮肤") + Else + SkinValue = SkinJson("textures")("skin")("url").ToString + End If + '保存缓存 + WriteIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid, SkinValue) + Log("[Skin] UUID " & Uuid & " 对应的皮肤文件为 " & SkinValue) + Return SkinValue + End Function + + Private ReadOnly McSkinDownloadLock As New Object + ''' + ''' 从 Url 下载皮肤。返回本地文件路径，失败将抛出异常。 + ''' + Public Function McSkinDownload(Address As String) As String + Dim SkinName As String = GetFileNameFromPath(Address) + Dim FileAddress As String = PathTemp & "Cache\Skin\" & GetHash(Address) & ".png" + SyncLock McSkinDownloadLock + If Not File.Exists(FileAddress) Then + NetDownload(Address, FileAddress & NetDownloadEnd) + File.Delete(FileAddress) + FileSystem.Rename(FileAddress & NetDownloadEnd, FileAddress) + Log("[Minecraft] 皮肤下载成功：" & FileAddress) + End If + Return FileAddress + End SyncLock + End Function + + ''' + ''' 获取 Uuid 对应的皮肤，返回“Steve”或“Alex”。 + ''' + Public Function McSkinSex(Uuid As String) As String + If Not Uuid.Length = 32 Then Return "Steve" + Dim a = Integer.Parse(Uuid(7), Globalization.NumberStyles.AllowHexSpecifier) + Dim b = Integer.Parse(Uuid(15), Globalization.NumberStyles.AllowHexSpecifier) + Dim c = Integer.Parse(Uuid(23), Globalization.NumberStyles.AllowHexSpecifier) + Dim d = Integer.Parse(Uuid(31), Globalization.NumberStyles.AllowHexSpecifier) + Return If((a Xor b Xor c Xor d) Mod 2, "Alex", "Steve") + End Function + +#End Region + +#Region "支持库文件（Library）" + + Public Class McLibToken + ''' + ''' 文件的完整本地路径。 + ''' + Public LocalPath As String + ''' + ''' 文件大小。若无有效数据即为 0。 + ''' + Public Size As Long = 0 + ''' + ''' 是否为 Natives 文件。 + ''' + Public IsNatives As Boolean = False + ''' + ''' 文件的 SHA1。 + ''' + Public SHA1 As String = Nothing + ''' + ''' 由 Json 提供的 URL，若没有则为 Nothing。 + ''' + Public Property Url As String + Get + Return _Url + End Get + Set(ByVal value As String) + '孤儿 Forge 作者喜欢把没有的 URL 写个空字符串 + _Url = If(String.IsNullOrWhiteSpace(value), Nothing, value) + End Set + End Property + Private _Url As String + ''' + ''' 原 Json 中 Name 项除去最后一部分版本号的较前部分。可能为 Nothing。 + ''' + Public ReadOnly Property Name As String + Get + If OriginalName Is Nothing Then Return Nothing + Dim Splited As New List(Of String)(OriginalName.Split(":")) + Splited.RemoveAt(Splited.Count - 1) + Return Join(Splited, ":") + End Get + End Property + ''' + ''' 原 Json 中 Name 项最后一部分的版本号。 + ''' + Public ReadOnly Property Version As String + Get + Dim Splited = OriginalName.Split(":") + Return Splited(Splited.Count - 1) + End Get + End Property + ''' + ''' 原 Json 中的 Name 项。 + ''' + Public OriginalName As String + ''' + ''' 是否为 JumpLoader 项。 + ''' + Public IsJumpLoader As Boolean = False + + Public Overrides Function ToString() As String + Return If(IsNatives, "[Native] ", "") & GetString(Size) & " | " & LocalPath + End Function + End Class + + ''' + ''' 检查是否符合 Json 中的 Rules。 + ''' + ''' Json 中的 "rules" 项目。 + Public Function McJsonRuleCheck(RuleToken As JToken) As Boolean + If RuleToken Is Nothing Then Return True + + '初始化 + Dim Required As Boolean = False + For Each Rule As JToken In RuleToken + + '单条条件验证 + Dim IsRightRule As Boolean = True '是否为正确的规则 + If Rule("os") IsNot Nothing Then '操作系统 + If Rule("os")("name") IsNot Nothing Then '操作系统名称 + Dim OsName As String = Rule("os")("name").ToString + If OsName = "unknown" Then + ElseIf OsName = "windows" Then + If Rule("os")("version") IsNot Nothing Then '操作系统版本 + Dim Cr As String = Rule("os")("version").ToString + IsRightRule = IsRightRule AndAlso RegexCheck(OSVersion, Cr) + End If + Else + IsRightRule = False + End If + End If + If Rule("os")("arch") IsNot Nothing Then '操作系统架构 + IsRightRule = IsRightRule AndAlso ((Rule("os")("arch").ToString = "x86") = Is32BitSystem) + End If + End If + If Not IsNothing(Rule("features")) Then '标签 + IsRightRule = IsRightRule AndAlso IsNothing(Rule("features")("is_demo_user")) '只反选是否为 Demo 用户 + End If + + '反选确认 + If Rule("action").ToString = "allow" Then + If IsRightRule Then Required = True 'allow + Else + If IsRightRule Then Required = False 'disallow + End If + + Next + Return Required + End Function + Private OSVersion As String = My.Computer.Info.OSVersion + + ''' + ''' 递归获取 Minecraft 某一版本的完整支持库列表。 + ''' + Public Function McLibListGet(Version As McVersion, IncludeVersionJar As Boolean) As List(Of McLibToken) + + '获取当前支持库列表 + Log("[Minecraft] 获取支持库列表：" & Version.Name) + McLibListGet = McLibListGetWithJson(Version.JsonObject, JumpLoaderFolder:=Version.PathIndie & ".jumploader\") + + '需要添加原版 Jar + If IncludeVersionJar Then + Dim RealVersion As McVersion + Dim RequiredJar As String = Version.JsonObject("jar")?.ToString + If Version.IsHmclFormatJson OrElse RequiredJar Is Nothing Then + '根据 Inherit 获取最深层版本 + '此外，HMCL 项直接使用自身的 Jar + Dim OriginalVersion As McVersion = Version + Do Until OriginalVersion.InheritVersion = "" + If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do + OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\") + Loop + '需要新建对象，否则后面的 Check 会导致 McVersionCurrent 的 State 变回 Original + '复现：启动一个 Snapshot 版本 + RealVersion = New McVersion(OriginalVersion.Path) + Else + 'Json 已提供 Jar 字段，使用该字段的信息 + RealVersion = New McVersion(RequiredJar) + End If + Dim ClientUrl As String, ClientSHA1 As String + '判断需求的版本是否存在 + '不能调用 RealVersion.Check()，可能会莫名其妙地触发 CheckPermission 正被另一进程使用，导致误判前置不存在 + If Not File.Exists(RealVersion.Path & RealVersion.Name & ".json") Then + RealVersion = Version + Log("[Minecraft] 可能缺少前置版本 " & RealVersion.Name & "，找不到对应的 Json 文件", LogLevel.Debug) + End If + '获取详细下载信息 + If RealVersion.JsonObject("downloads") IsNot Nothing AndAlso RealVersion.JsonObject("downloads")("client") IsNot Nothing Then + ClientUrl = RealVersion.JsonObject("downloads")("client")("url") + ClientSHA1 = RealVersion.JsonObject("downloads")("client")("sha1") + Else + ClientUrl = Nothing + ClientSHA1 = Nothing + End If + '把所需的原版 Jar 添加进去 + McLibListGet.Add(New McLibToken With {.LocalPath = RealVersion.Path & RealVersion.Name & ".jar", .Size = 0, .IsNatives = False, .Url = ClientUrl, .SHA1 = ClientSHA1}) + End If + + End Function + ''' + ''' 获取 Minecraft 某一版本忽视继承的支持库列表，即结果中没有继承项。 + ''' + 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) + 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 + + '检查是否需要（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 + RootUrl += McLibGet(Library("name"), False, True, CustomMcFolder).Replace("\", "/") + End If + + '根据是否本地化处理（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"), CustomMcFolder:=CustomMcFolder), CustomMcFolder & "libraries\" & Library("downloads")("artifact")("path").ToString.Replace("/", "\")), + .Size = Val(Library("downloads")("artifact")("size").ToString), + .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}) + 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}) + End Try + Else + '有 Natives + If Library("natives")("windows") IsNot Nothing Then + 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, + McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder).Replace(".jar", "-" & Library("natives")("windows").ToString & ".jar").Replace("${arch}", If(Environment.Is64BitOperatingSystem, "64", "32")), + CustomMcFolder & "libraries\" & Library("downloads")("classifiers")("natives-windows")("path").ToString.Replace("/", "\")), + .Size = Val(Library("downloads")("classifiers")("natives-windows")("size").ToString), + .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}) + 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}) + End Try + End If + End If + + Next + + '去重 + Dim ResultArray As New Dictionary(Of String, McLibToken) + For i = 0 To BasicArray.Count - 1 + Dim Key As String = BasicArray(i).Name & BasicArray(i).IsNatives.ToString & BasicArray(i).IsJumpLoader.ToString + If ResultArray.ContainsKey(Key) Then + If BasicArray(i).Version <> ResultArray(Key).Version AndAlso + (KeepSameNameDifferentVersionResult OrElse BasicArray(i).Version.Contains("natives-windows")) Then + 'Contains("natives-windows") 源于 1.19-Pre1 开始，lwjgl-3.3.1-natives-windows 与 lwjgl-3.3.1-natives-windows-x86 重复 + ResultArray.Add(Key & GetUuid(), BasicArray(i)) + ElseIf VersionSortBoolean(BasicArray(i).Version, ResultArray(Key).Version) Then + ResultArray(Key) = BasicArray(i) + End If + Else + ResultArray.Add(Key, BasicArray(i)) + End If + Next i + Return ResultArray.Values.ToList + End Function + + ''' + ''' 获取版本缺失的支持库文件所对应的 NetTaskFile。 + ''' + Public Function McLibFix(Version As McVersion, Optional CoreJarOnly As Boolean = False) As List(Of NetFile) + If Not Version.IsLoaded Then Version.Load() '确保例如 JumpLoader 等项被合并入 Json + Dim Result As New List(Of NetFile) + + '更新此方法时需要同步更新 Forge 新版自动安装方法！ + + '主 Jar 文件 + Try + Dim MainJar As NetFile = DlClientJarGet(Version, True) + If MainJar IsNot Nothing Then Result.Add(MainJar) + Catch ex As Exception + Log(ex, "版本缺失主 Jar 文件所必须的信息", LogLevel.Developer) + End Try + If CoreJarOnly Then Return Result + + '是否跳过校验 + Dim IsSetupSkip As Boolean = Setup.Get("LaunchAdvanceAssets") + Select Case Setup.Get("VersionAdvanceAssets", Version:=Version) + Case 0 '使用全局设置 + Case 1 '开启校验 + IsSetupSkip = False + Case 2 '关闭校验 + IsSetupSkip = True + End Select + + 'Library 文件 + Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\", AllowUnsameFile:=IsSetupSkip)) + + '统一通行证文件 + If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then + Dim TargetFile = Version.PathIndie & "nide8auth.jar" + Dim Checker As New FileChecker(MinSize:=173000) + If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then + Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker)) + End If + End If + 'Authlib-Injector 文件 + If Setup.Get("VersionServerLogin", Version:=Version) = 4 Then + Dim TargetFile = Version.PathIndie & "authlib-injector.jar" + Dim DownloadInfo As JObject = Nothing + '获取下载信息 + Try + Log("[Minecraft] 开始获取 Authlib-Injector 下载信息") + DownloadInfo = GetJson(NetGetCodeByDownload({"https://download.mcbbs.net/mirrors/authlib-injector/artifact/latest.json", "https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True)) + Catch ex As Exception + Log("获取 Authlib-Injector 下载信息失败", LogLevel.Hint) + End Try + '校验文件 + If DownloadInfo IsNot Nothing Then + Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString) + If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then + '开始下载 + Dim DownloadAddress As String = DownloadInfo("download_url") + Log("[Minecraft] Authlib-Injector 需要更新：" & DownloadAddress) + Result.Add(New NetFile({ + DownloadAddress.Replace("bmclapi2.bangbang93.com", "download.mcbbs.net"), DownloadAddress + }, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString))) + End If + End If + End If + + Return Result + End Function + ''' + ''' 将 McLibToken 列表转换为 NetFile。无需下载的文件会被自动过滤。 + ''' + Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing, Optional AllowUnsameFile As Boolean = False) As List(Of NetFile) + CustomMcFolder = If(CustomMcFolder, PathMcFolder) + Dim Result As New List(Of NetFile) + '获取 + For Each Token As McLibToken In Libs + '检查文件 + Dim Checker As FileChecker + If AllowUnsameFile Then '只要文件存在则通过检查，用于放宽完整性校验的情况 + Checker = New FileChecker(MinSize:=1) + Else + Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1) + End If + If Checker.Check(Token.LocalPath) Is Nothing Then Continue For + '文件不符合，添加下载 + Dim Urls As New List(Of String) + If Token.Url IsNot Nothing Then + '获取 Url 的真实地址 + Dim Url As String = Token.Url + Url = Url.Replace("https://files.minecraftforge.net", "http://files.minecraftforge.net") '这个鬼东西不让 https + Urls.Add(Url) + If Token.Url.Contains("launcher.mojang.com/v1/objects") Then Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings + If Token.Url.Contains("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOf("maven")), "https://download.mcbbs.net/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven")) + End If + If Token.LocalPath.Contains("transformer-discovery-service") Then + 'Transformer 文件释放 + If Not File.Exists(Token.LocalPath) Then WriteFile(Token.LocalPath, GetResources("Transformer")) + Log("[Download] 已自动释放 Transformer Discovery Service", LogLevel.Developer) + 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("-", "_") + OptiFineBase = "/maven/com/optifine/" & OptiFineBase + If OptiFineBase.Contains("_pre") Then OptiFineBase = OptiFineBase.Replace("com/optifine/", "com/optifine/preview_") + Urls.Add("http://download.mcbbs.net" & OptiFineBase) + Urls.Add("http://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("\", "/"))) + End If + Result.Add(New NetFile(ArrayNoDouble(Urls.ToArray()), Token.LocalPath, Checker)) + Next + '去重并返回 + Return ArrayNoDouble(Result, Function(Left As NetFile, Right As NetFile) + Return Left.LocalPath = Right.LocalPath + End Function) + End Function + ''' + ''' 获取对应的支持库文件地址。 + ''' + ''' 原始地址，如 com.mumfrey:liteloader:1.12.2-SNAPSHOT。 + ''' 是否包含 Lib 文件夹头部，若不包含，则会类似以 com\xxx\ 开头。 + Public Function McLibGet(Original As String, Optional WithHead As Boolean = True, Optional IgnoreLiteLoader As Boolean = False, Optional CustomMcFolder As String = Nothing) As String + CustomMcFolder = If(CustomMcFolder, PathMcFolder) + Dim Splited = Original.Split(":") + 'If Original.ToLower.Contains("xray") OrElse Original.ToLower.Contains("rift") OrElse Original.ToLower.Contains("mixin") OrElse Original.Contains("net.minecraftforge:forge") OrElse Splited(2).Contains("beta") OrElse (IgnoreLiteLoader AndAlso Original.Contains("liteloader")) Then + 'ElseIf Splited(2).Contains("-") Then + ' Log("[Launch] 可能存在分段问题的支持库：" & Original) + 'End If + McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") & + Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar" + '判断 OptiFine 是否应该使用 installer + If McLibGet.Contains("optifine\OptiFine\1.12") AndAlso '仅在 1.12 OptiFine 可重现 + File.Exists(CustomMcFolder & "libraries\" & Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & "-installer.jar") Then + Log("[Launch] 已将 " & Original & " 特判替换为对应的 Installer 文件", LogLevel.Debug) + McLibGet = McLibGet.Replace(".jar", "-installer.jar") + End If + End Function + +#End Region + +#Region "资源文件（Assets）" + + '获取索引 + ''' + ''' 获取某版本资源文件索引的对应 Json 项，详见版本 Json 中的 assetIndex 项。失败会抛出异常。 + ''' + Public Function McAssetsGetIndex(Version As McVersion, Optional ReturnLegacyOnError As Boolean = False, Optional CheckURLEmpty As Boolean = False) As JToken + Dim AssetsName As String + Try + Do While True + Dim Index As JToken = Version.JsonObject("assetIndex") + If Index IsNot Nothing AndAlso Index("id") IsNot Nothing Then Return Index + If Version.JsonObject("assets") IsNot Nothing Then AssetsName = Version.JsonObject("assets").ToString + If CheckURLEmpty AndAlso Index("url") IsNot Nothing Then Return Index + '下一个版本 + If Version.InheritVersion = "" Then Exit Do + Version = New McVersion(PathMcFolder & "versions\" & Version.InheritVersion) + Loop + Catch ex As Exception + Log(ex, "获取资源文件索引下载地址失败") + End Try + '无法获取到下载地址 + If ReturnLegacyOnError Then + '返回 assets 文件名会由于没有下载地址导致全局失败 + 'If AssetsName IsNot Nothing AndAlso AssetsName <> "legacy" Then + ' Log("[Minecraft] 无法获取资源文件索引下载地址，使用 assets 项提供的资源文件名：" & AssetsName) + ' Return GetJson("{""id"": """ & AssetsName & """}") + 'Else + Log("[Minecraft] 无法获取资源文件索引下载地址，使用默认的 legacy 下载地址") + Return GetJson(" + { + ""id"": ""legacy"", + ""sha1"": ""c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729"", + ""size"": 134284, + ""url"": ""https://launchermeta.mojang.com/mc-staging/assets/legacy/c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729/legacy.json"", + ""totalSize"": 111220701 + }") + 'End If + Else + Throw New Exception("该版本不存在资源文件索引信息") + End If + End Function + ''' + ''' 获取某版本资源文件索引名，优先使用 assetIndex，其次使用 assets。失败会返回 legacy。 + ''' + Public Function McAssetsGetIndexName(Version As McVersion) As String + Try + Do While True + If Version.JsonObject("assetIndex") IsNot Nothing AndAlso Version.JsonObject("assetIndex")("id") IsNot Nothing Then + Return Version.JsonObject("assetIndex")("id").ToString + End If + If Version.JsonObject("assets") IsNot Nothing Then + Return Version.JsonObject("assets").ToString + End If + If Version.InheritVersion = "" Then Exit Do + Version = New McVersion(PathMcFolder & "versions\" & Version.InheritVersion) + Loop + Catch ex As Exception + Log(ex, "获取资源文件索引名失败") + End Try + Return "legacy" + End Function + + '获取列表 + Private Structure McAssetsToken + ''' + ''' 文件的完整本地路径。 + ''' + Public LocalPath As String + ''' + ''' Json 中书写的源路径。例如 minecraft/sounds/mob/stray/death2.ogg 。 + ''' + Public SourcePath As String + ''' + ''' 文件大小。若无有效数据即为 0。 + ''' + Public Size As Long + ''' + ''' 是否为 Virtual 资源文件。 + ''' + Public IsVirtual As Boolean + ''' + ''' 文件的 Hash 校验码。 + ''' + Public Hash As String + + Public Overrides Function ToString() As String + Return If(IsVirtual, "[Virtual] ", "") & GetString(Size) & " | " & LocalPath + End Function + End Structure + ''' + ''' 获取 Minecraft 的资源文件列表。失败会抛出异常。 + ''' + ''' 版本的资源名称，如“1.13.1”。 + Private Function McAssetsListGet(Name As String) As List(Of McAssetsToken) + Try + + '初始化 + If Not File.Exists(PathMcFolder & "assets\indexes\" & Name & ".json") Then Throw New FileNotFoundException("Assets 索引文件未找到", PathMcFolder & "assets\indexes\" & Name & ".json") + McAssetsListGet = New List(Of McAssetsToken) + Dim Json = GetJson(ReadFile(PathMcFolder & "assets\indexes\" & Name & ".json")) + + '确认 Virtual 与 Map 状态 + Dim IsVirtual As Boolean = False + If Json("virtual") IsNot Nothing Then IsVirtual = Json("virtual").ToString + Dim IsMap As Boolean = False + If Json("map_to_resources") IsNot Nothing Then IsMap = Json("map_to_resources").ToString + + '加载列表 + If IsVirtual OrElse IsMap Then + For Each File As JProperty In Json("objects").Children + McAssetsListGet.Add(New McAssetsToken With { + .IsVirtual = True, + .LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\"), + .SourcePath = File.Name, + .Hash = File.Value("hash").ToString, + .Size = File.Value("size").ToString + }) + Next + Else + For Each File As JProperty In Json("objects").Children + McAssetsListGet.Add(New McAssetsToken With { + .IsVirtual = False, + .LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString, + .SourcePath = File.Name, + .Hash = File.Value("hash").ToString, + .Size = File.Value("size").ToString + }) + Next + End If + + Catch ex As Exception + Log(ex, "获取资源文件列表失败：" & Name) + Throw + End Try + End Function + + '获取缺失列表 + ''' + ''' 获取版本缺失的资源文件所对应的 NetTaskFile。 + ''' + Public Function McAssetsFixList(IndexAddress As String, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile) + Dim Result As New List(Of NetFile) + + Dim AssetsList As List(Of McAssetsToken) + Try + AssetsList = McAssetsListGet(IndexAddress) + Dim Token As McAssetsToken + If ProgressFeed IsNot Nothing Then ProgressFeed.Progress = 0.04 + For i = 0 To AssetsList.Count - 1 + '初始化 + Token = AssetsList(i) + If ProgressFeed IsNot Nothing Then ProgressFeed.Progress = 0.05 + 0.94 * i / AssetsList.Count + '检查文件是否存在 + Dim File As New FileInfo(Token.LocalPath) + If File.Exists AndAlso (Token.Size = 0 OrElse Token.Size = File.Length) AndAlso + (Not CheckHash OrElse Token.Hash Is Nothing OrElse Token.Hash = GetAuthSHA1(Token.LocalPath)) Then Continue For + '文件不存在，添加下载 + Result.Add(New NetFile(DlSourceResourceGet("http://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, "获取版本缺失的资源文件下载列表失败") + End Try + If ProgressFeed IsNot Nothing Then ProgressFeed.Progress = 0.99 + + Return Result + End Function + +#End Region + +#Region "Mod" + + Public Class McMod + +#Region "基础" + + ''' + ''' Mod 文件的地址。 + ''' + Public ReadOnly Path As String + Public Sub New(Path As String) + Me.Path = If(Path, "") + End Sub + + ''' + ''' Mod 的完整文件名。 + ''' + Public ReadOnly Property FileName As String + Get + Return GetFileNameFromPath(Path) + End Get + End Property + + ''' + ''' Mod 的状态。 + ''' + Public ReadOnly Property State As McModState + Get + Load() + If Not IsFileAvailable Then + Return McModState.Unavaliable + ElseIf Path.EndsWith(".disabled") Then + Return McModState.Disabled + Else + Return McModState.Fine + End If + End Get + End Property + Public Enum McModState As Integer + Fine = 0 + Disabled = 1 + Unavaliable = 2 + End Enum + +#End Region + +#Region "信息项" + + ''' + ''' Mod 的名称。若不可用则为 ModID 或无扩展的文件名。 + ''' + Public Property Name As String + Get + If _Name Is Nothing Then Load() + If _Name Is Nothing Then _Name = _ModId + If _Name Is Nothing Then _Name = GetFileNameWithoutExtentionFromPath(Path) + Return _Name + End Get + Set(value As String) + If _Name Is Nothing AndAlso value IsNot Nothing AndAlso + value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then + _Name = value + End If + End Set + End Property + Private _Name As String = Nothing + + ''' + ''' Mod 的描述信息。 + ''' + Public Property Description As String + Get + If _Description Is Nothing Then Load() + If _Description Is Nothing AndAlso FileUnavailableReason IsNot Nothing Then _Description = FileUnavailableReason.Message + 'If _Description Is Nothing Then _Description = Path + Return _Description + End Get + Set(value As String) + If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then + _Description = value.ToString.Trim(vbLf) + '优化显示：若以 [a-zA-Z0-9] 结尾，加上小数点句号 + If _Description.ToLower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "." + End If + End Set + End Property + Private _Description As String = Nothing + + ''' + ''' Mod 的版本，不保证符合版本格式规范。 + ''' + Public Property Version As String + Get + If _Version Is Nothing Then Load() + Return _Version + End Get + Set(value As String) + If _Version IsNot Nothing AndAlso (_Version.Contains(".") OrElse _Version.Contains("-")) Then Exit Property + If value IsNot Nothing AndAlso value.ToLower.Contains("version") Then value = "version" '需要修改的标识 + _Version = value + End Set + End Property + Private _Version As String = Nothing + + ''' + ''' 用于依赖检查的 ModID。 + ''' + Public Property ModId As String + Get + If _ModId Is Nothing Then Load() + Return _ModId + End Get + Set(value As String) + If value Is Nothing Then Exit Property + value = RegexSeek(value.ToLower, "[0-9a-z_]+") + If value IsNot Nothing AndAlso value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then + If Not PossibleModId.Contains(value) Then PossibleModId.Add(value) + If _ModId Is Nothing Then _ModId = value + End If + End Set + End Property + Private _ModId As String = Nothing + ''' + ''' 其他可能的 ModID。 + ''' + Public PossibleModId As New List(Of String) + + ''' + ''' Mod 的主页。 + ''' + Public Property Url As String + Get + If _Url Is Nothing Then Load() + Return _Url + End Get + Set(value As String) + If _Url Is Nothing AndAlso value IsNot Nothing AndAlso value.StartsWith("http") Then + _Url = value + End If + End Set + End Property + Private _Url As String = Nothing + + ''' + ''' Mod 的作者列表。 + ''' + Public Property Authors As String + Get + If _Authors Is Nothing Then Load() + Return _Authors + End Get + Set(value As String) + If _Authors Is Nothing AndAlso Not String.IsNullOrWhiteSpace(value) Then + _Authors = value + End If + End Set + End Property + Private _Authors As String = Nothing + + ''' + ''' 依赖项，其中包括了 Minecraft 的版本要求。格式为 ModID - VersionRequirement，若无版本要求则为 Nothing。 + ''' + Public ReadOnly Property Dependencies As Dictionary(Of String, String) + Get + Load() + Return _Dependencies + End Get + End Property + 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 + ModID = ModID.ToLower + If ModID = "name" OrElse Val(ModID).ToString = ModID Then Exit Sub '跳过 name 与纯数字 id + If VersionRequirement Is Nothing OrElse ((Not VersionRequirement.Contains(".")) AndAlso (Not VersionRequirement.Contains("-"))) OrElse VersionRequirement.Contains("$") Then + VersionRequirement = Nothing + Else + If (Not VersionRequirement.StartsWith("[")) AndAlso (Not VersionRequirement.StartsWith("(")) AndAlso (Not VersionRequirement.EndsWith("]")) AndAlso (Not VersionRequirement.EndsWith(")")) Then VersionRequirement = "[" & VersionRequirement & ",)" + End If + '向依赖项中添加 + If _Dependencies.ContainsKey(ModID) Then + If _Dependencies(ModID) Is Nothing Then _Dependencies(ModID) = VersionRequirement + Else + _Dependencies.Add(ModID, VersionRequirement) + End If + End Sub + +#End Region + +#Region "加载步骤标记" + + '1. 进行文件可用性检查 + ' 成功：继续第二步。 + ' 失败：标记 FileUnavailableReason， 并停止后续加载。 + ''' + ''' 是否已进行 Mod 文件的基础加载。（这包括第一步和第二步） + ''' + Private IsLoaded As Boolean = False + ''' + ''' Mod 文件是否可被正常读取。 + ''' + Public ReadOnly Property IsFileAvailable As Boolean + Get + Load() + Return FileUnavailableReason Is Nothing + End Get + End Property + ''' + ''' Mod 文件出错的原因。若无错误，则为 Nothing。 + ''' + Public ReadOnly Property FileUnavailableReason As Exception + Get + Load() + Return _FileUnavailableReason + End Get + End Property + Private _FileUnavailableReason As Exception = Nothing + + '2. 进行 .class 以外的信息获取 + ' 成功：标记 IsInfoWithoutClassAvailable。 + ' 失败：什么也不干。如果需要补充信息的话，检测到 IsInfoWithoutClassAvailable 为 False，会自动继续加载。 + ''' + ''' 是否已在不获取 .class 文件的前提下完成了所需信息的加载。 + ''' + Private IsInfoWithoutClassAvailable As Boolean = False + + '3. 尝试从 .class 文件中获取信息 + ' 成功：标记 IsInfoWithClassAvailable。 + ' 失败：什么也不干。 + ''' + ''' 是否已进行 .class 文件的信息获取。 + ''' + Private IsInfoWithClassLoaded As Boolean = False + ''' + ''' 是否已在 .class 文件中完成了所需信息的加载。 + ''' + Private IsInfoWithClassAvailable As Boolean = False + +#End Region + +#Region "加载" + + ''' + ''' 初始化所有数据。 + ''' + Private Sub Init() + _Name = Nothing + _Description = Nothing + _Version = Nothing + _ModId = Nothing + PossibleModId = New List(Of String) + _Dependencies = New Dictionary(Of String, String) + IsLoaded = False + _FileUnavailableReason = Nothing + IsInfoWithoutClassAvailable = False + IsInfoWithClassLoaded = False + IsInfoWithClassAvailable = False + End Sub + + ''' + ''' 进行文件可用性检查与 .class 以外的信息获取。 + ''' + Public Sub Load(Optional ForceReload As Boolean = False) + If IsLoaded AndAlso Not ForceReload Then Exit Sub + '初始化 + Init() + '阶段 1：基础可用性检查 + Dim Jar As ZipArchive + Try + '打开 Jar 文件 + If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径（" & If(Path, "null") & "）") + If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件（" & Path & "）") + Jar = New ZipArchive(New FileStream(Path, FileMode.Open)) + If Jar.Entries.Count = 0 Then Throw New FileFormatException("文件内容为空") + Catch ex As UnauthorizedAccessException + Log(ex, "Mod 文件由于无权限无法打开（" & Path & "）", LogLevel.Developer) + _FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限，请尝试右键以管理员身份运行 PCL2", ex) + Jar = Nothing + Catch ex As Exception + Log(ex, "Mod 文件无法打开（" & Path & "）", LogLevel.Developer) + _FileUnavailableReason = ex + Jar = Nothing + End Try + '阶段 2：信息获取 + If Jar IsNot Nothing Then LoadWithoutClass(Jar) + '阶段 3: Class 信息获取 + If Jar IsNot Nothing AndAlso Not IsInfoWithoutClassAvailable Then LoadWithClass(Jar) + '释放文件 + Try + If Jar IsNot Nothing Then Jar.Dispose() + Catch + End Try + '完成标记 + IsLoaded = True + End Sub + + ''' + ''' 进行不使用 .class 文件的信息获取。 + ''' + Private Sub LoadWithoutClass(Jar As ZipArchive) + +#Region "尝试使用 mcmod.info" + Try + '获取信息文件 + Dim InfoEntry As ZipArchiveEntry = Jar.GetEntry("mcmod.info") + Dim InfoString As String = Nothing + If InfoEntry IsNot Nothing Then + InfoString = ReadFile(InfoEntry.Open()) + If InfoString.Length < 15 Then InfoString = Nothing + End If + If InfoString Is Nothing Then Exit Try + '获取可用 Json 项 + Dim InfoObject As JObject + Dim JsonObject = GetJson(InfoString) + If JsonObject.Type = JTokenType.Array Then + InfoObject = JsonObject(0) + Else + InfoObject = JsonObject("modList")(0) + End If + '从文件中获取 Mod 信息项 + Name = InfoObject("name") + Description = InfoObject("description") + Version = InfoObject("version") + Url = InfoObject("url") + ModId = InfoObject("modid") + Dim AuthorJson As JArray = InfoObject("authorList") + If AuthorJson IsNot Nothing Then + Dim Author As New List(Of String) + For Each Token In AuthorJson + Author.Add(Token.ToString) + Next + If Author.Count > 0 Then Authors = Join(Author, ", ") + End If + Dim Reqs As JArray = InfoObject("requiredMods") + If Reqs IsNot Nothing Then + For Each Token As String In Reqs + If Not String.IsNullOrEmpty(Token) Then + Token = Token.Substring(Token.IndexOf(":") + 1) + If Token.Contains("@") Then + AddDependency(Token.Split("@")(0), Token.Split("@")(1)) + Else + AddDependency(Token) + End If + End If + Next + End If + Reqs = InfoObject("dependancies") + If Reqs IsNot Nothing Then + For Each Token As String In Reqs + If Not String.IsNullOrEmpty(Token) Then + Token = Token.Substring(Token.IndexOf(":") + 1) + If Token.Contains("@") Then + AddDependency(Token.Split("@")(0), Token.Split("@")(1)) + Else + AddDependency(Token) + End If + End If + Next + End If + Catch ex As Exception + Log(ex, "读取 mcmod.info 时出现未知错误（" & Path & "）", LogLevel.Developer) + End Try +#End Region +#Region "尝试使用 mods.toml" + Try + '获取 mods.toml 文件 + Dim TomlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/mods.toml") + Dim TomlText As String = Nothing + If TomlEntry IsNot Nothing Then + TomlText = ReadFile(TomlEntry.Open()) + If TomlText.Length < 15 Then TomlText = Nothing + End If + If TomlText Is Nothing Then Exit Try + '文件标准化：统一换行符为 vbLf，去除注释、头尾的空格、空行 + Dim Lines As New List(Of String) + For Each Line In TomlText.Replace(vbCrLf, vbLf).Replace(vbCr, vbLf).Split(vbLf) '统一换行符 + If Line.StartsWith("#") Then '去除注释 + Continue For + ElseIf Line.Contains("#") Then + Line = Line.Substring(0, Line.IndexOf("#")) + End If + Line = Line.Trim(New Char() {" "c, " "c, "　"c}) '去除头尾的空格 + If Line.Count > 0 Then Lines.Add(Line) '去除空行 + Next + '读取文件数据 + Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))} + For i = 0 To Lines.Count - 1 + Dim Line As String = Lines(i) + If Line.StartsWith("[[") AndAlso Line.EndsWith("]]") Then + '段落标记 + Dim Header = Line.Replace("[", "").Replace("]", "") + TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object))) + ElseIf Line.Contains("=") Then + '字段标记 + Dim Key As String = Line.Substring(0, Line.IndexOf("=")).TrimEnd(New Char() {" "c, " "c, "　"c}) + Dim RawValue As String = Line.Substring(Line.IndexOf("=") + 1).TrimStart(New Char() {" "c, " "c, "　"c}) + Dim Value As Object + If RawValue.StartsWith("""") AndAlso RawValue.EndsWith("""") Then + '单行字符串 + Value = RawValue.Trim("""") + ElseIf RawValue.StartsWith("'''") Then + '多行字符串 + Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")} + Do Until i >= Lines.Count - 1 + i += 1 + Dim ValueLine As String = Lines(i) + If ValueLine.EndsWith("'''") Then + ValueLines.Add(ValueLine.TrimEnd("'")) + Exit Do + Else + ValueLines.Add(ValueLine) + End If + Loop + Value = Join(ValueLines, vbLf).Trim(vbLf).Replace(vbLf, vbCrLf) + ElseIf RawValue.ToLower = "true" OrElse RawValue.ToLower = "false" Then + '布尔型 + Value = (RawValue.ToLower = "true") + ElseIf Val(RawValue).ToString = RawValue Then + '数字型 + Value = Val(RawValue) + Else + '不知道是个啥玩意儿，直接存储 + Value = RawValue + End If + DictionaryAdd(TomlData.Last.Value, Key, Value) + Else + '不知道是个啥玩意儿 + Exit Try + End If + Next + '从文件数据中获取信息 + Dim ModEntry As Dictionary(Of String, Object) = Nothing + For Each TomlSubData In TomlData + If TomlSubData.Key = "mods" Then + ModEntry = TomlSubData.Value + Exit For + End If + Next + If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try + ModId = ModEntry("modId") + If _ModId Is Nothing Then Exit Try '设置了无效的 ModID + If ModEntry.ContainsKey("displayName") Then Name = ModEntry("displayName") + If ModEntry.ContainsKey("description") Then Description = ModEntry("description") + If ModEntry.ContainsKey("version") Then Version = ModEntry("version") + If TomlData(0).Value.ContainsKey("displayURL") Then Url = TomlData(0).Value("displayURL") + If TomlData(0).Value.ContainsKey("authors") Then Authors = TomlData(0).Value("authors") + For Each TomlSubData In TomlData + If TomlSubData.Key.StartsWith("dependencies") Then + Dim DepEntry As Dictionary(Of String, Object) = TomlSubData.Value + If DepEntry.ContainsKey("modId") AndAlso DepEntry.ContainsKey("mandatory") AndAlso DepEntry("mandatory") AndAlso + DepEntry.ContainsKey("side") AndAlso Not DepEntry("side").ToString.ToLower = "server" Then + AddDependency(DepEntry("modId"), If(DepEntry.ContainsKey("versionRange"), DepEntry("versionRange"), Nothing)) + End If + End If + Next + '加载成功 + GoTo Finished + Catch ex As Exception + Log(ex, "读取 mods.toml 时出现未知错误（" & Path & "）", LogLevel.Developer) + End Try +#End Region +#Region "尝试使用 fabric.mod.json" + Try + '获取 fabric.mod.json 文件 + Dim FabricEntry As ZipArchiveEntry = Jar.GetEntry("fabric.mod.json") + Dim FabricText As String = Nothing + If FabricEntry IsNot Nothing Then + FabricText = ReadFile(FabricEntry.Open(), Encoding.UTF8) + If Not FabricText.Contains("schemaVersion") Then FabricText = Nothing + End If + If FabricText Is Nothing Then Exit Try + Dim FabricObject As JObject = GetJson(FabricText) +GotFabric: + '从文件中获取 Mod 信息项 + If FabricObject.ContainsKey("name") Then Name = FabricObject("name") + If FabricObject.ContainsKey("version") Then Version = FabricObject("version") + If FabricObject.ContainsKey("description") Then Description = FabricObject("description") + If FabricObject.ContainsKey("id") Then ModId = FabricObject("id") + If FabricObject.ContainsKey("contact") Then Url = If(FabricObject("contact")("homepage"), "") + Dim AuthorJson As JArray = FabricObject("authors") + If AuthorJson IsNot Nothing Then + Dim Author As New List(Of String) + For Each Token In AuthorJson + Author.Add(Token.ToString) + Next + If Author.Count > 0 Then Authors = Join(Author, ", ") + End If + 'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then + ' '添加 Minecraft 依赖 + ' Dim DepMinecraft As String = If(If(FabricObject("acceptedMinecraftVersions") IsNot Nothing, FabricObject("acceptedMinecraftVersions")("value"), ""), "") + ' If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft) + ' '添加其他依赖 + ' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "") + ' If Deps <> "" Then + ' For Each Dep In Deps.Split(";") + ' If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For + ' Dep = Dep.Substring(Dep.IndexOf(":") + 1) + ' If Dep.Contains("@") Then + ' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1)) + ' Else + ' AddDependency(Dep) + ' End If + ' Next + ' End If + 'End If + '加载成功 + GoTo Finished + Catch ex As Exception + Log(ex, "读取 fabric.mod.json 时出现未知错误（" & Path & "）", LogLevel.Developer) + End Try +#End Region +#Region "尝试使用 fml_cache_annotation.json" + Try + '获取 fml_cache_annotation.json 文件 + Dim FmlEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/fml_cache_annotation.json") + Dim FmlText As String = Nothing + If FmlEntry IsNot Nothing Then + FmlText = ReadFile(FmlEntry.Open(), Encoding.UTF8) + If Not FmlText.Contains("Lnet/minecraftforge/fml/common/Mod;") Then FmlText = Nothing + End If + If FmlText Is Nothing Then Exit Try + Dim FmlJson As JObject = GetJson(FmlText) + '获取可用 Json 项 + Dim FmlObject As JObject = Nothing + For Each ModFilePair In FmlJson + Dim ModFileAnnos As JArray = ModFilePair.Value("annotations") + If ModFileAnnos IsNot Nothing Then + '先获取 Mod + For Each ModFileAnno In ModFileAnnos + Dim Name As String = If(ModFileAnno("name"), "") + If Name = "Lnet/minecraftforge/fml/common/Mod;" Then + FmlObject = ModFileAnno("values") + GoTo Got + End If + Next + End If + Next + Exit Try +Got: + '从文件中获取 Mod 信息项 + If FmlObject.ContainsKey("useMetadata") AndAlso If(FmlObject("useMetadata")("value"), "").ToString.ToLower = "true" Then + '要求使用 mcmod.info 中的信息 + Dim value As String = FmlObject("modid")("value") + If value Is Nothing Then Exit Try + value = RegexSeek(value.ToLower, "[0-9a-z_]+") + If value IsNot Nothing AndAlso value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then + If Not PossibleModId.Contains(value) Then PossibleModId.Add(value) + End If + Exit Try + End If + If FmlObject.ContainsKey("name") Then Name = FmlObject("name")("value") + If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value") + If FmlObject.ContainsKey("modid") Then ModId = FmlObject("modid")("value") + If (Not FmlObject.ContainsKey("serverSideOnly")) OrElse FmlObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then + '添加 Minecraft 依赖 + Dim DepMinecraft As String = If(If(FmlObject("acceptedMinecraftVersions") IsNot Nothing, FmlObject("acceptedMinecraftVersions")("value"), ""), "") + If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft) + '添加其他依赖 + Dim Deps As String = If(If(FmlObject("dependencies") IsNot Nothing, FmlObject("dependencies")("value"), ""), "") + If Deps <> "" Then + For Each Dep In Deps.Split(";") + If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For + Dep = Dep.Substring(Dep.IndexOf(":") + 1) + If Dep.Contains("@") Then + AddDependency(Dep.Split("@")(0), Dep.Split("@")(1)) + Else + AddDependency(Dep) + End If + Next + End If + End If + Catch ex As Exception + Log(ex, "读取 fml_cache_annotation.json 时出现未知错误（" & Path & "）", LogLevel.Developer) + End Try +#End Region +Finished: +#Region "将 Version 代号转换为 META-INF 中的版本" + If _Version = "version" Then + Try + Dim MetaEntry As ZipArchiveEntry = Jar.GetEntry("META-INF/MANIFEST.MF") + If MetaEntry IsNot Nothing Then + Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":") + If MetaString.Contains("Implementation-Version:") Then + MetaString = MetaString.Substring(MetaString.IndexOf("Implementation-Version:") + "Implementation-Version:".Count) + MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim + Version = MetaString + End If + End If + Catch ex As Exception + Log("获取 META-INF 中的版本信息失败（" & Path & "）", LogLevel.Developer) + Version = Nothing + End Try + End If + If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing +#End Region + + IsInfoWithoutClassAvailable = _ModId IsNot Nothing AndAlso _Version IsNot Nothing + End Sub + + ''' + ''' 进行使用 .class 文件的信息获取。 + ''' + Private Sub LoadWithClass(Jar As ZipArchive) + Try + '查找入口点文件 + Dim ModClass As String = Nothing + Dim ModClassNotBest As String = Nothing '非完美匹配 + For Each Entry In Jar.Entries + If Entry.Name.EndsWith(".class") Then + Dim Temp As String = ReadFile(Entry.Open()).ToLower + If Temp.Contains("#lnet/minecraftforge/fml/common/mod;") Then + ModClass = Temp + Exit For + ElseIf Temp.Contains("modid") Then + ModClassNotBest = Temp + End If + End If + Next + If ModClass Is Nothing Then ModClass = ModClassNotBest + If ModClass Is Nothing Then Throw New FileNotFoundException("未找到 Mod 入口点") + ModClass = ModClass.Replace("ljava/lang/string;", "") + If ModClass.Count > 3000 Then ModClass = ModClass.Substring(0, 3000) '如果文件过大，截取前 3000 Byte + Dim IndexHead As Integer, IndexTail As Integer, IncreaseCount As Integer + '获取 ModID + If _ModId Is Nothing Then + IndexHead = ModClass.IndexOf("modid") + "modid".Length + 1 + IncreaseCount = 0 + Do While Convert.ToInt32(ModClass(IndexHead)) < 32 + IndexHead += 1 + IncreaseCount += 1 + If IncreaseCount > 10 Then Throw New Exception("ModID 头匹配失败") + Loop + IndexTail = IndexHead + 1 + IncreaseCount = 0 + Do Until Convert.ToInt32(ModClass(IndexTail)) < 32 + IndexTail += 1 + IncreaseCount += 1 + If IncreaseCount > 50 Then Throw New Exception("ModID 尾匹配失败") + Loop + ModId = ModClass.Substring(IndexHead, IndexTail - IndexHead) + End If + '获取 Version + If _Version Is Nothing AndAlso ModClass.Contains("version") Then + IndexHead = ModClass.IndexOf("version") + "version".Length + 1 + IncreaseCount = 0 + Do While Convert.ToInt32(ModClass(IndexHead)) < 32 + IndexHead += 1 + IncreaseCount += 1 + If IncreaseCount > 10 Then GoTo VersionFindFail + Loop + IndexTail = IndexHead + 1 + IncreaseCount = 0 + Do While ModClass(IndexTail) = "."c OrElse ModClass(IndexTail) = "-"c OrElse + (ModClass(IndexTail) >= "0"c AndAlso ModClass(IndexTail) <= "9"c) OrElse + (ModClass(IndexTail) >= "a"c AndAlso ModClass(IndexTail) <= "z"c) + IndexTail += 1 + IncreaseCount += 1 + If IncreaseCount > 50 Then GoTo VersionFindFail + Loop + _Version = ModClass.Substring(IndexHead, IndexTail - IndexHead) + End If +VersionFindFail: + '获取 Dependencies + IndexHead = ModClass.IndexOf("dependencies") + If IndexHead > 0 Then + If ModClass.Count >= IndexHead + 300 Then ModClass = ModClass.Substring(IndexHead, 299) + Dim Deps As List(Of String) = RegexSearch(ModClass, "(?<=required-((before|after|before-client|after-client)?):)[0-9a-z]+(@[\(\[]{1}[0-9.,]+[\)\]]{1})?") + For Each Token As String In Deps + If Not String.IsNullOrEmpty(Token) Then + If Token.Contains("@") Then + AddDependency(Token.Split("@")(0), Token.Split("@")(1)) + Else + AddDependency(Token) + End If + End If + Next + End If + Catch ex As Exception + Log(ex, "Mod Class 信息不可用（" & If(Path, "null") & "）", LogLevel.Normal) + End Try + IsInfoWithClassAvailable = _ModId IsNot Nothing AndAlso _Version IsNot Nothing + End Sub + +#End Region + + ''' + ''' 是否可能为前置 Mod。 + ''' + Public Function IsPresetMod() As Boolean + Return Dependencies.Count = 0 AndAlso (Name IsNot Nothing) AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib")) + End Function + + ''' + ''' 根据完整文件路径的文件扩展名判断是否为 Mod 文件。 + ''' + Public Shared Function IsModFile(Path As String) + If Path Is Nothing OrElse Not Path.Contains(".") Then Return False + Path = Path.ToLower + If Path.EndsWith(".jar") OrElse Path.EndsWith(".zip") OrElse Path.EndsWith(".litemod") OrElse + Path.EndsWith(".jar.disabled") OrElse Path.EndsWith(".zip.disabled") OrElse Path.EndsWith(".litemod.disabled") Then Return True + Return False + End Function + + End Class + + '加载 Mod 列表 + Public McModLoader As New LoaderTask(Of String, List(Of McMod))("Mod List Loader", AddressOf McModLoad) + Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of McMod))) + Try + RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = False) + + '获取 Mod 文件夹下的可用文件列表 + Dim ModFileList As New List(Of FileInfo) + If Directory.Exists(Loader.Input) Then + For Each File As FileInfo In New DirectoryInfo(Loader.Input).EnumerateFiles("*.*", SearchOption.AllDirectories) + Dim DirName As String = File.DirectoryName.ToLower + If DirName.StartsWith(Loader.Input & "memory_repo") OrElse DirName.StartsWith(".") OrElse + ((DirName & "\") <> Loader.Input AndAlso DirName.Contains("voxel")) Then Continue For + If McMod.IsModFile(File.FullName) Then ModFileList.Add(File) + Next + End If + + '确定是否显示进度 + Loader.Progress = 0.03 + If ModFileList.Count > 100 Then RunInUi(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = True) + + '加载为 Mod 列表 + Dim ModList As New List(Of McMod) + For Each ModFile As FileInfo In ModFileList + Dim ModEntity As New McMod(ModFile.FullName) + ModEntity.Load() + ModList.Add(ModEntity) + Loader.Progress += 0.9 / ModFileList.Count + Next + Loader.Progress = 0.93 + + '排序 + ModList = Sort(ModList, Function(Left As McMod, Right As McMod) As Boolean + If (Left.State = McMod.McModState.Unavaliable) <> (Right.State = McMod.McModState.Unavaliable) Then + Return Left.State = McMod.McModState.Unavaliable + Else + Return Left.FileName < Right.FileName + End If + End Function) + Loader.Progress = 0.98 + + '回设 + If Loader.IsAborted Then Exit Sub + Loader.Output = ModList + + Catch ex As Exception + Log(ex, "Mod 列表加载失败", LogLevel.Debug) + Throw + End Try + End Sub + +#If DEBUG Then + ''' + ''' 检查 Mod 列表中存在的错误，返回错误信息的集合。 + ''' + Public Function McModCheck(Version As McVersion, Mods As List(Of McMod)) As List(Of String) + Dim Result As New List(Of String) + '令所有 Mod 进行基础检查，并归纳需要检查的 Mod + Dim CurrentModList As New List(Of McMod) + For Each ModEntity In Mods + If Not ModEntity.IsFileAvailable Then + Result.Add("无法读取的 Mod 文件。" & vbCrLf & " - " & ModEntity.Path) + Continue For + End If + If ModEntity.State = McMod.McModState.Fine AndAlso ModEntity.ModId IsNot Nothing Then CurrentModList.Add(ModEntity) + Next + '添加默认依赖 + Dim CurrentDependencies As New Dictionary(Of String, String()) '{DependencyVersion, Path} + If Version.State = McVersionState.Forge Then CurrentDependencies.Add("forge", {Version.Version.ForgeVersion, "Forge"}) + CurrentDependencies.Add("minecraft", {Version.Version.McName, "Minecraft"}) + '检查重复的 Mod，并添加对应的依赖 + For Each ModEntity In CurrentModList + For Each PossibleModId In ModEntity.PossibleModId + If CurrentDependencies.ContainsKey(PossibleModId) Then + If CurrentDependencies(PossibleModId)(2) = 1 Then + Result.Add("重复添加了相同的 Mod，请尝试删除其中一个（ModID：" & PossibleModId & "）。" & vbCrLf & + " - " & ModEntity.FileName & vbCrLf & + " - " & CurrentDependencies(PossibleModId)(1)) + Else + Log("[Minecraft] 由于可能有多个 ModID，跳过疑似的重复项（ModID：" & PossibleModId & "）。" & vbCrLf & + " - " & ModEntity.FileName & vbCrLf & + " - " & CurrentDependencies(PossibleModId)(1), LogLevel.Developer) + End If + Else + CurrentDependencies.Add(PossibleModId, {ModEntity.Version, ModEntity.FileName, ModEntity.PossibleModId.Count}) + End If + Next + Next + '检查依赖 + For Each ModEntity In CurrentModList + Try + For Each Dependency In ModEntity.Dependencies + Dim ReqId As String = Dependency.Key + If ReqId.Count < 2 Then Continue For '确保正常 + If ReqId = ModEntity.ModId Then Continue For '跳过自体引用 + If ReqId = "forgemultipartcbe" Then Continue For '跳过莫名其妙的引用 + If Dependency.Value IsNot Nothing Then + '获取分段后的详细版本信息 + Dim ReqVersion As String = Dependency.Value + Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWith("[") + Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWith("]") + Dim ReqVersionHead As String + Dim ReqVersionTail As String + If ReqVersion.Contains(",") Then + ReqVersionHead = ReqVersion.Split(",")(0).Trim("([ ".ToCharArray()) + ReqVersionTail = ReqVersion.Split(",")(1).Trim("]) ".ToCharArray()) + Else + ReqVersionHead = ReqVersion.Trim("([]) ".ToCharArray()) + ReqVersionTail = ReqVersionHead + If ReqId = "minecraft" AndAlso ReqVersionHead.Split(".").Count = 2 Then + ReqVersionTail = ReqVersionHead.Split(".")(0) & "." & (Val(ReqVersionHead.Split(".")(1)) + 1) + ReqVersionTailCanEqual = False + End If + End If + If ReqVersionHead.StartsWith("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOf("-") + 1) + If ReqVersionTail.StartsWith("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOf("-") + 1) + '获取报错描述文本 + Dim VersionRequire As String + If ReqVersionHead = ReqVersionTail Then + VersionRequire = "应为 " & ReqVersionHead + ElseIf ReqVersionHead.Contains(".") AndAlso ReqVersionTail.Contains(".") Then + VersionRequire = "应为 " & ReqVersionHead & " 至 " & ReqVersionTail + ElseIf ReqVersionHead.Contains(".") Then + If ReqVersionHeadCanEqual Then + VersionRequire = "最低应为 " & ReqVersionHead + Else + VersionRequire = "应高于 " & ReqVersionHead + End If + ElseIf ReqVersionTail.Contains(".") Then + If ReqVersionTailCanEqual Then + VersionRequire = "最高应为 " & ReqVersionHead + Else + VersionRequire = "应低于 " & ReqVersionHead + End If + Else + VersionRequire = "" + End If + '检查前置 Mod 是否存在，并获取其版本 + If Not CurrentDependencies.ContainsKey(ReqId) Then + Result.Add("缺少前置 Mod：" & ReqId & If(VersionRequire = "", "", "，其版本" & VersionRequire) & "。" & vbCrLf & " - " & ModEntity.FileName) + Continue For + End If + Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0") + If CurrentVersion.StartsWith("1.") AndAlso CurrentVersion.Contains("-") Then CurrentVersion = CurrentVersion.Substring(CurrentVersion.LastIndexOf("-") + 1) + '对比前置 Mod 头部版本 + If ReqVersionHead.Contains(".") Then + If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then + Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过低，其版本" & VersionRequire & "，而当前版本为 " & CurrentVersion & "。" & vbCrLf & + " - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置：" & CurrentDependencies(ReqId)(1), "")) + Continue For + End If + End If + '对比前置 Mod 尾部版本 + If ReqVersionTail.Contains(".") Then + If VersionSortInteger(CurrentVersion, ReqVersionTail) > If(ReqVersionTailCanEqual, 0, -1) Then + Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过高，其版本" & VersionRequire & "，而当前版本为 " & CurrentVersion & "。" & vbCrLf & + " - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置：" & CurrentDependencies(ReqId)(1), "")) + Continue For + End If + End If + Else + If Not CurrentDependencies.ContainsKey(Dependency.Key) Then + Result.Add("缺少前置 Mod：" & Dependency.Key & "。" & vbCrLf & " - " & ModEntity.FileName) + Continue For + End If + End If + Next + Catch ex As Exception + Result.Add("检查 Mod 时出错：" & GetString(ex) & vbCrLf & " - " & ModEntity.FileName) + Log(ex, "检查 Mod 时出错") + End Try + Next + If Result.Count = 0 Then + Log("[Minecraft] Mod 检查未发现异常") + Else + Log("[Minecraft] Mod 检查异常结果：" & vbCrLf & Join(Result, vbCrLf)) + End If + Return Result + End Function +#End If + +#End Region + + ''' + ''' 发送 Minecraft 更新提示。 + ''' + Public Sub McDownloadClientUpdateHint(VersionName As String, Json As JObject) + Try + + '获取对应版本 + Dim Version As JToken = Nothing + For Each Token In Json("versions") + If Token("id") IsNot Nothing AndAlso Token("id").ToString = VersionName Then + Version = Token + Exit For + End If + Next + '进行提示 + If Version Is Nothing Then Exit Sub + Dim Time As Date = Version("releaseTime") + Dim MsgResult As Integer + If (Date.Now - Time).TotalDays > 1 Then + '1 天以上 + MsgResult = MyMsgBox("新版本：" & VersionName & vbCrLf & "更新时间：" & Time.ToString, "Minecraft 更新提示", "下载", "更新日志", "取消") + ElseIf (Date.Now - Time).TotalHours > 3 Then + '1 天 ~ 3 小时 + MsgResult = MyMsgBox("新版本：" & VersionName & vbCrLf & "更新于：" & GetTimeSpanString(Time - Date.Now), "Minecraft 更新提示", "下载", "更新日志", "取消") + Else + '不到 3 小时 + MsgResult = MyMsgBox("新版本：" & VersionName & vbCrLf & "更新于：" & GetTimeSpanString(Time - Date.Now), "Minecraft 更新提示", "下载", "取消") + If MsgResult = 2 Then MsgResult = 3 '把 “取消” 移位 + End If + '弹窗结果 + Select Case MsgResult + Case 1 + '下载 + McDownloadClient(NetPreDownloadBehaviour.HintWhileExists, VersionName, Version("url").ToString) + Case 2 + '更新日志 + McUpdateLogShow(Version) + End Select + + Catch ex As Exception + Log(ex, "Minecraft 更新提示发送失败（" & If(VersionName, "Nothing") & "）", LogLevel.Feedback) + End Try + End Sub + + ''' + ''' 比较两个版本名的排序，若 Left 较新则返回 True。无法比较两个 Pre 的大小。 + ''' 支持的格式范例：未知版本, 1.13.2, 1.7.10-pre4, 1.8_pre, 1.14 Pre-Release 2, 1.14.4 C6 + ''' + Public Function VersionSortBoolean(Left As String, Right As String) As Boolean + Return VersionSortInteger(Left, Right) >= 0 + End Function + ''' + ''' 比较两个版本名的排序，若 Left 较新则返回 1，相同则返回 0，Right 较新则返回 -1。 + ''' 支持的格式范例：未知版本, 1.13.2, 1.7.10-pre4, 1.8_pre, 1.14 Pre-Release 2, 1.14.4 C6 + ''' + Public Function VersionSortInteger(Left As String, Right As String) As Integer + If Left = "未知版本" OrElse Right = "未知版本" Then + If Left = "未知版本" AndAlso Right <> "未知版本" Then Return 1 + If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0 + If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1 + End If + Dim Lefts = RegexSearch(Left.ToLower, "[a-z]+|[0-9]+") + Dim Rights = RegexSearch(Right.ToLower, "[a-z]+|[0-9]+") + Dim i As Integer = 0 + While True + '两边均缺失，感觉是一个东西 + If Lefts.Count - 1 < i AndAlso Rights.Count - 1 < i Then + If Left > Right Then + Return 1 + ElseIf Left < Right Then + Return -1 + Else + Return 0 + End If + End If + '确定两边的数值 + Dim LeftValue As String = If(Lefts.Count - 1 < i, "-1", Lefts(i)) + Dim RightValue As String = If(Rights.Count - 1 < i, "-1", Rights(i)) + If LeftValue = RightValue Then GoTo NextEntry + If LeftValue = "pre" OrElse LeftValue = "snapshot" Then LeftValue = "-3" + If LeftValue = "rc" Then LeftValue = "-2" + If LeftValue = "experimental" Then LeftValue = "-4" + Dim LeftValValue = Val(LeftValue) + If RightValue = "pre" OrElse RightValue = "snapshot" Then RightValue = "-3" + If RightValue = "rc" Then RightValue = "-2" + If RightValue = "experimental" Then RightValue = "-4" + Dim RightValValue = Val(RightValue) + If LeftValValue = 0 AndAlso RightValValue = 0 Then + '如果没有数值则直接比较字符串 + If LeftValue > RightValue Then + Return 1 + ElseIf LeftValue < RightValue Then + Return -1 + End If + Else + '如果有数值则比较数值 + '这会使得一边是数字一边是字母时数字方更大 + If LeftValValue > RightValValue Then + Return 1 + ElseIf LeftValValue < RightValValue Then + Return -1 + End If + End If +NextEntry: + i += 1 + End While + Return 0 + End Function + ''' + ''' 比较两个版本名的排序器。 + ''' + Public Class VersionSorter + Implements IComparer(Of String) + Public IsDecreased As Boolean = True + Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare + Return VersionSortInteger(x, y) * If(IsDecreased, -1, 1) + End Function + Public Sub New(Optional IsDecreased As Boolean = True) + Me.IsDecreased = IsDecreased + End Sub + End Class + + ''' + ''' 为邮箱地址或手机号账号进行部分打码。 + ''' + 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, "*") + End If + End Function + ''' + ''' 对 PCL 约定的替换标记进行处理。 + ''' + Public Function ArgumentReplace(Raw As String) As String + If Raw Is Nothing Then Return Nothing + Raw = Raw.Replace("{user}", If(IsNothing(McLoginLoader.Output), "尚未登录", McLoginLoader.Output.Name)) + If IsNothing(McLoginLoader.Input) Then + Raw = Raw.Replace("{login}", "尚未登录") + Else + Select Case McLoginLoader.Input.Type + Case McLoginType.Legacy + Raw = Raw.Replace("{login}", "离线") + Case McLoginType.Mojang + Raw = Raw.Replace("{login}", "Mojang 正版") + Case McLoginType.Ms + Raw = Raw.Replace("{login}", "微软正版") + Case McLoginType.Nide + Raw = Raw.Replace("{login}", "统一通行证") + Case McLoginType.Auth + Raw = Raw.Replace("{login}", "Authlib-Injector") + End Select + End If + If McVersionCurrent Is Nothing Then + Raw = Raw.Replace("{name}", "无可用版本") + Raw = Raw.Replace("{version}", "无可用版本") + Else + Raw = Raw.Replace("{name}", McVersionCurrent.Name) + If Not McVersionCurrent.IsLoaded Then McVersionCurrent.Load() + If {"unknown", "old", "pending"}.Contains(McVersionCurrent.Version.McName.ToLower) Then + Raw = Raw.Replace("{version}", McVersionCurrent.Name) + Else + Raw = Raw.Replace("{version}", McVersionCurrent.Version.McName) + End If + End If + Raw = Raw.Replace("{path}", Path) + Return Raw + End Function + +End Module diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb new file mode 100644 index 0000000..5b71a33 --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb @@ -0,0 +1,619 @@ +Public Module ModModpack + + '触发整合包安装的外部接口 + ''' + ''' 弹窗要求选择一个整合包文件并进行安装。 + ''' + Public Sub ModpackInstall() + Dim File As String = SelectFile("压缩包文件(*.rar;*.zip)|*.rar;*.zip", "选择整合包压缩文件") '选择整合包文件 + If String.IsNullOrEmpty(File) Then Exit Sub + RunInThread(Sub() ModpackInstall(File)) + End Sub + ''' + ''' 安装一个给定的整合包文件，返回是否安装成功。必须在工作线程执行。 + ''' + Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True) As Boolean + Log("[ModPack] 整合包安装请求：" & If(File, "null")) + Dim Archive As Compression.ZipArchive = Nothing + Dim ArchiveBaseFolder As String = "" + Try + '获取整合包种类与关键 Json + Dim PackType As Integer = -1 + Try + Archive = New Compression.ZipArchive(New FileStream(File, FileMode.Open)) + '从根目录判断整合包类型 + If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断） + If Archive.GetEntry("manifest.json") IsNot Nothing Then + Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8)) + If Json("addons") Is Nothing Then + PackType = 0 : Exit Try 'CurseForge 整合包 + Else + PackType = 3 : Exit Try 'MCBBS 整合包 + End If + End If + If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包 + If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包 + '从一级目录判断整合包类型 + For Each Entry In Archive.Entries + Dim FullNames As String() = Entry.FullName.Split("/") + ArchiveBaseFolder = FullNames(0) & "/" + If Entry.FullName.EndsWith("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包 + '确定为一级目录下 + If FullNames.Count <> 2 Then Continue For + '判断是否为关键文件 + If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包（优先于 manifest.json 判断） + If FullNames(1) = "manifest.json" Then + Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8)) + If Json("addons") Is Nothing Then + PackType = 0 : Exit Try 'CurseForge 整合包 + Else + PackType = 3 : ArchiveBaseFolder = "overrides/" : Exit Try 'MCBBS 整合包 + End If + End If + If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包 + If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包 + Next + Catch ex As Exception + If File.ToLower.EndsWith(".rar") Then + Log(ex, "PCL2 无法处理 rar 格式的压缩包，请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) + Return False + Else + Log(ex, "打开整合包文件失败，文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) + Return False + End If + End Try + '执行对应的安装方法 + Select Case PackType + Case 0 + Log("[ModPack] 整合包种类：CurseForge") + InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName) + Case 1 + Log("[ModPack] 整合包种类：HMCL") + InstallPackHMCL(File, Archive, ArchiveBaseFolder) + Case 2 + Log("[ModPack] 整合包种类：MMC") + InstallPackMMC(File, Archive, ArchiveBaseFolder) + Case 3 + Log("[ModPack] 整合包种类：MCBBS") + InstallPackMCBBS(File, Archive, ArchiveBaseFolder) + Case 9 + Log("[ModPack] 整合包种类：压缩包") + Archive.Dispose() + Archive = Nothing + InstallPackCompress(File, ArchiveBaseFolder) + Case Else + If ShowHint Then + Hint("未能识别该整合包的种类，无法安装！", HintType.Critical) + Else + Log("[ModPack] 未能识别该整合包的种类，无法安装！") + End If + Return False + End Select + Return True + Catch ex As Exception + Log(ex, "准备安装整合包失败", LogLevel.Feedback) + Return False + Finally + If Archive IsNot Nothing Then Archive.Dispose() + End Try + End Function + + '整合包缓存清理 + Private IsInstallCacheCleared As Boolean = False + Private IsInstallCacheClearing As Boolean = False + Private Sub UnpackFiles(InstallTemp As String, FileAddress As String) + '清理缓存文件夹 + If Not IsInstallCacheCleared Then + IsInstallCacheCleared = True + IsInstallCacheClearing = True + Try + Log("[ModPack] 开始清理整合包安装缓存") + DeleteDirectory(PathTemp & "PackInstall\") + Log("[ModPack] 已清理整合包安装缓存") + Catch ex As Exception + Log(ex, "清理整合包安装缓存失败") + Finally + IsInstallCacheClearing = False + End Try + ElseIf IsInstallCacheClearing Then + '等待另一个整合包安装的清理步骤完成 + Do While IsInstallCacheClearing + Thread.Sleep(1) + Loop + End If + '解压文件 + Dim RetryCount As Integer = 1 + Dim Encode = Encoding.Default + Try +Retry: + '完全不知道为啥会出现文件正在被另一进程使用的问题，总之多试试 + Directory.CreateDirectory(InstallTemp) + DeleteDirectory(InstallTemp) + Compression.ZipFile.ExtractToDirectory(FileAddress, InstallTemp, Encode) + 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) + RetryCount += 1 + GoTo Retry + Else + Throw + End If + End Try + End Sub + +#Region "不同类型整合包的安装方法" + + 'CurseForge + ''' + ''' 获取安装 CurseForge 整合包的加载器，若失败或跳过则返回 Nothing。 + ''' 加载器以安装目标版本文件夹为输入。 + ''' + Private Function InstallPackCurseForgeLoader(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, VersionName As String) As LoaderCombo(Of String) + '读取 Json 文件 + Dim Json As JObject + Try + Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open)) + If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息") + Catch ex As Exception + Log(ex, "整合包安装信息存在问题", LogLevel.Hint) + Return Nothing + End Try + '获取 Mod API 版本信息 + Dim ForgeVersion As String = Nothing + Dim FabricVersion As String = Nothing + For Each Entry In If(Json("minecraft")("modLoaders"), {}) + Dim Id As String = If(Entry("id"), "").ToString.ToLower + If Id.StartsWith("forge-") Then + 'Forge 指定 + If Id.Contains("recommended") Then + Log("[ModPack] 该整合包版本过老，已不支持进行安装！", LogLevel.Hint) + Return Nothing + End If + Try + Log("[ModPack] 整合包 Forge 版本：" & Id) + ForgeVersion = Id.Split("-")(1) + Exit For + Catch ex As Exception + Log(ex, "读取整合包 Forge 版本失败：" & Id) + End Try + ElseIf Id.StartsWith("fabric-") Then + 'Fabric 指定 + Try + Log("[ModPack] 整合包 Fabric 版本：" & Id) + FabricVersion = Id.Split("-")(1) + Exit For + Catch ex As Exception + Log(ex, "读取整合包 Fabric 版本失败：" & Id) + End Try + End If + Next + '解压与配置文件 + Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" + Dim InstallLoaders As New List(Of LoaderBase) + Dim OverrideHome As String = If(Json("overrides"), "") + If OverrideHome <> "" Then + InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", + Sub(Task As LoaderTask(Of String, Integer)) + UnpackFiles(InstallTemp, FileAddress) + Task.Progress = 0.5 + '复制结果 + If Directory.Exists(InstallTemp & ArchiveBaseFolder & OverrideHome) Then + My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & OverrideHome, PathMcFolder & "versions\" & VersionName) + Else + Log("[ModPack] 整合包中未找到 override 目录，已跳过") + End If + Task.Progress = 0.9 + '开启版本隔离 + WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) + End Sub) With { + .ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s + End If + '获取 Mod 列表 + Dim ModFileList As New List(Of Integer) + For Each ModEntry In If(Json("files"), {}) + If ModEntry("projectID") Is Nothing OrElse ModEntry("fileID") Is Nothing Then + Hint("某项 Mod 缺少必要信息，已跳过：" & ModEntry.ToString) + Continue For + End If + If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then Continue For + ModFileList.Add(ModEntry("fileID")) + Next + If ModFileList.Count > 0 Then + '获取 Mod 下载信息 + InstallLoaders.Add(New LoaderTask(Of Integer, JArray)( + "获取 Mod 下载信息", + Sub(Task As LoaderTask(Of Integer, JArray)) + Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModFileList, ",") & "]}", "application/json"))("data") + '如果文件已被删除，则 API 会跳过那一项 + If ModFileList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除，因此无法完成整合包安装，请联系整合包作者更新整合包中的 Mod 版本") + End Sub) With {.ProgressWeight = ModFileList.Count / 10}) '每 10 Mod 需要 1s + '构造 NetFile + InstallLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息", + Sub(Task As LoaderTask(Of JArray, List(Of NetFile))) + Dim FileList As New Dictionary(Of Integer, NetFile) + For Each ModJson In Task.Input + '跳过重复的 Mod（疑似 CurseForge Bug） + If FileList.ContainsKey(ModJson("id").ToObject(Of Integer)) Then Continue For + '实际的添加 + FileList.Add(ModJson("id"), New DlCfFile(ModJson, False).GetDownloadFile(PathMcFolder & "versions\" & VersionName & "\mods\", False)) + Task.Progress += 1 / (1 + ModFileList.Count) + Next + Task.Output = FileList.Values.ToList + End Sub) With {.ProgressWeight = ModFileList.Count / 200, .Show = False}) '每 200 Mod 需要 1s + '下载 Mod 文件 + InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModFileList.Count * 1.5}) '每个 Mod 需要 1.5s + End If + '构造加载器 + Dim Request As New McInstallRequest With { + .TargetVersionName = VersionName, + .MinecraftName = Json("minecraft")("version").ToString, + .ForgeVersion = ForgeVersion, + .FabricVersion = FabricVersion + } + Dim InstallExpectTime As Double = 0 + For Each InstallLoader In InstallLoaders + InstallExpectTime += InstallLoader.ProgressWeight + Next + Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) + If MergeLoaders Is Nothing Then Return Nothing + Dim MergeExpectTime As Double = 0 + For Each MergeLoader In MergeLoaders + MergeExpectTime += MergeLoader.ProgressWeight + Next + '构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件） + 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 Loaders As New List(Of LoaderBase) + Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime}) + Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime}) + Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) + + '重复任务检查 + Dim LoaderName As String = "CurseForge 整合包安装：" & VersionName & " " + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = LoaderName Then + Hint("该整合包正在安装中！", HintType.Critical) + Return Nothing + End If + Next + End SyncLock + + '启动 + Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} + Return Loader + End Function + Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing) + + '获取版本名 + Dim ShowRibble As Boolean = VersionName Is Nothing + If VersionName Is Nothing Then + Dim Json As JObject + Try + Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open)) + If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息") + Catch ex As Exception + Log(ex, "整合包安装信息存在问题", LogLevel.Hint) + Exit Sub + End Try + Dim PackName As String = If(Json("name"), "") + Dim Validate As New ValidateFolderName(PathMcFolder & "versions") + If Validate.Validate(PackName) <> "" Then PackName = "" + VersionName = MyMsgBoxInput(PackName, New ObjectModel.Collection(Of Validate) From {Validate}, + Title:="输入版本名", Button2:="取消") + If String.IsNullOrEmpty(VersionName) Then Exit Sub + End If + + '启动加载器 + Dim Loader = InstallPackCurseForgeLoader(FileAddress, Archive, ArchiveBaseFolder, VersionName) + If Loader Is Nothing Then Exit Sub + Loader.Start(PathMcFolder & "versions\" & VersionName & "\") + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + If ShowRibble Then FrmMain.BtnExtraDownload.Ribble() + + End Sub + + 'HMCL + Private Sub InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) + '读取 Json 文件 + Dim Json As JObject + Try + Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8)) + Catch ex As Exception + Log(ex, "整合包安装信息存在问题", LogLevel.Hint) + Exit Sub + End Try + '获取版本名 + Dim PackName As String = If(Json("name"), "") + 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}, + Title:="输入版本名", Button2:="取消") + If VersionName Is Nothing Then Exit Sub + '解压与配置文件 + Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" + Dim InstallLoaders As New List(Of LoaderBase) + InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", + Sub(Task As LoaderTask(Of String, Integer)) + UnpackFiles(InstallTemp, FileAddress) + Task.Progress = 0.5 + '复制结果 + If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then + My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName) + Else + Log("[ModPack] 整合包中未找到 minecraft override 目录，已跳过") + End If + Task.Progress = 0.9 + '开启版本隔离 + WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) + End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s + '构造加载器 + If Json("gameVersion") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息") + Dim Request As New McInstallRequest With { + .TargetVersionName = VersionName, + .MinecraftName = Json("gameVersion").ToString + } + Dim InstallExpectTime As Double = 0 + For Each InstallLoader In InstallLoaders + InstallExpectTime += InstallLoader.ProgressWeight + Next + Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) + If MergeLoaders Is Nothing Then Exit Sub + Dim MergeExpectTime As Double = 0 + For Each MergeLoader In MergeLoaders + MergeExpectTime += MergeLoader.ProgressWeight + Next + '构造 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 Loaders As New List(Of LoaderBase) From { + New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime}, + New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime}, + New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8} + } + + '重复任务检查 + Dim LoaderName As String = "HMCL 整合包安装：" & VersionName & " " + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = LoaderName Then + Hint("该整合包正在安装中！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + + '启动 + Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} + 'If Archive IsNot Nothing Then Archive.Dispose() '解除占用，以免在加载器中触发 “正由另一进程使用，因此该进程无法访问此文件” + Loader.Start(PathMcFolder & "versions\" & VersionName & "\") + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + End Sub + + 'MMC + Private Sub InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) + '读取 Json 文件 + Dim PackJson As JObject, PackInstance As String + Try + PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8)) + PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8) + Catch ex As Exception + Log(ex, "整合包安装信息存在问题", LogLevel.Hint) + Exit Sub + End Try + '获取版本名 + Dim PackName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "") + 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}, + Title:="输入版本名", Button2:="取消") + If VersionName Is Nothing Then Exit Sub + '解压与配置文件 + Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" + Dim InstallLoaders As New List(Of LoaderBase) + InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", + Sub(Task As LoaderTask(Of String, Integer)) + UnpackFiles(InstallTemp, FileAddress) + Task.Progress = 0.5 + '复制结果 + If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then + My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName) + Else + Log("[ModPack] 整合包中未找到 override .minecraft 目录，已跳过") + End If + Task.Progress = 0.9 + '开启版本隔离 + WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) + End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s + '构造版本安装请求 + If PackJson("components") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息") + Dim Request As New McInstallRequest With {.TargetVersionName = VersionName} + For Each Component In PackJson("components") + Select Case If(Component("uid"), "").ToString + Case "org.lwjgl" + Log("[ModPack] 已跳过 LWJGL 项") + Case "net.minecraft" + Request.MinecraftName = Component("version") + Case "net.minecraftforge" + Request.ForgeVersion = Component("version") + End Select + Next + '构造加载器 + Dim InstallExpectTime As Double = 0 + For Each InstallLoader In InstallLoaders + InstallExpectTime += InstallLoader.ProgressWeight + Next + Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) + If MergeLoaders Is Nothing Then Exit Sub + Dim MergeExpectTime As Double = 0 + For Each MergeLoader In MergeLoaders + MergeExpectTime += MergeLoader.ProgressWeight + Next + '构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件） + 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 Loaders As New List(Of LoaderBase) + Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime}) + Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime}) + Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) + + '重复任务检查 + Dim LoaderName As String = "MMC 整合包安装：" & VersionName & " " + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = LoaderName Then + Hint("该整合包正在安装中！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + + '启动 + Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} + Loader.Start(PathMcFolder & "versions\" & VersionName & "\") + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + End Sub + + 'MCBBS + Private Sub InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) + '读取 Json 文件 + Dim Json As JObject + Try + Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json")) + Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8)) + Catch ex As Exception + Log(ex, "整合包安装信息存在问题", LogLevel.Hint) + Exit Sub + End Try + '获取版本名 + Dim PackName As String = If(Json("name"), "") + 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}, + Title:="输入版本名", Button2:="取消") + If VersionName Is Nothing Then Exit Sub + '解压与配置文件 + Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" + Dim InstallLoaders As New List(Of LoaderBase) + InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", + Sub(Task As LoaderTask(Of String, Integer)) + UnpackFiles(InstallTemp, FileAddress) + Task.Progress = 0.5 + '复制结果 + If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then + My.Computer.FileSystem.CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName) + Else + Log("[ModPack] 整合包中未找到 overrides 目录，已跳过") + End If + Task.Progress = 0.9 + '开启版本隔离 + WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) + End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s + '构造加载器 + If Json("addons") Is Nothing Then Throw New Exception("整合包未提供游戏版本信息") + Dim Addons As New Dictionary(Of String, String) + For Each Entry In Json("addons") + Addons.Add(Entry("id"), Entry("version")) + Next + If Not Addons.ContainsKey("game") Then Throw New Exception("整合包未提供游戏版本信息") + Dim Request As New McInstallRequest With { + .TargetVersionName = VersionName, + .MinecraftName = Addons("game"), + .OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing), + .ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing), + .FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing) + } + Dim InstallExpectTime As Double = 0 + For Each InstallLoader In InstallLoaders + InstallExpectTime += InstallLoader.ProgressWeight + Next + Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) + If MergeLoaders Is Nothing Then Exit Sub + Dim MergeExpectTime As Double = 0 + For Each MergeLoader In MergeLoaders + MergeExpectTime += MergeLoader.ProgressWeight + Next + '构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件） + 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 Loaders As New List(Of LoaderBase) + Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime}) + Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime}) + Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) + + '重复任务检查 + Dim LoaderName As String = "MCBBS 整合包安装：" & VersionName & " " + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = LoaderName Then + Hint("该整合包正在安装中！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + + '启动 + Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} + 'If Archive IsNot Nothing Then Archive.Dispose() '解除占用，以免在加载器中触发 “正由另一进程使用，因此该进程无法访问此文件” + Loader.Start(PathMcFolder & "versions\" & VersionName & "\") + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + End Sub + + '普通压缩包 + Private Sub InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) + MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹，它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True) + '获取解压路径 + Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）") + If String.IsNullOrEmpty(TargetFolder) Then Exit Sub + If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Exit Sub + If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标！", HintType.Critical) : Exit Sub + '要求显示名称 + Dim NewName As String = MyMsgBoxInput(GetFolderNameFromPath(TargetFolder), New ObjectModel.Collection(Of Validate) From { + New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"}) + },, "输入它在列表中的显示名称",, "取消") + If String.IsNullOrWhiteSpace(NewName) Then Exit Sub + '解压 + Hint("正在解压压缩包……") + UnpackFiles(TargetFolder, FileAddress) + '加入文件夹列表 + PageSelectLeft.AddFolder(TargetFolder, NewName, False) + Hint("已加入游戏文件夹列表：" & NewName, HintType.Finish) + End Sub + +#End Region + +End Module diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb new file mode 100644 index 0000000..7193328 --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb @@ -0,0 +1,361 @@ +Public Module ModWatcher + + '对全体的监视 + Public McWatcherList As New List(Of Watcher) + Private IsWatcherRunning As Boolean = False + Public HasRunningMinecraft As Boolean = False + Private Sub WatcherStateChanged() + Dim IsRunning As Boolean = False + Dim IsCrashed As Boolean = False + For Each Watcher In McWatcherList + If Watcher.State = Watcher.MinecraftState.Loading OrElse Watcher.State = Watcher.MinecraftState.Running Then + IsRunning = True + Exit For + ElseIf Watcher.State = Watcher.MinecraftState.Crashed Then + IsCrashed = True + End If + Next + If IsWatcherRunning = IsRunning Then Exit Sub + IsWatcherRunning = IsRunning + If IsWatcherRunning Then + MinecraftStart() + Else + MinecraftStop(IsCrashed) + End If + End Sub + Private Sub MinecraftStart() + McLaunchLog("[全局] 出现运行中的 Minecraft") + HasRunningMinecraft = True + FrmMain.BtnExtraShutdown.ShowRefresh() + End Sub + Private Sub MinecraftStop(HasMinecraftCrashed As Boolean) + McLaunchLog("[全局] 已无运行中的 Minecraft") + HasRunningMinecraft = False + FrmMain.BtnExtraShutdown.ShowRefresh() + '音乐播放 + If Setup.Get("UiMusicStop") Then + RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置，在结束后开始音乐播放")) + ElseIf Setup.Get("UiMusicStart") Then + RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置，在结束后暂停音乐播放")) + End If + '启动器可见性 + Select Case Setup.Get("LaunchArgumentVisible") + Case 2 + '直接关闭 + If HasMinecraftCrashed Then + RunInUi(Sub() FrmMain.Hidden = False) + Else + RunInUi(Sub() FrmMain.EndProgram(False)) + End If + Case 3 + '恢复 + RunInUi(Sub() FrmMain.Hidden = False) + End Select + End Sub + + '对单个进程的监视 + Public Class Watcher + + '初始化 + Public GameProcess As Process + Public Version As McVersion + Private WindowTitle As String = "" + Private PID As Integer + Public Loader As LoaderTask(Of Process, Integer) + Public Sub New(Loader As LoaderTask(Of Process, Integer), Version As McVersion, WindowTitle As String) + Me.Loader = Loader + Me.Version = Version + Me.WindowTitle = WindowTitle + Me.PID = Loader.Input.Id + WatcherLog("开始 Minecraft 日志监控") + If Me.WindowTitle <> "" Then WatcherLog("要求窗口标题：" & WindowTitle) + + '更改列表 + Dim NewWatcherList As New List(Of Watcher) + For Each Watch In McWatcherList + If Watch.State = MinecraftState.Crashed OrElse Watch.State = MinecraftState.Ended Then Continue For + NewWatcherList.Add(Watch) + Next + NewWatcherList.Add(Me) + McWatcherList = NewWatcherList + WatcherStateChanged() + + '初始化进程与日志读取 + Me.GameProcess = Loader.Input + GameProcess.BeginOutputReadLine() + GameProcess.BeginErrorReadLine() + AddHandler GameProcess.OutputDataReceived, AddressOf LogReceived + AddHandler GameProcess.ErrorDataReceived, AddressOf LogReceived + + '初始化时钟 + RunInNewThread(Sub() + Try + MinecraftBeforeLaunch = GetAllMinecraftWindowHandle(False).Keys.ToList + Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse Loader.State = LoadState.Aborted + TimerWindow() + TimerLog() + If State = MinecraftState.Loading Then ProgressUpdate() + '设置窗口标题 + For i = 1 To 3 + If IsWindowFinished AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then + Dim RealTitle As String = WindowTitle.Replace("{time}", Date.Now.ToShortTimeString) + SetWindowText(WindowHandle, RealTitle.ToCharArray) + End If + Thread.Sleep(64) + Next + Loop + WatcherLog("Minecraft 日志监控已退出") + Catch ex As Exception + Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback) + State = MinecraftState.Ended + End Try + End Sub, "Minecraft Watcher PID " & PID) + End Sub + + '状态 + Private _State As MinecraftState = MinecraftState.Loading + Public Property State As MinecraftState + Get + Return _State + End Get + Set(ByVal value As MinecraftState) + If _State = value Then Exit Property + _State = value + WatcherStateChanged() + End Set + End Property + Public Enum MinecraftState + Loading + Running + Crashed + Ended + End Enum + + '日志 + Public WaitingLog As New List(Of String)(1000) + Private ReadOnly WaitingLogLock As New Object + Private Sub LogReceived(sender As Object, e As DataReceivedEventArgs) + SyncLock WaitingLogLock + WaitingLog.Add(e.Data) + End SyncLock + End Sub + Private Sub TimerLog() + Try + '输出文本 + Dim Copyed As New List(Of String) + SyncLock WaitingLogLock + If WaitingLog.Count = 0 Then Exit Sub + Copyed = WaitingLog + WaitingLog = New List(Of String)(1000) + End SyncLock + For Each Str As String In Copyed + GameLog(Str) + Next + '游戏退出检查 + If GameProcess.HasExited Then + WatcherLog("Minecraft 已退出，返回值：" & GameProcess.ExitCode) + 'If Process.ExitCode = 1 Then + ' '返回值为 1，考虑是任务管理器结束 + ' WatcherLog("Minecraft 返回值为 1，考虑为任务管理器结束") '并不，崩了照样是 1 + ' State = MinecraftState.Ended + 'Else + If State = MinecraftState.Loading Then + '窗口未出现 + WatcherLog("Minecraft 尚未加载完成，可能已崩溃") + Crashed() + ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Version.ReleaseTime.Year >= 2012 Then + '返回值不为 0 且未结束 + WatcherLog("Minecraft 返回值异常，可能已崩溃") + Crashed() + Else + '正常关闭 + State = MinecraftState.Ended + End If + End If + Catch ex As Exception + Log(ex, "输出 Minecraft 日志失败", LogLevel.Feedback) + End Try + End Sub + Public LatestLog As New Queue(Of String) + Private Sub GameLog(Text As String) + '预处理 + If Text Is Nothing Then Exit Sub + Text = Text.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf) + '加入预存储 + LatestLog.Enqueue(Text) + If LatestLog.Count >= 501 Then LatestLog.Dequeue() + '进度处理 + If LogProgress < 1 Then + WatcherLog("日志 1/5：已出现日志输出") + LogProgress = 1 + End If '可能第一句就是后面需要判断的 Log（重现：启动 1.15.2 原版） + If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then + WatcherLog("日志 2/5：游戏用户已设置") '仅确保支持 Minecraft 1.7+ + LogProgress = 2 + ElseIf LogProgress < 3 AndAlso Text.ToLower.Contains("lwjgl version") Then + WatcherLog("日志 3/5：LWJGL 版本已确认") + LogProgress = 3 + ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then + WatcherLog("日志 4/5：OpenAL 已加载") '仅确保支持 Minecraft 1.7+ + LogProgress = 4 + ElseIf LogProgress < 5 AndAlso ((Text.Contains("Created") AndAlso Text.Contains("textures") AndAlso Text.Contains("-atlas")) OrElse Text.Contains("Found animation info")) Then + WatcherLog("日志 5/5：材质已加载") '仅确保支持 Minecraft 1.7+ + LogProgress = 5 + End If + '输出日志 + 'Log(Text) + '关闭与崩溃检测 + If Not Text.Contains("[CHAT]") Then + If Text.Contains("Someone is closing me!") Then + WatcherLog("识别为关闭的 Log：" & Text) + State = MinecraftState.Ended + ElseIf Text.Contains("Crash report saved to") OrElse Text.Contains("This crash report has been saved to:") Then + ' Text.Contains("Minecraft ran into a problem! Report saved to:") Then + 'Minecraft 崩溃，忽略 VanillaFix + WatcherLog("识别为崩溃的 Log：" & Text) + Crashed() + ElseIf Text.Contains("Could not save crash report to") Then + 'Minecraft 崩溃，无法保存崩溃日志 + WatcherLog("识别为崩溃的 Log：" & Text) + Crashed() + ElseIf Text.Contains("/ERROR]: Unable to launch") OrElse Text.Contains("An exception was thrown, the game will display an error screen and halt.") Then + 'Forge 崩溃 + WatcherLog("识别为崩溃的 Log：" & Text) + Crashed() + 'ElseIf Text.Contains("Shutdown failure!") Then + ' 'Minecraft 强行崩溃，由于点 X 强行关闭也会触发这句话，所以不可用 + ' Crashed(Nothing) + End If + End If + End Sub + Private Sub WatcherLog(Text As String) + McLaunchLog("[" & PID & "] " & Text) + End Sub + + '进度更新 + Private LogProgress As Integer = 0 + Private Sub ProgressUpdate() + Dim CurrentProgress As Double + If IsWindowAppeared OrElse LogProgress = 5 Then + CurrentProgress = 0.95 + WatcherLog("Minecraft 加载已完成") + State = MinecraftState.Running + Else + CurrentProgress = Math.Min(LogProgress, 3) / 3 * 0.9 + End If + Loader.Progress = CurrentProgress + End Sub + + '窗口检查 + Private IsWindowAppeared As Boolean = False + Private IsWindowFinished As Boolean = False + Private WindowHandle As IntPtr + Private MinecraftBeforeLaunch As List(Of IntPtr) + Private Sub TimerWindow() + Try + If GameProcess.HasExited Then Exit Sub + If Not IsWindowFinished Then + '获取全部窗口，检查是否有新增的 + Dim MinecraftWindows = GetAllMinecraftWindowHandle(True) + For Each Window In MinecraftBeforeLaunch + If MinecraftWindows.ContainsKey(Window) Then MinecraftWindows.Remove(Window) + Next + If MinecraftWindows.Count = 0 Then Exit Sub + '已找到窗口 + If MinecraftWindows.Values(0) Then + '已找到 Minecraft 窗口 + WindowHandle = MinecraftWindows.Keys(0) + WatcherLog("Minecraft 窗口已加载：" & WindowHandle.ToInt64) + IsWindowFinished = True + '最大化 + Thread.Sleep(3000) '1.7.10 LiteLoader 不延迟会显示错误 + If Setup.Get("LaunchArgumentWindowType") = 4 Then ShowWindow(WindowHandle, 3) + ElseIf Not IsWindowAppeared Then + '已找到 FML 窗口 + WatcherLog("FML 窗口已加载：" & MinecraftWindows.Keys(0).ToInt64) + End If + IsWindowAppeared = True + End If + Catch ex As Exception + Log(ex, "检查 Minecraft 窗口失败", LogLevel.Feedback) + End Try + End Sub + ''' + ''' 获取所有 Minecraft 窗口句柄。 + ''' Value: 是否为 Minecraft 窗口，而不是 FML 窗口。 + ''' + ''' 是否包含 FML 窗口 + Private Function GetAllMinecraftWindowHandle(CanUseFml As Boolean) As Dictionary(Of IntPtr, Boolean) + Dim AllList As New Dictionary(Of IntPtr, Boolean) + EnumWindows(Sub(hwnd As IntPtr, lParam As Integer) + '检查类名 + 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 + '检查窗口标题名 + str = New StringBuilder(512) + GetWindowText(hwnd, str, str.Capacity) + Dim WindowText As String = str.ToString + If CanUseFml AndAlso WindowText.StartsWith("FML") Then + AllList.Add(hwnd, False) + ElseIf Not (WindowText.StartsWith("GLFW") OrElse WindowText = "PopupMessageWindow") Then + '有的 Mod 可以修改窗口标题，不能检测是否为 Minecraft 打头 + '部分版本会搞个 GLFW message window 出来所以得反选 + AllList.Add(hwnd, True) + End If + 'If WindowText.StartsWith("Minecraft") Then + ' AllList.Add(hwnd, True) + 'ElseIf CanUseFml AndAlso WindowText.StartsWith("FML") Then + ' AllList.Add(hwnd, False) + 'End If + End Sub, 0) + Return AllList + End Function + Private Delegate Sub EnumWindowsSub(hwnd As IntPtr, lParam As Integer) + Private Declare Function EnumWindows Lib "user32" (hWnd As EnumWindowsSub, lParam As Integer) As Boolean + Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (hWnd As Integer, str As StringBuilder, maxCount As Integer) As Integer + Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (hWnd As Integer, str As StringBuilder, maxCount As Integer) As Integer + Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (hWnd As Integer, str As String) As Boolean + Private Declare Function ShowWindow Lib "user32" (hWnd As IntPtr, cmdWindow As UInteger) As Boolean + + '崩溃处理 + Private Sub Crashed() + If State = MinecraftState.Crashed OrElse State = MinecraftState.Ended Then Exit Sub + State = MinecraftState.Crashed + '崩溃分析 + WatcherLog("Minecraft 已崩溃，将在 2 秒后开始崩溃分析") + Hint("检测到 Minecraft 出现错误，错误分析已开始……") + RunInNewThread(Sub() + Try + Thread.Sleep(2000) + WatcherLog("崩溃分析开始") + Dim Analyzer As New CrashAnalyzer(PID) + Analyzer.Collect(Version.PathIndie, LatestLog.ToList) + Analyzer.Prepare() + Analyzer.Analyze(Version) + Analyzer.Output(False, New List(Of String) From + {Version.Path & Version.Name & ".json", + Path & "PCL\Log1.txt", + Path & "PCL\LatestLaunch.bat"}) + Catch ex As Exception + Log(ex, "崩溃分析失败", LogLevel.Feedback) + End Try + End Sub, "Crash Analyzer") + End Sub + + '强制关闭 + Public Sub Kill() + State = MinecraftState.Ended + WatcherLog("尝试强制结束 Minecraft 进程") + Try + If Not GameProcess.HasExited Then GameProcess.Kill() + WatcherLog("已强制结束 Minecraft 进程") + Catch ex As Exception + Log(ex, "强制结束 Minecraft 进程失败", LogLevel.Hint) + End Try + End Sub + + End Class + +End Module diff --git a/Plain Craft Launcher 2/Modules/ModEvent.vb b/Plain Craft Launcher 2/Modules/ModEvent.vb new file mode 100644 index 0000000..40e090d --- /dev/null +++ b/Plain Craft Launcher 2/Modules/ModEvent.vb @@ -0,0 +1,173 @@ +Public Module ModEvent + + Public Sub TryStartEvent(Type As String, Data As String) + If String.IsNullOrWhiteSpace(Type) Then Exit Sub + Dim RealData As String() = {""} + If Data IsNot Nothing Then RealData = Data.Split("|") + StartEvent(Type, RealData) + End Sub + Public Sub StartEvent(Type As String, Data As String()) + Try + Log("[Control] 执行自定义事件：" & Type & ", " & Join(Data, ", ")) + Select Case Type + + Case "打开网页" + Data(0) = Data(0).Replace("\", "/") + If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then + MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "如果想要启动程序，请将 EventType 改为 打开文件。", "事件执行失败") + Exit Sub + End If + Hint("正在打开网页，请稍候……") + OpenWebsite(Data(0)) + + Case "打开文件", "打开帮助" + RunInThread(Sub() + Try + + '确认实际路径 + Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type) + Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1) + + '执行 + If Type = "打开文件" Then + Dim Info As New ProcessStartInfo With { + .Arguments = If(Data.Length >= 2, Data(1), ""), + .FileName = Location, + .WorkingDirectory = WorkingDir + } + Process.Start(Info) + Else '打开帮助 + PageOtherHelp.EnterHelpPage(Location) + End If + + Catch ex As Exception + Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox) + End Try + End Sub) + Case "启动游戏" + + '初始化与前置条件检测 + If Not (FrmLaunchLeft.BtnLaunch.IsEnabled AndAlso FrmLaunchLeft.BtnLaunch.Visibility = Visibility.Visible AndAlso FrmLaunchLeft.BtnLaunch.IsHitTestVisible) Then + Hint("已有游戏正在启动中！", HintType.Critical) : Exit Sub + End If + If Not Directory.Exists(PathMcFolder & "versions\" & Data(0)) Then + Hint("未在当前 Minecraft 文件夹找到版本 " & Data(0) & "！", HintType.Critical) : Exit Sub + End If + Dim ButtonVersion As New McVersion(Data(0)) + ButtonVersion.Load() + If ButtonVersion.State = McVersionState.Error Then + Hint("无法启动 " & Data(0) & "：" & ButtonVersion.Info, HintType.Critical) : Exit Sub + End If + + '实际启动 + McVersionCurrent = ButtonVersion + Setup.Set("LaunchVersionSelect", McVersionCurrent.Name) + FrmLaunchLeft.PageLaunchLeft_Loaded() + FrmLaunchLeft.RefreshButtonsUI() + FrmMain.AprilGiveup() + FrmLaunchLeft.LaunchButtonClick(If(Data.Length >= 2, Data(1), "")) + FrmMain.PageChange(FormMain.PageType.Launch) + + Case "复制文本" + ClipboardSet(Join(Data, "|")) + + Case "刷新主页" + FrmLaunchRight.ForceRefresh() + + Case "刷新帮助" + PageOtherLeft.RefreshHelp() + + Case "弹出窗口" + MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf)) + + Case "下载文件" + Data(0) = Data(0).Replace("\", "/") + If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then + MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL2 不支持其他乱七八糟的协议。", "事件执行失败") + Exit Sub + End If + PageOtherTest.StartCustomDownload(Data(0)) + + Case Else + MyMsgBox("未知的事件类型：" & Type & vbCrLf & "请检查事件类型填写是否正确，或者 PCL2 是否为最新版本。", "事件执行失败") + End Select + Catch ex As Exception + Log(ex, "事件执行失败", LogLevel.Msgbox) + End Try + End Sub + + ''' + ''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。 + ''' 失败会抛出异常。 + ''' + Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String() + + '网页确认 + If RelativeUrl.ToLower.StartsWith("http") Then + If RunInUi() Then + Throw New Exception("MyListItem 在界面初始化时就需要获取帮助标题等信息，这会导致程序在网络请求时卡死。" & vbCrLf & + "因此，请换用 MyListItem 以外的控件（例如 MyButton）作为联网帮助页面的入口！") + End If + '获取文件名 + Dim RawFileName As String + Try + RawFileName = GetFileNameFromPath(RelativeUrl) + If Not RawFileName.ToLower.EndsWith(".json") Then Throw New Exception("未指向 .json 后缀的文件") + Catch ex As Exception + Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件，并在同路径下包含相应 XAML 文件！" & vbCrLf & + "例如：" & vbCrLf & + " - https://www.baidu.com/test.json（填写这个路径）" & vbCrLf & + " - https://www.baidu.com/test.xaml（同时也需要包含这个文件）", ex) + End Try + '下载文件 + Dim LocalTemp1 As String = PathTemp & "CustomEvent\" & RawFileName + Dim LocalTemp2 As String = PathTemp & "CustomEvent\" & RawFileName.Replace(".json", ".xaml") + Log("[Event] 转换网络资源：" & RelativeUrl & " -> " & LocalTemp1) + Hint("正在获取资源，请稍候……") + Try + NetDownload(RelativeUrl, LocalTemp1) + NetDownload(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml")) + Catch ex As Exception + Throw New Exception("下载指定的文件失败！" & vbCrLf & + "注意，联网帮助页面须指向一个帮助 JSON 文件，并在同路径下包含相应 XAML 文件！" & vbCrLf & + "例如：" & vbCrLf & + " - https://www.baidu.com/test.json（填写这个路径）" & vbCrLf & + " - https://www.baidu.com/test.xaml（同时也需要包含这个文件）", ex) + End Try + RelativeUrl = LocalTemp1 + End If + RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\") + + '确认实际路径 + Dim Location As String, WorkingDir As String = Path & "PCL" + If RelativeUrl.Contains(":\") Then + '绝对路径 + Location = RelativeUrl + Log("[Control] 自定义事件中由绝对路径" & EventType & "：" & Location) + ElseIf File.Exists(Path & "PCL\" & RelativeUrl) Then + '相对 PCL 文件夹的路径 + Location = Path & "PCL\" & RelativeUrl + Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & EventType & "：" & Location) + ElseIf File.Exists(Path & "PCL\Help\" & RelativeUrl) Then + '相对 PCL 本地帮助文件夹的路径 + Location = Path & "PCL\Help\" & RelativeUrl + WorkingDir = Path & "PCL\Help\" + Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & EventType & "：" & Location) + ElseIf EventType = "打开帮助" AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then + '相对 PCL 自带帮助文件夹的路径 + Location = PathTemp & "Help\" & RelativeUrl + WorkingDir = PathTemp & "Help\" + Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & "：" & Location) + ElseIf EventType = "打开文件" Then + '直接使用原有路径启动程序 + Location = RelativeUrl + Log("[Control] 自定义事件中直接" & EventType & "：" & Location) + Else + '打开帮助，但是格式不对劲 + Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件：" & RelativeUrl, RelativeUrl) + End If + + Return {Location, WorkingDir} + End Function + +End Module diff --git a/Plain Craft Launcher 2/Modules/ModMusic.vb b/Plain Craft Launcher 2/Modules/ModMusic.vb new file mode 100644 index 0000000..2dbb31e --- /dev/null +++ b/Plain Craft Launcher 2/Modules/ModMusic.vb @@ -0,0 +1,286 @@ +Public Module ModMusic + +#Region "播放列表" + + ''' + ''' 接下来要播放的音乐文件路径。未初始化时为 Nothing。 + ''' + Public MusicToplayList As List(Of String) = Nothing + ''' + ''' 全部音乐文件路径。未初始化时为 Nothing。 + ''' + Public MusicAllList As List(Of String) = Nothing + ''' + ''' 初始化音乐播放列表。 + ''' + ''' 强制全部重新载入列表。 + ''' 在重载列表时避免让某项成为第一项。 + Private Sub MusicListInit(ForceReload As Boolean, Optional IgnoreFirst As String = "") + If ForceReload Then MusicAllList = Nothing + Try + '初始化全部可用音乐列表 + If MusicAllList Is Nothing Then + MusicAllList = New List(Of String) + Directory.CreateDirectory(Path & "PCL\Musics\") + For Each File In My.Computer.FileSystem.GetFiles(Path & "PCL\Musics\", FileIO.SearchOption.SearchAllSubDirectories, "*.*") + '文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的 + Dim Extend As String = File.Split(".").Last.ToLower + If Not (Extend = "ini" OrElse Extend = "jpg" OrElse Extend = "txt" OrElse Extend = "cfg" OrElse Extend = "png") Then + MusicAllList.Add(File) + End If + Next + End If + '打乱顺序播放 + MusicToplayList = RandomChaos(New List(Of String)(MusicAllList)) + If Not IgnoreFirst = "" AndAlso Not MusicToplayList.Count = 0 AndAlso MusicToplayList(0) = IgnoreFirst Then + '若需要避免成为第一项的为第一项，则将它放在最后 + MusicToplayList.RemoveAt(0) + MusicToplayList.Add(IgnoreFirst) + End If + Catch ex As Exception + Log(ex, "初始化音乐列表失败", LogLevel.Feedback) + End Try + End Sub + ''' + ''' 获取下一首播放的音乐路径并将其从列表中移除。 + ''' + Private Function DequeueNextMusicAddress() As String + '初始化，确保存在音乐 + If MusicAllList Is Nothing Then MusicListInit(False) + If MusicAllList.Count = 0 Then Throw New Exception("在没有音乐时尝试获取音乐路径") + '出列下一个音乐，如果出列结束则生成新列表 + DequeueNextMusicAddress = MusicToplayList(0) + MusicToplayList.RemoveAt(0) + If MusicToplayList.Count = 0 Then MusicListInit(False, DequeueNextMusicAddress) + End Function + +#End Region + +#Region "UI 控制" + + ''' + ''' 刷新背景音乐按钮 UI 与设置页 UI。 + ''' + Private Sub MusicRefreshUI() + RunInUi(Sub() + Try + + If MusicAllList.Count = 0 Then + '无背景音乐 + FrmMain.BtnExtraMusic.Show = False + Else + '有背景音乐 + FrmMain.BtnExtraMusic.Show = True + + Dim ToolTipText As String = "正在播放：" & GetFileNameWithoutExtentionFromPath(MusicCurrent) + If MusicState = MusicStates.Pause Then + FrmMain.BtnExtraMusic.Logo = Logo.IconPlay + FrmMain.BtnExtraMusic.LogoScale = 0.8 + If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键播放，右键播放下一曲。" + Else + FrmMain.BtnExtraMusic.Logo = Logo.IconMusic + FrmMain.BtnExtraMusic.LogoScale = 1 + If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。" + End If + FrmMain.BtnExtraMusic.ToolTip = ToolTipText + ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16)) + End If + If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI() + + Catch ex As Exception + Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback) + End Try + End Sub) + End Sub + + ''' + ''' 让音乐在暂停、播放间切换，并显示提示文本。 + ''' + Public Sub MusicControlPause() + If MusicNAudio Is Nothing Then + Hint("音乐播放尚未开始！", HintType.Critical) + Else + Select Case MusicState + Case MusicStates.Pause + MusicResume() + Case MusicStates.Play + MusicPause() + Case Else + Hint("音乐目前为停止状态！", HintType.Critical) + End Select + End If + End Sub + + ''' + ''' 播放下一曲，并显示提示文本。 + ''' + Public Sub MusicControlNext() + If MusicAllList.Count = 1 Then + Hint("播放列表中仅有一首歌曲！") + Else + Dim Address As String = DequeueNextMusicAddress() + MusicStartPlay(Address) + Hint("正在播放：" & GetFileNameFromPath(Address), HintType.Finish) + MusicRefreshUI() + End If + End Sub + +#End Region + +#Region "主状态控制" + + ''' + ''' 获取当前的音乐播放状态。 + ''' + Public ReadOnly Property MusicState As MusicStates + Get + If MusicNAudio Is Nothing Then Return MusicStates.Stop + Select Case MusicNAudio.PlaybackState + Case 0 'NAudio.Wave.PlaybackState.Stopped + Return MusicStates.Stop + Case 2 'NAudio.Wave.PlaybackState.Paused + Return MusicStates.Pause + Case Else + Return MusicStates.Play + End Select + End Get + End Property + Public Enum MusicStates + [Stop] + Play + Pause + End Enum + + '重载与开始 + + ''' + ''' 重载播放列表并尝试开始播放背景音乐。 + ''' + ''' 是否显示刷新提示。 + Public Sub MusicRefreshPlay(ShowHint As Boolean, Optional IsFirstLoad As Boolean = False) + Try + + MusicListInit(True) + If MusicAllList.Count = 0 Then + If MusicNAudio Is Nothing Then + If ShowHint Then Hint("未检测到可用的背景音乐！", HintType.Critical) + Else + MusicNAudio = Nothing + If ShowHint Then Hint("背景音乐已清除！", HintType.Finish) + End If + Else + Dim Address As String = DequeueNextMusicAddress() + Try + MusicStartPlay(Address, IsFirstLoad) + If ShowHint Then Hint("背景音乐已刷新：" & GetFileNameFromPath(Address), HintType.Finish, False) + Catch + End Try + End If + MusicRefreshUI() + + Catch ex As Exception + Log(ex, "刷新背景音乐播放失败", LogLevel.Feedback) + End Try + End Sub + ''' + ''' 开始播放音乐。 + ''' + Private Sub MusicStartPlay(Address As String, Optional IsFirstLoad As Boolean = False) + Log("[Music] 播放开始：" & Address) + RunInNewThread(Sub() MusicLoop(Address, IsFirstLoad), "Music", ThreadPriority.BelowNormal) + End Sub + + '播放与暂停 + + ''' + ''' 暂停音乐播放，返回是否成功切换了状态。 + ''' + Public Function MusicPause() As Boolean + If MusicState = MusicStates.Play Then + RunInThread(Sub() + MusicNAudio.Pause() + MusicRefreshUI() + Log("[Music] 已暂停播放") + End Sub) + Return True + Else + Return False + End If + End Function + ''' + ''' 继续音乐播放，返回是否成功切换了状态。 + ''' + Public Function MusicResume() As Boolean + If MusicState = MusicStates.Pause Then + RunInThread(Sub() + MusicNAudio.Play() + MusicRefreshUI() + Log("[Music] 已恢复播放") + End Sub) + Return True + Else + Return False + End If + End Function + +#End Region + + ''' + ''' 当前正在播放的 NAudio.Wave.WaveOut。 + ''' + Public MusicNAudio = Nothing + ''' + ''' 当前播放的音乐地址。 + ''' + Private MusicCurrent As String = "" + + ''' + ''' 在 MusicUuid 不变的前提下，持续播放某地址的音乐，且在播放结束后随机播放下一曲。 + ''' + Private Sub MusicLoop(Address As String, Optional IsFirstLoad As Boolean = False) + MusicCurrent = Address + Dim CurrentWave As NAudio.Wave.WaveOut = Nothing + Dim Reader As NAudio.Wave.WaveStream = Nothing + Try + '开始播放 + CurrentWave = New NAudio.Wave.WaveOut() + MusicNAudio = CurrentWave + Reader = New NAudio.Wave.AudioFileReader(Address) + CurrentWave.Init(Reader) + CurrentWave.Play() + '第一次打开的暂停 + If IsFirstLoad AndAlso Not Setup.Get("UiMusicAuto") Then CurrentWave.Pause() + MusicRefreshUI() + '停止条件：播放完毕或变化 + Dim PreviousVolume = 0 + While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped + If Setup.Get("UiMusicVolume") <> PreviousVolume Then + '更新音量 + PreviousVolume = Setup.Get("UiMusicVolume") + CurrentWave.Volume = PreviousVolume / 1000 + End If + Thread.Sleep(50) + End While + '当前音乐已播放结束，继续下一曲 + If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress) + Catch ex As Exception + If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then + Hint("播放音乐失败（" & GetFileNameFromPath(Address) & "）：PCL2 不支持播放音频属性在中途发生变化的音乐", HintType.Critical) + ElseIf Not (Address.ToLower.EndsWith(".wav") OrElse Address.ToLower.EndsWith(".mp3") OrElse Address.ToLower.EndsWith(".flac")) Then + Hint("播放音乐失败（" & GetFileNameFromPath(Address) & "）：PCL2 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical) + Else + Log(ex, "播放音乐失败（" & GetFileNameFromPath(Address) & "）", LogLevel.Hint) + End If + Log(ex, "播放音乐失败（" & Address & "）", LogLevel.Developer) + If MusicAllList.Count > 1 Then + Thread.Sleep(1000) + MusicStartPlay(DequeueNextMusicAddress) + End If + Finally + If CurrentWave IsNot Nothing Then CurrentWave.Dispose() + If Reader IsNot Nothing Then Reader.Dispose() + MusicRefreshUI() + End Try + End Sub + +End Module diff --git a/Plain Craft Launcher 2/Modules/Reference/CookieWebClient.vb b/Plain Craft Launcher 2/Modules/Reference/CookieWebClient.vb new file mode 100644 index 0000000..17ea092 --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Reference/CookieWebClient.vb @@ -0,0 +1,59 @@ +Imports System.Net + +Public Class CookieWebClient + Inherits WebClient + + Public Sub New(container As CookieContainer, Headers As Dictionary(Of String, String)) + Me.New(container) + For Each keyVal In Headers + Me.Headers(keyVal.Key) = keyVal.Value + Next + End Sub + + Public Sub New() + Me.New(New CookieContainer()) + End Sub + + Public Sub New(container As CookieContainer) + Me.container = container + End Sub + + Private Shadows ReadOnly container As New CookieContainer() + + ''' + ''' 以毫秒为单位的超时。 + ''' + Public Timeout As Integer = 600000 + + Protected Overrides Function GetWebRequest(ByVal address As Uri) As WebRequest + Dim r As WebRequest = MyBase.GetWebRequest(address) + Dim request = TryCast(r, HttpWebRequest) + + If request IsNot Nothing Then + request.CookieContainer = container + request.Timeout = Timeout + End If + + Return r + End Function + + Protected Overrides Function GetWebResponse(ByVal request As WebRequest, ByVal result As IAsyncResult) As WebResponse + Dim response As WebResponse = MyBase.GetWebResponse(request, result) + ReadCookies(response) + Return response + End Function + + Protected Overrides Function GetWebResponse(ByVal request As WebRequest) As WebResponse + Dim response As WebResponse = MyBase.GetWebResponse(request) + ReadCookies(response) + Return response + End Function + + Private Sub ReadCookies(ByVal r As WebResponse) + Dim response = TryCast(r, HttpWebResponse) + If response IsNot Nothing Then + Dim cookies As CookieCollection = response.Cookies + container.Add(cookies) + End If + End Sub +End Class diff --git a/Plain Craft Launcher 2/Modules/Reference/PresentationFramework.Aero/SystemDropShadowChrome.vb b/Plain Craft Launcher 2/Modules/Reference/PresentationFramework.Aero/SystemDropShadowChrome.vb new file mode 100644 index 0000000..6e103cf --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Reference/PresentationFramework.Aero/SystemDropShadowChrome.vb @@ -0,0 +1,299 @@ +Public NotInheritable Class SystemDropShadowChrome + 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))) + Public Property Color As Color + Get + Return CType(GetValue(ColorProperty), Color) + End Get + Set(value As Color) + SetValue(ColorProperty, value) + End Set + End Property + + 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)) + Public Property CornerRadius As CornerRadius + Get + Return CType(GetValue(CornerRadiusProperty), CornerRadius) + 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) + 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 + + 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 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 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 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 + 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) + drawingContext.DrawRectangle(brushes(Placement.Top), Nothing, top) + End If + + Dim topRight As New Rect(guidelineSetX(2), shadowBounds.Top, cornerRadius.TopRight, cornerRadius.TopRight) + drawingContext.DrawRectangle(brushes(Placement.TopRight), Nothing, topRight) + Dim leftHeight As Double = guidelineSetY(3) - guidelineSetY(1) + + If leftHeight > 0 Then + Dim left As New Rect(shadowBounds.Left, guidelineSetY(1), ShadowDepth, 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) + drawingContext.DrawRectangle(brushes(Placement.Right), Nothing, right) + End If + + Dim bottomLeft As New Rect(shadowBounds.Left, guidelineSetY(3), cornerRadius.BottomLeft, cornerRadius.BottomLeft) + drawingContext.DrawRectangle(brushes(Placement.BottomLeft), Nothing, bottomLeft) + Dim bottomWidth As Double = guidelineSetX(4) - guidelineSetX(3) + + If bottomWidth > 0 Then + Dim bottom As New Rect(guidelineSetX(3), guidelineSetY(5), bottomWidth, ShadowDepth) + 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 + 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 + 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)) + Else + figure.StartPoint = New Point(guidelineSetX(0), guidelineSetY(0)) + End If + + If cornerRadius.BottomLeft > ShadowDepth 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)) + Else + figure.Segments.Add(New LineSegment(New Point(guidelineSetX(0), guidelineSetY(5)), True)) + End If + + If cornerRadius.BottomRight > ShadowDepth 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)) + Else + figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(5)), True)) + End If + + If cornerRadius.TopRight > ShadowDepth 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)) + Else + figure.Segments.Add(New LineSegment(New Point(guidelineSetX(5), guidelineSetY(0)), True)) + End If + + figure.IsClosed = True + figure.Freeze() + Dim geometry As New PathGeometry() + geometry.Figures.Add(figure) + geometry.Freeze() + drawingContext.DrawGeometry(brushes(Placement.Center), Nothing, geometry) + End If + + drawingContext.Pop() + End If + End Sub + + Private Enum Placement + TopLeft = 0 + Top = 1 + TopRight = 2 + Left = 3 + Center = 4 + Right = 5 + BottomLeft = 6 + Bottom = 7 + BottomRight = 8 + End Enum + Private Shared _commonBrushes As Brush() + Private Shared _commonCornerRadius As CornerRadius + Private Shared ReadOnly _resourceAccess As New Object() + Private _brushes As Brush() + + Private Shared Sub ClearBrushes(o As DependencyObject, e As DependencyPropertyChangedEventArgs) + CType(o, SystemDropShadowChrome)._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) + } + Dim stopColor As Color = c + stopColor.A = CByte(0.74336 * c.A) + gsc.Add(New GradientStop(stopColor, (1.5 + cornerRadius) * gradientScale)) + stopColor.A = CByte(0.38053 * c.A) + gsc.Add(New GradientStop(stopColor, (2.5 + cornerRadius) * gradientScale)) + stopColor.A = CByte(0.12389 * c.A) + gsc.Add(New GradientStop(stopColor, (3.5 + cornerRadius) * gradientScale)) + stopColor.A = CByte(0.02654 * c.A) + gsc.Add(New GradientStop(stopColor, (4.5 + cornerRadius) * gradientScale)) + stopColor.A = 0 + gsc.Add(New GradientStop(stopColor, (5 + cornerRadius) * gradientScale)) + gsc.Freeze() + Return gsc + End Function + Private Shared 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() + Dim sideStops As GradientStopCollection = CreateStops(c, 0) + Dim top As New LinearGradientBrush(sideStops, New Point(0, 1), New Point(0, 0)) + top.Freeze() + brushes(Placement.Top) = top + Dim left As New LinearGradientBrush(sideStops, New Point(1, 0), New Point(0, 0)) + left.Freeze() + brushes(Placement.Left) = left + Dim right As New LinearGradientBrush(sideStops, New Point(0, 0), New Point(1, 0)) + right.Freeze() + brushes(Placement.Right) = right + Dim bottom As New LinearGradientBrush(sideStops, New Point(0, 0), New Point(0, 1)) + bottom.Freeze() + brushes(Placement.Bottom) = bottom + Dim topLeftStops As GradientStopCollection + + If cornerRadius.TopLeft = 0 Then + topLeftStops = sideStops + Else + topLeftStops = CreateStops(c, cornerRadius.TopLeft) + End If + + Dim topLeft As New RadialGradientBrush(topLeftStops) With { + .RadiusX = 1, + .RadiusY = 1, + .Center = New Point(1, 1), + .GradientOrigin = New Point(1, 1) + } + topLeft.Freeze() + brushes(Placement.TopLeft) = topLeft + Dim topRightStops As GradientStopCollection + + If cornerRadius.TopRight = 0 Then + topRightStops = sideStops + ElseIf cornerRadius.TopRight = cornerRadius.TopLeft Then + topRightStops = topLeftStops + Else + topRightStops = CreateStops(c, cornerRadius.TopRight) + End If + + Dim topRight As New RadialGradientBrush(topRightStops) With { + .RadiusX = 1, + .RadiusY = 1, + .Center = New Point(0, 1), + .GradientOrigin = New Point(0, 1) + } + topRight.Freeze() + brushes(Placement.TopRight) = topRight + Dim bottomLeftStops As GradientStopCollection + + If cornerRadius.BottomLeft = 0 Then + bottomLeftStops = sideStops + ElseIf cornerRadius.BottomLeft = cornerRadius.TopLeft Then + bottomLeftStops = topLeftStops + ElseIf cornerRadius.BottomLeft = cornerRadius.TopRight Then + bottomLeftStops = topRightStops + Else + bottomLeftStops = CreateStops(c, cornerRadius.BottomLeft) + End If + + Dim bottomLeft As New RadialGradientBrush(bottomLeftStops) With { + .RadiusX = 1, + .RadiusY = 1, + .Center = New Point(1, 0), + .GradientOrigin = New Point(1, 0) + } + bottomLeft.Freeze() + brushes(Placement.BottomLeft) = bottomLeft + Dim bottomRightStops As GradientStopCollection + + If cornerRadius.BottomRight = 0 Then + bottomRightStops = sideStops + ElseIf cornerRadius.BottomRight = cornerRadius.TopLeft Then + bottomRightStops = topLeftStops + ElseIf cornerRadius.BottomRight = cornerRadius.TopRight Then + bottomRightStops = topRightStops + ElseIf cornerRadius.BottomRight = cornerRadius.BottomLeft Then + bottomRightStops = bottomLeftStops + Else + bottomRightStops = CreateStops(c, cornerRadius.BottomRight) + End If + + Dim bottomRight As New RadialGradientBrush(bottomRightStops) With { + .RadiusX = 1, + .RadiusY = 1, + .Center = New Point(0, 0), + .GradientOrigin = New Point(0, 0) + } + bottomRight.Freeze() + brushes(Placement.BottomRight) = bottomRight + Return brushes + End Function + Private Function GetBrushes(c As Color, cornerRadius As CornerRadius) As Brush() + If _commonBrushes Is Nothing Then + + SyncLock _resourceAccess + + If _commonBrushes Is Nothing Then + _commonBrushes = CreateBrushes(c, cornerRadius) + _commonCornerRadius = cornerRadius + End If + End SyncLock + End If + + If c = CType(_commonBrushes(Placement.Center), SolidColorBrush).Color AndAlso cornerRadius = _commonCornerRadius Then + _brushes = Nothing + Return _commonBrushes + ElseIf _brushes Is Nothing Then + _brushes = CreateBrushes(c, cornerRadius) + End If + + Return _brushes + End Function + +End Class diff --git a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb new file mode 100644 index 0000000..450a0b8 --- /dev/null +++ b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb @@ -0,0 +1,56 @@ +Imports System.Reflection +Imports System.Resources +Imports System.Runtime.InteropServices + +' 有关程序集的一般信息由以下 +' 控制。更改这些特性值可修改 +' 与程序集关联的信息。 + +'查看程序集特性的值 + + + + + + + + + +'若要开始生成可本地化的应用程序，请设置 +'在您的 .vbproj 文件中的 内设置 CultureYouAreCodingWith。 +'例如，如果您在源文件中使用的是美国英语， +'请将 设置为“en-US”。 然后取消下面对 +'NeutralResourceLanguage 特性的注释。 更新下面行中的“en-US” +'以与项目文件中的 UICulture 设置匹配。 + +' + + +'ThemeInfo 特性说明在何处可以找到任何特定于主题的和一般性的资源词典。 +'第一个参数: 特定于主题的资源词典的位置 +'(未在页面中找到资源时使用， +'或应用程序资源字典中找到时使用) + +'第二个参数: 一般性资源词典的位置 +'(未在页面中找到资源时使用， +'资源词典中找到资源时使用) + + + + +'如果此项目向 COM 公开，则下列 GUID 用于类型库的 ID + + +' 程序集的版本信息由下列四个值组成: +' +' 主版本 +' 次版本 +' 生成号 +' 修订号 +' +' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号 +' 方法是按如下所示使用“*” + + + + diff --git a/Plain Craft Launcher 2/My Project/MyExtensions/MyWpfExtension.vb b/Plain Craft Launcher 2/My Project/MyExtensions/MyWpfExtension.vb new file mode 100644 index 0000000..0c9a2be --- /dev/null +++ b/Plain Craft Launcher 2/My Project/MyExtensions/MyWpfExtension.vb @@ -0,0 +1,121 @@ +#If _MyType <> "Empty" Then + +Namespace My + ''' + ''' 用于定义“我的 WPF 命名空间”中的可用属性的模块 + ''' + ''' + _ + Module MyWpfExtension + Private s_Computer As New ThreadSafeObjectProvider(Of Global.Microsoft.VisualBasic.Devices.Computer) + Private s_User As New ThreadSafeObjectProvider(Of Global.Microsoft.VisualBasic.ApplicationServices.User) + Private s_Windows As New ThreadSafeObjectProvider(Of MyWindows) + Private s_Log As New ThreadSafeObjectProvider(Of Global.Microsoft.VisualBasic.Logging.Log) + ''' + ''' 返回正在运行的应用程序的应用程序对象 + ''' + + Friend ReadOnly Property Application() As Application + Get + Return CType(Global.System.Windows.Application.Current, Application) + End Get + End Property + ''' + ''' 返回有关主机计算机的信息。 + ''' + + Friend ReadOnly Property Computer() As Global.Microsoft.VisualBasic.Devices.Computer + Get + Return s_Computer.GetInstance() + End Get + End Property + ''' + ''' 返回当前用户的信息。 如果希望使用当前的 + ''' Windows 用户凭据来运行应用程序，请调用 My.User.InitializeWithWindowsUser()。 + ''' + + Friend ReadOnly Property User() As Global.Microsoft.VisualBasic.ApplicationServices.User + Get + Return s_User.GetInstance() + End Get + End Property + ''' + ''' 返回应用程序日志。可以使用应用程序的配置文件配置侦听器。 + ''' + + Friend ReadOnly Property Log() As Global.Microsoft.VisualBasic.Logging.Log + Get + Return s_Log.GetInstance() + End Get + End Property + + ''' + ''' 返回项目中定义的 Windows 集合。 + ''' + + Friend ReadOnly Property Windows() As MyWindows + + Get + Return s_Windows.GetInstance() + End Get + End Property + + + Friend NotInheritable Class MyWindows + + Private Shared Function Create__Instance__(Of T As {New, Global.System.Windows.Window})(Instance As T) As T + If Instance Is Nothing Then + If s_WindowBeingCreated IsNot Nothing Then + If s_WindowBeingCreated.ContainsKey(GetType(T)) = True Then + Throw New Global.System.InvalidOperationException("The window cannot be accessed via My.Windows from the Window constructor.") + End If + Else + s_WindowBeingCreated = New Global.System.Collections.Hashtable() + End If + s_WindowBeingCreated.Add(GetType(T), Nothing) + Return New T() + s_WindowBeingCreated.Remove(GetType(T)) + Else + Return Instance + End If + End Function + + + Private Sub Dispose__Instance__(Of T As Global.System.Windows.Window)(ByRef instance As T) + instance = Nothing + End Sub + + + Public Sub New() + MyBase.New() + End Sub + Private Shared s_WindowBeingCreated As Global.System.Collections.Hashtable + Public Overrides Function Equals(o As Object) As Boolean + Return MyBase.Equals(o) + End Function + Public Overrides Function GetHashCode() As Integer + Return MyBase.GetHashCode + End Function + + + Friend Overloads Function [GetType]() As Global.System.Type + Return GetType(MyWindows) + End Function + Public Overrides Function ToString() As String + Return MyBase.ToString + End Function + End Class + End Module +End Namespace +Partial Class Application + Inherits Global.System.Windows.Application + _ + _ + Friend ReadOnly Property Info() As Global.Microsoft.VisualBasic.ApplicationServices.AssemblyInfo + _ + Get + Return New Global.Microsoft.VisualBasic.ApplicationServices.AssemblyInfo(Global.System.Reflection.Assembly.GetExecutingAssembly()) + End Get + End Property +End Class +#End If \ No newline at end of file diff --git a/Plain Craft Launcher 2/My Project/Resources.Designer.vb b/Plain Craft Launcher 2/My Project/Resources.Designer.vb new file mode 100644 index 0000000..efcc395 --- /dev/null +++ b/Plain Craft Launcher 2/My Project/Resources.Designer.vb @@ -0,0 +1,153 @@ +'------------------------------------------------------------------------------ +' +' 此代码由工具生成。 +' 运行时版本:4.0.30319.42000 +' +' 对此文件的更改可能会导致不正确的行为，并且如果 +' 重新生成代码，这些更改将会丢失。 +' +'------------------------------------------------------------------------------ + +Option Strict On +Option Explicit On + +Imports System + +Namespace My.Resources + + '此类是由 StronglyTypedResourceBuilder + '类通过类似于 ResGen 或 Visual Studio 的工具自动生成的。 + '若要添加或移除成员，请编辑 .ResX 文件，然后重新运行 ResGen + '(以 /str 作为命令选项)，或重新生成 VS 项目。 + ''' + ''' 一个强类型的资源类，用于查找本地化的字符串等。 + ''' + _ + Friend Module Resources + + Private resourceMan As Global.System.Resources.ResourceManager + + Private resourceCulture As Global.System.Globalization.CultureInfo + + ''' + ''' 返回此类使用的缓存的 ResourceManager 实例。 + ''' + _ + Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager + Get + If Object.ReferenceEquals(resourceMan, Nothing) Then + Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("PCL.Resources", GetType(Resources).Assembly) + resourceMan = temp + End If + Return resourceMan + End Get + End Property + + ''' + ''' 重写当前线程的 CurrentUICulture 属性，对 + ''' 使用此强类型资源类的所有资源查找执行重写。 + ''' + _ + Friend Property Culture() As Global.System.Globalization.CultureInfo + Get + Return resourceCulture + End Get + Set + resourceCulture = value + End Set + End Property + + ''' + ''' 查找 System.Byte[] 类型的本地化资源。 + ''' + Friend ReadOnly Property Custom() As Byte() + Get + Dim obj As Object = ResourceManager.GetObject("Custom", resourceCulture) + Return CType(obj,Byte()) + End Get + End Property + + ''' + ''' 查找 System.Byte[] 类型的本地化资源。 + ''' + Friend ReadOnly Property Dialogs() As Byte() + Get + Dim obj As Object = ResourceManager.GetObject("Dialogs", resourceCulture) + Return CType(obj,Byte()) + End Get + End Property + + ''' + ''' 查找 System.Byte[] 类型的本地化资源。 + ''' + Friend ReadOnly Property ForgeInstaller() As Byte() + Get + Dim obj As Object = ResourceManager.GetObject("ForgeInstaller", resourceCulture) + Return CType(obj,Byte()) + End Get + End Property + + ''' + ''' 查找 System.Byte[] 类型的本地化资源。 + ''' + Friend ReadOnly Property Help() As Byte() + Get + Dim obj As Object = ResourceManager.GetObject("Help", resourceCulture) + Return CType(obj,Byte()) + End Get + End Property + + ''' + ''' 查找 System.Byte[] 类型的本地化资源。 + ''' + Friend ReadOnly Property Json() As Byte() + Get + Dim obj As Object = ResourceManager.GetObject("Json", resourceCulture) + Return CType(obj,Byte()) + End Get + End Property + + ''' + ''' 查找 System.Byte[] 类型的本地化资源。 + ''' + Friend ReadOnly Property ModData() As Byte() + Get + Dim obj As Object = ResourceManager.GetObject("ModData", resourceCulture) + Return CType(obj,Byte()) + End Get + End Property + + ''' + ''' 查找 System.Byte[] 类型的本地化资源。 + ''' + Friend ReadOnly Property NAudio() As Byte() + Get + Dim obj As Object = ResourceManager.GetObject("NAudio", resourceCulture) + Return CType(obj,Byte()) + End Get + End Property + + ''' + ''' 查找 System.Byte[] 类型的本地化资源。 + ''' + Friend ReadOnly Property STUN() As Byte() + Get + Dim obj As Object = ResourceManager.GetObject("STUN", resourceCulture) + Return CType(obj,Byte()) + End Get + End Property + + ''' + ''' 查找 System.Byte[] 类型的本地化资源。 + ''' + Friend ReadOnly Property Transformer() As Byte() + Get + Dim obj As Object = ResourceManager.GetObject("Transformer", resourceCulture) + Return CType(obj,Byte()) + End Get + End Property + End Module +End Namespace diff --git a/Plain Craft Launcher 2/My Project/Resources.resx b/Plain Craft Launcher 2/My Project/Resources.resx new file mode 100644 index 0000000..ccad302 --- /dev/null +++ b/Plain Craft Launcher 2/My Project/Resources.resx @@ -0,0 +1,148 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 2.0 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + + ..\resources\custom.xaml;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + ..\resources\ookii.dialogs.wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + ..\Resources\forge-installer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + ..\Resources\Help.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + ..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + ..\Resources\ModData.json;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + ..\Resources\NAudio.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + ..\Resources\STUN.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + ..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/My Project/Settings.Designer.vb b/Plain Craft Launcher 2/My Project/Settings.Designer.vb new file mode 100644 index 0000000..4fa2aee --- /dev/null +++ b/Plain Craft Launcher 2/My Project/Settings.Designer.vb @@ -0,0 +1,71 @@ +'------------------------------------------------------------------------------ +' +' 此代码由工具生成。 +' 运行时版本:4.0.30319.42000 +' +' 对此文件的更改可能会导致不正确的行为，并且如果 +' 重新生成代码，这些更改将会丢失。 +' +'------------------------------------------------------------------------------ + +Option Strict On +Option Explicit On + + + + _ +Partial Friend NotInheritable Class MySettings + Inherits Global.System.Configuration.ApplicationSettingsBase + + Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings()),MySettings) + +#Region "My.Settings 自动保存功能" +#If _MyType = "WindowsForms" Then + Private Shared addedHandler As Boolean + + Private Shared addedHandlerLockObject As New Object + + _ + Private Shared Sub AutoSaveSettings(sender As Global.System.Object, e As Global.System.EventArgs) + If My.Application.SaveMySettingsOnExit Then + My.Settings.Save() + End If + End Sub +#End If +#End Region + + Public Shared ReadOnly Property [Default]() As MySettings + Get + +#If _MyType = "WindowsForms" Then + If Not addedHandler Then + SyncLock addedHandlerLockObject + If Not addedHandler Then + AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings + addedHandler = True + End If + End SyncLock + End If +#End If + Return defaultInstance + End Get + End Property +End Class + +Namespace My + + _ + Friend Module MySettingsProperty + + _ + Friend ReadOnly Property Settings() As Global.PCL.MySettings + Get + Return Global.PCL.MySettings.Default + End Get + End Property + End Module +End Namespace diff --git a/Plain Craft Launcher 2/My Project/Settings.settings b/Plain Craft Launcher 2/My Project/Settings.settings new file mode 100644 index 0000000..40ed9fd --- /dev/null +++ b/Plain Craft Launcher 2/My Project/Settings.settings @@ -0,0 +1,7 @@ + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/My Project/app.manifest b/Plain Craft Launcher 2/My Project/app.manifest new file mode 100644 index 0000000..a156e2c --- /dev/null +++ b/Plain Craft Launcher 2/My Project/app.manifest @@ -0,0 +1,69 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb new file mode 100644 index 0000000..e1b2ddf --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb @@ -0,0 +1,2127 @@ +Imports System.IO.Compression + +Public Module ModDownloadLib + +#Region "Minecraft 下载" + + ''' + ''' 下载某个 Minecraft 版本，这会创造一个单独的下载任务，失败会跳过执行并要求反馈。 + ''' 返回正在下载的任务，若跳过或失败，则返回 Nothing。 + ''' + ''' 所下载的 Minecraft 的版本名。 + ''' Json 文件的 Mojang 官方地址。 + Public Function McDownloadClient(Behaviour As NetPreDownloadBehaviour, Id As String, Optional JsonUrl As String = Nothing) As LoaderCombo(Of String) + Try + Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\" + + '重复任务检查 + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = "Minecraft " & Id & " 下载" Then + If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return LoaderTaskbar(i) + Hint("该版本正在下载中！", HintType.Critical) + Return LoaderTaskbar(i) + End If + Next + End SyncLock + + '已有版本检查 + If Behaviour <> NetPreDownloadBehaviour.IgnoreCheck AndAlso File.Exists(VersionFolder & Id & ".json") AndAlso File.Exists(VersionFolder & Id & ".jar") Then + If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return Nothing + If MyMsgBox("版本 " & Id & " 已存在，是否重新下载？" & vbCrLf & "这会覆盖版本的 Json 与 Jar 文件，但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then + File.Delete(VersionFolder & Id & ".jar") + File.Delete(VersionFolder & Id & ".json") + Else + Return Nothing + End If + End If + + '启动 + Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", McDownloadClientLoader(Id, JsonUrl)) With {.OnStateChanged = AddressOf McInstallState} + Loader.Start(VersionFolder) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + Return Loader + + Catch ex As Exception + Log(ex, "开始 Minecraft 下载失败", LogLevel.Feedback) + Return Nothing + End Try + End Function + ''' + ''' 保存某个 Minecraft 版本的核心文件（仅 Json 与核心 Jar）。 + ''' + ''' 所下载的 Minecraft 的版本名。 + ''' Json 文件的 Mojang 官方地址。 + Public Sub McDownloadClientCore(Id As String, JsonUrl As String, Behaviour As NetPreDownloadBehaviour) + Try + Dim VersionFolder As String = SelectFolder() + If Not VersionFolder.Contains("\") Then Exit Sub + VersionFolder = VersionFolder & Id & "\" + + '重复任务检查 + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = "Minecraft " & Id & " 下载" Then + If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Exit Sub + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + + Dim Loaders As New List(Of LoaderBase) + '下载版本 Json 文件 + Loaders.Add(New LoaderDownload("下载版本 Json 文件", New List(Of NetFile) From { + New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True)) + }) With {.ProgressWeight = 2}) + '获取支持库文件地址 + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 Jar 文件下载地址", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder), True)) With {.ProgressWeight = 0.5, .Show = False}) + '下载支持库文件 + Loaders.Add(New LoaderDownload("下载核心 Jar 文件", New List(Of NetFile)) With {.ProgressWeight = 5}) + + '启动 + Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} + Loader.Start(Id) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + + Catch ex As Exception + Log(ex, "开始 Minecraft 下载失败", LogLevel.Feedback) + End Try + End Sub + + ''' + ''' 获取下载某个 Minecraft 版本的加载器列表。 + ''' 它必须安装到 PathMcFolder，但是可以自定义版本名（不过自定义的版本名不会修改 Json 中的 id 项）。 + ''' + Private Function McDownloadClientLoader(Id As String, Optional JsonUrl As String = Nothing, Optional VersionName As String = Nothing) As List(Of LoaderBase) + VersionName = If(VersionName, Id) + Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\" + + Dim Loaders As New List(Of LoaderBase) + + '下载版本 Json 文件 + If JsonUrl Is Nothing Then + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取原版 Json 文件下载地址", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + Dim JsonAddress As String = DlClientListGet(Id) + Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JsonAddress), VersionFolder & VersionName & ".json")} + End Sub) With {.ProgressWeight = 2, .Show = False}) + End If + Loaders.Add(New LoaderDownload("下载原版 Json 文件", New List(Of NetFile) From { + New NetFile(DlSourceLauncherOrMetaGet(If(JsonUrl, "")), VersionFolder & VersionName & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True)) + }) With {.ProgressWeight = 3}) + + '下载支持库文件 + 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(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) + LoadersLib.Add(New LoaderDownload("下载原版支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False}) + Loaders.Add(New LoaderCombo(Of String)(McDownloadClientLibName, LoadersLib) With {.Block = False, .ProgressWeight = 14}) + + '下载资源文件 + Dim LoadersAssets As New List(Of LoaderBase) + LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址（副加载器）", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + Try + Dim Version As New McVersion(VersionFolder) + Task.Output = New List(Of NetFile) From {DlClientAssetIndexGet(Version)} + Catch ex As Exception + Throw New Exception("分析资源文件索引地址失败", ex) + End Try + '顺手添加 Json 项目 + Try + Dim VersionJson As JObject = GetJson(ReadFile(VersionFolder & VersionName & ".json")) + VersionJson.Add("clientVersion", Id) + WriteFile(VersionFolder & VersionName & ".json", VersionJson.ToString) + Catch ex As Exception + Throw New Exception("添加客户端版本失败", ex) + End Try + End Sub) With {.ProgressWeight = 1, .Show = False}) + LoadersAssets.Add(New LoaderDownload("下载资源文件索引（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 3, .Show = False}) + LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析所需资源文件（副加载器）", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + Task.Output = McAssetsFixList(McAssetsGetIndexName(New McVersion(VersionFolder)), True, Task) + End Sub) With {.ProgressWeight = 3, .Show = False}) + LoadersAssets.Add(New LoaderDownload("下载资源文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 14, .Show = False}) + Loaders.Add(New LoaderCombo(Of String)("下载原版资源文件", LoadersAssets) With {.Block = False, .ProgressWeight = 21}) + + Return Loaders + + End Function + Private Const McDownloadClientLibName As String = "下载原版支持库文件" + +#End Region + +#Region "Minecraft 下载菜单" + + Public Function McDownloadListItem(Entry As JObject, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem + '确定图标 + Dim Logo As String + Select Case Entry("type") + Case "release" + Logo = "pack://application:,,,/images/Blocks/Grass.png" + Case "snapshot" + Logo = "pack://application:,,,/images/Blocks/CommandBlock.png" + Case "special" + Logo = "pack://application:,,,/images/Blocks/GoldBlock.png" + Case Else + Logo = "pack://application:,,,/images/Blocks/CobbleStone.png" + End Select + '建立控件 + Dim NewItem As New MyListItem With {.Logo = Logo, .SnapsToDevicePixels = True, .Title = Entry("id").ToString, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60} + If Entry("lore") Is Nothing Then + NewItem.Info = Entry("releaseTime").Value(Of Date).ToString("yyyy/MM/dd") + Else + NewItem.Info = Entry("lore").ToString + End If + If Entry("url").ToString.Contains("pcl") Then NewItem.Info = "[PCL2 特别提供] " & NewItem.Info + AddHandler NewItem.Click, OnClick + '建立菜单 + If IsSaveOnly Then + NewItem.ContentHandler = AddressOf McDownloadSaveMenuBuild + Else + NewItem.ContentHandler = AddressOf McDownloadMenuBuild + End If + '结束 + Return NewItem + End Function + Private Sub McDownloadSaveMenuBuild(sender As Object, e As EventArgs) + Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} + ToolTipService.SetPlacement(BtnInfo, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnInfo, 30) + ToolTipService.SetHorizontalOffset(BtnInfo, 2) + AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog + sender.Buttons = {BtnInfo} + End Sub + Private Sub McDownloadMenuBuild(sender As Object, e As EventArgs) + Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} + ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnSave, 30) + ToolTipService.SetHorizontalOffset(BtnSave, 2) + AddHandler BtnSave.Click, AddressOf McDownloadMenuSave + Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} + ToolTipService.SetPlacement(BtnInfo, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnInfo, 30) + ToolTipService.SetHorizontalOffset(BtnInfo, 2) + AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog + sender.Buttons = {BtnSave, BtnInfo} + End Sub + Private Sub McDownloadMenuLog(sender As Object, e As RoutedEventArgs) + Dim Version As JToken + If sender.Tag IsNot Nothing Then + Version = sender.Tag + ElseIf sender.Parent.Tag IsNot Nothing Then + Version = sender.Parent.Tag + Else + Version = sender.Parent.Parent.Tag + End If + McUpdateLogShow(Version) + End Sub + Public Sub McDownloadMenuSave(sender As Object, e As RoutedEventArgs) + Dim Version As MyListItem + If TypeOf sender Is MyListItem Then + Version = sender + ElseIf TypeOf sender.Parent Is MyListItem Then + Version = sender.Parent + Else + Version = sender.Parent.Parent + End If + McDownloadClientCore(Version.Title, Version.Tag("url").ToString, NetPreDownloadBehaviour.HintWhileExists) + End Sub + ''' + ''' 显示某 Minecraft 版本的更新日志。 + ''' + ''' 在 version_manifest.json 中的对应项。 + Public Sub McUpdateLogShow(VersionJson As JToken) + Dim WikiName As String + Dim Id As String = VersionJson("id").ToString.ToLower + If Id = "3d shareware v1.34" Then + WikiName = "3D_Shareware_v1.34" + ElseIf Id = "2.0" Then + WikiName = "Java版2.0" + ElseIf Id = "1.rv-pre1" Then + WikiName = "Java版1.RV-Pre1" + ElseIf Id = "combat test 1" OrElse Id.Contains("combat-1") OrElse Id.Contains("combat-212796") Then + WikiName = "Java版1.14.3_-_Combat_Test" + ElseIf Id = "combat test 2" OrElse Id.Contains("combat-2") OrElse Id.Contains("combat-0") Then + WikiName = "Java版Combat_Test_2" + ElseIf Id = "combat test 3" OrElse Id = "1.14_combat-3" Then + WikiName = "Java版Combat_Test_3" + ElseIf Id = "combat test 4" OrElse Id = "1.15_combat-1" Then + WikiName = "Java版Combat_Test_4" + ElseIf Id = "combat test 5" OrElse Id = "1.15_combat-6" Then + WikiName = "Java版Combat_Test_5" + ElseIf Id = "combat test 6" OrElse Id = "1.16_combat-0" Then + WikiName = "Java版Combat_Test_6" + ElseIf Id = "combat test 7c" OrElse Id = "1.16_combat-3" Then + WikiName = "Java版Combat_Test_7c" + ElseIf Id = "combat test 8b" OrElse Id = "1.16_combat-5" Then + WikiName = "Java版Combat_Test_8b" + ElseIf Id = "combat test 8c" OrElse Id = "1.16_combat-6" Then + WikiName = "Java版Combat_Test_8c" + ElseIf Id = "1.0.0-rc2-2" Then + WikiName = "Java版RC2" + ElseIf Id.StartsWith("1.19_deep_dark_experimental_snapshot-") OrElse Id.StartsWith("1_19_deep_dark_experimental_snapshot-") Then + WikiName = Id.Replace("1_19", "1.19").Replace("1.19_deep_dark_experimental_snapshot-", "Java版Deep_Dark_Experimental_Snapshot_") + ElseIf Id = "b1.9-pre6" Then + WikiName = "Java版Beta_1.9_Prerelease_6" + ElseIf Id.Contains("b1.9") Then + WikiName = "Java版Beta_1.9_Prerelease" + ElseIf VersionJson("type") = "release" OrElse VersionJson("type") = "snapshot" OrElse VersionJson("type") = "special" Then + WikiName = If(Id.Contains("w"), "", "Java版") & Id.Replace(" Pre-Release ", "-pre") + ElseIf Id.StartsWith("b") Then + WikiName = "Java版" & Id.TrimEnd("a", "b", "c", "d", "e").Replace("b", "Beta_") + ElseIf Id.StartsWith("a") Then + WikiName = "Java版" & Id.TrimEnd("a", "b", "c", "d", "e").Replace("a", "Alpha_v") + ElseIf Id = "inf-20100618" Then + WikiName = "Java版Infdev_20100618" + ElseIf Id = "c0.30_01c" OrElse Id = "c0.30_survival" OrElse Id.Contains("生存测试") Then + WikiName = "Java版Classic_0.30（生存模式）" + ElseIf Id = "c0.31" Then + WikiName = "Java版Indev_0.31（2010年1月30日）" + ElseIf Id.StartsWith("c") Then + WikiName = "Java版" & Id.Replace("c", "Classic_") + ElseIf Id.StartsWith("rd-") Then + WikiName = "Java版Pre-classic_" & Id + Else + Log("[Error] 未知的版本格式：" & Id & "。", LogLevel.Feedback) + Exit Sub + End If + OpenWebsite("https://minecraft.fandom.com/zh/wiki/" & WikiName.Replace("_experimental-snapshot-", "-exp")) + End Sub + +#End Region + +#Region "OptiFine 下载" + + Public Sub McDownloadOptiFine(DownloadInfo As DlOptiFineListEntry) + Try + Dim Id As String = DownloadInfo.NameVersion + Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\" + Dim IsNewVersion As Boolean = Val(DownloadInfo.Inherit.Split(".")(1)) >= 14 + Dim Target As String = If(IsNewVersion, + PathTemp & "Cache\Code\" & DownloadInfo.NameVersion & "_" & GetUuid(), + PathMcFolder & "libraries\optifine\OptiFine\" & DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "") & "\" & DownloadInfo.NameFile.Replace("OptiFine_", "OptiFine-").Replace("preview_", "")) + + '重复任务检查 + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = "OptiFine " & DownloadInfo.NameDisplay & " 下载" Then + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + + '已有版本检查 + If File.Exists(VersionFolder & Id & ".json") Then + If MyMsgBox("版本 " & Id & " 已存在，是否重新下载？" & vbCrLf & "这会覆盖版本的 Json 文件，但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then + File.Delete(VersionFolder & Id & ".jar") + File.Delete(VersionFolder & Id & ".json") + Else + Exit Sub + End If + End If + + '启动 + Dim Loader As New LoaderCombo(Of String)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineLoader(DownloadInfo)) With {.OnStateChanged = AddressOf McInstallState} + Loader.Start(VersionFolder) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + + Catch ex As Exception + Log(ex, "开始 OptiFine 下载失败", LogLevel.Feedback) + End Try + End Sub + Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry) + Try + Dim Id As String = DownloadInfo.NameVersion + Dim Target As String = SelectAs("选择保存位置", DownloadInfo.NameFile, "OptiFine Jar (*.jar)|*.jar") + If Not Target.Contains("\") Then Exit Sub + + '重复任务检查 + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = "OptiFine " & DownloadInfo.NameDisplay & " 下载" Then + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + + Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf DownloadStateSave} + Loader.Start(DownloadInfo) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + + Catch ex As Exception + Log(ex, "开始 OptiFine 下载失败", LogLevel.Feedback) + End Try + End Sub + Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean)) + '选择 Java + Dim Java = JavaSelect(New Version(1, 8, 0, 0)) + If Java Is Nothing Then + JavaMissing(8) + Throw New Exception("未找到用于安装 OptiFine 的 Java") + End If + '开始启动 + Dim Info = New ProcessStartInfo With { + .FileName = Java.PathJavaw, + .Arguments = "-Duser.home=""" & BaseMcFolderHome & """ -cp """ & Target & """ optifine.Installer", + .UseShellExecute = False, + .CreateNoWindow = True, + .RedirectStandardError = True, + .RedirectStandardOutput = True, + .WorkingDirectory = BaseMcFolderHome + } + If Info.EnvironmentVariables.ContainsKey("appdata") Then + Info.EnvironmentVariables("appdata") = BaseMcFolderHome + Else + Info.EnvironmentVariables.Add("appdata", BaseMcFolderHome) + End If + Log("[Download] 开始安装 OptiFine：" & Target) + Dim TotalLength As Integer = 0 + Dim process As New Process With {.StartInfo = Info} + Dim LastResult As String = "" + Using outputWaitHandle As New AutoResetEvent(False) + Using errorWaitHandle As New AutoResetEvent(False) + AddHandler process.OutputDataReceived, Function(sender, e) + Try + If e.Data Is Nothing Then + outputWaitHandle.[Set]() + Else + LastResult = e.Data + If ModeDebug Then Log("[Installer] " & LastResult) + TotalLength += 1 + Task.Progress += 0.9 / 7000 + End If + Catch ex As ObjectDisposedException + Catch ex As Exception + Log(ex, "读取 OptiFine 安装器信息失败") + End Try + Try + If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then + Log("[Installer] 由于任务取消，已中止 OptiFine 安装") + process.Kill() + End If + Catch + End Try + Return Nothing + End Function + AddHandler process.ErrorDataReceived, Function(sender, e) + Try + If e.Data Is Nothing Then + errorWaitHandle.[Set]() + Else + LastResult = e.Data + If ModeDebug Then Log("[Installer] " & LastResult) + TotalLength += 1 + Task.Progress += 0.9 / 7000 + End If + Catch ex As ObjectDisposedException + Catch ex As Exception + Log(ex, "读取 OptiFine 安装器错误信息失败") + End Try + Try + If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then + Log("[Installer] 由于任务取消，已中止 OptiFine 安装") + process.Kill() + End If + Catch + End Try + Return Nothing + End Function + process.Start() + process.BeginOutputReadLine() + process.BeginErrorReadLine() + '等待 + Do Until process.HasExited + Thread.Sleep(10) + Loop + '输出 + outputWaitHandle.WaitOne(10000) + errorWaitHandle.WaitOne(10000) + process.Dispose() + If TotalLength < 1000 Then Throw New Exception("安装器运行出错，末行为 " & LastResult) + End Using + End Using + End Sub + + ''' + ''' 获取下载某个 OptiFine 版本的加载器列表。 + ''' + Private Function McDownloadOptiFineLoader(DownloadInfo As DlOptiFineListEntry, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase) + + '参数初始化 + McFolder = If(McFolder, PathMcFolder) + Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder + Dim Id As String = DownloadInfo.NameVersion + 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, + PathTemp & "Cache\Code\" & DownloadInfo.NameVersion & "_" & GetUuid(), + 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) + + '获取下载地址 + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取 OptiFine 主文件下载地址", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + '启动依赖版本的下载 + If ClientDownloadLoader Is Nothing Then + If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器，则不能指定 MC 安装文件夹") + ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, DownloadInfo.Inherit) + End If + Task.Progress = 0.1 + Dim Sources As New List(Of String) + 'BMCLAPI 源 + If DownloadInfo.IsPreview Then + Sources.Add("https://download.mcbbs.net/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) + Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) + Else + Sources.Add("https://download.mcbbs.net/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) + Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) + End If + '官方源 + Dim PageData As String + Try + PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html") + Task.Progress = 0.8 + Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) + Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0)) + Catch ex As Exception + Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败") + End Try + Task.Progress = 0.9 + 'OptiFine 中文镜像源 + Sources.Add("https://optifine.cn/download/" & DownloadInfo.NameFile) + '构造文件请求 + Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=64 * 1024))} + End Sub) With {.ProgressWeight = 8}) + Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8}) + 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 + '等待原版文件下载完成 + For Each Loader In ClientDownloadLoader.GetLoaderList + If Loader.Name <> McDownloadClientLibName Then Continue For + Loader.WaitForExit() + Exit For + Next + '拷贝原版文件 + If IsCustomFolder Then + Try + Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name + Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit) + If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then + File.Copy(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") + End If + If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then + File.Copy(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") + End If + Catch ex As Exception + 'OptiFine 与 Forge 同时开始复制偶尔会导致冲突出错 + Log(ex, "安装 OptiFine 拷贝原版文件时出错") + End Try + End If + End Sub) With {.ProgressWeight = 0.1, .Show = False}) + + '安装（新旧方式均需要原版 Jar 和 Json） + If IsNewVersion Then + 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 = PathTemp & "InstallOptiFine" & RandomInteger(0, 100000) + Dim BaseMcFolder As String = BaseMcFolderHome & "\.minecraft\" + Try + '准备安装环境 + If Directory.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then + DeleteDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit) + End If + My.Computer.FileSystem.CreateDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\") + McFolderLauncherProfilesJsonCreate(BaseMcFolder) + File.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json", + BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") + File.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", + BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") + Task.Progress = 0.06 + '进行安装 + McDownloadOptiFineInstall(BaseMcFolderHome, Target, Task) + Task.Progress = 0.96 + '复制文件 + File.Delete(BaseMcFolder & "launcher_profiles.json") + My.Computer.FileSystem.CopyDirectory(BaseMcFolder, McFolder, True) + Task.Progress = 0.98 + '清理文件 + My.Computer.FileSystem.DeleteFile(Target) + DeleteDirectory(BaseMcFolderHome) + Catch ex As Exception + Throw New Exception("安装新版 OptiFine 版本失败", ex) + End Try + End Sub) With {.ProgressWeight = 8}) + Else + Log("[Download] 检测为旧版 OptiFine：" & DownloadInfo.Inherit) + Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine（方式 B）", + Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) + Try + '新建版本文件夹 + Directory.CreateDirectory(VersionFolder) + Task.Progress = 0.1 + '复制 Jar 文件 + If File.Exists(VersionFolder & Id & ".jar") Then File.Delete(VersionFolder & Id & ".jar") + File.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar") + Task.Progress = 0.7 + '建立 Json 文件 + Dim InheritVersion As New McVersion(McFolder & "versions\" & DownloadInfo.Inherit) + Dim Json As String = "{ + ""id"": """ & Id & """, + ""inheritsFrom"": """ & DownloadInfo.Inherit & """, + ""time"": """ & If(DownloadInfo.ReleaseTime = "", InheritVersion.ReleaseTime.ToString("yyyy-MM-dd"), DownloadInfo.ReleaseTime.Replace("/", "-")) & "T23:33:33+08:00"", + ""releaseTime"": """ & If(DownloadInfo.ReleaseTime = "", InheritVersion.ReleaseTime.ToString("yyyy-MM-dd"), DownloadInfo.ReleaseTime.Replace("/", "-")) & "T23:33:33+08:00"", + ""type"": ""release"", + ""libraries"": [ + {""name"": ""optifine:OptiFine:" & DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "") & """}, + {""name"": ""net.minecraft:launchwrapper:1.12""} + ], + ""mainClass"": ""net.minecraft.launchwrapper.Launch""," + Task.Progress = 0.8 + If InheritVersion.IsOldJson Then + '输出旧版 Json 格式 + Json += " + ""minimumLauncherVersion"": 18, + ""minecraftArguments"": """ & InheritVersion.JsonObject("minecraftArguments").ToString & " --tweakClass optifine.OptiFineTweaker"" +}" + Else + '输出新版 Json 格式 + Json += " + ""minimumLauncherVersion"": ""21"", + ""arguments"": { + ""game"": [ + ""--tweakClass"", + ""optifine.OptiFineTweaker"" + ] + } +}" + End If + WriteFile(VersionFolder & Id & ".json", Json) + Catch ex As Exception + Throw New Exception("安装旧版 OptiFine 版本失败", ex) + End Try + End Sub) With {.ProgressWeight = 1}) + End If + + '下载支持库 + 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}) + Loaders.Add(New LoaderDownload("下载 OptiFine 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 4}) + End If + + Return Loaders + End Function + ''' + ''' 获取保存某个 OptiFine 版本的加载器列表。 + ''' + Private Function McDownloadOptiFineSaveLoader(DownloadInfo As DlOptiFineListEntry, TargetFolder As String) As List(Of LoaderBase) + Dim Loaders As New List(Of LoaderBase) + '获取下载地址 + Loaders.Add(New LoaderTask(Of DlOptiFineListEntry, List(Of NetFile))("获取 OptiFine 下载地址", + Sub(Task As LoaderTask(Of DlOptiFineListEntry, List(Of NetFile))) + Dim Sources As New List(Of String) + 'BMCLAPI 源 + If DownloadInfo.IsPreview Then + Sources.Add("https://download.mcbbs.net/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) + Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) + Else + Sources.Add("https://download.mcbbs.net/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) + Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) + End If + '官方源 + Dim PageData As String + Try + PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html") + Task.Progress = 0.8 + Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) + Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址：" & Sources(0)) + Catch ex As Exception + Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败") + End Try + Task.Progress = 0.9 + '构造文件请求 + Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, TargetFolder, New FileChecker(MinSize:=64 * 1024))} + End Sub) With {.ProgressWeight = 6}) + '下载 + Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 10, .Block = True}) + Return Loaders + End Function + +#End Region + +#Region "OptiFine 下载菜单" + + Public Function OptiFineDownloadListItem(Entry As DlOptiFineListEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem + '建立控件 + Dim NewItem As New MyListItem With { + .Title = Entry.NameDisplay, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60, + .Info = If(Entry.IsPreview, "测试版", "正式版") & If(Entry.ReleaseTime = "", "", "，发布于 " & Entry.ReleaseTime), + .Logo = "pack://application:,,,/images/Blocks/GrassPath.png" + } + AddHandler NewItem.Click, OnClick + '建立菜单 + If IsSaveOnly Then + NewItem.ContentHandler = AddressOf OptiFineSaveContMenuBuild + Else + NewItem.ContentHandler = AddressOf OptiFineContMenuBuild + End If + '结束 + Return NewItem + End Function + Private Sub OptiFineSaveContMenuBuild(sender As Object, e As EventArgs) + Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} + ToolTipService.SetPlacement(BtnInfo, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnInfo, 30) + ToolTipService.SetHorizontalOffset(BtnInfo, 2) + AddHandler BtnInfo.Click, AddressOf OptiFineLog_Click + sender.Buttons = {BtnInfo} + End Sub + Private Sub OptiFineContMenuBuild(sender As Object, e As EventArgs) + Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} + ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnSave, 30) + ToolTipService.SetHorizontalOffset(BtnSave, 2) + AddHandler BtnSave.Click, AddressOf OptiFineSave_Click + Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} + ToolTipService.SetPlacement(BtnInfo, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnInfo, 30) + ToolTipService.SetHorizontalOffset(BtnInfo, 2) + AddHandler BtnInfo.Click, AddressOf OptiFineLog_Click + sender.Buttons = {BtnSave, BtnInfo} + End Sub + Private Sub OptiFineLog_Click(sender As Object, e As RoutedEventArgs) + Dim Version As DlOptiFineListEntry + If sender.Tag IsNot Nothing Then + Version = sender.Tag + ElseIf sender.Parent.Tag IsNot Nothing Then + Version = sender.Parent.Tag + Else + Version = sender.Parent.Parent.Tag + End If + OpenWebsite("https://optifine.net/changelog?f=" & Version.NameFile) + End Sub + Public Sub OptiFineSave_Click(sender As Object, e As RoutedEventArgs) + Dim Version As DlOptiFineListEntry + If sender.Tag IsNot Nothing Then + Version = sender.Tag + ElseIf sender.Parent.Tag IsNot Nothing Then + Version = sender.Parent.Tag + Else + Version = sender.Parent.Parent.Tag + End If + McDownloadOptiFineSave(Version) + End Sub + +#End Region + +#Region "LiteLoader 下载" + + Public Sub McDownloadLiteLoader(DownloadInfo As DlLiteLoaderListEntry) + Try + Dim Id As String = DownloadInfo.Inherit + Dim Target As String = PathTemp & "Download\" & Id & "-Liteloader.jar" + Dim VersionName As String = DownloadInfo.Inherit & "-LiteLoader" + Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\" + + '重复任务检查 + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = "LiteLoader " & Id & " 下载" Then + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + + '已有版本检查 + If File.Exists(VersionFolder & VersionName & ".json") Then + If MyMsgBox("版本 " & VersionName & " 已存在，是否重新下载？" & vbCrLf & "这会覆盖版本的 Json 文件，但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then + File.Delete(VersionFolder & VersionName & ".jar") + File.Delete(VersionFolder & VersionName & ".json") + Else + Exit Sub + End If + End If + + '启动 + Dim Loader As New LoaderCombo(Of String)("LiteLoader " & Id & " 下载", McDownloadLiteLoaderLoader(DownloadInfo)) With {.OnStateChanged = AddressOf McInstallState} + Loader.Start(VersionFolder) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + + Catch ex As Exception + Log(ex, "开始 LiteLoader 下载失败", LogLevel.Feedback) + End Try + End Sub + Private Sub McDownloadLiteLoaderSave(DownloadInfo As DlLiteLoaderListEntry) + Try + Dim Id As String = DownloadInfo.Inherit + Dim Target As String = SelectAs("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), "LiteLoader 安装器 (*.jar)|*.jar") + If Not Target.Contains("\") Then Exit Sub + + '重复任务检查 + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = "LiteLoader " & Id & " 下载" Then + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + + '构造步骤加载器 + Dim Loaders As New List(Of LoaderBase) + '下载 + Dim Address As New List(Of String) + If DownloadInfo.IsLegacy Then + '老版本 + Select Case DownloadInfo.Inherit + Case "1.7.10" + Address.Add("http://dl.liteloader.com/redist/1.7.10/liteloader-installer-1.7.10-04.jar") + Case "1.7.2" + Address.Add("http://dl.liteloader.com/redist/1.7.2/liteloader-installer-1.7.2-04.jar") + Case "1.6.4" + Address.Add("http://dl.liteloader.com/redist/1.6.4/liteloader-installer-1.6.4-01.jar") + Case "1.6.2" + Address.Add("http://dl.liteloader.com/redist/1.6.2/liteloader-installer-1.6.2-04.jar") + Case "1.5.2" + 'Address.AddRange({"https://download.mcbbs.net/maven/com/mumfrey/liteloader/1.5.2/liteloader-1.5.2.jar", + ' "https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/1.5.2/liteloader-1.5.2.jar"}) + Address.Add("http://dl.liteloader.com/redist/1.5.2/liteloader-installer-1.5.2-01.jar") + Case Else + Throw New NotSupportedException("未知的 Minecraft 版本（" & DownloadInfo.Inherit & "）") + End Select + Else + 'BMCLAPI 源下载的是安装后的 Jar，而不是 Installer，故无法使用 + ''BMCLAPI 源 + 'If DownloadInfo.IsPreview Then + ' Address.AddRange({"https://download.mcbbs.net/maven/com/mumfrey/liteloader/" & DownloadInfo.Inherit & "-SNAPSHOT/liteloader-" & DownloadInfo.Inherit & "-SNAPSHOT.jar", + ' "https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/" & DownloadInfo.Inherit & "-SNAPSHOT/liteloader-" & DownloadInfo.Inherit & "-SNAPSHOT.jar"}) + 'Else + ' Address.AddRange({"https://download.mcbbs.net/maven/com/mumfrey/liteloader/" & DownloadInfo.Inherit & "/liteloader-" & DownloadInfo.Inherit & ".jar", + ' "https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/" & DownloadInfo.Inherit & "/liteloader-" & DownloadInfo.Inherit & ".jar"}) + 'End If + '官方源 + Address.Add("http://jenkins.liteloader.com/job/LiteLoaderInstaller%20" & DownloadInfo.Inherit & "/lastSuccessfulBuild/artifact/" & If(DownloadInfo.Inherit = "1.8", "ant/dist/", "build/libs/") & DownloadInfo.FileName) + End If + Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker(MinSize:=1024 * 1024))}) With {.ProgressWeight = 15}) + '启动 + Dim Loader As New LoaderCombo(Of DlLiteLoaderListEntry)("LiteLoader " & Id & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} + Loader.Start(DownloadInfo) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + + Catch ex As Exception + Log(ex, "开始 LiteLoader 安装器下载失败", LogLevel.Feedback) + End Try + End Sub + + ''' + ''' 获取下载某个 LiteLoader 版本的加载器列表。 + ''' + Private Function McDownloadLiteLoaderLoader(DownloadInfo As DlLiteLoaderListEntry, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase) + + '参数初始化 + McFolder = If(McFolder, PathMcFolder) + Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder + Dim Id As String = DownloadInfo.Inherit + Dim Target As String = PathTemp & "Download\" & Id & "-Liteloader.jar" + Dim VersionName As String = DownloadInfo.Inherit & "-LiteLoader" + Dim VersionFolder As String = McFolder & "versions\" & VersionName & "\" + Dim Loaders As New List(Of LoaderBase) + + '启动依赖版本的下载 + If ClientDownloadLoader Is Nothing Then + Loaders.Add(New LoaderTask(Of String, String)( + "启动 LiteLoader 依赖版本下载", + Sub() + If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器，则不能指定 MC 安装文件夹") + ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, DownloadInfo.Inherit) + End Sub) With {.ProgressWeight = 0.2, .Show = False, .Block = False}) + End If + '安装 + Loaders.Add(New LoaderTask(Of String, String)("安装 LiteLoader", + Sub(Task As LoaderTask(Of String, String)) + Try + '新建版本文件夹 + Directory.CreateDirectory(VersionFolder) + '构造版本 Json + Dim VersionJson As New JObject + VersionJson.Add("id", VersionName) + VersionJson.Add("time", DateTime.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm:ss", Globalization.CultureInfo.CurrentCulture)) + VersionJson.Add("releaseTime", DateTime.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm:ss", Globalization.CultureInfo.CurrentCulture)) + VersionJson.Add("type", "release") + VersionJson.Add("arguments", GetJson("{""game"":[""--tweakClass"",""" & DownloadInfo.JsonToken("tweakClass").ToString & """]}")) + VersionJson.Add("libraries", DownloadInfo.JsonToken("libraries")) + CType(VersionJson("libraries"), JContainer).Add(GetJson("{""name"": ""com.mumfrey:liteloader:" & DownloadInfo.JsonToken("version").ToString & """,""url"": ""http://dl.liteloader.com/versions/""}")) + VersionJson.Add("mainClass", "net.minecraft.launchwrapper.Launch") + VersionJson.Add("minimumLauncherVersion", 18) + VersionJson.Add("inheritsFrom", DownloadInfo.Inherit) + VersionJson.Add("jar", DownloadInfo.Inherit) + '输出 Json 文件 + WriteFile(VersionFolder & VersionName & ".json", VersionJson.ToString) + Catch ex As Exception + Throw New Exception("安装新 LiteLoader 版本失败", ex) + End Try + End Sub) With {.ProgressWeight = 1}) + '下载支持库 + If FixLibrary Then + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 LiteLoader 支持库文件", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) + Loaders.Add(New LoaderDownload("下载 LiteLoader 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 6}) + End If + + Return Loaders + End Function + +#End Region + +#Region "LiteLoader 下载菜单" + + Public Function LiteLoaderDownloadListItem(Entry As DlLiteLoaderListEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem + '建立控件 + Dim NewItem As New MyListItem With { + .Title = Entry.Inherit, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 30, + .Info = If(Entry.IsPreview, "测试版", "稳定版") & If(Entry.ReleaseTime = "", "", "，发布于 " & Entry.ReleaseTime), + .Logo = "pack://application:,,,/images/Blocks/Egg.png" + } + AddHandler NewItem.Click, OnClick + '建立菜单 + If IsSaveOnly Then + NewItem.ContentHandler = AddressOf LiteLoaderSaveContMenuBuild + Else + NewItem.ContentHandler = AddressOf LiteLoaderContMenuBuild + End If + '结束 + Return NewItem + End Function + Private Sub LiteLoaderSaveContMenuBuild(sender As MyListItem, e As EventArgs) + If sender.Tag.IsLegacy Then + sender.PaddingRight = 0 + sender.Buttons = {} + Else + sender.PaddingRight = 30 + Dim BtnList As New MyIconButton With {.Logo = Logo.IconButtonList, .ToolTip = "查看全部版本", .Tag = sender} + ToolTipService.SetPlacement(BtnList, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnList, 30) + ToolTipService.SetHorizontalOffset(BtnList, 2) + AddHandler BtnList.Click, AddressOf LiteLoaderAll_Click + sender.Buttons = {BtnList} + End If + End Sub + Private Sub LiteLoaderContMenuBuild(sender As MyListItem, e As EventArgs) + Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "保存安装器", .Tag = sender} + ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnSave, 30) + ToolTipService.SetHorizontalOffset(BtnSave, 2) + AddHandler BtnSave.Click, AddressOf LiteLoaderSave_Click + If sender.Tag.IsLegacy Then + sender.PaddingRight = 30 + sender.Buttons = {BtnSave} + Else + sender.PaddingRight = 60 + Dim BtnList As New MyIconButton With {.Logo = Logo.IconButtonList, .ToolTip = "查看全部版本", .Tag = sender} + ToolTipService.SetPlacement(BtnList, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnList, 30) + ToolTipService.SetHorizontalOffset(BtnList, 2) + AddHandler BtnList.Click, AddressOf LiteLoaderAll_Click + sender.Buttons = {BtnSave, BtnList} + End If + End Sub + Private Sub LiteLoaderAll_Click(sender As Object, e As RoutedEventArgs) + Dim Version As DlLiteLoaderListEntry + If TypeOf sender.Tag Is DlLiteLoaderListEntry Then + Version = sender.Tag + Else + Version = sender.Tag.Tag + End If + OpenWebsite("http://jenkins.liteloader.com/view/" & Version.Inherit) + End Sub + Public Sub LiteLoaderSave_Click(sender As Object, e As RoutedEventArgs) + 'ListItem 与小按钮都会调用这个方法 + Dim Version As DlLiteLoaderListEntry + If TypeOf sender.Tag Is DlLiteLoaderListEntry Then + Version = sender.Tag + Else + Version = sender.Tag.Tag + End If + McDownloadLiteLoaderSave(Version) + End Sub + +#End Region + +#Region "Forge 下载" + + Public Sub McDownloadForge(DownloadInfo As DlForgeVersionEntry) + '老版本提示 + If DownloadInfo.Category = "client" Then + If MyMsgBox("该 Forge 版本过于古老，PCL2 暂不支持该版本的自动安装。" & vbCrLf & + "若你仍然希望继续，PCL2 将把安装程序下载到你指定的位置，但不会进行安装。", + "版本过老", "继续", "取消") = 1 Then + McDownloadForgeSave(DownloadInfo) + End If + Exit Sub + End If + If DownloadInfo.Category = "universal" OrElse DownloadInfo.Inherit.StartsWith("1.5") Then '对该版本自动安装的支持将在之后加入 + If MyMsgBox("该 Forge 版本过于古老，PCL2 暂不支持该版本的自动安装。" & vbCrLf & + "若你仍然希望继续，PCL2 将把安装程序下载到你指定的位置，但不会进行安装。", + "版本过老", "继续", "取消") = 1 Then + McDownloadForgeSave(DownloadInfo) + End If + Exit Sub + End If + '初始化参数 + Dim Id As String = DownloadInfo.Inherit & "-forge-" & DownloadInfo.Version + Dim Target As String = PathTemp & "Cache\Code\ForgeInstall-" & DownloadInfo.Version & "_" & GetUuid() & "." & DownloadInfo.FileSuffix + Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\" + Dim DisplayName As String = "Forge " & DownloadInfo.Inherit & " - " & DownloadInfo.Version + Try + + '重复任务检查 + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = DisplayName & " 下载" Then + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + + '已有版本检查 + If File.Exists(VersionFolder & Id & ".json") Then + If MyMsgBox("版本 " & Id & " 已存在，是否重新下载？" & vbCrLf & "这会覆盖版本的 Json 文件，但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then + File.Delete(VersionFolder & Id & ".jar") + File.Delete(VersionFolder & Id & ".json") + Else + Exit Sub + End If + End If + + '启动 + Dim Loader As New LoaderCombo(Of String)(DisplayName & " 下载", McDownloadForgeLoader(DownloadInfo.Version, DownloadInfo.Inherit, DownloadInfo)) With {.OnStateChanged = AddressOf McInstallState} + Loader.Start(VersionFolder) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + + Catch ex As Exception + Log(ex, "开始 Forge 下载失败", LogLevel.Feedback) + Finally + '删除安装包 + Try + If File.Exists(Target) Then File.Delete(Target) + Catch + End Try + End Try + End Sub + Public Sub McDownloadForgeSave(DownloadInfo As DlForgeVersionEntry) + Try + Dim Target As String = SelectAs("选择保存位置", DownloadInfo.FileName, "Forge 文件 (*." & DownloadInfo.FileSuffix & ")|*." & DownloadInfo.FileSuffix) + Dim DisplayName As String = "Forge " & DownloadInfo.Inherit & " - " & DownloadInfo.Version + If Not Target.Contains("\") Then Exit Sub + + '重复任务检查 + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = DisplayName & " 下载" Then + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + + '构造步骤加载器 + Dim Loaders As New List(Of LoaderBase) + '获取下载地址 + Loaders.Add(New LoaderTask(Of DlForgeVersionEntry, List(Of NetFile))("获取下载地址", + Sub(Task As LoaderTask(Of DlForgeVersionEntry, List(Of NetFile))) + Dim Files As New List(Of NetFile) + Files.Add(New NetFile({ + "https://download.mcbbs.net/maven/net/minecraftforge/forge/" & DownloadInfo.Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName, + "https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & DownloadInfo.Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName, + "http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & DownloadInfo.Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName + }, Target, New FileChecker(MinSize:=64 * 1024, Hash:=DownloadInfo.Hash))) + Task.Output = Files + End Sub) With {.ProgressWeight = 0.1, .Show = False}) + '下载 + Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile)) With {.ProgressWeight = 6}) + + '启动 + Dim Loader As New LoaderCombo(Of DlForgeVersionEntry)(DisplayName & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} + Loader.Start(DownloadInfo) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + + Catch ex As Exception + Log(ex, "开始 Forge 下载失败", LogLevel.Feedback) + End Try + End Sub + + Private Sub ForgeInjector(Target As String, Task As LoaderTask(Of Boolean, Boolean), McFolder As String) + '选择 Java + Dim Java = JavaSelect(New Version(1, 8, 0, 60)) + If Java Is Nothing Then + JavaMissing(8) + Throw New Exception("未找到用于安装 Forge 的 Java") + End If + '开始启动 + Dim Argument As String = String.Format("-cp ""{0};{1}"" com.bangbang93.ForgeInstaller ""{2}", PathTemp & "Cache\forge_installer.jar", Target, McFolder) + Dim Info = New ProcessStartInfo With { + .FileName = Java.PathJavaw, + .Arguments = Argument, + .UseShellExecute = False, + .CreateNoWindow = True, + .RedirectStandardError = True, + .RedirectStandardOutput = True + } + Log("[Download] 开始安装 Forge：" & Argument) + Dim process As New Process With {.StartInfo = Info} + Dim LastResults As New Queue(Of String) + Using outputWaitHandle As New AutoResetEvent(False) + Using errorWaitHandle As New AutoResetEvent(False) + AddHandler process.OutputDataReceived, Function(sender, e) + Try + If e.Data Is Nothing Then + outputWaitHandle.[Set]() + Else + LastResults.Enqueue(e.Data) + If LastResults.Count > 100 Then LastResults.Dequeue() + ForgeInjectorLine(e.Data, Task) + End If + Catch ex As ObjectDisposedException + Catch ex As Exception + Log(ex, "读取 Forge 安装器信息失败") + End Try + Try + If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then + Log("[Installer] 由于任务取消，已中止 Forge 安装") + process.Kill() + End If + Catch + End Try + Return Nothing + End Function + AddHandler process.ErrorDataReceived, Function(sender, e) + Try + If e.Data Is Nothing Then + errorWaitHandle.[Set]() + Else + LastResults.Enqueue(e.Data) + If LastResults.Count > 100 Then LastResults.Dequeue() + ForgeInjectorLine(e.Data, Task) + End If + Catch ex As ObjectDisposedException + Catch ex As Exception + Log(ex, "读取 Forge 安装器错误信息失败") + End Try + Try + If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then + Log("[Installer] 由于任务取消，已中止 Forge 安装") + process.Kill() + End If + Catch + End Try + Return Nothing + End Function + process.Start() + process.BeginOutputReadLine() + process.BeginErrorReadLine() + '等待 + Do Until process.HasExited + Thread.Sleep(10) + Loop + '输出 + outputWaitHandle.WaitOne(10000) + errorWaitHandle.WaitOne(10000) + process.Dispose() + If LastResults.Last = "true" Then Exit Sub + Log(Join(LastResults, vbCrLf)) + Throw New Exception("Forge 安装器出错，末行为 " & LastResults.Last) + End Using + End Using + ''判断结果 + 'Dim ReturnData As String = + 'If ModeDebug Then Log("[Download] Forge 安装器 Log：" & vbCrLf & ReturnData & vbCrLf) + ' If Not ReturnData.TrimEnd(vbCrLf.ToCharArray()).EndsWith("true") Then + ' Throw New Exception("自动安装过程出错，日志尾部：" & vbCrLf & ReturnData.Substring(Math.Max(0, ReturnData.Length - 1000))) + 'End If + End Sub + Private Sub ForgeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean)) + If Content.StartsWith(" Data") OrElse Content.StartsWith(" Slim") Then + If ModeDebug Then Log("[Installer] " & Content) + ElseIf Content.StartsWith(" Reading patch ") Then + If ModeDebug Then Log("[Installer] " & Content) + Task.Progress = 0.86 + Else + Select Case Content + Case "Extracting json" + Log("[Installer] " & Content) + Task.Progress = 0.07 + Case "Downloading libraries" + Log("[Installer] " & Content) + Task.Progress = 0.08 + Case " File exists: Checksum validated." + If ModeDebug Then Log("[Installer] " & Content) + Task.Progress += 0.003 + Case "Building Processors" + Task.Progress = 0.38 + Case "Task: DOWNLOAD_MOJMAPS" 'B + Task.Progress = 0.4 + Case "Task: MERGE_MAPPING" 'B + Task.Progress = 0.6 + Case "Splitting: " + Task.Progress = 0.62 + Case "Parameter Annotations" 'B + Task.Progress = 0.66 + Case "Processing Complete" 'B + Task.Progress = 0.7 + Case "Remapping final jar" 'A + Task.Progress = 0.72 + Case "Remapping jar... 50%" 'A + Task.Progress = 0.76 + Case "Remapping jar... 100%" 'A + Task.Progress = 0.81 + Case "Injecting profile" + Task.Progress = 0.91 + Case Else + If ModeDebug Then Log("[Installer] " & Content) + Exit Sub + End Select + Log("[Installer] " & Content) + End If + End Sub + + ''' + ''' 获取下载某个 Forge 版本的加载器列表。 + ''' + Private Function McDownloadForgeLoader(Version As String, Inherit As String, Optional DownloadInfo As DlForgeVersionEntry = Nothing, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase) + + '参数初始化 + McFolder = If(McFolder, PathMcFolder) + Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder + Dim Id As String = Inherit & "-forge-" & Version + Dim InstallerAddress As String = PathTemp & "Cache\Code\ForgeInstall-" & Version & "_" & RandomInteger(0, 100000) + Dim VersionFolder As String = McFolder & "versions\" & Id & "\" + Dim DisplayName As String = "Forge " & Inherit & " - " & Version + Dim Loaders As New List(Of LoaderBase) + Dim LibVersionFolder As String = PathMcFolder & "versions\" & Id & "\" '作为 Lib 文件目标的版本文件夹 + + '获取下载信息 + If DownloadInfo Is Nothing Then + Loaders.Add(New LoaderTask(Of String, String)("获取 Mod 加载器详细信息", + Sub(Task As LoaderTask(Of String, String)) + '获取 Forge 版本列表 + Dim ForgeLoader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("McDownloadForgeLoader " & Inherit, AddressOf DlForgeVersionMain) + ForgeLoader.WaitForExit(Inherit) + Task.Progress = 0.8 + '查找对应版本 + For Each ForgeVersion In ForgeLoader.Output + If ForgeVersion.Version = Version Then + DownloadInfo = ForgeVersion + Exit Sub + End If + Next + Throw New Exception("未能找到 Forge " & Inherit & "-" & Version & " 的详细信息！") + End Sub) With {.ProgressWeight = 3}) + End If + '下载 Forge 主文件 + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("准备 Mod 加载器下载", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + '启动依赖版本的下载 + If ClientDownloadLoader Is Nothing Then + If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器，则不能指定 MC 安装文件夹") + ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, Inherit) + End If + '添加主文件 + Dim Files As New List(Of NetFile) From {New NetFile({ + "https://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName, + "http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName, + "https://download.mcbbs.net/maven/net/minecraftforge/forge/" & Inherit & "-" & DownloadInfo.FileVersion & "/" & DownloadInfo.FileName + }, InstallerAddress, New FileChecker(MinSize:=64 * 1024, Hash:=DownloadInfo.Hash))} + Task.Output = Files + End Sub) With {.ProgressWeight = 0.5, .Show = False}) + Loaders.Add(New LoaderDownload("下载 Mod 加载器主文件", New List(Of NetFile)) With {.ProgressWeight = 9}) + + '安装（仅在新版安装时需要原版 Jar） + If Version.Split(".")(0) >= 20 Then + Log("[Download] 检测为新版 Forge：" & Version) + Dim Libs As List(Of McLibToken) = Nothing + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) + Task.Output = New List(Of NetFile) + Dim Installer As ZipArchive = Nothing + Try + '解压并获取、合并两个 Json 的信息 + Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) + Task.Progress = 0.2 + Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) + Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open)) + Json.Merge(Json2) + '获取 Lib 下载信息 + Libs = McLibListGetWithJson(Json, True) + '添加 Mappings 下载信息 + If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then + '下载原版 Json 文件 + Task.Progress = 0.4 + Log("[Download] 需要 Mappings 下载信息，开始获取原版 Json 文件") + Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True)) + '[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] + Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(0) + Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings.txt") + Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName, + .Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")}) + End If + Task.Progress = 0.8 + '去除其中的原始 Forge 项 + For i = 0 To Libs.Count - 1 + If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") Then + Libs.RemoveAt(i) + Exit For + End If + Next + Task.Output = McLibFixFromLibToken(Libs, PathMcFolder) + Catch ex As Exception + Throw New Exception("获取新版 Forge 支持库列表失败", ex) + Finally + '释放文件 + If Installer IsNot Nothing Then Installer.Dispose() + End Try + End Sub) With {.ProgressWeight = 2}) + Loaders.Add(New LoaderDownload("下载 Mod 加载器支持库文件", New List(Of NetFile)) With {.ProgressWeight = 12}) + Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("获取 Mod 下载器支持库文件", + Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) +#Region "Forge 文件" + If IsCustomFolder Then + For Each LibFile As McLibToken In Libs + Dim RealPath As String = LibFile.LocalPath.Replace(PathMcFolder, McFolder) + If Not File.Exists(RealPath) Then + Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath)) + File.Copy(LibFile.LocalPath, RealPath) + End If + If ModeDebug Then Log("[Download] 复制的 Forge 支持库文件：" & LibFile.LocalPath) + Next + End If +#End Region +#Region "原版文件" + '是否已经存在原版文件 + If ClientDownloadLoader Is Nothing Then Exit Sub + '等待原版文件下载完成 + For Each Loader In ClientDownloadLoader.GetLoaderList + If Loader.Name <> McDownloadClientLibName Then Continue For + Loader.WaitForExit() + Exit For + Next + '拷贝原版文件 + If IsCustomFolder Then + Try + Dim ClientName As String = New DirectoryInfo(ClientDownloadLoader.Input).Name + Directory.CreateDirectory(McFolder & "versions\" & Inherit) + If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then + File.Copy(ClientDownloadLoader.Input & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json") + End If + If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then + File.Copy(ClientDownloadLoader.Input & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") + End If + Catch ex As Exception + 'OptiFine 与 Forge 同时开始复制偶尔会导致冲突出错 + Log(ex, "安装 Forge 拷贝原版文件时出错") + End Try + End If +#End Region + End Sub) With {.ProgressWeight = 0.1, .Show = False}) + Loaders.Add(New LoaderTask(Of Boolean, Boolean)("安装 Mod 加载器（方式 A）", + Sub(Task As LoaderTask(Of Boolean, Boolean)) + Dim Installer As ZipArchive = Nothing + Try + Log("[Download] 开始进行新版方式 Forge 安装：" & InstallerAddress) + '解压并获取信息 + Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) + Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) + '新建目标版本文件夹 + Directory.CreateDirectory(VersionFolder) + '记录当前文件夹列表 + Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(Info As DirectoryInfo) As String + Return Info.FullName + End Function).ToList() + Task.Progress = 0.04 + '释放 launcher_installer.json + McFolderLauncherProfilesJsonCreate(McFolder) + Task.Progress = 0.05 + '释放 Forge 注入器 + WriteFile(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller")) + Task.Progress = 0.06 + '运行注入器 + ForgeInjector(InstallerAddress, Task, McFolder) + Task.Progress = 0.97 + '拷贝新增的版本 Json + Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.SkipWhile(Function(Info As DirectoryInfo) As Boolean + Return OldList.Contains(Info.FullName) + End Function).ToList() + If DeltaList.Count = 1 Then '如果没有新增文件夹，那么预测的文件夹名就是正确的 + Dim RealFolder As DirectoryInfo = DeltaList(0) + Dim JsonFile As FileInfo = RealFolder.EnumerateFiles.First() + JsonFile.CopyTo(VersionFolder & Id & ".json", True) + End If + '新建 mods 文件夹 + Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") + Catch ex As Exception + Throw New Exception("安装新 Forge 版本失败", ex) + End Try + '清理文件 + Try + If Installer IsNot Nothing Then Installer.Dispose() + If File.Exists(InstallerAddress) Then My.Computer.FileSystem.DeleteFile(InstallerAddress) + Catch ex As Exception + Log(ex, "安装 Forge 清理文件时出错") + End Try + End Sub) With {.ProgressWeight = 10}) + Else + Log("[Download] 检测为非新版 Forge：" & Version) + Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 Mod 加载器（方式 B）", + Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) + Dim Installer As ZipArchive = Nothing + Try + '解压并获取信息 + Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) + Task.Progress = 0.2 + Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) + Task.Progress = 0.4 + '新建版本文件夹 + Directory.CreateDirectory(VersionFolder) + Task.Progress = 0.5 + If Json("install") Is Nothing Then + '中版格式 + Log("[Download] 进行中版方式安装：" & InstallerAddress) + '建立 Json 文件 + Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open)) + JsonVersion("id") = Id + WriteFile(VersionFolder & Id & ".json", JsonVersion.ToString) + Task.Progress = 0.6 + '解压支持库文件 + Installer.Dispose() + ZipFile.ExtractToDirectory(InstallerAddress, InstallerAddress & "_unrar\") + My.Computer.FileSystem.CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\", True) + DeleteDirectory(InstallerAddress & "_unrar\") + Else + '旧版格式 + Log("[Download] 进行旧版方式安装：" & InstallerAddress) + '解压 Jar 文件 + Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder) + If File.Exists(JarAddress) Then File.Delete(JarAddress) + WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open) + Task.Progress = 0.9 + '建立 Json 文件 + Json("versionInfo")("id") = Id + If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit) + WriteFile(VersionFolder & Id & ".json", Json("versionInfo").ToString) + End If + '新建 mods 文件夹 + Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") + Catch ex As Exception + Throw New Exception("非新版方式安装 Forge 失败", ex) + End Try + Try + '释放文件 + If Installer IsNot Nothing Then Installer.Dispose() + If File.Exists(InstallerAddress) Then My.Computer.FileSystem.DeleteFile(InstallerAddress) + If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\") + Catch ex As Exception + Log(ex, "非新版方式安装 Forge 清理文件时出错") + End Try + End Sub) With {.ProgressWeight = 1}) + If FixLibrary Then + If IsCustomFolder Then Throw New Exception("若需要补全支持库，就不能自定义 MC 文件夹") + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) + Loaders.Add(New LoaderDownload("下载 Mod 加载器支持库文件", New List(Of NetFile)) With {.ProgressWeight = 11}) + End If + End If + + Return Loaders + End Function + +#End Region + +#Region "Forge 下载菜单" + + Public Sub ForgeDownloadListItemPreload(Stack As StackPanel, Entrys As List(Of DlForgeVersionEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) + '获取推荐版本与最新版本 + Dim FreshVersion As DlForgeVersionEntry = Nothing + If Entrys.Count > 0 Then + FreshVersion = Entrys(0) + Else + Log("[System] 未找到可用的 Forge 版本", LogLevel.Debug) + End If + Dim RecommendedVersion As DlForgeVersionEntry = Nothing + For Each Entry In Entrys + If Entry.IsRecommended Then RecommendedVersion = Entry + Next + '若推荐版本与最新版本为同一版本，则仅显示推荐版本 + If FreshVersion IsNot Nothing AndAlso FreshVersion Is RecommendedVersion Then FreshVersion = Nothing + '显示各个版本 + If RecommendedVersion IsNot Nothing Then + Dim Recommended = ForgeDownloadListItem(RecommendedVersion, OnClick, IsSaveOnly) + Recommended.Info = "推荐版" & If(Recommended.Info = "", "", "，" & Recommended.Info) + Stack.Children.Add(Recommended) + End If + If FreshVersion IsNot Nothing Then + Dim Fresh = ForgeDownloadListItem(FreshVersion, OnClick, IsSaveOnly) + Fresh.Info = "最新版" & If(Fresh.Info = "", "", "，" & Fresh.Info) + Stack.Children.Add(Fresh) + End If + '添加间隔 + Stack.Children.Add(New TextBlock With {.Text = "全部版本 (" & Entrys.Count & ")", .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 13, 0, 4)}) + End Sub + Public Function ForgeDownloadListItem(Entry As DlForgeVersionEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem + '建立控件 + Dim NewItem As New MyListItem With { + .Title = Entry.Version, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60, + .Info = If(Entry.ReleaseTime = "", + If(ModeDebug, "种类：" & Entry.Category & If(Entry.Branch Is Nothing, "", "，开发分支：" & Entry.Branch), ""), + "发布于 " & Entry.ReleaseTime & If(ModeDebug, "，种类：" & Entry.Category & If(Entry.Branch Is Nothing, "", "，开发分支：" & Entry.Branch), "")), + .Logo = "pack://application:,,,/images/Blocks/Anvil.png" + } + AddHandler NewItem.Click, OnClick + '建立菜单 + If IsSaveOnly Then + NewItem.ContentHandler = AddressOf ForgeSaveContMenuBuild + Else + NewItem.ContentHandler = AddressOf ForgeContMenuBuild + End If + '结束 + Return NewItem + End Function + Private Sub ForgeContMenuBuild(sender As MyListItem, e As EventArgs) + Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} + ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnSave, 30) + ToolTipService.SetHorizontalOffset(BtnSave, 2) + AddHandler BtnSave.Click, AddressOf ForgeSave_Click + Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} + ToolTipService.SetPlacement(BtnInfo, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnInfo, 30) + ToolTipService.SetHorizontalOffset(BtnInfo, 2) + AddHandler BtnInfo.Click, AddressOf ForgeLog_Click + sender.Buttons = {BtnSave, BtnInfo} + End Sub + Private Sub ForgeSaveContMenuBuild(sender As MyListItem, e As EventArgs) + Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} + ToolTipService.SetPlacement(BtnInfo, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnInfo, 30) + ToolTipService.SetHorizontalOffset(BtnInfo, 2) + AddHandler BtnInfo.Click, AddressOf ForgeLog_Click + sender.Buttons = {BtnInfo} + End Sub + Private Sub ForgeLog_Click(sender As Object, e As RoutedEventArgs) + Dim Version As DlForgeVersionEntry + If sender.Tag IsNot Nothing Then + Version = sender.Tag + ElseIf sender.Parent.Tag IsNot Nothing Then + Version = sender.Parent.Tag + Else + Version = sender.Parent.Parent.Tag + End If + OpenWebsite("http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & Version.Inherit & "-" & Version.Version & "/forge-" & Version.Inherit & "-" & Version.Version & "-changelog.txt") + End Sub + Public Sub ForgeSave_Click(sender As Object, e As RoutedEventArgs) + Dim Version As DlForgeVersionEntry + If sender.Tag IsNot Nothing Then + Version = sender.Tag + ElseIf sender.Parent.Tag IsNot Nothing Then + Version = sender.Parent.Tag + Else + Version = sender.Parent.Parent.Tag + End If + McDownloadForgeSave(Version) + End Sub + +#End Region + +#Region "Forge 推荐版本获取" + + ''' + ''' 尝试刷新 Forge 推荐版本缓存。 + ''' + Public Sub McDownloadForgeRecommendedRefresh() + If IsForgeRecommendedRefreshed Then Exit Sub + IsForgeRecommendedRefreshed = True + RunInNewThread(Sub() + Try + Log("[Download] 刷新 Forge 推荐版本缓存开始") + Dim Result As String = NetGetCodeByDownload({"https://bmclapi2.bangbang93.com/forge/promos", "https://download.mcbbs.net/forge/promos"}) + If Result.Length < 1000 Then Throw New Exception("获取的结果过短（" & Result & "）") + Dim ResultJson As JContainer = GetJson(Result) + '获取所有推荐版本列表 + Dim RecommendedList As New List(Of String) + For Each Version As JObject In ResultJson + If Version("name") Is Nothing OrElse Version("build") Is Nothing Then Continue For + Dim Name As String = Version("name") + If Not Name.EndsWith("-recommended") Then Continue For + '内容为："1.15.2":"31.2.0" + RecommendedList.Add("""" & Name.Replace("-recommended", """:""" & Version("build")("version").ToString & """")) + Next + If RecommendedList.Count < 5 Then Throw New Exception("获取的推荐版本数过少（" & Result & "）") + '保存 + Dim CacheJson As String = "{" & Join(RecommendedList, ",") & "}" + WriteFile(PathTemp & "Cache\ForgeRecommendedList.json", CacheJson) + Log("[Download] 刷新 Forge 推荐版本缓存成功") + Catch ex As Exception + Log(ex, "刷新 Forge 推荐版本缓存失败") + End Try + End Sub, "ForgeRecommendedRefresh") + End Sub + Private IsForgeRecommendedRefreshed As Boolean = False + + ''' + ''' 尝试获取某个 MC 版本对应的 Forge 推荐版本。如果不可用会返回 Nothing。 + ''' + Public Function McDownloadForgeRecommendedGet(McVersion As String) As String + Try + If McVersion Is Nothing Then Return Nothing + Dim List As String = ReadFile(PathTemp & "Cache\ForgeRecommendedList.json") + If List Is Nothing OrElse List = "" Then + Log("[Download] 没有 Forge 推荐版本缓存文件") + Return Nothing + End If + Dim Json As JObject = GetJson(List) + If Json Is Nothing OrElse (Not If(McVersion, "null").Contains(".")) OrElse Not Json.ContainsKey(McVersion) Then Return Nothing + Return If(Json(McVersion), "").ToString + Catch ex As Exception + Log(ex, "获取 Forge 推荐版本失败（" & If(McVersion, "null") & "）", LogLevel.Feedback) + Return Nothing + End Try + End Function + +#End Region + +#Region "Fabric 下载" + + Public Sub McDownloadFabricLoaderSave(DownloadInfo As JObject) + Try + Dim Url As String = DownloadInfo("url").ToString + Dim FileName As String = GetFileNameFromPath(Url) + Dim Version As String = GetFileNameFromPath(DownloadInfo("version").ToString) + Dim Target As String = SelectAs("选择保存位置", FileName, "Fabric 安装器 (*.jar)|*.jar") + If Not Target.Contains("\") Then Exit Sub + + '重复任务检查 + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = "Fabric " & Version & " 安装器下载" Then + Hint("该版本正在下载中！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + + '构造步骤加载器 + Dim Loaders As New List(Of LoaderBase) + '下载 + 'BMCLAPI 不支持 Fabric Installer 下载 + Dim Address As New List(Of String) + 'Address.Add(Url.Replace("maven.fabricmc.net", "download.mcbbs.net/maven")) + Address.Add(Url) + Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker(MinSize:=1024 * 64))}) With {.ProgressWeight = 15}) + '启动 + Dim Loader As New LoaderCombo(Of JObject)("Fabric " & Version & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} + Loader.Start(DownloadInfo) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + + Catch ex As Exception + Log(ex, "开始 Fabric 安装器下载失败", LogLevel.Feedback) + End Try + End Sub + + ''' + ''' 获取下载某个 Fabric 版本的加载器列表。 + ''' + Private Function McDownloadFabricLoader(FabricVersion As String, MinecraftName As String, Optional McFolder As String = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase) + + '参数初始化 + McFolder = If(McFolder, PathMcFolder) + Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder + Dim Id As String = "fabric-loader-" & FabricVersion & "-" & MinecraftName + Dim VersionFolder As String = McFolder & "versions\" & Id & "\" + Dim Loaders As New List(Of LoaderBase) + + '下载 Json + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取 Fabric 主文件下载地址", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) + '启动依赖版本的下载 + If FixLibrary Then + McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, MinecraftName) + End If + Task.Progress = 0.5 + '构造文件请求 + Task.Output = New List(Of NetFile) From {New NetFile({ + "https://download.mcbbs.net/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json", + "https://meta.fabricmc.net/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json" + }, VersionFolder & Id & ".json", New FileChecker(IsJson:=True))} + '新建 mods 文件夹 + Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") + End Sub) With {.ProgressWeight = 0.5}) + Loaders.Add(New LoaderDownload("下载 Fabric 主文件", New List(Of NetFile)) With {.ProgressWeight = 2.5}) + + '下载支持库 + If FixLibrary Then + Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Fabric 支持库文件", + Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) + Loaders.Add(New LoaderDownload("下载 Fabric 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 8}) + End If + + Return Loaders + End Function + +#End Region + +#Region "Fabric 下载菜单" + + Public Function FabricDownloadListItem(Entry As JObject, OnClick As MyListItem.ClickEventHandler) As MyListItem + '建立控件 + Dim NewItem As New MyListItem With { + .Title = Entry("version").ToString.Replace("+build", ""), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60, + .Info = If(Entry("stable").ToObject(Of Boolean), "稳定版", "测试版"), + .Logo = "pack://application:,,,/images/Blocks/Fabric.png" + } + AddHandler NewItem.Click, OnClick + '结束 + Return NewItem + End Function + Public Function FabricApiDownloadListItem(Entry As DlCfFile, OnClick As MyListItem.ClickEventHandler) As MyListItem + '建立控件 + Dim NewItem As New MyListItem With { + .Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60, + .Info = Entry.ReleaseTypeString & "，发布于 " & Entry.Date.ToString("yyyy/MM/dd HH:mm"), + .Logo = "pack://application:,,,/images/Blocks/Fabric.png" + } + AddHandler NewItem.Click, OnClick + '结束 + Return NewItem + End Function + Public Function OptiFabricDownloadListItem(Entry As DlCfFile, OnClick As MyListItem.ClickEventHandler) As MyListItem + '建立控件 + Dim NewItem As New MyListItem With { + .Title = Entry.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v"), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .PaddingRight = 60, + .Info = Entry.ReleaseTypeString & "，发布于 " & Entry.Date.ToString("yyyy/MM/dd HH:mm"), + .Logo = "pack://application:,,,/images/Blocks/OptiFabric.png" + } + AddHandler NewItem.Click, OnClick + '结束 + Return NewItem + End Function + +#End Region + +#Region "合并安装" + + ''' + ''' 安装请求。 + ''' + Public Class McInstallRequest + + ''' + ''' 必填。安装目标版本名称。 + ''' + Public TargetVersionName As String + + ''' + ''' 必填。欲下载的 Minecraft 的版本名。 + ''' + Public MinecraftName As String = Nothing + ''' + ''' 可选。欲下载的 Minecraft Json 地址。 + ''' + Public MinecraftJson As String = Nothing + + '若要下载 OptiFine，则需要在下面两项中完成至少一项 + ''' + ''' 欲下载的 OptiFine 版本名。例如 HD_U_F6_pre1。 + ''' + Public OptiFineVersion As String = Nothing + ''' + ''' 欲下载的 OptiFine 详细信息。 + ''' + Public OptiFineEntry As DlOptiFineListEntry = Nothing + + '若要下载 Forge，则需要在下面两项中完成至少一项 + ''' + ''' 欲下载的 Forge 版本名。例如 36.1.4。 + ''' + Public ForgeVersion As String = Nothing + ''' + ''' 欲下载的 Forge。 + ''' + Public ForgeEntry As DlForgeVersionEntry = Nothing + + ''' + ''' 欲下载的 Fabric Loader 版本名。 + ''' + Public FabricVersion As String = Nothing + + ''' + ''' 欲下载的 Fabric API 信息。 + ''' + Public FabricApi As DlCfFile = Nothing + + ''' + ''' 欲下载的 OptiFabric 信息。 + ''' + Public OptiFabric As DlCfFile = Nothing + + ''' + ''' 欲下载的 LiteLoader 详细信息。 + ''' + Public LiteLoaderEntry As DlLiteLoaderListEntry = Nothing + + End Class + + ''' + ''' 安装加载器状态改变后进行提示和重载文件夹列表的方法。 + ''' + Public Sub McInstallState(Loader) + Select Case Loader.State + Case LoadState.Finished + WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '清空缓存（合并安装会先生成文件夹，这会在刷新时误判为可以使用缓存） + Hint(Loader.Name & "成功！", HintType.Finish) + Case LoadState.Failed + Hint(Loader.Name & "失败：" & GetString(Loader.Error), HintType.Critical) + Case LoadState.Aborted + Hint(Loader.Name & "已取消！", HintType.Info) + Case LoadState.Loading + Exit Sub '不重新加载版本列表 + End Select + McInstallFailedClearFolder(Loader) + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + End Sub + ''' + ''' 安装加载器状态改变后进行提示的方法。它不会在失败时删除文件夹，也不会刷新 MC 文件夹。 + ''' + Public Sub DownloadStateSave(Loader) + Select Case Loader.State + Case LoadState.Finished + Hint(Loader.Name & "成功！", HintType.Finish) + Case LoadState.Failed + Hint(Loader.Name & "失败：" & GetString(Loader.Error), HintType.Critical) + Case LoadState.Aborted + Hint(Loader.Name & "已取消！", HintType.Info) + Case LoadState.Loading + Exit Sub '不重新加载版本列表 + End Select + End Sub + Public Sub McInstallFailedClearFolder(Loader) + Try + Thread.Sleep(1000) '防止存在尚未完全释放的文件，导致清理失败（例如整合包安装） + If Loader.State = LoadState.Failed OrElse Loader.State = LoadState.Aborted Then + '删除版本文件夹 + If Directory.Exists(Loader.Input & "saves\") OrElse Directory.Exists(Loader.Input & "versions\") Then + Log("[Download] 由于版本已被独立启动，不清理版本文件夹：" & Loader.Input, LogLevel.Developer) + Else + Log("[Download] 由于下载失败或取消，清理版本文件夹：" & Loader.Input, LogLevel.Developer) + DeleteDirectory(Loader.Input) + End If + End If + Catch ex As Exception + Log(ex, "下载失败或取消后清理版本文件夹失败") + End Try + End Sub + + ''' + ''' 进行合并安装。返回是否已经开始安装（例如如果没有安装 Java 则会进行提示并返回 False） + ''' + Public Function McInstall(Request As McInstallRequest) As Boolean + Try + Dim SubLoaders = McInstallLoader(Request) + If SubLoaders Is Nothing Then Return False + Dim Loader As New LoaderCombo(Of String)(Request.TargetVersionName & " 安装", SubLoaders) With {.OnStateChanged = AddressOf McInstallState} + + '启动 + Loader.Start(PathMcFolder & "versions\" & Request.TargetVersionName & "\") + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + Return True + + Catch ex As Exception + Log(ex, "开始合并安装失败", LogLevel.Feedback) + Return False + End Try + End Function + ''' + ''' 获取合并安装加载器列表，并进行前期的缓存清理与 Java 检查工作。 + ''' 如果出现已知问题且已提示用户，则返回 Nothing。出现异常则直接抛出。 + ''' + Public Function McInstallLoader(Request As McInstallRequest, Optional DontFixLibraries As Boolean = False) As List(Of LoaderBase) + Try + '清理缓存 + If Not IsInstallTempCleared Then + IsInstallTempCleared = True + DeleteDirectory(PathTemp & "Install\", True) + Log("[Download] 已清理合并安装缓存") + End If + Catch ex As Exception + Log(ex, "清理合并安装缓存失败") + End Try + + '获取参数 + Dim OutputFolder As String = PathMcFolder & "versions\" & Request.TargetVersionName & "\" + Dim TempMcFolder As String = PathTemp & "Install\" & Request.TargetVersionName & "\" + If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder) + Dim OptiFineFolder As String = Nothing + If Request.OptiFineVersion IsNot Nothing Then + Request.OptiFineEntry = New DlOptiFineListEntry With { + .NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", ""), + .Inherit = Request.MinecraftName, + .IsPreview = Request.OptiFineVersion.ToLower.Contains("pre"), + .NameVersion = Request.MinecraftName & "-OptiFine_" & Request.OptiFineVersion, + .NameFile = If(Request.OptiFineVersion.ToLower.Contains("pre"), "preview_", "") & + "OptiFine_" & Request.MinecraftName & "_" & Request.OptiFineVersion & ".jar" + } + End If + If Request.OptiFineEntry IsNot Nothing Then OptiFineFolder = TempMcFolder & "versions\" & Request.OptiFineEntry.NameVersion + Dim ForgeFolder As String = Nothing + If Request.ForgeEntry IsNot Nothing Then Request.ForgeVersion = If(Request.ForgeVersion, Request.ForgeEntry.Version) + If Request.ForgeVersion IsNot Nothing Then ForgeFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-forge-" & Request.ForgeVersion + Dim FabricFolder As String = Nothing + If Request.FabricVersion IsNot Nothing Then FabricFolder = TempMcFolder & "versions\fabric-loader-" & Request.FabricVersion & "-" & Request.MinecraftName + Dim LiteLoaderFolder As String = Nothing + If Request.LiteLoaderEntry IsNot Nothing Then LiteLoaderFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-LiteLoader" + + 'OptiFine 是否作为 Mod 进行下载 + Dim OptiFineAsMod As Boolean = + (Request.OptiFineEntry IsNot Nothing OrElse Request.OptiFineVersion IsNot Nothing) AndAlso Request.FabricVersion IsNot Nothing + If OptiFineAsMod Then + Log("[Download] OptiFine 将作为 Mod 进行下载") + OptiFineFolder = New McVersion(OutputFolder).GetPathIndie(True) & "mods\" + End If + + '记录日志 + If OptiFineFolder IsNot Nothing Then Log("[Download] OptiFine 缓存：" & OptiFineFolder) + If ForgeFolder IsNot Nothing Then Log("[Download] Forge 缓存：" & ForgeFolder) + If FabricFolder IsNot Nothing Then Log("[Download] Fabric 缓存：" & FabricFolder) + If LiteLoaderFolder IsNot Nothing Then Log("[Download] LiteLoader 缓存：" & LiteLoaderFolder) + Log("[Download] 对应的原版版本：" & Request.MinecraftName) + + '重复版本检查 + If File.Exists(OutputFolder & Request.TargetVersionName & ".json") Then + Hint("版本 " & Request.TargetVersionName & " 已经存在！", HintType.Critical) + Return Nothing + End If + + Dim LoaderList As New List(Of LoaderBase) + 'Fabric API + If Request.FabricApi IsNot Nothing Then + LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.GetDownloadFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\", False)}) 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.GetDownloadFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\", False)}) 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} + 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}) + Else + LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.NameDisplay, McDownloadOptiFineLoader(Request.OptiFineEntry, TempMcFolder, ClientLoader, False)) With {.Show = False, .ProgressWeight = 24, .Block = Request.ForgeVersion 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, McDownloadForgeLoader(Request.ForgeVersion, Request.MinecraftName, Request.ForgeEntry, TempMcFolder, ClientLoader, False)) With {.Show = False, .ProgressWeight = 25, .Block = 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}) + End If + 'Fabric Loader + 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}) + End If + '合并安装 + LoaderList.Add(New LoaderTask(Of String, String)("安装游戏", Sub(Task As LoaderTask(Of String, String)) + InstallMerge(OutputFolder, OutputFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, FabricFolder, LiteLoaderFolder) + Task.Progress = 0.3 + If Directory.Exists(TempMcFolder & "libraries") Then My.Computer.FileSystem.CopyDirectory(TempMcFolder & "libraries", PathMcFolder & "libraries", True) + If Directory.Exists(TempMcFolder & "mods") Then My.Computer.FileSystem.CopyDirectory(TempMcFolder & "mods", PathMcFolder & "mods", True) + End Sub) With {.ProgressWeight = 2, .Block = True}) + '补全文件 + If Not DontFixLibraries AndAlso + (Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.Split(".")(0) >= 20) 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 LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False}) + LoaderList.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) + End If + '总加载器 + Return LoaderList + End Function + Private IsInstallTempCleared As Boolean = False + + ''' + ''' 将多个版本 Json 进行合并，如果目标已存在则直接覆盖。失败会抛出异常。 + ''' + 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 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, "") & + If(LiteLoaderFolder IsNot Nothing, "，LiteLoader：" & LiteLoaderFolder, "") & + If(FabricFolder IsNot Nothing, "，Fabric：" & FabricFolder, "")) + Directory.CreateDirectory(OutputFolder) + + Dim HasOptiFine As Boolean = OptiFineFolder IsNot Nothing AndAlso Not OptiFineAsMod, HasForge As Boolean = ForgeFolder IsNot Nothing, HasLiteLoader As Boolean = LiteLoaderFolder IsNot Nothing, HasFabric As Boolean = FabricFolder IsNot Nothing + Dim OutputName As String, MinecraftName As String, OptiFineName As String, ForgeName As String, LiteLoaderName As String, FabricName As String + Dim OutputJsonPath As String, MinecraftJsonPath As String, OptiFineJsonPath As String = Nothing, ForgeJsonPath As String = Nothing, LiteLoaderJsonPath As String = Nothing, FabricJsonPath As String = Nothing + Dim OutputJar As String, MinecraftJar As String +#Region "初始化路径信息" + If Not OutputFolder.EndsWith("\") Then OutputFolder += "\" + OutputName = GetFolderNameFromPath(OutputFolder) + OutputJsonPath = OutputFolder & OutputName & ".json" + OutputJar = OutputFolder & OutputName & ".jar" + + If Not MinecraftFolder.EndsWith("\") Then MinecraftFolder += "\" + MinecraftName = GetFolderNameFromPath(MinecraftFolder) + MinecraftJsonPath = MinecraftFolder & MinecraftName & ".json" + MinecraftJar = MinecraftFolder & MinecraftName & ".jar" + + If HasOptiFine Then + If Not OptiFineFolder.EndsWith("\") Then OptiFineFolder += "\" + OptiFineName = GetFolderNameFromPath(OptiFineFolder) + OptiFineJsonPath = OptiFineFolder & OptiFineName & ".json" + End If + + If HasForge Then + If Not ForgeFolder.EndsWith("\") Then ForgeFolder += "\" + ForgeName = GetFolderNameFromPath(ForgeFolder) + ForgeJsonPath = ForgeFolder & ForgeName & ".json" + End If + + If HasLiteLoader Then + If Not LiteLoaderFolder.EndsWith("\") Then LiteLoaderFolder += "\" + LiteLoaderName = GetFolderNameFromPath(LiteLoaderFolder) + LiteLoaderJsonPath = LiteLoaderFolder & LiteLoaderName & ".json" + End If + + If HasFabric Then + If Not FabricFolder.EndsWith("\") Then FabricFolder += "\" + FabricName = GetFolderNameFromPath(FabricFolder) + FabricJsonPath = FabricFolder & FabricName & ".json" + End If +#End Region + + Dim OutputJson As JObject, MinecraftJson As JObject, OptiFineJson As JObject = Nothing, ForgeJson As JObject = Nothing, LiteLoaderJson As JObject = Nothing, FabricJson As JObject = Nothing +#Region "读取文件并检查文件是否合规" + Dim MinecraftJsonText As String = ReadFile(MinecraftJsonPath) + If Not MinecraftJsonText.StartsWith("{") Then Throw New Exception("Minecraft Json 有误，地址：" & MinecraftJsonPath & "，前段内容：" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000))) + MinecraftJson = GetJson(MinecraftJsonText) + + If HasOptiFine Then + Dim OptiFineJsonText As String = ReadFile(OptiFineJsonPath) + If Not OptiFineJsonText.StartsWith("{") Then Throw New Exception("OptiFine Json 有误，地址：" & OptiFineJsonPath & "，前段内容：" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000))) + OptiFineJson = GetJson(OptiFineJsonText) + End If + + If HasForge Then + Dim ForgeJsonText As String = ReadFile(ForgeJsonPath) + If Not ForgeJsonText.StartsWith("{") Then Throw New Exception("Forge Json 有误，地址：" & ForgeJsonPath & "，前段内容：" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000))) + ForgeJson = GetJson(ForgeJsonText) + End If + + If HasLiteLoader Then + Dim LiteLoaderJsonText As String = ReadFile(LiteLoaderJsonPath) + If Not LiteLoaderJsonText.StartsWith("{") Then Throw New Exception("LiteLoader Json 有误，地址：" & LiteLoaderJsonPath & "，前段内容：" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000))) + LiteLoaderJson = GetJson(LiteLoaderJsonText) + End If + + If HasFabric Then + Dim FabricJsonText As String = ReadFile(FabricJsonPath) + If Not FabricJsonText.StartsWith("{") Then Throw New Exception("Fabric Json 有误，地址：" & FabricJsonPath & "，前段内容：" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000))) + FabricJson = GetJson(FabricJsonText) + End If +#End Region + +#Region "处理 Json 文件" + '获取 minecraftArguments + Dim AllArguments As String = + If(MinecraftJson("minecraftArguments"), " ").ToString & + If(OptiFineJson IsNot Nothing, If(OptiFineJson("minecraftArguments"), " ").ToString, " ") & + If(ForgeJson IsNot Nothing, If(ForgeJson("minecraftArguments"), " ").ToString, " ") & + If(LiteLoaderJson IsNot Nothing, If(LiteLoaderJson("minecraftArguments"), " ").ToString, " ") + Dim SplitArguments As New List(Of String) + For Each Argument In AllArguments.Split("--") + Argument = Argument.Trim + If Argument <> "" Then SplitArguments.Add(Argument) + Next + SplitArguments = ArrayNoDouble(SplitArguments) + Dim RealArguments As String = Nothing + If SplitArguments.Count > 0 Then + RealArguments = "--" & Join(SplitArguments, " --") + End If + '合并 + OutputJson = MinecraftJson + If HasOptiFine Then + '合并 OptiFine + OptiFineJson.Remove("releaseTime") + OptiFineJson.Remove("time") + OutputJson.Merge(OptiFineJson) + End If + If HasForge Then + '合并 Forge + ForgeJson.Remove("releaseTime") + ForgeJson.Remove("time") + OutputJson.Merge(ForgeJson) + End If + If HasLiteLoader Then + '合并 LiteLoader + LiteLoaderJson.Remove("releaseTime") + LiteLoaderJson.Remove("time") + OutputJson.Merge(LiteLoaderJson) + End If + If HasFabric Then + '合并 Fabric + FabricJson.Remove("releaseTime") + FabricJson.Remove("time") + OutputJson.Merge(FabricJson) + End If + '修改 + If RealArguments IsNot Nothing Then OutputJson("minecraftArguments") = RealArguments + OutputJson.Remove("_comment_") + OutputJson.Remove("inheritsFrom") + OutputJson.Remove("jar") + OutputJson("id") = OutputName +#End Region + +#Region "保存" + WriteFile(OutputJsonPath, OutputJson.ToString) + If MinecraftJar <> OutputJar Then '可能是同一个文件 + If File.Exists(OutputJar) Then File.Delete(OutputJar) + File.Copy(MinecraftJar, OutputJar) + End If + Log("[Download] 版本合并 " & OutputName & " 完成") +#End Region + + End Sub + +#End Region + +End Module diff --git a/Plain Craft Launcher 2/Pages/PageDownload/MyCfItem.xaml b/Plain Craft Launcher 2/Pages/PageDownload/MyCfItem.xaml new file mode 100644 index 0000000..239354b --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/MyCfItem.xaml @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/MyCfItem.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/MyCfItem.xaml.vb new file mode 100644 index 0000000..2fed02e --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/MyCfItem.xaml.vb @@ -0,0 +1,200 @@ +Public Class MyCfItem + Public Uuid As Integer = GetUuid() + +#Region "Logo" + + 'Public CacheLogo As Boolean = True '是否缓存 Logo：通过下载量确定是否为默认页 + Private _Logo As String = "" + Public Property Logo As String + Get + Return _Logo + End Get + Set(value As String) + If _Logo = value OrElse value Is Nothing Then Exit Property + _Logo = value + Dim FileAddress = PathTemp & "CFLogo\" & GetHash(_Logo) & ".png" + Try + If _Logo.ToLower.StartsWith("http") Then + '网络图片 + If File.Exists(FileAddress) Then + PathLogo.Source = New MyBitmap(FileAddress) + Else + PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png") + RunInNewThread(Sub() LogoLoader(FileAddress), "CurseForge Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal) + End If + Else + '位图 + PathLogo.Source = New MyBitmap(_Logo) + End If + Catch ex As IOException + Log(ex, "加载 CurseForge 工程图标时读取失败（" & FileAddress & "）") + Catch ex As ArgumentException + '考虑缓存的图片本身可能有误 + Log(ex, "可视化 CurseForge 工程图标失败（" & FileAddress & "）") + Try + File.Delete(FileAddress) + Log("[Download] 已清理损坏的 CurseForge 工程图标：" & FileAddress) + Catch exx As Exception + Log(exx, "清理损坏的 CurseForge 工程图标缓存失败（" & FileAddress & "）", LogLevel.Hint) + End Try + Catch ex As Exception + Log(ex, "加载 CurseForge 工程图标失败（" & value & "）") + End Try + End Set + End Property + + Private Sub LogoLoader(Address As String) + Dim Retry As Boolean = False + Dim DownloadEnd As String = GetUuid() +RetryStart: + Try + NetDownload(_Logo, Address & DownloadEnd) + RunInUiWait(Sub() + Try + '在地址更换时取消加载 + If Not Address = PathTemp & "CFLogo\" & GetHash(_Logo) & ".png" Then Exit Sub + '在完成正常加载后才保存缓存图片 + PathLogo.Source = New MyBitmap(Address & DownloadEnd) + Catch ex As Exception + Log(ex, "读取 CurseForge 工程图标失败（" & Address & "）", LogLevel.Hint) + End Try + End Sub) + If File.Exists(Address) Then + File.Delete(Address & DownloadEnd) + Else + FileIO.FileSystem.MoveFile(Address & DownloadEnd, Address) + End If + Catch ex As Exception + If Not Retry Then + Retry = True + GoTo RetryStart + Else + Log(ex, "下载 CurseForge 工程图标失败") + End If + End Try + End Sub + +#End Region + +#Region "点击" + + '触发点击事件 + Public Event Click(sender As Object, e As MouseButtonEventArgs) + Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp + If IsMouseDown Then + RaiseEvent Click(sender, e) + If e.Handled Then Exit Sub + Log("[Control] 按下 CurseForge 工程列表项：" & LabTitle.Text) + End If + End Sub + + '鼠标点击判定 + Private IsMouseDown As Boolean = False + Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown + If IsMouseOver Then IsMouseDown = True + End Sub + Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp + IsMouseDown = False + End Sub + +#End Region + +#Region "后加载指向背景" + + Private _RectBack As Border = Nothing + Public ReadOnly Property RectBack As Border + Get + If _RectBack Is Nothing Then + Dim Rect As New Border With { + .Name = "RectBack", + .CornerRadius = New CornerRadius(3), + .RenderTransform = New ScaleTransform(0.8, 0.8), + .RenderTransformOrigin = New Point(0.5, 0.5), + .BorderThickness = New Thickness(GetWPFSize(1)), + .SnapsToDevicePixels = True, + .IsHitTestVisible = False, + .Opacity = 0 + } + Rect.SetResourceReference(Border.BackgroundProperty, "ColorBrush7") + Rect.SetResourceReference(Border.BorderBrushProperty, "ColorBrush6") + SetColumnSpan(Rect, 999) + SetRowSpan(Rect, 999) + Children.Insert(0, Rect) + _RectBack = Rect + ' + End If + Return _RectBack + End Get + End Property + +#End Region + + Private StateLast As String + Public HasAnimation As Boolean = True + Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp + If Not HasAnimation Then Exit Sub + '判断当前颜色 + Dim StateNew As String, Time As Integer + If IsMouseOver Then + If IsMouseDown Then + StateNew = "MouseDown" + Time = 120 + Else + StateNew = "MouseOver" + Time = 120 + End If + Else + StateNew = "Idle" + Time = 180 + End If + If StateLast = StateNew Then Exit Sub + StateLast = StateNew + '触发颜色动画 + If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 + '有动画 + Dim Ani As New List(Of AniData) + If IsMouseOver Then + Ani.AddRange({ + AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush9"), Time), + AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent) + }) + If IsMouseDown Then + Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent)) + Else + Ani.Add(AaScaleTransform(RectBack, 1 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent)) + End If + Else + Ani.AddRange({ + AaOpacity(RectBack, -RectBack.Opacity, Time), + AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time), + AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent), + AaScaleTransform(RectBack, -0.196, 1,,, True) + }) + End If + AniStart(Ani, "CfItem Color " & Uuid) + Else + '无动画 + AniStop("CfItem Color " & Uuid) + If _RectBack IsNot Nothing Then RectBack.Opacity = 0 + End If + End Sub + + '指向时扩展描述 + Private Sub LabInfo_MouseEnter(sender As Object, e As MouseEventArgs) Handles LabInfo.MouseEnter + If IsTextTrimmed(LabInfo) Then + ToolTipInfo.Content = LabInfo.Text + ToolTipInfo.Width = LabInfo.ActualWidth + 25 + LabInfo.ToolTip = ToolTipInfo + Else + LabInfo.ToolTip = Nothing + End If + End Sub + Private Function IsTextTrimmed(textBlock As TextBlock) As Boolean + Dim typeface As New Typeface(textBlock.FontFamily, textBlock.FontStyle, textBlock.FontWeight, textBlock.FontStretch) + Dim formattedText As New FormattedText(textBlock.Text, Thread.CurrentThread.CurrentCulture, textBlock.FlowDirection, typeface, textBlock.FontSize, textBlock.Foreground, DPI) + Return formattedText.Width > textBlock.ActualWidth + End Function + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCfDetail.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCfDetail.xaml new file mode 100644 index 0000000..220557c --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCfDetail.xaml @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCfDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCfDetail.xaml.vb new file mode 100644 index 0000000..b18ea7b --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCfDetail.xaml.vb @@ -0,0 +1,261 @@ +Public Class PageDownloadCfDetail + Private CfItem As MyCfItem = Nothing + Private Project As DlCfProject + +#Region "加载器" + + '初始化加载器信息 + Private Sub PageDownloadCfDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized + Project = FrmMain.PageCurrent.Additional + PageLoaderInit(Load, PanLoad, PanMain, CardIntro, DlCfFileLoader, AddressOf Load_OnFinish, AddressOf LoaderInput) + End Sub + Private Function LoaderInput() As KeyValuePair(Of Integer, Boolean) + Return New KeyValuePair(Of Integer, Boolean)(Project.Id, Project.IsModPack) + End Function + '自动重试 + Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged + Select Case DlCfFileLoader.State + Case LoadState.Failed + Dim ErrorMessage As String = "" + If DlCfFileLoader.Error IsNot Nothing Then ErrorMessage = DlCfFileLoader.Error.Message + If ErrorMessage.Contains("不是有效的 Json 文件") Then + Log("[Download] 下载的 Mod 列表 Json 文件损坏，已自动重试", LogLevel.Debug) + PageLoaderRestart() + End If + End Select + End Sub + '结果 UI 化 + Private Class VersionSorterWithSelect + Implements IComparer(Of String) + Public Top As String = "" + Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare + If x = y Then Return 0 + If x = Top Then Return -1 + If y = Top Then Return 1 + Return -VersionSortInteger(x, y) + End Function + Public Sub New(Optional Top As String = "") + Me.Top = If(Top, "") + End Sub + End Class + Private Sub Load_OnFinish() + + '初始化字典，并将当前版本排在最上面 + Dim TopVersion As String + If Project.IsModPack Then + TopVersion = If(PageDownloadPack.Loader.Input.GameVersion, "") + Else + TopVersion = If(PageDownloadMod.Loader.Input.GameVersion, "") + End If + Dim Dict As New SortedDictionary(Of String, List(Of DlCfFile))(New VersionSorterWithSelect(TopVersion)) + 'PCL#8826 汇报了奇怪的这个 Try 块里出现 NPE 的问题，但实在找不到，就瞎加点检测 + Try + Dict.Add("未知版本", New List(Of DlCfFile)) + If DlCfFileLoader.Output Is Nothing Then + Log("[Download] 列表加载输出为 Nothing，请反馈此问题", LogLevel.Feedback) + Exit Try + End If + For Each Version As DlCfFile In DlCfFileLoader.Output + If Version Is Nothing Then + Log("[Download] 列表中的一个版本为 Nothing，请反馈此问题", LogLevel.Feedback) + Continue For + End If + If Version.GameVersion Is Nothing Then + Log("[Download] 列表中的一个版本没有任何适配的游戏版本，返回为 Nothing，请反馈此问题", LogLevel.Feedback) + Continue For + End If + For Each GameVersion In Version.GameVersion + '决定添加到哪个版本 + Dim TargetVersion As String + If GameVersion Is Nothing OrElse GameVersion.Split(".").Count < 2 Then + TargetVersion = "未知版本" + Else + TargetVersion = GameVersion + End If + '实际进行添加 + If Not Dict.ContainsKey(TargetVersion) Then Dict.Add(TargetVersion, New List(Of DlCfFile)) + If Not Dict(TargetVersion).Contains(Version) Then Dict(TargetVersion).Add(Version) + Next + Next + Catch ex As Exception + Log(ex, "准备工程下载列表出错", LogLevel.Feedback) + End Try + +#Region "转化为 UI" + Try + '清空当前 + PanMain.Children.Clear() + '转化为 UI + For Each Pair As KeyValuePair(Of String, List(Of DlCfFile)) In Dict + If Pair.Value.Count = 0 Then Continue For + '增加卡片 + Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(Project.IsModPack, 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 + PanMain.Children.Add(NewCard) + '确定卡片是否展开 + If Pair.Key = TopVersion Then + MyCard.StackInstall(NewStack, 8, Pair.Key) + Else + NewCard.IsSwaped = True + End If + '增加提示 + If Pair.Key = "未知版本" Then + NewStack.Children.Add(New MyHint With {.Text = "由于 API 的版本信息更新缓慢，可能无法识别刚更新不久的 MC 版本，只需等待几天即可自动恢复正常。", .IsWarn = False, .Margin = New Thickness(0, 0, 0, 7)}) + End If + Next + '如果只有一张卡片，展开第一张卡片 + If PanMain.Children.Count = 1 Then + CType(PanMain.Children(0), MyCard).IsSwaped = False + End If + Catch ex As Exception + Log(ex, "可视化工程下载列表出错", LogLevel.Feedback) + End Try +#End Region + + End Sub + +#End Region + + Private IsFirstInit As Boolean = True + Public Sub Init() Handles Me.OnPageEnter + AniControlEnabled += 1 + Project = FrmMain.PageCurrent.Additional + PanBack.ScrollToHome() + + '重启加载器 + If IsFirstInit Then + '在 Me.Initialized 已经初始化了加载器，不再重复初始化 + IsFirstInit = False + Else + PageLoaderRestart(IsForceRestart:=True) + End If + + '放置当前工程 + If CfItem IsNot Nothing Then PanIntro.Children.Remove(CfItem) + CfItem = Project.ToCfItem(True, True) + CfItem.Margin = New Thickness(-7, -7, 0, 8) + PanIntro.Children.Insert(0, CfItem) + + '决定按钮显示 + BtnIntroWiki.Visibility = If(Project.McWikiId = 0, Visibility.Collapsed, Visibility.Visible) + BtnIntroMCBBS.Visibility = If(Project.MCBBS Is Nothing, Visibility.Collapsed, Visibility.Visible) + + AniControlEnabled -= 1 + End Sub + + '整合包下载（安装） + Public Sub Install_Click(sender As MyListItem, e As EventArgs) + Try + + '获取基本信息 + Dim File As DlCfFile = sender.Tag + Dim LoaderName As String = "CurseForge 整合包下载：" & Project.ChineseName & " " + + '获取版本名 + Dim PackName As String = Project.ChineseName.Replace(".zip", "").Replace(".rar", "").Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：") + 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}, + Title:="输入版本名", Button2:="取消") + If String.IsNullOrEmpty(VersionName) Then Exit Sub + + '构造步骤加载器 + Dim Loaders As New List(Of LoaderBase) + Dim Target As String = PathMcFolder & "versions\" & VersionName & "\原始整合包.zip" + Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 10, .Block = True}) + Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包", Sub() ModpackInstall(Target, VersionName)) With {.ProgressWeight = 0.1}) + + '启动 + Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Sub(MyLoader) + Select Case MyLoader.State + Case LoadState.Failed + Hint(MyLoader.Name & "失败：" & GetString(MyLoader.Error), HintType.Critical) + Case LoadState.Aborted + Hint(MyLoader.Name & "已取消！", HintType.Info) + Case LoadState.Loading + Exit Sub '不重新加载版本列表 + End Select + McInstallFailedClearFolder(MyLoader) + End Sub} + Loader.Start(PathMcFolder & "versions\" & VersionName & "\") + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + + Catch ex As Exception + Log(ex, "下载 CurseForge 整合包失败", LogLevel.Feedback) + End Try + End Sub + 'Mod 下载；整合包另存为 + Public Shared DownloadFolder = Nothing '仅在本次缓存的下载文件夹 + Public Sub Save_Click(sender As Object, e As EventArgs) + Try + Dim Desc As String = If(Project.IsModPack, "整合包", "Mod ") + + '确认默认保存位置 + Dim DefaultFolder As String = Nothing + If Not Project.IsModPack Then + DefaultFolder = DownloadFolder + If McVersionCurrent IsNot Nothing Then + If Not McVersionCurrent.IsLoaded Then McVersionCurrent.Load() + If McVersionCurrent.Version.Modable Then + DefaultFolder = McVersionCurrent.PathIndie & "mods\" + Directory.CreateDirectory(DefaultFolder) + End If + End If + If String.IsNullOrEmpty(DefaultFolder) Then DefaultFolder = Nothing + End If + + '获取基本信息 + Dim File As DlCfFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag + Dim ChineseName As String = If(Project.ChineseName = Project.Name, "", + Project.ChineseName.Replace(" (", "Å").Split("Å").First.Replace("\", "＼").Replace("/", "／").Replace("|", "｜").Replace(":", "：").Replace("<", "＜").Replace(">", "＞").Replace("*", "＊").Replace("?", "？").Replace("""", "").Replace("： ", "：")) + Dim FileName As String + Select Case Setup.Get("ToolDownloadTranslate") + Case 0 + FileName = If(ChineseName = "", "", "[" & ChineseName & "] ") & File.FileName + Case 1 + FileName = If(ChineseName = "", "", ChineseName & "-") & File.FileName + Case 2 + FileName = File.FileName & If(ChineseName = "", "", "-" & ChineseName) + Case Else + FileName = File.FileName + End Select + Dim Target As String + If File.FileName.EndsWith(".litemod") Then + Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.litemod"), DefaultFolder) + Else + Target = SelectAs("选择保存位置", FileName, Desc & "文件|" & If(Project.IsModPack, "*.zip", "*.jar"), DefaultFolder) + End If + If Not Target.Contains("\") Then Exit Sub + Dim LoaderName As String = Desc & "下载：" & File.DisplayName & " " + If Target <> DefaultFolder AndAlso Not Project.IsModPack Then DownloadFolder = GetPathFromFullPath(Target) + + '构造步骤加载器 + Dim Loaders As New List(Of LoaderBase) + Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.GetDownloadFile(Target, True)}) With {.ProgressWeight = 6, .Block = True}) + + '启动 + Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} + Loader.Start(1) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + Catch ex As Exception + Log(ex, "保存 CurseForge 文件失败", LogLevel.Feedback) + End Try + End Sub + + Private Sub BtnIntroCf_Click(sender As Object, e As EventArgs) Handles BtnIntroCf.Click + OpenWebsite(Project.Website) + End Sub + Private Sub BtnIntroWiki_Click(sender As Object, e As EventArgs) Handles BtnIntroWiki.Click + OpenWebsite("https://www.mcmod.cn/class/" & Project.McWikiId & ".html") + End Sub + Private Sub BtnIntroMCBBS_Click(sender As Object, e As EventArgs) Handles BtnIntroMCBBS.Click + OpenWebsite("https://www.mcbbs.net/thread-" & Project.MCBBS & "-1-1.html") + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml new file mode 100644 index 0000000..ee70967 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml @@ -0,0 +1,31 @@ + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb new file mode 100644 index 0000000..63cec9a --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadClient.xaml.vb @@ -0,0 +1,107 @@ +Public Class PageDownloadClient + + Private Sub LoaderInit() Handles Me.Initialized + PageLoaderInit(Load, PanLoad, PanBack, Nothing, DlClientListLoader, AddressOf Load_OnFinish) + End Sub + Private Sub Init() Handles Me.Loaded + PanBack.ScrollToHome() + End Sub + + Private Sub Load_OnFinish() + '结果数据化 + Try + '归类 + Dim Dict As New Dictionary(Of String, List(Of JObject)) From { + {"正式版", New List(Of JObject)}, {"预览版", New List(Of JObject)}, {"远古版", New List(Of JObject)}, {"愚人节版", New List(Of JObject)} + } + Dim Versions As JArray = DlClientListLoader.Output.Value("versions") + For Each Version As JObject In Versions + '确定分类 + Dim Type As String = Version("type") + Select Case Type + Case "release" + Type = "正式版" + Case "snapshot" + Type = "预览版" + 'Mojang 误分类 + If Version("id").ToString.StartsWith("1.") AndAlso + Not Version("id").ToString.ToLower.Contains("combat") AndAlso + Not Version("id").ToString.ToLower.Contains("rc") AndAlso + Not Version("id").ToString.ToLower.Contains("experimental") AndAlso + Not Version("id").ToString.ToLower.Contains("pre") Then + Type = "正式版" + Version("type") = "release" + End If + '愚人节版本 + Select Case Version("id").ToString.ToLower + Case "20w14infinite", "20w14∞" + Type = "愚人节版" + Version("id") = "20w14∞" + Version("type") = "special" + Version.Add("lore", GetMcFoolName(Version("id"))) + Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime" + Type = "愚人节版" + Version("type") = "special" + Version.Add("lore", GetMcFoolName(Version("id"))) + End Select + Case "special" + '已被处理的愚人节版 + Type = "愚人节版" + Case Else + Type = "远古版" + End Select + '加入辞典 + Dict(Type).Add(Version) + Next + '排序 + For i = 0 To Dict.Keys.Count - 1 + Dict(Dict.Keys(i)) = Sort(Dict.Values(i), Function(Left As JObject, Right As JObject) As Boolean + Return Left("releaseTime").Value(Of Date) > Right("releaseTime").Value(Of Date) + End Function) + Next + '清空当前 + PanMain.Children.Clear() + '添加最新版本 + Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2} + Dim TopestVersions As New List(Of JObject) + Dim Release As JObject = Dict("正式版")(0).DeepClone() + Release("lore") = "最新正式版，发布于 " & Release("releaseTime").ToString() + TopestVersions.Add(Release) + If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then + Dim Snapshot As JObject = Dict("预览版")(0).DeepClone() + Snapshot("lore") = "最新预览版，发布于 " & Snapshot("releaseTime").ToString() + TopestVersions.Add(Snapshot) + End If + Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions} + MyCard.StackInstall(PanInfo, 2) + CardInfo.Children.Add(PanInfo) + PanMain.Children.Add(CardInfo) + '添加其他版本 + For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict + If Pair.Value.Count = 0 Then Continue For + '增加卡片 + Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2} + 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 + NewCard.IsSwaped = True + PanMain.Children.Add(NewCard) + Next + Catch ex As Exception + Log(ex, "可视化版本列表出错", LogLevel.Feedback) + End Try + End Sub + + Public Sub DownloadStart(sender As MyListItem, e As Object) + McDownloadClient(NetPreDownloadBehaviour.HintWhileExists, sender.Title, sender.Tag("url").ToString) + End Sub + + ''介绍栏 + 'Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click + ' OpenWebsite("https://www.minecraft.net/zh-hans") + 'End Sub + 'Private Sub BtnInstall_Click(sender As Object, e As EventArgs) Handles BtnInstall.Click + ' FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall) + 'End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadFabric.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadFabric.xaml new file mode 100644 index 0000000..fa8647c --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadFabric.xaml @@ -0,0 +1,28 @@ + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadFabric.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadFabric.xaml.vb new file mode 100644 index 0000000..fa65b79 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadFabric.xaml.vb @@ -0,0 +1,32 @@ +Public Class PageDownloadFabric + + Private Sub LoaderInit() Handles Me.Initialized + PageLoaderInit(Load, PanLoad, CardVersions, CardTip, DlFabricListLoader, AddressOf Load_OnFinish) + End Sub + Private Sub Init() Handles Me.Loaded + PanBack.ScrollToHome() + End Sub + + Private Sub Load_OnFinish() + '结果数据化 + Try + Dim Versions As JArray = DlFabricListLoader.Output.Value("installer") + PanVersions.Children.Clear() + For Each Version In Versions + PanVersions.Children.Add(FabricDownloadListItem(Version, AddressOf Fabric_Selected)) + Next + CardVersions.Title = "版本列表 (" & Versions.Count & ")" + Catch ex As Exception + Log(ex, "可视化 Fabric 版本列表出错", LogLevel.Feedback) + End Try + End Sub + + Private Sub Fabric_Selected(sender As MyListItem, e As EventArgs) + McDownloadFabricLoaderSave(sender.Tag) + End Sub + + Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click + OpenWebsite("https://www.fabricmc.net") + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml new file mode 100644 index 0000000..b40be50 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml @@ -0,0 +1,26 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb new file mode 100644 index 0000000..78541a0 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadForge.xaml.vb @@ -0,0 +1,67 @@ +Public Class PageDownloadForge + + Private Sub LoaderInit() Handles Me.Initialized + PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlForgeListLoader, AddressOf Load_OnFinish) + End Sub + Private Sub Init() Handles Me.Loaded + PanBack.ScrollToHome() + End Sub + + Private Sub Load_OnFinish() + '结果数据化 + Try + '排序 + Dim Versions = Sort(DlForgeListLoader.Output.Value, AddressOf VersionSortBoolean) + '清空当前 + PanMain.Children.Clear() + '转化为 UI + For Each Version As String In Versions + '增加卡片 + Dim NewCard As New MyCard With {.Title = Version.Replace("_p", " P"), .Margin = New Thickness(0, 0, 0, 15), .SwapType = 5} + Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Version} + NewCard.Children.Add(NewStack) + NewCard.SwapControl = NewStack + NewCard.IsSwaped = True + PanMain.Children.Add(NewCard) + Next + ''非官方源警示 + 'If Setup.Get("ToolDownloadOutOfDate") AndAlso Not DlForgeListLoader.Output.IsOfficial Then + ' Dim CardWarn As New MyCard With {.Title = "过期提示", .Margin = New Thickness(0, 0, 0, 15)} + ' CardWarn.Children.Add(New TextBlock With { + ' .Margin = New Thickness(25, MyCard.SwapedHeight, 15, 15), .VerticalAlignment = VerticalAlignment.Top, .HorizontalAlignment = HorizontalAlignment.Left, .TextTrimming = TextTrimming.None, .TextWrapping = TextWrapping.Wrap, + ' .Text = "获取官方源失败，正在使用 " & DlForgeListLoader.Output.SourceName & " 镜像源，版本列表可能并非最新。" & vbCrLf & "官方源错误原因：" & If(DlForgeListLoader.Output.OfficialError, New Exception("连接服务器超时")).Message}) + ' PanMain.Children.Insert(0, CardWarn) + 'End If + Catch ex As Exception + Log(ex, "可视化版本列表出错", LogLevel.Feedback) + End Try + End Sub + + 'Forge 版本列表加载 + Public Sub Forge_Click(sender As MyLoading, e As MouseButtonEventArgs) + If sender.State.LoadingState = MyLoading.MyLoadingState.Error Then + CType(sender.State, LoaderTask(Of String, List(Of DlForgeVersionEntry))).Start(IsForceRestart:=True) + 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 + + Dim Card As MyCard = CType(sender.Parent, FrameworkElement).Parent + Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = sender.State + '载入列表 + Card.SwapControl.Children.Clear() + Card.SwapControl.Tag = Loader.Output + Card.SwapType = 6 + Card.StackInstall() + End Sub + + Public Sub DownloadStart(sender As MyListItem, e As Object) + McDownloadForge(sender.Tag) + End Sub + + '介绍栏 + Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click + OpenWebsite("https://files.minecraftforge.net") + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml new file mode 100644 index 0000000..06db311 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml @@ -0,0 +1,180 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb new file mode 100644 index 0000000..6394977 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb @@ -0,0 +1,1050 @@ +Public Class PageDownloadInstall + + Private Sub LoaderInit() Handles Me.Initialized + PageLoaderInit(LoadMinecraft, PanLoad, PanBack, Nothing, DlClientListLoader, AddressOf LoadMinecraft_OnFinish) + End Sub + + Private IsLoad As Boolean = False + Private Sub Init() Handles Me.Loaded + PanBack.ScrollToHome() + DlOptiFineListLoader.Start() + DlLiteLoaderListLoader.Start() + DlFabricListLoader.Start() + + '重载预览 + TextSelectName.ValidateRules = New ObjectModel.Collection(Of Validate) From {New ValidateFolderName(PathMcFolder & "versions")} + TextSelectName.Validate() + SelectReload() + + '非重复加载部分 + If IsLoad Then Exit Sub + IsLoad = True + + McDownloadForgeRecommendedRefresh() + + LoadOptiFine.State = DlOptiFineListLoader + LoadLiteLoader.State = DlLiteLoaderListLoader + LoadFabric.State = DlFabricListLoader + LoadFabricApi.State = DlFabricApiLoader + LoadOptiFabric.State = DlOptiFabricLoader + End Sub + +#Region "页面切换" + + '页面切换动画 + Private IsInSelectPage As Boolean = False + Private IsFirstLoaded As Boolean = False + Private Sub EnterSelectPage() + If IsInSelectPage Then Exit Sub + IsInSelectPage = True + + IsSelectNameEdited = False + PanSelect.Visibility = Visibility.Visible + PanSelect.IsHitTestVisible = True + PanMinecraft.IsHitTestVisible = False + PanBack.IsHitTestVisible = False + PanBack.ScrollToHome() + + CardMinecraft.IsSwaped = True + CardOptiFine.IsSwaped = True + CardLiteLoader.IsSwaped = True + CardForge.IsSwaped = True + CardFabric.IsSwaped = True + CardFabricApi.IsSwaped = True + CardOptiFabric.IsSwaped = True + + If Not Setup.Get("HintInstallBack") Then + Setup.Set("HintInstallBack", True) + Hint("点击 Minecraft 项即可返回游戏主版本选择页面！") + End If + + '如果在选择页面按了刷新键，选择页的东西可能会由于动画被隐藏，但不会由于加载结束而再次显示，因此这里需要手动恢复 + For Each Card In GetAllAnimControls(PanSelect) + Card.Opacity = 1 + Card.RenderTransform = New TranslateTransform + Next + + '启动 Forge 加载 + If SelectedMinecraftId.StartsWith("1.") Then + Dim ForgeLoader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion " & SelectedMinecraftId, AddressOf DlForgeVersionMain) + LoadForge.State = ForgeLoader + ForgeLoader.Start(SelectedMinecraftId) + End If + + '启动 Fabric API、OptiFabric 加载 + DlFabricApiLoader.Start() + DlOptiFabricLoader.Start() + + AniStart({ + AaOpacity(PanMinecraft, -PanMinecraft.Opacity, 100, 10), + AaTranslateX(PanMinecraft, -50 - CType(PanMinecraft.RenderTransform, TranslateTransform).X, 110, 10), + AaCode(Sub() + PanBack.ScrollToHome() + TextSelectName.Validate() + OptiFine_Loaded() + LiteLoader_Loaded() + Forge_Loaded() + Fabric_Loaded() + FabricApi_Loaded() + OptiFabric_Loaded() + SelectReload() + End Sub, After:=True), + AaOpacity(PanSelect, 1 - PanSelect.Opacity, 250, 150), + AaTranslateX(PanSelect, -CType(PanSelect.RenderTransform, TranslateTransform).X, 500, 150, Ease:=New AniEaseOutBack(AniEasePower.Weak)), + AaCode(Sub() + PanMinecraft.Visibility = Visibility.Collapsed + PanBack.IsHitTestVisible = True + '初始化 Binding + If IsFirstLoaded Then Exit Sub + 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}) + BtnForgeClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardForge.MainTextBlock, .Mode = BindingMode.OneWay}) + BtnFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabric.MainTextBlock, .Mode = BindingMode.OneWay}) + BtnFabricApiClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardFabricApi.MainTextBlock, .Mode = BindingMode.OneWay}) + BtnOptiFabricClearInner.SetBinding(Shapes.Path.FillProperty, New Binding("Foreground") With {.Source = CardOptiFabric.MainTextBlock, .Mode = BindingMode.OneWay}) + End Sub,, True) + }, "FrmDownloadInstall SelectPageSwitch", True) + End Sub + Public Sub ExitSelectPage() + If Not IsInSelectPage Then Exit Sub + IsInSelectPage = False + + SelectClear() '清除已选择项 + PanMinecraft.Visibility = Visibility.Visible + PanSelect.IsHitTestVisible = False + PanMinecraft.IsHitTestVisible = True + PanBack.IsHitTestVisible = False + PanBack.ScrollToHome() + + AniStart({ + AaOpacity(PanSelect, -PanSelect.Opacity, 90, 10), + AaTranslateX(PanSelect, 50 - CType(PanSelect.RenderTransform, TranslateTransform).X, 100, 10), + AaCode(Sub() PanBack.ScrollToHome(), After:=True), + AaOpacity(PanMinecraft, 1 - PanMinecraft.Opacity, 150, 100), + AaTranslateX(PanMinecraft, -CType(PanMinecraft.RenderTransform, TranslateTransform).X, 400, 100, Ease:=New AniEaseOutBack(AniEasePower.Weak)), + AaCode(Sub() + PanSelect.Visibility = Visibility.Collapsed + PanBack.IsHitTestVisible = True + End Sub,, True) + }, "FrmDownloadInstall SelectPageSwitch") + End Sub + + '页面切换触发 + Public Sub MinecraftSelected(sender As MyListItem, e As Object) + SelectedMinecraftId = sender.Title + SelectedMinecraftJsonUrl = sender.Tag("url").ToString + SelectedMinecraftIcon = sender.Logo + EnterSelectPage() + End Sub + Private Sub CardMinecraft_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardMinecraft.PreviewSwap + ExitSelectPage() + e.Handled = True + End Sub + +#End Region + +#Region "选择" + + 'Minecraft + Private SelectedMinecraftId As String + Private SelectedMinecraftJsonUrl As String + Private SelectedMinecraftIcon As String + + 'OptiFine + Private SelectedOptiFine As DlOptiFineListEntry = Nothing + Private Sub SetOptiFineInfoShow(IsShow As String) + If PanOptiFineInfo.Tag = IsShow Then Exit Sub + 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) + }, "SetOptiFineInfoShow") + Else + '隐藏信息栏 + AniStart({ + AaTranslateY(PanOptiFineInfo, 6 - CType(PanOptiFineInfo.RenderTransform, TranslateTransform).Y, 200), + AaOpacity(PanOptiFineInfo, -PanOptiFineInfo.Opacity, 100) + }, "SetOptiFineInfoShow") + End If + End Sub + + 'LiteLoader + Private SelectedLiteLoader As DlLiteLoaderListEntry = Nothing + Private Sub SetLiteLoaderInfoShow(IsShow As String) + If PanLiteLoaderInfo.Tag = IsShow Then Exit Sub + 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) + }, "SetLiteLoaderInfoShow") + Else + '隐藏信息栏 + AniStart({ + AaTranslateY(PanLiteLoaderInfo, 6 - CType(PanLiteLoaderInfo.RenderTransform, TranslateTransform).Y, 200), + AaOpacity(PanLiteLoaderInfo, -PanLiteLoaderInfo.Opacity, 100) + }, "SetLiteLoaderInfoShow") + End If + End Sub + + 'Forge + Private SelectedForge As DlForgeVersionEntry = Nothing + Private Sub SetForgeInfoShow(IsShow As String) + If PanForgeInfo.Tag = IsShow Then Exit Sub + 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) + }, "SetForgeInfoShow") + Else + '隐藏信息栏 + AniStart({ + AaTranslateY(PanForgeInfo, 6 - CType(PanForgeInfo.RenderTransform, TranslateTransform).Y, 200), + AaOpacity(PanForgeInfo, -PanForgeInfo.Opacity, 100) + }, "SetForgeInfoShow") + End If + End Sub + + 'Fabric + Private SelectedFabric As String = Nothing + Private Sub SetFabricInfoShow(IsShow As String) + If PanFabricInfo.Tag = IsShow Then Exit Sub + 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) + }, "SetFabricInfoShow") + Else + '隐藏信息栏 + AniStart({ + AaTranslateY(PanFabricInfo, 6 - CType(PanFabricInfo.RenderTransform, TranslateTransform).Y, 200), + AaOpacity(PanFabricInfo, -PanFabricInfo.Opacity, 100) + }, "SetFabricInfoShow") + End If + End Sub + + 'FabricApi + Private SelectedFabricApi As DlCfFile = Nothing + Private Sub SetFabricApiInfoShow(IsShow As String) + If PanFabricApiInfo.Tag = IsShow Then Exit Sub + 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) + }, "SetFabricApiInfoShow") + Else + '隐藏信息栏 + AniStart({ + AaTranslateY(PanFabricApiInfo, 6 - CType(PanFabricApiInfo.RenderTransform, TranslateTransform).Y, 200), + AaOpacity(PanFabricApiInfo, -PanFabricApiInfo.Opacity, 100) + }, "SetFabricApiInfoShow") + End If + End Sub + + 'OptiFabric + Private SelectedOptiFabric As DlCfFile = Nothing + Private Sub SetOptiFabricInfoShow(IsShow As String) + If PanOptiFabricInfo.Tag = IsShow Then Exit Sub + 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) + }, "SetOptiFabricInfoShow") + Else + '隐藏信息栏 + AniStart({ + AaTranslateY(PanOptiFabricInfo, 6 - CType(PanOptiFabricInfo.RenderTransform, TranslateTransform).Y, 200), + AaOpacity(PanOptiFabricInfo, -PanOptiFabricInfo.Opacity, 100) + }, "SetOptiFabricInfoShow") + End If + End Sub + + ''' + ''' 重载已选择的项目的显示。 + ''' + Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged + If SelectedMinecraftId Is Nothing Then Exit Sub + '主预览 + SelectNameUpdate() + ItemSelect.Title = TextSelectName.Text + ItemSelect.Info = GetSelectInfo() + ItemSelect.Logo = GetSelectLogo() + 'Minecraft + LabMinecraft.Text = SelectedMinecraftId + ImgMinecraft.Source = New MyBitmap(SelectedMinecraftIcon) + 'OptiFine + Dim OptiFineError As String = LoadOptiFineGetError() + CardOptiFine.MainSwap.Visibility = If(OptiFineError Is Nothing, Visibility.Visible, Visibility.Collapsed) + If OptiFineError IsNot Nothing Then CardOptiFine.IsSwaped = True '例如在同时展开卡片时选择了不兼容项则强制折叠 + SetOptiFineInfoShow(CardOptiFine.IsSwaped) + If SelectedOptiFine Is Nothing Then + BtnOptiFineClear.Visibility = Visibility.Collapsed + ImgOptiFine.Visibility = Visibility.Collapsed + LabOptiFine.Text = If(OptiFineError, "点击选择") + LabOptiFine.Foreground = ColorGray4 + Else + BtnOptiFineClear.Visibility = Visibility.Visible + ImgOptiFine.Visibility = Visibility.Visible + LabOptiFine.Text = SelectedOptiFine.NameDisplay.Replace(SelectedMinecraftId & " ", "") + LabOptiFine.Foreground = ColorGray1 + End If + 'LiteLoader + Dim LiteLoaderError As String = LoadLiteLoaderGetError() + CardLiteLoader.MainSwap.Visibility = If(LiteLoaderError Is Nothing, Visibility.Visible, Visibility.Collapsed) + If LiteLoaderError IsNot Nothing Then CardLiteLoader.IsSwaped = True '例如在同时展开卡片时选择了不兼容项则强制折叠 + SetLiteLoaderInfoShow(CardLiteLoader.IsSwaped) + If SelectedLiteLoader Is Nothing Then + BtnLiteLoaderClear.Visibility = Visibility.Collapsed + ImgLiteLoader.Visibility = Visibility.Collapsed + LabLiteLoader.Text = If(LiteLoaderError, "点击选择") + LabLiteLoader.Foreground = ColorGray4 + Else + BtnLiteLoaderClear.Visibility = Visibility.Visible + ImgLiteLoader.Visibility = Visibility.Visible + LabLiteLoader.Text = SelectedLiteLoader.Inherit + LabLiteLoader.Foreground = ColorGray1 + End If + 'Forge + Dim ForgeError As String = LoadForgeGetError() + CardForge.MainSwap.Visibility = If(ForgeError Is Nothing, Visibility.Visible, Visibility.Collapsed) + If ForgeError IsNot Nothing Then CardForge.IsSwaped = True + SetForgeInfoShow(CardForge.IsSwaped) + If SelectedForge Is Nothing Then + BtnForgeClear.Visibility = Visibility.Collapsed + ImgForge.Visibility = Visibility.Collapsed + LabForge.Text = If(ForgeError, "点击选择") + LabForge.Foreground = ColorGray4 + Else + BtnForgeClear.Visibility = Visibility.Visible + ImgForge.Visibility = Visibility.Visible + LabForge.Text = SelectedForge.Version + LabForge.Foreground = ColorGray1 + End If + 'Fabric + Dim FabricError As String = LoadFabricGetError() + CardFabric.MainSwap.Visibility = If(FabricError Is Nothing, Visibility.Visible, Visibility.Collapsed) + If FabricError IsNot Nothing Then CardFabric.IsSwaped = True + SetFabricInfoShow(CardFabric.IsSwaped) + If SelectedFabric Is Nothing Then + BtnFabricClear.Visibility = Visibility.Collapsed + ImgFabric.Visibility = Visibility.Collapsed + LabFabric.Text = If(FabricError, "点击选择") + LabFabric.Foreground = ColorGray4 + Else + BtnFabricClear.Visibility = Visibility.Visible + ImgFabric.Visibility = Visibility.Visible + LabFabric.Text = SelectedFabric.Replace("+build", "") + LabFabric.Foreground = ColorGray1 + End If + 'FabricApi + Dim FabricApiError As String = LoadFabricApiGetError() + CardFabricApi.MainSwap.Visibility = If(FabricApiError Is Nothing, Visibility.Visible, Visibility.Collapsed) + If FabricApiError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardFabricApi.IsSwaped = True + SetFabricApiInfoShow(CardFabricApi.IsSwaped) + If SelectedFabricApi Is Nothing Then + BtnFabricApiClear.Visibility = Visibility.Collapsed + ImgFabricApi.Visibility = Visibility.Collapsed + LabFabricApi.Text = If(FabricApiError, "点击选择") + LabFabricApi.Foreground = ColorGray4 + Else + BtnFabricApiClear.Visibility = Visibility.Visible + ImgFabricApi.Visibility = Visibility.Visible + LabFabricApi.Text = SelectedFabricApi.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim + LabFabricApi.Foreground = ColorGray1 + End If + 'OptiFabric + Dim OptiFabricError As String = LoadOptiFabricGetError() + CardOptiFabric.MainSwap.Visibility = If(OptiFabricError Is Nothing, Visibility.Visible, Visibility.Collapsed) + If OptiFabricError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardOptiFabric.IsSwaped = True + SetOptiFabricInfoShow(CardOptiFabric.IsSwaped) + If SelectedOptiFabric Is Nothing Then + BtnOptiFabricClear.Visibility = Visibility.Collapsed + ImgOptiFabric.Visibility = Visibility.Collapsed + LabOptiFabric.Text = If(OptiFabricError, "点击选择") + LabOptiFabric.Foreground = ColorGray4 + Else + BtnOptiFabricClear.Visibility = Visibility.Visible + ImgOptiFabric.Visibility = Visibility.Visible + LabOptiFabric.Text = SelectedOptiFabric.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v") + LabOptiFabric.Foreground = ColorGray1 + End If + '主警告 + HintFabricAPI.Visibility = If(SelectedFabric IsNot Nothing AndAlso SelectedFabricApi Is Nothing, Visibility.Visible, Visibility.Collapsed) + HintOptiFabric.Visibility = If(SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing, Visibility.Visible, Visibility.Collapsed) + End Sub + ''' + ''' 清空已选择的项目。 + ''' + Private Sub SelectClear() + SelectedMinecraftId = Nothing + SelectedMinecraftJsonUrl = Nothing + SelectedMinecraftIcon = Nothing + SelectedOptiFine = Nothing + SelectedLiteLoader = Nothing + SelectedForge = Nothing + SelectedFabric = Nothing + SelectedFabricApi = Nothing + SelectedOptiFabric = Nothing + End Sub + + '显示信息获取 + ''' + ''' 获取默认版本名。 + ''' + Private Function GetSelectName() As String + Dim Name As String = SelectedMinecraftId + If SelectedFabric IsNot Nothing Then + Name += "-Fabric " & SelectedFabric.Replace("+build", "") + End If + If SelectedForge IsNot Nothing Then + Name += "-Forge_" & SelectedForge.Version + End If + If SelectedLiteLoader IsNot Nothing Then + Name += "-LiteLoader" + End If + If SelectedOptiFine IsNot Nothing Then + Name += "-OptiFine_" & SelectedOptiFine.NameDisplay.Replace(SelectedMinecraftId & " ", "").Replace(" ", "_") + End If + Return Name + End Function + ''' + ''' 获取版本描述信息。 + ''' + Private Function GetSelectInfo() As String + Dim Info As String = "" + If SelectedFabric IsNot Nothing Then + Info += ", Fabric " & SelectedFabric.Replace("+build", "") + End If + If SelectedForge IsNot Nothing Then + Info += ", Forge " & SelectedForge.Version + End If + If SelectedLiteLoader IsNot Nothing Then + Info += ", LiteLoader" + End If + If SelectedOptiFine IsNot Nothing Then + Info += ", OptiFine " & SelectedOptiFine.NameDisplay.Replace(SelectedMinecraftId & " ", "") + End If + If Info = "" Then Info = ", 无附加安装" + Return Info.TrimStart(", ".ToCharArray()) + End Function + ''' + ''' 获取版本图标。 + ''' + Private Function GetSelectLogo() As String + If SelectedFabric IsNot Nothing Then + Return "pack://application:,,,/images/Blocks/Fabric.png" + ElseIf SelectedForge IsNot Nothing Then + Return "pack://application:,,,/images/Blocks/Anvil.png" + ElseIf SelectedLiteLoader IsNot Nothing Then + Return "pack://application:,,,/images/Blocks/Egg.png" + ElseIf SelectedOptiFine IsNot Nothing Then + Return "pack://application:,,,/images/Blocks/GrassPath.png" + Else + Return SelectedMinecraftIcon + End If + End Function + + '版本名处理 + Private IsSelectNameEdited As Boolean = False + Private IsSelectNameChanging As Boolean = False + Private Sub SelectNameUpdate() + If IsSelectNameEdited OrElse IsSelectNameChanging Then Exit Sub + 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 + IsSelectNameEdited = True + SelectReload() + End Sub + Private Sub TextSelectName_ValidateChanged(sender As Object, e As EventArgs) Handles TextSelectName.ValidateChanged + BtnSelectStart.IsEnabled = TextSelectName.ValidateResult = "" + End Sub + +#End Region + +#Region "加载器" + + '结果数据化 + Private Sub LoadMinecraft_OnFinish() + ExitSelectPage() '返回 + Try + Dim Dict As New Dictionary(Of String, List(Of JObject)) From { + {"正式版", New List(Of JObject)}, {"预览版", New List(Of JObject)}, {"远古版", New List(Of JObject)}, {"愚人节版", New List(Of JObject)} + } + Dim Versions As JArray = DlClientListLoader.Output.Value("versions") + For Each Version As JObject In Versions + '确定分类 + Dim Type As String = Version("type") + Select Case Type + Case "release" + Type = "正式版" + Case "snapshot" + Type = "预览版" + 'Mojang 误分类 + If Version("id").ToString.StartsWith("1.") AndAlso + Not Version("id").ToString.ToLower.Contains("combat") AndAlso + Not Version("id").ToString.ToLower.Contains("rc") AndAlso + Not Version("id").ToString.ToLower.Contains("experimental") AndAlso + Not Version("id").ToString.ToLower.Contains("pre") Then + Type = "正式版" + Version("type") = "release" + End If + '愚人节版本 + Select Case Version("id").ToString.ToLower + Case "20w14infinite", "20w14∞" + Type = "愚人节版" + Version("id") = "20w14∞" + Version("type") = "special" + Version.Add("lore", GetMcFoolName(Version("id"))) + Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime" + Type = "愚人节版" + Version("type") = "special" + Version.Add("lore", GetMcFoolName(Version("id"))) + End Select + Case "special" + '已被处理的愚人节版 + Type = "愚人节版" + Case Else + Type = "远古版" + End Select + '加入辞典 + Dict(Type).Add(Version) + Next + '排序 + For i = 0 To Dict.Keys.Count - 1 + Dict(Dict.Keys(i)) = Sort(Dict.Values(i), Function(Left As JObject, Right As JObject) As Boolean + Return Left("releaseTime").Value(Of Date) > Right("releaseTime").Value(Of Date) + End Function) + Next + '清空当前 + PanMinecraft.Children.Clear() + '添加最新版本 + Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 15, 0, 15), .SwapType = 2} + Dim TopestVersions As New List(Of JObject) + Dim Release As JObject = Dict("正式版")(0).DeepClone() + Release("lore") = "最新正式版，发布于 " & Release("releaseTime").ToString() + TopestVersions.Add(Release) + If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then + Dim Snapshot As JObject = Dict("预览版")(0).DeepClone() + Snapshot("lore") = "最新预览版，发布于 " & Snapshot("releaseTime").ToString() + TopestVersions.Add(Snapshot) + End If + Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions} + MyCard.StackInstall(PanInfo, 7) + CardInfo.Children.Add(PanInfo) + PanMinecraft.Children.Insert(0, CardInfo) + '添加其他版本 + For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict + If Pair.Value.Count = 0 Then Continue For + '增加卡片 + Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 7} + 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 + NewCard.IsSwaped = True + PanMinecraft.Children.Add(NewCard) + Next + Catch ex As Exception + Log(ex, "可视化安装版本列表出错", LogLevel.Feedback) + End Try + End Sub + +#End Region + +#Region "OptiFine 列表" + + ''' + ''' 获取 OptiFine 的加载异常信息。若正常则返回 Nothing。 + ''' + Private Function LoadOptiFineGetError() As String + 'If Not SelectedMinecraftId.Contains("1.") Then Return "没有可用版本" + If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" + If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadOptiFine.State, Object).Error.Message + For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value + If Version.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then + 'If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容" + If SelectedForge IsNot Nothing AndAlso VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then Return "与 Forge 不兼容" + Return Nothing + End If + Next + Return "没有可用版本" + End Function + + '限制展开 + Private Sub CardOptiFine_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardOptiFine.PreviewSwap + If LoadOptiFineGetError() IsNot Nothing Then e.Handled = True + End Sub + + ''' + ''' 尝试重新可视化 OptiFine 版本列表。 + ''' + Private Sub OptiFine_Loaded() Handles LoadOptiFine.StateChanged + Try + If DlOptiFineListLoader.State <> LoadState.Finished Then Exit Sub + '获取版本列表 + Dim Versions As New List(Of DlOptiFineListEntry) + For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value + If Version.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Versions.Add(Version) + Next + If Versions.Count = 0 Then Exit Sub + '排序 + Versions = Sort(Versions, Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean + Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay) + End Function) + '可视化 + PanOptiFine.Children.Clear() + For Each Version In Versions + PanOptiFine.Children.Add(OptiFineDownloadListItem(Version, AddressOf OptiFine_Selected, False)) + Next + Catch ex As Exception + Log(ex, "可视化 OptiFine 安装版本列表出错", LogLevel.Feedback) + End Try + End Sub + + '选择与清除 + Private Sub OptiFine_Selected(sender As MyListItem, e As EventArgs) + SelectedOptiFine = sender.Tag + OptiFabric_Loaded() + CardOptiFine.IsSwaped = True + SelectReload() + End Sub + Private Sub OptiFine_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnOptiFineClear.MouseLeftButtonUp + SelectedOptiFine = Nothing + SelectedOptiFabric = Nothing + CardOptiFine.IsSwaped = True + e.Handled = True + SelectReload() + End Sub + +#End Region + +#Region "LiteLoader 列表" + + ''' + ''' 获取 LiteLoader 的加载异常信息。若正常则返回 Nothing。 + ''' + Private Function LoadLiteLoaderGetError() As String + If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then Return "没有可用版本" + If LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" + If LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadLiteLoader.State, Object).Error.Message + For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value + If Version.Inherit = SelectedMinecraftId Then Return Nothing + Next + Return "没有可用版本" + End Function + + '限制展开 + Private Sub CardLiteLoader_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardLiteLoader.PreviewSwap + If LoadLiteLoaderGetError() IsNot Nothing Then e.Handled = True + End Sub + + ''' + ''' 尝试重新可视化 LiteLoader 版本列表。 + ''' + Private Sub LiteLoader_Loaded() Handles LoadLiteLoader.StateChanged + Try + If DlLiteLoaderListLoader.State <> LoadState.Finished Then Exit Sub + '获取版本列表 + 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 Versions.Count = 0 Then Exit Sub + '可视化 + PanLiteLoader.Children.Clear() + For Each Version In Versions + PanLiteLoader.Children.Add(LiteLoaderDownloadListItem(Version, AddressOf LiteLoader_Selected, False)) + Next + Catch ex As Exception + Log(ex, "可视化 LiteLoader 安装版本列表出错", LogLevel.Feedback) + End Try + End Sub + + '选择与清除 + Private Sub LiteLoader_Selected(sender As MyListItem, e As EventArgs) + SelectedLiteLoader = sender.Tag + CardLiteLoader.IsSwaped = True + SelectReload() + End Sub + Private Sub LiteLoader_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnLiteLoaderClear.MouseLeftButtonUp + SelectedLiteLoader = Nothing + CardLiteLoader.IsSwaped = True + e.Handled = True + SelectReload() + End Sub + +#End Region + +#Region "Forge 列表" + + ''' + ''' 获取 Forge 的加载异常信息。若正常则返回 Nothing。 + ''' + Private Function LoadForgeGetError() As String + If Not SelectedMinecraftId.StartsWith("1.") Then Return "没有可用版本" + If Not LoadForge.State.IsLoader Then Return "正在获取版本列表……" + Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = LoadForge.State + If SelectedMinecraftId <> Loader.Input Then Return "正在获取版本列表……" + If Loader.State = LoadState.Loading Then Return "正在获取版本列表……" + If Loader.State = LoadState.Failed Then + Dim ErrorMessage As String = Loader.Error.Message + If ErrorMessage.Contains("没有可用版本") Then + Return "没有可用版本" + Else + Return "获取版本列表失败：" & ErrorMessage + End If + End If + If Loader.State <> LoadState.Finished Then Return "获取版本列表失败：未知错误，状态为 " & GetStringFromEnum(Loader.State) + For Each Version In Loader.Output + If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本 + If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容" + If SelectedOptiFine IsNot Nothing AndAlso VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then Return "与 OptiFine 不兼容" + Return Nothing + Next + Return "该版本不支持自动安装" + End Function + + '限制展开 + Private Sub CardForge_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardForge.PreviewSwap + If LoadForgeGetError() IsNot Nothing Then e.Handled = True + End Sub + + ''' + ''' 尝试重新可视化 Forge 版本列表。 + ''' + Private Sub Forge_Loaded() Handles LoadForge.StateChanged + Try + If Not LoadForge.State.IsLoader Then Exit Sub + 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 + '可视化 + Dim Versions As New List(Of DlForgeVersionEntry) + Versions.AddRange(Loader.Output) '复制数组，以免 Output 在实例化后变空 + If Loader.Output.Count = 0 Then Exit Sub + PanForge.Children.Clear() + Versions = Sort(Versions, Function(Left As DlForgeVersionEntry, Right As DlForgeVersionEntry) As Boolean + Return New Version(Left.Version) > New Version(Right.Version) + End Function) + ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False) + For Each Version In Versions + If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本 + PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False)) + Next + Catch ex As Exception + Log(ex, "可视化 Forge 安装版本列表出错", LogLevel.Feedback) + End Try + End Sub + + '选择与清除 + Private Sub Forge_Selected(sender As MyListItem, e As EventArgs) + SelectedForge = sender.Tag + CardForge.IsSwaped = True + SelectReload() + End Sub + Private Sub Forge_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnForgeClear.MouseLeftButtonUp + SelectedForge = Nothing + CardForge.IsSwaped = True + e.Handled = True + SelectReload() + End Sub + +#End Region + +#Region "Fabric 列表" + + ''' + ''' 获取 Fabric 的加载异常信息。若正常则返回 Nothing。 + ''' + Private Function LoadFabricGetError() As String + If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" + If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadFabric.State, Object).Error.Message + For Each Version As JObject In DlFabricListLoader.Output.Value("game") + If Version("version").ToString = SelectedMinecraftId Then + If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容" + 'If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容" + Return Nothing + End If + Next + Return "没有可用版本" + End Function + + '限制展开 + Private Sub CardFabric_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardFabric.PreviewSwap + If LoadFabricGetError() IsNot Nothing Then e.Handled = True + End Sub + + ''' + ''' 尝试重新可视化 Fabric 版本列表。 + ''' + Private Sub Fabric_Loaded() Handles LoadFabric.StateChanged + Try + If DlFabricListLoader.State <> LoadState.Finished Then Exit Sub + '获取版本列表 + Dim Versions As JArray = DlFabricListLoader.Output.Value("loader") + If Versions.Count = 0 Then Exit Sub + '可视化 + PanFabric.Children.Clear() + For Each Version In Versions + PanFabric.Children.Add(FabricDownloadListItem(Version, AddressOf Fabric_Selected)) + Next + Catch ex As Exception + Log(ex, "可视化 Fabric 安装版本列表出错", LogLevel.Feedback) + End Try + End Sub + + '选择与清除 + Private Sub Fabric_Selected(sender As MyListItem, e As EventArgs) + SelectedFabric = sender.Tag("version").ToString + FabricApi_Loaded() + OptiFabric_Loaded() + CardFabric.IsSwaped = True + SelectReload() + If Not Setup.Get("HintInstallFabricApi") Then + Setup.Set("HintInstallFabricApi", True) + Hint("安装 Fabric 时通常还需要安装 Fabric API，在选择 Fabric 后就会显示其安装选项！") + End If + End Sub + Private Sub Fabric_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnFabricClear.MouseLeftButtonUp + SelectedFabric = Nothing + SelectedFabricApi = Nothing + SelectedOptiFabric = Nothing + CardFabric.IsSwaped = True + e.Handled = True + SelectReload() + End Sub + +#End Region + +#Region "Fabric API 列表" + + ''' + ''' 从显示名判断该 API 是否与某版本适配。 + ''' + Public Shared Function IsSuitableFabricApi(DisplayName As String, MinecraftVersion As String) As Boolean + Try + If DisplayName Is Nothing OrElse MinecraftVersion Is Nothing Then Return False + DisplayName = DisplayName.ToLower : MinecraftVersion = MinecraftVersion.ToLower + If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True + If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False + '直接的判断（例如 1.18.1/22w03a） + For Each Part As String In DisplayName.Split("]")(0).TrimStart("[").Split("/") + If Part = MinecraftVersion Then Return True + Next + '将版本名分割语素（例如 1.16.4/5） + Dim Lefts = RegexSearch(DisplayName.Split("]")(0), "[a-z/]+|[0-9/]+") + Dim Rights = RegexSearch(MinecraftVersion.Split("]")(0), "[a-z/]+|[0-9/]+") + '对每段进行判断 + Dim i As Integer = 0 + While True + '两边均缺失，感觉是一个东西 + If Lefts.Count - 1 < i AndAlso Rights.Count - 1 < i Then Return True + '确定两边是否一致 + Dim LeftValue As String = If(Lefts.Count - 1 < i, "-1", Lefts(i)) + Dim RightValue As String = If(Rights.Count - 1 < i, "-1", Rights(i)) + If Not LeftValue.Contains("/") Then + If LeftValue <> RightValue Then Return False + Else + '左边存在斜杠 + If Not LeftValue.Contains(RightValue) Then Return False + End If + i += 1 + End While + Return True + Catch ex As Exception + Log(ex, "判断 Fabric API 版本适配性出错（" & DisplayName & ", " & MinecraftVersion & "）") + Return False + End Try + End Function + + ''' + ''' 获取 FabricApi 的加载异常信息。若正常则返回 Nothing。 + ''' + Private Function LoadFabricApiGetError() As String + If SelectedFabric Is Nothing Then Return "需要安装 Fabric" + If LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" + If LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadFabricApi.State, Object).Error.Message + For Each Version In DlFabricApiLoader.Output + If IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Return Nothing + Next + Return "没有可用版本" + End Function + + '限制展开 + Private Sub CardFabricApi_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardFabricApi.PreviewSwap + If LoadFabricApiGetError() IsNot Nothing Then e.Handled = True + End Sub + + ''' + ''' 尝试重新可视化 FabricApi 版本列表。 + ''' + 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 + '获取版本列表 + Dim Versions As New List(Of DlCfFile) + For Each Version In DlFabricApiLoader.Output + If IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then + If Not Version.DisplayName.StartsWith("[") Then + Log("[Download] 已特判修改 Fabric API 显示名：" & Version.DisplayName, LogLevel.Debug) + Version.DisplayName = "[" & SelectedMinecraftId & "] " & Version.DisplayName + End If + Versions.Add(Version) + End If + Next + If Versions.Count = 0 Then Exit Sub + '排序 + Versions = Sort(Versions, Function(Left As DlCfFile, Right As DlCfFile) As Boolean + Return Left.Date > Right.Date + End Function) + '可视化 + PanFabricApi.Children.Clear() + For Each Version In Versions + If Not IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Continue For + PanFabricApi.Children.Add(FabricApiDownloadListItem(Version, AddressOf FabricApi_Selected)) + Next + Catch ex As Exception + Log(ex, "可视化 Fabric API 安装版本列表出错", LogLevel.Feedback) + End Try + End Sub + + '选择与清除 + Private Sub FabricApi_Selected(sender As MyListItem, e As EventArgs) + SelectedFabricApi = sender.Tag + CardFabricApi.IsSwaped = True + SelectReload() + End Sub + Private Sub FabricApi_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnFabricApiClear.MouseLeftButtonUp + SelectedFabricApi = Nothing + CardFabricApi.IsSwaped = True + e.Handled = True + SelectReload() + End Sub + +#End Region + +#Region "OptiFabric 列表" + + ''' + ''' 从显示名判断该 Mod 是否与某版本适配。 + ''' + Private Function IsSuitableOptiFabric(ModFile As DlCfFile, MinecraftVersion As String) As Boolean + Try + If MinecraftVersion Is Nothing Then Return False + Return ModFile.GameVersion.Contains(MinecraftVersion) + Catch ex As Exception + Log(ex, "判断 OptiFabric 版本适配性出错（" & MinecraftVersion & "）") + Return False + End Try + End Function + + ''' + ''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。 + ''' + Private Function LoadOptiFabricGetError() As String + If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric" + If SelectedFabric Is Nothing Then Return "需要安装 Fabric" + If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine" + If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" + If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadOptiFabric.State, Object).Error.Message + For Each Version In DlOptiFabricLoader.Output + If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Return Nothing + Next + Return "没有可用版本" + End Function + + '限制展开 + Private Sub CardOptiFabric_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardOptiFabric.PreviewSwap + If LoadOptiFabricGetError() IsNot Nothing Then e.Handled = True + End Sub + + ''' + ''' 尝试重新可视化 OptiFabric 版本列表。 + ''' + 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 + '获取版本列表 + Dim Versions As New List(Of DlCfFile) + For Each Version In DlOptiFabricLoader.Output + If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Versions.Add(Version) + Next + If Versions.Count = 0 Then Exit Sub + '排序 + Versions = Sort(Versions, Function(Left As DlCfFile, Right As DlCfFile) As Boolean + Return Left.Date > Right.Date + End Function) + '可视化 + PanOptiFabric.Children.Clear() + For Each Version In Versions + If Not IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Continue For + PanOptiFabric.Children.Add(OptiFabricDownloadListItem(Version, AddressOf OptiFabric_Selected)) + Next + Catch ex As Exception + Log(ex, "可视化 Fabric API 安装版本列表出错", LogLevel.Feedback) + End Try + End Sub + + '选择与清除 + Private Sub OptiFabric_Selected(sender As MyListItem, e As EventArgs) + SelectedOptiFabric = sender.Tag + CardOptiFabric.IsSwaped = True + SelectReload() + End Sub + Private Sub OptiFabric_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnOptiFabricClear.MouseLeftButtonUp + SelectedOptiFabric = Nothing + CardOptiFabric.IsSwaped = True + e.Handled = True + SelectReload() + End Sub + +#End Region + +#Region "安装" + + Private Sub BtnSelectStart_Click(sender As Object, e As EventArgs) Handles BtnSelectStart.Click + '确认版本隔离 + If (SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso + (Setup.Get("LaunchArgumentIndie") = 0 OrElse Setup.Get("LaunchArgumentIndie") = 2) Then + If MyMsgBox("你尚未开启版本隔离，这会导致多个 MC 共用同一个 Mod 文件夹。" & vbCrLf & + "因此在切换 MC 版本时，MC 会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf & + "PCL2 推荐你在开始下载前，在 设置 → 版本隔离 中开启版本隔离选项！", "版本隔离提示", "取消下载", "继续") = 1 Then + Exit Sub + End If + End If + '提交安装申请 + Dim Request As New McInstallRequest With { + .TargetVersionName = TextSelectName.Text, + .MinecraftJson = SelectedMinecraftJsonUrl, + .MinecraftName = SelectedMinecraftId, + .OptiFineEntry = SelectedOptiFine, + .ForgeEntry = SelectedForge, + .FabricVersion = SelectedFabric, + .FabricApi = SelectedFabricApi, + .OptiFabric = SelectedOptiFabric, + .LiteLoaderEntry = SelectedLiteLoader + } + If Not McInstall(Request) Then Exit Sub + '返回，这样在再次进入安装页面时这个版本就会显示文件夹已重复 + ExitSelectPage() + End Sub + +#End Region + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml new file mode 100644 index 0000000..4526793 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb new file mode 100644 index 0000000..89a49a4 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb @@ -0,0 +1,168 @@ +Public Class PageDownloadLeft + +#Region "页面切换" + + ''' + ''' 当前页面的编号。 + ''' + Public PageID As FormMain.PageSubType = FormMain.PageSubType.DownloadInstall + + ''' + ''' 勾选事件改变页面。 + ''' + Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemClient.Check, ItemOptiFine.Check, ItemForge.Check, ItemLiteLoader.Check, ItemMod.Check, ItemFabric.Check, ItemPack.Check + '尚未初始化控件属性时，sender.Tag 为 Nothing，会导致切换到页面 0 + '若使用 IsLoaded，则会导致模拟点击不被执行（模拟点击切换页面时，控件的 IsLoaded 为 False） + If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) + End Sub + + Public Function PageGet(Optional ID As FormMain.PageSubType = -1) + If ID = -1 Then ID = PageID + Select Case ID + Case FormMain.PageSubType.DownloadInstall + If FrmDownloadInstall Is Nothing Then FrmDownloadInstall = New PageDownloadInstall + Return FrmDownloadInstall + Case FormMain.PageSubType.DownloadClient + If FrmDownloadClient Is Nothing Then FrmDownloadClient = New PageDownloadClient + Return FrmDownloadClient + Case FormMain.PageSubType.DownloadOptiFine + If FrmDownloadOptiFine Is Nothing Then FrmDownloadOptiFine = New PageDownloadOptiFine + Return FrmDownloadOptiFine + Case FormMain.PageSubType.DownloadForge + If FrmDownloadForge Is Nothing Then FrmDownloadForge = New PageDownloadForge + Return FrmDownloadForge + Case FormMain.PageSubType.DownloadLiteLoader + If FrmDownloadLiteLoader Is Nothing Then FrmDownloadLiteLoader = New PageDownloadLiteLoader + Return FrmDownloadLiteLoader + Case FormMain.PageSubType.DownloadFabric + If FrmDownloadFabric Is Nothing Then FrmDownloadFabric = New PageDownloadFabric + Return FrmDownloadFabric + Case FormMain.PageSubType.DownloadMod + If FrmDownloadMod Is Nothing Then FrmDownloadMod = New PageDownloadMod + Return FrmDownloadMod + Case FormMain.PageSubType.DownloadPack + If FrmDownloadPack Is Nothing Then FrmDownloadPack = New PageDownloadPack + Return FrmDownloadPack + Case Else + Throw New Exception("未知的下载子页面种类：" & ID) + End Select + End Function + + ''' + ''' 切换现有页面。 + ''' + Public Sub PageChange(ID As FormMain.PageSubType) + If PageID = ID Then Exit Sub + AniControlEnabled += 1 + Try + PageChangeRun(PageGet(ID)) + PageID = ID + Catch ex As Exception + Log(ex, "切换设置分页面失败（ID " & ID & "）", LogLevel.Feedback) + Finally + AniControlEnabled -= 1 + End Try + End Sub + Private Shared Sub PageChangeRun(Target As MyPageRight) + AniStop("FrmMain PageChangeRight") '停止主页面的右页面切换动画，防止它与本动画一起触发多次 PageOnEnter + If Target.Parent IsNot Nothing Then Target.SetValue(ContentPresenter.ContentProperty, Nothing) + FrmMain.PageRight = Target + CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnExit() + AniStart({ + AaCode(Sub() + CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit() + FrmMain.PanMainRight.Child = FrmMain.PageRight + FrmMain.PageRight.Opacity = 0 + End Sub, 130), + AaCode(Sub() + '延迟触发页面通用动画，以使得在 Loaded 事件中加载的控件得以处理 + FrmMain.PageRight.Opacity = 1 + FrmMain.PageRight.PageOnEnter() + End Sub, 30, True) + }, "PageLeft PageChange") + End Sub + +#End Region + + '强制刷新 + Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用 + Select Case Val(sender.Tag) + Case FormMain.PageSubType.DownloadInstall + DlClientListLoader.Start(IsForceRestart:=True) + DlOptiFineListLoader.Start(IsForceRestart:=True) + DlForgeListLoader.Start(IsForceRestart:=True) + DlLiteLoaderListLoader.Start(IsForceRestart:=True) + DlFabricListLoader.Start(IsForceRestart:=True) + DlFabricApiLoader.Start(IsForceRestart:=True) + DlOptiFabricLoader.Start(IsForceRestart:=True) + Case FormMain.PageSubType.DownloadMod + If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart() + Case FormMain.PageSubType.DownloadPack + If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart() + Case FormMain.PageSubType.DownloadClient + DlClientListLoader.Start(IsForceRestart:=True) + Case FormMain.PageSubType.DownloadOptiFine + DlOptiFineListLoader.Start(IsForceRestart:=True) + Case FormMain.PageSubType.DownloadForge + DlForgeListLoader.Start(IsForceRestart:=True) + Case FormMain.PageSubType.DownloadLiteLoader + DlLiteLoaderListLoader.Start(IsForceRestart:=True) + Case FormMain.PageSubType.DownloadFabric + DlFabricListLoader.Start(IsForceRestart:=True) + End Select + End Sub + + '点击返回 + Private Sub ItemInstall_Click(sender As Object, e As MouseButtonEventArgs) Handles ItemInstall.Click + If Not ItemInstall.Checked Then Exit Sub + FrmDownloadInstall.ExitSelectPage() + End Sub + + '展开手动安装 + Private Sub ItemHand_Click(sender As Object, e As RouteEventArgs) Handles ItemHand.Changed + If ItemHand.Checked = False Then Exit Sub + e.Handled = True + AniControlEnabled += 1 + If Not Setup.Get("HintHandInstall") Then + Setup.Set("HintHandInstall", True) + If MyMsgBox("手动安装包功能提供了 OptiFine、Forge 等组件的 .jar 安装文件下载，但无法自动安装。" & vbCrLf & + "在自动安装页面先选择 MC 版本，然后就可以选择 OptiFine、Forge 等组件，让 PCL2 自动进行安装了。", "自动安装提示", "返回自动安装", "继续下载手动安装包") = 1 Then + FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.Download}, FormMain.PageSubType.DownloadInstall) + AniControlEnabled -= 1 + Exit Sub + End If + End If + ItemHand.Visibility = Visibility.Collapsed + LabGame.Visibility = Visibility.Collapsed + LabHand.Visibility = Visibility.Visible + ItemClient.Visibility = Visibility.Visible + ItemOptiFine.Visibility = Visibility.Visible + ItemFabric.Visibility = Visibility.Visible + ItemForge.Visibility = Visibility.Visible + ItemLiteLoader.Visibility = Visibility.Visible + RunInThread(Sub() + Thread.Sleep(20) + RunInUiWait(Sub() ItemClient.SetChecked(True, True, True)) + AniControlEnabled -= 1 + End Sub) + End Sub + '折叠手动安装 + Private Sub LabHand_Click(sender As Object, e As MouseButtonEventArgs) Handles LabHand.MouseLeftButtonUp + e.Handled = True + AniControlEnabled += 1 + ItemHand.Visibility = Visibility.Visible + LabGame.Visibility = Visibility.Visible + LabHand.Visibility = Visibility.Collapsed + ItemClient.Visibility = Visibility.Collapsed + ItemOptiFine.Visibility = Visibility.Collapsed + ItemFabric.Visibility = Visibility.Collapsed + ItemForge.Visibility = Visibility.Collapsed + ItemLiteLoader.Visibility = Visibility.Collapsed + RunInThread(Sub() + Thread.Sleep(20) + RunInUiWait(Sub() ItemInstall.SetChecked(True, True, True)) + AniControlEnabled -= 1 + End Sub) + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLiteLoader.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLiteLoader.xaml new file mode 100644 index 0000000..a0d8657 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLiteLoader.xaml @@ -0,0 +1,26 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLiteLoader.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLiteLoader.xaml.vb new file mode 100644 index 0000000..d0d7eaa --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLiteLoader.xaml.vb @@ -0,0 +1,52 @@ +Public Class PageDownloadLiteLoader + + Private Sub LoaderInit() Handles Me.Initialized + PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlLiteLoaderListLoader, AddressOf Load_OnFinish) + End Sub + Private Sub Init() Handles Me.Loaded + PanBack.ScrollToHome() + End Sub + + Private Sub Load_OnFinish() + '结果数据化 + Try + '归类 + Dim Dict As New Dictionary(Of String, List(Of DlLiteLoaderListEntry)) + For VersionCode As Integer = 30 To 0 Step -1 + Dict.Add("1." & VersionCode, New List(Of DlLiteLoaderListEntry)) + Next + Dict.Add("未知版本", New List(Of DlLiteLoaderListEntry)) + For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value + Dim MainVersion As String = "1." & Version.Inherit.Split(".")(1) + If Dict.ContainsKey(MainVersion) Then + Dict(MainVersion).Add(Version) + Else + Dict("未知版本").Add(Version) + End If + Next + '清空当前 + PanMain.Children.Clear() + '转化为 UI + For Each Pair As KeyValuePair(Of String, List(Of DlLiteLoaderListEntry)) In Dict + If Pair.Value.Count = 0 Then Continue For + '增加卡片 + Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 10} + 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 + NewCard.IsSwaped = True + PanMain.Children.Add(NewCard) + Next + Catch ex As Exception + Log(ex, "可视化版本列表出错", LogLevel.Feedback) + End Try + End Sub + + Public Sub DownloadStart(sender As MyListItem, e As Object) + McDownloadLiteLoader(sender.Tag) + End Sub + Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click + OpenWebsite("https://www.liteloader.com") + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml new file mode 100644 index 0000000..05d9aa7 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml @@ -0,0 +1,108 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb new file mode 100644 index 0000000..194172b --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb @@ -0,0 +1,83 @@ +Public Class PageDownloadMod + + '初始化加载器信息 + Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized + PageLoaderInit(Load, PanLoad, CardProjects, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput) + End Sub + Public Shared Loader As New LoaderTask(Of DlCfProjectRequest, DlCfProjectResult)("DlCfProject Mod", AddressOf DlCfProjectSub, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000} + Private Shared Function LoaderInput() As DlCfProjectRequest + If FrmDownloadMod IsNot Nothing AndAlso FrmDownloadMod.IsLoaded Then + Return New DlCfProjectRequest With { + .SearchFilter = FrmDownloadMod.TextSearchName.Text, + .GameVersion = If(FrmDownloadMod.TextSearchVersion.Text.Contains("."), FrmDownloadMod.TextSearchVersion.Text, Nothing), + .CategoryId = Val(FrmDownloadMod.ComboSearchTag.SelectedItem.Tag), + .IsModPack = False, + .ModLoader = Val(FrmDownloadMod.ComboSearchLoader.SelectedItem.Tag) + } '处理列表加载失败后的点击加载器重试 + Else + Return New DlCfProjectRequest With {.IsModPack = False} + End If + End Function + '结果 UI 化 + Private Sub Load_OnFinish() + Try + PanProjects.Children.Clear() + If Loader.Input.SearchFilter = "" Then + CardProjects.Title = "热门 Mod" + Else + CardProjects.Title = "搜索结果 (" & Loader.Output.Projects.Count & If(Loader.Output.Projects.Count < Loader.Output.RealCount, "+", "") & ")" + End If + For Each Project In Loader.Output.Projects + PanProjects.Children.Add(Project.ToCfItem(Loader.Input.GameVersion Is Nothing, Loader.Input.ModLoader Is Nothing OrElse Loader.Input.ModLoader = 0, AddressOf ProjectClick)) + Next + Catch ex As Exception + Log(ex, "可视化 Mod 列表出错", 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 DlCfFileLoader.Error IsNot Nothing Then ErrorMessage = DlCfFileLoader.Error.Message + If ErrorMessage.Contains("不是有效的 Json 文件") Then + Log("[Download] 下载的 Mod 列表 Json 文件损坏，已自动重试", LogLevel.Debug) + PageLoaderRestart() + End If + End Select + End Sub + + '进入详情页面 + + Public Sub ProjectClick(sender As MyCfItem, e As EventArgs) + FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CfDetail, .Additional = sender.Tag}) + End Sub + + '搜索 + + Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp + If e.Key = Key.Enter Then StartSearch() + End Sub + Private Shared Sub StartSearch() Handles BtnSearchRun.Click + Loader.Start() + End Sub + Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click + TextSearchName.Text = "" + TextSearchVersion.SelectedIndex = 0 + TextSearchVersion.Text = "" + ComboSearchTag.SelectedIndex = 0 + ComboSearchLoader.SelectedIndex = 0 + Loader.LastFinishedTime = 0 '要求强制重新开始 + End Sub + Private Sub TextSearchVersion_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextSearchVersion.TextChanged + If TextSearchVersion.Text = "" Then + ComboSearchLoader.Visibility = Visibility.Collapsed + Grid.SetColumnSpan(TextSearchVersion, 2) + ComboSearchLoader.SelectedIndex = 0 + Else + ComboSearchLoader.Visibility = Visibility.Visible + Grid.SetColumnSpan(TextSearchVersion, 1) + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml new file mode 100644 index 0000000..5aa1291 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml @@ -0,0 +1,28 @@ + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb new file mode 100644 index 0000000..a53860c --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadOptiFine.xaml.vb @@ -0,0 +1,60 @@ +Public Class PageDownloadOptiFine + + Private Sub LoaderInit() Handles Me.Initialized + PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlOptiFineListLoader, AddressOf Load_OnFinish) + End Sub + Private Sub Init() Handles Me.Loaded + PanBack.ScrollToHome() + End Sub + + Private Sub Load_OnFinish() + '结果数据化 + Try + '归类 + Dim Dict As New Dictionary(Of String, List(Of DlOptiFineListEntry)) + Dict.Add("快照版本", New List(Of DlOptiFineListEntry)) + For VersionCode As Integer = 30 To 0 Step -1 + Dict.Add("1." & VersionCode, New List(Of DlOptiFineListEntry)) + Next + For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value + If Version.Inherit.StartsWith("1.") Then + Dim MainVersion As String = "1." & Version.NameDisplay.Split(".")(1).Split(" ")(0) + If Dict.ContainsKey(MainVersion) Then + Dict(MainVersion).Add(Version) + Else + Dict("快照版本").Add(Version) + End If + Else + Dict("快照版本").Add(Version) + End If + Next + '清空当前 + PanMain.Children.Clear() + '转化为 UI + For Each Pair As KeyValuePair(Of String, List(Of DlOptiFineListEntry)) In Dict + If Pair.Value.Count = 0 Then Continue For + '增加卡片 + Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 3} + 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 + NewCard.IsSwaped = True + PanMain.Children.Add(NewCard) + Next + Catch ex As Exception + Log(ex, "可视化版本列表出错", LogLevel.Feedback) + End Try + End Sub + + Public Sub DownloadStart(sender As MyListItem, e As Object) + McDownloadOptiFine(sender.Tag) + End Sub + + Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click + OpenWebsite("https://www.optifine.net/") + End Sub + Private Sub BtnChina_Click(sender As Object, e As EventArgs) Handles BtnChina.Click + OpenWebsite("https://optifine.cn/home") + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml new file mode 100644 index 0000000..2ed1c45 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml @@ -0,0 +1,112 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml.vb new file mode 100644 index 0000000..fe50914 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml.vb @@ -0,0 +1,82 @@ +Public Class PageDownloadPack + + '初始化加载器信息 + Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized + PageLoaderInit(Load, PanLoad, CardProjects, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput) + End Sub + Public Shared Loader As New LoaderTask(Of DlCfProjectRequest, DlCfProjectResult)("DlCfProject ModPack", AddressOf DlCfProjectSub, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000} + Private Shared Function LoaderInput() As DlCfProjectRequest + If FrmDownloadPack IsNot Nothing AndAlso FrmDownloadPack.IsLoaded Then + Return New DlCfProjectRequest With { + .SearchFilter = FrmDownloadPack.TextSearchName.Text, + .GameVersion = If(FrmDownloadPack.TextSearchVersion.Text.Contains("."), FrmDownloadPack.TextSearchVersion.Text, Nothing), + .CategoryId = Val(FrmDownloadPack.ComboSearchTag.SelectedItem.Tag), + .IsModPack = True + } '处理列表加载失败后的点击加载器重试 + Else + Return New DlCfProjectRequest With {.IsModPack = True} + End If + End Function + '结果 UI 化 + Private Sub Load_OnFinish() + Try + PanProjects.Children.Clear() + If Loader.Input.SearchFilter = "" Then + CardProjects.Title = "热门整合包" + Else + CardProjects.Title = "搜索结果 (" & Loader.Output.Projects.Count & If(Loader.Output.Projects.Count < Loader.Output.RealCount, "+", "") & ")" + End If + For Each Project In Loader.Output.Projects + PanProjects.Children.Add(Project.ToCfItem(Loader.Input.GameVersion Is Nothing, Loader.Input.ModLoader Is Nothing OrElse Loader.Input.ModLoader = 0, AddressOf ProjectClick)) + Next + 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 DlCfFileLoader.Error IsNot Nothing Then ErrorMessage = DlCfFileLoader.Error.Message + If ErrorMessage.Contains("不是有效的 Json 文件") Then + Log("[Download] 下载的整合包列表 Json 文件损坏，已自动重试", LogLevel.Debug) + PageLoaderRestart() + End If + End Select + End Sub + + Private Sub Load_OnStart() + PanLoad.Visibility = Visibility.Visible + AniStart({ + AaOpacity(PanLoad, 1 - PanLoad.Opacity, 150), + AaOpacity(CardProjects, -CardProjects.Opacity, 150), + AaCode(Sub() + CardProjects.Visibility = Visibility.Collapsed + PanProjects.Children.Clear() + End Sub,, True) + }, "FrmDownloadPack Load Switch") + End Sub + + Public Sub ProjectClick(sender As MyCfItem, e As EventArgs) + FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CfDetail, .Additional = sender.Tag}) + End Sub + + Private Sub TextSearchName_KeyUp(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyUp, TextSearchVersion.KeyUp + If e.Key = Key.Enter Then StartSearch() + End Sub + Private Shared Sub StartSearch() Handles BtnSearchRun.Click + Loader.Start() + End Sub + Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click + TextSearchName.Text = "" + TextSearchVersion.SelectedIndex = 0 + TextSearchVersion.Text = "全部" + ComboSearchTag.SelectedIndex = 0 + Loader.LastFinishedTime = 0 '要求强制重新开始 + End Sub + Private Sub BtnSearchInstall_Click(sender As Object, e As EventArgs) Handles BtnSearchInstall.Click + ModpackInstall() + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml new file mode 100644 index 0000000..25317dd --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml.vb new file mode 100644 index 0000000..0279344 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/FormLoginOAuth.xaml.vb @@ -0,0 +1,78 @@ +Imports System.Windows.Navigation + +Public Class FormLoginOAuth + + Public Event OnLoginSuccess(code As String) + Public Event OnLoginCanceled(IsForceExit As Boolean) + + '跳转事件 + Private IsLoginSuccessed As Boolean = False + Private IsForceExit As Boolean = False + Private Sub Browser_Navigating(sender As WebBrowser, e As NavigatingCancelEventArgs) Handles Browser1.Navigating, Browser2.Navigating, Browser3.Navigating + Dim Url As String = e.Uri.AbsoluteUri + If ModeDebug Then Log("[Login] 登录浏览器 " & sender.Tag & " 导向：" & Url) + If Url.Contains("code=") Then + Dim Code As String = RegexSeek(Url, "(?<=code\=)[^&]+") + Log("[Login] 抓取到 OAuth 返回码：" & Code) + IsLoginSuccessed = True + RaiseEvent OnLoginSuccess(Code) + ElseIf Url.Contains("github.") Then + Hint("PCL2 不支持使用 GitHub 登录微软账号！", HintType.Critical) + IsForceExit = True + Close() + End If + End Sub + + '已导航事件 + Private IsFirstLoaded As Boolean = False + Private IsFirstLoadedLock As New Object + Private Sub Browser_Navigated(sender As WebBrowser, e As NavigationEventArgs) Handles Browser1.Navigated, Browser2.Navigated, Browser3.Navigated + SyncLock IsFirstLoadedLock + If IsFirstLoaded Then Exit Sub + IsFirstLoaded = True + End SyncLock + RunInThread(Sub() + Thread.Sleep(1000) + RunInUi(Sub() + sender.Visibility = Visibility.Visible + PanLoading.Visibility = Visibility.Collapsed + End Sub) + End Sub) + End Sub + + '窗体的进出事件 + Public Shared LoginUrl1 As String = "https://login.microsoftonline.com/consumers/oauth2/v2.0/authorize?prompt=login&client_id=00000000402b5328&response_type=code&scope=service%3A%3Auser.auth.xboxlive.com%3A%3AMBI_SSL&redirect_uri=https:%2F%2Flogin.live.com%2Foauth20_desktop.srf" + Public Shared LoginUrl2 As String = "https://login.live.com/oauth20_authorize.srf?prompt=login&client_id=00000000402b5328&response_type=code&scope=service%3A%3Auser.auth.xboxlive.com%3A%3AMBI_SSL&redirect_uri=https:%2F%2Flogin.live.com%2Foauth20_desktop.srf" + Private Sub FrmLoginOAuth_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + Browser1.Navigate(LoginUrl1) + RunInThread(Sub() + '估计是由于时间戳原因，同时导航会导致误报密码失败 + Thread.Sleep(2500) + RunInUi(Sub() + Try '防止在 Dispose 之后调用 + If Not IsFirstLoaded Then Browser2.Navigate(LoginUrl1) + Catch + End Try + End Sub) + Thread.Sleep(2500) + RunInUi(Sub() + Try + If Not IsFirstLoaded Then Browser3.Navigate(LoginUrl2) + Catch + End Try + End Sub) + End Sub) + End Sub + Private Sub FormLoginOAuth_Closed() Handles Me.Closed + Try + Browser1.Dispose() + Browser2.Dispose() + Browser3.Dispose() + Catch ex As Exception + Log(ex, "释放微软登录浏览器失败") + End Try + If Not IsLoginSuccessed Then RaiseEvent OnLoginCanceled(IsForceExit) + FrmMain.Focus() + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml new file mode 100644 index 0000000..d552c7a --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml @@ -0,0 +1,22 @@ + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb new file mode 100644 index 0000000..6b38dc7 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb @@ -0,0 +1,260 @@ +Public Class MySkin + + '事件 + Public Event Click(sender As Object, e As MouseButtonEventArgs) + + '皮肤储存 + Private _Address As String + Public Property Address() As String + Get + Return _Address + End Get + Set(value As String) + _Address = value + ToolTip = If(_Address = "", "加载中", "点击更换皮肤（右键查看更多选项）") + End Set + End Property + Public Loader As LoaderTask(Of EqualableList(Of String), String) + + '控件动画 + Private Sub PanSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter + AniStart(AaOpacity(ShadowSkin, 0.8 - ShadowSkin.Opacity, 200, 100), "Skin Shadow") + End Sub + Private Sub PanSkin_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave + AniStart(AaOpacity(ShadowSkin, 0.2 - ShadowSkin.Opacity, 200), "Skin Shadow") + IsSkinMouseDown = False + AniStart(AaScaleTransform(Me, 1 - CType(Me.RenderTransform, ScaleTransform).ScaleX, 60,, New AniEaseOutFluent), "Skin Scale") + End Sub + + '点击 + Private IsSkinMouseDown As Boolean = False + Private Sub PanSkin_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown + IsSkinMouseDown = True + AniStart(AaScaleTransform(Me, 0.9 - CType(Me.RenderTransform, ScaleTransform).ScaleX, 60,, New AniEaseOutFluent), "Skin Scale") + End Sub + Private Sub PanSkin_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp + AniStart(AaScaleTransform(Me, 1 - CType(Me.RenderTransform, ScaleTransform).ScaleX, 60,, New AniEaseOutFluent), "Skin Scale") + If IsSkinMouseDown Then + IsSkinMouseDown = False + RaiseEvent Click(sender, e) + End If + End Sub + + '保存皮肤 + Private Sub BtnSkinSave_Click(sender As Object, e As RoutedEventArgs) Handles BtnSkinSave.Click + Save(Loader) + End Sub + Public Shared Sub Save(Loader As LoaderTask(Of EqualableList(Of String), String)) + Dim Address = Loader.Output + If Not Loader.State = LoadState.Finished Then + Hint("皮肤正在获取中，请稍候！", HintType.Critical) + If Not Loader.State = LoadState.Loading Then Loader.Start() + Exit Sub + End If + Try + Dim FileAddress As String = SelectAs("选取保存皮肤的位置", GetFileNameFromPath(Address), "皮肤图片文件(*.png)|*.png") + If FileAddress.Contains("\") Then + File.Delete(FileAddress) + If Address.StartsWith(PathImage) Then + Dim Image As New MyBitmap(Address) + Image.Save(FileAddress) + Else + File.Copy(Address, FileAddress) + End If + Hint("皮肤保存成功！", HintType.Finish) + End If + Catch ex As Exception + Log(ex, "保存皮肤失败", LogLevel.Hint) + End Try + End Sub + Private Sub BtnSkinSave_Checked(sender As MyMenuItem, e As RoutedEventArgs) Handles BtnSkinSave.Checked + sender.IsEnabled = Address = "" + End Sub + + ''' + ''' 载入皮肤。 + ''' + Public Sub Load() + Try + Address = Loader.Output + '检查文件存在 + If Address = "" Then Throw New Exception("皮肤加载器 " & Loader.Name & " 没有输出") + If Not Address.StartsWith(PathImage) AndAlso Not File.Exists(Address) Then Throw New FileNotFoundException("皮肤文件未找到", Address) + '加载 + Dim Image As New MyBitmap(Address) + ImgBack.Tag = Address + '头发层（附加层） + If Image.Pic.Width >= 64 AndAlso Image.Pic.Height >= 32 Then + '如果图片中有透明像素，或是头部颜色和透明区均不一样，则加载附加层 + If (Image.Pic.GetPixel(1, 1).A = 0 OrElse Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1).A = 0 OrElse Image.Pic.GetPixel(Image.Pic.Width - 2, 2).A = 0) OrElse + (Image.Pic.GetPixel(1, 1) <> Image.Pic.GetPixel(41, 9) AndAlso Image.Pic.GetPixel(Image.Pic.Width - 1, Image.Pic.Height - 1) <> Image.Pic.GetPixel(41, 9) AndAlso Image.Pic.GetPixel(Image.Pic.Width - 2, 2) <> Image.Pic.GetPixel(41, 9)) Then + ImgFore.Source = New CroppedBitmap(Image, New Int32Rect(40, 8, 8, 8)) + Else + ImgFore.Source = Nothing + End If + Else + ImgFore.Source = Nothing + End If + '脸层 + If Image.Pic.Width >= 32 AndAlso Image.Pic.Height >= 32 Then + ImgBack.Source = New CroppedBitmap(Image, New Int32Rect(8, 8, 8, 8)) + Log("[Skin] 载入头像成功：" & Loader.Name) + Else + ImgBack.Source = Nothing + Throw New Exception("图片大小不足，长为 " & Image.Pic.Height & "，宽为 " & Image.Pic.Width) + End If + Catch ex As Exception + Log(ex, "载入头像失败（" & If(Address, "null") & "," & Loader.Name & "）", LogLevel.Hint) + End Try + End Sub + ''' + ''' 清空皮肤。 + ''' + Public Sub Clear() + Address = "" + ImgFore.Source = Nothing + ImgBack.Source = Nothing + End Sub + + '刷新缓存 + Private Sub RefreshClick(sender As MyMenuItem, e As EventArgs) Handles BtnSkinRefresh.Click + RefreshCache(Loader) + End Sub + ''' + ''' 刷新皮肤缓存。 + ''' + Public Shared Sub RefreshCache(Optional sender As LoaderTask(Of EqualableList(Of String), String) = Nothing) + Dim HasLoaderRunning As Boolean = False + For Each SkinLoader In PageLaunchLeft.SkinLoaders + If SkinLoader.State = LoadState.Loading Then + HasLoaderRunning = True : Exit For + End If + Next + If FrmLaunchLeft IsNot Nothing AndAlso HasLoaderRunning Then + '由于 Abort 不是实时的，暂时不会释放文件，会导致删除报错，故只能取消执行 + Hint("有正在获取中的皮肤，请稍后再试！", HintType.Info) + Else + RunInThread(Sub() + Try + Hint("正在刷新皮肤……") + '清空缓存 + Log("[Skin] 正在清空皮肤缓存") + If Directory.Exists(PathTemp & "Cache\Skin") Then DeleteDirectory(PathTemp & "Cache\Skin") + If Directory.Exists(PathTemp & "Cache\Uuid") Then DeleteDirectory(PathTemp & "Cache\Uuid") + IniClearCache(PathTemp & "Cache\Skin\IndexMojang.ini") + IniClearCache(PathTemp & "Cache\Skin\IndexMs.ini") + IniClearCache(PathTemp & "Cache\Skin\IndexNide.ini") + IniClearCache(PathTemp & "Cache\Skin\IndexAuth.ini") + IniClearCache(PathTemp & "Cache\Uuid\Mojang.ini") + '刷新控件 + For Each SkinLoader In If(sender IsNot Nothing, {sender}, {PageLaunchLeft.SkinMojang, PageLaunchLeft.SkinLegacy, PageLaunchLeft.SkinMs}) + SkinLoader.WaitForExit(IsForceRestart:=True) + Next + Hint("已刷新皮肤！", HintType.Finish) + Catch ex As Exception + Log(ex, "刷新皮肤缓存失败", LogLevel.Msgbox) + End Try + End Sub) + End If + End Sub + ''' + ''' 在更换正版皮肤后，刷新正版皮肤。 + ''' + ''' 新的正版皮肤完整地址。 + Public Shared Sub ReloadCache(SkinAddress As String, IsMsLogin As Boolean) + RunInThread(Sub() + Try + '更新缓存 + Dim LoginType As String = If(IsMsLogin, "Ms", "Mojang") + WriteIni(PathTemp & "Cache\Skin\Index" & LoginType & ".ini", Setup.Get("Cache" & LoginType & "Uuid"), SkinAddress) + Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("Cache" & LoginType & "Uuid"), SkinAddress)) + '刷新控件 + For Each SkinLoader In If(IsMsLogin, {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}, {PageLaunchLeft.SkinMojang, PageLaunchLeft.SkinLegacy}) + SkinLoader.WaitForExit(IsForceRestart:=True) + Next + '完成提示 + Hint("更改皮肤成功！", HintType.Finish) + Catch ex As Exception + Log(ex, "更改正版皮肤后刷新皮肤失败", LogLevel.Feedback) + End Try + End Sub) + End Sub + + '披风 + Public Property HasCape As Boolean + Get + Return BtnSkinCape.Visibility = Visibility.Collapsed + End Get + Set(value As Boolean) + If value Then + BtnSkinCape.Visibility = Visibility.Visible + Else + BtnSkinCape.Visibility = Visibility.Collapsed + End If + End Set + End Property + Private IsChanging As Boolean = False + Private Sub BtnSkinCape_Click(sender As Object, e As RoutedEventArgs) Handles BtnSkinCape.Click + '检查条件，获取新披风 + If IsChanging Then + Hint("正在更改披风中，请稍候！") + Exit Sub + End If + If McLoginMsLoader.State = LoadState.Failed Then + Hint("登录失败，无法更改披风！", HintType.Critical) + Exit Sub + End If + Hint("正在获取披风列表，请稍候……") + IsChanging = True + '开始实际获取 + RunInNewThread(Sub() + Try +Retry: + '获取登录信息 + If McLoginMsLoader.State <> LoadState.Finished Then McLoginMsLoader.WaitForExit() '等待登录结束 + If McLoginMsLoader.State <> LoadState.Finished Then + Hint("登录失败，无法更改披风！", HintType.Critical) + Exit Sub + End If + Dim AccessToken As String = McLoginMsLoader.Output.AccessToken + Dim Uuid As String = McLoginMsLoader.Output.Uuid + Dim SkinData As JObject = GetJson(McLoginMsLoader.Output.ProfileJson) + '获取玩家的所有披风 + Dim SelId As Integer? = Nothing + RunInUiWait(Sub() + Try + Dim CapeNames As New Dictionary(Of String, String) From { + {"Migrator", "迁移者披风"}, {"MapMaker", "Realms 地图制作者披风"}, {"Moderator", "Mojira 管理员披风"}, {"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"} + } + Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}} + For Each Cape In SkinData("capes") + Dim CapeName As String = Cape("alias").ToString + If CapeNames.ContainsKey(CapeName) Then CapeName = CapeNames(CapeName) + SelectionControl.Add(New MyRadioBox With {.Text = CapeName}) + Next + SelId = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消") + Catch ex As Exception + Log(ex, "获取玩家皮肤列表失败", LogLevel.Feedback) + End Try + End Sub) + If SelId Is Nothing Then Exit Sub + '发送请求 + Dim Result As String = NetRequestRetry("https://api.minecraftservices.com/minecraft/profile/capes/active", + If(SelId = 0, "DELETE", "PUT"), + If(SelId = 0, "", "{""capeId"": """ & SkinData("capes")(SelId - 1)("id").ToString & """}"), + "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 + Else + Hint("更改披风成功！", HintType.Finish) + End If + Catch ex As Exception + Log(ex, "更改披风失败", LogLevel.Hint) + Finally + IsChanging = False + End Try + End Sub, "Cape Change") + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml new file mode 100644 index 0000000..4a36097 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml @@ -0,0 +1,158 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb new file mode 100644 index 0000000..7f9b597 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb @@ -0,0 +1,877 @@ +Public Class PageLaunchLeft + + '加载当前版本 + Private IsLoad As Boolean = False + Private IsLoadFinished As Boolean = False + Public Sub PageLaunchLeft_Loaded() Handles Me.Loaded + If IsLoad Then RefreshPage(True, False) + + AprilPosTrans.X = 0 + AprilPosTrans.Y = 0 + + If IsLoad Then Exit Sub + IsLoad = True + AniControlEnabled += 1 + + '开始按钮 + AddHandler McVersionListLoader.LoadingStateChanged, AddressOf RefreshButtonsUI + AddHandler McFolderListLoader.LoadingStateChanged, AddressOf RefreshButtonsUI + RefreshButtonsUI() + + '加载版本 + RunInNewThread(Sub() + '确认 Minecraft 文件夹存在 + PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path) + If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then + '无效的文件夹 + If PathMcFolder = "" Then + Log("[Launch] 没有已储存的 Minecraft 文件夹") + Else + Log("[Launch] Minecraft 文件夹无效，该文件夹已不存在：" & PathMcFolder, LogLevel.Debug) + End If + McFolderListLoader.WaitForExit(IsForceRestart:=True) + Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$")) + End If + Log("[Launch] Minecraft 文件夹：" & PathMcFolder) + If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000)) + '确认 Minecraft 版本存在 + Dim Selection As String = Setup.Get("LaunchVersionSelect") + Dim Version As McVersion + If Selection = "" Then + Version = Nothing + Else + Version = New McVersion(Selection) + End If + If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then + '无效的版本 + Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), "，没有有效版本", "：" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug)) + If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) + If McVersionList.Count = 0 OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then + Version = Nothing + Setup.Set("LaunchVersionSelect", "") + Log("[Launch] 无可用 Minecraft 版本") + Else + Version = McVersionList.First.Value(0) + Setup.Set("LaunchVersionSelect", Version.Name) + Log("[Launch] 自动选择 Minecraft 版本：" & Version.Path) + End If + End If + RunInUi(Sub() + McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变 + IsLoadFinished = True + RefreshButtonsUI() + RefreshPage(False, False) '有可能选择的版本变化了，需要重新刷新 + If McLoginAble() = "" Then McLoginLoader.Start() '自动登录 + End Sub) + End Sub, "Version Check", ThreadPriority.AboveNormal) + + '改变页面 + Dim LoginType As McLoginType = Setup.Get("LoginType") + If LoginType = McLoginType.Legacy OrElse LoginType = McLoginType.Mojang OrElse LoginType = McLoginType.Ms Then CType(FindName("RadioLoginType" & LoginType), MyRadioButton).Checked = True + RefreshPage(False, False) + + AniControlEnabled -= 1 + End Sub + +#Region "切换大页面" + + ''' + ''' 切换至启动中页面。 + ''' + Public Sub PageChangeToLaunching() + LaunchingPreload() + PanInput.IsHitTestVisible = False + PanLaunching.IsHitTestVisible = False + LoadLaunching.State.LoadingState = MyLoading.MyLoadingState.Run + PanLaunching.Visibility = Visibility.Visible + AniStart({ + AaOpacity(PanInput, 0, 50), '略作延迟，这样如果预检测失败，不会出现奇怪的弹一下的动画 + AaOpacity(PanInput, -PanInput.Opacity, 110, , New AniEaseInFluent, True), + AaScaleTransform(PanInput, 1.2 - CType(PanInput.RenderTransform, ScaleTransform).ScaleX, 160), + AaOpacity(PanLaunching, 1 - PanLaunching.Opacity, 150, 100), + AaScaleTransform(PanLaunching, 1 - CType(PanLaunching.RenderTransform, ScaleTransform).ScaleX, 500, 100, New AniEaseOutBack(AniEasePower.Weak)), + AaCode(Sub() PanLaunching.IsHitTestVisible = True, 150) + }, "Launch State Page") + End Sub + ''' + ''' 切换至登录页面。 + ''' + Public Sub PageChangeToLogin() + PageGet(PageCurrent).Reload(KeepInput:=False) + PanInput.IsHitTestVisible = False + PanLaunching.IsHitTestVisible = False + LoadLaunching.State.LoadingState = MyLoading.MyLoadingState.Stop + PanInput.Visibility = Visibility.Visible + AniStart({ + AaOpacity(PanLaunching, -PanLaunching.Opacity, 150), + AaScaleTransform(PanLaunching, 0.8 - CType(PanLaunching.RenderTransform, ScaleTransform).ScaleX, 150,, New AniEaseOutFluent(AniEasePower.Weak)), + AaOpacity(PanInput, 1 - PanInput.Opacity, 250, 50), + AaScaleTransform(PanInput, 1 - CType(PanInput.RenderTransform, ScaleTransform).ScaleX, 300, 50, New AniEaseOutBack(AniEasePower.Weak)), + AaCode(Sub() PanInput.IsHitTestVisible = True, 200) + }, "Launch State Page", True) + End Sub + +#End Region + +#Region "切换登录页面" + + Private Enum PageType + None + Mojang + MojangSkin + Legacy + Nide + NideSkin + Auth + AuthSkin + Ms + MsSkin + End Enum + ''' + ''' 当前页面的种类。 + ''' + Private PageCurrent As PageType = PageType.None + + Private Function PageGet(Type As PageType) + Select Case Type + Case PageType.Mojang + If IsNothing(FrmLoginMojang) Then FrmLoginMojang = New PageLoginMojang + Return FrmLoginMojang + Case PageType.MojangSkin + If IsNothing(FrmLoginMojangSkin) Then FrmLoginMojangSkin = New PageLoginMojangSkin + Return FrmLoginMojangSkin + Case PageType.Legacy + If IsNothing(FrmLoginLegacy) Then FrmLoginLegacy = New PageLoginLegacy + Return FrmLoginLegacy + Case PageType.Nide + If IsNothing(FrmLoginNide) Then FrmLoginNide = New PageLoginNide + Return FrmLoginNide + Case PageType.NideSkin + If IsNothing(FrmLoginNideSkin) Then FrmLoginNideSkin = New PageLoginNideSkin + Return FrmLoginNideSkin + Case PageType.Auth + If IsNothing(FrmLoginAuth) Then FrmLoginAuth = New PageLoginAuth + Return FrmLoginAuth + Case PageType.AuthSkin + If IsNothing(FrmLoginAuthSkin) Then FrmLoginAuthSkin = New PageLoginAuthSkin + Return FrmLoginAuthSkin + Case PageType.Ms + If IsNothing(FrmLoginMs) Then FrmLoginMs = New PageLoginMs + Return FrmLoginMs + Case PageType.MsSkin + If IsNothing(FrmLoginMsSkin) Then FrmLoginMsSkin = New PageLoginMsSkin + Return FrmLoginMsSkin + Case Else + Throw New ArgumentOutOfRangeException("Type", "即将切换的登录分页编号越界") + End Select + End Function + ''' + ''' 切换现有登录页面种类，返回新页面的实例。 + ''' + ''' 新页面的种类。 + ''' 是否显示动画。 + Private Function PageChange(Type As PageType, Anim As Boolean) + Dim PageNew As Object = FrmLoginMojang '初始化一个东西，避免在执行时出现异常导致雪崩 + Try + +#Region "确定更改的页面实例并实例化" + If PageCurrent = Type Then Return PageNew + PageNew = PageGet(Type) +#End Region + +#Region "切换页面" + AniStop("FrmLogin PageChange") + '清除页面关联性 + If Not IsNothing(PageNew) AndAlso Not IsNothing(PageNew.Parent) Then PageNew.SetValue(ContentPresenter.ContentProperty, Nothing) + If Anim Then + '动画 + Dispatcher.Invoke(Sub() + '执行动画 + AniStart({ + AaOpacity(PanLogin, -PanLogin.Opacity, 100,, New AniEaseOutFluent), + AaCode(Sub() + AniControlEnabled += 1 + PanLogin.Children.Clear() + PanLogin.Children.Add(PageNew) + AniControlEnabled -= 1 + End Sub, 100), + AaOpacity(PanLogin, 1, 100, 120, New AniEaseInFluent) + }, "FrmLogin PageChange") + End Sub, Threading.DispatcherPriority.Render) + Else + '无动画 + AniControlEnabled += 1 + PanLogin.Children.Clear() + PanLogin.Children.Add(PageNew) + AniControlEnabled -= 1 + End If +#End Region + + PageCurrent = Type + Return PageNew + Catch ex As Exception + Log(ex, "切换登录分页失败（" & GetStringFromEnum(CType(Type, [Enum])) & "）", LogLevel.Feedback) + Return PageNew + End Try + End Function + + ''' + ''' 确认当前显示的子页面正确，并刷新该页面。 + ''' + Public Sub RefreshPage(KeepInput As Boolean, Anim As Boolean) + '获取页面的可用种类并回写缓存 + Dim Type As PageType + Dim LoginPageType As Integer + If McVersionCurrent IsNot Nothing Then + LoginPageType = Setup.Get("VersionServerLogin", Version:=McVersionCurrent) + '缓存当前版本的页面种类，下一次打开 McVersionCurrent 为空时才能加载出正确的页面 + Setup.Set("LoginPageType", LoginPageType) + Else + LoginPageType = Setup.Get("LoginPageType") + End If + Select Case LoginPageType + Case 0 '正版或离线 +UnknownType: + If RadioLoginType1.Checked Then + If Setup.Get("CacheMojangAccess") = "" Then + Type = PageType.Mojang + Else + Type = PageType.MojangSkin + End If + Setup.Set("LoginType", McLoginType.Mojang) + ElseIf RadioLoginType5.Checked Then + If Setup.Get("CacheMsAccess") = "" Then + Type = PageType.Ms + Else + Type = PageType.MsSkin + End If + Setup.Set("LoginType", McLoginType.Ms) + Else + Type = PageType.Legacy + Setup.Set("LoginType", McLoginType.Legacy) + End If + PanType.Visibility = Visibility.Visible + PanTypeOne.Visibility = Visibility.Collapsed + RadioLoginType1.Visibility = Visibility.Visible + RadioLoginType5.Visibility = Visibility.Visible + RadioLoginType0.Visibility = Visibility.Visible + Case 1 '仅正版 + If RadioLoginType5.Checked Then + If Setup.Get("CacheMsAccess") = "" Then + Type = PageType.Ms + Else + Type = PageType.MsSkin + End If + Setup.Set("LoginType", McLoginType.Ms) + Else + If Setup.Get("CacheMojangAccess") = "" Then + Type = PageType.Mojang + Else + Type = PageType.MojangSkin + End If + Setup.Set("LoginType", McLoginType.Mojang) + End If + PanType.Visibility = Visibility.Visible + PanTypeOne.Visibility = Visibility.Collapsed + RadioLoginType1.Visibility = Visibility.Visible + RadioLoginType5.Visibility = Visibility.Visible + RadioLoginType0.Visibility = Visibility.Collapsed + Case 2 '仅离线 + Type = PageType.Legacy + Setup.Set("LoginType", McLoginType.Legacy) + PanType.Visibility = Visibility.Collapsed + PanTypeOne.Visibility = Visibility.Visible + PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonUser) + LabTypeOne.Text = "离线登录" + Case 3 '统一通行证 + If Setup.Get("CacheNideAccess") = "" Then + Type = PageType.Nide + Else + Type = PageType.NideSkin + End If + Setup.Set("LoginType", McLoginType.Nide) + PanType.Visibility = Visibility.Collapsed + PanTypeOne.Visibility = Visibility.Visible + PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard) + LabTypeOne.Text = "统一通行证登录" + Case 4 'Authlib-Injector + If Setup.Get("CacheAuthAccess") = "" Then + Type = PageType.Auth + Else + Type = PageType.AuthSkin + End If + Setup.Set("LoginType", McLoginType.Auth) + PanType.Visibility = Visibility.Collapsed + PanTypeOne.Visibility = Visibility.Visible + PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard) + LabTypeOne.Text = If(McVersionCurrent Is Nothing, Setup.Get("CacheAuthServerName"), Setup.Get("VersionServerAuthName", Version:=McVersionCurrent)) + If LabTypeOne.Text = "" Then LabTypeOne.Text = "第三方登录" + Case Else + Log("[Control] 未知的登录页面：" & LoginPageType, LogLevel.Hint) + GoTo UnknownType + End Select + '刷新页面 + If PageCurrent = Type Then Exit Sub + PageChange(Type, Anim).Reload(KeepInput) + Dim Control As MyRadioButton = FindName("RadioLoginType" & Setup.Get("LoginType")) + If Control IsNot Nothing Then Control.Checked = True + End Sub + Private Sub RadioLoginType_Change(sender As Object, raiseByMouse As Boolean) Handles RadioLoginType0.Check, RadioLoginType1.Check, RadioLoginType5.Check + If raiseByMouse Then RefreshPage(True, True) + End Sub + +#End Region + +#Region "皮肤" + + 'Mojang 正版皮肤 + Public Shared SkinMojang As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Mojang", AddressOf SkinMojangLoad, AddressOf SkinMojangInput, ThreadPriority.AboveNormal) + Private Shared Function SkinMojangInput() As EqualableList(Of String) + '获取名称 + Return New EqualableList(Of String) From {Setup.Get("CacheMojangName"), Setup.Get("CacheMojangUuid")} + End Function + Private Shared Sub SkinMojangLoad(Data As LoaderTask(Of EqualableList(Of String), String)) + '清空已有皮肤 + '如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载 + RunInUi(Sub() If FrmLoginMojangSkin IsNot Nothing AndAlso FrmLoginMojangSkin.Skin IsNot Nothing Then FrmLoginMojangSkin.Skin.Clear()) + '获取 Url + Dim UserName As String = Data.Input(0) + Dim Uuid As String = Data.Input(1) + If UserName = "" Then + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" + Log("[Minecraft] 获取正版皮肤失败，ID 为空") + GoTo Finish + End If + Try + Dim Result As String = McSkinGetAddress(Uuid, "Mojang") + If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消：" & UserName) + Result = McSkinDownload(Result) + If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消：" & UserName) + Data.Output = Result + Catch ex As Exception + If ex.GetType.Name = "ThreadInterruptedException" Then + Data.Output = "" + Exit Sub + ElseIf GetString(ex).Contains("429") Then + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" + Log("[Minecraft] 获取正版皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint) + ElseIf GetString(ex).Contains("未设置自定义皮肤") Then + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" + Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载") + Else + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" + Log(ex, "获取正版皮肤失败（" & UserName & "）", LogLevel.Hint) + End If + End Try +Finish: + '刷新显示 + If FrmLoginMojangSkin IsNot Nothing Then + RunInUi(AddressOf FrmLoginMojangSkin.Skin.Load) + ElseIf Not Data.IsAborted Then '如果已经中断，Input 也被清空，就不会再次刷新 + Data.Input = Nothing '清空输入，因为皮肤实际上没有被渲染，如果不清空切换到页面的 Start 会由于输入相同而不渲染 + End If + End Sub + + '微软正版皮肤 + Public Shared SkinMs As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal) + Private Shared Function SkinMsInput() As EqualableList(Of String) + '获取名称 + Return New EqualableList(Of String) From {Setup.Get("CacheMsName"), Setup.Get("CacheMsUuid")} + End Function + Private Shared Sub SkinMsLoad(Data As LoaderTask(Of EqualableList(Of String), String)) + '清空已有皮肤 + '如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载 + RunInUi(Sub() If FrmLoginMsSkin IsNot Nothing AndAlso FrmLoginMsSkin.Skin IsNot Nothing Then FrmLoginMsSkin.Skin.Clear()) + '获取 Url + Dim UserName As String = Data.Input(0) + Dim Uuid As String = Data.Input(1) + If UserName = "" Then + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" + Log("[Minecraft] 获取微软正版皮肤失败，ID 为空") + GoTo Finish + End If + Try + Dim Result As String = McSkinGetAddress(Uuid, "Ms") + If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消：" & UserName) + Result = McSkinDownload(Result) + If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消：" & UserName) + Data.Output = Result + Catch ex As Exception + If ex.GetType.Name = "ThreadInterruptedException" Then + Data.Output = "" + Exit Sub + ElseIf GetString(ex).Contains("429") Then + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" + Log("[Minecraft] 获取正版皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint) + ElseIf GetString(ex).Contains("未设置自定义皮肤") Then + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" + Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载") + Else + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" + Log(ex, "获取微软正版皮肤失败（" & UserName & "）", LogLevel.Hint) + End If + End Try +Finish: + '刷新显示 + If FrmLoginMsSkin IsNot Nothing Then + RunInUi(AddressOf FrmLoginMsSkin.Skin.Load) + ElseIf Not Data.IsAborted Then '如果已经中断，Input 也被清空，就不会再次刷新 + Data.Input = Nothing '清空输入，因为皮肤实际上没有被渲染，如果不清空切换到页面的 Start 会由于输入相同而不渲染 + End If + End Sub + + '离线皮肤 + Public Shared SkinLegacy As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Legacy", AddressOf SkinLegacyLoad, AddressOf SkinLegacyInput, ThreadPriority.AboveNormal) + Private Shared Function SkinLegacyInput() As EqualableList(Of String) + '根据类型判断输入 + Dim Type As Integer = Setup.Get("LaunchSkinType") + Select Case Type + Case 0 + If FrmLoginLegacy IsNot Nothing AndAlso FrmLoginLegacy.IsReloaded Then + Return New EqualableList(Of String) From {0, If(FrmLoginLegacy.ComboName.Text, "")} + ElseIf Setup.Get("LoginLegacyName") = "" Then + Return New EqualableList(Of String) From {0, ""} + Else + Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.Split("¨")(0), "")} + End If + Case 3 + Return New EqualableList(Of String) From {3, Setup.Get("LaunchSkinID")} + Case Else + Return New EqualableList(Of String) From {Type} + End Select + End Function + Private Shared Sub SkinLegacyLoad(Data As LoaderTask(Of EqualableList(Of String), String)) + '清空已有皮肤 + RunInUi(Sub() If FrmLoginLegacy IsNot Nothing AndAlso FrmLoginLegacy.Skin IsNot Nothing Then FrmLoginLegacy.Skin.Clear()) + '获取 Url + Select Case Data.Input(0) + Case 0 '默认 + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(Data.Input(1))) & ".png" + Case 1 'Steve +UseDefault: + Data.Output = PathImage & "Skins/Steve.png" + Case 2 'Alex + Data.Output = PathImage & "Skins/Alex.png" + Case 3 '正版 + Dim ID As String = Data.Input(1) + Try + If ID.Count < 2 Then + Data.Output = PathImage & "Skins/Steve.png" + Else + Dim Result As String = McLoginMojangUuid(ID, True) + If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消：" & ID) + Result = McSkinGetAddress(Result, "Mojang") + If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消：" & ID) + Result = McSkinDownload(Result) + If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消：" & ID) + Data.Output = Result + End If + Catch ex As Exception + If ex.GetType.Name = "ThreadInterruptedException" Then + Data.Output = "" + Exit Sub + ElseIf GetString(ex).Contains("429") Then + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png" + Log("获取离线登录使用的正版皮肤失败（" & ID & "）：获取皮肤太过频繁，请 5 分钟后再试！") + Else + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png" + Log(ex, "获取离线登录使用的正版皮肤失败（" & ID & "）") + End If + End Try + Case 4 '自定义 + If Not File.Exists(PathTemp & "CustomSkin.png") Then + Hint("未找到离线皮肤自定义文件，可能它已被删除。PCL2 将使用默认的 Steve 皮肤！") + Setup.Set("LaunchSkinType", 1) + GoTo UseDefault + End If + Data.Output = PathTemp & "CustomSkin.png" + End Select + '刷新显示 + If FrmLoginLegacy IsNot Nothing Then + RunInUi(AddressOf FrmLoginLegacy.Skin.Load) + ElseIf Not Data.IsAborted Then '如果已经中断，Input 也被清空，就不会再次刷新 + Data.Input = Nothing '清空输入，因为皮肤实际上没有被渲染，如果不清空切换到页面的 Start 会由于输入相同而不渲染 + End If + End Sub + + '统一通行证皮肤 + Public Shared SkinNide As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Nide", AddressOf SkinNideLoad, AddressOf SkinNideInput, ThreadPriority.AboveNormal) + Private Shared Function SkinNideInput() As EqualableList(Of String) + '获取名称 + Return New EqualableList(Of String) From {Setup.Get("CacheNideName"), Setup.Get("CacheNideUuid")} + End Function + Private Shared Sub SkinNideLoad(Data As LoaderTask(Of EqualableList(Of String), String)) + '清空已有皮肤 + '如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载 + RunInUi(Sub() If FrmLoginNideSkin IsNot Nothing AndAlso FrmLoginNideSkin.Skin IsNot Nothing Then FrmLoginNideSkin.Skin.Clear()) + '获取 Url + Dim UserName As String = Data.Input(0) + Dim Uuid As String = Data.Input(1) + If UserName = "" Then + Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png" + Log("[Minecraft] 获取统一通行证皮肤失败，ID 为空") + GoTo Finish + End If + Try + Dim Result As String = McSkinGetAddress(Uuid, "Nide") + If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消：" & UserName) + Result = McSkinDownload(Result) + If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消：" & UserName) + Data.Output = Result + Catch ex As Exception + If ex.GetType.Name = "ThreadInterruptedException" Then + Data.Output = "" + Exit Sub + ElseIf GetString(ex).Contains("429") Then + Data.Output = PathImage & "Skins/Steve.png" + Log("[Minecraft] 获取统一通行证皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint) + ElseIf GetString(ex).Contains("未设置自定义皮肤") Then + Data.Output = PathImage & "Skins/Steve.png" + Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载") + Else + Data.Output = PathImage & "Skins/Steve.png" + Log(ex, "获取统一通行证皮肤失败（" & UserName & "）", LogLevel.Hint) + End If + End Try +Finish: + '刷新显示 + If FrmLoginNideSkin IsNot Nothing Then + RunInUi(AddressOf FrmLoginNideSkin.Skin.Load) + ElseIf Not Data.IsAborted Then '如果已经中断，Input 也被清空，就不会再次刷新 + Data.Input = Nothing '清空输入，因为皮肤实际上没有被渲染，如果不清空切换到页面的 Start 会由于输入相同而不渲染 + End If + End Sub + + 'Authlib-Injector 皮肤 + Public Shared SkinAuth As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Auth", AddressOf SkinAuthLoad, AddressOf SkinAuthInput, ThreadPriority.AboveNormal) + Private Shared Function SkinAuthInput() As EqualableList(Of String) + '获取名称 + Return New EqualableList(Of String) From {Setup.Get("CacheAuthName"), Setup.Get("CacheAuthUuid")} + End Function + Private Shared Sub SkinAuthLoad(Data As LoaderTask(Of EqualableList(Of String), String)) + '清空已有皮肤 + '如果在输入时清空皮肤，若输入内容一样则不会执行 Load 方法，导致皮肤不被加载 + RunInUi(Sub() If FrmLoginAuthSkin IsNot Nothing AndAlso FrmLoginAuthSkin.Skin IsNot Nothing Then FrmLoginAuthSkin.Skin.Clear()) + '获取 Url + Dim UserName As String = Data.Input(0) + Dim Uuid As String = Data.Input(1) + If UserName = "" Then + Data.Output = PathImage & "Skins/Steve.png" + Log("[Minecraft] 获取 Authlib-Injector 皮肤失败，ID 为空") + GoTo Finish + End If + Try + Dim Result As String = McSkinGetAddress(Uuid, "Auth") + If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消：" & UserName) + Result = McSkinDownload(Result) + If Data.IsAborted Then Throw New ThreadInterruptedException("当前任务已取消：" & UserName) + Data.Output = Result + Catch ex As Exception + If ex.GetType.Name = "ThreadInterruptedException" Then + Data.Output = "" + Exit Sub + ElseIf GetString(ex).Contains("429") Then + Data.Output = PathImage & "Skins/Steve.png" + Log("[Minecraft] 获取 Authlib-Injector 皮肤失败（" & UserName & "）：获取皮肤太过频繁，请 5 分钟后再试！", LogLevel.Hint) + ElseIf GetString(ex).Contains("未设置自定义皮肤") Then + Data.Output = PathImage & "Skins/Steve.png" + Log("[Minecraft] 用户未设置自定义皮肤，跳过皮肤加载") + Else + Data.Output = PathImage & "Skins/Steve.png" + Log(ex, "获取 Authlib-Injector 皮肤失败（" & UserName & "）", LogLevel.Hint) + End If + End Try +Finish: + '刷新显示 + If FrmLoginAuthSkin IsNot Nothing Then + RunInUi(AddressOf FrmLoginAuthSkin.Skin.Load) + ElseIf Not Data.IsAborted Then '如果已经中断，Input 也被清空，就不会再次刷新 + Data.Input = Nothing '清空输入，因为皮肤实际上没有被渲染，如果不清空切换到页面的 Start 会由于输入相同而不渲染 + End If + End Sub + + '全部皮肤加载器 + '需要放在其中元素的后面，否则会因为它提前被加载而莫名其妙变成 Nothing + Public Shared SkinLoaders As New List(Of LoaderTask(Of EqualableList(Of String), String)) From {SkinMojang, SkinMs, SkinLegacy, SkinNide, SkinAuth} + +#End Region + + '版本选择按钮 + Private Sub BtnVersion_Click(sender As Object, e As EventArgs) Handles BtnVersion.Click + FrmMain.PageChange(FormMain.PageType.VersionSelect) + End Sub + '启动按钮 + Private Sub BtnLaunch_Click() Handles BtnLaunch.Click + LaunchButtonClick() + End Sub + Public Sub LaunchButtonClick(Optional ServerIp As String = "") + If BtnLaunch.IsEnabled AndAlso BtnLaunch.Visibility = Visibility.Visible AndAlso BtnLaunch.IsHitTestVisible Then + If BtnLaunch.Text = "启动游戏" Then + McLaunchLoader.Start(ServerIp) + ElseIf BtnLaunch.Text = "下载游戏" Then + FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall) + End If + '愚人节处理 + If IsAprilEnabled AndAlso Not IsAprilGiveup Then + ThemeUnlock(12, False, "隐藏主题 滑稽彩 已解锁！") + IsAprilGiveup = True + FrmLaunchLeft.AprilScaleTrans.ScaleX = 1 + FrmLaunchLeft.AprilScaleTrans.ScaleY = 1 + FrmLaunchLeft.AprilPosTrans.X = 0 + FrmLaunchLeft.AprilPosTrans.Y = 0 + FrmMain.BtnExtraApril.ShowRefresh() + End If + End If + End Sub + Private BtnLaunchState As Integer = 0 + Private BtnLaunchVersion As McVersion = Nothing + Public Sub RefreshButtonsUI() Handles BtnLaunch.Loaded + If Not BtnLaunch.IsLoaded Then Exit Sub + '获取当前状态 + Dim CurrentState As Integer + If (Not IsLoadFinished) OrElse McVersionListLoader.State = LoadState.Loading OrElse McFolderListLoader.State = LoadState.Loading Then + CurrentState = 0 + Else + If McVersionCurrent Is Nothing Then + If Setup.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow Then + CurrentState = 1 + Else + CurrentState = 2 + End If + Else + CurrentState = 3 + End If + End If + '更新状态 + If CurrentState = BtnLaunchState AndAlso + If(McVersionCurrent Is Nothing, "", McVersionCurrent.Path) = If(BtnLaunchVersion Is Nothing, "", BtnLaunchVersion.Path) Then GoTo ExitRefresh + BtnLaunchVersion = McVersionCurrent + BtnLaunchState = CurrentState + Select Case CurrentState + Case 0 + Log("[Minecraft] 启动按钮：正在加载 Minecraft 版本") + FrmLaunchLeft.BtnLaunch.Text = "正在加载" + FrmLaunchLeft.BtnLaunch.IsEnabled = False + FrmLaunchLeft.LabVersion.Text = "正在加载版本列表，请稍候" + FrmLaunchLeft.BtnVersion.IsEnabled = False + FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed + Case 1 + Log("[Minecraft] 启动按钮：无 Minecraft 版本，下载已禁用") + FrmLaunchLeft.BtnLaunch.Text = "启动游戏" + FrmLaunchLeft.BtnLaunch.IsEnabled = False + FrmLaunchLeft.LabVersion.Text = "未找到可用的游戏版本" + FrmLaunchLeft.BtnVersion.IsEnabled = True + FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed + Case 2 + Log("[Minecraft] 启动按钮：无 Minecraft 版本，要求下载") + FrmLaunchLeft.BtnLaunch.Text = "下载游戏" + FrmLaunchLeft.BtnLaunch.IsEnabled = True + FrmLaunchLeft.LabVersion.Text = "未找到可用的游戏版本" + FrmLaunchLeft.BtnVersion.IsEnabled = True + FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed + Case 3 + Log("[Minecraft] 启动按钮：Minecraft 版本：" & McVersionCurrent.Path) + FrmLaunchLeft.BtnLaunch.Text = "启动游戏" + FrmLaunchLeft.BtnVersion.IsEnabled = True + FrmLaunchLeft.BtnLaunch.IsEnabled = True + FrmLaunchLeft.LabVersion.Text = McVersionCurrent.Name + 'FrmLaunchLeft.BtnMore.Visibility = Visibility.Visible '由功能隐藏设置修改 + End Select +ExitRefresh: + '功能隐藏 + FrmLaunchLeft.BtnVersion.Visibility = If(Not PageSetupUI.HiddenForceShow AndAlso Setup.Get("UiHiddenFunctionSelect"), Visibility.Collapsed, Visibility.Visible) + If CurrentState = 3 Then + FrmLaunchLeft.BtnMore.Visibility = FrmLaunchLeft.BtnVersion.Visibility + End If + End Sub + '取消按钮 + Private Sub BtnCancel_Click() Handles BtnCancel.Click + If McLaunchLoaderReal IsNot Nothing Then + McLaunchLoaderReal.Abort() + McLaunchLog("已取消启动") + Try + If McLaunchWatcher IsNot Nothing Then + McLaunchWatcher.Kill() + ElseIf McLaunchProcess IsNot Nothing Then + If Not McLaunchProcess.HasExited Then McLaunchProcess.Kill() + End If + Catch ex As Exception + Log(ex, "取消启动结束进程失败", LogLevel.Hint) + End Try + End If + End Sub + '更多按钮 + Private Sub BtnMore_Click(sender As Object, e As EventArgs) Handles BtnMore.Click + McVersionCurrent.Load() + PageVersionLeft.Version = McVersionCurrent + FrmMain.PageChange(FormMain.PageType.VersionSetup, 0) + End Sub + '刷新 UI + Public Sub LaunchingPreload() + '修改登陆方式 + Select Case Setup.Get("LoginType") + Case McLoginType.Legacy + LabLaunchingMethod.Text = "离线登录" + Case McLoginType.Mojang + LabLaunchingMethod.Text = "Mojang 正版登录" + Case McLoginType.Ms + LabLaunchingMethod.Text = "微软正版登录" + Case McLoginType.Nide + LabLaunchingMethod.Text = "统一通行证" + Case McLoginType.Auth + LabLaunchingMethod.Text = "Authlib-Injector" + End Select + '初始化页面 + LabLaunchingName.Text = McVersionCurrent.Name + LabLaunchingStage.Text = "初始化" + LabLaunchingTitle.Text = "正在启动游戏" + LabLaunchingProgress.Text = "0.00 %" + LabLaunchingProgress.Opacity = 1 + LabLaunchingDownload.Visibility = Visibility.Visible + LabLaunchingProgressLeft.Opacity = 0.6 + LabLaunchingDownload.Visibility = Visibility.Visible + LabLaunchingDownload.Text = "0 B/s" + LabLaunchingDownload.Opacity = 0 + LabLaunchingDownload.Visibility = Visibility.Collapsed + LabLaunchingDownloadLeft.Opacity = 0 + LabLaunchingDownloadLeft.Visibility = Visibility.Collapsed + ProgressLaunchingFinished.Width = New GridLength(0, GridUnitType.Star) + ProgressLaunchingUnfinished.Width = New GridLength(1, GridUnitType.Star) + PanLaunchingHint.Opacity = 0 + PanLaunchingHint.Visibility = Visibility.Collapsed + PanLaunchingInfo.Width = Double.NaN '重置宽度改变动画 + McLaunchProcess = Nothing + McLaunchWatcher = Nothing + '获取 “你知道吗” 提示 + Dim Hint As String = PageOtherTest.GetRandomHint() + Try + Dim RawHints = Array.FindAll( + ReadFile(Path & "PCL\hints.txt").Replace(vbLf, "").Split(vbCr), + Function(Input As String) As Boolean + Return Not String.IsNullOrWhiteSpace(Input) + End Function) + If RawHints.Count > 0 Then Hint = RandomOne(RawHints) + Catch ex As Exception + Log(ex, "获取自定义 你知道吗 提示失败", LogLevel.Hint) + End Try + LabLaunchingHint.Text = Hint + End Sub + Private ShowProgress As Double = 0 + ''' + ''' 每 0.2s 执行一次，刷新启动的数据 UI 显示。 + ''' + Public Sub LaunchingRefresh() + Try + If McLaunchLoaderReal.State = LoadState.Aborted Then Exit Sub + '阶段状态获取 + Dim IsLaunched As Boolean = False '是否已经启动游戏，只是在等待窗口 + Try + For Each Loader In McLaunchLoaderReal.GetLoaderList(False) + If Loader.State = LoadState.Loading OrElse Loader.State = LoadState.Waiting Then + LabLaunchingStage.Text = Loader.Name + IsLaunched = Loader.Name = "等待游戏窗口出现" OrElse Loader.Name = "结束处理" + Exit Try + End If + Next + LabLaunchingStage.Text = "已完成" + Catch ex As Exception + Log(ex, "获取是否启动完成失败，可能是由于启动状态改变导致集合已修改") + Exit Sub + End Try + If AniIsRun("Launch State Page") Then IsLaunched = False '等待页面切换动画完成 + '计算应显示的进度 + Dim ActualProgress = McLaunchLoaderReal.Progress + If ActualProgress >= ShowProgress Then ShowProgress += (ActualProgress - ShowProgress) * 0.2 + 0.005 '向实际进度靠一点 + If ActualProgress <= ShowProgress Then ShowProgress = ActualProgress '原来或处理后变得比实际进度高，直接回退 + If IsLaunched Then ShowProgress = 1 '如果已经完成了，就不卖关子了 + '文本 + LabLaunchingTitle.Text = If(IsLaunched, "已启动游戏", "正在启动游戏") + LabLaunchingProgress.Text = StrFillNum(ShowProgress * 100, 2) & " %" + Dim HasLaunchDownloader As Boolean = False + Try + For Each Loader In NetManager.Tasks + If Loader.RealParent IsNot Nothing AndAlso Loader.RealParent.Name = "Minecraft 启动" AndAlso Loader.State = LoadState.Loading Then HasLaunchDownloader = True + Next + Catch ex As Exception + Log(ex, "获取 Minecraft 启动下载器失败，可能是因为启动被取消") + HasLaunchDownloader = False + End Try + LabLaunchingDownload.Text = GetString(NetManager.Speed) & "/s" + '进度改变动画 + Dim AnimList As New List(Of AniData) From { + AaGridLengthWidth(ProgressLaunchingFinished, ShowProgress - ProgressLaunchingFinished.Width.Value, 260,, New AniEaseOutFluent), + AaGridLengthWidth(ProgressLaunchingUnfinished, 1 - ShowProgress - ProgressLaunchingUnfinished.Width.Value, 260,, New AniEaseOutFluent) + } + Dim IsDownloadStateChanged As Boolean = HasLaunchDownloader = (LabLaunchingDownload.Visibility = Visibility.Collapsed) + If IsDownloadStateChanged Then + LabLaunchingDownload.Visibility = Visibility.Visible + LabLaunchingDownloadLeft.Visibility = Visibility.Visible + AnimList.AddRange({ + AaOpacity(LabLaunchingDownload, If(HasLaunchDownloader, 1, 0) - LabLaunchingDownload.Opacity, 100), + AaOpacity(LabLaunchingDownloadLeft, If(HasLaunchDownloader, 0.5, 0) - LabLaunchingDownloadLeft.Opacity, 100), + AaCode(Sub() + If Not HasLaunchDownloader Then + LabLaunchingDownload.Visibility = Visibility.Collapsed + LabLaunchingDownloadLeft.Visibility = Visibility.Collapsed + End If + End Sub, 110) + }) + End If + Dim IsProgressStateChanged As Boolean = (Not IsLaunched) = (LabLaunchingProgress.Visibility = Visibility.Collapsed) + If IsProgressStateChanged Then + LabLaunchingProgress.Visibility = Visibility.Visible + LabLaunchingProgressLeft.Visibility = Visibility.Visible + If IsLaunched Then + 'IsWidthAnimating = True + PanLaunchingHint.Visibility = Visibility.Visible + 'AniStop("Launching Info Width") + 'PanLaunchingInfo.Width = 260 + 'ActualUsedWidth = 260 + 'IsWidthAnimating = False + End If + AnimList.AddRange({ + AaOpacity(LabLaunchingProgress, If(Not IsLaunched, 1, 0) - LabLaunchingProgress.Opacity, 100), + AaOpacity(LabLaunchingProgressLeft, If(Not IsLaunched, 0.5, 0) - LabLaunchingProgressLeft.Opacity, 100), + AaOpacity(PanLaunchingHint, If(IsLaunched, 1, 0) - PanLaunchingHint.Opacity, 100) + }) + End If + AniStart(AnimList, "Launching Progress") + Catch ex As Exception + Log(ex, "刷新启动信息失败", LogLevel.Feedback) + End Try + End Sub + '尺寸改变动画 + Private IsWidthAnimating As Boolean = False + 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 + AniStart({ + AaWidth(PanLaunchingInfo, DeltaWidth, 180,, New AniEaseOutFluent), + AaCode(Sub() + IsWidthAnimating = False + PanLaunchingInfo.Width = ActualUsedWidth + End Sub,, True) + }, "Launching Info Width") + IsWidthAnimating = True + ActualUsedWidth = PanLaunchingInfo.Width + PanLaunchingInfo.Width = e.PreviousSize.Width + End Sub + Private IsHeightAnimating As Boolean = False + 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 + AniStart({ + AaHeight(PanLaunchingInfo, DeltaHeight, 180,, New AniEaseOutFluent), + AaCode(Sub() + IsHeightAnimating = False + PanLaunchingInfo.Height = ActualUsedHeight + End Sub,, True) + }, "Launching Info Height") + IsHeightAnimating = True + ActualUsedHeight = PanLaunchingInfo.Height + PanLaunchingInfo.Height = e.PreviousSize.Height + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml new file mode 100644 index 0000000..246c05d --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml @@ -0,0 +1,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb new file mode 100644 index 0000000..ae42504 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb @@ -0,0 +1,110 @@ +Public Class PageLaunchRight + + Private Sub Init() Handles Me.Loaded + PanBack.ScrollToHome() + PanLog.Visibility = If(ModeDebug, Visibility.Visible, Visibility.Collapsed) + '刷新主页 + If ShouldRefresh Then + ShouldRefresh = False + RefreshCustom() + End If + '快照版提示 +#If BETA Then + PanHint.Visibility = Visibility.Collapsed +#Else + PanHint.Title = "快照版提示" + PanHint.Visibility = If(ThemeCheckGold(), Visibility.Collapsed, Visibility.Visible) + LabHint1.Text = "快照版包含尚未在正式版发布的测试性功能，仅用于赞助者本人尝鲜。所以请不要发给其他人或者用于制作整合包哦！如果发现了 Bug，可以在 更多 → 反馈 中提交！" + LabHint2.Text = "你可以通过赞助￥23.33 档位换取解锁码来隐藏这个提示。" +#End If + End Sub + + Private LatestFileContent As String = "" + Private LatestFileLink As String = Nothing + Private IsRefreshing As Boolean = False + Public ShouldRefresh As Boolean = True + ''' + ''' 刷新自定义的主页。返回是否成功。 + ''' + Private Sub RefreshCustom() + If IsRefreshing Then + ShouldRefresh = True + Exit Sub + End If + Try + IsRefreshing = True + PanCustom.Children.Clear() + RunInNewThread(Sub() + Dim FileContent As String = "" + Select Case Setup.Get("UiCustomType") + Case 0 + '啥也不干 + Case 1 + '加载本地文件 + FileContent = ReadFile(Path & "PCL\Custom.xaml") 'ReadFile 会进行存在检测 + Log("[System] 尝试从本地文件读取主页自定义数据（" & FileContent.Length & "）") + Case 2 + '加载联网文件 + Try + Dim Link As String = Setup.Get("UiCustomNet") + If Link = LatestFileLink Then + FileContent = LatestFileContent + Log("[System] 尝试缓存加载主页自定义数据（" & FileContent.Length & "）") + ElseIf Not String.IsNullOrWhiteSpace(Link) Then + Log("[System] 开始从网络读取主页自定义数据（" & Link & "）") + FileContent = NetGetCodeByRequestRetry(Link) + Log("[System] 尝试从网络读取主页自定义数据（" & FileContent.Length & "）") + End If + LatestFileLink = Link + LatestFileContent = FileContent + Catch ex As Exception + Log(ex, "获取 PCL2 主页自定义信息失败", LogLevel.Msgbox) + LatestFileLink = "" + End Try + End Select + If FileContent = "" Then + IsRefreshing = False + Exit Sub + End If + FileContent = "" & FileContent & "" + FileContent = FileContent.Replace("{path}", Path) + RunInUi(Sub() + Try + Log("[System] 加载主页自定义数据") + PanCustom.Children.Add(GetObjectFromXML(FileContent)) + IsRefreshing = False + Catch ex As Exception + IsRefreshing = False + Log("[System] 自定义信息内容：" & vbCrLf & FileContent) + If MyMsgBox(ex.Message, "加载自定义主页失败", "重试", "取消") = 1 Then + LatestFileLink = Nothing + LatestFileContent = "" + RefreshCustom() + End If + End Try + End Sub) + End Sub, "主页自定义刷新") + Catch ex As Exception + Log(ex, "加载 PCL2 主页自定义信息失败", LogLevel.Msgbox) + IsRefreshing = False + End Try + End Sub + + Public Sub ForceRefresh(Optional ShowHint As Boolean = True) + ShouldRefresh = True + LatestFileContent = "" + LatestFileLink = Nothing + If ShowHint Then Hint("已刷新主页！", HintType.Finish) + FrmMain.PageChange(FormMain.PageType.Launch) + Init() + End Sub + + Private Sub BtnMsStart_Click() Handles BtnMsStart.Click + MyMsgBox("在迁移过程中，你可能需要设置你的档案信息。" & vbCrLf & "在输入年龄或生日时，请注意让你的年龄大于 18 岁，否则可能导致无法登录！", "迁移提示", "继续", ForceWait:=True) + OpenWebsite("https://www.minecraft.net/zh-hans/account-security") + End Sub + Private Sub BtnMsFaq_Click() Handles BtnMsFaq.Click + OpenWebsite("https://www.mcbbs.net/thread-1252431-1-1.html") + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml new file mode 100644 index 0000000..97e5609 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb new file mode 100644 index 0000000..7445bd6 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb @@ -0,0 +1,86 @@ +Public Class PageLoginAuth + Private IsFirstLoad As Boolean = True + ''' + ''' 刷新页面显示的所有信息。 + ''' + Public Sub Reload(KeepInput As Boolean) + '记住密码 + CheckRemember.Checked = Setup.Get("LoginRemember") + If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载，导致文本框里没东西 + '保留输入，只刷新下拉框列表 + Dim Input As String = ComboName.Text + ComboName.ItemsSource = If(Setup.Get("LoginAuthEmail") = "", Nothing, Setup.Get("LoginAuthEmail").ToString.Split("¨")) + ComboName.Text = Input + Else + '不保留输入，刷新列表后自动选择第一项 + If Setup.Get("LoginAuthEmail") = "" Then + ComboName.ItemsSource = Nothing + Else + ComboName.ItemsSource = Setup.Get("LoginAuthEmail").ToString.Split("¨") + ComboName.Text = Setup.Get("LoginAuthEmail").ToString.Split("¨")(0) + If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.Split("¨")(0).Trim + End If + End If + IsFirstLoad = False + End Sub + ''' + ''' 获取当前页面的登录信息。 + ''' + Public Shared Function GetLoginData() As McLoginServer + Dim Server As String = If(IsNothing(McVersionCurrent), Setup.Get("CacheAuthServerServer"), Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)) & "/authserver" + If FrmLoginAuth Is Nothing Then + Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = "", .Password = "", .Description = "Authlib-Injector", .Type = McLoginType.Auth} + Else + Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = FrmLoginAuth.ComboName.Text.Replace("¨", "").Trim, .Password = FrmLoginAuth.TextPass.Password.Replace("¨", "").Trim, .Description = "Authlib-Injector", .Type = McLoginType.Auth} + End If + End Function + ''' + ''' 当前页面的登录信息是否有效。 + ''' + Public Shared Function IsVaild(LoginData As McLoginServer) As String + If LoginData.UserName = "" Then Return "账号不能为空！" + If LoginData.Password = "" Then Return "密码不能为空！" + Return "" + End Function + Public Function IsVaild() As String + Return IsVaild(GetLoginData()) + End Function + + '保存输入信息 + Private Sub ComboName_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged + If sender.Text = "" Then TextPass.Password = "" + If AniControlEnabled = 0 Then Setup.Set("CacheAuthAccess", "") '迫使其不进行 Validate + End Sub + Private Sub TextPass_PasswordChanged(sender As Object, e As RoutedEventArgs) Handles TextPass.PasswordChanged + If AniControlEnabled = 0 Then Setup.Set("CacheAuthAccess", "") + End Sub + Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged + If sender.SelectedIndex = -1 OrElse Not Setup.Get("LoginRemember") Then + TextPass.Password = "" + Else + TextPass.Password = Setup.Get("LoginAuthPass").ToString.Split("¨")(sender.SelectedIndex).Trim + End If + End Sub + Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) + End Sub + + '链接处理 + Private Sub ComboName_TextChanged() Handles ComboName.TextChanged + BtnLink.Content = If(ComboName.Text = "", "注册账号", "找回密码") + End Sub + Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click + If BtnLink.Content = "注册账号" Then + OpenWebsite(If(McVersionCurrent Is Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister"))) + Else + Dim Website As String = If(McVersionCurrent Is Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")) + OpenWebsite(Website.Replace("/auth/register", "/auth/forgot")) + End If + End Sub + '切换注册按钮可见性 + Private Sub ReloadRegisterButton() Handles Me.Loaded + Dim Address As String = If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")) + BtnLink.Visibility = If(String.IsNullOrEmpty(New ValidateHttp().Validate(Address)), Visibility.Visible, Visibility.Collapsed) + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml new file mode 100644 index 0000000..893672b --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml.vb new file mode 100644 index 0000000..0ed101d --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml.vb @@ -0,0 +1,82 @@ +Public Class PageLoginAuthSkin + + Public Sub New() + InitializeComponent() + Skin.Loader = PageLaunchLeft.SkinAuth + End Sub + Private Sub PageLoginLegacy_Loaded() Handles Me.Loaded + Skin.Loader.Start() + End Sub + + ''' + ''' 刷新页面显示的所有信息。 + ''' + Public Sub Reload(KeepInput As Boolean) + TextName.Text = Setup.Get("CacheAuthName") + TextEmail.Text = Setup.Get("CacheAuthUsername") + TextEmail.Visibility = If(Setup.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible) + PageLoginLegacy_Loaded() + End Sub + ''' + ''' 获取当前页面的登录信息。 + ''' + Public Shared Function GetLoginData() As McLoginServer + Dim Server As String = If(IsNothing(McVersionCurrent), Setup.Get("CacheAuthServerServer"), Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)) & "/authserver" + Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = Setup.Get("CacheAuthUsername"), .Password = Setup.Get("CacheAuthPass"), .Description = "Authlib-Injector", .Type = McLoginType.Auth} + End Function + + Private Sub PageLoginAuthSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter + AniStart({ + AaOpacity(BtnEdit, 1 - BtnEdit.Opacity, 80), + AaHeight(BtnEdit, 25.5 - BtnEdit.Height, 140,, New AniEaseOutFluent), + AaHeight(BtnEdit, -1.5, 50, 140, New AniEaseInFluent), + AaOpacity(BtnExit, 1 - BtnExit.Opacity, 80), + AaHeight(BtnExit, 25.5 - BtnExit.Height, 140,, New AniEaseOutFluent), + AaHeight(BtnExit, -1.5, 50, 140, New AniEaseInFluent) + }, "PageLoginAuthSkin Button") + End Sub + Private Sub PageLoginAuthSkin_MouseLeave(sender As Object, e As MouseEventArgs) Handles PanData.MouseLeave + AniStart({ + AaOpacity(BtnEdit, -BtnEdit.Opacity, 120,, New AniEaseOutFluent), + AaHeight(BtnEdit, 14 - BtnEdit.Height, 120,, New AniEaseInFluent), + AaOpacity(BtnExit, -BtnExit.Opacity, 120,, New AniEaseOutFluent), + AaHeight(BtnExit, 14 - BtnExit.Height, 120,, New AniEaseInFluent) + }, "PageLoginAuthSkin Button") + End Sub + + Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click + If McLoginLoader.State = LoadState.Loading Then + Log("[Launch] 要求更换角色，但登录加载器繁忙", LogLevel.Debug) + If CType(McLoginLoader.Input, McLoginServer).ForceReselectProfile Then + Hint("正在尝试更换，请稍候！") + Exit Sub + Else + Hint("正在登录中，请稍后再更换角色！", HintType.Critical) + Exit Sub + End If + End If + Hint("正在尝试更换，请稍候！") + Setup.Set("CacheAuthUuid", "") '清空选择缓存 + Setup.Set("CacheAuthName", "") + RunInThread(Sub() + Try + Dim Data As McLoginServer = GetLoginData() + Data.ForceReselectProfile = True + McLoginLoader.WaitForExit(Data, IsForceRestart:=True) + RunInUi(Sub() Reload(True)) + Catch ex As Exception + Log(ex, "更换角色失败", LogLevel.Hint) + End Try + End Sub) + End Sub + Private Sub BtnExit_Click() Handles BtnExit.Click + Setup.Set("CacheAuthAccess", "") + FrmLaunchLeft.RefreshPage(False, True) + End Sub + + Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click + Dim Address As String = If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")) + If String.IsNullOrEmpty(New ValidateHttp().Validate(Address)) Then OpenWebsite(Address.Replace("/auth/register", "/user/closet")) + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml new file mode 100644 index 0000000..c6fca06 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml @@ -0,0 +1,10 @@ + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb new file mode 100644 index 0000000..e3fec69 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb @@ -0,0 +1,67 @@ +Public Class PageLoginLegacy + + Public Sub New() + InitializeComponent() + Skin.Loader = PageLaunchLeft.SkinLegacy + End Sub + Private Sub PageLoginLegacy_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + Skin.Loader.Start() + End Sub + + Public IsReloaded As Boolean = False + ''' + ''' 刷新页面显示的所有信息。 + ''' + Public Sub Reload(KeepInput As Boolean) + If KeepInput AndAlso IsReloaded Then '避免第一次就以 KeepInput 的方式加载，导致文本框里没东西 + '保留输入，只刷新下拉框列表 + Dim Input As String = ComboName.Text + ComboName.ItemsSource = If(Setup.Get("LoginLegacyName") = "", Nothing, Setup.Get("LoginLegacyName").ToString.Split("¨")) + ComboName.Text = Input + Else + '不保留输入，刷新列表后自动选择第一项 + If Setup.Get("LoginLegacyName") = "" Then + ComboName.ItemsSource = Nothing + Else + ComboName.ItemsSource = Setup.Get("LoginLegacyName").ToString.Split("¨") + ComboName.Text = Setup.Get("LoginLegacyName").ToString.Split("¨")(0) + End If + End If + IsReloaded = True + End Sub + ''' + ''' 获取当前页面的登录信息。 + ''' + Public Shared Function GetLoginData() As McLoginLegacy + If FrmLoginLegacy Is Nothing Then + Return New McLoginLegacy With {.UserName = "", .SkinType = Setup.Get("LaunchSkinType"), .SkinName = Setup.Get("LaunchSkinID")} + Else + Return New McLoginLegacy With {.UserName = FrmLoginLegacy.ComboName.Text.Replace("¨", "").Trim, .SkinType = Setup.Get("LaunchSkinType"), .SkinName = Setup.Get("LaunchSkinID")} + End If + End Function + ''' + ''' 当前页面的登录信息是否有效。 + ''' + Public Shared Function IsVaild(LoginData As McLoginLegacy) As String + If LoginData.UserName.Trim = "" Then Return "玩家名不能为空！" + If LoginData.UserName.Contains("""") Then Return "玩家名不能包含英文引号！" + Return "" + End Function + Public Function IsVaild() As String + Return IsVaild(GetLoginData()) + End Function + + Private Sub ComboLegacy_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged + If Setup.Get("LaunchSkinType") = 0 Then + PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True) + End If + End Sub + Private Sub Skin_Click() Handles Skin.Click + If (Setup.Get("UiHiddenPageSetup") OrElse Setup.Get("UiHiddenSetupLaunch")) AndAlso Not PageSetupUI.HiddenForceShow Then + Hint("启动设置已被禁用！", HintType.Critical) + Else + FrmMain.PageChange(FormMain.PageType.Setup, FormMain.PageSubType.SetupLaunch) '切换到皮肤设置页面 + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojang.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojang.xaml new file mode 100644 index 0000000..16ce45b --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojang.xaml @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojang.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojang.xaml.vb new file mode 100644 index 0000000..ef89ca6 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojang.xaml.vb @@ -0,0 +1,81 @@ +Public Class PageLoginMojang + + Private IsFirstLoad As Boolean = True + ''' + ''' 刷新页面显示的所有信息。 + ''' + Public Sub Reload(KeepInput As Boolean) + '记住密码 + CheckRemember.Checked = Setup.Get("LoginRemember") + If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载，导致文本框里没东西 + '保留输入，只刷新下拉框列表 + Dim Input As String = ComboName.Text + ComboName.ItemsSource = If(Setup.Get("LoginMojangEmail") = "", Nothing, Setup.Get("LoginMojangEmail").ToString.Split("¨")) + ComboName.Text = Input + Else + '不保留输入，刷新列表后自动选择第一项 + If Setup.Get("LoginMojangEmail") = "" Then + ComboName.ItemsSource = Nothing + Else + ComboName.ItemsSource = Setup.Get("LoginMojangEmail").ToString.Split("¨") + ComboName.Text = Setup.Get("LoginMojangEmail").ToString.Split("¨")(0) + If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginMojangPass").ToString.Split("¨")(0).Trim + End If + End If + IsFirstLoad = False + End Sub + ''' + ''' 获取当前页面的登录信息。 + ''' + Public Shared Function GetLoginData() As McLoginServer + If FrmLoginMojang Is Nothing Then + Return New McLoginServer(McLoginType.Mojang) With {.BaseUrl = "https://authserver.mojang.com", .Token = "Mojang", .UserName = "", .Password = "", .Type = McLoginType.Mojang, .Description = "Mojang 正版"} + Else + Return New McLoginServer(McLoginType.Mojang) With {.BaseUrl = "https://authserver.mojang.com", .Token = "Mojang", .UserName = If(FrmLoginMojang.ComboName.Text, "").Replace("¨", "").Trim(), .Password = If(FrmLoginMojang.TextPass.Password, "").Replace("¨", "").Trim(), .Type = McLoginType.Mojang, .Description = "Mojang 正版"} + End If + End Function + ''' + ''' 当前页面的登录信息是否有效。 + ''' + Public Shared Function IsVaild(LoginData As McLoginServer) As String + If LoginData.UserName = "" Then Return "邮箱不能为空！" + If Not LoginData.UserName.Contains("@") Then Return "邮箱格式错误！" + If LoginData.Password = "" Then Return "密码不能为空！" + Return "" + End Function + Public Function IsVaild() As String + Return IsVaild(GetLoginData()) + End Function + + '保存输入信息 + Private Sub ComboMojangName_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged + If sender.Text = "" Then TextPass.Password = "" + If AniControlEnabled = 0 Then Setup.Set("CacheMojangAccess", "") '迫使其不进行 Validate + End Sub + Private Sub TextMojangPass_PasswordChanged(sender As Object, e As RoutedEventArgs) Handles TextPass.PasswordChanged + If AniControlEnabled = 0 Then Setup.Set("CacheMojangAccess", "") + End Sub + Private Sub ComboMojangName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged + If sender.SelectedIndex = -1 OrElse Not Setup.Get("LoginRemember") Then + TextPass.Password = "" + Else + TextPass.Password = Setup.Get("LoginMojangPass").ToString.Split("¨")(sender.SelectedIndex).Trim + End If + End Sub + Private Sub CheckRememberChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) + End Sub + + '链接处理 + Private Sub InputChanged() Handles ComboName.TextChanged, TextPass.PasswordChanged + BtnLink.Content = If(ComboName.Text = "" AndAlso TextPass.Password = "", "购买正版", "找回密码") + End Sub + Private Sub BtnMojang_Click(sender As Object, e As EventArgs) Handles BtnLink.Click + If BtnLink.Content = "购买正版" Then + OpenWebsite("https://www.minecraft.net/store/minecraft-java-edition/buy") + Else + OpenWebsite("https://account.mojang.com/password") + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojangSkin.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojangSkin.xaml new file mode 100644 index 0000000..3e570d3 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojangSkin.xaml @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojangSkin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojangSkin.xaml.vb new file mode 100644 index 0000000..c8d8456 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMojangSkin.xaml.vb @@ -0,0 +1,114 @@ +Public Class PageLoginMojangSkin + + Public Sub New() + InitializeComponent() + Skin.Loader = PageLaunchLeft.SkinMojang + End Sub + Private Sub PageLoginLegacy_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + Skin.Loader.Start() + End Sub + + ''' + ''' 刷新页面显示的所有信息。 + ''' + Public Sub Reload(KeepInput As Boolean) + TextName.Text = Setup.Get("CacheMojangName") + TextEmail.Text = Setup.Get("CacheMojangUsername") + TextEmail.Visibility = If(Setup.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible) + '皮肤在 Loaded 加载 + End Sub + ''' + ''' 获取当前页面的登录信息。 + ''' + Public Shared Function GetLoginData() As McLoginServer + Return New McLoginServer(McLoginType.Mojang) With {.BaseUrl = "https://authserver.mojang.com", .Token = "Mojang", .UserName = Setup.Get("CacheMojangUsername"), .Password = Setup.Get("CacheMojangPass"), .Description = "Mojang 正版", .Type = McLoginType.Mojang} + End Function + + Private Sub PageLoginMojangSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter + AniStart({ + AaOpacity(BtnEdit, 1 - BtnEdit.Opacity, 80), + AaHeight(BtnEdit, 25.5 - BtnEdit.Height, 140,, New AniEaseOutFluent), + AaHeight(BtnEdit, -1.5, 50, 140, New AniEaseInFluent), + AaOpacity(BtnExit, 1 - BtnExit.Opacity, 80), + AaHeight(BtnExit, 25.5 - BtnExit.Height, 140,, New AniEaseOutFluent), + AaHeight(BtnExit, -1.5, 50, 140, New AniEaseInFluent) + }, "PageLoginMojangSkin Button") + End Sub + Private Sub PageLoginMojangSkin_MouseLeave(sender As Object, e As MouseEventArgs) Handles PanData.MouseLeave + AniStart({ + AaOpacity(BtnEdit, -BtnEdit.Opacity, 120,, New AniEaseOutFluent), + AaHeight(BtnEdit, 14 - BtnEdit.Height, 120,, New AniEaseInFluent), + AaOpacity(BtnExit, -BtnExit.Opacity, 120,, New AniEaseOutFluent), + AaHeight(BtnExit, 14 - BtnExit.Height, 120,, New AniEaseInFluent) + }, "PageLoginMojangSkin Button") + End Sub + + Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click + Select Case MyMsgBox("你希望通过哪种途径更改密码？" & vbCrLf & "首次通过个人档案修改密码可能需要验证你的密保问题。", "更改密码", "个人档案", "密保邮箱", "取消") + Case 1 + '个人档案 + OpenWebsite("https://www.minecraft.net/zh-hans/profile/") + Case 2 + '密保邮箱 + OpenWebsite("https://account.mojang.com/password") + Case 3 + '取消 + End Select + End Sub + Private Sub BtnExit_Click() Handles BtnExit.Click + Setup.Set("CacheMojangAccess", "") + FrmLaunchLeft.RefreshPage(False, True) + End Sub + + Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click + If McLoginLoader.State = LoadState.Failed Then + Hint("登录失败，无法更改皮肤！", HintType.Critical) + Exit Sub + End If + Dim SkinInfo As McSkinInfo = McSkinSelect(False) + If Not SkinInfo.IsVaild Then Exit Sub + Hint("正在更改皮肤……") + RunInNewThread(Async Sub() + Try + + If McLoginLoader.State = LoadState.Loading Then McLoginLoader.WaitForExit() '等待登录结束 + Dim AccessToken As String = Setup.Get("CacheMojangAccess") + Dim Uuid As String = Setup.Get("CacheMojangUuid") + + Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 10)} + Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken) + Client.DefaultRequestHeaders.Accept.Add(New Net.Http.Headers.MediaTypeWithQualityHeaderValue("*/*")) + Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1")) + Dim Contents As New Net.Http.MultipartFormDataContent From { + {New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "")), "model"}, + {New Net.Http.ByteArrayContent(File.ReadAllBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)} + } + Dim Result As String = Await (Await Client.PutAsync(New Uri("https://api.mojang.com/user/profile/" & Uuid & "/skin"), Contents)).Content.ReadAsStringAsync + If RegexCheck(Result, "^[0-9a-f]{59,64}$") Then + MySkin.ReloadCache("http://textures.minecraft.net/texture/" & Result, False) + ElseIf Result.ToLower.Contains("ip not secured") Then + If MyMsgBox("首次操作需要在官网验证密保问题。" & vbCrLf & "验证完成后，你即可使用 PCL 更改皮肤，且无需再次验证。", "验证密保问题", "开始验证", "取消") = 1 Then + OpenWebsite("https://www.minecraft.net/zh-hans/profile/skin") + End If + ElseIf Result.Contains("request requires user authentication") Then + Hint("正在重新登录，请稍后再次尝试更改皮肤！") + RunInUi(Sub() + BtnExit_Click() + If String.IsNullOrEmpty(McLoginAble()) Then McLoginLoader.Start() + End Sub) + ElseIf Result.Contains("""errorMessage""") Then + Hint("更改皮肤失败：" & GetJson(Result)("errorMessage"), HintType.Critical) + Else + Throw New Exception("未知错误（" & Result & "）") + End If + Catch ex As Exception + If ex.GetType.Equals(GetType(Tasks.TaskCanceledException)) Then + Hint("更改皮肤失败：与 Mojang 皮肤服务器的连接超时，请检查你的网络是否通畅！", HintType.Critical) + Else + Log(ex, "更改皮肤失败", LogLevel.Hint) + End If + End Try + End Sub, "Mojang Skin Upload") + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml new file mode 100644 index 0000000..86b4386 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml @@ -0,0 +1,16 @@ + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb new file mode 100644 index 0000000..e3d0b79 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMs.xaml.vb @@ -0,0 +1,65 @@ +Public Class PageLoginMs + + ''' + ''' 刷新页面显示的所有信息。 + ''' + Public Sub Reload(KeepInput As Boolean) + End Sub + ''' + ''' 获取当前页面的登录信息。 + ''' + Public Shared Function GetLoginData() As McLoginMs + Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")} + End Function + ''' + ''' 当前页面的登录信息是否有效。 + ''' + Public Shared Function IsVaild(LoginData As McLoginMs) As String + If LoginData.OAuthRefreshToken = "" Then + Return "请在登录账号后再继续！" + Else + Return "" + End If + End Function + Public Function IsVaild() As String + Return IsVaild(GetLoginData()) + End Function + + Private Sub BtnLogin_Click(sender As Object, e As EventArgs) Handles BtnLogin.Click + BtnLogin.IsEnabled = False + BtnLogin.Text = "登录中 0%" + RunInNewThread(Sub() + Try + McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True) + Do While McLoginMsLoader.State = LoadState.Loading + RunInUi(Sub() BtnLogin.Text = "登录中 " & Math.Round(McLoginMsLoader.Progress * 100) & "%") + Thread.Sleep(50) + Loop + If McLoginMsLoader.State = LoadState.Finished Then + RunInUi(Sub() FrmLaunchLeft.RefreshPage(False, True)) + ElseIf McLoginMsLoader.State = LoadState.Aborted Then + Throw New ThreadInterruptedException + ElseIf McLoginMsLoader.Error Is Nothing Then + Throw New Exception("未知错误！") + Else + Throw New Exception(McLoginMsLoader.Error.Message, McLoginMsLoader.Error) + End If + Catch ex As ThreadInterruptedException + Hint("登录已取消！") + Catch ex As Exception + If ex.Message = "$$" Then + ElseIf ex.Message.StartsWith("$") Then + Hint(ex.Message.TrimStart("$"), HintType.Critical) + Else + Log(ex, "微软登录尝试失败", LogLevel.Msgbox) + End If + Finally + RunInUi(Sub() + BtnLogin.IsEnabled = True + BtnLogin.Text = "添加账号" + End Sub) + End Try + End Sub, "Ms Login") + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml new file mode 100644 index 0000000..35a0521 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb new file mode 100644 index 0000000..6682b29 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb @@ -0,0 +1,122 @@ +Public Class PageLoginMsSkin + + Public Sub New() + InitializeComponent() + Skin.Loader = PageLaunchLeft.SkinMs + End Sub + Private Sub PageLoginLegacy_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + Skin.Loader.Start() + End Sub + + ''' + ''' 刷新页面显示的所有信息。 + ''' + Public Sub Reload(KeepInput As Boolean) + TextName.Text = Setup.Get("CacheMsName") + '皮肤在 Loaded 加载 + End Sub + ''' + ''' 获取当前页面的登录信息。 + ''' + Public Shared Function GetLoginData() As McLoginMs + If McLoginMsLoader.State = LoadState.Finished Then + Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName"), .AccessToken = Setup.Get("CacheMsAccess"), .Uuid = Setup.Get("CacheMsUuid")} + Else + Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")} + End If + End Function + + Private Sub PageLoginMsSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter + AniStart({ + AaOpacity(BtnEdit, 1 - BtnEdit.Opacity, 80), + AaHeight(BtnEdit, 25.5 - BtnEdit.Height, 140,, New AniEaseOutFluent), + AaHeight(BtnEdit, -1.5, 50, 140, New AniEaseInFluent), + AaOpacity(BtnExit, 1 - BtnExit.Opacity, 80), + AaHeight(BtnExit, 25.5 - BtnExit.Height, 140,, New AniEaseOutFluent), + AaHeight(BtnExit, -1.5, 50, 140, New AniEaseInFluent) + }, "PageLoginMsSkin Button") + End Sub + Private Sub PageLoginMsSkin_MouseLeave(sender As Object, e As MouseEventArgs) Handles PanData.MouseLeave + AniStart({ + AaOpacity(BtnEdit, -BtnEdit.Opacity, 120,, New AniEaseOutFluent), + AaHeight(BtnEdit, 14 - BtnEdit.Height, 120,, New AniEaseInFluent), + AaOpacity(BtnExit, -BtnExit.Opacity, 120,, New AniEaseOutFluent), + AaHeight(BtnExit, 14 - BtnExit.Height, 120,, New AniEaseInFluent) + }, "PageLoginMsSkin Button") + End Sub + + Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click + OpenWebsite("https://account.microsoft.com/security") + End Sub + Private Sub BtnExit_Click() Handles BtnExit.Click + Setup.Set("CacheMsOAuthRefresh", "") + Setup.Set("CacheMsAccess", "") + Setup.Set("CacheMsUuid", "") + Setup.Set("CacheMsName", "") + McLoginMsLoader.Abort() + FrmLaunchLeft.RefreshPage(False, True) + End Sub + + Private IsChanging As Boolean = False + Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click + '检查条件，获取新皮肤 + If IsChanging Then + Hint("正在更改皮肤中，请稍候！") + Exit Sub + End If + If McLoginLoader.State = LoadState.Failed Then + Hint("登录失败，无法更改皮肤！", HintType.Critical) + Exit Sub + End If + Dim SkinInfo As McSkinInfo = McSkinSelect(False) + If Not SkinInfo.IsVaild Then Exit Sub + Hint("正在更改皮肤……") + IsChanging = True + '开始实际获取 + RunInNewThread(Async Sub() + Try +Retry: + If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束 + Dim AccessToken As String = Setup.Get("CacheMsAccess") + Dim Uuid As String = Setup.Get("CacheMsUuid") + + Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)} + Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken) + Client.DefaultRequestHeaders.Accept.Add(New Net.Http.Headers.MediaTypeWithQualityHeaderValue("*/*")) + Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1")) + Dim Contents As New Net.Http.MultipartFormDataContent From { + {New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"}, + {New Net.Http.ByteArrayContent(File.ReadAllBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)} + } + Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync + If Result.Contains("request requires user authentication") Then + Hint("正在登录，将在登录完成后继续更改皮肤……") + McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True) + GoTo Retry + ElseIf Result.Contains("""error""") Then + Hint("更改皮肤失败：" & GetJson(Result)("error"), HintType.Critical) + Exit Sub + End If + '获取新皮肤地址 + Log("[Skin] 皮肤修改返回值：" & vbCrLf & Result) + Dim ResultJson As JObject = GetJson(Result) + For Each Skin As JObject In ResultJson("skins") + If Skin("state").ToString = "ACTIVE" Then + MySkin.ReloadCache(Skin("url"), True) + Exit Sub + End If + Next + Throw New Exception("未知错误（" & Result & "）") + Catch ex As Exception + If ex.GetType.Equals(GetType(Tasks.TaskCanceledException)) Then + Hint("更改皮肤失败：与 Mojang 皮肤服务器的连接超时，请检查你的网络是否通畅！", HintType.Critical) + Else + Log(ex, "更改皮肤失败", LogLevel.Hint) + End If + Finally + IsChanging = False + End Try + End Sub, "Ms Skin Upload") + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml new file mode 100644 index 0000000..1a5e74a --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml @@ -0,0 +1,24 @@ + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb new file mode 100644 index 0000000..70a971b --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb @@ -0,0 +1,80 @@ +Public Class PageLoginNide + Private IsFirstLoad As Boolean = True + ''' + ''' 刷新页面显示的所有信息。 + ''' + Public Sub Reload(KeepInput As Boolean) + '记住密码 + CheckRemember.Checked = Setup.Get("LoginRemember") + If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载，导致文本框里没东西 + '保留输入，只刷新下拉框列表 + Dim Input As String = ComboName.Text + ComboName.ItemsSource = If(Setup.Get("LoginNideEmail") = "", Nothing, Setup.Get("LoginNideEmail").ToString.Split("¨")) + ComboName.Text = Input + Else + '不保留输入，刷新列表后自动选择第一项 + If Setup.Get("LoginNideEmail") = "" Then + ComboName.ItemsSource = Nothing + Else + ComboName.ItemsSource = Setup.Get("LoginNideEmail").ToString.Split("¨") + ComboName.Text = Setup.Get("LoginNideEmail").ToString.Split("¨")(0) + If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.Split("¨")(0).Trim + End If + End If + IsFirstLoad = False + End Sub + ''' + ''' 获取当前页面的登录信息。 + ''' + Public Shared Function GetLoginData() As McLoginServer + Dim Server As String = If(IsNothing(McVersionCurrent), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Version:=McVersionCurrent)) + If FrmLoginNide Is Nothing Then + Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = "", .Password = "", .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"} + Else + Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = FrmLoginNide.ComboName.Text.Replace("¨", "").Trim, .Password = FrmLoginNide.TextPass.Password.Replace("¨", "").Trim, .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"} + End If + End Function + ''' + ''' 当前页面的登录信息是否有效。 + ''' + Public Shared Function IsVaild(LoginData As McLoginServer) As String + If LoginData.UserName = "" Then Return "账号不能为空！" + If LoginData.Password = "" Then Return "密码不能为空！" + Return "" + End Function + Public Function IsVaild() As String + Return IsVaild(GetLoginData()) + End Function + + '保存输入信息 + Private Sub ComboName_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged + If sender.Text = "" Then TextPass.Password = "" + If AniControlEnabled = 0 Then Setup.Set("CacheNideAccess", "") '迫使其不进行 Validate + End Sub + Private Sub TextPass_PasswordChanged(sender As Object, e As RoutedEventArgs) Handles TextPass.PasswordChanged + If AniControlEnabled = 0 Then Setup.Set("CacheNideAccess", "") + End Sub + Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged + If sender.SelectedIndex = -1 OrElse Not Setup.Get("LoginRemember") Then + TextPass.Password = "" + Else + TextPass.Password = Setup.Get("LoginNidePass").ToString.Split("¨")(sender.SelectedIndex).Trim + End If + End Sub + Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) + End Sub + + '链接处理 + Private Sub ComboName_TextChanged() Handles ComboName.TextChanged + BtnLink.Content = If(ComboName.Text = "", "注册账号", "找回密码") + End Sub + Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click + If BtnLink.Content = "注册账号" Then + OpenWebsite("https://login.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=McVersionCurrent) & "/register") + Else + OpenWebsite("https://login.mc-user.com:233/account/login") + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml new file mode 100644 index 0000000..a682902 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml.vb new file mode 100644 index 0000000..bceb7c8 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml.vb @@ -0,0 +1,59 @@ +Public Class PageLoginNideSkin + + Public Sub New() + InitializeComponent() + Skin.Loader = PageLaunchLeft.SkinNide + End Sub + Private Sub PageLoginLegacy_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + Skin.Loader.Start() + End Sub + + ''' + ''' 刷新页面显示的所有信息。 + ''' + Public Sub Reload(KeepInput As Boolean) + TextName.Text = Setup.Get("CacheNideName") + TextEmail.Text = Setup.Get("CacheNideUsername") + TextEmail.Visibility = If(Setup.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible) + '皮肤在 Loaded 加载 + End Sub + ''' + ''' 获取当前页面的登录信息。 + ''' + Public Shared Function GetLoginData() As McLoginServer + Dim Server As String = If(IsNothing(McVersionCurrent), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Version:=McVersionCurrent)) + Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = Setup.Get("CacheNideUsername"), .Password = Setup.Get("CacheNidePass"), .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"} + End Function + + Private Sub PageLoginNideSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter + AniStart({ + AaOpacity(BtnEdit, 1 - BtnEdit.Opacity, 80), + AaHeight(BtnEdit, 25.5 - BtnEdit.Height, 140,, New AniEaseOutFluent), + AaHeight(BtnEdit, -1.5, 50, 140, New AniEaseInFluent), + AaOpacity(BtnExit, 1 - BtnExit.Opacity, 80), + AaHeight(BtnExit, 25.5 - BtnExit.Height, 140,, New AniEaseOutFluent), + AaHeight(BtnExit, -1.5, 50, 140, New AniEaseInFluent) + }, "PageLoginNideSkin Button") + End Sub + Private Sub PageLoginNideSkin_MouseLeave(sender As Object, e As MouseEventArgs) Handles PanData.MouseLeave + AniStart({ + AaOpacity(BtnEdit, -BtnEdit.Opacity, 120,, New AniEaseOutFluent), + AaHeight(BtnEdit, 14 - BtnEdit.Height, 120,, New AniEaseInFluent), + AaOpacity(BtnExit, -BtnExit.Opacity, 120,, New AniEaseOutFluent), + AaHeight(BtnExit, 14 - BtnExit.Height, 120,, New AniEaseInFluent) + }, "PageLoginNideSkin Button") + End Sub + + Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click + OpenWebsite("https://login.mc-user.com:233/account/changepw") + End Sub + Private Sub BtnExit_Click() Handles BtnExit.Click + Setup.Set("CacheNideAccess", "") + FrmLaunchLeft.RefreshPage(False, True) + End Sub + + Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click + OpenWebsite("https://login.mc-user.com:233/" & If(IsNothing(McVersionCurrent), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Version:=McVersionCurrent)) & "/skin") + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml new file mode 100644 index 0000000..a12af94 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml @@ -0,0 +1,23 @@ + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb new file mode 100644 index 0000000..f05576e --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelp.xaml.vb @@ -0,0 +1,177 @@ +Public Class PageOtherHelp + +#Region "初始化" + + '滚动条 + Private Sub PageOther_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + PanBack.ScrollToHome() + End Sub + '初始化加载器信息 + Private Sub PageOther_Inited(sender As Object, e As EventArgs) Handles Me.Initialized + PageLoaderInit(Load, PanLoad, PanBack, Nothing, HelpLoader, AddressOf HelpListLoad) + End Sub + +#End Region + + ''' + ''' 将帮助列表对象实例化为主页 UI。 + ''' + Private Sub HelpListLoad(Loader As LoaderTask(Of Integer, List(Of HelpEntry))) + Try + + '初始化 + PanList.Children.Clear() + PanBack.ScrollToHome() + Dim HelpItems = Loader.Output + '获取全部分类 + Dim Types As New List(Of String) + For Each Item As HelpEntry In HelpItems + If Val(VersionBranchCode) = 50 AndAlso Not Item.ShowInPublic Then Continue For + If Val(VersionBranchCode) <> 50 AndAlso Not Item.ShowInSnapshot Then Continue For + For Each Type In Item.Types + If Not Types.Contains(Type) Then Types.Add(Type) + Next + Next + '将指南页面置顶 + If Types.Contains("指南") Then + Types.Remove("指南") + Types.Insert(0, "指南") + End If + '转化为 UI + For Each Type As String In Types + '确认所属该分类的项目 + Dim TypeItems As New List(Of HelpEntry) + For Each Item In HelpItems + If Val(VersionBranchCode) = 50 AndAlso Not Item.ShowInPublic Then Continue For + If Val(VersionBranchCode) <> 50 AndAlso Not Item.ShowInSnapshot Then Continue For + If Item.Types.Contains(Type) Then TypeItems.Add(Item) + Next + '增加卡片 + Dim NewCard As New MyCard With {.Title = Type, .Margin = New Thickness(0, 0, 0, 15), .SwapType = 11} + Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TypeItems} + NewCard.Children.Add(NewStack) + NewCard.SwapControl = NewStack + If Type = "指南" Then + MyCard.StackInstall(NewStack, 11, "指南") + Else + NewCard.IsSwaped = True + End If + PanList.Children.Add(NewCard) + Next + + Catch ex As Exception + Log(ex, "加载帮助列表 UI 失败", LogLevel.Feedback) + End Try + End Sub + + ''' + ''' 帮助项目的点击事件。 + ''' + Public Shared Sub OnItemClick(Entry As HelpEntry) + Try + If Entry.IsEvent Then + ModEvent.TryStartEvent(Entry.EventType, Entry.EventData) + Else + EnterHelpPage(Entry) + End If + Catch ex As Exception + Log(ex, "处理帮助项目点击时发生意外错误", LogLevel.Feedback) + End Try + End Sub + Public Shared Sub EnterHelpPage(Location As String) + RunInThread(Sub() + If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid) + Dim Entry As New HelpEntry(Location) + RunInUi(Sub() + Dim FrmHelpDetail As New PageOtherHelpDetail + If FrmHelpDetail.Init(Entry) Then + FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}}) + Else + Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", LogLevel.Debug) + End If + End Sub) + End Sub) + End Sub + Public Shared Sub EnterHelpPage(Entry As HelpEntry) + RunInThread(Sub() + If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid) + RunInUi(Sub() + Dim FrmHelpDetail As New PageOtherHelpDetail + If FrmHelpDetail.Init(Entry) Then + FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}}) + Else + Log("[Help] 已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃", LogLevel.Debug) + End If + End Sub) + End Sub) + End Sub + Public Shared Function GetHelpPage(Location As String) As PageOtherHelpDetail + If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid) + Dim FrmHelpDetail As New PageOtherHelpDetail + If FrmHelpDetail.Init(New HelpEntry(Location)) Then + Return FrmHelpDetail + Else + Throw New Exception("已取消进入帮助项目，这一般是由于 xaml 初始化失败，且用户在弹窗中手动放弃") + End If + End Function + + ''' + ''' 搜索帮助。 + ''' + Public Sub SearchRun() Handles SearchBox.TextChanged + If String.IsNullOrWhiteSpace(SearchBox.Text) Then + '隐藏 + AniStart({ + AaOpacity(PanSearch, -PanSearch.Opacity, 100), + AaCode(Sub() + PanSearch.Height = 0 + PanSearch.Visibility = Visibility.Collapsed + PanList.Visibility = Visibility.Visible + End Sub,, True), + AaOpacity(PanList, 1 - PanList.Opacity, 150, 30) + }, "FrmOtherHelp Search Switch") + Else + '构造请求 + Dim QueryList As New List(Of SearchEntry(Of HelpEntry)) + For Each Entry As HelpEntry In HelpLoader.Output + If Not Entry.ShowInSearch OrElse (Val(VersionBranchCode) = 50 AndAlso Not Entry.ShowInPublic) Then Continue For + If Not Entry.ShowInSearch OrElse (Val(VersionBranchCode) <> 50 AndAlso Not Entry.ShowInSnapshot) Then Continue For + QueryList.Add(New SearchEntry(Of HelpEntry) With { + .Item = Entry, + .SearchSource = New List(Of KeyValuePair(Of String, Double)) From { + New KeyValuePair(Of String, Double)(Entry.Title, 1), + New KeyValuePair(Of String, Double)(Entry.Desc, 0.5), + New KeyValuePair(Of String, Double)(Entry.Search, 1.5) + } + }) + 'New KeyValuePair(Of String, Double)(If(Entry.IsEvent, If(Entry.EventData, ""), Entry.XamlContent), 0.2) + Next + '进行搜索，构造列表 + Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=5, MinBlurSimilarity:=0.08) + PanSearchList.Children.Clear() + If SearchResult.Count = 0 Then + PanSearch.Title = "无搜索结果" + PanSearchList.Visibility = Visibility.Collapsed + Else + PanSearch.Title = "搜索结果" + For Each Result In SearchResult + Dim Item = Result.Item.ToListItem + If ModeDebug Then Item.Info = If(Result.AbsoluteRight, "完全匹配，", "") & "相似度：" & Math.Round(Result.Similarity, 3) & "，" & Item.Info + PanSearchList.Children.Add(Item) + Next + PanSearchList.Visibility = Visibility.Visible + End If + '显示 + AniStart({ + AaOpacity(PanList, -PanList.Opacity, 100), + AaCode(Sub() + PanList.Visibility = Visibility.Collapsed + PanSearch.Visibility = Visibility.Visible + PanSearch.TriggerForceResize() + End Sub,, True), + AaOpacity(PanSearch, 1 - PanSearch.Opacity, 150, 30) + }, "FrmOtherHelp Search Switch") + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml new file mode 100644 index 0000000..1430169 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml @@ -0,0 +1,24 @@ + + + + + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb new file mode 100644 index 0000000..203bd0f --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherHelpDetail.xaml.vb @@ -0,0 +1,27 @@ +Public Class PageOtherHelpDetail + Public Entry As HelpEntry + + Private Sub PageOtherHelpDetail_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + PanBack.ScrollToTop() + End Sub + + ''' + ''' 根据特定帮助项初始化页面 UI，返回是否成功加载。 + ''' + Public Function Init(Entry As HelpEntry) As Boolean + Dim FileContent = "" & If(Entry.XamlContent, "") & "" + Try + If String.IsNullOrEmpty(Entry.XamlContent) Then Throw New Exception("帮助 xaml 文件为空") + Me.Entry = Entry + PanCustom.Children.Clear() + FileContent = FileContent.Replace("{path}", Path) + PanCustom.Children.Add(GetObjectFromXML(FileContent)) + Return True + Catch ex As Exception + Log("[System] 自定义信息内容：" & vbCrLf & FileContent) + Log(ex, "加载帮助 xaml 文件失败", LogLevel.Msgbox) + Return False + End Try + End Function + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml new file mode 100644 index 0000000..a047b56 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb new file mode 100644 index 0000000..976227b --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb @@ -0,0 +1,140 @@ +Public Class PageOtherLeft + + Private IsLoad As Boolean = False + Private IsPageSwitched As Boolean = False '如果在 Loaded 前切换到其他页面，会导致触发 Loaded 时再次切换一次 + Private Sub PageOtherLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + '是否处于隐藏的子页面 + Dim IsHiddenPage As Boolean = False + If ItemHelp.Checked AndAlso Setup.Get("UiHiddenOtherHelp") Then IsHiddenPage = True + If ItemFeedback.Checked AndAlso Setup.Get("UiHiddenOtherFeedback") Then IsHiddenPage = True + If ItemAbout.Checked AndAlso Setup.Get("UiHiddenOtherAbout") Then IsHiddenPage = True + If ItemTest.Checked AndAlso Setup.Get("UiHiddenOtherTest") Then IsHiddenPage = True + If PageSetupUI.HiddenForceShow Then IsHiddenPage = False + '若页面错误，或尚未加载，则继续 + If IsLoad AndAlso Not IsHiddenPage Then Exit Sub + IsLoad = True + '刷新子页面隐藏情况 + PageSetupUI.HiddenRefresh() + '选择第一个未被禁用的子页面 + If IsPageSwitched Then Exit Sub + If Not Setup.Get("UiHiddenOtherHelp") Then + ItemHelp.SetChecked(True, False, False) + ElseIf Not Setup.Get("UiHiddenOtherAbout") Then + ItemAbout.SetChecked(True, False, False) + ElseIf Not Setup.Get("UiHiddenOtherTest") Then + ItemTest.SetChecked(True, False, False) + Else + ItemFeedback.SetChecked(True, False, False) + End If + End Sub + Private Sub PageOtherLeft_Unloaded(sender As Object, e As RoutedEventArgs) Handles Me.Unloaded + IsPageSwitched = False + End Sub + +#Region "页面切换" + + ''' + ''' 当前页面的编号。从 0 开始计算。 + ''' + Public PageID As FormMain.PageSubType + Public Sub New() + InitializeComponent() + '选择第一个未被禁用的子页面 + If Not Setup.Get("UiHiddenOtherHelp") Then + PageID = FormMain.PageSubType.OtherHelp + ElseIf Not Setup.Get("UiHiddenOtherAbout") Then + PageID = FormMain.PageSubType.OtherAbout + ElseIf Not Setup.Get("UiHiddenOtherTest") Then + PageID = FormMain.PageSubType.OtherTest + Else + PageID = FormMain.PageSubType.OtherFeedback + End If + End Sub + + ''' + ''' 勾选事件改变页面。 + ''' + Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemAbout.Check, ItemHelp.Check, ItemFeedback.Check, ItemTest.Check + '尚未初始化控件属性时，sender.Tag 为 Nothing，会导致切换到页面 0 + '若使用 IsLoaded，则会导致模拟点击不被执行（模拟点击切换页面时，控件的 IsLoaded 为 False） + If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) + End Sub + + Public Function PageGet(Optional ID As FormMain.PageSubType = -1) + If ID = -1 Then ID = PageID + Select Case ID + Case FormMain.PageSubType.OtherHelp + If FrmOtherHelp Is Nothing Then FrmOtherHelp = New PageOtherHelp + Return FrmOtherHelp + Case FormMain.PageSubType.OtherFeedback + If FrmOtherFeedback Is Nothing Then FrmOtherFeedback = New PageOtherFeedback + Return FrmOtherFeedback + Case FormMain.PageSubType.OtherAbout + If FrmOtherAbout Is Nothing Then FrmOtherAbout = New PageOtherAbout + Return FrmOtherAbout + Case FormMain.PageSubType.OtherTest + If FrmOtherTest Is Nothing Then FrmOtherTest = New PageOtherTest + Return FrmOtherTest + Case Else + Throw New Exception("未知的更多子页面种类：" & ID) + End Select + End Function + + ''' + ''' 切换现有页面。 + ''' + Public Sub PageChange(ID As FormMain.PageSubType) + If PageID = ID Then Exit Sub + AniControlEnabled += 1 + IsPageSwitched = True + Try + PageChangeRun(PageGet(ID)) + PageID = ID + Catch ex As Exception + Log(ex, "切换设置分页面失败（ID " & ID & "）", LogLevel.Feedback) + Finally + AniControlEnabled -= 1 + End Try + End Sub + Private Shared Sub PageChangeRun(Target As MyPageRight) + AniStop("FrmMain PageChangeRight") '停止主页面的右页面切换动画，防止它与本动画一起触发多次 PageOnEnter + If Target.Parent IsNot Nothing Then Target.SetValue(ContentPresenter.ContentProperty, Nothing) + FrmMain.PageRight = Target + CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnExit() + AniStart({ + AaCode(Sub() + CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit() + FrmMain.PanMainRight.Child = FrmMain.PageRight + FrmMain.PageRight.Opacity = 0 + End Sub, 130), + AaCode(Sub() + '延迟触发页面通用动画，以使得在 Loaded 事件中加载的控件得以处理 + FrmMain.PageRight.Opacity = 1 + FrmMain.PageRight.PageOnEnter() + End Sub, 30, True) + }, "PageLeft PageChange") + End Sub + +#End Region + + '强制刷新 + Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用 + Select Case Val(sender.Tag) + Case FormMain.PageSubType.OtherHelp + RefreshHelp() + Case FormMain.PageSubType.OtherFeedback + If FrmOtherFeedback IsNot Nothing Then + FrmOtherFeedback.PageLoaderRestart() + FrmOtherFeedback.SearchBox.Text = "" + Else + FeedbackLoader.Start() + End If + End Select + End Sub + Public Shared Sub RefreshHelp() + Setup.Set("SystemHelpVersion", 0) '强制重新解压文件 + FrmOtherHelp.PageLoaderRestart() + FrmOtherHelp.SearchBox.Text = "" + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml new file mode 100644 index 0000000..97e9c54 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb new file mode 100644 index 0000000..2fd14e5 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb @@ -0,0 +1,404 @@ +Public Class PageSelectLeft + + Private Sub PageSelectLeft_Initialized(sender As Object, e As EventArgs) Handles Me.Initialized + AddHandler McFolderListLoader.PreviewFinish, Sub() If FrmSelectLeft IsNot Nothing Then RunInUiWait(AddressOf McFolderListUI) + End Sub + Private IsFirstLoad As Boolean = True + Private Sub PageSelectLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + If IsFirstLoad Then McFolderListUI() '若已经执行完成，触发首次加载 + IsFirstLoad = False + End Sub + Private Sub McFolderListUI() + Try + + '确认数据有变化 + If McFolderListLast IsNot Nothing AndAlso McFolderListLast.SequenceEqual(McFolderList) Then + Dim IsEqual As Boolean = True + For i = 0 To McFolderListLast.Count - 1 + If Not McFolderListLast(i).Equals(McFolderList(i)) Then + IsEqual = False + Exit For + End If + Next + If IsEqual Then Exit Sub + End If + McFolderListLast = McFolderList + + '创建 UI + FrmSelectLeft.PanList.Children.Clear() + + '文件夹列表 + FrmSelectLeft.PanList.Children.Add(New TextBlock With {.Text = "文件夹列表", .Margin = New Thickness(13, 18, 5, 4), .Opacity = 0.6, .FontSize = 12}) + For Each Folder As McFolder In McFolderList.ToArray + '添加控件 + Dim ContMenu As ContextMenu = Nothing + Select Case Folder.Type + Case McFolderType.Original + ContMenu = GetObjectFromXML( + + + + + + + ) + Case McFolderType.RenamedOriginal + ContMenu = GetObjectFromXML( + + + + + + + + ) + Case McFolderType.Custom + ContMenu = GetObjectFromXML( + + + + + + + + ) + End Select + If (Folder.Type = McFolderType.Original OrElse Folder.Type = McFolderType.RenamedOriginal) AndAlso Folder.Path = Path & ".minecraft\" AndAlso McFolderList.Count = 1 Then CType(ContMenu.FindName("Delete"), MyMenuItem).Header = "清空" + '注册事件 + If Not Folder.Type = McFolderType.Original Then CType(ContMenu.FindName("Remove"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Remove_Click)) + CType(ContMenu.FindName("Open"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Open_Click)) + CType(ContMenu.FindName("Delete"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Delete_Click)) + CType(ContMenu.FindName("Rename"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Rename_Click)) + CType(ContMenu.FindName("Refresh"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Refresh_Click)) + '构建框架与图表按钮 + Dim NewItem As New MyListItem With {.IsScaleAnimationEnabled = False, .Type = MyListItem.CheckType.RadioBox, .PaddingRight = 30, .Title = Folder.Name, .Info = Folder.Path, .Height = 40, .ContextMenu = ContMenu, .Tag = Folder} + AddHandler NewItem.Changed, AddressOf FrmSelectLeft.Folder_Change + Dim NewIconButton As New MyIconButton With {.Logo = Logo.IconButtonSetup, .LogoScale = 1.1} + AddHandler NewIconButton.Click, Sub(sender, e) + ContMenu.PlacementTarget = NewItem + ContMenu.IsOpen = True + End Sub + NewItem.Buttons = {NewIconButton} + FrmSelectLeft.PanList.Children.Add(NewItem) + Log("[Minecraft] 有效的 Minecraft 文件夹：" & Folder.Name & " > " & Folder.Path) + Next + + '标题文本 + FrmSelectLeft.PanList.Children.Add(New TextBlock With {.Text = "添加或导入", .Margin = New Thickness(13, 18, 5, 4), .Opacity = 0.6, .FontSize = 12}) + + '确认创建按钮状态 + If Not Directory.Exists(Path & ".minecraft\") Then + Dim ItemCreate As New MyListItem With {.IsScaleAnimationEnabled = False, .Type = MyListItem.CheckType.Clickable, .Title = "新建 .minecraft 文件夹", .Height = 34, + .ToolTip = "在 PCL 当前所在文件夹下创建新的 .minecraft 文件夹", + .LogoScale = 0.9, + .Logo = "M103.331925 384.978025l25.805736 0L129.137661 161.847132c0-18.313088 14.905478-33.718963 33.718963-33.718963l0.969071 0 253.006318 0c10.82044 0 20.218484 4.797259 26.500561 12.257162l117.579929 126.753869 297.819966 0c18.297738 0 33.736359 15.179724 33.736359 33.977859l0 0.952698 0 82.909292 25.547863 0c18.538215 0 34.187637 15.179724 34.187637 33.977859 0 2.163269-0.469698 3.617387-0.469698 5.539156l-54.437843 432.971086c-1.210571 10.382465-7.007601 19.056008-14.968923 24.352641-6.249331 5.765307-14.680351 9.624195-23.595394 9.624195l-0.969071 0-694.906773 0c-9.155521 0-17.344017-3.858888-23.626094-9.155521-8.67252-5.765307-14.453177-14.939247-15.389502-25.758664L69.597613 423.040922c-2.165316-18.313088 10.868535-35.414581 29.665647-38.062897L103.331925 384.978025 103.331925 384.978025zM196.576609 384.978025 196.576609 384.978025l627.938546 0 0-49.625234L546.461371 335.352791l0 0c-9.400091 0-18.329461-4.117784-25.048489-11.110035L402.363486 196.067514 196.576609 196.067514 196.576609 384.978025 196.576609 384.978025zM879.469767 452.916347 879.469767 452.916347l-20.267603 0-0.469698 0-0.969071 0-694.906773 0-0.984421 0-20.218484 0 45.781696 366.728382 646.218888 0L879.469767 452.916347 879.469767 452.916347z"} + ToolTipService.SetPlacement(ItemCreate, Primitives.PlacementMode.Right) + ToolTipService.SetHorizontalOffset(ItemCreate, -50) + ToolTipService.SetVerticalOffset(ItemCreate, 2.5) + ToolTipService.SetShowDuration(ItemCreate, 2333333) + FrmSelectLeft.PanList.Children.Add(ItemCreate) + AddHandler ItemCreate.Click, AddressOf FrmSelectLeft.Create_Click + End If + + '添加按钮 + Dim ItemAdd As New MyListItem With {.IsScaleAnimationEnabled = False, .Type = MyListItem.CheckType.Clickable, .Title = "添加已有文件夹", .Height = 34, + .ToolTip = "将一个已有的 Minecraft 文件夹添加到列表", + .Logo = "M512.277 954.412c-118.89 0-230.659-46.078-314.73-129.73S67.12 629.666 67.12 511.222s46.327-229.744 130.398-313.427 195.82-129.73 314.73-129.73 230.659 46.078 314.72 129.73S957.397 392.81 957.397 511.183 911.078 740.96 826.97 824.642s-195.8 129.77-314.692 129.77z m0-822.784c-101.972 0-197.809 39.494-269.865 111.222s-111.7 166.997-111.7 268.373 39.653 196.695 111.67 268.335S410.246 890.78 512.248 890.78s197.809-39.484 269.865-111.222 111.7-166.998 111.67-268.374c-0.03-101.375-39.654-196.665-111.67-268.303S614.22 131.628 512.277 131.628z m222.585 347.8H544.073V288.64c-0.76-17.561-15.613-31.18-33.173-30.419-16.495 0.714-29.704 13.924-30.419 30.419v190.787H289.703c-17.56 0.761-31.179 15.614-30.419 33.174 0.715 16.494 13.924 29.703 30.42 30.418H480.48v190.788c0.761 17.56 15.614 31.179 33.174 30.419 16.494-0.715 29.703-13.925 30.418-30.42V543.02h190.788c17.56 0.762 32.413-12.857 33.173-30.418 0.762-17.561-12.858-32.414-30.419-33.174a31.683 31.683 0 0 0-2.753 0z"} + ToolTipService.SetPlacement(ItemAdd, Primitives.PlacementMode.Right) + ToolTipService.SetHorizontalOffset(ItemAdd, -50) + ToolTipService.SetVerticalOffset(ItemAdd, 2.5) + ToolTipService.SetShowDuration(ItemAdd, 2333333) + FrmSelectLeft.PanList.Children.Add(ItemAdd) + AddHandler ItemAdd.Click, AddressOf FrmSelectLeft.Add_Click + + '安装按钮 + Dim ItemInstall As New MyListItem With {.IsScaleAnimationEnabled = False, .Type = MyListItem.CheckType.Clickable, .Title = "导入整合包", .Height = 34, + .ToolTip = "在当前选择的 Minecraft 文件夹下安装整合包", + .Logo = "M512 40.96C249.344 40.96 35.84 252.416 35.84 512s213.504 471.04 476.16 471.04c103.424 0 202.752-33.28 286.72-96.256l1.536-1.536c5.12-5.632 7.68-12.8 7.68-19.968 0-16.896-13.824-30.208-30.72-30.208-7.68 0-15.36 2.56-20.992 7.68h-0.512c-71.68 52.224-155.648 79.36-243.712 79.36-227.328 0-412.16-182.784-412.16-407.552 0-224.768 184.832-407.552 412.16-407.552s412.16 182.784 412.16 407.552c0 68.608-15.872 132.608-46.592 190.464-0.512 1.024-1.024 2.048-1.024 3.072-0.512 2.048-1.536 4.608-1.536 8.192 0 16.896 13.824 30.208 30.72 30.208 12.288 0 23.04-7.168 28.16-18.432 35.84-68.608 53.76-141.312 53.76-216.064 0.512-259.584-212.992-471.04-475.648-471.04z M812.032 483.328c-31.744-20.992-71.68 1.536-78.848 6.144-1.024 0.512-104.448 61.44-128 74.752-8.192 4.608-22.528-0.512-27.136-4.096-31.232-36.352-54.272-70.656-68.608-102.4-13.312-29.184 0.512-41.472 3.072-43.52 7.168-4.608 114.688-68.608 143.36-83.456 24.064-12.288 40.96-25.088 46.08-45.056 3.072-13.312 0-27.136-9.216-39.936-22.016-31.744-172.544-84.992-311.296-3.584-157.184 91.648-152.064 242.688-150.528 292.352v9.216c0 18.944-12.8 37.376-14.848 40.448l-20.992 21.504c-6.144 6.144-9.216 13.824-9.216 22.528 0 8.704 3.584 16.384 9.728 22.528 12.8 12.288 32.768 11.776 45.056-0.512l22.528-23.552 0.512-0.512c3.072-3.584 30.208-38.4 30.208-81.92l-0.512-11.264c-1.536-44.544-5.632-162.816 119.296-235.52 88.064-51.2 173.056-32.256 208.896-19.968-36.864 19.456-143.36 83.456-144.896 84.48-22.016 14.336-55.808 58.88-26.112 122.88 17.408 37.376 43.52 76.8 80.896 120.32 14.336 17.408 62.976 37.376 103.424 15.36 24.576-13.312 125.44-73.216 130.048-75.776 2.048-1.024 4.608-2.56 7.68-3.584 0 2.56-0.512 6.144-1.024 10.752-5.632 35.84-35.328 155.136-191.488 181.76-49.664 8.704-89.6 3.584-121.856-0.512h-0.512c-37.888-4.608-73.216-9.216-101.888 14.336-31.232 26.112-40.96 34.304-35.84 54.272 3.584 14.336 16.384 24.064 30.72 24.064 2.56 0 5.12-0.512 7.68-1.024 6.656-1.536 12.8-5.632 16.896-10.752 2.048-2.048 7.68-6.656 20.992-18.432 6.656-5.632 25.088-3.584 52.736 0 34.816 4.608 81.92 10.24 141.312 0.512 157.184-26.624 228.864-138.752 243.2-234.496 7.68-38.912 0-64.512-21.504-78.336z"} + ToolTipService.SetPlacement(ItemInstall, Primitives.PlacementMode.Right) + ToolTipService.SetHorizontalOffset(ItemInstall, -50) + ToolTipService.SetVerticalOffset(ItemInstall, 2.5) + ToolTipService.SetShowDuration(ItemInstall, 2333333) + FrmSelectLeft.PanList.Children.Add(ItemInstall) + AddHandler ItemInstall.Click, AddressOf ModpackInstall + + '边距 + FrmSelectLeft.PanList.Children.Add(New FrameworkElement With {.Height = 10, .IsHitTestVisible = False}) + + '确认勾选状态 + For i = 0 To McFolderList.Count - 1 + If McFolderList(i).Path = PathMcFolder Then + CType(FrmSelectLeft.PanList.Children(i + 1), MyListItem).Checked = True '去掉第一个标题 + Exit Sub + End If + Next + If McFolderList.Count = 0 Then + Throw New ArgumentNullException("没有可用的 Minecraft 文件夹") + Else + Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$")) + CType(FrmSelectLeft.PanList.Children(1), MyListItem).Checked = True + End If + + Catch ex As Exception + Log(ex, "构建 Minecraft 文件夹列表 UI 出错", LogLevel.Feedback) + Finally + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表 + End Try + End Sub + Private McFolderListLast As List(Of McFolder) + + '添加文件夹 + Public Sub Add_Click() + Dim NewFolder As String = "" + '检查是否有下载任务 + If HasDownloadingTask() Then + Hint("请不要在下载过程中添加游戏文件夹！", HintType.Critical) + Exit Sub + End If + Try + '获取输入 + NewFolder = SelectFolder() + If NewFolder = "" Then Exit Sub + If NewFolder.Contains("!") OrElse NewFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Critical) : Exit Sub + '要求输入显示名称 + Dim SplitedNames As String() = NewFolder.TrimEnd("\").Split("\") + Dim NewName As String = MyMsgBoxInput(If(SplitedNames.Last = ".minecraft", If(SplitedNames.Count >= 3, SplitedNames(SplitedNames.Count - 2), ""), SplitedNames.Last), New ObjectModel.Collection(Of Validate) From { + New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"}) + },, "输入显示名称",, "取消") + If String.IsNullOrWhiteSpace(NewName) Then Exit Sub + '添加文件夹 + AddFolder(NewFolder, NewName, True) + Catch ex As Exception + Log(ex, "添加文件夹失败（" & NewFolder & "）", LogLevel.Feedback) + End Try + End Sub + Public Shared Sub AddFolder(FolderPath As String, DisplayName As String, ShowHint As Boolean) + RunInThread( + Sub() + Try + If Not FolderPath.EndsWith("\") Then FolderPath &= "\" '加上斜杠…… + '检查文件夹权限 + If Not CheckPermission(FolderPath) Then + If ShowHint Then + Hint("添加文件夹失败：PCL 没有访问该文件夹的权限！", HintType.Critical) + Exit Sub + Else + Throw New Exception("PCL 没有访问文件夹的权限：" & FolderPath) + End If + End If + '检查实际的 Minecraft 文件夹位置（没有问题，或是在子文件夹中） + If Not CheckPermission(FolderPath & "versions\") Then + For Each Folder As DirectoryInfo In New DirectoryInfo(FolderPath).GetDirectories + If CheckPermission(Folder.FullName & "\versions\") Then + FolderPath = Folder.FullName & "\" + Exit For + End If + Next + End If + '判断是否已经添加过，若添加过则直接修改自定义名 + Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|")) + Dim IsAdded As Boolean = False + Dim IsReplace As Boolean = False + For i = 0 To Folders.Count - 1 + Dim Folder As String = Folders(i) + If Folder = "" Then Continue For + If Folder.Split(">")(1) = FolderPath Then + IsAdded = True + If Folder.Split(">")(0) = DisplayName Then + If ShowHint Then Hint("此文件夹已在列表中！", HintType.Info) + Exit Sub + Else + Folders(i) = DisplayName & ">" & FolderPath + IsReplace = True + If ShowHint Then Hint("文件夹名称已更新为 " & DisplayName & " ！", HintType.Finish) + End If + Exit For + End If + Next + '如果没有添加过，则添加进去 + If Not IsAdded Then Folders.Add(DisplayName & ">" & FolderPath) + '保存 + Setup.Set("LaunchFolders", Join(Folders.ToArray, "|")) + '切换选择并更新列表 + Setup.Set("LaunchFolderSelect", FolderPath.Replace(Path, "$")) + McFolderListLoader.Start(IsForceRestart:=True) + '提示 + If IsReplace Then Exit Sub + 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 + '2. 版本数较少，可能为整合包 + Dim VersionFolder As New DirectoryInfo(FolderPath & "versions\") + If Not (VersionFolder.Exists AndAlso VersionFolder.EnumerateDirectories.Count <= 3) Then Exit Sub + '3. 能够找到可安装 Mod 的版本 + For Each VersionPath In VersionFolder.EnumerateDirectories + Dim Version As New McVersion(VersionPath.FullName) + Version.Load() + If Not Version.Version.Modable Then Continue For + '4. 该版本的隔离文件夹下不存在 mods + Dim ModIndieFolder As New DirectoryInfo(Version.Path & "mods\") + If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Count > 0 Then Exit Sub + '满足以上全部条件则视为根目录整合包 + Setup.Set("VersionArgumentIndie", 2, Version:=Version) + Log("[Setup] 已自动关闭单版本隔离：" & Version.Name, LogLevel.Debug) + Next + Catch ex As Exception + Log(ex, "向文件夹列表中添加新文件夹失败", LogLevel.Feedback) + End Try + End Sub) + End Sub + + '创建文件夹 + Public Sub Create_Click() + '检查是否有下载任务 + If HasDownloadingTask() Then + Hint("请不要在下载过程中创建游戏文件夹！", HintType.Critical) + Exit Sub + End If + If Not Directory.Exists(Path & ".minecraft\") Then + Directory.CreateDirectory(Path & ".minecraft\") + Directory.CreateDirectory(Path & ".minecraft\versions\") + Setup.Set("LaunchFolderSelect", "$.minecraft\") + Hint("新建 .minecraft 文件夹成功！", HintType.Finish) + End If + McFolderListLoader.Start(IsForceRestart:=True) + End Sub + + '右键菜单 + Public Sub Remove_Click(sender As Object, e As RoutedEventArgs) + Try + + Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag + '若为 “移除”，则提醒是否删除 PCL 的配置文件 + If Folder.Type = McFolderType.Custom Then + Select Case MyMsgBox("是否需要清理 PCL 在该文件夹中的配置文件？" & vbCrLf & "这包括各个版本的独立设置（如自定义图标、第三方登录配置）等，对游戏本身没有影响。", "配置文件清理", "删除", "保留", "取消") + Case 1 + '删除配置文件 + If File.Exists(Folder.Path & "PCL.ini") Then File.Delete(Folder.Path & "PCL.ini") + If Directory.Exists(Folder.Path & "versions\") Then + For Each Version In New DirectoryInfo(Folder.Path & "versions\").EnumerateDirectories + If Directory.Exists(Version.FullName & "\PCL\") Then Directory.Delete(Version.FullName & "\PCL\", True) + Next + End If + Case 2 + '不删除 + Case 3 + '取消 + Exit Sub + End Select + End If + '若修改了本部分代码，应对应修改 Delete_Click 中的代码 + '获取并删除列表项 + Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|")) + Dim Name As String = "" + For i = 0 To Folders.Count - 1 + If Folders(i) = "" Then Exit For + If Folders(i).ToString.EndsWith(Folder.Path) Then + Name = Folders(i).ToString.Split(">")(0) + Folders.RemoveAt(i) + Exit For + End If + Next + '保存 + Setup.Set("LaunchFolders", If(Folders.Count = 0, "", Join(Folders.ToArray, "|"))) + Hint(If(Folder.Type = McFolderType.Custom, "文件夹 " & Name & " 已从列表中移除！", "文件夹名称已复原！"), HintType.Finish) + McFolderListLoader.Start(IsForceRestart:=True) + + Catch ex As Exception + Log(ex, "从列表中移除游戏文件夹失败", LogLevel.Feedback) + End Try + End Sub + 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 & "这会导致该文件夹中的所有存档与其他文件永久消失，且不可恢复！", "删除警告", "取消", "继续") = 1 Then Exit Sub + If MyMsgBox(DeleteText & "这个文件夹会导致该文件夹中的所有文件永久消失，且不可恢复！" & vbCrLf & "这是最后一次警告！", "删除警告", DeleteText, "取消",, True) = 2 Then Exit Sub + '移出列表 + If Folder.Type = McFolderType.Custom Then + Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|")) + For i = 0 To Folders.Count - 1 + If Folders(i) = "" Then Exit For + If Folders(i).ToString.EndsWith(Folder.Path) Then + 'Name = Folders(i).ToString.Split(">")(0) + Folders.RemoveAt(i) + Exit For + End If + Next + Setup.Set("LaunchFolders", If(Folders.Count = 0, "", Join(Folders.ToArray, "|"))) + End If + RunInNewThread(Sub() + '删除文件夹 + Try + Hint("正在" & DeleteText & "文件夹 " & Folder.Name & "！", HintType.Info) + DeleteDirectory(Folder.Path) + If DeleteText = "清空" Then Directory.CreateDirectory(Folder.Path) + Hint("已" & DeleteText & "文件夹 " & Folder.Name & "！", HintType.Finish) + Catch ex As Exception + Log(ex, DeleteText & "文件夹 " & Folder.Name & " 失败", LogLevel.Hint) + Finally + '刷新列表 + McFolderListLoader.Start(IsForceRestart:=True) + End Try + End Sub, "Folder Delete " & GetUuid(), ThreadPriority.BelowNormal) + End Sub + Public Sub Open_Click(sender As Object, e As RoutedEventArgs) + OpenExplorer("""" & CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Info & """") + End Sub + Public Sub Refresh_Click(sender As Object, e As RoutedEventArgs) + Dim Data As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag + WriteIni(Data.Path & "PCL.ini", "VersionCache", "") '删除缓存以强制要求下一次加载时更新列表 + If Data.Path = PathMcFolder Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + End Sub + Public Sub Rename_Click(sender As Object, e As RoutedEventArgs) + Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag + Try + '获取输入 + 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 + '修改自定义名 + Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|")) + Dim IsAdded As Boolean = False + For i = 0 To Folders.Count - 1 + Dim FolderCurrent As String = Folders(i) + If FolderCurrent = "" Then Continue For + If FolderCurrent.Split(">")(1) = Folder.Path Then + IsAdded = True + If FolderCurrent.Split(">")(0) = NewName Then + '名称未修改 + Exit Sub + Else + Folders(i) = NewName & ">" & Folder.Path + End If + Exit For + End If + Next + '如果没有添加过，则添加进去（因为修改了默认项的名称） + If Not IsAdded Then Folders.Add(NewName & ">" & Folder.Path) + Hint("文件夹名称已更新为 " & NewName & " ！", HintType.Finish) + '保存 + Setup.Set("LaunchFolders", Join(Folders.ToArray, "|")) + McFolderListLoader.Start(IsForceRestart:=True) + Catch ex As Exception + Log(ex, "重命名文件夹失败", LogLevel.Feedback) + End Try + End Sub + + '点击选项 + Public Sub Folder_Change(sender As MyListItem, e As RouteEventArgs) + If Not e.RaiseByMouse OrElse Not sender.Checked Then Exit Sub + '检查是否有下载任务 + If HasDownloadingTask(True) Then + Hint("请不要在下载过程中切换游戏文件夹！", HintType.Critical) + e.Handled = True + Exit Sub + End If + '更换 + Setup.Set("LaunchFolderSelect", CType(sender.Tag, McFolder).Path.Replace(Path, "$")) + McFolderListLoader.Start(IsForceRestart:=True) + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表 + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageSelectRight.xaml b/Plain Craft Launcher 2/Pages/PageSelectRight.xaml new file mode 100644 index 0000000..b503c15 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSelectRight.xaml @@ -0,0 +1,25 @@ + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb new file mode 100644 index 0000000..de1f451 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb @@ -0,0 +1,266 @@ +Public Class PageSelectRight + + '窗口基础 + Private Sub PageSelectRight_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") + PanBack.ScrollToHome() + End Sub + Private Sub LoaderInit() Handles Me.Initialized + PageLoaderInit(Load, PanLoad, PanAllBack, Nothing, McVersionListLoader, AddressOf McVersionListUI, AutoRun:=False) + End Sub + Private Sub Load_Click(sender As Object, e As MouseButtonEventArgs) Handles Load.Click + If McModLoader.State = LoadState.Failed Then + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + End If + End Sub + + '窗口属性 + ''' + ''' 是否显示隐藏的 Minecraft 版本。 + ''' + Public ShowHidden As Boolean = False + +#Region "结果 UI 化" + + Private Sub McVersionListUI(Loader As LoaderTask(Of String, Integer)) + Try + Dim Path As String = Loader.Input + '加载 UI + PanMain.Children.Clear() + + For Each Card As KeyValuePair(Of McVersionCardType, List(Of McVersion)) In McVersionList.ToArray + '确认是否为隐藏版本显示状态 + If Card.Key = McVersionCardType.Hidden Xor ShowHidden Then Continue For +#Region "确认卡片名称" + Dim CardName As String = "" + Select Case Card.Key + Case McVersionCardType.OriginalLike + CardName = "常规版本" + Case McVersionCardType.API + Dim IsForgeExists As Boolean = False + Dim IsFabricExists As Boolean = False + Dim IsLiteExists As Boolean = False + For Each Version As McVersion In Card.Value + If Version.Version.HasFabric Then IsFabricExists = True + If Version.Version.HasLiteLoader Then IsLiteExists = True + If Version.Version.HasForge Then IsForgeExists = True + Next + If If(IsLiteExists, 1, 0) + If(IsForgeExists, 1, 0) + If(IsFabricExists, 1, 0) > 1 Then + CardName = "可安装 Mod" + ElseIf IsForgeExists Then + CardName = "Forge 版本" + ElseIf IsLiteExists Then + CardName = "LiteLoader 版本" + Else + CardName = "Fabric 版本" + End If + Case McVersionCardType.Error + CardName = "错误的版本" + Case McVersionCardType.Hidden + CardName = "隐藏的版本" + Case McVersionCardType.Rubbish + CardName = "不常用版本" + Case McVersionCardType.Star + CardName = "收藏夹" + Case McVersionCardType.Fool + CardName = "愚人节版本" + Case Else + Throw New ArgumentException("未知的卡片种类（" & Card.Key & "）") + End Select +#End Region + '建立控件 + Dim CardTitle As String = CardName & If(CardName = "收藏夹", "", " (" & Card.Value.Count & ")") + Dim NewCard As New MyCard With {.Title = CardTitle, .Margin = New Thickness(0, 0, 0, 15), .SwapType = 0} + Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Card.Value} + NewCard.Children.Add(NewStack) + NewCard.SwapControl = NewStack + PanMain.Children.Add(NewCard) + '确定卡片是否展开 + If Card.Key = McVersionCardType.Rubbish OrElse Card.Key = McVersionCardType.Error OrElse Card.Key = McVersionCardType.Fool Then + NewCard.IsSwaped = True + Else + MyCard.StackInstall(NewStack, 0, CardTitle) + End If + Next + + '若只有一个卡片，则强制展开 + If PanMain.Children.Count = 1 AndAlso CType(PanMain.Children(0), MyCard).IsSwaped Then + CType(PanMain.Children(0), MyCard).IsSwaped = False + End If + + '判断应该显示哪一个页面 + If PanMain.Children.Count = 0 Then + PanEmpty.Visibility = Visibility.Visible + PanBack.Visibility = Visibility.Collapsed + If ShowHidden Then + LabEmptyTitle.Text = "无隐藏版本" + LabEmptyContent.Text = "没有版本被隐藏，你可以在版本设置的版本分类选项中隐藏版本。" & vbCrLf & "再次按下 F11 即可退出隐藏版本查看模式。" + BtnEmptyDownload.Visibility = Visibility.Collapsed + Else + LabEmptyTitle.Text = "无可用版本" + LabEmptyContent.Text = "未找到任何版本的游戏，请先下载任意版本的游戏。" & vbCrLf & "若有已存在的游戏，请在左边的列表中选择添加文件夹，选择 .minecraft 文件夹将其导入。" + BtnEmptyDownload.Visibility = If(Setup.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow, Visibility.Collapsed, Visibility.Visible) + End If + Else + PanBack.Visibility = Visibility.Visible + PanEmpty.Visibility = Visibility.Collapsed + End If + + Catch ex As Exception + Log(ex, "将版本列表转换显示时失败", LogLevel.Feedback) + End Try + End Sub + Public Shared Function McVersionListItem(Version As McVersion) As MyListItem + Dim NewItem As New MyListItem With {.Title = Version.Name, .Info = Version.Info, .Height = 42, .Tag = Version, .PaddingRight = 78, .SnapsToDevicePixels = True, .Type = MyListItem.CheckType.Clickable} + Try + If Version.Logo.EndsWith("PCL\Logo.png") Then + NewItem.Logo = Version.Path & "PCL\Logo.png" '修复老版本中，存储的自定义 Logo 使用完整路径，导致移动后无法加载的 Bug + Else + NewItem.Logo = Version.Logo + End If + Catch ex As Exception + Log(ex, "加载版本图标失败", LogLevel.Hint) + NewItem.Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png" + End Try + NewItem.ContentHandler = AddressOf McVersionListContent + Return NewItem + End Function + Private Shared Sub McVersionListContent(sender As MyListItem, e As EventArgs) + Dim Version As McVersion = sender.Tag + '注册点击事件 + AddHandler sender.Click, AddressOf Item_Click + '图标按钮 + Dim BtnStar As New MyIconButton + If Version.IsStar Then + BtnStar.ToolTip = "取消收藏" + ToolTipService.SetPlacement(BtnStar, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnStar, 30) + ToolTipService.SetHorizontalOffset(BtnStar, 2) + BtnStar.LogoScale = 1.1 + BtnStar.Logo = Logo.IconButtonLikeFill + Else + BtnStar.ToolTip = "收藏" + ToolTipService.SetPlacement(BtnStar, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnStar, 30) + ToolTipService.SetHorizontalOffset(BtnStar, 2) + BtnStar.LogoScale = 1.1 + BtnStar.Logo = Logo.IconButtonLikeLine + End If + AddHandler BtnStar.Click, Sub() + WriteIni(Version.Path & "PCL\Setup.ini", "IsStar", Not Version.IsStar) + McVersionListForceRefresh = True + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + End Sub + Dim BtnDel As New MyIconButton With {.LogoScale = 1.1, .Logo = Logo.IconButtonDelete} + BtnDel.ToolTip = "删除" + ToolTipService.SetPlacement(BtnDel, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnDel, 30) + ToolTipService.SetHorizontalOffset(BtnDel, 2) + AddHandler BtnDel.Click, Sub() DeleteVersion(sender, Version) + If Version.State <> McVersionState.Error Then + Dim BtnCont As New MyIconButton With {.LogoScale = 1.1, .Logo = Logo.IconButtonSetup} + BtnCont.ToolTip = "设置" + ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnCont, 30) + ToolTipService.SetHorizontalOffset(BtnCont, 2) + AddHandler BtnCont.Click, Sub() + PageVersionLeft.Version = Version + FrmMain.PageChange(FormMain.PageType.VersionSetup, 0) + End Sub + AddHandler sender.MouseRightButtonUp, Sub() + PageVersionLeft.Version = Version + FrmMain.PageChange(FormMain.PageType.VersionSetup, 0) + End Sub + sender.Buttons = {BtnStar, BtnDel, BtnCont} + Else + Dim BtnCont As New MyIconButton With {.LogoScale = 1.15, .Logo = Logo.IconButtonOpen} + BtnCont.ToolTip = "打开文件夹" + ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnCont, 30) + ToolTipService.SetHorizontalOffset(BtnCont, 2) + AddHandler BtnCont.Click, Sub() + PageVersionOverall.OpenVersionFolder(Version) + End Sub + AddHandler sender.MouseRightButtonUp, Sub() + PageVersionOverall.OpenVersionFolder(Version) + End Sub + sender.Buttons = {BtnStar, BtnDel, BtnCont} + End If + End Sub + +#End Region + +#Region "页面事件" + + '点击选项 + Public Shared Sub Item_Click(sender As MyListItem, e As EventArgs) + Dim Version As McVersion = sender.Tag + If New McVersion(Version.Path).Check Then + '正常版本 + McVersionCurrent = Version + Setup.Set("LaunchVersionSelect", McVersionCurrent.Name) + FrmMain.PageBack() + Else + '错误版本 + PageVersionOverall.OpenVersionFolder(Version) + End If + End Sub + + Private Sub BtnDownload_Click(sender As Object, e As EventArgs) Handles BtnEmptyDownload.Click + FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall) + End Sub + + Public Shared Sub DeleteVersion(Item As MyListItem, Version As McVersion) + '修改此代码时，同时修改 PageVersionOverall 中的代码 + Try + Dim IsHintIndie As Boolean = Version.State <> McVersionState.Error AndAlso Version.PathIndie <> PathMcFolder + Select Case MyMsgBox("你确定要删除版本 " & Version.Name & " 吗？" & + If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""), + "版本删除确认", , "取消",, True) + Case 1 + FileIO.FileSystem.DeleteDirectory(Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin) + Hint("版本 " & Version.Name & " 已删除到回收站！", HintType.Finish) + Case 2 + ' DeleteDirectory(Version.Path) + ' Hint("版本 " & Version.Name & " 已永久删除！", HintType.Finish) + 'Case 3 + Exit Sub + End Select + '从 UI 中移除 + If Version.DisplayType = McVersionCardType.Hidden OrElse Not Version.IsStar Then + '仅出现在当前卡片 + Dim Parent As StackPanel = Item.Parent + If Parent.Children.Count > 2 Then '当前的项目与一个占位符 + '删除后还有剩 + Dim Card As MyCard = Parent.Parent + Card.Title = Card.Title.Replace(Parent.Children.Count - 1, Parent.Children.Count - 2) '有一个占位符 + Parent.Children.Remove(Item) + If McVersionCurrent IsNot Nothing AndAlso Version.Path = McVersionCurrent.Path Then + '删除当前版本就更改选择 + McVersionCurrent = CType(Parent.Children(0), MyListItem).Tag + End If + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.UpdateOnly, MaxDepth:=1, ExtraPath:="versions\") + Else + '删除后没剩了 + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + End If + Else + '同时出现在当前卡片与收藏夹 + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + End If + Catch ex As Exception + Log(ex, "删除版本 " & Version.Name & " 失败", LogLevel.Msgbox) + End Try + End Sub + + Public Sub BtnEmptyDownload_Loaded() Handles BtnEmptyDownload.Loaded + Dim NewVisibility = If((Setup.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse ShowHidden, Visibility.Collapsed, Visibility.Visible) + If BtnEmptyDownload.Visibility <> NewVisibility Then + BtnEmptyDownload.Visibility = NewVisibility + PanLoad.TriggerForceResize() + End If + End Sub + +#End Region + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml new file mode 100644 index 0000000..3454e73 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml @@ -0,0 +1,235 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + " + “ + ” + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb new file mode 100644 index 0000000..38a9506 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb @@ -0,0 +1,551 @@ +Public Class PageSetupLaunch + + Private IsLoad As Boolean = False + + Private Sub PageSetupLaunch_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + + '重复加载部分 + PanBack.ScrollToHome() + RefreshRam(False) + + '非重复加载部分 + If IsLoad Then Exit Sub + IsLoad = True + + AniControlEnabled += 1 + Reload() + AniControlEnabled -= 1 + + '内存自动刷新 + Dim timer As New Threading.DispatcherTimer With {.Interval = New TimeSpan(0, 0, 0, 1)} + AddHandler timer.Tick, AddressOf RefreshRam + timer.Start() + + End Sub + Public Sub Reload() + Try + + '离线皮肤 + CType(FindName("RadioSkinType" & Setup.Load("LaunchSkinType")), MyRadioBox).Checked = True + TextSkinID.Text = Setup.Get("LaunchSkinID") + + '启动参数 + TextArgumentTitle.Text = Setup.Get("LaunchArgumentTitle") + TextArgumentInfo.Text = Setup.Get("LaunchArgumentInfo") + ComboArgumentIndie.SelectedIndex = Setup.Get("LaunchArgumentIndie") + ComboArgumentVisibie.SelectedIndex = Setup.Get("LaunchArgumentVisible") + ComboArgumentPriority.SelectedIndex = Setup.Get("LaunchArgumentPriority") + ComboArgumentWindowType.SelectedIndex = Setup.Get("LaunchArgumentWindowType") + TextArgumentWindowWidth.Text = Setup.Get("LaunchArgumentWindowWidth") + TextArgumentWindowHeight.Text = Setup.Get("LaunchArgumentWindowHeight") + RefreshJavaComboBox() + + '游戏内存 + CType(FindName("RadioRamType" & Setup.Load("LaunchRamType")), MyRadioBox).Checked = True + SliderRamCustom.Value = Setup.Get("LaunchRamCustom") + + '高级设置 + TextAdvanceJvm.Text = Setup.Get("LaunchAdvanceJvm") + TextAdvanceGame.Text = Setup.Get("LaunchAdvanceGame") + CheckAdvanceAssets.Checked = Setup.Get("LaunchAdvanceAssets") + + Catch ex As NullReferenceException + Log(ex, "启动设置项存在异常，已被自动重置", LogLevel.Msgbox) + Reset() + Catch ex As Exception + Log(ex, "重载启动设置时出错", LogLevel.Feedback) + End Try + End Sub + + '初始化 + Public Sub Reset() + Try + Setup.Reset("LaunchArgumentTitle") + Setup.Reset("LaunchArgumentInfo") + Setup.Reset("LaunchArgumentIndie") + Setup.Reset("LaunchArgumentVisible") + Setup.Reset("LaunchArgumentWindowType") + Setup.Reset("LaunchArgumentWindowWidth") + Setup.Reset("LaunchArgumentWindowHeight") + Setup.Reset("LaunchArgumentPriority") + Setup.Reset("LaunchRamType") + Setup.Reset("LaunchRamCustom") + Setup.Reset("LaunchSkinType") + Setup.Reset("LaunchSkinID") + Setup.Reset("LaunchAdvanceJvm") + Setup.Reset("LaunchAdvanceGame") + Setup.Reset("LaunchAdvanceAssets") + + Setup.Reset("LaunchArgumentJavaAll") + Setup.Reset("LaunchArgumentJavaSelect") + JavaSearchLoader.Start(IsForceRestart:=True) + + Log("[Setup] 已初始化启动设置") + Hint("已初始化启动设置！", HintType.Finish, False) + Catch ex As Exception + Log(ex, "初始化启动设置失败", LogLevel.Msgbox) + End Try + + Reload() + End Sub + + '将控件改变路由到设置改变 + Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioSkinType0.Check, RadioSkinType1.Check, RadioSkinType2.Check, RadioSkinType3.Check, RadioSkinType4.Check, RadioRamType0.Check, RadioRamType1.Check + If AniControlEnabled = 0 Then Setup.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1))) + End Sub + Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSkinID.ValidatedTextChanged, TextArgumentWindowHeight.ValidatedTextChanged, TextArgumentWindowWidth.ValidatedTextChanged, TextArgumentInfo.ValidatedTextChanged, TextAdvanceGame.ValidatedTextChanged, TextAdvanceJvm.ValidatedTextChanged, TextArgumentTitle.ValidatedTextChanged + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text) + End Sub + Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value) + End Sub + Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged, ComboArgumentVisibie.SelectionChanged, ComboArgumentWindowType.SelectionChanged, ComboArgumentPriority.SelectionChanged + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) + End Sub + Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) + End Sub + +#Region "离线皮肤" + + Private Sub BtnSkinChange_Click(sender As Object, e As EventArgs) Handles BtnSkinChange.Click + Dim SkinInfo As McSkinInfo = McSkinSelect(True) + If Not SkinInfo.IsVaild Then Exit Sub + '设置文件 + Try + '拷贝文件 + File.Delete(PathTemp & "CustomSkin.png") + File.Copy(SkinInfo.LocalFile, PathTemp & "CustomSkin.png") + '更新设置 + Setup.Set("LaunchSkinSlim", SkinInfo.IsSlim) + Catch ex As Exception + Log(ex, "设置离线皮肤失败", LogLevel.Msgbox) + Finally + '设置当前显示 + PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True) + End Try + 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 + Try + '已有图片则不再选择 + If File.Exists(PathTemp & "CustomSkin.png") Then Exit Sub + '没有图片则要求选择 + Dim SkinInfo As McSkinInfo = McSkinSelect(True) + If Not SkinInfo.IsVaild Then + e.Handled = True + Exit Sub + End If + '拷贝文件 + File.Delete(PathTemp & "CustomSkin.png") + File.Copy(SkinInfo.LocalFile, PathTemp & "CustomSkin.png") + '更新设置 + Setup.Set("LaunchSkinSlim", SkinInfo.IsSlim) + Catch ex As Exception + Log(ex, "设置离线皮肤失败", LogLevel.Msgbox) + e.Handled = True + Finally + '设置当前显示 + PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True) + End Try + End Sub + Private Sub BtnSkinDelete_Click(sender As Object, e As EventArgs) Handles BtnSkinDelete.Click + Try + File.Delete(PathTemp & "CustomSkin.png") + RadioSkinType0.SetChecked(True, True, True) + Hint("离线皮肤已清空！", HintType.Finish) + Catch ex As Exception + Log(ex, "清空离线皮肤失败", LogLevel.Msgbox) + End Try + End Sub + Private Sub BtnSkinSave_Click(sender As Object, e As EventArgs) Handles BtnSkinSave.Click + MySkin.Save(PageLaunchLeft.SkinLegacy) + End Sub + Private Sub BtnSkinCache_Click(sender As Object, e As EventArgs) Handles BtnSkinCache.Click + MySkin.RefreshCache(Nothing) + End Sub + +#End Region + +#Region "游戏内存" + + Public Sub RamType(Type As Integer) + If SliderRamCustom Is Nothing Then Exit Sub + SliderRamCustom.IsEnabled = (Type = 1) + End Sub + + ''' + ''' 刷新 UI 上的 RAM 显示。 + ''' + 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 + '获取内存情况 + Dim RamGame As Double = GetRam(McVersionCurrent, False) + Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 + Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 + Dim RamGameActual As Double = Math.Min(RamGame, RamAvailable) + Dim RamUsed As Double = RamTotal - RamAvailable + Dim RamEmpty As Double = Math.Round(MathRange(RamTotal - RamUsed - RamGame, 0, 1000) * 10) / 10 + '设置最大可用内存 + If RamTotal <= 1.5 Then + SliderRamCustom.MaxValue = Math.Max(Math.Floor((RamTotal - 0.3) / 0.1), 1) + ElseIf RamTotal <= 8 Then + SliderRamCustom.MaxValue = Math.Floor((RamTotal - 1.5) / 0.5) + 12 + ElseIf RamTotal <= 16 Then + SliderRamCustom.MaxValue = Math.Floor((RamTotal - 8) / 1) + 25 + ElseIf RamTotal <= 32 Then + SliderRamCustom.MaxValue = Math.Floor((RamTotal - 16) / 2) + 33 + Else + SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 32) / 4) + 41, 49) + End If + '设置文本 + LabRamGame.Text = If(RamGame = Math.Floor(RamGame), RamGame & ".0", RamGame) & " GB" & + If(RamGame <> RamGameActual, " (可用 " & If(RamGameActual = Math.Floor(RamGameActual), RamGameActual & ".0", RamGameActual) & " GB)", "") + LabRamUsed.Text = If(RamUsed = Math.Floor(RamUsed), RamUsed & ".0", RamUsed) & " GB" + LabRamTotal.Text = " / " & If(RamTotal = Math.Floor(RamTotal), RamTotal & ".0", RamTotal) & " GB" + LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaUse64Bit() AndAlso Not Is32BitSystem, Visibility.Visible, Visibility.Collapsed) + If ShowAnim Then + '宽度动画 + AniStart({ + AaGridLengthWidth(ColumnRamUsed, RamUsed - ColumnRamUsed.Width.Value, 800,, New AniEaseOutFluent(AniEasePower.Strong)), + AaGridLengthWidth(ColumnRamGame, RamGameActual - ColumnRamGame.Width.Value, 800,, New AniEaseOutFluent(AniEasePower.Strong)), + AaGridLengthWidth(ColumnRamEmpty, RamEmpty - ColumnRamEmpty.Width.Value, 800,, New AniEaseOutFluent(AniEasePower.Strong)) + }, "SetupLaunch Ram Grid") + Else + '宽度设置 + ColumnRamUsed.Width = New GridLength(RamUsed, GridUnitType.Star) + ColumnRamGame.Width = New GridLength(RamGameActual, GridUnitType.Star) + ColumnRamEmpty.Width = New GridLength(RamEmpty, GridUnitType.Star) + End If + End Sub + Private Sub RefreshRam() Handles SliderRamCustom.Change, RadioRamType0.Check, RadioRamType1.Check + RefreshRam(True) + End Sub + + Private RamTextLeft As Integer = 2, RamTextRight As Integer = 1 + ''' + ''' 刷新 UI 上的文本位置。 + ''' + Private Sub RefreshRamText() Handles RectRamGame.SizeChanged, RectRamEmpty.SizeChanged, LabRamGame.SizeChanged + '获取宽度信息 + Dim RectUsedWidth = RectRamUsed.ActualWidth + Dim TotalWidth = PanRamDisplay.ActualWidth + Dim LabGameWidth = LabRamGame.ActualWidth, LabUsedWidth = LabRamUsed.ActualWidth, LabTotalWidth = LabRamTotal.ActualWidth + Dim LabGameTitleWidth = LabRamGameTitle.ActualWidth, LabUsedTitleWidth = LabRamUsedTitle.ActualWidth + '左侧 + Dim Left As Integer + If RectUsedWidth - 30 < LabUsedWidth OrElse RectUsedWidth - 30 < LabUsedTitleWidth Then + '全写不下了 + Left = 0 + ElseIf RectUsedWidth - 25 < (LabUsedWidth + LabTotalWidth) Then + '显示不下完整数据 + Left = 1 + Else + '正常 + Left = 2 + End If + If RamTextLeft <> Left Then + RamTextLeft = Left + 'If AniControlEnabled = 0 Then + Select Case Left + Case 0 + AniStart({ + AaOpacity(LabRamUsed, -LabRamUsed.Opacity, 100), + AaOpacity(LabRamTotal, -LabRamTotal.Opacity, 100), + AaOpacity(LabRamUsedTitle, -LabRamUsedTitle.Opacity, 100) + }, "SetupLaunch Ram TextLeft") + Case 1 + AniStart({ + AaOpacity(LabRamUsed, 1 - LabRamUsed.Opacity, 100), + AaOpacity(LabRamTotal, -LabRamTotal.Opacity, 100), + AaOpacity(LabRamUsedTitle, 0.7 - LabRamUsedTitle.Opacity, 100) + }, "SetupLaunch Ram TextLeft") + Case 2 + AniStart({ + AaOpacity(LabRamUsed, 1 - LabRamUsed.Opacity, 100), + AaOpacity(LabRamTotal, 1 - LabRamTotal.Opacity, 100), + AaOpacity(LabRamUsedTitle, 0.7 - LabRamUsedTitle.Opacity, 100) + }, "SetupLaunch Ram TextLeft") + End Select + 'Else + ' Select Case Left + ' Case 0 + ' LabRamUsed.Opacity = 0 + ' LabRamTotal.Opacity = 0 + ' LabRamUsedTitle.Opacity = 0 + ' Case 1 + ' LabRamUsed.Opacity = 1 + ' LabRamTotal.Opacity = 0 + ' LabRamUsedTitle.Opacity = 0.7 + ' Case 2 + ' LabRamUsed.Opacity = 1 + ' LabRamTotal.Opacity = 1 + ' LabRamUsedTitle.Opacity = 0.7 + ' End Select + 'End If + End If + '右侧 + Dim Right As Integer + If TotalWidth < LabGameWidth + 2 + RectUsedWidth OrElse TotalWidth < LabGameTitleWidth + 2 + RectUsedWidth Then + '挤到最右边 + Right = 0 + Else + '正常情况 + Right = 1 + End If + If Right = 0 Then + If AniControlEnabled = 0 AndAlso (RamTextRight <> Right OrElse AniIsRun("SetupLaunch Ram TextRight")) Then + '需要动画 + AniStart({ + AaX(LabRamGame, TotalWidth - LabGameWidth - LabRamGame.Margin.Left, 100,, New AniEaseOutFluent(AniEasePower.Weak)), + AaX(LabRamGameTitle, TotalWidth - LabGameTitleWidth - LabRamGameTitle.Margin.Left, 100,, New AniEaseOutFluent(AniEasePower.Weak)) + }, "SetupLaunch Ram TextRight") + Else + '不需要动画 + LabRamGame.Margin = New Thickness(TotalWidth - LabGameWidth, 3, 0, 0) + LabRamGameTitle.Margin = New Thickness(TotalWidth - LabGameTitleWidth, 0, 0, 5) + End If + Else + If AniControlEnabled = 0 AndAlso (RamTextRight <> Right OrElse AniIsRun("SetupLaunch Ram TextRight")) Then + '需要动画 + AniStart({ + AaX(LabRamGame, 2 + RectUsedWidth - LabRamGame.Margin.Left, 100,, New AniEaseOutFluent(AniEasePower.Weak)), + AaX(LabRamGameTitle, 2 + RectUsedWidth - LabRamGameTitle.Margin.Left, 100,, New AniEaseOutFluent(AniEasePower.Weak)) + }, "SetupLaunch Ram TextRight") + Else + '不需要动画 + LabRamGame.Margin = New Thickness(2 + RectUsedWidth, 3, 0, 0) + LabRamGameTitle.Margin = New Thickness(2 + RectUsedWidth, 0, 0, 5) + End If + End If + RamTextRight = Right + End Sub + + ''' + ''' 获取当前设置的 RAM 值。单位为 GB。 + ''' + Public Shared Function GetRam(Version As McVersion, UseVersionJavaSetup As Boolean) As Double + Dim RamGive As Double + If Setup.Get("LaunchRamType") = 0 Then + '自动配置 + Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 + '确定需求的内存值 + Dim RamMininum As Double '无论如何也需要保证的最低限度内存 + Dim RamTarget1 As Double '估计能勉强带动了的内存 + Dim RamTarget2 As Double '估计没啥问题了的内存 + Dim RamTarget3 As Double '放一百万个材质和 Mod 和光影需要的内存 + If Version IsNot Nothing AndAlso Not Version.IsLoaded Then Version.Load() + If Version IsNot Nothing AndAlso Version.Version.Modable Then + '可安装 Mod 的版本 + Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\") + Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0) + RamMininum = 0.4 + ModCount / 150 + RamTarget1 = 1.5 + ModCount / 100 + RamTarget2 = 3 + ModCount / 60 + RamTarget3 = 6 + ModCount / 30 + ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then + 'OptiFine 版本 + RamMininum = 0.3 + RamTarget1 = 1.5 + RamTarget2 = 3 + RamTarget3 = 6 + Else + '普通版本 + RamMininum = 0.3 + RamTarget1 = 1.5 + RamTarget2 = 2.5 + RamTarget3 = 4 + End If + Dim RamDelta As Double + '预分配内存，阶段一，0 ~ T1，100% + RamDelta = RamTarget1 + RamAvailable = Math.Max(0, RamAvailable - 0.1) + RamGive += Math.Min(RamAvailable * 1, RamDelta) + RamAvailable -= RamDelta / 1 + 0.1 + If RamAvailable < 0.1 Then GoTo PreFin + '预分配内存，阶段二，T1 ~ T2，80% + RamDelta = RamTarget2 - RamTarget1 + RamAvailable = Math.Max(0, RamAvailable - 0.1) + RamGive += Math.Min(RamAvailable * 0.8, RamDelta) + RamAvailable -= RamDelta / 0.8 + 0.1 + If RamAvailable < 0.1 Then GoTo PreFin + '预分配内存，阶段三，T2 ~ T3，60% + RamDelta = RamTarget3 - RamTarget2 + RamAvailable = Math.Max(0, RamAvailable - 0.2) + RamGive += Math.Min(RamAvailable * 0.6, RamDelta) + RamAvailable -= RamDelta / 0.6 + 0.2 + If RamAvailable < 0.1 Then GoTo PreFin + '预分配内存，阶段四，T3 ~ T3 * 2，40% + RamDelta = RamTarget3 + RamAvailable = Math.Max(0, RamAvailable - 0.3) + RamGive += Math.Min(RamAvailable * 0.4, RamDelta) + RamAvailable -= RamDelta / 0.4 + 0.3 + If RamAvailable < 0.1 Then GoTo PreFin +PreFin: + '不低于最低值 + RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1) + Else + '手动配置 + Dim Value As Integer = Setup.Get("LaunchRamCustom") + If Value <= 12 Then + RamGive = Value * 0.1 + 0.3 + ElseIf Value <= 25 Then + RamGive = (Value - 12) * 0.5 + 1.5 + ElseIf Value <= 33 Then + RamGive = (Value - 25) * 1 + 8 + ElseIf Value <= 41 Then + RamGive = (Value - 33) * 2 + 16 + Else + RamGive = (Value - 41) * 4 + 32 + End If + End If + '若使用 32 位 Java，则限制为 1G + If Not JavaUse64Bit(If(UseVersionJavaSetup, Version, Nothing)) Then RamGive = Math.Min(1, RamGive) + Return RamGive + End Function + +#End Region + +#Region "Java 选择" + + '刷新 Java 下拉框显示 + Public Sub RefreshJavaComboBox() + If ComboArgumentJava Is Nothing Then Exit Sub + '初始化列表 + ComboArgumentJava.Items.Clear() + ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择适合所选游戏版本的 Java", .Tag = "自动选择"}) + '更新列表 + Dim SelectedItem As MyComboBoxItem = Nothing + Dim SelectedBySetup As String = Setup.Get("LaunchArgumentJavaSelect") + Try + For Each Java In JavaList + Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java} + ToolTipService.SetPlacement(ListItem, Primitives.PlacementMode.Right) + ToolTipService.SetHorizontalOffset(ListItem, 5) + ComboArgumentJava.Items.Add(ListItem) + '判断人为选中 + If SelectedBySetup = "" Then Continue For + If JavaEntry.FromJson(GetJson(SelectedBySetup)).PathFolder = Java.PathFolder Then SelectedItem = ListItem + Next + Catch ex As Exception + Setup.Set("LaunchArgumentJavaSelect", "") + Log(ex, "更新设置 Java 下拉框失败", LogLevel.Feedback) + End Try + '更新选择项 + If SelectedItem Is Nothing AndAlso JavaList.Count > 0 Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择” + ComboArgumentJava.SelectedItem = SelectedItem + '结束处理 + If SelectedItem Is Nothing Then + ComboArgumentJava.Items.Clear() + ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "未找到可用的 Java", .IsSelected = True}) + End If + RefreshRam(True) + End Sub + '阻止在特定情况下展开下拉框 + Private Sub ComboArgumentJava_DropDownOpened(sender As Object, e As EventArgs) Handles ComboArgumentJava.DropDownOpened + If ComboArgumentJava.SelectedItem Is Nothing OrElse ComboArgumentJava.Items(0).Content = "未找到可用的 Java" OrElse ComboArgumentJava.Items(0).Content = "加载中……" Then + ComboArgumentJava.IsDropDownOpen = False + End If + End Sub + + '下拉框选择更改 + Private Sub JavaSelectionUpdate() Handles ComboArgumentJava.SelectionChanged + If AniControlEnabled <> 0 Then Exit Sub + 'Java 不可用时也不清空，会导致刷新时找不到对象 + If ComboArgumentJava.SelectedItem Is Nothing OrElse ComboArgumentJava.SelectedItem.Tag Is Nothing Then Exit Sub + '设置新的 Java + Dim SelectedJava = ComboArgumentJava.SelectedItem.Tag + If "自动选择".Equals(SelectedJava) Then + '选择 “自动” + Setup.Set("LaunchArgumentJavaSelect", "") + Log("[Java] 修改 Java 选择设置：自动选择") + Else + '选择指定项 + Setup.Set("LaunchArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None)) + Log("[Java] 修改 Java 选择设置：" & SelectedJava.ToString) + End If + RefreshRam(True) + End Sub + + '手动选择 + 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 + End If + '选择 Java + Dim JavaSelected As String = SelectFile("javaw.exe|javaw.exe", "选择 javaw.exe 文件") + If JavaSelected = "" Then Exit Sub + If Not JavaSelected.ToLower.EndsWith("javaw.exe") Then + Hint("请选择 bin 文件夹中的 javaw.exe 文件！", HintType.Critical) + Exit Sub + End If + JavaSelected = GetPathFromFullPath(JavaSelected) + Try + '验证 Java 可用 + Dim NewEntry As New JavaEntry(JavaSelected, True) + NewEntry.Check() + '加入列表并改变选择 + Dim JavaNewList As New JArray From {NewEntry.ToJson} + For Each JsonEntry In GetJson(Setup.Get("LaunchArgumentJavaAll")) + Dim Entry = JavaEntry.FromJson(JsonEntry) + If Entry.PathFolder = NewEntry.PathFolder Then Continue For + JavaNewList.Add(JsonEntry) + Next + Setup.Set("LaunchArgumentJavaAll", JavaNewList.ToString(Newtonsoft.Json.Formatting.None)) + Setup.Set("LaunchArgumentJavaSelect", NewEntry.ToJson.ToString(Newtonsoft.Json.Formatting.None)) '加载器会优先选择设置中的 Java + '重新加载列表 + JavaSearchLoader.Start(IsForceRestart:=True) + Catch ex As Exception + Log(ex, "该 Java 存在异常，无法使用", LogLevel.Msgbox, "异常的 Java") + Exit Sub + 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 + End If + RunInThread(Sub() + Hint("正在搜索 Java！") + JavaSearchLoader.WaitForExit(GetUuid) + If JavaList.Count = 0 Then + Hint("未找到可用的 Java！", HintType.Critical) + Else + Hint("已找到 " & JavaList.Count & " 个 Java，请检查下拉框查看列表！", HintType.Finish) + End If + End Sub) + End Sub + +#End Region + +#Region "启动参数" + + Private Sub WindowTypeUIRefresh() Handles ComboArgumentWindowType.SelectionChanged + If ComboArgumentWindowType Is Nothing Then Exit Sub + If ComboArgumentWindowType.SelectedIndex = 3 AndAlso LabArgumentWindowMiddle IsNot Nothing AndAlso LabArgumentWindowMiddle.Visibility = Visibility.Collapsed Then + LabArgumentWindowMiddle.Visibility = Visibility.Visible + TextArgumentWindowHeight.Visibility = Visibility.Visible + TextArgumentWindowWidth.Visibility = Visibility.Visible + ElseIf ComboArgumentWindowType.SelectedIndex <> 3 AndAlso LabArgumentWindowMiddle IsNot Nothing AndAlso LabArgumentWindowMiddle.Visibility = Visibility.Visible Then + LabArgumentWindowMiddle.Visibility = Visibility.Collapsed + TextArgumentWindowHeight.Visibility = Visibility.Collapsed + TextArgumentWindowWidth.Visibility = Visibility.Collapsed + End If + End Sub + + '可见性选择直接关闭的警告 + Private Sub ComboArgumentVisibie_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentVisibie.SelectionChanged + If AniControlEnabled <> 0 Then Exit Sub + If ComboArgumentVisibie.SelectedIndex = 0 Then + If MyMsgBox("若在游戏启动后立即关闭启动器，崩溃检测、更改游戏标题等功能将失效。" & vbCrLf & + "如果想保留这些功能，可以选择让启动器在游戏启动后隐藏，游戏退出后自动关闭。", "提示", "继续", "取消") = 2 Then + ComboArgumentVisibie.SelectedItem = e.RemovedItems(0) + End If + End If + End Sub + +#End Region + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml new file mode 100644 index 0000000..818dfd1 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml @@ -0,0 +1,39 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml.vb new file mode 100644 index 0000000..51ecb2a --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml.vb @@ -0,0 +1,169 @@ +Public Class PageSetupLeft + + Private IsLoad As Boolean = False + Private IsPageSwitched As Boolean = False '如果在 Loaded 前切换到其他页面，会导致触发 Loaded 时再次切换一次 + Private Sub PageSetupLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + '是否处于隐藏的子页面 + Dim IsHiddenPage As Boolean = False + If ItemLaunch.Checked AndAlso Setup.Get("UiHiddenSetupLaunch") Then IsHiddenPage = True + If ItemUI.Checked AndAlso Setup.Get("UiHiddenSetupUi") Then IsHiddenPage = True + If ItemSystem.Checked AndAlso Setup.Get("UiHiddenSetupSystem") Then IsHiddenPage = True + If ItemLink.Checked AndAlso Setup.Get("UiHiddenSetupLink") Then IsHiddenPage = True + If PageSetupUI.HiddenForceShow Then IsHiddenPage = False + '若页面错误，或尚未加载，则继续 + If IsLoad AndAlso Not IsHiddenPage Then Exit Sub + IsLoad = True + '刷新子页面隐藏情况 + PageSetupUI.HiddenRefresh() + '选择第一个未被禁用的子页面 + If IsPageSwitched Then Exit Sub + If Not Setup.Get("UiHiddenSetupLaunch") Then + ItemLaunch.SetChecked(True, False, False) + ElseIf Not Setup.Get("UiHiddenSetupUi") Then + ItemUI.SetChecked(True, False, False) + ElseIf Not Setup.Get("UiHiddenSetupSystem") Then + ItemSystem.SetChecked(True, False, False) + ElseIf Not Setup.Get("UiHiddenSetupLink") Then + ItemLink.SetChecked(True, False, False) + Else + ItemLaunch.SetChecked(True, False, False) + End If + End Sub + Private Sub PageOtherLeft_Unloaded(sender As Object, e As RoutedEventArgs) Handles Me.Unloaded + IsPageSwitched = False + End Sub + +#Region "页面切换" + + ''' + ''' 当前页面的编号。从左往右从 0 开始计算。 + ''' + Public PageID As FormMain.PageSubType + Public Sub New() + InitializeComponent() + '选择第一个未被禁用的子页面 + If Not Setup.Get("UiHiddenSetupLaunch") Then + PageID = FormMain.PageSubType.SetupLaunch + ElseIf Not Setup.Get("UiHiddenSetupUi") Then + PageID = FormMain.PageSubType.SetupUI + ElseIf Not Setup.Get("UiHiddenSetupSystem") Then + PageID = FormMain.PageSubType.SetupSystem + ElseIf Not Setup.Get("UiHiddenSetupLink") Then + PageID = FormMain.PageSubType.SetupLink + Else + PageID = FormMain.PageSubType.SetupLaunch + End If + End Sub + + ''' + ''' 勾选事件改变页面。 + ''' + Private Sub PageCheck(sender As MyListItem, e As EventArgs) Handles ItemLaunch.Check, ItemSystem.Check, ItemUI.Check, ItemLink.Check + '尚未初始化控件属性时，sender.Tag 为 Nothing，会跳过切换，且由于 PageID 默认为 0 而切换到第一个页面 + '若使用 IsLoaded，则会导致模拟点击不被执行（模拟点击切换页面时，控件的 IsLoaded 为 False） + If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) + End Sub + + ''' + ''' 获取当前导航指定的右页面。 + ''' + Public Function PageGet(Optional ID As FormMain.PageSubType = -1) + If ID = -1 Then ID = PageID + Select Case ID + Case FormMain.PageSubType.SetupLaunch + If FrmSetupLaunch Is Nothing Then FrmSetupLaunch = New PageSetupLaunch + Return FrmSetupLaunch + Case FormMain.PageSubType.SetupUI + If FrmSetupUI Is Nothing Then FrmSetupUI = New PageSetupUI + Return FrmSetupUI + Case FormMain.PageSubType.SetupLink + If FrmSetupLink Is Nothing Then FrmSetupLink = New PageSetupLink + Return FrmSetupLink + Case FormMain.PageSubType.SetupSystem + If FrmSetupSystem Is Nothing Then FrmSetupSystem = New PageSetupSystem + Return FrmSetupSystem + Case Else + Throw New Exception("未知的设置子页面种类：" & ID) + End Select + End Function + + ''' + ''' 切换现有页面。 + ''' + Public Sub PageChange(ID As FormMain.PageSubType) + If PageID = ID Then Exit Sub + AniControlEnabled += 1 + IsPageSwitched = True + Try + + Select Case ID + Case FormMain.PageSubType.SetupLaunch + If IsNothing(FrmSetupLaunch) Then FrmSetupLaunch = New PageSetupLaunch + PageChangeRun(FrmSetupLaunch) + Case FormMain.PageSubType.SetupUI + If IsNothing(FrmSetupUI) Then FrmSetupUI = New PageSetupUI + PageChangeRun(FrmSetupUI) + Case FormMain.PageSubType.SetupLink + If IsNothing(FrmSetupLink) Then FrmSetupLink = New PageSetupLink + PageChangeRun(FrmSetupLink) + Case FormMain.PageSubType.SetupSystem + If IsNothing(FrmSetupSystem) Then FrmSetupSystem = New PageSetupSystem + PageChangeRun(FrmSetupSystem) + Case Else + Throw New Exception("未知的设置子页面种类：" & ID) + End Select + + PageID = ID + Catch ex As Exception + Log(ex, "切换设置分页面失败（ID " & ID & "）", LogLevel.Feedback) + Finally + AniControlEnabled -= 1 + End Try + End Sub + Private Shared Sub PageChangeRun(Target As MyPageRight) + AniStop("FrmMain PageChangeRight") '停止主页面的右页面切换动画，防止它与本动画一起触发多次 PageOnEnter + If Target.Parent IsNot Nothing Then Target.SetValue(ContentPresenter.ContentProperty, Nothing) + FrmMain.PageRight = Target + CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnExit() + AniStart({ + AaCode(Sub() + CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit() + FrmMain.PanMainRight.Child = FrmMain.PageRight + FrmMain.PageRight.Opacity = 0 + End Sub, 130), + AaCode(Sub() + '延迟触发页面通用动画，以使得在 Loaded 事件中加载的控件得以处理 + FrmMain.PageRight.Opacity = 1 + FrmMain.PageRight.PageOnEnter() + End Sub, 30, True) + }, "PageLeft PageChange") + End Sub + +#End Region + + Public Sub Reset(sender As Object, e As EventArgs) + Select Case Val(sender.Tag) + Case FormMain.PageSubType.SetupLaunch + If MyMsgBox("是否要初始化启动页的所有设置？该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then + If IsNothing(FrmSetupLaunch) Then FrmSetupLaunch = New PageSetupLaunch + FrmSetupLaunch.Reset() + End If + Case FormMain.PageSubType.SetupUI + If MyMsgBox("是否要初始化个性化页的所有设置？该操作不可撤销。" & vbCrLf & "（背景图片与音乐、自定义主页等外部文件不会被删除）", "初始化确认",, "取消", IsWarn:=True) = 1 Then + If IsNothing(FrmSetupUI) Then FrmSetupUI = New PageSetupUI + FrmSetupUI.Reset() + End If + Case FormMain.PageSubType.SetupSystem + If MyMsgBox("是否要初始化启动器页的所有设置？该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then + If IsNothing(FrmSetupSystem) Then FrmSetupSystem = New PageSetupSystem + FrmSetupSystem.Reset() + End If + Case FormMain.PageSubType.SetupLink + If MyMsgBox("是否要初始化联机页的所有设置？该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then + If IsNothing(FrmSetupLink) Then FrmSetupLink = New PageSetupLink + FrmSetupLink.Reset() + End If + End Select + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLink.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLink.xaml new file mode 100644 index 0000000..ae13c9b --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLink.xaml @@ -0,0 +1,35 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLink.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLink.xaml.vb new file mode 100644 index 0000000..ad23b2f --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLink.xaml.vb @@ -0,0 +1,47 @@ +Class PageSetupLink + + Private Shadows IsLoaded As Boolean = False + + Private Sub PageSetupLink_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + + '重复加载部分 + PanBack.ScrollToHome() + + '非重复加载部分 + If IsLoaded Then Exit Sub + IsLoaded = True + + AniControlEnabled += 1 + Reload() + AniControlEnabled -= 1 + + End Sub + Public Sub Reload() + CheckLinkAuto.Checked = Setup.Get("LinkAuto") + TextLinkName.Text = Setup.Get("LinkName") + End Sub + + '初始化 + Public Sub Reset() + Try + Setup.Reset("LinkAuto") + Setup.Reset("LinkName") + + Log("[Setup] 已初始化联机页设置") + Hint("已初始化联机页设置！", HintType.Finish, False) + Catch ex As Exception + Log(ex, "初始化联机页设置失败", LogLevel.Msgbox) + End Try + + Reload() + End Sub + + '将控件改变路由到设置改变 + Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckLinkAuto.Change + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) + End Sub + Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextLinkName.ValidatedTextChanged + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text) + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml new file mode 100644 index 0000000..496cc36 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml @@ -0,0 +1,158 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb new file mode 100644 index 0000000..22223a0 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb @@ -0,0 +1,251 @@ +Class PageSetupSystem + +#Region "语言" + 'Private Sub PageSetupUI_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + ' AniControlEnabled -= 1 + + ' '读取设置 + ' Select Case Lang + ' Case "zh_CN" + ' ComboLang.SelectedIndex = 0 + ' Case "zh_HK" + ' ComboLang.SelectedIndex = 1 + ' Case "en_US" + ' ComboLang.SelectedIndex = 2 + ' End Select + ' CheckDebug.Checked = ReadReg("SystemDebugMode", "False") + + ' AniControlEnabled += 1 + 'End Sub + + 'Private Sub RefreshLang() Handles ComboLang.SelectionChanged + ' If IsLoaded Then + ' If Not ComboLang.IsLoaded Then Exit Sub + ' Lang = CType(ComboLang.SelectedItem, MyComboBoxItem).Tag + ' Application.Current.Resources.MergedDictionaries(1) = New ResourceDictionary With {.Source = New Url("Languages\" & Lang & ".xaml", UrlKind.Relative)} + ' WriteReg("Lang", Lang) + ' End If + 'End Sub +#End Region + + Private Shadows IsLoaded As Boolean = False + + Private Sub PageSetupSystem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + + '重复加载部分 + PanBack.ScrollToHome() + +#If Not BETA Then + ItemSystemUpdateDownload.Content = "在有新版本时自动下载（更新快照版可能需要更新密钥）" +#End If + + '非重复加载部分 + If IsLoaded Then Exit Sub + IsLoaded = True + + AniControlEnabled += 1 + Reload() + SliderLoad() + AniControlEnabled -= 1 + + End Sub + Public Sub Reload() + + '下载 + SliderDownloadThread.Value = Setup.Get("ToolDownloadThread") + SliderDownloadSpeed.Value = Setup.Get("ToolDownloadSpeed") + ComboDownloadVersion.SelectedIndex = Setup.Get("ToolDownloadVersion") + ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate") + + 'Minecraft 更新提示 + CheckUpdateRelease.Checked = Setup.Get("ToolUpdateRelease") + CheckUpdateSnapshot.Checked = Setup.Get("ToolUpdateSnapshot") + + '辅助设置 + CheckHelpChinese.Checked = Setup.Get("ToolHelpChinese") + + '系统设置 + ComboSystemUpdate.SelectedIndex = Setup.Get("SystemSystemUpdate") + ComboSystemActivity.SelectedIndex = Setup.Get("SystemSystemActivity") + TextSystemCache.Text = Setup.Get("SystemSystemCache") + + '调试选项 + CheckDebugMode.Checked = Setup.Get("SystemDebugMode") + SliderDebugAnim.Value = Setup.Get("SystemDebugAnim") + CheckDebugDelay.Checked = Setup.Get("SystemDebugDelay") + CheckDebugSkipCopy.Checked = Setup.Get("SystemDebugSkipCopy") + + End Sub + + '初始化 + Public Sub Reset() + Try + Setup.Reset("ToolDownloadThread") + Setup.Reset("ToolDownloadSpeed") + Setup.Reset("ToolDownloadVersion") + Setup.Reset("ToolDownloadTranslate") + Setup.Reset("ToolUpdateRelease") + Setup.Reset("ToolUpdateSnapshot") + Setup.Reset("ToolHelpChinese") + Setup.Reset("SystemDebugMode") + Setup.Reset("SystemDebugAnim") + Setup.Reset("SystemDebugDelay") + Setup.Reset("SystemDebugSkipCopy") + Setup.Reset("SystemSystemCache") + Setup.Reset("SystemSystemUpdate") + Setup.Reset("SystemSystemActivity") + + Log("[Setup] 已初始化启动器页设置") + Hint("已初始化启动器页设置！", HintType.Finish, False) + Catch ex As Exception + Log(ex, "初始化启动器页设置失败", LogLevel.Msgbox) + End Try + + Reload() + End Sub + + '将控件改变路由到设置改变 + Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckDebugMode.Change, CheckDebugDelay.Change, CheckDebugSkipCopy.Change, CheckUpdateRelease.Change, CheckUpdateSnapshot.Change, CheckHelpChinese.Change + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) + End Sub + Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value) + End Sub + Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboDownloadTranslate.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) + End Sub + Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text) + End Sub + + '滑动条 + Private Sub SliderLoad() + SliderDownloadThread.GetHintText = Function(Value As Integer) + Return Value + 1 + End Function + SliderDownloadSpeed.GetHintText = Function(Value As Integer) + If Value <= 14 Then + Return (Value + 1) * 0.1 & " M/s" + ElseIf Value <= 31 Then + Return (Value - 11) * 0.5 & " M/s" + ElseIf Value <= 41 Then + Return (Value - 21) & " M/s" + Else + Return "无限制" + End If + End Function + SliderDebugAnim.GetHintText = Function(Value As Integer) + Return If(Value > 29, "关闭", (Value / 10 + 0.1) & "x") + End Function + End Sub + Private Sub SliderDownloadThread_PreviewChange(sender As Object, e As RouteEventArgs) Handles SliderDownloadThread.PreviewChange + If SliderDownloadThread.Value < 100 Then Exit Sub + If Not Setup.Get("HintDownloadThread") Then + Setup.Set("HintDownloadThread", True) + MyMsgBox("如果设置过多的下载线程，可能会导致下载时出现非常严重的卡顿。" & vbCrLf & + "一般设置 64 线程即可满足大多数下载需求，除非你知道你在干什么，否则不建议设置更多的线程数！", "警告", "我知道了", IsWarn:=True) + End If + End Sub + + '调试模式 + Private Sub CheckDebugMode_Change() Handles CheckDebugMode.Change + If AniControlEnabled = 0 Then Hint("部分调试信息将在刷新或启动器重启后切换显示！",, False) + End Sub + + '清理缓存 + Private IsClearingCache As Boolean = False + Private Sub BtnSystemCacheClear_Click(sender As Object, e As EventArgs) Handles BtnSystemCacheClear.Click + If HasDownloadingTask() Then + Hint("请在所有下载任务完成后再清理缓存！", HintType.Critical) + Exit Sub + End If + If MyMsgBox("你确定要清理缓存吗？" & vbCrLf & "在清理缓存后，PCL2 会被强制关闭，以避免缓存缺失带来的异常。", "清理缓存", "确定", "取消") = 2 Then + Exit Sub + End If + If IsClearingCache Then Exit Sub + IsClearingCache = True + Try + Dim TotalSize As ULong = DeleteCacheDirectory(PathTemp) + If TotalSize <= 0 Then + Hint("没有可清理的缓存！") + Else + MyMsgBox("已清理 " & GetString(TotalSize) & " 缓存！" & vbCrLf & "PCL2 即将自动关闭。", "缓存已清理", ForceWait:=True) + FrmMain.EndProgram(False) + End If + Catch ex As Exception + Log(ex, "清理缓存失败", LogLevel.Hint) + Finally + IsClearingCache = False + End Try + End Sub + Private Function DeleteCacheDirectory(Path As String, Optional TotalSize As ULong = 0) As ULong + If Not Directory.Exists(Path) Then Return TotalSize + Dim Temp As String() + Temp = Directory.GetFiles(Path) + For Each str As String In Temp + If str = PathTemp & "CustomSkin.png" Then Continue For '不删除自定义皮肤 + Try + Dim Info As New FileInfo(str) + Dim FileActualSize = Math.Ceiling(Info.Length / 4096) * 4096 + Info.Delete() + TotalSize += FileActualSize + Catch ex As Exception + Log(ex, "删除失败的缓存文件（" & str & "）") + End Try + Next + Temp = Directory.GetDirectories(Path) + For Each str As String In Temp + TotalSize += DeleteCacheDirectory(str) + Next + Return TotalSize + End Function + + '自动更新 + Private Sub ComboSystemActivity_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemActivity.SelectionChanged + If AniControlEnabled <> 0 Then Exit Sub + If ComboSystemActivity.SelectedIndex = 2 Then + If MyMsgBox("若选择此项，即使在将来出现严重问题时，你也无法获取相关通知。" & vbCrLf & + "例如，如果发现某个版本游戏存在严重 Bug，你可能就会因为无法得到通知而导致无法预知的后果。" & vbCrLf & vbCrLf & + "一般选择 仅在有重要通知时显示公告 就可以让你尽量不受打扰了。" & vbCrLf & + "除非你在制作服务器整合包，或时常手动更新启动器，否则极度不推荐选择此项！", "警告", "继续", "取消") = 2 Then + ComboSystemActivity.SelectedItem = e.RemovedItems(0) + End If + End If + End Sub + Private Sub ComboSystemUpdate_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemUpdate.SelectionChanged + If AniControlEnabled <> 0 Then Exit Sub + If ComboSystemUpdate.SelectedIndex = 3 Then + If MyMsgBox("若选择此项，即使在启动器将来出现严重问题时，你也无法获取更新并获得修复。" & vbCrLf & + "例如，如果官方修改了登录方式，从而导致现有启动器无法登录，你可能就会因为无法更新而无法开始游戏。" & vbCrLf & vbCrLf & + "一般选择 仅在有重大漏洞更新时显示提示 就可以让你尽量不受打扰了。" & vbCrLf & + "除非你在制作服务器整合包，或时常手动更新启动器，否则极度不推荐选择此项！", "警告", "继续", "取消") = 2 Then + ComboSystemUpdate.SelectedItem = e.RemovedItems(0) + End If + End If + End Sub + Private Sub BtnSystemUpdate_Click(sender As Object, e As EventArgs) Handles BtnSystemUpdate.Click + UpdateCheckByButton() + End Sub + ''' + ''' 启动器是否已经是最新版？ + ''' 若返回 Nothing，则代表无更新缓存文件或出错。 + ''' + Public Shared Function IsLauncherNewest() As Boolean? + Try + '确认服务器公告是否正常 + Dim ServerContent As String = ReadFile(PathTemp & "Cache\Notice.cfg") + If ServerContent.Split("|").Count < 3 Then Return Nothing + '确认是否为最新 +#If BETA Then + Dim NewVersionCode As Integer = ServerContent.Split("|")(2) +#Else + Dim NewVersionCode As Integer = ServerContent.Split("|")(1) +#End If + Return NewVersionCode <= VersionCode + Catch ex As Exception + Log(ex, "确认启动器更新失败", LogLevel.Feedback) + Return Nothing + End Try + End Function + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml b/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml new file mode 100644 index 0000000..39702b1 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb new file mode 100644 index 0000000..c2042ee --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb @@ -0,0 +1,235 @@ +Public Class PageSpeedLeft + Private Const WatcherInterval As Integer = 300 + + '初始化 + Private IsLoad As Boolean = False + Private Sub Page_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + + '进入时就刷新一次显示 + Watcher() + + '如果在页面切换动画的 “上一页消失” 部分已经完成了下载，就直接尝试返回 + TryReturnToHome() + + If IsLoad Then Exit Sub + IsLoad = True + + '监控定时器 + Dim timer As New Threading.DispatcherTimer With {.Interval = New TimeSpan(0, 0, 0, 0, WatcherInterval)} + AddHandler timer.Tick, AddressOf Watcher + timer.Start() + + '非调试模式隐藏线程数 + If Not ModeDebug Then + RowDefinitions(12).Height = New GridLength(0) + RowDefinitions(13).Height = New GridLength(0) + RowDefinitions(14).Height = New GridLength(0) + RowDefinitions(15).Height = New GridLength(0) + End If + + End Sub + + '定时器任务 + Private ReadOnly RightCards As New Dictionary(Of String, MyCard) + Private Sub Watcher() + If Not FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then Exit Sub + Try + +#Region "更新左边栏" + If LoaderTaskbar.Count = 0 Then + '无任务 + LabProgress.Text = "100 %" + LabSpeed.Text = "0 B/s" + LabFile.Text = "0" + LabThread.Text = "0 / " & NetTaskThreadLimit + Else + '有任务，输出基本信息 + Dim RawPercent As Double = LoaderTaskbarProgress + Dim PredictText As String = Math.Floor(RawPercent * 100) & "." & StrFill(Math.Floor((RawPercent * 100 - Math.Floor(RawPercent * 100)) * 100), "0", 2) & " %" + LabProgress.Text = If(RawPercent > 0.999999, "100 %", PredictText) + LabSpeed.Text = GetString(NetManager.Speed) & "/s" + LabFile.Text = If(NetManager.FileRemain < 0, "0*", NetManager.FileRemain) + LabThread.Text = NetTaskThreadCount & " / " & NetTaskThreadLimit + End If +#End Region + + Catch ex As Exception + Log(ex, "下载管理左栏监视出错", LogLevel.Feedback) + End Try + If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub + Try + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + TaskRefresh(LoaderTaskbar(i)) + Next + End SyncLock + Catch ex As Exception + Log(ex, "下载管理右栏监视出错", LogLevel.Feedback) + End Try + End Sub + Public Sub TaskRefresh(Loader As LoaderBase) + If Loader Is Nothing OrElse Not Loader.Show Then Exit Sub + Try + '获取实际加载器列表 + Dim LoaderList As List(Of LoaderBase) = CType(Loader, Object).GetLoaderList() + If RightCards.ContainsKey(Loader.Name) Then + '已有此卡片 + Dim Card As Grid = RightCards(Loader.Name) + Dim NewValue As Double = Loader.Progress + Loader.State + If Val(Card.Tag) = NewValue Then Exit Sub + Card.Tag = NewValue + If Card.Children.Count <= 3 Then + Log("[Watcher] 元素不足的卡片：" & Loader.Name, LogLevel.Debug) + Exit Sub + End If + Card = Card.Children(3) + Try + Select Case Loader.State + Case LoadState.Failed +#Region "失败，更新卡片" + Card.RowDefinitions.Clear() + Card.Children.Clear() + Card.Children.Add(GetObjectFromXML("")) + Dim Tb As TextBlock = GetObjectFromXML("") + Tb.Text = GetString(Loader.Error, False) + AddHandler Tb.MouseDown, Sub(sender As TextBlock, e As EventArgs) + ClipboardSet(sender.Text, False) + Hint("已复制错误详情！", HintType.Finish) + End Sub + Card.Children.Add(Tb) + ''删除取消按钮 + 'For Each Element As FrameworkElement In CType(Card.Parent, Panel).Children + ' If Element.Name = "BtnCancel" Then AniDispose(CType(Element, MyIconButton), True) + 'Next +#End Region + Case LoadState.Finished +#Region "完成，销毁卡片并返回" + AniDispose(CType(Card.Parent, MyCard), True, AddressOf TryReturnToHome) +#End Region + Case LoadState.Loading, LoadState.Waiting +#Region "进度不同，更新卡片" + Try + If Card.Children.Count < LoaderList.Count * 2 Then + Log("刷新下载管理卡片失败：卡片中仅有 " & Card.Children.Count & " 个子项", LogLevel.Debug) + Exit Try + End If + Dim Row As Integer = 0 + For Each SubTask In LoaderList + Select Case SubTask.State + Case LoadState.Waiting + If CType(Card.Children(Row * 2), FrameworkElement).Tag <> "Waiting" Then + Card.Children.RemoveAt(Row * 2) + Card.Children.Insert(Row * 2, GetObjectFromXML("")) + End If + Case LoadState.Loading + If CType(Card.Children(Row * 2), FrameworkElement).Tag <> "Loading" Then + Card.Children.RemoveAt(Row * 2) + Card.Children.Insert(Row * 2, GetObjectFromXML("")) + Else + CType(Card.Children(Row * 2), TextBlock).Text = Math.Floor(SubTask.Progress * 100) & "%" + End If + Case LoadState.Finished + If CType(Card.Children(Row * 2), FrameworkElement).Tag <> "Finished" Then + Card.Children.RemoveAt(Row * 2) + Card.Children.Insert(Row * 2, GetObjectFromXML("")) + End If + End Select + Row += 1 + Next + Catch ex As Exception + Log(ex, "刷新下载管理卡片失败", LogLevel.Feedback) + End Try +#End Region + End Select + Catch ex As Exception + Log(ex, "更新下载管理显示失败（" & Loader.State.ToString & "）", LogLevel.Feedback) + End Try + ElseIf Not (Loader.State = LoadState.Aborted OrElse Loader.State = LoadState.Finished) Then + Try +#Region "没有卡片且未中断或完成，添加新的卡片" + Dim CardXAML As String = " + + + + + + + " + For Each SubTask In LoaderList + CardXAML += "" + Next + CardXAML += "" + Dim Row As Integer = 0 + For Each SubTask In LoaderList + Select Case SubTask.State + Case LoadState.Waiting + CardXAML += "" + Case LoadState.Loading + CardXAML += "" + Case LoadState.Finished + CardXAML += "" + Case Else + CardXAML += "" + End Select + CardXAML += "" + Row += 1 + Next + CardXAML += " + + " + '实例化控件 + Dim Card As MyCard + Try + Card = GetObjectFromXML(CardXAML) + Catch ex As Exception + Log(ex, "新建下载管理卡片失败") + Log("出错的卡片内容：" & vbCrLf & CardXAML) + Throw + End Try + FrmSpeedRight.PanMain.Children.Insert(0, Card) + RightCards.Add(Loader.Name, Card) + '添加取消按钮 + Dim Cancel As New MyIconButton With {.Name = "BtnCancel", .Logo = "F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z", .Height = 20, .Margin = New Thickness(0, 10, 10, 0), .LogoScale = 1.1, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Top} + Card.Children.Add(Cancel) + AddHandler Cancel.Click, Sub(sender As MyIconButton, e As EventArgs) + AniDispose(sender, False) + AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack()) + RightCards.Remove(Loader.Name) + RunInThread(Sub() Loader.Abort()) + End Sub + '如果已经失败，再刷新一次，修改成失败的控件 + If Loader.State = LoadState.Failed Then + Card.Tag = Nothing '避免重复导致刷新无效 + TaskRefresh(Loader) + End If +#End Region + Catch ex As Exception + Log(ex, "添加下载管理卡片失败", LogLevel.Feedback) + End Try + End If + Catch ex As Exception + Log(ex, "刷新下载管理显示失败", LogLevel.Feedback) + End Try + End Sub + Public Sub TaskRemove(Loader As Object) + If RightCards.ContainsKey(Loader.Name) Then + RunInUiWait(Sub() + '移除已有的卡片 + Dim Card As Grid = RightCards(Loader.Name) + FrmSpeedRight.PanMain.Children.Remove(Card) + RightCards.Remove(Loader.Name) + End Sub) + End If + End Sub + + ''' + ''' 若没有任务，尝试返回主页。 + ''' + Private Sub TryReturnToHome() + If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then + FrmMain.PageBack() + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageSpeedRight.xaml b/Plain Craft Launcher 2/Pages/PageSpeedRight.xaml new file mode 100644 index 0000000..70040ba --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSpeedRight.xaml @@ -0,0 +1,40 @@ + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageSpeedRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageSpeedRight.xaml.vb new file mode 100644 index 0000000..ffd3ef9 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageSpeedRight.xaml.vb @@ -0,0 +1,7 @@ +Class PageSpeedRight + + Private Sub Init() Handles Me.Loaded + PanBack.ScrollToHome() + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml new file mode 100644 index 0000000..d641e9d --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb new file mode 100644 index 0000000..afcd0bc --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb @@ -0,0 +1,102 @@ +Public Class PageVersionLeft + + ''' + ''' 当前显示设置的 MC 版本。 + ''' + Public Shared Version As McVersion + + Private Sub PageVersionLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + If Version IsNot Nothing AndAlso Version.Version.Modable Then + ItemMod.Visibility = Visibility.Visible + ItemModDisabled.Visibility = Visibility.Collapsed + Else + ItemMod.Visibility = Visibility.Collapsed + ItemModDisabled.Visibility = Visibility.Visible + End If + End Sub + +#Region "页面切换" + + ''' + ''' 当前页面的编号。从 0 开始计算。 + ''' + Public PageID As FormMain.PageSubType = FormMain.PageSubType.Default + + ''' + ''' 勾选事件改变页面。 + ''' + Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemOverall.Check, ItemMod.Check, ItemModDisabled.Check, ItemSetup.Check + '尚未初始化控件属性时，sender.Tag 为 Nothing，会导致切换到页面 0 + '若使用 IsLoaded，则会导致模拟点击不被执行（模拟点击切换页面时，控件的 IsLoaded 为 False） + If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) + End Sub + + Public Function PageGet(Optional ID As FormMain.PageSubType = -1) + If ID = -1 Then ID = PageID + Select Case ID + Case FormMain.PageSubType.VersionOverall + If FrmVersionOverall Is Nothing Then FrmVersionOverall = New PageVersionOverall + Return FrmVersionOverall + Case FormMain.PageSubType.VersionMod + If FrmVersionMod Is Nothing Then FrmVersionMod = New PageVersionMod + Return FrmVersionMod + Case FormMain.PageSubType.VersionModDisabled + If FrmVersionModDisabled Is Nothing Then FrmVersionModDisabled = New PageVersionModDisabled + Return FrmVersionModDisabled + Case FormMain.PageSubType.VersionSetup + If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup + Return FrmVersionSetup + Case Else + Throw New Exception("未知的版本设置子页面种类：" & ID) + End Select + End Function + + ''' + ''' 切换现有页面。 + ''' + Public Sub PageChange(ID As FormMain.PageSubType) + If PageID = ID Then Exit Sub + AniControlEnabled += 1 + Try + PageChangeRun(PageGet(ID)) + PageID = ID + Catch ex As Exception + Log(ex, "切换设置分页面失败（ID " & ID & "）", LogLevel.Feedback) + Finally + AniControlEnabled -= 1 + End Try + End Sub + Private Shared Sub PageChangeRun(Target As MyPageRight) + AniStop("FrmMain PageChangeRight") '停止主页面的右页面切换动画，防止它与本动画一起触发多次 PageOnEnter + If Target.Parent IsNot Nothing Then Target.SetValue(ContentPresenter.ContentProperty, Nothing) + FrmMain.PageRight = Target + CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnExit() + AniStart({ + AaCode(Sub() + CType(FrmMain.PanMainRight.Child, MyPageRight).PageOnForceExit() + FrmMain.PanMainRight.Child = FrmMain.PageRight + FrmMain.PageRight.Opacity = 0 + End Sub, 130), + AaCode(Sub() + '延迟触发页面通用动画，以使得在 Loaded 事件中加载的控件得以处理 + FrmMain.PageRight.Opacity = 1 + FrmMain.PageRight.PageOnEnter() + End Sub, 30, True) + }, "PageLeft PageChange") + End Sub + +#End Region + + Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用 + '强制刷新 + If FrmVersionMod IsNot Nothing Then FrmVersionMod.RefreshList(True) '没有 Else，还没加载刷个鬼的新 + End Sub + + Public Sub Reset(sender As Object, e As EventArgs) + If MyMsgBox("是否要初始化该版本的版本独立设置？该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then + If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup + FrmVersionSetup.Reset() + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml new file mode 100644 index 0000000..f9e79e9 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb new file mode 100644 index 0000000..2152b27 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb @@ -0,0 +1,475 @@ +Public Class PageVersionMod + +#Region "初始化" + + Private IsLoad As Boolean = False + Public Sub PageOther_Loaded() Handles Me.Loaded + + PanBack.ScrollToHome() + RefreshList() + + '非重复加载部分 + If IsLoad Then Exit Sub + IsLoad = True + +#If DEBUG Then + BtnManageCheck.Visibility = Visibility.Visible +#End If + + End Sub + ''' + ''' 刷新 Mod 列表。 + ''' + Public Sub RefreshList(Optional ForceReload As Boolean = False) + If McModLoader.State = LoadState.Loading Then Exit Sub + If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then + PanBack.ScrollToHome() + SearchBox.Text = "" + End If + End Sub + + Private Sub LoaderInit() Handles Me.Initialized + PageLoaderInit(Load, PanLoad, PanAllBack, Nothing, McModLoader, AddressOf Load_Finish, AutoRun:=False) + End Sub + Private Sub Load_Click(sender As Object, e As MouseButtonEventArgs) Handles Load.Click + If McModLoader.State = LoadState.Failed Then + LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.ForceRun) + End If + End Sub + +#End Region + +#Region "UI 化" + + ''' + ''' 将 Mod 列表加载为 UI。 + ''' + Private Sub Load_Finish(Loader As LoaderTask(Of String, List(Of McMod))) + Dim List As List(Of McMod) = Loader.Output + Try + PanList.Children.Clear() + + '判断应该显示哪一个页面 + If List.Count = 0 Then + PanEmpty.Visibility = Visibility.Visible + PanBack.Visibility = Visibility.Collapsed + Exit Sub + Else + PanBack.Visibility = Visibility.Visible + PanEmpty.Visibility = Visibility.Collapsed + End If + + '建立 StackPanel + Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, If(List.Count > 0, 20, 0)), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0)} + For Each ModEntity As McMod In List + NewStack.Children.Add(McModListItem(ModEntity)) + Next + '建立 MyCard + Dim NewCard As New MyCard With {.Title = McModGetTitle(List), .Margin = New Thickness(0, 0, 0, 15)} + NewCard.Children.Add(NewStack) + PanList.Children.Add(NewCard) + '显示提示 + If List.Count > 0 AndAlso Not Setup.Get("HintModDisable") Then + Setup.Set("HintModDisable", True) + Hint("直接点击某个 Mod 项即可将它禁用！") + End If + + Catch ex As Exception + Log(ex, "加载 Mod 列表 UI 失败", LogLevel.Feedback) + End Try + End Sub + ''' + ''' 获取 Card 的标题。 + ''' + Private Function McModGetTitle(List As List(Of McMod)) As String + Dim Counter = {0, 0, 0} + For Each ModEntity As McMod In List + Counter(ModEntity.State) += 1 + Next + If List.Count = 0 Then + '全空 + Return "未找到任何 Mod" + ElseIf Counter(McMod.McModState.Disabled) = 0 AndAlso Counter(McMod.McModState.Unavaliable) = 0 Then + '只有启用的 Mod + Return "Mod 列表（" & Counter(McMod.McModState.Fine) & "）" + Else + '混合种类 + Dim TypeList As New List(Of String) + If Counter(McMod.McModState.Fine) > 0 Then TypeList.Add("启用 " & Counter(McMod.McModState.Fine)) + If Counter(McMod.McModState.Disabled) > 0 Then TypeList.Add("禁用 " & Counter(McMod.McModState.Disabled)) + If Counter(McMod.McModState.Unavaliable) > 0 Then TypeList.Add("错误 " & Counter(McMod.McModState.Unavaliable)) + Return "Mod 列表（" & Join(TypeList, "，") & "）" + End If + End Function + Private Function McModListItem(Entry As McMod) As MyListItem + '图标 + Dim Logo As String + Select Case Entry.State + Case McMod.McModState.Fine + Logo = "pack://application:,,,/images/Blocks/RedstoneLampOn.png" + Case McMod.McModState.Disabled + Logo = "pack://application:,,,/images/Blocks/RedstoneLampOff.png" + Case Else '出错 + Logo = "pack://application:,,,/images/Blocks/RedstoneBlock.png" + End Select + '文本 + Dim Title As String + If Entry.State = McMod.McModState.Disabled Then + Title = GetFileNameWithoutExtentionFromPath(Entry.Path.Substring(0, Entry.Path.Count - ".disabled".Count)) & "（已禁用）" + Else + Title = GetFileNameWithoutExtentionFromPath(Entry.Path) + End If + Dim Desc As String + If Entry.Version Is Nothing OrElse Entry.Description IsNot Nothing Then + Desc = Entry.Name & If(Entry.Version Is Nothing, "", " (" & Entry.Version & ")") & " : " & If(Entry.Description, Entry.Path) + ElseIf Entry.IsFileAvailable Then + Desc = Entry.Path + Else + Desc = "存在错误 : " & Entry.Path + End If + 'Desc = If(Entry.ModId, "无可用名称") & " (" & If(Entry.Version, "无可用版本") & ")" + 'If Entry.Dependencies.Count > 0 Then + ' Dim DepList As New List(Of String) + ' For Each Dep In Entry.Dependencies + ' DepList.Add(Dep.Key & If(Dep.Value Is Nothing, "", "@" & Dep.Value)) + ' Next + ' Desc += " : " & Join(DepList, ", ") + 'End If + '实例化 + Dim NewItem As New MyListItem With {.Logo = Logo, .SnapsToDevicePixels = True, .Title = Title, .Info = Desc, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry} + NewItem.PaddingRight = If(Entry.IsFileAvailable, 73, 55) + '事件 + NewItem.ContentHandler = AddressOf McModContent + Return NewItem + End Function + Private Sub McModContent(sender As MyListItem, e As EventArgs) + Dim ModEntity As McMod = sender.Tag + '注册点击事件 + AddHandler sender.Click, AddressOf Item_Click + '图标按钮 + Dim BtnDel As New MyIconButton With {.LogoScale = 1.1, .Logo = Logo.IconButtonDelete, .Tag = sender} + BtnDel.ToolTip = "删除" + ToolTipService.SetPlacement(BtnDel, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnDel, 30) + ToolTipService.SetHorizontalOffset(BtnDel, 2) + AddHandler BtnDel.Click, AddressOf Delete_Click + Dim BtnOpen As New MyIconButton With {.LogoScale = 1.15, .Logo = Logo.IconButtonOpen, .Tag = sender} + BtnOpen.ToolTip = "打开文件位置" + ToolTipService.SetPlacement(BtnOpen, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnOpen, 30) + ToolTipService.SetHorizontalOffset(BtnOpen, 2) + AddHandler BtnOpen.Click, AddressOf Open_Click + If ModEntity.IsFileAvailable Then + Dim BtnCont As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .Tag = sender} + BtnCont.ToolTip = "详情" + ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center) + ToolTipService.SetVerticalOffset(BtnCont, 30) + ToolTipService.SetHorizontalOffset(BtnCont, 2) + AddHandler BtnCont.Click, AddressOf Info_Click + AddHandler sender.MouseRightButtonDown, AddressOf Info_Click + sender.Buttons = {BtnCont, BtnOpen, BtnDel} + Else + sender.Buttons = {BtnOpen, BtnDel} + End If + End Sub + +#End Region + +#Region "管理" + + ''' + ''' 打开 Mods 文件夹。 + ''' + Private Sub BtnManageOpen_Click(sender As Object, e As EventArgs) Handles BtnManageOpen.Click, BtnHintOpen.Click + Try + Directory.CreateDirectory(PageVersionLeft.Version.PathIndie & "mods\") + OpenExplorer("""" & PageVersionLeft.Version.PathIndie & "mods\""") + Catch ex As Exception + Log(ex, "打开 Mods 文件夹失败", LogLevel.Msgbox) + End Try + End Sub + +#If DEBUG Then + ''' + ''' 检查 Mod。 + ''' + Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click + Try + Dim Result = McModCheck(PageVersionLeft.Version, McModLoader.Output) + If Result.Count > 0 Then + MyMsgBox(Join(Result, vbCrLf & vbCrLf), "Mod 检查结果") + Else + Hint("Mod 检查完成，未发现任何问题！", HintType.Finish) + End If + Catch ex As Exception + Log(ex, "进行 Mod 检查时出错", LogLevel.Feedback) + End Try + End Sub +#End If + + ''' + ''' 一键启用 / 禁用。 + ''' + Private Sub BtnManageChange_Click(sender As MyButton, e As EventArgs) Handles BtnManageEnabled.Click, BtnManageDisabled.Click + Dim IsSuccessful As Boolean = True + Try + Dim IsDisable As Boolean = sender.Text.Contains("禁用") + For Each ModEntity In McModLoader.Output + Dim NewPath As String = Nothing + If ModEntity.State = McMod.McModState.Fine And IsDisable Then + '禁用 + NewPath = ModEntity.Path & ".disabled" + ElseIf ModEntity.State = McMod.McModState.Disabled AndAlso Not IsDisable Then + '启用 + NewPath = ModEntity.Path.Substring(0, ModEntity.Path.Count - ".disabled".Count) + Else + Continue For + End If + '重命名 + Try + If File.Exists(ModEntity.Path) Then + File.Delete(NewPath) + FileSystem.Rename(ModEntity.Path, NewPath) + Else + Throw New FileNotFoundException("未找到文件：" & ModEntity.Path) + End If + Catch ex As Exception + Log(ex, "全局状态改变中重命名 Mod 失败") + IsSuccessful = False + End Try + Next + Catch ex As Exception + Log(ex, "改变全部 Mod 状态失败", LogLevel.Msgbox) + IsSuccessful = False + Finally + If Not IsSuccessful Then Hint("由于文件被占用，部分 Mod 的状态切换失败，请尝试关闭正在运行的游戏后再试！", HintType.Critical) + RefreshList() + End Try + End Sub + +#End Region + +#Region "单个 Mod 项" + + '点击：切换可用状态 / 显示错误原因 + Public Sub Item_Click(sender As MyListItem, e As EventArgs) + Try + + Dim ModEntity As McMod = sender.Tag + Dim NewPath As String = Nothing + Select Case ModEntity.State + Case McMod.McModState.Fine + '前置检测警告 + If ModEntity.IsPresetMod Then + If MyMsgBox("该 Mod 可能为其他 Mod 的前置，如果禁用可能导致其他 Mod 无法使用。" & vbCrLf & "你确定要继续禁用吗？", "警告", "禁用", "取消") = 2 Then Exit Sub + End If + NewPath = ModEntity.Path & ".disabled" + Case McMod.McModState.Disabled + NewPath = ModEntity.Path.Substring(0, ModEntity.Path.Count - ".disabled".Count) + Case McMod.McModState.Unavaliable + MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息：" & GetString(ModEntity.FileUnavailableReason, False), "Mod 读取失败") + Exit Sub + End Select + '重命名 + Dim NewModEntity As New McMod(NewPath) + Try + File.Delete(NewPath) + FileSystem.Rename(ModEntity.Path, NewPath) + Catch ex As FileNotFoundException + Log(ex, "未找到理应存在的 Mod 文件（" & ModEntity.Path & "）") + FileSystem.Rename(NewPath, ModEntity.Path) + NewModEntity = New McMod(ModEntity.Path) + End Try + '更改 Loader 中的列表 + Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity) + McModLoader.Output.RemoveAt(IndexOfLoader) + McModLoader.Output.Insert(IndexOfLoader, NewModEntity) + '更改 UI 中的列表 + Dim Parent As StackPanel = sender.Parent + Dim IndexOfUi As Integer = Parent.Children.IndexOf(sender) + Parent.Children.RemoveAt(IndexOfUi) + Parent.Children.Insert(IndexOfUi, McModListItem(NewModEntity)) + '仅在非搜索页面才执行，以确保搜索页内外显示一致 + If String.IsNullOrWhiteSpace(SearchBox.Text) Then + '改变禁用数量的显示 + CType(Parent.Parent, MyCard).Title = McModGetTitle(McModLoader.Output) + '更新加载器状态 + LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.UpdateOnly) + End If + + Catch ex As Exception + Log(ex, "单个状态改变中重命名 Mod 失败") + Hint("切换 Mod 状态失败，请尝试关闭正在运行的游戏后再试！") + LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.UpdateOnly) + End Try + End Sub + '删除 + Public Sub Delete_Click(sender As MyIconButton, e As EventArgs) + Try + + Dim ListItem As MyListItem = sender.Tag + Dim ModEntity As McMod = ListItem.Tag + '前置检测警告 + If ModEntity.IsPresetMod Then + If MyMsgBox("该 Mod 可能为其他 Mod 的前置，如果删除可能导致其他 Mod 无法使用。" & vbCrLf & "你确定要继续删除吗？", "警告", "删除", "取消", IsWarn:=True) = 2 Then Exit Sub + End If + '删除 + If File.Exists(ModEntity.Path) Then + My.Computer.FileSystem.DeleteFile(ModEntity.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin) + Else + '在不明原因下删除的文件可能还在列表里，如果玩家又点了一次就会出错，总之加个判断也不碍事 + Log("[System] 需要删除的 Mod 文件不存在（" & ModEntity.Path & "）", LogLevel.Hint) + Exit Sub + End If + '更改 Loader 中的列表 + McModLoader.Output.Remove(ModEntity) + '更改 UI 中的列表 + Dim Parent As StackPanel = ListItem.Parent + Parent.Children.Remove(ListItem) + If Parent.Children.Count = 0 Then + RefreshList(True) + Else + CType(Parent.Parent, MyCard).Title = McModGetTitle(McModLoader.Output) + End If + '显示提示 + Hint("已将 " & ModEntity.FileName & " 删除到回收站！", HintType.Finish) + LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.UpdateOnly) + + Catch ex As Exception + Log(ex, "删除 Mod 失败", LogLevel.Feedback) + End Try + End Sub + '详情 + Public Sub Info_Click(sender As Object, e As EventArgs) + Try + + Dim ListItem As MyListItem + ListItem = If(TypeOf sender Is MyIconButton, sender.Tag, sender) + Dim ModEntity As McMod = ListItem.Tag + '获取信息 + Dim ContentLines As New List(Of String) + If ModEntity.Description IsNot Nothing Then ContentLines.Add(ModEntity.Description & vbCrLf) + If ModEntity.Authors IsNot Nothing Then ContentLines.Add("作者：" & ModEntity.Authors) + ContentLines.Add("文件：" & ModEntity.FileName & "（" & GetString(New FileInfo(ModEntity.Path).Length) & "）") + If ModEntity.Version IsNot Nothing Then ContentLines.Add("版本：" & ModEntity.Version) + If ModeDebug Then + Dim DebugInfo As New List(Of String) + If ModEntity.ModId IsNot Nothing Then + DebugInfo.Add("Mod ID：" & ModEntity.ModId) + End If + If ModEntity.Dependencies.Count > 0 Then + DebugInfo.Add("依赖于：") + For Each Dep In ModEntity.Dependencies + DebugInfo.Add(" - " & Dep.Key & If(Dep.Value Is Nothing, "", "，版本：" & Dep.Value)) + Next + End If + If DebugInfo.Count > 0 Then + ContentLines.Add(vbCrLf & "—————— 调试信息 ——————") + ContentLines.AddRange(DebugInfo) + End If + End If + '获取用于搜索的 Mod 名称 + Dim ModOriginalName As String = ModEntity.Name.Replace(" ", "+") + Dim ModSearchName As String = ModOriginalName.Substring(0, 1) + For i = 1 To ModOriginalName.Count - 1 + Dim IsLastLower As Boolean = ModOriginalName(i - 1).ToString.ToLower.Equals(ModOriginalName(i - 1).ToString) + Dim IsCurrentLower As Boolean = ModOriginalName(i).ToString.ToLower.Equals(ModOriginalName(i).ToString) + If IsLastLower AndAlso Not IsCurrentLower Then + '上一个字母为小写，这一个字母为大写 + ModSearchName += "+" + End If + ModSearchName += ModOriginalName(i) + Next + ModSearchName = ModSearchName.Replace("++", "+").Replace("pti+Fine", "ptiFine") + '显示 + If ModEntity.Url Is Nothing Then + If MyMsgBox(Join(ContentLines, vbCrLf), ModEntity.Name, "确定", "百科搜索") = 2 Then + OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0") + End If + Else + Select Case MyMsgBox(Join(ContentLines, vbCrLf), ModEntity.Name, "确定", "百科搜索", "打开官网") + Case 2 + OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0") + Case 3 + OpenWebsite(ModEntity.Url) + End Select + End If + + Catch ex As Exception + Log(ex, "获取 Mod 详情失败", LogLevel.Feedback) + End Try + End Sub + '打开文件所在的位置 + Public Sub Open_Click(sender As MyIconButton, e As EventArgs) + Try + + Dim ListItem As MyListItem = sender.Tag + Dim ModEntity As McMod = ListItem.Tag + OpenExplorer("/select,""" & ModEntity.Path & """") + + Catch ex As Exception + Log(ex, "打开 Mod 文件位置失败", LogLevel.Feedback) + End Try + End Sub + +#End Region + + Public Sub SearchRun() Handles SearchBox.TextChanged + If String.IsNullOrWhiteSpace(SearchBox.Text) Then + '隐藏 + LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.RunOnUpdated) + AniStart({ + AaOpacity(PanSearch, -PanSearch.Opacity, 100), + AaCode(Sub() + PanSearch.Height = 0 + PanSearch.Visibility = Visibility.Collapsed + PanList.Visibility = Visibility.Visible + PanManage.Visibility = Visibility.Visible + End Sub,, True), + AaOpacity(PanList, 1 - PanList.Opacity, 150, 30), + AaOpacity(PanManage, 1 - PanManage.Opacity, 150, 30) + }, "FrmVersionMod Search Switch", True) + Else + '构造请求 + Dim QueryList As New List(Of SearchEntry(Of McMod)) + For Each Entry As McMod In McModLoader.Output + QueryList.Add(New SearchEntry(Of McMod) With { + .Item = Entry, + .SearchSource = New List(Of KeyValuePair(Of String, Double)) From { + New KeyValuePair(Of String, Double)(Entry.Name, 1), + New KeyValuePair(Of String, Double)(Entry.FileName, 1), + New KeyValuePair(Of String, Double)(If(Entry.Description, ""), 0.5) + } + }) + Next + '进行搜索，构造列表 + Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=5, MinBlurSimilarity:=0.35) + PanSearchList.Children.Clear() + If SearchResult.Count = 0 Then + PanSearch.Title = "无搜索结果" + PanSearchList.Visibility = Visibility.Collapsed + Else + PanSearch.Title = "搜索结果" + For Each Result In SearchResult + Dim Item = McModListItem(Result.Item) + If ModeDebug Then Item.Info = If(Result.AbsoluteRight, "完全匹配，", "") & "相似度：" & Math.Round(Result.Similarity, 3) & "，" & Item.Info + PanSearchList.Children.Add(Item) + Next + PanSearchList.Visibility = Visibility.Visible + End If + '显示 + AniStart({ + AaOpacity(PanList, -PanList.Opacity, 100), + AaOpacity(PanManage, -PanManage.Opacity, 100), + AaCode(Sub() + PanList.Visibility = Visibility.Collapsed + PanManage.Visibility = Visibility.Collapsed + PanSearch.Visibility = Visibility.Visible + PanSearch.TriggerForceResize() + End Sub,, True), + AaOpacity(PanSearch, 1 - PanSearch.Opacity, 200, 60) + }, "FrmVersionMod Search Switch", True) + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionModDisabled.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionModDisabled.xaml new file mode 100644 index 0000000..497445a --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionModDisabled.xaml @@ -0,0 +1,30 @@ + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionModDisabled.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionModDisabled.xaml.vb new file mode 100644 index 0000000..cfc9283 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionModDisabled.xaml.vb @@ -0,0 +1,19 @@ +Class PageVersionModDisabled + + Private Sub BtnDownload_Click(sender As Object, e As EventArgs) Handles BtnDownload.Click + FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall) + End Sub + Private Sub BtnVersion_Click(sender As Object, e As EventArgs) Handles BtnVersion.Click + FrmMain.PageChange(FormMain.PageType.Launch) '在版本选择页面选定版本的时候只会返回一层，因此如果不先锚定 Launch，在选择版本后会回退到版本设置的这个页面 + FrmMain.PageChange(FormMain.PageType.VersionSelect) + End Sub + + Public Sub BtnDownload_Loaded() Handles BtnDownload.Loaded + Dim NewVisibility = If((Setup.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse If(FrmSelectRight Is Nothing, False, FrmSelectRight.ShowHidden), Visibility.Collapsed, Visibility.Visible) + If BtnDownload.Visibility <> NewVisibility Then + BtnDownload.Visibility = NewVisibility + PanMain.TriggerForceResize() + End If + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml new file mode 100644 index 0000000..156a67a --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb new file mode 100644 index 0000000..6b7f211 --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb @@ -0,0 +1,281 @@ +Public Class PageVersionOverall + + Private IsLoad As Boolean = False + Private Sub PageSetupLaunch_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + + '重复加载部分 + PanBack.ScrollToHome() + + '更新设置 + ItemDisplayLogoCustom.Tag = "PCL\Logo.png" + Reload() + + '非重复加载部分 + If IsLoad Then Exit Sub + IsLoad = True + PanDisplay.TriggerForceResize() + + End Sub + + Public ItemVersion As MyListItem + ''' + ''' 确保当前页面上的信息已正确显示。 + ''' + Private Sub Reload() + AniControlEnabled += 1 + + '刷新设置项目 + ComboDisplayType.SelectedIndex = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto) + BtnDisplayStar.Text = If(PageVersionLeft.Version.IsStar, "从收藏夹中移除", "加入收藏夹") + '刷新版本显示 + PanDisplayItem.Children.Clear() + ItemVersion = PageSelectRight.McVersionListItem(PageVersionLeft.Version) + ItemVersion.IsHitTestVisible = False + PanDisplayItem.Children.Add(ItemVersion) + FrmMain.PageNameRefresh() + '刷新版本图标 + ComboDisplayLogo.SelectedIndex = 0 + Dim Logo As String = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "Logo", "") + Dim LogoCustom As Boolean = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "LogoCustom", "False") + If LogoCustom Then + For Each Selection As MyComboBoxItem In ComboDisplayLogo.Items + If Selection.Tag = Logo OrElse (Selection.Tag = "PCL\Logo.png" AndAlso Logo.EndsWith("PCL\Logo.png")) Then + ComboDisplayLogo.SelectedItem = Selection + Exit For + End If + Next + End If + + AniControlEnabled -= 1 + End Sub + +#Region "设置临时接口" + + '版本分类 + Private Sub ComboDisplayType_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboDisplayType.SelectionChanged + If Not (IsLoad AndAlso AniControlEnabled = 0) Then Exit Sub + If ComboDisplayType.SelectedIndex <> 1 Then + '改为不隐藏 + Try + WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", ComboDisplayType.SelectedIndex) + WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '要求刷新缓存 + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + Catch ex As Exception + Log(ex, "修改版本分类失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Feedback) + End Try + Else + '改为隐藏 + Try + If Not Setup.Get("HintHide") Then + If MyMsgBox("确认要从版本列表中隐藏该版本吗？隐藏该版本后，它将不再出现于 PCL 显示的版本列表中。" & vbCrLf & "此后，在版本列表页面按下 F11 才可以查看被隐藏的版本。", "隐藏版本提示",, "取消") <> 1 Then + ComboDisplayType.SelectedIndex = 0 + Exit Sub + End If + Setup.Set("HintHide", True) + End If + WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Hidden) + WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '要求刷新缓存 + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + Catch ex As Exception + Log(ex, "隐藏版本 " & PageVersionLeft.Version.Name & " 失败", LogLevel.Feedback) + End Try + End If + End Sub + '更改描述 + Private Sub BtnDisplayDesc_Click(sender As Object, e As EventArgs) Handles BtnDisplayDesc.Click + Try + Dim OldInfo As String = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "CustomInfo") + Dim NewInfo As String = MyMsgBoxInput(OldInfo, New ObjectModel.Collection(Of Validate), "留空即为使用默认描述", "更改描述",, "取消") + If NewInfo IsNot Nothing AndAlso OldInfo <> NewInfo Then WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "CustomInfo", NewInfo) + PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load() + Reload() + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + Catch ex As Exception + Log(ex, "版本 " & PageVersionLeft.Version.Name & " 描述更改失败", LogLevel.Msgbox) + End Try + End Sub + '重命名版本 + Private Sub BtnDisplayRename_Click(sender As Object, e As EventArgs) Handles BtnDisplayRename.Click + Try + '确认输入的新名称 + Dim OldName As String = PageVersionLeft.Version.Name + Dim OldPath As String = PageVersionLeft.Version.Path + '修改此部分的同时修改快速安装的版本名检测* + Dim NewName As String = MyMsgBoxInput(OldName, New ObjectModel.Collection(Of Validate) From {New ValidateFolderName(PathMcFolder & "versions", IgnoreCase:=False)},, "重命名版本",, "取消") + If String.IsNullOrWhiteSpace(NewName) Then Exit Sub + Dim NewPath As String = PathMcFolder & "versions\" & NewName & "\" + '获取临时中间名，以防止仅修改大小写的重命名失败 + Dim TempName As String = NewName & "_temp" + Dim TempPath As String = PathMcFolder & "versions\" & TempName & "\" + Dim IsCaseChangedOnly As Boolean = NewName.ToLower = OldName.ToLower + '重新加载版本 Json 信息，避免 HMCL 项被合并 + Dim JsonObject As JObject + Try + JsonObject = GetJson(ReadFile(PageVersionLeft.Version.Path & PageVersionLeft.Version.Name & ".json")) + Catch ex As Exception + Log(ex, "重命名读取 Json 时失败") + JsonObject = PageVersionLeft.Version.JsonObject + End Try + '重命名主文件夹 + My.Computer.FileSystem.RenameDirectory(OldPath, TempName) + My.Computer.FileSystem.RenameDirectory(TempPath, NewName) + '遍历重命名所有文件与文件夹 + For Each Entry As DirectoryInfo In New DirectoryInfo(NewPath).EnumerateDirectories + If Not Entry.Name.Contains(OldName) Then Continue For + If IsCaseChangedOnly Then + My.Computer.FileSystem.RenameDirectory(Entry.FullName, Entry.Name & "_temp") + My.Computer.FileSystem.RenameDirectory(Entry.FullName & "_temp", Entry.Name.Replace(OldName, NewName)) + Else + DeleteDirectory(NewPath & Entry.Name.Replace(OldName, NewName)) + My.Computer.FileSystem.RenameDirectory(Entry.FullName, Entry.Name.Replace(OldName, NewName)) + End If + Next + For Each Entry As FileInfo In New DirectoryInfo(NewPath).EnumerateFiles + If Not Entry.Name.Contains(OldName) Then Continue For + If IsCaseChangedOnly Then + My.Computer.FileSystem.RenameFile(Entry.FullName, Entry.Name & "_temp") + My.Computer.FileSystem.RenameFile(Entry.FullName & "_temp", Entry.Name.Replace(OldName, NewName)) + Else + If File.Exists(NewPath & Entry.Name.Replace(OldName, NewName)) Then File.Delete(NewPath & Entry.Name.Replace(OldName, NewName)) + My.Computer.FileSystem.RenameFile(Entry.FullName, Entry.Name.Replace(OldName, NewName)) + End If + Next + '替换版本设置文件中的路径 + If File.Exists(NewPath & "PCL\Setup.ini") Then + WriteFile(NewPath & "PCL\Setup.ini", ReadFile(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath)) + End If + '更改已选中的版本 + If ReadIni(PathMcFolder & "PCL.ini", "Version") = OldName Then + WriteIni(PathMcFolder & "PCL.ini", "Version", NewName) + End If + '更改版本 Json + If File.Exists(NewPath & NewName & ".json") Then + Try + JsonObject("id") = NewName + WriteFile(NewPath & NewName & ".json", JsonObject.ToString) + Catch ex As Exception + Log(ex, "重命名 Json 时失败") + End Try + End If + '刷新与提示 + Hint("重命名成功！", HintType.Finish) + PageVersionLeft.Version = New McVersion(NewName).Load() + If Not IsNothing(McVersionCurrent) AndAlso McVersionCurrent.Equals(PageVersionLeft.Version) Then WriteIni(PathMcFolder & "PCL.ini", "Version", NewName) + Reload() + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + Catch ex As Exception + Log(ex, "重命名版本失败", LogLevel.Msgbox) + End Try + End Sub + '收藏夹 + Private Sub BtnDisplayStar_Click(sender As Object, e As EventArgs) Handles BtnDisplayStar.Click + Try + WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "IsStar", Not PageVersionLeft.Version.IsStar) + PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load() + Reload() + McVersionListForceRefresh = True + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + Catch ex As Exception + Log(ex, "版本 " & PageVersionLeft.Version.Name & " 收藏状态更改失败", LogLevel.Msgbox) + End Try + End Sub + '补全文件 + Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click + Try + '重复任务检查 + SyncLock LoaderTaskbarLock + For i = 0 To LoaderTaskbar.Count - 1 + If LoaderTaskbar(i).Name = PageVersionLeft.Version.Name & " 文件补全" Then + Hint("正在处理中，请稍候！", HintType.Critical) + Exit Sub + End If + Next + End SyncLock + '启动 + Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False)) + Loader.OnStateChanged = Sub() + Select Case Loader.State + Case LoadState.Finished + Hint(Loader.Name & "成功！", HintType.Finish) + Case LoadState.Failed + Hint(Loader.Name & "失败：" & GetString(Loader.Error), HintType.Critical) + Case LoadState.Aborted + Hint(Loader.Name & "已取消！", HintType.Info) + End Select + End Sub + Loader.Start(PageVersionLeft.Version.Name) + LoaderTaskbarAdd(Loader) + FrmMain.BtnExtraDownload.ShowRefresh() + FrmMain.BtnExtraDownload.Ribble() + Catch ex As Exception + Log(ex, "尝试补全文件失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Msgbox) + End Try + End Sub + '删除版本 + Private Sub BtnManageDelete_Click(sender As Object, e As EventArgs) Handles BtnManageDelete.Click + '修改此代码时，同时修改 PageSelectRight 中的代码 + Try + Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder + Select Case MyMsgBox("你确定要删除版本 " & PageVersionLeft.Version.Name & " 吗？" & + If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""), + "版本删除确认", , "取消",, True) + Case 1 + FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin) + Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站！", HintType.Finish) + Case 2 + ' DeleteDirectory(PageVersionLeft.Version.Path) + ' Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除！", HintType.Finish) + 'Case 3 + Exit Sub + End Select + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + FrmMain.PageBack() + Catch ex As Exception + Log(ex, "删除版本 " & PageVersionLeft.Version.Name & " 失败", LogLevel.Msgbox) + End Try + End Sub + '打开版本文件夹 + Private Sub BtnManageFolder_Click() Handles BtnManageFolder.Click + OpenVersionFolder(PageVersionLeft.Version) + End Sub + Public Shared Sub OpenVersionFolder(Version As McVersion) + OpenExplorer("""" & Version.Path & """") + End Sub + '版本图标 + Private Sub ComboDisplayLogo_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboDisplayLogo.SelectionChanged + If Not (IsLoad AndAlso AniControlEnabled = 0) Then Exit Sub + '选择 自定义 时修改图片 + Try + If ComboDisplayLogo.SelectedItem Is ItemDisplayLogoCustom Then + Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.gif)|*.png;*.jpg;*.gif", "选择图片") + If FileName = "" Then + Reload() '还原选项 + Exit Sub + End If + File.Delete(PageVersionLeft.Version.Path & "PCL\Logo.png") + Directory.CreateDirectory(PageVersionLeft.Version.Path & "PCL") '虽然不知道为啥，有时候真没这文件夹 + File.Copy(FileName, PageVersionLeft.Version.Path & "PCL\Logo.png") + Else + File.Delete(PageVersionLeft.Version.Path & "PCL\Logo.png") + End If + Catch ex As Exception + Log(ex, "更改自定义版本图标失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Feedback) + End Try + '进行更改 + Try + Dim NewLogo As String = ComboDisplayLogo.SelectedItem.Tag + WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "Logo", NewLogo) + WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "LogoCustom", Not NewLogo = "") + '刷新显示 + WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '要求刷新缓存 + PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load() + Reload() + LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") + Catch ex As Exception + Log(ex, "更改版本图标失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Feedback) + End Try + End Sub + +#End Region + +End Class diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml new file mode 100644 index 0000000..a3454ad --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml @@ -0,0 +1,194 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + " + “ + ” + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + " + “ + ” + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb new file mode 100644 index 0000000..feaa62f --- /dev/null +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb @@ -0,0 +1,471 @@ +Public Class PageVersionSetup + + Private Shadows IsLoaded As Boolean = False + + Private Sub PageSetupSystem_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + + '重复加载部分 + PanBack.ScrollToHome() + RefreshRam(False) + + '由于各个版本不同，每次都需要重新加载 + AniControlEnabled += 1 + Reload() + AniControlEnabled -= 1 + + '非重复加载部分 + If IsLoaded Then Exit Sub + IsLoaded = True + + '内存自动刷新 + Dim timer As New Threading.DispatcherTimer With {.Interval = New TimeSpan(0, 0, 0, 1)} + AddHandler timer.Tick, AddressOf RefreshRam + timer.Start() + + End Sub + Public Sub Reload() + Try + + '启动参数 + TextArgumentTitle.Text = Setup.Get("VersionArgumentTitle", Version:=PageVersionLeft.Version) + TextArgumentInfo.Text = Setup.Get("VersionArgumentInfo", Version:=PageVersionLeft.Version) + Dim Indie As Integer = Setup.Get("VersionArgumentIndie", Version:=PageVersionLeft.Version) + If Indie = -1 Then + Dim ModFolder As New DirectoryInfo(PageVersionLeft.Version.Path & "mods\") + Dim SaveFolder As New DirectoryInfo(PageVersionLeft.Version.Path & "saves\") + If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count > 0) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Count > 0) Then + '自动开启 + Setup.Set("VersionArgumentIndie", 1, Version:=PageVersionLeft.Version) + Log("[Setup] 已自动开启单版本隔离：" & PageVersionLeft.Version.Name) + Indie = 1 + Else + '使用全局设置 + Setup.Set("VersionArgumentIndie", 0, Version:=PageVersionLeft.Version) + Log("[Setup] 版本隔离使用全局设置：" & PageVersionLeft.Version.Name) + Indie = 0 + End If + End If + ComboArgumentIndie.SelectedIndex = Indie + TextAdvanceJvm.Text = Setup.Get("VersionAdvanceJvm", Version:=PageVersionLeft.Version) + TextAdvanceGame.Text = Setup.Get("VersionAdvanceGame", Version:=PageVersionLeft.Version) + ComboAdvanceAssets.SelectedIndex = Setup.Get("VersionAdvanceAssets", Version:=PageVersionLeft.Version) + RefreshJavaComboBox() + + '游戏内存 + CType(FindName("RadioRamType" & Setup.Load("VersionRamType", Version:=PageVersionLeft.Version)), MyRadioBox).Checked = True + SliderRamCustom.Value = Setup.Get("VersionRamCustom", Version:=PageVersionLeft.Version) + + '服务器 + TextServerEnter.Text = Setup.Get("VersionServerEnter", Version:=PageVersionLeft.Version) + ComboServerLogin.SelectedIndex = Setup.Get("VersionServerLogin", Version:=PageVersionLeft.Version) + ComboServerLoginLast = ComboServerLogin.SelectedIndex + ServerLogin(ComboServerLogin.SelectedIndex) + TextServerNide.Text = Setup.Get("VersionServerNide", Version:=PageVersionLeft.Version) + TextServerAuthServer.Text = Setup.Get("VersionServerAuthServer", Version:=PageVersionLeft.Version) + TextServerAuthName.Text = Setup.Get("VersionServerAuthName", Version:=PageVersionLeft.Version) + TextServerAuthRegister.Text = Setup.Get("VersionServerAuthRegister", Version:=PageVersionLeft.Version) + + Catch ex As Exception + Log(ex, "重载版本独立设置时出错", LogLevel.Feedback) + End Try + End Sub + + '初始化 + Public Sub Reset() + Try + + Setup.Reset("VersionServerEnter", Version:=PageVersionLeft.Version) + Setup.Reset("VersionServerLogin", Version:=PageVersionLeft.Version) + Setup.Reset("VersionServerNide", Version:=PageVersionLeft.Version) + Setup.Reset("VersionServerAuthServer", Version:=PageVersionLeft.Version) + Setup.Reset("VersionServerAuthRegister", Version:=PageVersionLeft.Version) + Setup.Reset("VersionServerAuthName", Version:=PageVersionLeft.Version) + Setup.Reset("VersionArgumentTitle", Version:=PageVersionLeft.Version) + Setup.Reset("VersionArgumentInfo", Version:=PageVersionLeft.Version) + Setup.Set("VersionArgumentIndie", 0, Version:=PageVersionLeft.Version) + Setup.Reset("VersionRamType", Version:=PageVersionLeft.Version) + Setup.Reset("VersionRamCustom", Version:=PageVersionLeft.Version) + Setup.Reset("VersionAdvanceJvm", Version:=PageVersionLeft.Version) + Setup.Reset("VersionAdvanceGame", Version:=PageVersionLeft.Version) + Setup.Reset("VersionAdvanceAssets", Version:=PageVersionLeft.Version) + + Setup.Reset("VersionArgumentJavaSelect", Version:=PageVersionLeft.Version) + JavaSearchLoader.Start(IsForceRestart:=True) + + Log("[Setup] 已初始化版本独立设置") + Hint("已初始化版本独立设置！", HintType.Finish, False) + Catch ex As Exception + Log(ex, "初始化版本独立设置失败", LogLevel.Msgbox) + End Try + + Reload() + End Sub + + '将控件改变路由到设置改变 + Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioRamType0.Check, RadioRamType1.Check, RadioRamType2.Check + If AniControlEnabled = 0 Then Setup.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1)), Version:=PageVersionLeft.Version) + End Sub + Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextServerEnter.ValidatedTextChanged, TextArgumentInfo.ValidatedTextChanged, TextAdvanceGame.ValidatedTextChanged, TextAdvanceJvm.ValidatedTextChanged, TextServerNide.ValidatedTextChanged, TextServerAuthName.ValidatedTextChanged, TextServerAuthRegister.ValidatedTextChanged, TextServerAuthServer.ValidatedTextChanged, TextArgumentTitle.ValidatedTextChanged + If AniControlEnabled = 0 Then + Dim HandledText As String = sender.Text + If sender.Tag = "VersionServerAuthServer" OrElse sender.Tag = "VersionServerAuthRegister" Then HandledText = HandledText.TrimEnd("/") + Setup.Set(sender.Tag, HandledText, Version:=PageVersionLeft.Version) + End If + End Sub + Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value, Version:=PageVersionLeft.Version) + End Sub + Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged, ComboAdvanceAssets.SelectionChanged + If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex, Version:=PageVersionLeft.Version) + End Sub + +#Region "游戏内存" + + Public Sub RamType(Type As Integer) + If SliderRamCustom Is Nothing Then Exit Sub + SliderRamCustom.IsEnabled = (Type = 1) + End Sub + + ''' + ''' 刷新 UI 上的 RAM 显示。 + ''' + Public Sub RefreshRam(ShowAnim As Boolean) + If LabRamGame Is Nothing OrElse LabRamUsed Is Nothing OrElse FrmMain.PageCurrent <> FormMain.PageType.VersionSetup OrElse FrmVersionLeft.PageID <> FormMain.PageSubType.VersionSetup Then Exit Sub + '获取内存情况 + Dim RamGame As Double = GetRam(PageVersionLeft.Version) + Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 + Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 + Dim RamGameActual As Double = Math.Min(RamGame, RamAvailable) + Dim RamUsed As Double = RamTotal - RamAvailable + Dim RamEmpty As Double = Math.Round(MathRange(RamTotal - RamUsed - RamGame, 0, 1000) * 10) / 10 + '设置最大可用内存 + If RamTotal <= 1.5 Then + SliderRamCustom.MaxValue = Math.Max(Math.Floor((RamTotal - 0.3) / 0.1), 1) + ElseIf RamTotal <= 8 Then + SliderRamCustom.MaxValue = Math.Floor((RamTotal - 1.5) / 0.5) + 12 + ElseIf RamTotal <= 16 Then + SliderRamCustom.MaxValue = Math.Floor((RamTotal - 8) / 1) + 25 + ElseIf RamTotal <= 32 Then + SliderRamCustom.MaxValue = Math.Floor((RamTotal - 16) / 2) + 33 + Else + SliderRamCustom.MaxValue = Math.Min(Math.Floor((RamTotal - 32) / 4) + 41, 49) + End If + '设置文本 + LabRamGame.Text = If(RamGame = Math.Floor(RamGame), RamGame & ".0", RamGame) & " GB" & + If(RamGame <> RamGameActual, " (可用 " & If(RamGameActual = Math.Floor(RamGameActual), RamGameActual & ".0", RamGameActual) & " GB)", "") + LabRamUsed.Text = If(RamUsed = Math.Floor(RamUsed), RamUsed & ".0", RamUsed) & " GB" + LabRamTotal.Text = " / " & If(RamTotal = Math.Floor(RamTotal), RamTotal & ".0", RamTotal) & " GB" + LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaUse64Bit(PageVersionLeft.Version) AndAlso Not Is32BitSystem, Visibility.Visible, Visibility.Collapsed) + If ShowAnim Then + '宽度动画 + AniStart({ + AaGridLengthWidth(ColumnRamUsed, RamUsed - ColumnRamUsed.Width.Value, 800,, New AniEaseOutFluent(AniEasePower.Strong)), + AaGridLengthWidth(ColumnRamGame, RamGameActual - ColumnRamGame.Width.Value, 800,, New AniEaseOutFluent(AniEasePower.Strong)), + AaGridLengthWidth(ColumnRamEmpty, RamEmpty - ColumnRamEmpty.Width.Value, 800,, New AniEaseOutFluent(AniEasePower.Strong)) + }, "VersionSetup Ram Grid") + Else + '宽度设置 + ColumnRamUsed.Width = New GridLength(RamUsed, GridUnitType.Star) + ColumnRamGame.Width = New GridLength(RamGameActual, GridUnitType.Star) + ColumnRamEmpty.Width = New GridLength(RamEmpty, GridUnitType.Star) + End If + End Sub + Private Sub RefreshRam() Handles SliderRamCustom.Change, RadioRamType0.Check, RadioRamType1.Check, RadioRamType2.Check + RefreshRam(True) + End Sub + + Private RamTextLeft As Integer = 2, RamTextRight As Integer = 1 + ''' + ''' 刷新 UI 上的文本位置。 + ''' + Private Sub RefreshRamText() Handles RectRamGame.SizeChanged, RectRamEmpty.SizeChanged, LabRamGame.SizeChanged + '获取宽度信息 + Dim RectUsedWidth = RectRamUsed.ActualWidth + Dim TotalWidth = PanRamDisplay.ActualWidth + Dim LabGameWidth = LabRamGame.ActualWidth, LabUsedWidth = LabRamUsed.ActualWidth, LabTotalWidth = LabRamTotal.ActualWidth + Dim LabGameTitleWidth = LabRamGameTitle.ActualWidth, LabUsedTitleWidth = LabRamUsedTitle.ActualWidth + '左侧 + Dim Left As Integer + If RectUsedWidth - 30 < LabUsedWidth OrElse RectUsedWidth - 30 < LabUsedTitleWidth Then + '全写不下了 + Left = 0 + ElseIf RectUsedWidth - 25 < (LabUsedWidth + LabTotalWidth) Then + '显示不下完整数据 + Left = 1 + Else + '正常 + Left = 2 + End If + If RamTextLeft <> Left Then + RamTextLeft = Left + Select Case Left + Case 0 + AniStart({ + AaOpacity(LabRamUsed, -LabRamUsed.Opacity, 100), + AaOpacity(LabRamTotal, -LabRamTotal.Opacity, 100), + AaOpacity(LabRamUsedTitle, -LabRamUsedTitle.Opacity, 100) + }, "VersionSetup Ram TextLeft") + Case 1 + AniStart({ + AaOpacity(LabRamUsed, 1 - LabRamUsed.Opacity, 100), + AaOpacity(LabRamTotal, -LabRamTotal.Opacity, 100), + AaOpacity(LabRamUsedTitle, 0.7 - LabRamUsedTitle.Opacity, 100) + }, "VersionSetup Ram TextLeft") + Case 2 + AniStart({ + AaOpacity(LabRamUsed, 1 - LabRamUsed.Opacity, 100), + AaOpacity(LabRamTotal, 1 - LabRamTotal.Opacity, 100), + AaOpacity(LabRamUsedTitle, 0.7 - LabRamUsedTitle.Opacity, 100) + }, "VersionSetup Ram TextLeft") + End Select + End If + '右侧 + Dim Right As Integer + If TotalWidth < LabGameWidth + 2 + RectUsedWidth OrElse TotalWidth < LabGameTitleWidth + 2 + RectUsedWidth Then + '挤到最右边 + Right = 0 + Else + '正常情况 + Right = 1 + End If + If Right = 0 Then + If AniControlEnabled = 0 AndAlso (RamTextRight <> Right OrElse AniIsRun("VersionSetup Ram TextRight")) Then + '需要动画 + AniStart({ + AaX(LabRamGame, TotalWidth - LabGameWidth - LabRamGame.Margin.Left, 100,, New AniEaseOutFluent(AniEasePower.Weak)), + AaX(LabRamGameTitle, TotalWidth - LabGameTitleWidth - LabRamGameTitle.Margin.Left, 100,, New AniEaseOutFluent(AniEasePower.Weak)) + }, "VersionSetup Ram TextRight") + Else + '不需要动画 + LabRamGame.Margin = New Thickness(TotalWidth - LabGameWidth, 3, 0, 0) + LabRamGameTitle.Margin = New Thickness(TotalWidth - LabGameTitleWidth, 0, 0, 5) + End If + Else + If AniControlEnabled = 0 AndAlso (RamTextRight <> Right OrElse AniIsRun("VersionSetup Ram TextRight")) Then + '需要动画 + AniStart({ + AaX(LabRamGame, 2 + RectUsedWidth - LabRamGame.Margin.Left, 100,, New AniEaseOutFluent(AniEasePower.Weak)), + AaX(LabRamGameTitle, 2 + RectUsedWidth - LabRamGameTitle.Margin.Left, 100,, New AniEaseOutFluent(AniEasePower.Weak)) + }, "VersionSetup Ram TextRight") + Else + '不需要动画 + LabRamGame.Margin = New Thickness(2 + RectUsedWidth, 3, 0, 0) + LabRamGameTitle.Margin = New Thickness(2 + RectUsedWidth, 0, 0, 5) + End If + End If + RamTextRight = Right + End Sub + + ''' + ''' 获取当前设置的 RAM 值。单位为 GB。 + ''' + Public Shared Function GetRam(Version As McVersion) As Double + '使用全局设置 + If Setup.Get("VersionRamType", Version:=Version) = 2 Then + Return PageSetupLaunch.GetRam(Version, True) + End If + '使用当前版本的设置 + Dim RamGive As Double + If Setup.Get("VersionRamType", Version:=Version) = 0 Then + '自动配置 + Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 + '确定需求的内存值 + Dim RamMininum As Double '无论如何也需要保证的最低限度内存 + Dim RamTarget1 As Double '估计能勉强带动了的内存 + Dim RamTarget2 As Double '估计没啥问题了的内存 + Dim RamTarget3 As Double '安装过多附加组件需要的内存 + If Version IsNot Nothing AndAlso Not Version.IsLoaded Then Version.Load() + If Version IsNot Nothing AndAlso Version.Version.Modable Then + '可安装 Mod 的版本 + Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\") + Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0) + RamMininum = 0.4 + ModCount / 150 + RamTarget1 = 1.5 + ModCount / 100 + RamTarget2 = 3 + ModCount / 60 + RamTarget3 = 6 + ModCount / 30 + ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then + 'OptiFine 版本 + RamMininum = 0.3 + RamTarget1 = 1.5 + RamTarget2 = 3 + RamTarget3 = 6 + Else + '普通版本 + RamMininum = 0.3 + RamTarget1 = 1.5 + RamTarget2 = 2.5 + RamTarget3 = 4 + End If + Dim RamDelta As Double + '预分配内存，阶段一，0 ~ T1，100% + RamDelta = RamTarget1 + RamAvailable = Math.Max(0, RamAvailable - 0.1) + RamGive += Math.Min(RamAvailable * 1, RamDelta) + RamAvailable -= RamDelta / 1 + 0.1 + If RamAvailable < 0.1 Then GoTo PreFin + '预分配内存，阶段二，T1 ~ T2，80% + RamDelta = RamTarget2 - RamTarget1 + RamAvailable = Math.Max(0, RamAvailable - 0.1) + RamGive += Math.Min(RamAvailable * 0.8, RamDelta) + RamAvailable -= RamDelta / 0.8 + 0.1 + If RamAvailable < 0.1 Then GoTo PreFin + '预分配内存，阶段三，T2 ~ T3，60% + RamDelta = RamTarget3 - RamTarget2 + RamAvailable = Math.Max(0, RamAvailable - 0.2) + RamGive += Math.Min(RamAvailable * 0.6, RamDelta) + RamAvailable -= RamDelta / 0.6 + 0.2 + If RamAvailable < 0.1 Then GoTo PreFin + '预分配内存，阶段四，T3 ~ T3 * 2，40% + RamDelta = RamTarget3 + RamAvailable = Math.Max(0, RamAvailable - 0.3) + RamGive += Math.Min(RamAvailable * 0.4, RamDelta) + RamAvailable -= RamDelta / 0.4 + 0.3 + If RamAvailable < 0.1 Then GoTo PreFin +PreFin: + '不低于最低值 + RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1) + Else + '手动配置 + Dim Value As Integer = Setup.Get("VersionRamCustom", Version:=Version) + If Value <= 12 Then + RamGive = Value * 0.1 + 0.3 + ElseIf Value <= 25 Then + RamGive = (Value - 12) * 0.5 + 1.5 + ElseIf Value <= 33 Then + RamGive = (Value - 25) * 1 + 8 + ElseIf Value <= 41 Then + RamGive = (Value - 33) * 2 + 16 + Else + RamGive = (Value - 41) * 4 + 32 + End If + End If + '若使用 32 位 Java，则限制为 1G + If Not JavaUse64Bit(PageVersionLeft.Version) Then RamGive = Math.Min(1, RamGive) + Return RamGive + End Function + +#End Region + +#Region "服务器" + + '全局 + Private ComboServerLoginLast As Integer + Private Sub ComboServerLogin_Changed() Handles ComboServerLogin.SelectionChanged, TextServerNide.ValidatedTextChanged, TextServerAuthServer.ValidatedTextChanged, TextServerAuthRegister.ValidatedTextChanged + If AniControlEnabled <> 0 Then Exit Sub + ServerLogin(ComboServerLogin.SelectedIndex) + '检查是否输入正确，正确才触发设置改变 + If ComboServerLogin.SelectedIndex = 3 AndAlso TextServerNide.ValidateResult <> "" Then Exit Sub + If ComboServerLogin.SelectedIndex = 4 AndAlso TextServerAuthServer.ValidateResult <> "" Then Exit Sub + '检查结果是否发生改变，未改变则不触发设置改变 + If ComboServerLoginLast = ComboServerLogin.SelectedIndex Then Exit Sub + '触发 + ComboServerLoginLast = ComboServerLogin.SelectedIndex + ComboChange(ComboServerLogin, Nothing) + End Sub + Public Sub ServerLogin(Type As Integer) + If LabServerNide Is Nothing Then Exit Sub + LabServerNide.Visibility = If(Type = 3, Visibility.Visible, Visibility.Collapsed) + TextServerNide.Visibility = If(Type = 3, Visibility.Visible, Visibility.Collapsed) + PanServerNide.Visibility = If(Type = 3, Visibility.Visible, Visibility.Collapsed) + LabServerAuthName.Visibility = If(Type = 4, Visibility.Visible, Visibility.Collapsed) + TextServerAuthName.Visibility = If(Type = 4, Visibility.Visible, Visibility.Collapsed) + LabServerAuthRegister.Visibility = If(Type = 4, Visibility.Visible, Visibility.Collapsed) + TextServerAuthRegister.Visibility = If(Type = 4, Visibility.Visible, Visibility.Collapsed) + LabServerAuthServer.Visibility = If(Type = 4, Visibility.Visible, Visibility.Collapsed) + TextServerAuthServer.Visibility = If(Type = 4, Visibility.Visible, Visibility.Collapsed) + BtnServerAuthLittle.Visibility = If(Type = 4, Visibility.Visible, Visibility.Collapsed) + CardServer.TriggerForceResize() + End Sub + + '统一通行证 + Private Sub BtnServerNideWeb_Click(sender As Object, e As EventArgs) Handles BtnServerNideWeb.Click + OpenWebsite("https://login.mc-user.com:233/server/intro") + End Sub + Private Sub BtnServerNideBbs_Click(sender As Object, e As EventArgs) Handles BtnServerNideBbs.Click + OpenWebsite("https://www.mcbbs.net/thread-729821-1-1.html") + End Sub + + 'Little Skin + Private Sub BtnServerAuthLittle_Click(sender As Object, e As EventArgs) Handles BtnServerAuthLittle.Click + TextServerAuthServer.Text = "https://littleskin.cn/api/yggdrasil" + TextServerAuthRegister.Text = "https://littleskin.cn/auth/register" + TextServerAuthName.Text = "Little Skin 登录" + End Sub + +#End Region + +#Region "Java 选择" + + '刷新 Java 下拉框显示 + Public Sub RefreshJavaComboBox() + If ComboArgumentJava Is Nothing Then Exit Sub + '初始化列表 + ComboArgumentJava.Items.Clear() + ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "使用全局设置", .Tag = "使用全局设置"}) + ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择适合所选游戏版本的 Java", .Tag = "自动选择"}) + '更新列表 + Dim SelectedItem As MyComboBoxItem = Nothing + Dim SelectedBySetup As String = Setup.Get("VersionArgumentJavaSelect", Version:=PageVersionLeft.Version) + Try + For Each Java In JavaList + Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java} + ToolTipService.SetPlacement(ListItem, Primitives.PlacementMode.Right) + ToolTipService.SetHorizontalOffset(ListItem, 5) + ComboArgumentJava.Items.Add(ListItem) + '判断人为选中 + If SelectedBySetup = "" OrElse SelectedBySetup = "使用全局设置" Then Continue For + If JavaEntry.FromJson(GetJson(SelectedBySetup)).PathFolder = Java.PathFolder Then SelectedItem = ListItem + Next + Catch ex As Exception + Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=PageVersionLeft.Version) + Log(ex, "更新版本设置 Java 下拉框失败", LogLevel.Feedback) + End Try + '更新选择项 + If SelectedItem Is Nothing AndAlso JavaList.Count > 0 Then + If SelectedBySetup = "" Then + SelectedItem = ComboArgumentJava.Items(1) '选中 “自动选择” + Else + SelectedItem = ComboArgumentJava.Items(0) '选中 “使用全局设置” + End If + End If + ComboArgumentJava.SelectedItem = SelectedItem + '结束处理 + If SelectedItem Is Nothing Then + ComboArgumentJava.Items.Clear() + ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "未找到可用的 Java", .IsSelected = True}) + End If + RefreshRam(True) + End Sub + '阻止在特定情况下展开下拉框 + Private Sub ComboArgumentJava_DropDownOpened(sender As Object, e As EventArgs) Handles ComboArgumentJava.DropDownOpened + If ComboArgumentJava.SelectedItem Is Nothing OrElse ComboArgumentJava.Items(0).Content = "未找到可用的 Java" OrElse ComboArgumentJava.Items(0).Content = "加载中……" Then + ComboArgumentJava.IsDropDownOpen = False + End If + End Sub + + '下拉框选择更改 + Private Sub JavaSelectionUpdate() Handles ComboArgumentJava.SelectionChanged + If AniControlEnabled <> 0 Then Exit Sub + 'Java 不可用时也不清空，会导致刷新时找不到对象 + If ComboArgumentJava.SelectedItem Is Nothing OrElse ComboArgumentJava.SelectedItem.Tag Is Nothing Then Exit Sub + '设置新的 Java + Dim SelectedJava = ComboArgumentJava.SelectedItem.Tag + If "使用全局设置".Equals(SelectedJava) Then + '选择 “自动” + Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=PageVersionLeft.Version) + Log("[Java] 修改版本 Java 选择设置：使用全局设置") + ElseIf "自动选择".Equals(SelectedJava) Then + '选择 “自动” + Setup.Set("VersionArgumentJavaSelect", "", Version:=PageVersionLeft.Version) + Log("[Java] 修改版本 Java 选择设置：自动选择") + Else + '选择指定项 + Setup.Set("VersionArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None), Version:=PageVersionLeft.Version) + Log("[Java] 修改版本 Java 选择设置：" & SelectedJava.ToString) + End If + RefreshRam(True) + End Sub + +#End Region + +End Class diff --git a/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj b/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj new file mode 100644 index 0000000..fd91ac2 --- /dev/null +++ b/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj @@ -0,0 +1,909 @@ + + + + Debug + AnyCPU + {4499F2D2-18EF-4238-B1F0-7BD547AFF925} + {60dc8134-eba5-43b8-bcc9-bb4bc16c2548};{F184B08F-C81C-45F6-A57F-5ABD9991F28F} + WinExe + PCL + Plain Craft Launcher 2 + v4.6.2 + Custom + false + + + + + publish\ + true + Disk + false + Foreground + 7 + Days + false + false + true + zh-CN + 0 + 1.0.0.%2a + false + true + + + AnyCPU + true + full + true + false + true + D:\Minecraft\程序\ + Plain Craft Launcher 2.xml + 41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314 + false + MinimumRecommendedRules.ruleset + false + 1 + false + + + AnyCPU + none + false + false + false + false + true + D:\Minecraft\程序\ + Plain Craft Launcher 2.xml + 41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314 + false + BasicDesignGuidelineRules.ruleset + 1 + RELEASE + + + On + + + Text + + + Off + + + On + + + app.manifest + + + Images\icon.ico + + + false + + + CE7A815CD81401B559C8649A3EEA43B75ECB8FC5 + + + Plain Craft Launcher 2_TemporaryKey.pfx + + + false + + + LocalIntranet + + + false + + + D:\Minecraft\ + Plain Craft Launcher 2.xml + true + 1 + 41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314 + AnyCPU + BasicDesignGuidelineRules.ruleset + SNAPSHOT + false + + + D:\Minecraft\程序\ + Plain Craft Launcher 2.xml + true + 1 + 41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314 + AnyCPU + BasicDesignGuidelineRules.ruleset + BETA + + + false + + + + + + + D:\Minecraft\程序\ + RELEASE,BY_UPDATE + Plain Craft Launcher 2.xml + true + 1 + 41999,42016,42017,42018,42019,42020,42021,42022,42032,42036,42314 + AnyCPU + BasicDesignGuidelineRules.ruleset + false + + + + False + False + + + ..\packages\Newtonsoft.Json.11.0.2\lib\net45\Newtonsoft.Json.dll + False + + + False + Resources\Ookii.Dialogs.Wpf.dll + False + + + False + Resources\STUN.dll + False + + + + + + + + + + + + + + 4.0 + + + + + + + + MSBuild:Compile + Designer + + + + + + + + + + + MyExtraButton.xaml + + + MyHint.xaml + + + MyLoading.xaml + + + + MyMsgInput.xaml + + + MyMsgSelect.xaml + + + + + MySearchBox.xaml + + + + + + + + + + + Component + + + + MyCfItem.xaml + + + PageDownloadMod.xaml + + + PageDownloadFabric.xaml + + + PageDownloadInstall.xaml + + + PageDownloadCfDetail.xaml + + + PageDownloadPack.xaml + + + FormLoginOAuth.xaml + + + PageLoginAuth.xaml + + + PageLoginAuthSkin.xaml + + + PageLoginMs.xaml + + + PageLoginMsSkin.xaml + + + PageLoginNideSkin.xaml + + + PageLinkFeedback.xaml + + + PageOtherHelpDetail.xaml + + + PageLinkIoi.xaml + + + PageLinkLeft.xaml + + + PageVersionLeft.xaml + + + PageVersionMod.xaml + + + PageVersionModDisabled.xaml + + + PageVersionOverall.xaml + + + PageVersionSetup.xaml + + + + + + + + + + PageDownloadForge.xaml + + + PageDownloadLiteLoader.xaml + + + PageDownloadOptiFine.xaml + + + PageOtherFeedback.xaml + + + PageOtherTest.xaml + + + MySkin.xaml + + + PageLoginNide.xaml + + + PageLoginLegacy.xaml + + + PageLoginMojang.xaml + + + PageLoginMojangSkin.xaml + + + PageSelectRight.xaml + + + PageSelectLeft.xaml + + + PageLaunchLeft.xaml + + + PageLaunchRight.xaml + + + PageOtherAbout.xaml + + + PageOtherHelp.xaml + + + PageDownloadLeft.xaml + + + PageDownloadClient.xaml + + + PageOtherLeft.xaml + + + PageSetupLeft.xaml + + + + PageSetupLaunch.xaml + + + PageSetupSystem.xaml + + + PageSetupLink.xaml + + + PageSetupUI.xaml + + + PageSpeedLeft.xaml + + + PageSpeedRight.xaml + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + MSBuild:Compile + Designer + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + MSBuild:Compile + Designer + + + Application.xaml + Code + + + MyListItem.xaml + + + MyButton.xaml + + + MyCheckBox.xaml + + + MyIconButton.xaml + + + MyMsgText.xaml + + + MyRadioBox.xaml + + + + MySlider.xaml + + + MyRadioButton.xaml + + + FormMain.xaml + Code + + + MSBuild:Compile + Designer + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + MSBuild:Compile + Designer + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + MSBuild:Compile + Designer + + + MSBuild:Compile + Designer + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + MSBuild:Compile + Designer + + + + MSBuild:Compile + Designer + + + MSBuild:Compile + Designer + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + MSBuild:Compile + Designer + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + MSBuild:Compile + Designer + + + MSBuild:Compile + Designer + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + MSBuild:Compile + Designer + + + MSBuild:Compile + Designer + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + MSBuild:Compile + Designer + + + Designer + MSBuild:Compile + + + MSBuild:Compile + Designer + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + Designer + MSBuild:Compile + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Code + + + Microsoft.VisualBasic.WPF.MyExtension + 1.0.0.0 + + + True + True + Resources.resx + + + True + Settings.settings + True + + + VbMyResourcesResXFileCodeGenerator + Resources.Designer.vb + My.Resources + Designer + + + + SettingsSingleFileGenerator + Settings.Designer.vb + + + + + + + + False + Microsoft .NET Framework 4.5.2 %28x86 和 x64%29 + true + + + False + .NET Framework 3.5 SP1 + false + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + False + + + + + Exclude + True + Assembly + + + False + + + + + Exclude + True + Assembly + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + {1C565858-F302-471E-B409-F180AA4ABEC6} + 1 + 0 + 0 + tlbimp + False + True + + + {58FBCF7C-E7A9-467C-80B3-FC65E8FCCA08} + 1 + 0 + 0 + tlbimp + False + True + + + + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Resources/Custom.xaml b/Plain Craft Launcher 2/Resources/Custom.xaml new file mode 100644 index 0000000..9e3b8be --- /dev/null +++ b/Plain Craft Launcher 2/Resources/Custom.xaml @@ -0,0 +1,237 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Resources/Font.ttf b/Plain Craft Launcher 2/Resources/Font.ttf new file mode 100644 index 0000000..8ee62cb Binary files /dev/null and b/Plain Craft Launcher 2/Resources/Font.ttf differ diff --git a/Plain Craft Launcher 2/Resources/Help.zip b/Plain Craft Launcher 2/Resources/Help.zip new file mode 100644 index 0000000..512fc39 Binary files /dev/null and b/Plain Craft Launcher 2/Resources/Help.zip differ diff --git a/Plain Craft Launcher 2/Resources/Language/en_US.xaml b/Plain Craft Launcher 2/Resources/Language/en_US.xaml new file mode 100644 index 0000000..f0714da --- /dev/null +++ b/Plain Craft Launcher 2/Resources/Language/en_US.xaml @@ -0,0 +1,10 @@ + + + More + Download + Launch + Setting + + diff --git a/Plain Craft Launcher 2/Resources/Language/zh_CN.xaml b/Plain Craft Launcher 2/Resources/Language/zh_CN.xaml new file mode 100644 index 0000000..a92d95b --- /dev/null +++ b/Plain Craft Launcher 2/Resources/Language/zh_CN.xaml @@ -0,0 +1,10 @@ + + + 更多 + 下载 + 启动 + 设置 + + diff --git a/Plain Craft Launcher 2/Resources/ModData.json b/Plain Craft Launcher 2/Resources/ModData.json new file mode 100644 index 0000000..cb1a48b --- /dev/null +++ b/Plain Craft Launcher 2/Resources/ModData.json @@ -0,0 +1 @@ +{"minecraft-comes-alive-mca":"100|虚拟人生/凡家物语 (Minecraft Comes Alive)|727273","digimobs":"1000|数码宝贝 (Digimobs)","storage-boats-mod":"1001|存储船 (Storage Boat Mod)|798267","mo-withers":"1002|更多凋灵 (Mo' Withers)","the-autologin-mod-for-authme-server":"1004|自动登录 (AutoLogin)","ROOST":"1005|鸡窝 (Roost)","croparia":"1006|矿石作物/魔种之咏 (Croparia)|1300400","simple-corn":"1007|简单玉米 (Simple Corn)|778746","thaumic-jei":"1008|~","tinkers-construct":"683|匠魂|661201","unicode-font-extension":"1010|Unicode字体扩展 (Unicode Font Extension)|733474","placeable-items":"1011|可放置物品 (Placeable Items)|775353","compendium":"1012|工匠防御 (Tinkers' Compendium (Tinkers' Defense))|686520","stargate-network":"1013|格雷的星门 (Greg's SG Craft)|319182","damage-indicators-mod":"1014|伤害显示 (Damage Indicators)|75581","torohealth-damage-indicators":"1015|伤害显示 (ToroHealth Damage Indicators)|1106212","omni-ocular":"1016|~","wrapup":"1017|~","nuclear-physics":"1018|~","wither-skeleton-tweaks":"1019|凋灵骷髅调整 (Wither Skeleton Tweaks)","heat-and-climate":"1020|热量与气候 (Heat And Climate)","customthings":"1021|自定义物品 (CustomThings)","exgregilo":"1022|格雷矿筛 (ExGregilo)","placebo":"1023|~","plants":"1024|~","chinjufumod":"1026|镇守府 (ChinjufuMod +JapaneseBlock)|776626","track-api":"1027|~","immersive-railroading":"1028|沉浸铁路 (Immersive Railroading)|783016","forge-essentials-74735":"103|~","custom-main-menu":"1030|自定义主菜单 (Custom Main Menu)|769607","wildycraft":"1032|~|526348","my-little-mob-grinder":"1035|小怪物粉碎机 (My Little Mob Grinder)|783333","resource-loader":"1036|资源加载 (Resource Loader)|670173","no-sleeping-allowed":"1037|禁止睡觉 (No Sleeping Allowed)|784121","playersdropheads":"1038|玩家掉落头颅 (PlayersDropHeads)|783991","memory-bar":"1039|~","toxicrain":"1040|有毒的雨 (ToxicRain)|783727","cannibalism":"1043|割肉小刀/同类相食 (Cannibalism)|381013","quick-consume":"1044|快速消耗 (Quick Consume)|784670","planting-dirt-for-saplings":"1045|自动植树机 (Planting dirt for saplings)|784640","custom-crosshair-mod":"1047|自定义准心 (Custom Crosshair Mod)|607354","better-blink":"1048|更好的传送 (Better Blink)|785164","biobomb":"1049|生物炸弹 (BioBomb)|785148","translocators-1-8":"105|转运器 (Translocators)","ender-hopper":"1050|末影漏斗 (Ender Hopper)|784833","mine-souls":"1051|黑魂战斗 (Mine Souls)|683570","radixcore":"1052|~","dlt2":"1053|动态蓄水槽 (Dynamic Liquid Tanks)","familiar-fauna":"1054|熟悉的动物 (Familiar Fauna)|785558","tinkers-tool-leveling":"1056|匠魂工具升级 (Tinkers' Tool Leveling)|646118","arcana-rpg-final-version":"1057|神秘RPG (Arcana RPG)|529452","ingame-info-xml":"1058|游戏信息显示XML版 (InGame Info XML)","craftguide":"106|G键合成表 (CraftGuide)|117634","lovelyrobot":"1060|萌化机器人 (LovelyRobot)|680093","tameable-arachne":"1061|萌化女妖 (Tameable Arachne)|445196","skillable":"1062|~","lunatriuscore":"1063|~","spin-to-win":"1064|旋转剑技 (Spin to Win)","soft-blocks":"1065|柔软方块 (Soft Blocks)|785967","heartblock":"1066|生命方块 (HeartBlock)|786355","spawncontroller":"1067|自定义怪物生成 (SpawnController)|786558","wearable-backpacks":"1068|可穿戴背包 (Wearable Backpacks)|664777","heart-drop":"1069|生命汲取 (Heart Drop)","omlib":"1070|开放式炮台库 (OMLib)","dynamictrees":"1071|动态的树/有活力的树 (Dynamic Trees)|771545","merry-christmas":"1072|圣诞箱子 (Merry Christmas!)|786210","cloud-control":"1073|可控制的云 (Cloud Control)|785903","zombie-ore":"1074|矿石僵尸 (Zombie ore)|786883","meanmobs":"1075|残忍怪物 (MeanMobs)|786377","zyins-hud":"1076|~","rough-tweaks":"1078|难度调整 (Rough Tweaks)","biomes-o-plenty":"108|超多生物群系 (Biomes O' Plenty)|814732","the-disenchanter-mod":"1080|祛魔台 (The Disenchanter)","carry-on":"1081|搬运 (Carry On)","better-than-llamas":"1082|更好看的羊驼 (Better Than Llamas)","dynamic-surroundings-fabric-edition":"1083|动态环境/动态环绕 (Dynamic Surroundings)|813490","alfheim":"1084|亚尔夫海姆 (Alfheim)|809440","mob-battle-mod-fabric":"1085|怪物大乱斗 (Mob Battle Mod)|582695","smooth-font":"1086|平滑字体 (Smooth Font)|781290","dude-wheres-my-blocks":"1087|谁动了我的合成表 (Dude where's my blocks)","reskillable":"1088|~","betteroffhand":"1089|更好的副手 (BetterOffhand)|788841","entity-spring":"1090|实体弹簧 (Entity Spring)|788317","compatskills":"1091|~","avaritia-tweaks":"1092|~","mjrlegendslib":"1093|~","dye-it-yourself":"1094|自动染色 (Dye It Yourself)|789349","piston-expansion":"1095|活塞拓展 (Piston Expansion)|789538","underwater-rails":"1096|水下铁轨 (Underwater Rails)|789443","trebuchet":"1097|~","particlelib":"1098|粒子库 (ParticleLib)","touhou-item-mod":"11|辉夜姬的五难题 (五つの難題MOD+ ~ Touhou Items)|111053","jglrxavpoks-uncrafting-table":"1101|jglrxavpok的拆解台 (jglrxavpok's Uncrafting Table)","rustic":"1102|乡村 (Rustic)","netherutils":"1103|~","bonsai-trees":"1104|盆栽 (Bonsai Trees)|785239","binnies-mods":"472|宾尼的模组合集","misty-world":"1107|朦胧世界 (Misty World)","enhanced-portals-3":"111|增强传送门3 (Enhanced Portals 3)","kathairis-alive":"1110|卡塞瑞斯 (Kathairis/Kether)|865377","manametal":"1111|魔法金属 (ManaMetalMod)|1157795","avaritiaddons":"1112|无尽收容 / 更多空间箱子 (Avaritiaddons)|922743","base":"1113|~","immersive-cables":"1114|沉浸线缆 (Immersive Cables)","better-title-screen":"1116|更好的标题页 (Better Title Screen)|1207672","sound-filters":"1117|声音滤波器 (Sound Filters)","vivecraft-forge-extensions":"1119|~","compact-solars":"112|压缩太阳能阵列 (CompactSolars)|807551","super-sound-muffler":"1120|超级消音器 (Super Sound Muffler)","armorplus":"1121|装备扩充 (ArmorPlus)","inspirations":"1122|灵感 (Inspirations)|940567","tree-growing-simulator":"1123|跳舞树成长 (Tree Growing Simulator)","personal-cars":"1125|~","thermal-innovation":"1126|热力革新 (Thermal Innovation)","bewitchment":"1127|~","better-foliage":"1128|更好的树叶 (Better Foliage)","creative-plus":"1129|创造+ (Creative Plus)","bibliocraft":"113|收藏馆 (BiblioCraft)","just-a-few-fish":"1130|只是一些鱼 (Just a Few Fish)|529165","ynot":"1131|~","serene-seasons":"1132|静谧四季/季节 (Serene Seasons)|849266","realm-of-the-dragons-rotd":"1133|龙之领域 (Realm Of The Dragons)","rockhounding-mod":"1134|地质探秘/岩石狩猎 (RockHounding)","fancy-block-particles":"1135|梦幻方块效果 (Fancy Block Particles)|678541","thaumic-katana":"1136|神秘之日本刀 (Thaumic Katana)","the-aether-ii":"1137|天境二 (The Aether II)|797818","visibleraygenerator":"1138|永久光发电机 (VisibleRay Generator)|785459","mmmmmmmmmmmm":"1139|试验假人 (MmmMmmMmmMmm)|708291","natura":"114|自然 (Natura)","aromabackup":"1140|存档备份 (AromaBackup)","orbis-lib":"1142|~","the-eight-fabled-blades":"1143|八大传说之刃 (The Eight Fabled Blades)|794723","malisisblocks":"1144|~","useful-interior":"1145|有用的内饰 (Useful Interior)|793625","taiga-tinkers-alloying-addon":"1146|匠魂合金附加 (Tinkers Alloying Addon)|670143","version-checker":"1147|模组更新检测 (Version Checker)","planar-artifice":"1148|镜面艺术: 传承 (Planar Artifice: Continuation)","atomic-science":"115|原子科学 (Atomic Science)","Requiem":"1150|安魂曲 (Requiem/Dissolution)|843736","slashblade-in-tfc":"1151|古刀传 (Slash Blade in TFC)|789943","mlp-mythical-creatures":"1152|神话生物 (Mythical Creatures)","metamorph":"1153|变形 (Metamorph)|723273","reactioncraft-3-rebirth":"1154|世界反应3：重置 (Reactioncraft 3: Rebirth)","pewter":"1155|魔法匠魂 (Pewter)","redstone-repository-revolved":"1156|红石军械库重制版 (Redstone Repository Revolved)","spawncommands-spawn-commands-teleport":"1157|传送指令 (Spawn Commands Teleport)|830035","server-properties-for-lan":"1158|简单联机 (Server.Properties for LAN)|781904","jaopcaadditions":"1160|JAOPCA附属 (JAOPCAAdditions)","cloche-call":"1161|~","mouse-tweaks":"1162|鼠标手势 (Mouse Tweaks)|69677","jaopcaagriculture":"1163|JAOPCA神秘农业附属 (JAOPCA Agriculture)","sky-resources":"1164|空岛资源 (Sky Resources)|817623","hexxit-gear":"1165|Hexxit装备 (Hexxit Gear)","magic-clover#t1:other-downloads":"1167|幸运四叶草 (Magic Clover)","inventory-crafting-grid":"1168|背包工作台 (Inventory Crafting Grid)","kleeslabs-fabric":"1169|更好地破坏半砖 (KleeSlabs)","atum":"117|阿图姆：沙漠之旅/亚图姆：金沙之旅 (Atum 2: Return to the Sands)|1207987","opencubicchunks":"1170|~","gregtechce":"1171|格雷科技社区版 (GregTech Community Edition)|818575","blur-fabric":"1172|界面背景模糊 (Blur)","fast-leaf-decay":"1173|树叶快速腐烂 (Fast Leaf Decay)","enable-cheats":"1174|开启作弊模式 (Enable Cheats)|798217","findit":"1175|找到它 (Findit!)|798212","wearable-blocks":"1176|可穿戴的方块 (Wearable Blocks)","swissarmyknife":"1179|瑞士军刀 (SwissArmyKnife)","blockphysics_by_id_miner":"118|方块物理学 (BlockPhysics)","ender-io-addons":"1180|末影接口拓展 (Ender IO Addons)|545556","historicized-medicine":"1181|历史化医学 (Historicized Medicine)","infinity-item-editor":"1182|无尽物品编辑器 (Infinity Item Editor)|791937","extra-rails":"1183|更多功能铁轨 (Extra Rails)|607938","gregtania":"1184|~","origin":"1185|~","minecraft-transport-simulator":"1186|沉浸车辆 (Immersive Vehicles)","chest-transporter":"1187|搬箱器 (Chest Transporter)|467680","i18nupdatemod":"1188|自动汉化更新 (I18nUpdateMod)|805273","realistic-item-drops":"1189|真实物品掉落 (Realistic Item Drops)","pixelmon":"1190|像素精灵宝可梦 重铸 (Pixelmon)|291020","controlling":"1191|键位冲突显示 (Controlling)|713187","simpleleather":"1194|腐肉烧皮革 (SimpleLeather)|660382","sync":"1195|克隆 (Sync)|300110","chiseled-me":"1196|超级变变变 (Chiseled Me)","progressive-automation-early-miner":"1197|进阶自动化 (Progressive Automation)","matmos":"1198|真实环境音效 (MAtmos)","ye-olde-tanks":"1199|水箱 (Ye Olde Tanks)","secretroomsmod":"12|密室 (SecretRooms)","improving-minecraft":"1200|改善的世界 (Improving Minecraft)","wawla":"1201|Wawla高亮显示 (What Are We Looking At)","lightarea":"1202|点亮区域 (LightArea)|806149","stellar-sky":"1204|群星璀璨 (Stellar Sky)|502403","stellar-api":"1205|恒星API (Stellar API)","nei-addons":"1206|NEI扩充 (NEI Addons)","cucumber":"1207|~","hunting-dimension":"1208|狩猎维度 (Hunting Dimension)|800351","runes-of-wizardry":"1209|符文魔法 (Runes-of-Wizardry)","remain-in-motion":"121|运动红石机构 (Redstone in motion)","coffee-workshop":"1211|咖啡工坊 (Coffee Workshop)|808472","in-game-account-switcher":"1212|游戏内账号切换 (In-Game Account Switcher)|1211916","consecration":"1213|圣化 (Consecration)|849160","ignite-hud":"1214|燃点HUD (Ignite HUD)","mrcrayfishs-gun-mod":"1215|MrCrayfish的枪 (MrCrayfish's Gun Mod)","bloodmoon":"1216|血月 (bloodmoon)|904325","obfuscate":"1217|~","runic-dungeons":"1218|符文地牢 (Runic Dungeon)|402813","poop":"1219|屎 (Poop Mod)|610472","slurp":"1220|啜饮 (Slurp)","tough-expansion":"1221|意志坚定：热力附属 (Tough Expansion)","mystical-agradditions":"1222|神秘农业扩展 (Mystical Agradditions)","vanillafix":"1223|原版修复 (VanillaFix)|792493","just-enough-harvestcraft":"1224|更多潘马斯配方查询 (Just Enough HarvestCraft)|725038","charcoal-pit":"1225|~|818165","uncomplication":"1226|IC2exp还原 (Uncomplication)|471928","the-wings-of-alfheim-1-7-10":"1227|亚尔夫海姆之翼 (The Wings of Alfheim)|499629","mubble-forge":"1230|~","libraryex":"1231|MineEx通用库 (LibraryEx)","industrial-wires":"1232|工业线缆 (Industrial Wires)","mystagrad-cloche-compat":"1233|~","waitingtime":"1234|加载页面游戏 (WaitingTime)|774325","dragontech":"1235|龙之科技/龙鳞实验版 (DragonTech/Dragon Scales EX)","gravityfalls-mod":"1237|怪诞小镇 (Gravity Falls)","tfcbotania":"1238|TFC植物魔法 (TFCBotania)","no-recipe-guide":"1239|没有合成指南 (No Recipe Guide)|811530","modular-powersuits":"124|模块化动力套装 (Modular Powersuits)","takumi-craft":"1240|爬行者世界/苦力怕世界 (Takumi Craft)","the-mists-of-riov":"1241|神秘世界 (The Mists of RioV Mod)","nsr-no-respawn-screen":"1243|无重生屏幕 (No Respawn Screen)|793776","more-bees":"1244|蜜蜂拓展 (More Bees)|777452","evilnotchlib":"1245|~","tpalette":"1246|调色板 (TPalette)","career-bees":"1248|职业蜜蜂 (Career Bees)","level-up":"1250|升级！重置 (Level Up!Reloaded)","level-up-legacy":"1251|升级！前版 (Level Up!Legacy)","moar-boats":"1252|模块化船 (Moar Boats)","numina":"1253|模块化动力装甲前置 (Numina)","tinkers-complement":"1254|匠魂补充 (Tinkers' Complement)","everlastingabilities":"1255|永恒能力 (EverlastingAbilities)","abyssalcraft-heads":"1256|深渊国度头颅 (AbyssalCraft Heads)|673330","overlord":"1257|不死者之王 (Overlord)|657071","multifarm-crops":"1258|多功能农场兼容 (Multifarm Crops)","forestry-fermenter-addon":"1259|更多生物质 (Forestry Fermenter Addon)","dakimakura-mod":"1260|抱枕 (Dakimakura Mod)|816801","rift":"1262|~|814764","crop-eating-animals":"1263|动物自动喂食 (Crop-Eating Animals)","refraction":"1264|折射 (Refraction)","librarianlib":"1266|图书馆 (LibrarianLib)","creeper-confetti":"1267|烟花苦力怕 (Creeper Confetti)|775377","funnels":"1268|液体漏斗 (Funnels)","advent-of-ascension-nevermine":"1269|虚无世界|325420","toroquest":"1270|托罗探索 (Toro Quest)|818183","rikmulds-core-mod":"1272|~","just-enough-pattern-banners":"1273|~","primitive-mobs":"1274|远古生物/原始生物 (Primitive Mobs)","realistic-cobwebs":"1275|~","simpleharvest":"1276|简单收获 (Simple Harvest)|1089377","mrcrayfishs-device-mod":"1277|MrCrayfish的设备 (MrCrayfish's Device Mod)|830159","block-armor":"1278|方块盔甲 (Block Armor)","stockpile":"1279|储物桶 (Stockpile)|818298","loot-slash-conquer":"1280|~|805062","candy-world":"1281|糖果世界 (Candy World)|812603","creativecore":"1283|~","instantunify":"1284|瞬间统一 (InstantUnify)|816966","mobdrops":"1286|更多掉落 (MobDrops)","states":"1287|城邦 (States)|819991","modular-machinery":"1288|模块化机械 (Modular Machinery)","compositegear":"1289|复合齿轮/复合装甲 (Composite Gear)","kiwi-fabric":"1290|~","cuisine":"1291|料理工艺 🍳 (Cuisine 🍳)|821999","world-control":"1292|世界控制 (World Control)","tree-chopper":"1294|砍树 (Tree Chopper)|630864","the-lost-cities":"1295|失落的城市 (The Lost Cities)|833685","simple-underground-biomes":"1299|简单地下生物群系 (Simple Underground Biomes)","the-camping-mod":"13|野营 (The Camping Mod)|230368","zen-foundry":"1300|禅：金属工坊 🌋 (Zen: Foundry 🌋)","galaxyadditions":"1303|~|1103561","animationapi":"1304|~","realbench":"1305|更好的工作台 (RealBench)","primalcore":"1306|原始核心 (PrimalCore)","primal-tech":"1307|原始科技 (Primal Tech)","antique-atlas":"1308|古式地图 (Antique Atlas)","xray-1-13-rift-modloader":"1310|~","overloaded":"1311|超限存储 (Overloaded)|817115","power-tools":"1312|现代工具 (Power Tools)","enchanting-plus":"1314|高级附魔台 (Enchanting Plus)|200972","stick-of-death":"1315|死亡之棍 (The Stick Of Death)","godweapons":"1316|神的武器 (Gods' Weapons)","sekwah41s-naruto-mod":"1317|sekwah41的火影忍者 (sekwah41's Naruto Mod)","constructs-armory":"1318|匠魂盔甲 (Construct's Armory)|786419","undertale-mod":"1320|传说之下 (UNDERTALE Mod)","globe":"1321|水晶球 (Globe)|789706","super-stick-sword":"1322|超级木棍剑 (Super Stick sword)","mekanism-generators":"1323|通用机械发电机 (Mekanism Generators)","spider-queen":"1324|蜘蛛女王 (Spider Queen)|525087","baublelicious":"1325|美妙饰品 (Baublelicious)|553597","void-monster":"1326|~","shields-plus":"1327|更多盾牌 (Shields Plus)","ghost-buster":"1328|~","culinary-construct":"1329|自定义三明治 (Culinary Construct)","armoreablemobs":"1330|怪物装备自定义 (ArmoreableMobs)","gem-buffs-infinite-potion-effects":"1331|宝石效果/增益宝石 (Gem Buffs)","advanced-inventory":"1333|~","crafting-pillar-mod":"1334|合成柱 (Crafting Pillar Mod)","pollution-of-the-realms":"1336|环境污染/领域的污染 (Pollution of the Realms)","heat-and-climate-lib":"1338|~","waystones-fabric":"1339|传送石碑 (Waystones)|1095026","thaumic-calculations":"1340|神秘计算器 (Thaumic Calculations)","pams-weee-flowers":"1341|潘马斯花园 (Pam's Weee! Flowers)|110931","paragliders":"1344|滑翔伞 (Paragliders)|1246990","ender-io-endergy":"1345|末影接口：管道拓展 (Ender IO:Endergy)|843550","bwm-suite":"1346|~","ambience-music-mod":"1347|环境音乐 (Ambience)|711711","almost-enough-items":"1348|AEI物品管理器 (Almost Enough Items)|812644","mtutils":"1349|~","gravestone-mod":"1350|墓碑 (GraveStone)|772774","atlas-extras":"1351|~","horse-power":"1352|马力 (Horse Power)","better-with-addons":"1353|~","tesla-core-lib":"1354|特斯拉核心 (Tesla Core Lib)","voidscape":"1355|虚空工艺 (Voidscape/VoidCraft)|825777","stygian-end-biome-expansion":"1356|末地：生物群系扩展 (Stygian End: Biome Expansion)","wooden-furnace":"1357|木制熔炉 (Wooden Furnace)|827260","moreplates":"1358|更多金属板 (More Plates)","morelibs":"1359|~","flatsigns":"136|平置牌子 (FlatSigns)","game-stages":"1360|游戏阶段 (Game Stages)|854578","the-building-game":"1361|建筑游戏 (The Building Game)","silents-gems":"1362|寂静宝石 (Silent's Gems)","silent-lib":"1363|~","silents-gems-tic-support":"1364|寂静宝石：匠魂支持 (Silent's Gems: TiC Support)","lit-little-insignificant-things":"1365|~","gemulation":"1366|~","silents-gems-extra-parts":"1367|寂静宝石：额外部件 (Silent's Gems: Extra Parts)","fun-ores":"1368|趣味矿石 (Fun Ores)","solar-furnaces":"1369|简易太阳能 (Simple Solar Panels)","switches":"137|按钮开关 (Switches)","vanilladeathchest-fabric":"1370|原版死亡箱子 (Vanilla Death Chest)|825450","arachnophobia":"1371|蜘蛛恐惧症 (Arachnophobia)|784755","abyssalcraft-integration":"1372|深渊国度联动 (AbyssalCraft Integration)|672323","prefab-fabric":"1373|预制建筑 (Prefab)","haunch-hud":"1374|~|818937","absent-by-design":"1375|~","no-nv-flash":"1376|无夜视闪烁 (No Night Vision Flashing)|984741","arcade-mod":"1377|街机 (Arcade Mod)|826772","asmodeuscore":"1378|~","building-gadgets":"1379|建筑小帮手 (Building Gadgets)|806768","artifice":"138|工匠的手艺 (Artifice)","dooglamoo-worlds":"1380|Dooglamoo的世界 (Dooglamoo Worlds)","scp-lockdown":"1381|SCP基金会：封锁 (SCP: Lockdown)|807971","middle-earth-thaumaturgy":"1382|中土神秘学 (Middle-Earth Thaumaturgy)|867665","structpro-mod-fast-schematic-spawning-system":"1383|自然神殿 (Structpro)|827204","betterfps":"1384|更好的FPS (BetterFPS)|539780","sky-compression":"1385|~","reap-mod":"1386|收获 (Reap)","geolosys":"1387|地质矿脉 (Geolosys)|935361","patchouli-fabric":"1388|帕秋莉手册 (Patchouli)","jeid":"1389|~","gases-framework":"1390|~","ranged-pumps":"1391|范围泵 (Ranged Pumps)|668293","bagginses":"1392|背包 (Bagginses)|628505","ic2-classic":"1393|工业时代2经典版 (IC2 Classic)|810416","cubicworldgen":"1395|~","rally-health":"1396|~","open-terrain-generator":"1397|开放地形生成器 (Open Terrain Generator)","noshelter":"1399|无庇护所 (NoShelter)","usefulfood":"14|有用的食物 (UsefulFood)|195107","archimedes-ships":"140|阿基米德之舟 (Archimedes' Ships)","epic-siege-mod":"1400|史诗攻城 (Epic Siege)|725125","furnace-overhaul":"1401|熔炉改革 (Furnace Overhaul)","architecturecraft-tridev":"1403|建筑师工艺重置版 (ArchitectureCraft - TridentMC Version)","ore-farm":"1404|矿石农场 (Ore Farm)","sound-physics-fabric":"1406|物理声效 (Sound Physics)|676189","plethora-peripherals":"1407|~","simple-flight":"1408|简单的飞行 (Simple Flight)|374613","factory-tech":"1409|工厂科技 (FactoryTech)","cubebots":"141|立方体机器人 (CubeBots)","blockrenderer":"1410|~","mysticallib":"1412|~","crissaegrim":"1413|~","traverse":"1416|遍历 (Traverse)","winter-wonder-land":"1417|霏雪寄语之地 (Winter Wonder Land)","road-stuff":"1418|道路2 (Road Stuff2)|609045","ae2wtlib":"1419|~","truss-mod":"142|桁架 (Truss Mod)","real-filing-cabinet":"1420|仿真档案柜 (Real Filing Cabinet)","hycrafthds-wtf-ic2-addon":"1421|WTF 工业拓展 (WTF Ic2 Addon)","u-team-core":"1422|~","ftb-quests-fabric":"1423|FTB任务 (FTB Quests)|849746","texfix":"1424|材质修复 (TexFix)|771588","mapmakers-gadgets":"1425|地图作者小帮手 (Mapmaker's Gadgets)","travellers-gear":"1426|旅者之器 (Traveller's Gear)","ceramics":"1427|陶瓷器 (Ceramics)","slashblade-japanese-addon-pack":"1428|拔刀剑日系附属包 (SlashBlade Japanese Addon Pack)|1230741","mutant-creatures-mod":"143|突变生物 (Mutant Creatures)","planet-progression":"1430|星球研究 (Planet Progression)","space-advanced-addon-for-galactic-craft-3":"1431|~","decimation-zombie-apocalypse":"1432|僵尸启示录 (Decimation)|878571","rift-mod-list":"1433|~","forgeendertech":"1434|~","new-tardis-mod":"1435|~","advanced-chimneys":"1437|高级烟囱 (Advanced Chimneys)|673890","regeneration":"1438|~","stevekungs-lib":"1439|~","make-zoom-zoom":"1440|更快的加载 (MakeZoomZoom)","minecraft-virtual-machines":"1441|Minecraft虚拟机 (Minecraft Virtual Machines)","cavern2":"1442|洞穴 II (Cavern II)|782780","notenoughids":"1443|增加ID上限 (NotEnoughIDs)","avaritia-recipe-generator":"1444|可视化无尽配方编辑器 (Avaritia Recipe Generator)","trapcraft":"1445|陷阱 (Trapcraft)|260090","mod-name-tooltip":"1446|模组名称显示 (Mod Name Tooltip)","gpick-2":"1447|进化之镐2 (GPickaxe 2)|795644","cxlibrary":"1448|~","logistics-pipes":"145|物流管道 (Logistics Pipes)","integrated-tunnels":"1450|集成管道 (Integrated Tunnels)|944541","unmending":"1451|经验不修补 (Unmending)","the-creeping-nether":"1452|蔓延的下界 (The Creeping Nether)","random-psideas":"1453|Psi随想 (Random PSIdeas)","expetrum":"1454|真实世界 (ExPetrum)|818194","equivalent-energistics":"1455|等价能源学 (Equivalent Energistics)","thedragonlib":"1456|~","repose":"1457|自动上坡 (Repose)","botanic-additions":"1458|植物学拓展 (Botanic Additions)","the-veggie-way":"1460|素食主义者 (The Veggie Way)","gargoyles-mod":"1461|石像鬼 (Gargoyles)","hydrophobia":"1462|恐水症 (Hydrophobia)","dimensional-edibles":"1463|维度食物 (Dimensional Edibles)","passable-leaves":"1464|叶间穿行 (Passable Leaves)|799088","swingthroughgrass":"1465|穿草攻击 (SwingThroughGrass)|691271","steves-bizarre-adventure":"1466|史蒂夫的奇妙冒险 (Steve's Bizarre Adventure)|839550","animania":"1467|动物谷：基础 (Animania Base)|817915","endertweaker":"1468|~","cofh-vanilla-tools":"1469|~","rarmor":"1471|功能装甲 (Rarmor)","immersive-io":"1472|沉浸接口 (Immersive IO)|839807","tickratechanger":"1473|运算变速 (TickrateChanger)|731107","botania-needs-these-things":"1474|植物魔法需要它！ (Botania Needs These Things!)|838714","nocubes":"1475|~","orelib":"1476|~","tick-dynamic":"1477|动态Tick (Tick-Dynamic)","surge":"1478|潮涌 (Surge)|923335","more-avaritia":"1479|~","magic-bees":"148|魔法蜜蜂 (Magic Bees)","ai-improvements":"1480|AI改进 (AI Improvements)","project-ex":"1481|等价交换升级 (Project EX)|1168453","xaeros-world-map":"1483|Xaero的世界地图 (Xaero's World Map)|616156","wizardry-mod":"1484|巫师艺术 (Wizardry)|910980","fastfurnace":"1485|熔炉性能优化 (FastFurnace)","fastworkbench":"1486|工作台性能优化 (FastWorkbench)","unbreaken":"1487|工具保护 (UnbreakEn)","bitcoin":"1488|比特币 (Bitcoin)","hungering-darkness":"1489|~","carpenters-blocks":"149|木匠方块 (Carpenter's Blocks)|461134","roots-classic":"1490|根源魔法经典版 (Roots Classic)","embers-rekindled":"1491|余烬复刻版 (Embers Rekindled)|681929","vending-machines-revamped":"1492|自动贩卖机 (VendingMachinesRevamped)|482613","thaumic-alchemy":"1493|神秘炼金学 (Thaumic Alchemy)|713264","move-plus":"1495|移动方式增强 (Move Plus)","future-minecraft":"1496|未来的版本 (FutureVersions)","contenttweaker":"1497|~","from-the-ground-up":"1498|白手起家 (From The Ground Up)|830883","clumps":"1499|经验机制改革 (Clumps)|769015","powerconverters-portablejims-fork":"15|能源转换 (PowerConverters)","mystcraft":"150|神秘岛 (Mystcraft)","dynamic-surroundings-huds":"1500|动态环境：信息显示 (Dynamic Surroundings: HUDs)","crafting-tweaks-fabric":"1501|合成辅助 (Crafting Tweaks)|682072","limelib":"1502|~","sparks-hammers":"1503|重锤火花 (Sparks Hammers)|658384","deadly-monsters":"1504|致命怪物 (Deadly Monsters)|666749","vanillaautomation":"1505|原版自动化 (VanillaAutomation)","vanilla-immersion":"1507|立体工具方块 (Vanilla Immersion)|726263","earthworks":"1508|土方工程 (Earthworks)","terraqueous":"1509|地灵云心/海树山花 (Terraqueous)","initial-inventory":"1510|自定义初始物品 (Initial Inventory)|1037306","interaction-wheel":"1511|~","water-strainer":"1512|滤水器 (Water Strainer)","tinkers-skyblock":"1513|匠魂空岛 (Tinkers' Skyblock)","diet-hoppers":"1514|漏斗碰撞箱修复 (Diet Hoppers)","xl-food-mod":"1515|超多食物 (XL Food Mod)","soot":"1516|烟尘 (Soot)","hp-spells":"1517|哈利·波特：法术 (Harry Potter Spells)|843371","recurrent-complex":"1518|自然建筑生成 (Recurrent Complex)|923814","capabilityproxy":"1519|功能代理 (CapabilityProxy)","reauth-fabric":"1520|~","autoverse":"1521|~","transprot":"1522|运输 (Transprot)","default-world-generator-port":"1523|~","better-questing-standard-expansion":"1524|更好的任务-基础扩展 (Better Questing - Standard Expansion)","exchangers":"1525|方块交换器 (Exchangers)","flexible-tools":"1526|灵活的工具 (Flexible Tools)","dimensional-control":"1527|维度控制 (Dimensional Control)","valkyrien-warfare":"1528|瓦尔基里天空/瓦尔基里战争 (Valkyrien Skies/Valkyrien Warfare)|804503","item-scroller":"1529|~","better-advancements":"1530|更好的进度 (Better Advancements)|1109188","lucraft-core":"1531|~","progressive-bosses":"1532|进化的BOSS (Progressive Bosses)|843928","persistent-bits":"1533|~","rc-roads":"1534|真实公路 (RC Roads)","emoticons":"1535|动作表情 (Emoticons)|831515","simple-diving-gear":"1536|简单的潜水装备 (Simple Diving Gear)","just-enough-energistics-jee":"1537|~","ironman":"1538|钢铁侠 (IronMan)","chunk-animator":"1539|区块加载动画 (Chunk Animator)","minesweeper-mod":"154|扫雷 (Minesweeper)","craftstudio-api":"1540|~","fisks-superheroes-2":"1542|菲斯克的超级英雄 (Fisk's Superheroes)|806138","aiot-botania":"1544|植物魔法全能工具 (AIOT Botania)","botania-tweaks":"1545|植物魔法调整 (Botania Tweaks)","albedo":"1546|~","natures-aura":"1547|自然灵气 (Nature's Aura)","void-island-control":"1549|~","minechess":"155|国际象棋 (MineChess)","ic2-nei-crop-plugin":"1550|IC2育种模拟器/杂交模拟器 (IC2 Crop-Breeding Plugin)","better-storage-too":"1551|更好的储存2 (Better Storage Too)","manaita-plus":"1552|更好的砧板 (Manaita Plus)|900754","bartworks":"1553|巴特的作品 (bartworks)","placeable-motor":"1555|可放置马达 (Placeable Motor)","exo-craft":"1556|~","simple-login":"1557|简单登录 (Simple Login)","grim-pack":"1558|Grim的Mod整合 (Grim Pack)","artisan-worktables":"1559|工匠之作/工匠工作台 (Artisan Worktables)|819099","ptrlib":"1560|~","creeper-awareness":"1561|爬行者意识 (Creeper Awareness)","what-fluid-fix":"1562|~","blue-skies":"1563|蔚蓝浩空 (Blue Skies)|850467","project-vibrant-journeys":"1564|活力之旅 (Project: Vibrant Journeys)","bed-bugs":"1565|修复卡床 (Bed Bugs)","biometweaker":"1566|生物群系修改器 (BiomeTweaker)","actuallycomputers":"1567|实用电脑 (ActuallyComputers)","fence-overhaul":"1568|斜栅栏 (Fence Overhaul)","zombie-players":"1569|僵尸玩家 (Zombie Players)","exotic-birds":"1570|珍奇鸟类 (Exotic Birds)","charset":"1571|~","biometweakercore":"1572|生物群系修改器扩展 (BiomeTweakerCore)","trashcans-reborn":"1573|~","compactdrawers":"1574|~","blockdispenser":"1575|发射器放置方块 (BlockDispenser)","redstone-paste":"1576|爬墙红石/粘性红石 (Redstone Paste)","dynamic-trees-traverse-compat":"1577|动态的树：遍历附属 (Dynamic Trees - Traverse Compat)","charset-lib":"1578|~","betternether":"1579|更好的下界 (BetterNether)|859523","time-machine-mod":"1580|时光机 (Time Machine)","upsizer-mod":"1582|更大的堆叠数量 (Upsizer Mod)","fence-jumper":"1583|越过栅栏 (Fence Jumper)|783865","enchantments-exchanger":"1584|便携附魔替换台 (Enchantments Exchanger)|823400","additional-enchanted-miner":"1585|~","treasure-bags":"1586|藏宝袋 (Treasure Bags)","stevecraft-by-owenpsteve2":"1587|史蒂夫工艺 (SteveCraft)","hunger-games":"1588|饥饿游戏 (The Hunger Games)","tfctech-addon":"1589|群峦工业 (TFCTech Addon)","yunomakegoodmap":"1590|~","organic-creepers":"1591|苦力怕蕨 (Organic Creepers)","industrial-renewal":"1595|工业复兴 (Industrial Renewal)","draconicadditions":"1596|龙之进化拓展 (Draconic Additions)|914734","hated-mobs":"1598|令人讨厌的生物 (Hated Mobs)","mekanica":"1600|通用机械：DZ版 (Mekanica)","littletiles":"1601|LT小方块 (LittleTiles)|726890","extended-crafting":"1602|合成拓展 (Extended Crafting)|947515","prodigy-tech":"1603|奇才妙械 (Prodigy Tech)|909679","item-filters-fabric":"1605|物品过滤器 (Item Filters​)","eblib":"1606|~","notenoughcodecs":"1607|~","future-mc":"1608|未来的MC (Future MC)|913598","rope-bridge":"1609|索桥 (Rope Bridge)","sbm-oil-ore":"1610|油矿石 (Oil Ore)","redstone-minus-redstone":"1611|红石减红石 (Redstone Minus Redstone)","more-furnaces":"1612|更多熔炉 (More Furnaces)","integrated-crafting":"1613|集成合成学 (Integrated Crafting)","integrated-terminals":"1614|集成终端 (Integrated Terminals)","mekanism-tools":"1615|通用机械工具 (Mekanism Tools)","roboticparts":"1616|机械改造1.12+ (Robotic Parts)","rewired":"1617|~","oh-the-biomes-youll-go-fabric":"1618|你将去的生物群系 (Oh The Biomes You'll Go)","vertically-stacked-dimensions":"1619|垂直堆叠的世界 (Vertically Stacked Dimensions)","malisisswitches":"1621|~","automated-redstone":"1622|自动化红石 (Automated Redstone)","thuts-elevators":"1623|Thutmose的电梯 (Thut's Elevators)|692866","additional-resources":"1624|~","sky-orchards":"1625|天空果园 (Sky Orchards)","mdxlib":"1626|~","wireless-utilities":"1627|无线设备 (Wireless Utilities)","tometinkers":"1628|~","tinkers-slashblade":"1629|刀锻冶匠魂 (Tinker's SlashBlade)|846907","audio-death":"1630|死亡音效 (Audio Death)","deep-mob-learning":"1631|深度怪物学习 (Deep Mob Learning)","tofucraftreload":"1633|豆腐工艺重制版 (TofuCraftReload)|946310","electroblobs-wizardry":"1634|巫术学 (Electroblob's Wizardry)|894070","moarsigns":"1635|更多牌子 (MoarSigns)|547700","kamen-rider-craft":"1636|假面骑士工艺 (KamenRiderCraft)","avaritia-io":"1637|无尽贪婪：接口 (Avaritia IO)","dense-neutron-collectors-1-7":"1638|致密中子态素收集器 (Dense Neutron Collectors)","pubgmc-mod":"1639|~","project-red-compat":"2861|红石计划：兼容性","mobultion":"1640|进化怪物 (mobultion)|783073","waddles":"1641|~","project-intelligence":"1642|PI文档 (Project Intelligence)","thutcore":"1643|~","resource-pack-organizer":"1644|资源包管理器 (Resource Pack Organizer)|721005","morcant-ore":"1645|莫桑矿石 (Morcant Ore)","force-void-world":"1646|强制虚空世界 (Force Void World)","i-am-very-smart-forge":"1647|我很聪明 (I Am Very Smart)","far-from-home":"1648|背井离乡 (Far From Home)","cotton":"1649|~","oxygen-teleportation":"1650|~","oxygen-core":"1651|氧气核心 (Oxygen Core)","lead-villagers":"1652|带领村民 (Lead Villagers)","delta-hard-mode":"1653|Delta 困难模式 (Delta Hard Mode)|868260","id-squeezer-tweak":"1654|~","food-ores":"1655|食物矿石 (Food Ores)|853666","sit-fabric":"1656|席地而坐 (Sit)|1088610","dimensionaldoors":"166|次元门 (Dimensional Doors)|896027","cplpibalds-tweaks":"1660|CplPibald的微调 (CplPibald's Tweaks)","ore-biome":"1661|矿石生态群系 (Ore Biome)","farmadventure":"1662|农场冒险 (Farm Adventure)","japaricraftmod-2":"1664|加帕里公园 (JapariCraftMod)","mchorses-mclib":"1665|~","musiccraft-mod":"1666|音乐工艺 (MusicCraft mod)|276475","hardcore-darkness":"1667|真实的黑夜 (Hardcore Darkness)","cola-craft":"1668|可乐工艺 (Cola Craft)","chicken-chunks-1-8":"167|区块载入器 (ChickenChunks)","backstab":"1670|背刺 (BackStab)","dynamic-stealth":"1671|动态潜行 (Dynamic Stealth)|840795","roughly-enough-items":"1674|REI物品管理器 (Roughly Enough Items)|1265546","modmenu":"1675|模组菜单 (Mod Menu)","rei-addons":"1676|~","illuminations":"1677|~","mappy":"1678|~","mouse-wheelie":"1679|急速滚轮 (Mouse Wheelie)","mrcrayfishs-vehicle-mod":"1680|MrCrayfish的载具 (MrCrayfish`s Vehicle Mod)|867766","cc-tweaked":"1681|~","aliensvspredator":"1682|异形大战铁血战士 (AliensVsPredator)","dragon-murder":"1683|~","refined-machinery":"1684|精致机械 (Refined Machinery)|867043","birds-nests":"1685|鸟巢 (Birds Nests)","minecraft-animated":"1686|~","magicalsculpture":"1689|魔法雕像 (MagicalSculpture)|868224","ash-another-simple-hud":"1690|另一个简单的HUD (Another Simple HUD)","custom-selection-box-port":"1691|自定义选择框 (Custom Selection Box)","librikka-api":"1692|~","not-enough-wands":"1693|更多魔杖 (Not Enough Wands)","deep-mob-learning-blood-magic-addon":"1694|深度怪物知识-血魔法插件 (Deep Mob Learning - Blood Magic Addon)","informed-load-fabric":"1695|更多加载信息 (Informed Load)","huajiage-infinite-galaxy":"1696|滑稽纪元II:无尽星河 (Huaji Age II:Infinite Galaxy)|862800","cqrepoured":"1698|寻找巧克力重铸版 (Chocolate Quest Repoured)","fabricproxy":"1699|Fabric群组支持 (FabricProxy)","ex-sartagine":"1700|锅具 (Ex Sartagine)|780936","xaeros-minimap":"1701|Xaero的小地图 (Xaero's Minimap)|545145","everlastingabilities-potioncore":"1702|永恒能力-药水核心 (EverlastingAbilities-PotionCore)","optifabric":"1703|~|1113013","the-emerald-haven":"1704|翡翠天堂 (The Emerald Haven)|908155","simple-grinder":"1706|简易研磨机 (Simple Grinder)|801070","redstone-gauges-and-switches":"1707|红石测量与开关 (Redstone Gauges and Switches)","apotheosis":"1708|神化 (Apotheosis)|905214","lighting-wand":"1709|照明魔杖 🌟 (Lighting Wand 🌟)","morph":"171|变身 (Morph)","terrarium":"1710|地球 (Terrarium)","climatic-biomes":"1711|~","howling-moon":"1712|狼人 (Howling Moon)","hostile-worlds-invasions":"1713|敌对世界-入侵 (Hostile Worlds - Invasions)","simple-storage-network":"1714|简单存储 (Simple Storage Network)","scaling-health":"1716|~|1153595","minecoprocessors":"1717|微处理器 (Minecoprocessors)","difficult-life":"1719|~","mekanismores":"1720|通用机械矿石 (MekanismOres)","pyrotech":"1721|火种科技 (Pyrotech)","rats":"1722|老鼠 (Rats)|1117540","serversync":"1723|服务器同步 (ServerSync)|1140732","auxilium-equivalence":"1725|等价交换辅助 (Auxilium Equivalence / Auxilium)|1124866","bionisation-2":"1726|细菌病毒 (Bionisation)|784253","tiny-mob-farm":"1727|迷你刷怪场 (Tiny Mob Farm)|838630","soulus":"1728|~","sanlib":"1729|~","travelers-backpack-fabric":"1732|旅行者背包 (Traveler's Backpack)","gregtech-classic":"1733|格雷科技经典版 (GregTech Classic)|968064","aperture":"1734|~|705836","combo-armors":"1735|组合装甲 (IC2ComboArmors)|86941","nonausea":"1737|没有反胃 (NoNausea)","communism-mod":"1738|苏维埃工坊 (Communism Mod)","mirror":"1739|~","extracells2":"174|更多存储单元2 (Extra Cells 2)","ping":"1740|~","the-legends-mod":"1741|~","bad-wither-no-cookie-reloaded-fabric":"1742|~|734965","giacomos-fishing-net":"1743|~","hospital-mod-theatres-pack":"1744|医院Mod (The Hospital Mod)|873210","more-charcoal":"1745|更多木炭 (More Charcoal)","born-in-a-barn":"1746|~","aqua-acrobatics":"1747|水游技艺 (Aqua Acrobatics)","better-animations-collection-2":"1748|更好的动物动作2 (Better Animations Collection 2)","quality-tools":"1750|工具品质 (Quality Tools)","toolscombine":"1751|工具组合 (Tools Combine)","pollutant-pump":"1752|污染泵 (Pollutant Pump)","infinite-pollution-filter":"1753|无限污染过滤器 (Infinite Pollution Filter)","jei-hider":"1754|~","fastflyblockbreaking":"1755|飞行速破 (Fast Fly Block Breaking)","exhausted-stamina":"1756|竭力攻击 (Exhausted Stamina)","planttech-2":"1757|植物科技2 (PlantTech 2)|905616","toast-control":"1758|消息框控制 (Toast Control)","cocoa-magic":"1760|可可工艺 (Cocoa Magic)|1145375","betterportals":"1761|更好的传送门 (Better Portals)","classic-combat":"1762|经典战斗 (Classic Combat)","less-lag":"1764|较少的滞后 (Less Lag)|785968","goodbye-grass":"1765|没有草丛 (Grassta la Vista)","phosphor-forge":"1766|磷 (Phosphor)|1081821","clay-bucket":"1767|粘土桶 (Clay Bucket)|632083","extra-anvils":"1768|更多铁砧/更多砧 (Extra anvils)","glassential-fabric":"1769|精致玻璃 (Glassential)|1098398","billund-223258":"177|乐高 (Billund)","tinkers-addons":"1770|匠魂拓展 (Tinkers' Addons)","barrels-drums-storage-more":"1771|桶，圆桶，存储&更多 (Barrels, Drums, Storage & More)","wings":"1772|翅膀 (Wings)","up-and-down-and-all-around":"1773|颠倒世界 (Up And Down And All Around)","lost-souls":"1774|失落的灵魂 (Lost Souls)","intelligent-energistics":"1775|智能能源 (Intelligent Energistics)","ender-compass":"1776|末影指南针 (Ender Compass)|785069","ic2-tweaker":"1777|~","thaumic-gadgets":"1778|神秘宝具 (Thaumic Gadgets)","multi-mine":"1779|多人开采 (Multi Mine)","extra-foam-for-liteloader":"1780|Liteloader修复 (Extra Foam For LiteLoader)|982739","embersified":"1781|余烬能量转换 (Embersified)","ichunutil":"1782|~","thaumic-grid":"1783|神秘网络 (Thaumic Grid)","back-tools":"1784|工具后置/后背工具展示 (Back Tools)","mapwriter-2":"1785|地图作者2 (Mapwriter 2)|680409","dartcraft-reloaded":"1786|达特工艺重置版 (Dartcraft Reloaded)|920140","ceu":"1788|~","fantastic-lib":"1789|~","better-bows":"179|更好弓箭系统 (Better Archery Mod)","dm2":"1790|龙骑士2 (Dragon Mounts 2)","tiquality":"1791|~","loot-capacitor-tooltips":"1792|电容信息显示 (Loot Capacitor Tooltips)|888624","classic-bars":"1793|经典状态条 (Classic Bars)","overground-ores":"1795|地表矿石 (Overground Ores)","touhou-little-maid":"1796|车万女仆 (Touhou Little Maid)|882845","eureka":"1798|~","lazy-ae2":"1799|懒人AE2 (Lazy AE2)","modular-forcefield-system":"18|模块化力场系统 (Modular Forcefield System)","mumblelink":"180|Mumble语音链接 (Mumblelink)","libnine":"1800|~","equaldragons":"1801|~","berries":"1802|~","infinity-gauntlet-mod":"1803|无限手套 (Infinity Gauntlet)","mighty-ender-chicken":"1804|强大的末影鸡 (Mighty Ender Chicken)","malisisadvert":"1805|广告牌 (MalisisAdvert)","ido":"1806|移动 (Idō)","bat-happy-mod":"1807|🦇蝙蝠快乐MOD (🦇 Bat Happy Mod)","viescraft-airships":"1808|维斯工艺-飞艇！ (ViesCraft - Airships!)","the-ultimate-dimension":"1809|究极次元 (The Ultimate Dimension)|885906","ender-io":"181|末影接口 (Ender IO)|677063","advanced-mortars":"1810|更好的研钵 (Advanced Mortars)","crafttweaker-utils":"1812|~","fps-reducer":"1815|FPS减速器 (FPS Reducer)","freelook":"1816|自由视角 (FreeLook)","spacecraftx-reloaded":"1817|航天高科X (SpaceCraftX)","bamboo-everything-fabric":"1819|竹子制品 (Bamboo Everything)","nofog":"1820|没有雾 (NoFog)","essentia-brazier":"1821|源质火盆 (Essentia Brazier)","antipotionmod-1-12-2":"1822|无药水效果 (AntiPotionMod)","quark-oddities":"1823|夸克-奇思妙想 (Quark Oddities)","fast-food":"1824|快餐 (Fast Food)","more-carrots":"1825|更多的萝卜 (More Carrots)","d-maneuver-gear":"1826|3D立体机动装置 (3D Maneuver Gear)","weapon-craftery":"1827|武器工匠 (Weapon Craftery)","bobos-supermarket":"1828|Bobo的超市 (Bobo's supermarket)","even-more-apples":"1829|更多的苹果 (More Apples)","lucky-beans":"1830|幸运豆 (Lucky Beans)","cooked":"1831|~","afaoe":"1832|~","birds-foods":"1833|~|807358","morexfood":"1834|~","yummy":"1835|美味 (Yummy)","spice-of-life-carrot-edition":"1836|生活调味料：胡萝卜版 (Spice of Life: Carrot Edition)|772478","refined-exchange":"1837|~","rs-requestify":"1838|精致存储：请求者 (Refined Storage: Requestify)|1098079","pizzacraft":"1839|披萨工艺 (PizzaCraft)","super-factory-manager":"1840|超级工厂管理 (Super Factory Manager)","sakura":"1841|樱 (Sakura)|895337","sips":"1842|更多液体容器 (Sips)","gregs-construct":"1843|格雷与匠魂 (Greg's Construct)","locks":"1846|锁 (Locks)","special-mobs":"1847|特殊怪物 (Special Mobs)","adorn-for-forge":"1848|~","missingbits":"1849|~","electrodynamics":"185|电动力学 (Electrodynamics)","locky":"1852|~","baubleshud":"1853|~","landcore":"1855|陆地工艺核心 (LandCore)","mystical-world":"1857|魔幻世界 (Mystical World)|991631","extra-golems":"1858|更多傀儡 (Extra Golems)","craftablecreativemodifier":"1859|可合成的创造模式强化头颅 (CraftableCreativeModifier)","elite-armageddon":"186|~","ruins-structure-spawning-system":"1860|遗迹 (Ruins)|771602","armory-expansion":"1861|匠魂盔甲扩展 (Armory Expansion)","wg-block-replacer":"1862|方块生成替换器 (WorldGen Block Replacer)|785486","multi-mob-core":"1863|~","structurize":"1865|结构化 (Structurize)","improvable-skills":"1867|技能进阶 (Improvable Skills 3)","bounding-box-outline-reloaded":"1869|自然生成建筑结构显示 (Bounding Box Outline Reloaded)","mekanism":"187|通用机械 (Mekanism)|654082","sauceconstruct":"1870|~","health-overlay":"1871|更美观的血条 (Health Overlay)","auto-feeder-helmet":"1872|自动进食头盔 (Auto Feeder Helmet)","cc-tweaked-fabric":"1873|~","simple-farming":"1874|简单农业 (Simple Farming)|988997","bigger-packets-please":"1875|~","lockyz-extra-dimensions-mod":"1876|更多维度世界 (Lockyz Extra Dimensions)","psi-combat-magic":"1877|~","dtphc":"1878|动态的树：潘马斯附属 (Dynamic Trees - Pam's Harvestcraft Compat)","largefluidtank-fabric":"1879|大型储罐 (Large Fluid Tank)","tumbleweed":"1880|风滚草 (Tumbleweed)","cubicdynamictreescompat":"1881|~","thermallogistics":"1882|热力物流学 (Thermal Logistics)","bithop":"1883|~","swordskillsapi":"1884|~","dynamic-sword-skills":"1885|动态剑技 (Dynamic Sword Skills)|906987","magical-instruments":"1886|魔法乐器 (Magical Instruments)","enderspawn":"1887|末影龙再生成 (EnderSpawn)|501726","animus":"1888|~","scootys-scp-lockdown-extras":"1889|scp重型收容区扩展 (SCP: Lockdown Heavy Containment Zone Expansion)","modern-glass-doors":"1890|时尚玻璃门 (Modern Glass Doors)|886035","lemonlib":"1891|柠檬库 (lemonlib)","statues-rechiseled":"1892|雕像：重置 (Statues: Rechiseled)","trashslot-fabric-edition":"1893|垃圾槽 (TrashSlot)","player-plates-fabric":"1894|更多压力板 (Player Plates)","just-sleep":"1895|我就睡个觉 (Just Sleep)","auto-network-lib":"1896|~","click-machine":"1897|自动连点器 (Click Machine)","mystical-adaptations":"1898|更好的神秘农业 (Mystical Adaptations)|887221","reinforcedtools":"1899|强化工具 (ReinforcedTools)|674729","magic-crusade-rpg-mod":"190|魔法远征:魔法十字军 (Magic Crusade)","killing-fall":"1900|~","more-dogs":"1901|更多狗狗 (More Dogs)","snow-variants":"1902|更好的雪 (Snow Variants)","searchable-chests":"1903|箱子搜索栏 (Searchable Chests)","bad-mobs":"1904|~|568141","mc-paint":"1905|涂鸦 (MC Paint)","goprone-fabric":"1906|匍匐前进 (GoProne)|1107815","ceiling-torch":"1907|倒置火把 (Ceiling Torch)|885948","air-hop-fabric":"1908|多段跳 (Air Hop)","better-combat-mod":"1909|更好的战斗 (Better Combat Mod)","invasions":"191|入侵 (Invasion)","ftb-money":"1910|FTB交易 (FTB Money)","restricted-portals":"1911|传送门限制 (Restricted Portals)","vampirelib":"1912|~","ingameconfigmanager":"1913|游戏内配置器 (InGameConfigManager)","playerrevive":"1914|玩家救援 (PlayerRevive)","farlands":"1915|边境之地 (FarLands)","inworldcrafting":"1916|世界合成 (InWorldCrafting)","food-editor":"1917|食物编辑器 (Food Editor)","custom-starter-gear":"1918|自定义初始装备 (Custom Starter Gear)","ct-tinycoal":"1919|CT 小型煤炭 (CT TinyCoal)","mb-battlegear-2":"192|挖矿与砍杀:双持与战备2 (Mine & Blade: Battlegear 2)","tweaker-gui":"1920|~|816003","crafttweaker-editor":"1921|CraftTweaker 编辑器 (CraftTweaker Editor)","unforgiving-void":"1922|不那么仁慈的虚空 (Unforgiving Void)","moretweaker":"1923|~","riteclicker-mod":"1924|小石子 (RiteClicker Mod)","forgiving-void-fabric":"1926|仁慈的虚空 (Forgiving Void)","bread-craft":"1927|面包工艺 (Bread Craft)","alchemistry":"1928|炼金化学 (Alchemistry)","damage-control":"1929|伤害控制 (Damage Control)","prestige":"1930|成就点 (Prestige)","yukarilib":"1932|~","energy-converters":"1933|能量桥接器 (EnergyConverters)","signpost":"1934|路标 (Signpost)","diagonal-panes":"1935|对角线玻璃板 (Diagonal Panes)","forgelin":"1936|~","all":"1937|~","exp-ore-block-mod":"1938|经验矿石 (Exp Ore)","more-glowstone":"1939|更多荧石 (More Glowstone)|873535","galacticraft-legacy":"194|星系 (GalactiCraft)|802464","gregic-additions":"1941|~","instantlava":"1942|无限岩浆 (InstantLava)|684726","enchantment-descriptions":"1945|附魔描述 (Enchantment Descriptions)","streak":"1946|残影 (Streak)","dttc":"1947|动态的树：神秘时代附属 (Dynamic Trees - Thaumcraft Compat)","dtbop":"1948|动态的树：超多生物群系附属 (Dynamic Trees - Biomes O' Plenty Compat)|798337","dynamic-trees-compatibility-for-climatic-biomes":"1949|动态的树：气候生态群系附属 (Dynamic Trees Compatibility for Climatic Biomes)","capability-adapter":"1950|ME功能适配器 (ME Capability Adapter)","tf2-stuff-mod":"1951|军团要塞2 (TF2 stuff mod)|887461","mob-control-wands":"1952|怪物控制魔杖 (Mob Control Wands)","athenaeum-1-16":"1954|~","ore-excavation":"1955|矿石挖掘 (Ore Excavation)|702872","stone-chests":"1956|石箱子 (Stone Chests)","kjlib":"1957|KJ库 (KJLib)","iron-chest-minecarts":"1958|更多箱子矿车 (Iron Chest Minecarts)","nether-chest":"1959|下界箱子 (Nether Chest)","mob-kill-messages":"1960|击杀信息通知 (Mob Kill Messages)","betterdispenser":"1962|能喂食的发射器 (Better Dispenser)","shulkerboxdisplay":"1963|潜影盒显示器 (ShulkerBoxDisplay)|912440","mycommands":"1964|我的命令 (MyCommands)|588293","hearth-well":"1968|~|909385","tea-and-biscuits":"1970|茶和饼干 (Tea And Biscuits)|820208","controllable":"1971|手柄控制 (Controllable)","genetic-animals":"1972|遗传动物 (Genetic Animals)","stone-chest":"1973|石头箱子 (Stone Chest)","iron-shulker-boxes":"1974|更多潜影盒 (Iron Shulker Boxes)","mob-dismemberment":"1975|怪物肢解 (Mob Dismemberment)","zoo-wild-animals-rebuild":"1976|野生动物园：重制版 (Zoo & Wild Animals Rebuilt)","kottle":"1977|~","customdrones":"1978|自定义无人机 (Custom Drones)|608228","call-to-battle-2-authentic-world-war-2-experience":"1979|战争召唤2 (Call To Battle 2)","journeymap":"198|旅行地图 (Journey Map)|612917","some-like-it-dry":"1980|~","yungs-better-caves-fabric":"1981|YUNG的洞穴优化 (YUNG's Better Caves)","resynth":"1982|神农科技 (Resynth)|916667","flatworld":"1983|开山棒 (Flat World)|675894","pymtech":"1984|皮姆科技 (PymTech)","corail-tombstone":"1985|Corail的墓碑 (Corail's Tombstone)|913702","arcane-archives":"1988|奥术档案馆 (Arcane Archives)|1006624","divineweapon":"1989|神兵 (DivineWeapon)","camera-obscura":"1990|朝花夕拾 (Camera Obscura)","animales":"1991|动物扩充 (Animales)","armor-underwear-mod":"1992|盔甲内衬 (Armor Underwear Mod)","assisted-progression":"1993|进度小助手 (Assisted Progression)","more-buckets":"1994|更多桶 (More Buckets)","laggoggles":"1995|延迟监视 (LagGoggles)|785024","the-weirding-gadget":"1996|古怪装置 (The Weirding Gadget)","energysynergy":"1997|能源协同 (EnergySynergy)","mine-and-slash-reloaded":"1998|挖矿与砍杀 (Mine and Slash)|869674","industrial-craft":"2|工业时代2 (Industrial Craft 2)|515771","iron-chests-for-fabric":"20|更多箱子 (Iron Chests)|372723","monster-swarm":"2000|怪物云集 (Monster Swarm)|439839","SimplePipes":"2001|~","amecs":"2003|~","world-primer":"2004|~","bookworm":"2006|~","openeye":"2007|错误报告器 (OpenEye)","let-sleeping-dogs-lie":"2008|嘘，别吵醒狗狗 (Let Sleeping Dogs Lie)","bspkrscore-updated":"2009|~|430478","undergroundbiomesconstructs":"201|科学地质 (Underground Biomes)","super-ores":"2010|超级矿石 (Super Ores)|704620","gravelminer-fabric":"2011|砂砾终结者 (GravelMiner)|1126578","client-tweaks-fabric":"2012|客户端微调 (Client Tweaks)|915029","single-use-crafting-table-mod":"2013|一次性工作台 (Single-Use Crafting Table Mod)","get-back-to-home":"2014|回家 (Get Back to Home)","expanded-equivalence":"2015|等价扩展 (Expanded Equivalence)","schematica":"2016|~|893275","scp-craft-decline":"2017|SCPCraft - 下降 (SCPCraft - Decline)","tetra":"2018|~|804377","minestrappolation-5":"2019|~","fpsplus-lagfixes":"202|FPS优化 (FPS Plus)","underwater-biome":"2020|深海生态 (Underwater Biome)|923907","create-fabric":"2021|机械动力 (Create)|1088970","energeticsheep":"2024|脉冲羊 (EnergeticSheep)","ensorcellation":"2025|万象 (Ensorcellation)|1016362","inventory-sorter":"2026|物品分拣 (Inventory Sorter)","speedster-heroes":"2027|闪电侠 (Speedster Heroes)|685240","curios-fabric":"2029|~","ars-magica-2":"203|魔法艺术2 (Ars Magica 2)","village-spawn-point-fabric":"2030|村庄出生点 (Village Spawn Point)","spawnercraft":"2031|刷怪笼合成 (SpawnerCraft)|692662","openfm":"2032|开放电台 (OpenFM)|522352","the-dalek-mod":"2033|神秘博士 (The Dalek Mod)","modular-diversity":"2034|模块化多样性 (Modular Diversity)","botanic-bonsai":"2035|植物魔法盆栽 (Botanic Bonsai)","modular-magic":"2036|模块化魔法 (Modular Magic)","magic-kingdoms-mod":"2038|魔法王国 (Magic Kingdoms Mod/Schools of Magic Mod)","zollern-galaxy":"2039|卓伦星系 (Zollern Galaxy)","thaumcraft":"956|神秘时代|776706","macaws-bridges":"2040|Macaw的桥梁 (Macaw's Bridges)","trample-stopper-fabric":"2042|防止踩踏 (Trample Stopper)|803109","macaws-roofs":"2043|Macaw的屋顶 (Macaw's Roofs)","shadows-of-greg":"2044|格雷之影 (Shadows of Greg)","loottabletweaker":"2045|~","rockycore":"2046|~","tree-tweaker":"2047|~","worleys-caves":"2048|沃利的洞穴 (Worley's Caves)","additional-structures-fabric":"2049|失落废墟 (Additional Structures/Rex's Additional Structures)","highlands":"205|高地 (Highlands)","enhancedvisuals":"2054|增强视觉效果/拓展视觉效果 (EnhancedVisuals)","potion-fingers-redux":"2055|药剂环 (Potion Rings)","balloon-sheep":"2056|气球羊 (Balloon Sheep)|900147","farming-for-blockheads-fabric":"2057|傻瓜式农贸市场 (Farming for Blockheads)","oreexcavation-integration":"2058|矿物开凿 (Ore Excavation Integration)","engineers-workshop":"2059|工程师工作站 (Engineers Workshop)","doggy-talents":"206|小狗天才 (Doggy Talents)|713458","the_legend_of_the_brave":"2060|勇者传说 (The Legend of The Brave)|916377","twerk-sim-2k16":"2061|~","fart-generator":"2062|屁能发电机 (Fart Energy Generator)","ex-nihilo-fabrico":"2063|无中生有：Fabrico (Ex Nihilo Fabrico)","holoinventory":"2064|物品显示/物品清单 (HoloInventory)","reactor-stuff":"2065|反应堆材料 (Reactor Stuff)|927559","traitors-better-swampland-mod":"2066|更好的沼泽 (Traitor's Better Swamplands Mod)","soviet-abandoned-lab-mod":"2067|苏维埃风格装饰 (Soviet Era Mod(earlier Soviet Lab))","charm-reforged":"2069|~","plasmacraft":"207|电浆工艺 (PlasmaCraft)","villager-names-fabric":"2070|村庄名字 (Village Names)","advanced-rocketry-tweaker":"2071|~","alternating-flux":"2072|交变磁通 (Alternating Flux)","projectextended":"2073|等价交换扩展 (ProjectExtended)","tfc-metallum":"2074|群峦合金 (TFC：Metallum)","reactor-turbines-mod-for-ic2":"2075|~","mutant-beasts":"2076|突变生物重置版 (Mutant Beasts)","jei-integration":"2077|JEI扩展 (JEI Integration)|1101324","funny-fruit":"2078|滑稽果 (FunnyFruit)","life-tech":"2079|生命工艺 (Life Tech)","exponential-power":"2080|~","girl-armor-mod":"2081|女式盔甲 (V-Girl Armor Mod)","nomadic-tents":"2083|游牧帐篷 (Nomadic Tents)","zetta-industries":"2084|泽它重工 (Zetta Industries)","kekztech":"2085|~","by-the-gods":"2086|神迹 (By The Gods)","bee-angry-est":"2087|愤怒的蜜蜂 (Bee Angry-est)","titanium":"2088|钛 (Titanium)","chemlib":"2089|~","fossils":"209|考古与化石 (Fossils and Archeology Revival)|856874","carrots-lib":"2090|胡萝卜库 (Carrots Library)","no-hostiles-around-campfire-fabric":"2091|围火无怪 (No Hostiles Around Campfire)","healing-campfire":"2092|治愈营火 (Healing Campfire)","231455-minetunes":"2093|~","jetif":"2094|物品丢入流体 (Just Enough Throwing In Fluids)","rftools-base":"2095|RF工具：基础 (RFTools Base)","flopper":"2096|流体漏斗 (Flopper)","staminaplus":"2098|耐力值 (StaminaPlus)","enhanced-armaments":"2099|增强装备 (Enhanced Armaments)|898546","balkons-weaponmod":"21|更多武器 (Balkon's WeaponMod)","glenns-gases":"210|格林的气体 (Glenn's Gases)","spatialcompat":"2100|空间兼容 (SpatialCompat)","extended-reach":"2101|~","no-recipe-book":"2102|没有配方书 (No Recipe Book)","darknesslib":"2103|~","tfcraft":"2104|群峦传说|887732","redstone-control":"2105|红石控制 (Redstone Control)","snow-real-magic-fabric":"2106|雪！真实的魔法！⛄ (Snow! Real Magic! ⛄)|871191","comforts-fabric":"2107|舒适用品 (Comforts)","plasmacannon":"2108|等离子炮 (PlasmaCannon)|930033","plasmaengines":"2109|等离子引擎 (PlasmaEngines)|930034","the-lord-of-the-rings-mod-legacy":"211|魔戒：传承 (The Lord of the Rings Mod: Legacy)|1084629","bonny-food":"2110|~","emerging-technology-hydroponics":"2111|新兴技术 (Emerging Technology)|934929","twilightopia-phantasy":"2114|暮托邦之梦 (Twilightopia)|977230","engineers-decor":"2115|工程师的装饰 (Engineer's Decor)","engineers-tools":"2116|工程师的工具 (Engineer's Tools)","wesleys-roguelike-dungeons":"2117|Wesley的冒险地牢 (Wesley's Roguelike Dungeons)","xp-tome":"2118|~","varied-commodities":"2119|~","thaumic-tinkerer":"212|神秘工匠 (Thaumic Tinkerer)","tinkers-things":"2120|匠魂扩增 (Tinkers' Things)","just-enough-buttons":"2121|更多的按钮 (Just Enough Buttons)|678566","clock-hud":"2122|时间显示器 (Clock HUD)","tektopia":"2123|桃花源记/特克托皮亚 (TekTopia)|980572","muya1-7-10":"2124|姆亚核心 (MuyaCore)","fabric-language-kotlin":"2126|~","ftb-backups":"2127|FTB备份 (FTB Backups)","cyclopstek":"2128|独眼巨人 (CyclopsTek)","champions":"2130|冠军/强敌 (Champions)|998116","danger-lies-ahead":"2131|前路危机 (Danger Lies Ahead)|905359","croploadcore":"2132|~","defiled-lands":"2133|污秽之地 (Defiled Lands)|965119","arcanum":"2134|奥秘 (Arcanum)|804291","random-enchants":"2135|随机附魔 (Random Enchants)|963657","much-more-spiders-v2":"2136|更多种类的蜘蛛 (Much More Spiders)|521013","compressed-items":"2137|~","no-tree-punching":"2138|无树可撸 (No Tree Punching)|1066911","harvest-festival-legacy":"2139|丰收物语移植版 (Harvest Festival Legacy)","metallurgy":"322|冶金|273214","friendlymobs":"2140|友好的怪物 (FriendlyMobs)|698723","simplecore-api":"2141|简单前置 (SimpleCore API)","topography":"2142|地形 (Topography)|926097","jei-villagers":"2143|JEI村民交易查看 (JEI Villagers)|772483","bnbgamingcore":"2144|~","igauntlet":"2145|灭霸手套 (IGauntlet)","alcatrazcore":"2146|~","debugserverinfo":"2147|~","the-midnight":"2148|午夜 (The Midnight)|943646","moolands":"2149|奶牛世界 (Moolands)","egg-craft":"2150|蛋工艺 (Egg Craft)|952118","tinkersextras":"2151|~","poke-lucky":"2152|宝可梦幸运方块 (PokeLucky)|791757","usefultnt":"2153|更有用的TNT (UsefulTNT)","crow-flight":"2155|乌鸦坐飞机 (Crow Flight)","findme":"2156|~","minecraft-transit-railway":"2157|我的世界铁路 (Minecraft Transit Railway)|1173523","random-loot-mod":"2158|随机战利品 (Random Loot Mod)","tinkers-aether-dman-edition":"2160|天境工匠 (Tinkers Aether)","mine-and-slash-auto-compatibility":"2161|挖矿与砍杀自动兼容 (Mine and Slash Auto Compatibility)","metallurgy-core":"2162|冶金核心 (MetallurgyCore)","blank-planet":"2163|~","betterachievements":"2164|更好的成就 (Better Achievements)","extra-bows":"2165|更多的弓 (Extra Bows)|891607","forgotten-relics":"2166|失落遗物学 (Forgotten Relics)|937895","ore-core":"2167|矿石核心 (Ore Core)","ordinary-coins":"2168|普通硬币 (Ordinary Coin)","peanut-mod":"2169|花生！ (Peanuts!)","chococraft":"217|陆行鸟 (ChocoCraft)","in-game-wiki-mod":"2171|~","betterbedrockgen":"2172|更好的基岩 (Better Bedrock Gen)|1109812","wsbim-legacy-blocks-and-items":"2173|~","storage-items-mod":"2174|~","what-should-be-in-mc-wsbim":"2175|~","bluestone":"2176|~","effortless-building":"2177|~","ic2-classic-tweaker":"2178|~","Ic2c-Crop-Overrides":"2179|IC2经典版作物覆盖 (IC2C Crop Overrides)","pams-harvestcraft":"218|潘马斯农场 (Pam's HarvestCraft)|669856","ic2c-extras":"2180|工业时代2经典版拓展 (IC2C Extras)","advanced-solars-classic":"2181|高级太阳能经典版 (Advanced Solars Classic)","power-chisels":"2182|能量凿子 (Power Chisels)","ic2c-custom-soils":"2183|~","homing-exp-orbs":"2184|经验球归航 (Homing Exp Orbs)","enchantmentglint":"2185|自定义附魔光效 (Jabelar's Truly Magical Enchantment Glints)","floricraft":"2186|花卉工艺 (Floricraft)|674160","weisscore":"2187|~","glibys-physics":"2188|Gliby的物理 (Gliby's Physics)","electro-magic-tools-ic2-classic":"2189|电子神秘工具 (Electro-Thaumic Tools - IC2 Classic)","blood-magic":"5501|血魔法3","forceasciifont":"2190|强制ASCII字体 (ForceASCIIFont)","skewers":"2191|烤串 (Skewers)|962626","get-in-the-bucket-mod-fabric":"2192|进入水桶 (Get In The Bucket Mod)","fertilization":"2193|施肥 (Fertilization)","additional-banners":"2194|更多旗帜 (Additional Banners)","dropt":"2195|~","the-elven-forest":"2196|精灵森林 (The Elven Forest​)","the-beneath":"2197|深渊世界 (The Beneath)","not-enough-characters":"2198|NEI 拼音搜索 (Not Enough Characters)|614246","advanced-machines":"22|高级机械 (AdvancedMachines)","opis":"220|~","mine-addons-2":"2200|~","terrafirmacraftplus":"2201|群峦传说 + (Terrafirmacraft +)|1043715","quick-consume-2":"2202|快速摄入2 (Quick Consume 2)","mctitle":"2203|~|725545","mgui":"2204|~","sublib":"2205|~","dense-ores":"2206|致密矿石 (Dense Ores)|522248","archisections":"2207|~","cavecontrol":"2208|洞穴控制 (Cave Control)","expandedredstone":"2209|红石扩展 (Expanded Redstone)","legacycraft":"2210|传统工艺 (LegacyCraft)","geostrata":"2211|~","territoryzone":"2212|~","loottweaks":"2213|~","critterpet":"2214|~","condensedores":"2215|~","treeclimbing":"2216|~","more-electric-tools":"2217|更多电力装置 (More Electric Tools)|970021","wireless-fluid-terminal":"2218|无线流体终端 (AE2 Wireless Fluid Terminal)","wireless-interface-terminal":"2219|无线接口终端 (AE2 Wireless Interface Terminal)","openblocks":"222|开放式方块 (OpenBlocks)","wireless-pattern-terminal":"2220|无线样板终端 (Wireless Pattern Terminal)","better-questing-rf-expansion":"2221|更好的任务-RF拓展 (Better Questing - RF Expansion)","hurt-animation-remover":"2222|~","more-cauldrons":"2223|更多炼药锅 (More Cauldrons)","parabox":"2224|~","sky-grid":"2225|~","forbidden-arcanus":"2226|禁忌与奥秘 (Forbidden and Arcanus)","mysticalmechanics":"2227|~","backpacked":"2228|背包 (Backpacked)","starship":"2229|星舰 (StarShip)|692838","tweakeroo":"2230|~|973508","integrated-rest":"2231|~","citadel":"2232|~","screenshot-browser":"2233|内置截图管理器 (Screenshot Browser)","curio-of-undying-fabric":"2236|不死图腾插槽 (Curio of Undying/Trinket of Undying)","explorercraft-worldexpansion":"2237|探险者 (Explorercraft)|980848","enigmatic-legacy":"2239|神秘遗物 (Enigmatic Legacy)|958575","water-power":"224|水力科技 (Water Power)|190676","end-reborn":"2240|末地：重生 (End: Reborn)|846012","ezstorage-2":"2242|EZ存储2 (EZStorage 2)","more-chickens":"2243|更多鸡扩展 (More Chickens)","the-first-age-submod":"2244|魔戒：第一纪元 (LOTR: Frist Age)","the-rc-mod":"2245|~","rubybyimxiaoanag":"2246|红宝石 (Ruby)|949124","jojo-hamon-era":"2247|JoJo-波纹时代 (JoJo-Hamon Era)","OpenSecurity":"2249|开放式防卫 (OpenSecurity)","level-up-hp-forge":"2251|生命提升 (Level Up HP)|1036332","more-planet-extras":"2252|~","randompatches-fabric":"2253|随意修复 (RandomPatches)","ships-mod":"2254|船 (Ships Mod)","tfc-metric":"2255|公制重量转换 (TFC Metric)","tfc-additions":"2259|群峦附加 (TFC-Additions)","raolcraft-w":"2260|~","litematica":"2261|投影 (Litematica)|1015510","telepastries":"2262|传送蛋糕 (TelePastries)","heroesexpansion":"2263|超级英雄拓展 (HeroesExpansion)|963046","attributefix":"2264|属性修复 (AttributeFix)|939188","dynamic-transport":"2265|动态运输 (Dynamic Transport)|428517","tool-builder":"2266|铸器师 (Tool Builder)|967559","bountifulbaubles":"2267|丰富的饰品 (Bountiful Baubles)","manacraft":"2269|魔能工艺 (ManaCraft)|841528","randomcraft-v0-1-0":"227|随机工艺 (RandomCraft)","forge-backpacks":"2274|更多背包 (Backpacks)|140940","repurpose":"2275|~","unlimited-chisel-works":"2276|~","kfc":"2277|~|805566","rainbow-oak-trees":"2278|彩虹橡树 (Rainbow Oak Trees)","spawntabletweaker":"2279|生成调整 (SpawnTableTweaker)","large-ore-deposits":"2280|大型矿床 (Large Ore Deposits)","gregtech6-unofficial":"2281|格雷科技6非官方版 (GregTech 6 Unofficial)|1038500","mahou-tsukai":"2282|魔法使 (Mahou Tsukai)|929252","moar-tinkers":"2284|~","baubley-heart-canisters":"2285|心之容器 (Baubley Heart Canisters)|795294","jaopcasingularities":"2286|JAOPCA的奇点 (JAOPCA Singularities)|958964","animal-bikes":"229|动物坐骑 (Animal Bikes)","guidebook":"2291|~","lithium-forge":"2292|锂 (Lithium)","dependents":"2293|求生之路 (Left 2 Mine)","worldeditcui-forge-edition-2":"2294|~","world-book":"2295|~","uppers":"2296|倒置漏斗 (Uppers)","spartan-weaponry":"2297|斯巴达的武器 (Spartan Weaponry)|798723","malilib":"2298|~","infraredstone":"2299|~","advanced-solar-panels":"23|高级太阳能 (Advanced Solar Panels)","incorporeal":"2300|幻想多媒体 (Incorporeal)","amun-ra":"2301|~","mysterious-mountain-lib":"2303|妖怪之山通用库 (MysteriousMountainLib)","loottweaker":"2304|~","rediscovered":"2305|特性重现 (Rediscovered)|359096","kitchen-mod":"2306|厨房 (The Kitchen Mod)|295019","baubles-reborn":"2308|饰品栏重置版 (Baubles Reborn)","pams-brewcraft":"2309|潘马斯酿造工艺 (Pam's Brewcraft)","dirtcraft":"2310|泥土工艺 (DirtCraft)","minihud":"2311|迷你HUD (MiniHUD)","potato-craft":"2312|土豆工艺 (Potato Craft)|604304","bed-patch":"2314|~","data-loader":"2316|~","level-up-hp-easy-start":"2317|~","simply-light":"2318|更好的灯 (Simply Light)","lightning-bolt-mod":"2319|雷电攻击 (Lightning Bolt Mod)","electro-magic-tools":"232|电力魔法工具 (Electro-Magic Tools)","spartan-and-fire":"2320|斯巴达之冰与火 (Spartan and Fire)","beacons-for-all-fabric":"2322|~","more-flowers":"2324|更多功能花 (More Flowers)","enchanting-with-thaumcraft":"2325|神秘附魔学 (Enchanting With Thaumcraft)","buzzier-bees":"2326|~","lollipop":"2328|棒棒糖 (Lollipop)","enemyz":"2329|敌意显示 (Enemyz)","forbidden-magic":"233|禁忌魔法 (Forbidden Magic)","thaumic-restoration":"2330|~","primal-boat":"2333|原始船舶 (Primal Boat)","eyes-in-the-darkness":"2334|~","thaumic-augmentation":"2335|神秘进阶 (Thaumic Augmentation)|1063250","lost-magic":"2336|失落的魔法 (Lost Magic)","thaumic-arcana":"2337|~","thaumic-wonders":"2338|神秘奇境 (Thaumic Wonders)|920375","crimson-warfare":"2339|~","mobtalker2":"234|怪物交谈2 (MobTalker 2)|193844","terra-1-to-1-minecraft-world-project":"2340|~","multiverse-pouch":"2341|多元宇宙袋 (Multiverse Pouch)","electroblobs-wizardry-twilight-forest-spell-pack":"2343|巫术学：暮色森林法术包 (Electroblob's Wizardry: Twilight Forest Spell Pack)|1001020","blockbuster":"2344|~","fishs-undead-rising":"2345|Fish的不死崛起 (Fish's Undead Rising)|984184","cloth-config":"2346|~","just-map":"2347|~","too-realistic-inventory":"2348|真实背包 (Realistic Inventory)","mob-farm":"2349|生物农场 (Mob farm)","icbm":"235|洲际导弹 (ICBM)","acceleratorcraft":"2350|加速器工艺 (AcceleratorCraft)","minecraft-spongebob-squarepants-mod-for-the-1-7-10":"2351|~","utility-worlds":"2352|实用世界 (Utility Worlds)|1009400","goblin-traders":"2353|哥布林商人 (Goblin Traders)","divine-favor":"2354|神的恩惠 (Divine Favor)","volumetric-flask":"2355|量瓶 (Volumetric Flask)","loot-bag-mod":"2356|战利品包 (Loot Bag Mod)","minecraft-dungeons-mod":"2358|我的世界地下城 (Minecraft Dungeons Mod)","thaumic-infusion":"236|神秘注魔 (Thaumic Infusion)","seasonal-bees":"2360|季节性蜜蜂 (Seasonal Bees)|799196","forgedcarpet":"2361|~|1098345","handmadegunsmodex":"2362|自定义枪械 (HandmadeGuns)|853957","equivalent-additions":"2363|等价拓展 (Equivalent Additions)|838238","mixinbootstrap":"2364|~","powah":"2365|~|1000888","natural-pledge":"2366|自然誓约 (Natural Pledge)|1010943","more-berries":"2367|更多浆果 (More Berries)","zeiyocraft":"2368|~","time-stages":"2369|阶段时间 (Time Stages)","thaumic-exploration":"237|神秘探险 (Thaumic Exploration)","additional-events":"2370|~","artemislib":"2371|~","pams-harvestcraft-2-food-extended":"2930|潘马斯农场2 - 食物拓展","easy-retrogen":"2373|简易重生成 (Easy Retrogen)|793640","extraplayerrenderer":"2374|额外玩家渲染 (ExtraPlayerRenderer)","rwbym":"2375|~|998968","libnonymous":"2376|~","shattered-moon":"2377|~","tinkersurvival":"2378|匠魂生存 (Tinkers' Survival)|811651","portablecraft":"2379|便携物品 (PortableCraft)|784442","deconstruction-table":"238|解构工作台 (Deconstruction Table)|825992","better-than-bunnies":"2381|给兔子戴上礼帽 (Better Than Bunnies)|769012","arcane-essentials":"2382|奥术精要 (Arcane Essentials)|878611","the-aurorian":"2383|极光幽境 (The Aurorian)","egg-auto-hatch":"2384|鸡蛋自动孵化 (Egg Auto Hatch)","performant":"2385|性能优化 (Performant)","tube-transport-system":"2386|管道传输系统 (Tube Transport System)","transmutation-alchemy-revival":"2388|~","extra-spells-electroblobs-wizardry":"2389|额外咒语 (Extra Spells)","ancient-spellcraft":"2390|古代咒法 (Ancient Spellcraft)","moving-elevators":"2391|~|1009680","interstellar-exoplanets":"2392|星际：系外行星 (Interstellar: Exoplanets)|1105540","infini-tic":"2393|~","extra-disks":"2394|更多磁盘 (Extra Disks)","optiforge":"2395|~","magic-seeds-for-electroblobs-wizardry":"2396|巫术学魔法种子 (Magic seeds for Electroblobs Wizardry)","extra-alchemy":"2397|扩展炼药 (Extra Alchemy)|871236","beyond-the-veil":"2398|帷幕彼端 (Beyond The Veil)|1109481","maple-syrup":"2399|枫糖 (Maple Syrup)|1014291","nuclear-control-2":"24|核电控制2 (Nuclear Control 2)","blood-particles":"2400|血液粒子效果 (Blood Particles)|990913","nyx":"2401|~","lieutenant":"2402|~","matthews-difficulty-mod":"2403|~","old-combat-system":"2404|旧版战斗系统 (Old Combat System)|983861","vampires-need-umbrellas":"2405|~","hypnotics":"2406|安眠药 (hypnotics)","villager-market":"2407|村民市场 (Villager Market)","linear":"2409|线性放置 (Linear)|817264","b0bgarys-growable-ores":"241|可生长矿石 (B0bGary's Growable Ores)","immersive-portals-for-forge":"2410|沉浸式传送门 (Immersive Portals)|1177771","universalbestiary":"2411|~","autumnity":"2412|秋原 (Autumnity)|1021372","worldgeneration-profiler":"2413|~","chunk-in-a-globe":"2414|球内区块 (Chunk In A Globe)","dragon-mounts-legacy":"2415|龙骑士重置版 (Dragon Mounts: Legacy)","fruit-trees":"2416|果树 🍊 (Fruit Trees 🍊)|976516","journey-into-the-light-mod":"2417|光明之旅·神之本质 (Journey Into the Light · Essence of the Gods)|1128195","more-dungeons":"2419|更多地牢 (More Dungeons)","voyage":"2420|~","idealland":"2421|理想境 (Idealland)|1051328","second-screen":"2424|~","arcanecraft":"2427|奥法工艺 (ArcaneCraft)|1022110","retrobees":"2428|~","beebetteratbees":"2429|育蜂指南 (BeeBetterAtBees)","inverted-enchantments":"2430|负魔书 (InvertedEnchantments)|1003938","general-laymans-aesthetic-spying-screen-glass":"2431|~","diy_title":"2432|自定义名称前后缀 (diy_title)|998747","tooltweaks":"2433|禁用原版工具 (ToolTweaks)|773523","atop":"2434|超多生物群系护甲 (Armor for Biomes O' Plenty)","tinkers-forging":"2435|工匠锻造 (Tinker's Forging)","gravity-gun":"2436|重力枪 (Gravity Gun)","mekanism-additions":"2437|通用机械附加 (Mekanism Addition)","signpicture":"2438|木牌图片 (Sign Picture)|698600","vampirism-integrations":"2439|吸血鬼联动 (Vampirism Integrations)","gottschcore":"2440|~","not-enough-crashes-forge":"2441|崩溃优化 (Not Enough Crashes)|1097535","crash-to-main-menu":"2442|崩溃返回主菜单 (Crash To Main Menu)","tinkers-jei":"2443|~","better-questing-quest-book":"2445|更好的任务 - 任务书 (Better Questing - Quest Book)","engineers-doors":"2446|工程师的门 (Engineer's Doors)","tps-generator":"2447|TPS发电机 (TPS Generator)","better-drowning":"2448|更好的溺水 (Better Drowning)","getting-started":"2449|~","kubejs-fabric":"2450|~|1207772","tickcentral":"2451|~","lowocalizatiwn":"2452|~","redlib":"2453|~","modern-ui":"2454|现代化 UI (Modern UI)","auto-config-updated-api":"2455|~","medieval-madness":"2456|中世纪的疯狂 (Medieval Madness)","unionlib":"2457|~","caelus-fabric":"2458|~","xeocore":"2459|~","waila":"246|高亮信息拓展 (What am I looking at)","wtbw_lib":"2460|~","dev-world-fabric":"2461|~","threecore":"2462|~","moddirector":"2463|~","function-api":"2464|~","targetingapi":"2465|~","re-targetingapi":"2466|~","dominionlib":"2468|~","chaoscraft-2":"247|混沌工艺 (ChaosCraft)","endergetic":"2470|末地拓展 (The Endergetic Expansion)","swamp-expansion":"2471|~","galactictweaks":"2472|~","dungeon-tactics":"2473|地牢战术 (Dungeon Tactics)|945504","villagers-nose":"2474|村民的鼻子 (Villager's Nose)|320049","dungeons2":"2475|自定义地牢2 (Dungeons2)","lang_tool":"2476|加长工具 (lang_tool)","emojiful":"2479|~","scenter-mod":"248|矿物追踪 (Scenter)","item-compatibility":"2480|~","aether-lost-content":"2481|天境: 遗失之物 (Aether: Lost Content)","gunpowderlib":"2482|~","nuclearcraft-overhauled":"2483|核电工艺：重制版 (NuclearCraft: Overhauled)|1077507","nei-lotr":"2484|魔戒NEI插件 (LotR Mod NEI Plugin/NEI LotR)","adventure-backpack":"2486|探索者背包 (Adventure Backpack)","speed-illusion":"2487|~","supertic":"2488|匠魂药水效果 (SuperTiC)","the-bumblezone-fabric":"2489|蜜蜂领域/黄蜂领域 (The Bumblezone)|998154","beesourceful":"2490|~","middle-earth-industry":"2491|~","thut-wearables":"2492|~","after-the-drizzle":"2493|细雨田园 (After the Drizzle)|1038199","cmdcam":"2494|CMD指令摄影机 (CMDCam)|1034801","climate-control-geographicraft":"2495|气候控制/地理世界 (Climate Control/Geographicraft)|833208","cosmetic-armor-reworked":"2497|时装盔甲重置版 (Cosmetic Armor Reworked)","efab":"2499|~","ex-nihilo":"250|无中生有 (Ex Nihilo)|195925","potion-of-bees-fabric":"2500|蜂群药水 (Potion of Bees)","wyrmroost":"2501|猛龙之居 (Wyrmroost)","productivebees":"2502|资源蜜蜂 (Productive Bees)|1088015","gkolivers-super-tic":"2503|~","songs-of-war-mod":"2505|战争之歌 (Songs of War)|1003372","fluidict":"2506|~","squidcraft":"2507|鱿鱼工艺 (SquidCraft)|1025201","clothesline-fabric":"2508|晾衣绳 (ClothesLine)|1037838","siege":"2509|~","reactorcraft":"251|反应堆工艺 (ReactorCraft)","fermion-core":"2510|~","omnitranslation":"2511|万能翻译 (OmniTranslation)|1007862","the-egg-came-first":"2512|先有蛋 (The Egg Came First)","nuclearcraft-helper":"2513|核电助手 (NuclearCraft Helper)","the-hive-more-bee-content":"2514|~","tinkersmiddleearth":"2515|~|1040428","inventory-pause":"2516|~","snowy-leaves":"2517|霜花叶 (Snowy Leaves)","materialis":"2518|~","tesseract":"2519|超立方体 (Tesseract)|1117511","bctools":"252|BC扩展：更多工具 (Buildcraft Tools)","carrier-bees":"2520|物流蜜蜂 (Carrier Bees)","tinkers-reforged":"2521|工匠再锻 (Tinkers' Reforged)","recipes-for-all":"2523|配方书全解锁 (Recipes for All)|795776","gregicality":"2524|~","the-lord-of-the-rings-mod-renewed":"2525|魔戒：复兴 (The Lord of the Rings Mod: Renewed)|1084629","modelloader":"2526|~","animal-crops":"2527|动物作物 (Animal Crops)","terrafirmacraftneiplugin":"2528|~","furenikusroads":"2529|Fureniku的路 (Fureniku's Roads)","additional-buildcraft-objects":"253|更多管道 (Additional Buildcraft Objects)","patchouli-quests":"2530|帕秋莉任务手册 (Patchouli Quests)|1046562","extraacademy":"2531|学园附属 (ExtraAcademy)|727182","iitemrenderer-reborn":"2532|~","time-overhaul":"2533|时间改革 (Time Overhaul)","steamweapon":"2534|梗多武器 (StemWeapon)|932419","counter-guns":"2535|~","gregtech-chill-edition":"2537|格雷科技轻松版 (GregTech: Chill Edition)","custom-player-model-cpm-remake":"2538|自定义玩家模型 (Custom Player Model)|950601","roughly-enough-resources":"2539|~|1046041","foundry":"254|金属工坊 (Foundry)","so-many-enchantments":"2540|更多附魔 (So Many Enchantments)|927418","sisser":"2542|~","hxcenchants":"2543|多样化附魔 (HxCEnchants)","better-dropped-items":"2544|更好的掉落物 (Better Dropped Items)|1125352","hxc-core":"2545|~","surrounding-indicators":"2546|~","gobber":"2547|戈伯|967993","iblis":"2549|恶魔 (iblis)|1025597","gravitation-suite":"255|重力装甲 (Gravitation Suite)|734193","the-king-of-the-villagers":"2551|村民之王 (The King of the Villagers)","bring-me-the-rings":"2552|~","bloomful":"2553|~","pick-pocketer":"2554|扒手 (Pick Pocketer)","terraforged":"2555|~|1157666","rad-metabolosis":"2556|~","mmd-orespawn":"2557|~","tragicmc3":"2558|悲惨世界3 (TragicMC 3)|1233212","redstone-arsenal":"256|红石兵工厂 (Redstone Arsenal)","not-enough-rtgs":"2560|更多RTG (Not Enough RTGs)","qmd":"2561|量子块动力学 (Quantum Minecraft Dynamics)","environmental-rads":"2562|~","fission-based-neutron-collector":"2563|裂变能中子素收集器 (Fission Based Neutron Collector)","trinity":"2564|三位一体 (Trinity)","macaws-windows":"2565|Macaw的窗户 (Macaw's Windows)","music-player":"2566|~","csokicraftutil":"2567|~","large-enchants":"2568|~","angrysun":"2569|炙热太阳 (AngrySun)|797244","big-reactors":"257|大型反应堆 (Big Reactors)|348989","its-not-long-enough":"2570|与现实相同的昼夜交替 (It's Not Long Enough)|807281","sunscreen-gel":"2571|防晒霜 (Sunscreen Gel)|797343","macaws-furniture":"2573|Macaw的家具 (Macaw's Furniture)","macaws-doors":"2574|Macaw的门 (Macaw's Doors)|1098241","blueprint":"2575|~","geyser-mod":"2576|~","not-enough-pets":"2577|更多宠物 (Not Enough Pets)|1007471","potionextension":"2578|~","torchslabs-mod":"2579|更好的火把放置 (Torch Slabs Mod)|1098447","routerrebornlib":"2580|~","the-magic-doorknob":"2581|~","ultimate-skyblock-generator":"2582|~","everyone-poops-dung-fertilizer":"2583|肥料 (Everyone Poops - Dung Fertilizer)|838650","ascension-of-the-divine":"2584|~","nebulaecraft":"2585|~","tab-overlay":"2586|背包显示 (Inventory Overlay)|807811","ic2magma":"2587|~","iridium-source":"2588|铱矿产 (Iridium Source)","frogcraft-rebirth":"2589|青蛙化工:重生 (FrogCraft:Rebirth)","endertanks":"259|末影水槽 (Ender Tanks)","coaxium-mod-1-12-2-ic2-addon":"2590|~","energy-control":"2591|能源控制 (Energy Control)","gulliver-reborn":"2592|~","rationcraft":"2594|~","default-options":"2595|~","ender-mail":"2596|末影邮递 (Ender Mail)|1037597","more-overlays":"2597|~|784302","stefinus-3d-guns-mod":"2598|3D枪械 (New Stefinus Guns)|441094","better-dungeons":"26|更好的地牢/寻找巧克力 (Better Dungeons / Chocolate Quest)|418940","applied-energistics-2":"260|应用能源2 (Applied Energistics 2)|798231","moderncraft-core":"2600|ModernCraft Core","lang_magic":"2601|言灵 (lang_magic)","noexpensive":"2602|不昂贵 (NoExpensive)|1055512","rough-mobs-revamped":"2603|粗暴的怪物重置版 (Rough Mobs Revamped)","fullbright":"2604|充满光明 (Fullbright)|803202","backpacks":"2605|背包！ (backpacks!)|423986","living-enchantment":"2607|生命附魔 (Living Enchantment)|932961","karat-garden":"2608|克拉的花园 (Karat Garden)|663378","hopper-ducts":"261|漏斗管道 (Hopper Ducts)","bard-mania":"2610|~","shulkerboxtooltip":"2611|潜影盒工具提示 (Shulker Box Tooltip)","crafting-dead-official":"2613|行尸走肉 (Crafting Dead)","lord-craft":"2614|~","stupid-things":"2617|~","more-gems-fabric":"2618|更多宝石 (More Gems)","minewars":"2619|~","autofish":"262|自动钓鱼 (Autofish)","gregicadditionscompatibility":"2620|~","combined-potions":"2621|组合药水 (Combined Potions)|785942","plusticminusbad":"2622|~","baileys-dailies":"2623|~|1047464","joshuas-christmas-mod":"2624|~","enderio-fluxified":"2625|~","skizzik":"2626|~","sandbag":"2629|沙袋 (Sandbag)","mrcrayfish-furniture-mod":"263|MrCrayfish 的家具 (MrCrayfish's Furniture Mod)|321693","tinkers-arsenal":"2630|~","garbage-energy":"2631|废品能源炉 (Garbage Energy)","quirky-generators":"2632|~","megaloot":"2633|超级战利品 (MegaLoot)|1014884","mad-villagers":"2635|疯狂的村民 (Mad Villagers)|785126","logical-drops":"2636|逻辑工艺 (Logical Craft)|1022032","drone-craft":"2637|~","water-source":"2638|水源 (Water Source)|1057153","wr-cbe-universal":"264|无线红石 (Wireless Redstone)|621428","hungteens-plants-vs-zombies-mod":"2640|HungTeen的植物大战僵尸 (HungTeen's Plants vs Zombies Mod)|1052460","pams-desertcraft":"2641|潘马斯沙漠工艺 (Pam's DesertCraft)","pams-bonecraft":"2642|潘马斯骨头工艺 (Pam's BoneCraft)","thermal-singularities":"2643|热力奇点 (Thermal Singularities)","minejurassic":"2644|~","terraria-craft":"2645|泰拉瑞亚世界 (Terraria Craft)|953855","colytra-fabric":"2646|鞘翅胸甲 (Colytra)","insects":"2647|昆虫 (Insects)","sound-reloader":"2648|声音重载 (Sound Reloader)|732142","tool-belt":"2649|工具皮带 (Tool Belt)|677629","argentina-food-mod":"2650|阿根廷的食物 (Argentina Food Mod)","pet-names-fabric":"2651|宠物名字 (Pet Names)","collective-fabric":"2652|~","giselbaers-durability-viewer":"2653|耐久信息显示 (Durability Viewer)|1007803","more-cookies":"2654|更多饼干 (More Cookies)","apple-carrot":"2655|苹果胡萝卜 (Apple Carrot)","eat-yo-veg":"2656|~","bountiful-fabric":"2657|赏金 (Bountiful)|1172239","betterenchantment":"2658|更好的附魔 (BetterEnchantment)","purified-flesh-mod":"2659|纯净的腐肉 (Purified Flesh Mod)","gotminecraftmod":"2660|权力的游戏 (Game of Thrones Mod)","nosleep":"2661|禁止睡觉 (No Sleep)","minersadvantage":"2662|矿工的优势 (MinersAdvantage)|845552","simple-backpack-fabric":"2664|简单背包 (Simple Backpack)","gas-conduits":"2666|气体导管 (Gas Conduits)|1298016","handgun-from-terraria":"2667|~","more-discs-mod":"2668|更多唱片 (More discs mod)","edible-honeycombs":"2669|~","per-fabrica-ad-astra-geologica":"267|自合成至星辰：真实地理 (Per Fabrica Ad Astra: Geologica)","emerald-and-ruby":"2670|~","craftable-nametag":"2671|可合成的命名牌 (Craftable Nametag)|1103800","dyeable-flower-pots":"2672|染色花盆 (Dyeable Flower Pots)","graffiti":"2673|涂鸦 (Graffiti)","bunny-boots":"2674|~","backported-flora":"2675|~","eat-eggs":"2676|~","wool-plates":"2677|羊毛压力板 (Wool Plates)","more-berry-uses":"2678|更多浆果用途 (More Berry Uses)","elemental-blades":"2679|元素之刃 (Elemental Blades)|1012675","beyond-earth":"2680|~","simple-planes-fabric":"2681|简单飞机 (Simple Planes)","world-tooltips":"2682|显示掉落信息 (World Tooltips)|678452","extra-arcane-knowledge-electroblobs-wizardry":"2683|额外巫术知识 (Extra Arcane Knowledge)","bacteriums":"2684|细菌重置版 (Bacterium)","pillagers":"2685|掠夺者 (Pillagers)|786310","guard-villagers":"2686|警卫村民 (Guard Villagers)|995876","simple-machinery":"2687|简单机器 (Simple Machinery)","bridge-maker":"2689|桥梁制造者 (Bridge Maker)","redstone-furnace":"269|红石炉 (Redstone Furnace)","craft-your-saddle":"2690|~","never-break":"2692|损坏防护 (Never Break)","simple-villager-spawn-egg":"2693|~","banana-decor-forge":"2694|~","immersive-metal":"2695|沉浸金属 (Immersive Metal)","coffee-time":"2696|~","drink-mod":"2697|饮料模组 (Drink Mod)","more-zombie-villagers-fabric":"2698|更多僵尸村民 (More Zombie Villagers)","naturally-charged-creepers-fabric":"2699|自然生成闪电苦力怕 (Naturally Charged Creepers)","flans-mod-5-5-2":"27|Flan的枪械 (Flan's Mod)|1055461","pneumaticcraft-repressurized":"270|气动工艺 (PneumaticCraft: Repressurized)","skinport":"2700|~","dynamic-surroundings-soundcontrol":"2701|动态环境：音效控制 (Dynamic Surroundings: SoundControl)","chop-down-updated":"2703|~|789214","aegis-weapon-system-mod":"2704|宙斯盾作战系统-战舰模组 (Aegis Weapon System -Warship's Mod)","advanced-hook-launchers":"2705|高级钩爪发射器 (Advanced Hook Launchers)|673881","vampire-magic":"2706|~","fantasyunderworld":"2707|江湖行 (fantasyunderworld)","stacc":"2708|~","a-riot-of-colour-craft":"2709|五彩斑斓工艺 (a riot of colour craft)|982406","crop-dusting":"2710|排气施肥 (Crop Dusting)|965619","dynamic-surroundings-mobeffects":"2711|动态环境：生物效果 (Dynamic Surroundings: MobEffects)","dynamic-surroundings-environs":"2712|动态环境：周边环境 (Dynamic Surroundings: Environs)","recipe-stages":"2713|配方阶段 (Recipe Stages)","attack-on-minecraft":"2714|自由之翼 (Wings of Freedom)|1071695","cavern-miner":"2715|洞穴：矿工 (Cavern: Miner)","vanilla-tools":"2716|原版工具+ (Vanilla Plus Tools)","server-tab-info":"2717|~|790756","letsencryptcraft":"2718|~","creeperhost-minetogether":"2719|~","thirst-mod":"272|饮水 (Thirst Mod)|483367","fullscreen-windowed-borderless-for-minecraft":"2721|窗口化全屏 (Fullscreen Windowed (Borderless) for Minecraft)|678406","nocurse":"2722|不诅咒 (NoCurse)|1066483","pretty-beaches":"2723|~|1113121","qing_gong":"2724|轻功 (qing_gong)|1065957","remnants":"2725|腐败 (Remnants)","pane-in-the-glass":"2727|~","dynamic-dynamos":"2728|能源炉动画 (Dynamic Dynamos)","trophy-slots":"2729|~","tubes":"273|管道 (Tubes)","replanting-crops-fabric":"2731|补种农作物 (Replanting Crops)","complex-crops":"2732|~|873934","screenshot-to-clipboard-fabric":"2733|截图到剪贴板 (Screenshot to Clipboard)","hide-armor":"2734|隐藏盔甲 (Hide Armor)","hunterillager":"2735|邪猎者 (HunterIllager)|936480","pocket-apocalypse-mod":"2737|便携式天灾 (Pocket Apocalypse mod)","compass":"2738|指南针 (compass)|1067220","tinkers-evolution":"2739|匠魂进化 (Tinkers' Evolution)|1118159","pchan3-steamship-steamboat-pirates":"274|飞艇与汽船 (SteamShip - SteamBoat and Pirates)","tinkers-exporter":"2740|匠魂数据导出器 (Tinkers Exporter)|1071348","farlanders":"2741|更多末影人 (The Farlanders)|425192","vials":"2742|瓶瓶罐罐 (Vials)","advanced-lightsabers":"2743|高级光剑 (Advanced Lightsabers)","fall_attack":"2744|下落击杀 (fall_attack)|1068034","swimsuit":"2745|泳装 (swimsuit)|1069305","more-overlays-updated":"2746|~","dothack-hack-weapons":"2747|~","immersive-energy":"2748|沉浸能源 (Immersive Energy)","crimson-moon":"2749|绯红之月 (Crimson Moon)","mobs-attempt-parkour":"2750|~","identity-on-forge":"2751|化身 (Identity)|1097458","industrial-revolution":"2752|工业革命 (Industrial Revolution)|1069869","art-of-alchemy":"2753|炼金艺术 (Art of Alchemy)|1017647","lan-server-properties":"2754|自定义局域网联机 (Lan Server Properties)|1056335","immersive-intelligence":"2756|沉浸智能 (Immersive Intelligence)","analyzeio":"2757|~","wool-buttons":"2758|羊毛按钮 (Wool Buttons)","total-tinkers":"2759|统合匠艺 (Total Tinkers)","betterfarming":"276|农业增强 (Better Farming)|167515","thaumic-wands":"2761|神秘法杖 (Thaumic Wands)|1082168","japanese-food-mod":"2762|日式料理 (Japanese Food Mod)|1089344","pandoras-creatures":"2763|潘多拉生物 (Pandoras Creatures)|944141","status-tags":"2764|名称标签状态栏 (Status Tags)","just-enough-dimensions":"2765|维度配置 (Just Enough Dimensions)","multishot":"2766|延时摄影 (Multishot)","tweakers-construct":"2767|匠魂调整 (Tweakers Construct)","valhelsia-structures":"2768|~","just-enough-reactors":"2771|~","aoa-infobundle":"2772|虚无世界信息包 (AoA InfoBundle)","mana-and-artifice":"2773|魔法艺术3：巧工魔艺 (Mana and Artifice)","slab-helper":"2776|半砖小帮手 (Slab Helper)|1075292","no-jumping-allowed":"2777|禁止跳跃 (No Jumping Allowed)","swan-boats":"2778|天鹅船 (Swan Boats)","primal-winter":"2779|原始寒冬 (Primal Winter)","lots-of-food":"278|更多食物 (Lots Of Food)|149310","better-burning":"2780|更好的燃烧机制 (Better Burning)","compact-void-miners":"2781|紧凑型虚空采矿机 (Compact Void Miners)","probe":"2782|~","mekanism-fluxified":"2783|“通量”机械 (Mekanism Fluxified)","stepup":"2784|平滑自动上坡 (StepUp)","sodium":"2785|钠 (Sodium)|1079347","netherlicious":"2787|~|1104913","yungs-better-mineshafts-fabric":"2788|YUNG的矿井优化 (YUNG's Better Mineshafts)","terrible-chest":"2789|可怕的箱子/可怖箱子 (Terrible Chest)|922554","spartan-shields":"2790|斯巴达之盾 (Spartan Shields)|672959","silent-gear":"2791|寂静装备 (Silent Gear)","simple-smeltery-accelerator":"2793|匠魂冶炼炉加速器 (Simple Smeltery Accelerator)","portality":"2794|~|963035","natural-absorption":"2795|伤害吸收天赋 (Natural Absorption)","unique-enchantments":"2796|独特的附魔 (Unique Enchantments)","tombstone-revived":"2797|墓碑：复生 (Tombstone: Revived)","travelers-backpack-integrations":"2798|旅行者背包集成 (Traveler's Backpack Integrations)","Baby-Mobs":"2799|Baby生物 (Baby Mobs)","compressedblock":"2800|压缩方块 (Compressed Block)","wildnature":"2801|狂野自然 (Wild Nature)","novam-terram":"2802|~","terrafirmathings":"2803|群峦作品 (Terra Firma Things)|1155379","mechanization-datapack":"2804|机械工厂 (Mechanization)|1085049","simpledifficulty":"2805|坚定意志 (SimpleDifficulty)|1105340","tfctech-unofficial":"2807|群峦工业非官方版 (TFCTech Unofficial)","invmove-forge":"2809|边拿边走 (InvMove)","aquaculture":"281|水产养殖2 (Aquaculture 2)","autofish-for-forge":"2810|自动钓鱼Forge版 (AutoFish for Forge)","industrial-upgrade":"2811|工业升级 (Industrial Upgrade)|1038987","rpgstats":"2812|~","datapackrecipemaker":"2813|数据包配方助手 (Datapack Recipe Maker)|1087231","never-needed-or-wanted":"2814|~","ama-damage-indicator":"2815|~","magic-circle":"2817|阵法 (Magic Circle)|929326","crash-utilities":"2818|~","eldritch-mobs":"2819|~","project-bench":"282|高级工作台 (Project Bench)","farmers-delight-fabric":"2820|农夫乐事 (Farmer's Delight)","artifacts-fabric":"2821|奇异饰品 (Artifacts)","mechanized-steam-power":"2822|机械化蒸汽动力 (Mechanized Steam Power)","dynamictreestfc":"2823|动态的树：群峦传说附属 (Dynamic Trees-TFC)","lucky-block-avaritia":"2824|无尽幸运方块 (Lucky block avaritia)","dynamic-trees-the-twilight-forest":"2825|动态的树：暮色森林附属 (Dynamic Trees-The Twilight Forest)","drp-global-datapack":"2826|全局数据包 (DRP - Global Data Pack)","mob-farm-nerfer":"2827|~","blood-in-the-water":"2828|~","bio-technik":"2829|~","astromine-fabric":"2832|天体矿工 (Astromine: Complete)|1068634","rustic-thaumaturgy":"2833|神秘乡村 (Rustic Thaumaturgy)","thallium":"2835|铊 (Thallium)|1088212","haema":"2836|~","evil-ores":"2837|~","unsuspicious-stew":"2838|炖菜解谜/炖菜效果显示 (Unsuspicious Stew)","tfc-seasonal":"2839|~","apples-plus":"284|更多苹果 (Apples+)","imblockerfabric":"2840|输入法冲突修复 (IMBlockerFabric)|1090731","saomclib":"2841|~","survival-utilities":"2842|生存工具 (Survival Utilities)","slashblade":"2843|拔刀剑|726664","portal-blocks-2-0":"2844|传送门方块 (Portal Blocks)|1077770","slimecraft-add-tools-etc":"2845|~","moreswordonline":"2847|动漫神域 (MoreSwordOnline)","Camera-mod":"2848|照相机 (Camera Mod)|1162901","heartdrops":"2849|生命汲取 (Heart Drops)","observerlib":"2850|~","zen-summoning":"2851|~","campanion":"2852|野营物品 (Campanion)","wolves-with-armor":"2853|狼铠 (Wolves With Armor)","get-exp-for-everything":"2854|万物皆可获得经验 (Get exp for everything)","jei-enchantment-info":"2855|JEI附魔信息 (JEI Enchantment Info)","project-red-core":"2856|红石计划：核心 (Project Red - Core)","project-red-fabrication":"2857|红石计划：制作 (Project Red - Fabrication)","project-red-integration":"2858|红石计划：集成 (Project Red - Integration)","project-red-lighting":"2859|红石计划：照明 (Project Red - Lighting)","qcraft":"286|量子物理 (QCraft)","project-red-world":"2860|红石计划：探索 (Project Red - World)","canvas-renderer":"2862|Canvas渲染器 (Canvas Renderer)|1211675","coolfood":"2864|冷饮 (CoolFood)","infinitevillagertrading":"2865|无限村民交易 (InfiniteVillagerTrading)","infinite-trading":"2866|无限交易 (Infinite Trading)","better-loading-screen":"2867|自定义加载画面 (Custom Loading Screen)|970911","extended-lights-mod":"2868|灯具拓展 (Extended Lights)|903904","more-swords-legacy":"2869|更多剑：传承 (More Swords Legacy)","the-undergarden":"2870|深暗之园 (The Undergarden)","allure":"2871|诱惑 (Allure)|1094606","glibys-voice-chat-reloaded":"2873|Gliby的语音聊天重置版 (Gliby's Voice Chat Reloaded)|832155","greater-eye-of-ender-forge":"2874|高级末影之眼 (Greater Eye of Ender)|1022292","project-red-mechanical":"2875|红石计划：机械 (Project Red - Mechanical)","neon-craft-mod":"2876|霓虹灯艺 (Neon Craft Mod)","arrows-ignite-tnt":"2877|~","enderite-mod-for-forge":"2878|末影合金 (Enderite Mod)","dynamic-trees-industrial-craft-2":"2879|动态的树：工业2附属 (Dynamic Trees - Industrial Craft 2)","mad-science":"288|疯狂科学 (Mad Science)","dynamic-trees-tinkers-construct":"2880|动态的树：匠魂附属 (Dynamic Trees - Tinker's Construct)","ex-nihilo-sequentia":"2881|无中生有：传承 (Ex Nihilo: Sequentia)","toms-storage":"2882|汤姆的简易存储 (Tom's Simple Storage Mod)|1085400","fishing-real":"2883|更真实的钓鱼 (Fishing Real)","maessentials":"2884|~","lingering-loot":"2885|~","ugraded-netherite":"2886|下界合金增强 (Upgraded Netherite)","inventory-profiles":"2888|一键背包整理 (Inventory Profiles)|920520","slimevoid-library":"2889|~","kotlin-for-forge":"2890|~","fabric-zero":"2891|~","towers-of-the-wild":"2892|旷野之塔 (Towers Of The Wild)|1098534","sausagecore":"2893|香肠核心 (SausageCore)","shadowlands":"2894|暗影之地 (Shadowlands)","polymorph-fabric":"2895|多态合成 (Polymorph)","scalable-cats-force":"2896|~","otyacraft-engine":"2897|~","omega-craft-mod":"2898|~","custom-ports":"2899|自定义局域网端口 (Custom LAN Ports)","enviromine":"290|更多生存要素 (EnviroMine)","decorative-blocks":"2900|装饰方块 (Decorative Blocks)|1099281","music-layer":"2901|~","colored-lux":"2902|彩色照明 (Colored Lux)","corsair-mccue":"2903|~","right-click-clear":"2904|右键文本清除 (Right Click Clear)","wtfs-expedition-cavebiomes-ores-trees-and-tweaks":"2905|~","guide-api-village-and-pillage":"2906|~","drcyanos-lootable-bodies":"2907|可拾取尸体 (Dr. Cyano's Lootable Bodies)|406482","simply-cats":"2908|~","pams-harvestcraft-2-crops":"2909|潘马斯农场2 - 作物 (Pam's HarvestCraft 2 - Crops)|1000336","base-metals":"2910|基础金属 (Base Metals)","mmdlib":"2912|~","just-poop-mod":"2913|屎! (Poop Mod!)","costumes":"2914|服装 (Costumes)","eyemod-a-phone-mod":"2915|~|913253","upgrade-aquatic":"2916|碧海新生 (Upgrade Aquatic)|962459","tfc-ambiental":"2917|~","macaws-trapdoors":"2918|Macaw的活板门 (Macaw's Trapdoors)","zenutil":"2919|~","the-erebus":"292|混沌之地 (The Erebus)|856742","instant-bubble-studio":"2920|瞬息气泡工坊 (Instant Bubble Studio)|1103368","better-beacon-effect":"2921|更好的信标效果 (Better Beacon Effect)","netherite-horse-armor":"2922|下界合金马铠 (Netherite Horse Armor)","tacocraft-fabric":"2923|~","lootr-fabric":"2924|~","biolib":"2925|~","scavenge":"2926|~","heaven-earth-ring":"2928|乾坤戒指 (Heaven Earth Ring)|1113665","emerald-mod":"293|绿宝石Mod (Emerald Mod)|282677","pams-harvestcraft-2-trees":"2931|潘马斯农场2 - 果树 (Pam's HarvestCraft 2 - Trees)|1000336","better-minecart-rotation-forge":"2933|~","modern-metals":"2934|现代金属 (Modern Metals)","blockus":"2936|~","conjurers-cookbook":"2937|~","color-unchained":"2938|~","aportingcore":"2939|移植核心 (APortingCore)|1106002","lucky-blocks":"294|幸运方块 (Lucky Block)","ywlib":"2940|~","sweet-potato":"2941|烤地瓜 (Sweet Potato Mod)|1132119","redstone-lantern":"2942|红石灯笼 (Redstone Lantern)","culinaire":"2943|烹饪 (Culinaire)","furbishcraft":"2944|~","plural-lucky-block":"2946|复数幸运方块 (Plural Lucky Block)|1153085","ambientsounds":"2947|自然音效 (AmbientSounds)|780518","ordinary-firearms":"2948|普通枪械2 (Ordinary Firearms 2)|1107541","territory":"2949|领地 (MineTerritory)","dynamic-lights":"295|动态光源 (Dynamic Lights)|593066","better-ping-display-fabric":"2950|更好的延迟显示 (Better Ping Display)","turned-the-changed-mod":"2951|~","survival-tweaks":"2952|生存微调 (Survival Tweaks)|1050858","melon-slabs":"2953|西瓜台阶 (Melon Slabs)","lambdynamiclights":"2954|Lambda的动态光源 (LambDynamicLights)","realistic-torches":"2955|真实火把 (Realistic Torches)|566201","durability-viewer":"2957|耐久显示器 (Durability Viewer)|1086168","lucky-block-bow":"2959|~","yarr-cute-mob-models-remake":"296|怪物娘化 (Yarr Cute Mob Models - Remake)|172434","ground-item-highlighting":"2961|地面物品高光显示 (Ground Item Highlighting)|1084931","real-survivor":"2963|幸存者 (RealSurvivor)|1093190","armor-toughness-bar":"2964|盔甲韧性显示 (Armor Toughness Bar)","block-meter":"2965|~","time-to-live":"2966|~","dual-hotbar-1-12-2":"2967|双重快捷栏1.12.2 (Dual Hotbars 1.12.2)|986000","cha-s":"2968|可合成的马铠和鞍 (Craftable Horse Armour & Saddle)","dual-hotbar":"2969|双重快捷栏 (Dual Hotbars)|320409","monster-hunter-frontier-craft":"297|怪物猎人边境工艺 (Monster Hunter Frontier Craft)","travellers-boots":"2970|~","cofh-vanilla-satchels":"2972|~","betteranimalsplus":"2973|更多动物 (Better Animals Plus)|861155","packagedauto":"2974|封包合成 (PackagedAuto)","packagedexcrafting":"2975|封包合成拓展 (PackagedExCrafting)","compactstorage":"2977|紧凑存储 (compactstorage)","useful-backpacks":"2978|实用背包 (Useful Backpacks)","conquest-reforged":"2979|征服者 (ConquestReforged)|992711","zombie-awareness":"298|僵尸意识 (Zombie Awareness)","steelseries-gamesense":"2980|~","pizzaatimes-timber-mod":"2981|~","tellme":"2982|~","minerva-library":"2983|~","edit-sign":"2987|编辑告示牌 (Edit Sign)","logistical-automation":"2988|~","dynamic-view-fabric":"2989|动态视距 (Dynamic View)","remote-io":"299|远程接口 (Remote IO)","instrumental-mobs":"2991|乐器怪物 (Instrumental Mobs)","finder-compass":"2992|~","spacering":"2993|储物戒 (SpaceRing)","trumpet-skeleton-redooted":"2994|~","emotes":"2996|~","oc-sensors":"2997|~","fabric-for-fabric":"2998|~","storage-tech":"2999|~","electrical-age":"300|电力时代 (Electrical Age)","thaumic-periphery":"3000|神秘外饰 (Thaumic Periphery)","embellishcraft":"3001|装饰工艺 (EmbellishCraft)","open-loader":"3002|开放式加载 (Open Loader)","deep-mob-learning-refabricated":"3003|深度怪物学习：重制版 (Deep Mob Learning: Refabricated)","ftb-ultimine-fabric":"3004|连锁破坏 (FTB Ultimine)","server-translations":"3005|~","image2map":"3006|~","corpse":"3007|遗体 (Corpse)","ring-of-the-miner-forge":"3008|矿工之戒 (Ring of the Miner)","kaleido":"3015|~","crock-pot":"3017|烹饪锅 (Crock Pot)","together-forever":"3026|~","iron-furnaces-fabric":"3027|更多熔炉 (Iron Furnaces)","lenient-creepers":"3029|仁慈的苦力怕 (Lenient Creepers)|811522","minor-alchemy":"303|小型炼金术 (Minor Alchemy)","treasure2":"3030|寻宝记2 (Treasure2!)","structure-gel-api":"3033|~","the-conjurer":"3034|魔术师 (The Conjurer)|1122250","ganys-nether":"3035|Gany的下界 (Gany's Nether)","ganys-end":"3036|Gany的末地 (Gany's End)","epic-fight-mod":"3037|史诗战斗 (Epic Fight)|1115564","attack-missed":"3038|攻击闪避 (Attack Missed)|1115551","lava-monsters":"3039|熔岩怪 (Lava Monsters)","tumat":"3040|~","riddle-chests":"3041|谜题箱 (Riddle Chests)","totem-plus":"3043|图腾增强 (Totem Plus)","blockmeterfabric":"3044|方块计量表 (BlockMeterFabric)","fluid-drawers":"3046|储液抽屉 (Fluid Drawers)","creepypastacraft-reborn":"3047|蠕动意面重置版 (CreepyPastaCraft Reborn)","itemzoom":"3048|物品缩放 (ItemZoom)","light-overlay":"3049|亮度覆盖 (Light Overlay)","smallerfpsincrements":"3050|~","regex-filters":"3051|正则表达式过滤器 (Regex Filters)","fluidsystem":"3053|流体系统 (FluidSystem)","falling-tree":"3054|伐树 (FallingTree)","issues":"3055|物品名称双语同屏 (Untranslated Items)","particle-culling":"3056|粒子渲染机制优化 (Particle Culling)","aggressive-chickens":"3057|~","entity-culling":"3058|实体渲染机制优化 (Entity Culling)","hammerandvil":"3059|锻造锤与锤锻台 (HammerAndVil)","simply-backpacks":"3061|简易背包 (Simply Backpacks)","mermaid-tail-mod":"3062|~","better-placement":"3063|更好的放置 (Better Placement)|730136","fat-cat":"3064|大资本家 (Fat Cat)","waystones2waypoints":"3065|传送石碑路径点 (Waystones2Waypoints)","beta-days":"3066|B测往昔 (Beta Days)","trajectory-preview-fabric":"3067|弹道预览 (Trajectory Preview)","xp-spawner-control":"3068|刷怪笼经验控制 (Xp Spawner Control)","mob-spawner-control":"3069|刷怪箱控制与修改 (Mob Spawner Control)","refined-pipes":"3070|精致管道 (Refined Pipes)","singularities":"3071|奇点 (Singularities)","better-spawner-control-fabric":"3072|更好的刷怪笼控制 (Better Spawner Control)","crying-ghasts-fabric":"3073|哭泣的恶魂 (Crying Ghasts)","dynamic-fps":"3074|动态FPS (Dynamic FPS)","compact-ores":"3075|致密矿石 (Compact Ores)","thaumic-additions":"3076|神秘领域：重构","fabric-disable-custom-worlds-advice":"3077|禁用自定义世界警告 (Disable Custom World Advice)","leaf-decay":"3078|树叶速腐Fabric版 (Leaf Decay)","fast-furnace-for-fabric":"3079|熔炉性能优化Fabric版 (Fast Furnace for Fabric)","diggus-maximus":"3080|连锁挖掘 (Diggus Maximus)","super-sentai-craft":"3081|超级战队工艺 (Super Sentai Craft)","wildly-eat":"3082|狼吞虎咽 (Wildly Eat)","gotta-climb-fast":"3083|快速爬梯 (Gotta Climb Fast!)","can-i-mine-this-block":"3084|我­­ 能 挖 它 吗？ (cAn i MiNe thIS bLOCk?)","rotten-creatures":"3085|腐烂生物 (Rotten Creatures)|1094419","fairy-lights":"3086|圣诞彩灯 (Fairy Lights)|1167478","packmode":"3087|~","dank-null":"3088|~","avaritia-complement":"3089|~","mcicraft":"309|MCI工艺 (MCI Craft)","better-questing-triggerer":"3090|~","Broken-Wings":"3091|~","Compacter":"3093|压缩者 (Compacter)","simple-cc":"3094|简单清除聊天 (Simple Clear Chat)","not-enough-potions":"3095|~","framed-compacting-drawers":"3096|镶框压缩抽屉 (Framed Compacting Drawers)","discordsuite":"3097|~","mikes-mods-library":"3098|~","Teslafied":"3099|~","ee3":"31|等价交换3 (Equivalent Exchange 3)","shurlin":"3100|仙灵 (Shurlin)","mob-amputation":"3101|怪物截肢 (Mob Amputation)","packguard":"3102|~","wtfs-texturegeneratorlib":"3103|~","more-totems-of-undying":"3104|更多的不死图腾 (More Totems Of Undying)|1120388","dungeon-crawl":"3105|~","tesslocator":"3106|超立方转运器 (Tesslocator)","iblis-headshots":"3107|爆头击杀 (Iblis Headshots)|963706","bee-barker":"3108|~|812120","sky-bonsais":"3109|天空盆景 (Sky Bonsais)","origins":"3111|起源 (Origins (Fabric))|1081026","alexiillib":"3112|~","feed-a-friend":"3113|~","the-legend-of-herobrine":"3116|~","extra-origins":"3117|起源扩展 (Extra Origins)","caves-and-cliffs":"3118|~","miner-golems":"3119|矿工傀儡 (Miner Golems)","engineers-toolbox":"312|工程师工具箱 (Engineer's Toolbox)","online-card":"3121|网络卡片 (Online Card)","felling":"3122|连锁砍树 (Felling)","extra-player-render":"3123|额外玩家渲染 (Extra Player Renderer)|1118280","fabric-api":"3124|~|835999","coloredlanterns":"3125|多彩灯笼 (ColoredLanterns)","ae2-fluid-crafting":"3126|AE2流体合成套件 (AE2 Fluid Crafting)","cardinal-energy":"3127|能量基本 (Cardinal Energy)","travel-anchors":"3128|旅行锚 (Travel Anchors)","bnbgaminglib":"3129|~","e-tools-redstone-powered-tools":"313|电子工具：红石供电工具 (E-Tools: Redstone Powered Tools)","triumph":"3130|~","overloaded-armor-bar-fabric":"3131|护甲上限突破 (Overloaded Armor Bar)|1027870","toomanydanyores":"3132|~","glass-pipe":"3133|玻璃管道 (Glass Pipe)","origins-classes":"3134|起源：职业 (Origins: Classes)|1129492","plonk":"3135|世界内物品放置 (Plonk)|1155521","baritone-1-18-2":"3136|~","potionsmaster":"3137|魔药大师 (Potions Master)|1002297","tinkered-hegemony":"3138|匠器主导 (Tinkered Hegemony)","better-impaling":"3139|更好的穿刺附魔 (Better Impaling)","caliper":"3140|~","botanical-machinery":"3141|植物机械 (Botanical Machinery)","demagnetize":"3142|消磁 (Demagnetize)","cinderscapes":"3147|余烬奇景 (Cinderscapes)","tfc-storage":"3148|~","tfctinkers":"3149|群峦与匠魂 (TFC Tinkers)","modular-systems":"315|模块化熔炉2 (Modular Furnaces 2/Modular Systems)","thick-font-fix":"3150|~","dynamic-trees-traverse":"3152|动态的树：遍历附属 (Dynamic Trees - Traverse)","mcmt-multithreading":"3153|~|1126026","bwm-core":"3154|~","ice-ice-baby":"3155|冰术师 (Ice Ice Baby)","hardlib":"3156|~","bilingualname":"3157|物品名称双语显示 (BilingualName)","chlorine":"3158|氯 (Chlorine)|1120009","bedrock-miner":"3160|基岩矿工 (Bedrock Miner)|789614","reasonable-realism":"3161|合理的现实主义 (Reasonable Realism)|997171","passable-foliage":"3162|叶间穿行 🌳 (Passable Foliage 🌳)","betterend-forge-port":"3163|更好的末地 (BetterEnd)","armor-chroma":"3164|盔甲颜色显示 (Armor Chroma)|772358","interactions":"3165|自定义交互事件 (Interactions)","lods-of-emone":"3166|很多钱 (Lods of Emone)","fabric-language-scala":"3167|~","fluid-physics":"3168|流体物理 (Fluid Physics)","zettai-grimoires":"3169|~","Traincraft":"317|火车工业 (Traincraft)","runorama":"3170|全景截图背景 (Runorama)|910751","item-stages":"3171|物品阶段 (Item Stages)","rocksalt":"3172|~","cazfps-the-dead-sea":"3173|~","pouch-of-unknown":"3174|未知之袋 (Pouch of Unknown)","wizardry-fates":"3175|~","the-mighty-architect":"3176|~","phosphophyllite":"3177|~","biggerreactors":"3178|~","ftb-teams-fabric":"3179|FTB 团队 (FTB Teams)","hydraulicraft":"318|液压工艺 (Hydraulicraft)","waveaway":"3180|挥挥手 (WaveAway)","no-advancements":"3181|移除进度机制 (No Advancements)","tfc_rocksplus":"3182|群峦岩石 (TFC Rocksplus)","mars-mod-reborn":"3183|~","ftb-library-fabric":"3184|~","crossroads-mc":"3185|交错道途 (Crossroads)","config-checker":"3186|整合包配置检测 (Modpack Configuration Checker)","thaumic-speedup":"3187|~","armor-curve":"3188|盔甲曲线修改 (Armor Curve)","ambience-extras":"3189|环境音乐：附加 (Ambience - Extras)","utilities3":"319|流体能量 (Utilities³)","additions-mod":"3190|~","extracpus":"3191|更多CPU (Extra CPUs)","extra-crafting-storage":"3192|~","underground-city-engineering":"3194|地下城市工程 (Underground City Engineering)|943842","essentials":"3195|~","soul-shards-respawn":"3196|~","soul-shards-the-old-ways":"3197|~","the-flying-things":"3199|~","minefactory-reloaded":"32|我的工厂|693826","ftb-ranks-fabric":"3200|~","ftb-chunks-fabric":"3201|~","ftb-essentials":"3202|~","silveroak-outpost":"3203|银橡前哨 (Silveroak Outpost)","pehkui":"3204|~","jeitweaker":"3205|~","yungs-law":"3206|~","libx":"3207|~","atmospheric":"3208|悠然一派 (Atmospheric)","monospace-font":"3209|等宽字体 (Monospace font)","mana-liquidizer":"3211|魔力液化器 (Mana Liquidizer)","neapolitan":"3212|那不勒斯风味 (Neapolitan)","clear-despawn-fabric":"3213|~","tinkers-modifier-modifier":"3214|匠魂强化修改 (Tinkers' Modifier Modifier)","randomtweaks":"3215|随意微调 (RandomTweaks)|776232","zettai-magic":"3216|~","strawgolem-reborn":"3217|稻草傀儡重制版 (Straw Golem Reborn)","rare-ice":"3218|冰中有宝 (Rare Ice)|1267712","create-integration":"3219|~","the-magic-mirror":"3220|魔镜 (The Magic Mirror)","extra-boats":"3222|额外船只 (Extra Boats)","outvoted":"3223|落选生物 (Outvoted)|1144693","attribute":"3225|属性修复 - Fabric版 (Attribute Fix {FABRIC})","packmodemenu":"3226|PackMode菜单 (PackModeMenu)","simple-gamemodes":"3227|游戏模式短指令 (Simple Gamemodes)","uniq":"3228|流体统一/物品统一 (UniQ)","harder-ores":"3230|更难的矿物处理 (Harder Ores)","rune-craft":"3231|~","geckolib":"3232|~","memory-cleaner-mod":"3233|内存自动清理 (Memory Cleaner Mod)","ore-flowers":"3234|矿物花卉 (Ore Flowers)","aqua-creepers":"3235|水下苦力怕 (Aqua Creepers!)","extrastorage":"3236|更多存储 (ExtraStorage)","thermal-locomotion":"3237|热力运输 (Thermal Locomotion)","external-tweaker":"3238|~","morebiomesxl":"3239|~","school-mod-forge-1-14":"324|学校 (School Mod)","notes":"3240|笔记 (Notes)","stare-till-they-grow":"3241|盯到它们熟为止！ (Stare Till They Grow!)","vm-computers":"3242|虚拟电脑 (VM Computers)","inventory-free":"3243|无物品栏 (Inventory-Free)","randompatches-integration":"3245|~","bubble-column-elevator-backport":"3246|1.13水域机制 (1.13 Water Mechanics)","basic-nether-ores":"3247|基础下界矿石 (Basic Nether Ores)|1136294","nuclearcraft-reactor-builder":"3248|核电工艺反应堆建造机 (NuclearCraft Reactor Builder)","pams-harvestcraft-2-food-core":"3249|潘马斯农场2 - 食物核心 (Pam's HarvestCraft 2 - Food Core)|1000336","witchery":"325|巫术 (Witchery)|314815","eki-lib":"3250|~","nodami":"3252|伤害免疫机制移除 (No Damage Immunity)","astrological-sorcery":"3253|星占魔法 (Astrological Sorcery)","efab-ct-bindings":"3254|~","golden-hopper":"3255|金漏斗 (Golden Hopper)|1109760","wizardry-golems":"3256|巫术傀儡 (Wizardry Golems)","devtech":"3259|GTCE-CrT 开发套件 (Devtech)","growthcraft-community-edition":"326|生长工艺 (GrowthCraft)","jurassic-world-reborn-mod":"3265|侏罗纪世界重生 (Jurassic World Reborn Mod)","cardboard":"3267|~","crimson-revelations":"3269|血腥启示 (Crimson Revelation)","gregtech-5-unofficial":"327|格雷科技5 (GregTech 5)|352465","environmental-core":"3270|~","bigger-crafting-tables":"3271|~","covers-everywhere":"3272|万用覆盖板 (Covers Everywhere)","mo-villages":"3273|更多村庄 (Mo' Villages)|814563","inventoryneko":"3274|~","loading-screens":"3275|自定义加载画面 (Loading Screens)","ofms-crisis-ridden":"3276|OFMS:危机重重 (OFMS:crisis-ridden)","dupefix-project":"3277|~","ore-control":"3278|矿物控制 (Ore Control)","twitch-chat-integration":"3279|Twitch信息显示 (Twitch Chat Integration)","avaritia-lite":"3282|无尽贪婪精简版 (Avaritia Lite)","packmenu":"3283|~","console-hud":"3285|原主机版界面特性 (Console Experience)","mite-reborn":"3288|MITE：重生 (MITE:Reborn)","detailed-technology":"3289|细节科技 (Detailed Technology)|1145905","mantle":"329|地幔 (Mantle)","oreberries":"3290|矿莓 (Oreberries)","stone-block-utilities":"3291|~","mystical-creations":"3292|~","multiconnect":"3293|~","art-of-alchemy-memoriam":"3294|炼金艺术：纪念版 (Art of Alchemy: Memoriam)|1017647","blockphysics":"3295|方块物理 (BlockPhysics)","stoneblock-dimensions":"3296|~","charging-gadgets":"3297|充电设备 (Charging Gadgets)","integration-foregoing":"3298|工业先锋集成附属 (Integration Foregoing)|937389","enderfuge":"3299|末影熔炉 (Enderfuge)","customoregen":"330|自定义矿物生成 (Custom Ore Generation)","calm-down-zombie-guy":"3300|~","universal-mod-core":"3301|~","suspended-server":"3302|挂起服务器 (Suspended Server)","starlight-forge":"3303|星光 (Starlight)|1216316","research-table":"3304|研究台 🔬 (Research Table 🔬)|871188","shoulder-surfing-reloaded":"3305|越肩视角重制 (Shoulder Surfing Reloaded)|985499","silents-mechanisms":"3307|寂静机械 (Silent Mechanisms)","project-potman":"3308|背锅人计划 (ProjectPotman)","nbt-crafting":"3309|数据包NBT合并 (Nbt Crafting)","littlemaidmobx":"331|女仆 (LittleMaidMob)|367058","diregoo":"3310|~","ogdragon":"3311|OG龙+ (OGDragon+)","sevtweaks":"3312|~","journeymapstages":"3313|旅行地图阶段控制 (JourneyMapStages)","textile-backup":"3314|Textile备份 (Textile Backup)","goopers":"3315|~","mob-drops":"3316|自定义生物战利品 (Mob Drops Your Way)","alexs-mobs":"3318|Alex 的生物 (Alex's Mobs)|1185939","all-stackable":"3319|可堆叠物品自定义 (All Stackable)","botania-fabric":"332|植物魔法 (Botania)|722470","thermal-mj":"3320|热力MJ支持 (Thermal MJ)","ctd-core":"3321|~","time-speed-mod":"3322|Minecraft地球自转/真实昼夜循环 (Вращение Земли Майнкрафтская (Accurate day/night-cycles Mod))","mineral-tracker":"3324|~","carpet-extra":"3325|Carpet拓展 (carpet-extra)","viafabric":"3327|~","double-slabs":"3328|双重台阶 (Double Slabs)","tools-and-armor-bop":"3329|超多生物群系：旧工具和装甲 (Tools And Armor - BOP)","alternate-terrain-generation":"333|交替性地形生成 (Alternate Terrain Generation)","centralized-materials":"3330|集中材料 (Centralized Materials)","server-sided-chunk-loader":"3331|服务器端区块加载器 (Server Sided Chunk Loader)","fluid-cows":"3332|流体牛 (Fluid cows)","shulkerboxviewer":"3333|~","gameinfo":"3334|游戏信息 (GameInfo)","arcaea":"3335|Arcaea韵律源点 (Arcaea)","advanced-tfc-tech":"3336|进阶群峦科技 (Advanced TFC Tech)","vanilla-enhanced":"3337|原版增强 (Enriched/Vanilla Enhanced)","satisforestry":"3338|~","asmc":"3339|~","gendustry":"334|基因工业 (Gendustry)|441078","simple-generators":"3340|简易发电机 (Simple Generators)","tfc-bonsai":"3341|群峦盆栽 (TFC Bonsai)","tfc-drying-rack":"3342|群峦晾干架 (TFC Drying Rack)","lumen":"3344|流明 (Lumen 🔥)","openblocks-elevator":"3345|开放式电梯 (OpenBlocks Elevator)","crafttweaker-integration":"3346|CrT集成 (CraftTweaker Integration)","spiders-2-0":"3348|蜘蛛行为增强 (Spiders 2.0)","hammer-metals":"3350|锤子材料 (Hammer Metals)","bunch-of-biomes":"3351|生物群系扩充 (Bunch Of Biomes!)","better-slimes":"3353|更好的史莱姆 (Better Slimes)|890364","windowlogging":"3354|玻璃板贴合 (Windowlogging)","the-time-stop-mod":"3355|时间静止 (The Time Stop Mod)","vanilla-hammers-forge":"3357|原版材质锤 (Vanilla Hammers)","imblocker":"3358|输入法冲突修复 (IMBlocker)|935619","hardcore-map-reset":"3359|~","tfc-aged-drinks":"3360|群峦陈酿 (TFC Aged Drinks)","buildcraft-rf":"3361|~","youtubers-lucky-blocks":"3362|Youtuber的幸运方块 (Youtuber's Lucky Blocks)","wandering-trapper":"3363|流浪猎人 (Wandering Trapper)","chocolate-fix":"3364|~","thaumcraft-4-scrolling":"3365|~","orderly":"3366|~|996563","water-control-extreme":"3367|~","variant16x":"3368|~","endremastered-fabric":"3369|末地：创世 (End Remastered)","unique-crops":"3371|独特作物 (Unique Crops)|910420","yungs-api-fabric":"3372|~","dawn":"3373|~","assembly-line-machines":"3374|装配线 (Assembly Line Machines)","netherending-ores":"3375|~","Flex-FOV":"3376|扭曲视野 (Flex FOV)","hooked":"3377|抓钩 (Hooked)","createtweaker":"3378|~","iTorch":"3379|~","gullivern":"3381|~","nbt-manipulator":"3382|~","netherending-ores-configs":"3383|~","sulfur-and-potassium-make-more-gunpowder":"3385|~","statues":"3386|雕像 (Statues)|1119703","advanced-mining-dimension":"3387|先进的采矿维度 (Advanced Mining Dimension)|1157631","time-travel-mod":"3388|时间旅行 (Time Travel Mod)","backslotaddon":"3389|背用武器拓展 (BackSlotAddon)","betterfonts":"339|更好的字体 (BetterFonts)|187674","optifabric-1-8-9":"3390|~","gt6-ore-helper":"3392|GT6矿石助手 (GT6 Ore Helper)","applied-integrations":"3393|应用集成 (Applied Integrations)","inventory-hud-forge":"3395|物品栏HUD+ (Inventory HUD+)|1116793","prehistoric-flora":"4869|史前自然","langsplit":"3397|~","legacy-fabric-api":"3398|~","krypton":"3399|氪 (Krypton)","render-player-api":"34|玩家渲染API (Render Player API)","zelda-sword-skills":"340|塞尔达剑技 (ZELDA SWORD SKILLS)|500299","mana-gear":"3400|~","not-enough-enchantments":"3401|~","bon-appetit-fabric":"3402|祝您好胃口 (Bon Appetit)","scuba-gear":"3404|潜水装备 (Scuba Gear)","avatar-mod-2-out-of-the-iceberg":"3405|降世神通：突破冰山 (Avatar Mod 2: Out of the Iceberg)","lazy-dfu-forge":"3407|DFU载入优化 (LazyDFU)","ridable-ender-pearls":"3409|可骑乘末影珍珠 (Ridable Ender Pearls)|1126706","gildedarmor":"3410|镀金盔甲 (GildedArmor)|1126586","deadly-book":"3411|致命书本 (Deadly Book)","speedy-hoppers":"3412|极速漏斗 (Speedy Hoppers)","indium":"3413|铟 (Indium)","go-fish":"3416|~","more-player-models":"3417|更多玩家模型 (More Player Models)","loot-overhaul":"3418|~","miners-helmet":"3419|矿工头盔 (Miner's Helmet)","minemenu":"342|我的菜单 (MineMenu)|302947","lightweight-blood-mechanics":"3420|~","kbackup-fabric":"3421|~","smooth-boot-forge":"3422|流畅加载 (Smooth Boot)","netherite-plus-mod":"3424|下界合金拓展 (Netherite Plus Mod)","chunkpregenerator":"3425|区块预生成器 (Chunk-Pregenerator)|1015490","antighost":"3426|方块同步修复 (AntiGhost)","backslot":"3428|背用武器 (BackSlot)","minecraftcapes-mod":"3429|~","symcalc":"343|对称度运算仪 (Symcalc)","spartan-weaponry-arcana":"3431|斯巴达奥法 (SpartanWeaponryArcana)","greek-fantasy":"3433|希腊幻想 (Greek Fantasy)|1143037","architectury-api":"3434|~","fantastic-beasts-and-how-to-eat-them-butchercraft":"3436|~","createaddition":"3437|~","smithee":"3438|~","dragon-egg-replicator":"3439|龙蛋复制器 (Dragon Egg Replicator)","assassins-creed-blocklegend":"4312|刺客信条：方块传奇2|1168306","elemental-ingots-ei":"3441|元素锭 (Elemental Ingots)","solargeneration":"3442|太阳能发电机 (Solar Generation)","enchant-with-mob":"3443|~","worldstatecheckpoints":"3445|~","dungeons-plus":"3446|~","liquid-enchanting":"3447|药水附魔 (Liquid Enchanting)|844632","shutup-experimental-settings":"3448|禁用实验性设置警告 (Shutup Experimental Settings!)","datafixerslayer":"3449|~","iguanas-tinker-tweaks":"555|匠魂增强|425981","hexcraft":"3450|~","police-mod":"3451|警察 (Police Mod)","enhanced-celestials-fabric":"3452|月亮事件 (Enhanced Celestials)","resourceful-bees":"3453|缤纷蜜蜂 (Resourceful Bees)","held-item-info":"3454|手持物品信息 (Held Item Info)|977835","cleancut":"3455|干净利落 (CleanCut)|1231946","plus-tweaks":"3456|~","global-gamerules":"3457|全局游戏规则 (Global GameRules)","save-my-stronghold":"3459|~","jabba":"346|更好的储物桶 (Just Another Better Barrel Attempt)","physics-mod":"3460|真实物理 (Physics mod)","bluemap":"3461|~","dregora":"3462|德雷戈拉 (Dregora)","k4lib":"3463|~","deadly-end-phantoms":"3464|~","spice-of-life-potato-edition":"3465|生活调味料：马铃薯版 (Spice of Life: Potato Edition)","easiervillagertrading":"3466|简单村民交易 (EasierVillagerTrading)","wwta":"3467|聊天栏时间显示 (When Was That Again)|1285507","ars-nouveau":"3468|新生魔艺 (Ars Nouveau)","eidolon":"3469|幻梦 (Eidolon)","mcheli-minecraft-helicopter-mod":"347|MC直升机 (MC Helicopter MOD)","rats-ratlantis":"3470|老鼠：鼠西洲 (Rats: Ratlantis)","wthit-forge":"3471|~|1200908","modern-industrialization":"3472|现代工业化 (Modern Industrialization)","chunk-pregenerator-fabric":"3473|区块预生成器（Fabric） (Fabric Chunk Pregenerator)|1167231","jumploader":"3474|~","unloader":"3475|~","better-animal-models":"3476|更真实的动物 (Better animal models)","druidcraft":"3479|德鲁伊工艺 (Druidcraft)|1162793","ex-aliquo":"348|~","berry-good":"3480|~","savage-and-ravage":"3481|残暴与掠夺 (Savage & Ravage)","jade":"3482|玉 🔍 (Jade 🔍)","somnia":"3483|梦醒时分 (Somnia Awoken)","industrial-reborn":"3484|~","mo-structures-forge":"3485|更多自然生成结构 (Mo' Structures)","wallpapercraft-a-fresh-roll":"3486|墙纸创造 (Wallpapercraft - A Fresh Roll)","clear-despawn":"3487|~","botany-trees":"3491|~","better-third-person":"3492|~","survive":"3493|生存要素 (Survive)","wallpapercraft-a-fresh-roll-stairs":"3494|墙纸创造：楼梯 (Wallpapercraft - A Fresh Roll (Stairs!))","wallpapercraft-a-fresh-roll-slabs":"3495|墙纸创造：台阶 (Wallpapercraft - A Fresh Roll (Slabs!))","wallpapercraft-a-fresh-roll-walls":"3496|墙纸创造：围墙 (Wallpapercraft - A Fresh Roll (Walls!))","compact-crafting":"3497|~","assembly-lines":"3498|装配线 (Assembly Lines)","botany-pots":"3499|植物盆栽 (Botany Pots)","player-api":"35|玩家API (Player API)","steves-carts-2":"350|史蒂夫矿车2 (Steve's Carts 2)","callable-horses":"3500|召之马来 (Callable Horses)","ultimate-solar-panels":"3502|~","slight-gui-modifications":"3503|界面微调 (Slight Gui Modifications)|1148951","elemental-craft":"3504|元素工艺 (Elemental Craft)","just-another-rotten-flesh-to-leather-mod":"3505|腐肉换皮革 (Just Another Rotten Flesh to Leather Mod)","spatial-harvesters-fabric":"3506|~","emotecraft-forge":"3507|表情工艺 (Emotecraft)","pattysmorestuff":"3508|~","hats":"3509|帽子 (Hats)","mariculture":"351|海洋物语 (Mariculture)|321251","smoother-bedrock":"3510|平滑基岩层 (Smoother Bedrock)","c2me-fabric":"3511|C^2M 引擎 (C^2M-Engine/Concurrent Chunk Management Engine)|1188136","datapack-anvil":"3512|~","nuclear-science":"3513|核科学 (Nuclear Science)","glaretorch":"3514|强光火把 (Glare Torch)","mrcrayfishs-jumping-castle-mod":"3515|MrCrayfish的充气城堡 (MrCrayfish's Jumping Castle)","exposer":"3516|~","to-the-bat-poles":"3517|~","cc-restitched":"3518|~","wearables":"3519|可穿戴设备 (Wearables)","evilcraft":"352|邪恶工艺 (EvilCraft)","better-weather-fabric":"3522|更好的天气 (Better Weather)","ultimate-car-mod":"3523|终极汽车 (Ultimate Car Mod)|938477","craft-time":"3524|耗时合成 (Craft Takes Time)|1159911","betterf3":"3525|更好的F3 (BetterF3)","the-abyss-chapter-ii":"3527|深渊：第二章 (The Abyss: Chapter II / The Abyss II - The Other Side)","mapper-base":"3528|~","bedrockify":"3529|~","projecte":"353|等价交换重制版 (ProjectE)|1109380","rftools-power":"3531|RF工具：能量 (RFTools Power)","pipez":"3532|~","coins-je":"3533|~","beenfo":"3535|蜂巢信息 (Beenfo)","chest-building-blocks":"3536|~","zycraft":"3537|~","quitconfirm":"3538|退出前确认 (QuitConfirm)|1116784","ruined-equipment":"3539|~","falling-meteors-mod":"354|陨石 (Falling Mateors)","clickthrough":"3540|~","dynamic-sound-filters":"3541|动态声音滤波器 (Dynamic Sound Filters)","binniepatcher":"3542|~","subterranean-wilderness":"3543|~","construction-wand":"3545|建筑之杖 (Construction Wand)","squeedometer":"3546|~","forgery":"3547|~","fabrication":"3548|~","mcdj":"3549|~","boost-boots":"3550|~","better-sodium-video-settings-button":"3551|更好的钠视频设置按钮 (Better Sodium Video Settings Button)","artisan-worktables-1-16":"3553|工匠之作2 / 工匠工作台2 (Artisan Worktables 2 / Artisan Worktables 1.16)","thermal-solars":"3554|~","supplementaries":"3555|~|1149530","more-fuels-mod":"3556|~","pointless-tech-collective":"3558|~","revampedwolf":"3559|~","bedrock-b-gone":"3560|~","elemental-creepers":"3562|元素爬行者 (Больше Криперов)|287856","gymcraft":"3563|~","infernal-expansion":"3564|地狱扩展 (Infernal Expansion)","configurable-mob-potion-effects-fabric":"3567|怪物药水效果自定义 (Configurable Mob Potion Effects)","sapience":"3568|~","netherite-nuggets-forge":"3569|下界合金粒 (Netherite Nuggets)","thermal-expansion":"634|热力膨胀|805200","eroding-stone-entities-fabric":"3570|~","direbats-fabric":"3571|~","advanced-electric-tools":"3572|高级电动工具 (Advanced Electric Tools)","backpacker":"3574|~","ynet":"3576|~","simple-drawers":"3577|简单的抽屉 (Simple Drawers)","charmonium-reforged":"3578|~","xnicex":"3579|~","krate":"3580|~","chickensshed":"3581|鸡棚重置版 (ChickensShed)","chickenshed":"3582|~","expanded-storage-forge":"3583|扩展存储 (Expanded Storage)","project-mmo":"3584|~","abnormals-delight":"3585|~","jojos-bizarre-survival":"3586|~","somnus":"3588|~","lost-trinkets":"3589|~","lookingglass":"3590|~","environmental":"3591|自然环境 (Environmental)","golden-airport-pack-immersive-vehicles-content":"3593|~","hole-filler-mod":"3595|洞口填充器 (Hole Filler)","simply-tea":"3597|简单的茶！ (Simply Tea!)|699389","buttermilk":"3598|~","diet":"3599|饮食 (Diet)","glacia-dimension":"360|冰河时代 (Glacia)","brazilian-fields":"3600|巴西风情 (Brazilian Fields)","ae2-extras":"3601|AE2附加 (AE2 Extras)","animalium":"3602|动物 (Animalium)","mob-origins":"3603|生物起源 (Mob Origins)","better-default-biomes":"3604|更好的默认生物群系 (Better Default Biomes)","kaimyentity":"3605|KAI我的实体 (KAIMyEntity)|1170874","tablechair":"3606|桌椅 (TableChair)","when-dungeons-arise-fabric":"3607|地牢浮现之时 (When Dungeons Arise)","animal-feeding-trough":"3608|动物喂养槽 (Animal Feeding Trough)","wiki-zoomer":"3609|~","personality":"3610|~","allurement":"3611|~","dwarf-miner-totem":"3612|矮人矿工 (Dwarf Miner Totem)","yungs-better-portals":"3613|YUNG的传送门机制重构 (YUNG's Better Portals)","german-road-signs-mod":"3614|德国交通标志 (German Road Signs Mod)","iguana-in-a-blanket":"3615|真实调整 (Iguana in a Blanket)","anthill-inside":"3616|蚂蚁物流 (Anthill Inside)","nei-integration":"3617|~","uncrafting-grinder":"3618|分解磨床 (Uncrafting Grinder)","emendatus-enigmatica":"3619|~","realtrainmod":"362|真实火车 (RealTrainMod)|781058","jousting":"3623|马术 (Jousting)","bamboo-blocks":"3624|~","scape-and-run-parasites":"3625|逃逸：寄生兽 (Scape and Run: Parasites)","just-enough-drags":"3626|更多JEI拖拽 (Just Enough Drags)|1179845","exnihilo-automation":"3627|无中生有：自动化 (Exnihilo: Automation)","world-handler-command-gui":"3628|世界管理器：图形交互 (World Handler - Command GUI)","entityculling":"3629|实体渲染机制优化 (Entity Culling Fabric/Forge)","applemilktea2":"363|苹果奶茶2 (Apple&Milk&Tea! ver2)|466114","tea-kettle":"3631|茶壶 (Tea Kettle)","enhanced-block-entities":"3632|方块实体优化 (Enhanced Block Entities)","gun-customization-infinity":"3633|~","dungeons-gear":"3634|地下城装备 (Dungeons Gear)","integrated-nbt":"3635|~","pillagers-plus":"3636|~","abundance":"3640|~","just-enough-calculation":"3643|~|561503","mythicbotany":"3644|神话植物学 (MythicBotany)|1190745","improved-mobs-fabric":"3645|怪物增强 (Improved Mobs)","limitless":"3646|无上限附魔 (Limitless)|1118079","vpn-blocker":"3647|禁用VPN (VPN Blocker)","premium-wood":"3648|~","tenshilib-fabric":"3649|~","flaxbeards-steam-power":"365|FSP蒸汽动力 (Flaxbeard's Steam Power)|315722","randomportals":"3650|随意传送门 (RandomPortals)","configured":"3651|配置界面 (Configured)","jellyfishing":"3653|抓水母 (Jellyfishing)","accurate-block-placement":"3654|~","pro-placer":"3655|放置专家 (Pro Placer)","farmers-delight-compats":"3656|~","farmers-tea":"3657|农夫的茶 (Farmer's Tea)","farmers-delight-integration":"3658|~","magical-psi-redux":"3659|~","anvil-fix":"3660|铁砧修复 (Anvil Fix)","no-increasing-repair-cost":"3661|~","wool-temples":"3662|羊毛神殿 (Wool Temples)","exp-bottling":"3663|经验装瓶 (EXP Bottling)","buildersaddition":"3664|~","gt-remastered":"3665|格雷科技重制版 (GT: Remastered)","tips":"3666|提示 (Tips)","Interactio":"3667|~","advancement-book":"3668|进度之书 (Advancement Book)","drawers-tooltip":"3669|抽屉提示 (Drawers Tooltip)","steves-factory-manager-reborn":"367|史蒂夫工厂管理 (Steve's Factory Manager)","paradise-lost":"3670|天境：重生 (Paradise Lost)","more-jellyfish":"3673|更多水母 (More Jellyfish)","easy-ladders":"3674|~","beta-dannys-expansion":"3675|~","inventory-tweaks-renewed":"3676|~","arrp":"3677|高级运行时资源包 (Advanced Runtime Resource Packs)","tougher-glass-fabric":"3678|~","differentiate":"3679|~","cookie-core-fabric":"3680|~","image-world-generator":"3681|图片地图转换器 (Image World Generator)","inductive-logistics":"3682|集成物流 (Inductive Logistics)","automatic-path":"3684|~","morevanillalib":"3686|~","vanilla-excavators-forge":"3687|~","morevanillatools":"3689|更多原版工具 (MoreVanillaTools)","colorful-health-bar":"3690|~","tipline":"3691|~","ultimate-plane-mod":"3692|终极飞机 (Ultimate Plane Mod)","simple-voice-chat":"3693|简单的语音聊天 (Simple Voice Chat)|1232171","not-enough-milk":"3694|~","ewewukeks-musket-mod":"3695|ewewukek的火枪模组 (ewewukek's Musket mod)","irisshaders":"3697|~|1161271","chambers":"3699|处理仓 (Chambers)","thaumcraftgates":"370|神秘管道 (ThaumcraftGates)","sodium-extra":"3701|钠 · 扩展 (Sodium Extra)","grind-enchantments":"3702|砂轮增强 (Grind Enchantments)","voice-chat":"3703|语音聊天 (Voice Chat)","xnet-gases":"3705|~","filing-cabinets-refurbished":"3706|~","dropz":"3708|~","figura":"3709|~","autopilot-fabric":"3711|~","applied-energistics-2-wireless-terminals":"3712|AE2无线终端 (Applied Energistics 2 Wireless Terminals)","appliedenergisticstweaker":"3713|~","sleeping-bags":"3714|睡袋 (Sleeping Bags)","mass-inscriber":"3715|~","random-title":"3717|随机标题 (Random Title)|980991","astikorcarts":"3718|~","invsync-fabric":"3719|背包同步 (InvSync)","jea":"3720|JEI进度 (Just Enough Advancements)","et-futurum-requiem":"3721|~","better-op":"3722|更好的OP (Better Op)","fastworkbench-minus-replacement":"3723|~","crimson-compass":"3724|绯红指南针 (Crimson Compass)","ryoramas-terraria-mod":"3726|~","steves-workshop":"3727|~","upgraded-ender-chests":"3728|高级末影箱 (Upgraded Ender Chests)","ydm-ygo-dueling-mod-ii":"3729|~","notenoughkeys":"373|更好的按键控制 (Not Enough Keys)","versioner":"3730|整合包版本工具 (Versioner)","engineers-workshop-reborn":"3732|~","crimson-xp-charm":"3736|经验护符 (Crimson XP)","locatebiome":"3737|~","enderman-evolution":"3738|~","sophisticated-backpacks":"3739|精妙背包 (Sophisticated Backpacks)","age-of-exile":"3740|~","whoosh":"3741|~","gregtech-intergalactical":"3742|泛银河系格雷科技 (GregTech Intergalactical)","catalogue":"3743|模组目录 (Catalogue)","libblockattributes":"3744|~","balance-of-exile":"3745|~","dungeons-of-exile":"3746|~","more-food-addon-bedrock":"3747|~","pe-superheroes-mod":"3748|~","necromancy":"3749|~","pet-bats":"375|宠物蝙蝠 (Pet Bat Mod)|295007","library-of-exile":"3750|~","variegated":"3752|~","chest-cavity":"3753|胸腔 (Chest Cavity)","extended-note-block":"3754|音符盒扩展 (Extended Noteblocks)","hbms-nuclear-tech-mod-reloaded":"3755|HBM的核科技重制版 (Hbm's Nuclear Tech Mod Reloaded)","loading-timer":"3756|加载时长显示 (Loading Timer)","ocrocketry":"3757|~","chime-fabric":"3758|~","witherite":"3759|凋灵合金 (Witherite)","astromine-core":"3761|天体矿工：核心 (Astromine: Core)","dungeondq":"3762|~","dynamic-trees-integrated-dynamics":"3763|动态的树：动态联合/集成动力附属 (Dynamic Trees - Integrated Dynamics)","skyblock-builder":"3764|空岛建立者 (Skyblock Builder)","antiportals":"3765|反传送门 (AntiPortals)","trash-cans":"3766|垃圾桶 (Trash Cans)","mattdahepic-core":"3767|~","mob-farm-helpers-fabric":"3768|刷怪塔小帮手 (Mob Farm Helpers)","metal-bushes":"3769|金属灌木 (Metal Bushes)","the-vanilla-experience":"3772|~","flower-seeds":"3773|~","astemirs-forest-craft":"3777|~","astromine-foundations":"3778|天体矿工：基础 (Astromine: Foundations)","create-stuff-additions":"3779|机械动力：物品附加 (Create : Stuff Additions)|1314047","ultratech":"378|次元科技 (UltraTech)","slab-machines":"3780|台阶型设备 (Slab Machines)","more-create-stuffs":"3781|更多机械动力物品 (More Create Stuffs)","rsinfinitybooster":"3782|~","cuneiform":"3783|~","terraincognita":"3784|~","cloth-api":"3785|~","ingameime":"3786|游戏内输入法 (IngameIME)|1158421","yungs-better-strongholds-fabric":"3787|YUNG的要塞重制 (YUNG's Better Strongholds)","mojangdark":"3788|暗色加载界面 (MojangDark)","astromine-technologies":"3789|天体矿工：科技 (Astromine: Technologies)","astromine-transportations":"3790|天体矿工：运输 (Astromine: Transportaions)","azuredooms-chunk-loader":"3791|~","creeper-spores":"3792|苦力怕孢子 (Creeper Spores)","more-dragon-eggs":"3793|更多的龙蛋 (More Dragon Eggs)","more-red":"3794|更多红石 (More Red)","craftable-items":"3797|~|1166161","ex-nihilo-sequentia-mekanism-addon":"3798|无中生有：传承 - 通用机械扩展 (Ex Nihilo: Sequentia - Mekanism Addon)","panorama":"3799|全景图 (Panorama)","atomicstrykers-infernal-mobs":"380|稀有精英怪 (Infernal Mobs)|592395","bgcore":"3800|~","induction-charger":"3801|~","tiered-forge":"3802|~","c-o-m-b-a-t":"3803|~","burden-of-time":"3804|~","gamemenumodoption":"3805|游戏菜单模组设定 (Game Menu Mod Option)","game-menu-remove-gfarb":"3806|游戏菜单移除GFARB (Game Menu Remove GFARB)","randomdeathmessage":"3807|随机死亡消息 (RandomDeathMessage)","ex-nihilo-sequentia-ae2-addon":"3808|无中生有：传承 - 应用能源2扩展 (Ex Nihilo: Sequentia - AE2 Addon)","sweetmagic":"3809|甜蜜与魔法 (SweetMagic)|1255490","applecore":"381|苹果核 (AppleCore)","astromine-discoveries":"3810|天体矿工：探索 (Astromine: Discoveries)","azuredooms-angel-ring-fabric":"3811|AzureDoom的天使指环 (AzureDooms Angel Ring)","togglelib":"3812|列车手柄库 (ToggleLib)|1189685","regrowth":"3813|再生 (Regrowth)","mobs-main-menu":"3814|~","chaos-awakens":"3816|混沌觉醒 (Chaos Awakens)","hot-or-not":"3817|~","playerpig":"3818|~","tumble-dryer":"3819|~","cat-jammies":"3820|~","rhino":"3821|犀牛 (Rhino)","fastsuite":"3822|配方性能优化 (FastSuite)","twerkitmeal":"3823|跳舞生长一切 (Twerk To Grow All The Things)","thermal-integration":"3824|热力系列 (Thermal Series)","piggybanks":"3825|存钱罐 (Piggybanks)","in-control":"3826|~","mystical-agriculture-refabricated":"3827|神秘农业：Fabric版 (Mystical Agriculture: Refabricated)","pedestals":"3828|~","aerial-affinity-fabric":"3829|~","communism-life-and-art":"3830|共产主义：生活与艺术 (Communism:Life and Art)","project-war-dance":"3831|战舞计划 (Project: War Dance)|1176754","faster-ladder-climbing":"3832|更快的爬梯 (Faster Ladder Climbing)","infinitymending":"3833|无限+经验修补 (InfinityMending)","better-than-mending":"3834|更好的经验修补 (Better Than Mending)","elenai-dodge-2":"3835|~","taterzens-forge":"3837|~|1242114","dragons-survival":"3838|龙之生存 (Dragon Survival)","no-lan-cheats":"3840|禁用局域网作弊 (No LAN Cheats)","dashloader":"3841|疾速加载 (DashLoader)","caveworld-2":"3842|洞穴世界 (Caveworld 2)","break-progress":"3844|破坏进度 (Break Progress)","item-model-fix":"3845|物品模型修复 (Item Model Fix)","additional-pipes-for-buildcraft":"3847|附加管道 (Additional Pipes for Buildcraft)","lolasm":"3848|~","rftools-utility":"3849|RF工具：实用设备 (RFTools Utility)","thaumic-energistics":"385|神秘能源 (Thaumic Energistics)|791638","ctm-fabric":"3850|连接材质Fabric版 (ConnectedTexturesMod for Fabric)","whats-that-slot":"3851|~","pmmo-and-nbt-compat":"3852|~","techstacks-heavy-machinery-mod":"3853|~","enhanced-mushrooms-fabric":"3854|蘑菇增强 (Enhanced Mushrooms)","versatile-portals":"3855|~","spawn-egg-recipes":"3856|刷怪蛋配方注册 (Spawn Egg Recipes)","configurable-extra-mob-drops-fabric":"3857|可配置的额外怪物掉落 (Configurable Extra Mob Drops)","enhanced-mob-spawners":"3858|刷怪笼增强 (Enhanced Mob Spawners)","autorun":"3860|~","animania-farm":"3861|动物谷:农场 (Animania Farm)","animania-extra":"3862|动物谷:额外动物 (Animania Extra Animals)","animania-cats-dogs":"3863|动物谷:猫猫狗狗 (Animania Cats & Dogs)","better-foliage-renewed":"3864|更好的树叶重制版 (Better Foliage Renewed)","block-swap-fabric":"3865|~","basalt-walker":"3866|玄武岩行者 (Basalt Walker)","endless-oceans-adventures-fabric":"3868|无尽海洋：冒险 (Endless Ocean: Adventures)","bpm":"3869|~","chisel":"387|凿子 (Chisel)|641383","stone-circles":"3870|~","phase-potion":"3871|相位药水 (Phase Potion)","marblegates-exotic-enchantment-flowing-agony":"3872|白门的奇异附魔：苦痛长河 (MarbleGate's Exotic Enchantment: Flowing Agony)|1198067","measurements":"3873|~","armor-slots-in-other-inventories":"3874|可见装备槽 (Visible Armor Slots)|1191226","moon-and-space-dimensions-fabric":"3875|星际次元 (Space Dimensions / Moon and Space Dimensions)|1348102","winged":"3877|~","mob-stages":"3879|生物阶段 (Mob Stages)|854619","nuclearcraft-mod":"388|核电工艺 (NuclearCraft)","refooled":"3880|~","fabric-seasons":"3882|~","dehydration":"3883|脱水 (Dehydration)","easy-villagers":"3884|村民物品化/简单村民 (Easy Villagers)|1097287","largebar":"3885|~","tis-3d":"3886|~","entity-nan-health-fix":"3887|假死修复 (Entity NaN Health Fix)","ferritecore-fabric":"3888|铁氧体磁芯 (FerriteCore)","thaumcraft-research-patcher":"3889|~","opencomputers":"389|开放式电脑 (Open Computers)|618383","masterful-machinery":"3890|~|1245140","minecraft-earth-mod":"3891|Derec的地球生物 (Derec's Earth Mobs)","scotts-essential":"3892|~|1151637","drawerfps":"3893|储物抽屉渲染配置 (DrawerFPS)","cursed-earth":"3895|~","sll":"3896|逆向交易 (sɹǝƃɐllᴉΛ)","lagmeter":"3897|延迟表 (LagMeter)","hexxit-gear-2":"3898|Hexxit装备2 (Hexxit Gear 2)","scootys-plants-vs-zombies":"3899|Scooty的植物大战僵尸重生 (Scootys Plants Vs. Zombies Regrown)","elemental-stones":"390|元素之石 (Elemental Stones)","custom-machinery":"3903|~","bonsai-tree-crops":"3904|~","rpgz":"3905|~","scavenge-timing-addon":"3909|~","cull-particles-fabric":"3910|粒子渲染机制优化 (Cull Particles)","majos-broom":"3911|魔女的扫帚 (Majo's broom)|1182237","seamless-loading-screen-forge":"3912|无缝加载界面 (Seamless Loading Screen)","curios-quark-oddities-backpack":"3913|夸克背包饰品 (Curios Quark Oddities Backpack)","nature-expansion":"3914|~","electromagnetic-coherence":"3917|~","amaleafs-expantion-world-mod":"3918|~","the-elemelon-mod":"3919|元素西瓜 (The Elemelon Mod)","waila-nbt":"392|万用高亮显示 (Waila NBT)","dcsp":"3920|钻石压缩 (Diamonds Compressor SP)","corpse-complex":"3921|~","modularvoicechat":"3922|模块化语音聊天 (ModularVoiceChat)","curious-elytra-fabric":"3923|鞘翅插槽 (Curious Elytra / Elytra Trinket)","incubation":"3927|~","thaumcraft-node-tracker":"393|神秘节点追踪 (Thaumcraft Node Tracker)","create-plus":"3931|~","coloured-tooltips":"3933|~","magicraft-magic":"3934|魔法材料 (Magical Materials)","glowstone-ores":"3935|荧石矿石 (Glowstone Ores)","more-wires":"3936|~","alexandrite-and-more":"3937|~","endgame-materials":"3938|终局材料 (Endgame Materials)","more-cobblestone":"3939|更多圆石 (More Cobblestone)","geochests":"394|箱载世界 (Geochests)","wild-netherwart":"3940|野生地狱疣 (Wild Netherwart)","the-periodic-table-mod":"3941|元素周期表 (The Periodic Table)","adamantium-in-minecraft":"3942|~","forgerocks":"3943|~","ballistix":"3944|弹道学 (Ballistix)","wireless-industry":"3945|~|1338617","spice-of-life-tonio-edition":"3946|生活调味料：托尼欧版 (Spice of Life: Tonio Editon)","husk-spawn-fabric":"3947|尸壳生成微调 (Husk Spawn)","artisan-tools-1-16":"3948|工匠工具 (Artisan Tools)","yttr":"3949|~","parachutemod":"395|降落伞 (Parachute)","wisla":"3950|~","mixin-0-7-0-8-compatibility":"3951|兼容Mixin0.7-0.8 (Mixin 0.7-0.8 Compatibility)","farplanetwo":"3952|远平面2 (Far Plane Two)","xenoclus-one":"3953|~","satako-library":"3954|~","unique-enchantments-utils":"3955|独特的附魔：效用扩展 (Unique Enchantments - Utils)","forge-ae2-additional-opportunity":"3956|~","iconexporter":"3957|~","curious-shulker-boxes-fabric":"3958|潜影盒插槽 (Curious Shulker Boxes/Trinket Shulker Boxes)","xenoclus-2":"3959|~","darker-depths":"3960|深岩之下 (Darker Depths)","terracraft-journey":"3961|~","solar-cooker":"3962|太阳灶 (Solar Cooker)","create-addon":"3964|~","boat-contraptions":"3965|~","ender-rift":"3966|~","splashanimation":"3968|~","continue-button":"3969|继续按钮 (Continue Button)","rftools":"397|RF工具箱 (RFTools)|416167","chem-craft":"3970|化学工艺 (Chem Craft)","time-in-a-bottle-standalone":"3971|时间之瓶 (Time in a bottle standalone)","compressed-grass":"3973|压缩草 (Compressed Grass)","applepie":"3974|苹果派 (ApplePie)","doles-mod":"3975|~","ex-nihilo-sequentia-thermal-addon":"3976|无中生有：传承 - 热力扩展 (Ex Nihilo: Sequentia - Thermal Addon)","ex-naturae":"3977|无中生有：传承 - 植物魔法扩展 (Ex Naturae)","ex-nihilo-sequentia-tinkers-addon":"3978|无中生有：传承 - 匠魂扩展 (Ex Nihilo: Sequentia - Tinkers Addon)","iron-jetpacks-fabric":"3979|~","custom-discs":"3980|自定义唱片 (Custom Discs)|1256463","playtime-counter-fabric":"3981|游戏时长计数器 (Playtime Counter)","entity-banners":"3982|实体旗帜 (Entity Banners)","curious-jetpacks":"3983|~","curious-armor-stands":"3984|~","trinkets-fabric":"3985|~","occultism":"3986|神秘学 (Occultism)|1077431","stray-spawn-fabric":"3987|流浪者生成微调 (Stray Spawn)","mooshroom-spawn-fabric":"3988|哞菇生成微调 (Mooshroom Spawn)","cardinal-components":"3989|~","grimoire-of-gaia":"399|盖亚魔典3 (Grimoire of Gaia 3)|679274","integrated-proxy":"3992|集成代理器 (Integrated Proxy)","a-cobblestone-crafting-table":"3993|圆石工作台 (A Cobblestone Crafting Table)","colored-iron":"3994|~","final-kobold":"3995|~","ears":"3996|耳朵 (Ears)","wildfires-female-gender-mod-fabric":"3997|~","modularwarfare":"3999|模块化战争/模块化武装 (ModularWarfare)","BuildCraft":"4|建筑 (BuildCraft)|884720","mputils-basic-tools":"4000|~","the-agartha-mod":"4001|~","falling-with-style":"4002|花式降落 (Falling With Style)","valhelsia-core":"4003|~","alwayseat":"4005|吃不停 (AlwaysEat)","aquarium":"4009|深海 (Aquarium)","mixin-booter":"4010|~","jrds-moneymod":"4012|~","skeletdimension":"4013|骷髅维度 (SkeletDimension)","sushigocrafting":"4014|巧制寿司 (Sushi Go Crafting)","shrines-structures":"4015|~","valhelsia-tweaks":"4016|~","lazierae2":"4017|懒人AE2 1.16+ (Lazier AE2)","magical-crops-core":"4018|~","magical-crops-decorative":"4019|~","academycraft":"402|超能力/学园都市 (AcademyCraft)|421967","magical-crops-armoury":"4020|~","simpleeco":"4022|简单经济 (SimpleEconomy)","vistas":"4023|~","fish-in-planks":"4025|~","fish-on-the-line-fabric":"4026|~","fish-traps":"4027|鱼栅 (Fish Traps)","combustive-fishing":"4028|~","fabric-survival-island":"4029|~","sonicraft":"4030|索尼克工艺 (SoniCraft)","islands":"4031|~","origins-forge":"4032|起源非官方Forge版 (Origins (Forge))","magic-feather":"4033|~","alet":"4034|~","netheriteplus":"4035|~","the-survivalists-mod":"4036|~","campfire-overhaul":"4037|~","shatter":"4038|~","electric-self-balance-scooters":"4039|电动平衡车 (Electric Self-balance Scooters)","the-spice-of-life":"404|生活调味料 (The Spice of Life)|722595","rats-mischief":"4040|~","dream-rng":"4041|~","wandering-trader-improvements":"4042|~","wasteland-reborn":"4044|不毛之地：重生 (Wastland Reborn)","skds-core":"4045|~","endertech":"4046|末影科技 (Ender Tech)","enderpig-mod":"4047|末影猪 (Enderpig Mod)","atomic-bomb-1-16":"4050|枪，炮，原子弹！ (Guns, Rockets and Atomic Explosions)","se-sign-shop":"4051|简单经济：牌子商店 (SE: Sign Shop)","fancymenu-fabric":"4053|~|1236106","halogen":"4054|卤素 (Halogen)","zetamod":"4055|泽塔 (ZetaForged/Zeta's Mod)","wholetreeaxe":"4058|~","fabrishot":"4059|高清截图Fabric (Fabrishot)","materialisation":"4060|物质化 (Materialisation)","recipebuffers":"4061|配方缓冲 (RecipeBuffers)","portal-gun-fabric":"4063|传送枪 Fabric (Portal Gun Fabric)","incendium":"4064|~","cooperative-advancements-fabric":"4066|合作进度 (Cooperative Advancements)","lightstones":"4067|~","openbackup":"4068|~","fat-experience-orbs":"4069|肥胖经验球 ([Fabric] Fat Experience Orbs)","automagy":"407|自动化魔法 (Automagy)","better-pipes":"4070|更好的管道 (Better Pipes)","truetype-font-replacement":"4071|~|616658","fluidlogged-api":"4072|~","spark":"4073|火花 (spark)","saoui":"4074|~","guardians-galore":"4075|~","cogwheel-tweaker":"4076|~","ultra-amplified-dimension-fabric":"4077|超大群系维度 (Ultra Amplified Dimension)","classical-art-fabric":"4078|经典艺术 (Classical Art)","emc-baubles":"4079|等价饰品 (EMC Baubles)","storage-drawers":"408|储物抽屉 (Storage Drawers)|798307","lag-removal":"4081|~","gender":"4082|~","ticktock":"4084|~","fps-reducre-for-fabric":"4086|FPS减速器（Fabric） (FPS Reducer (For Fabric))","art-artillery":"4087|艺术？火炮！ (Art? Artillery!)","minemenufabric":"4088|我的菜单Fabric版 (MineMenuFabric)","wintercraft-gruntpie224":"409|冬天的世界 (Wintercraft)","afkpeace":"4090|~","secret-rooms-fabric":"4092|~","smooth-chunks":"4093|~","saturationoverflow":"4094|饱和度溢出 (Saturation Over flow)|838721","phantom-blood":"4096|幻影之血 (Phantom Blood)","searchable-containers":"4098|可搜索容器 (Searchable Containers)","notenoughitems":"41|NEI物品管理器 (Not Enough Items)|389937","integrated-additions":"4101|集成扩展 (Integrated Additions)","matchlock-guns":"4102|火绳枪 (Matchlock Guns)","fabric-autoswitch":"4103|自动切换工具 (AutoSwitch)","inventory-profiles-next":"4104|一键背包整理Next (Inventory Profiles Next)","drill":"4105|钻头 (Drill)","ore-tree":"4106|矿物树 (Ore Tree)|1214379","ferdinands-flowers":"4107|~","clear-water":"4108|清澈的水 (Clear Water)","applied-energistics-2-wireless-terminals-forge":"4109|AE2无线终端Forge版 (Applied Energistics 2 Wireless Terminals Forge)","ferroustry":"4110|~","village-employment":"4111|村庄就业 (Village Employment)","deathlog":"4113|死亡日志 (Deathlog)","automatic-elytra":"4114|自动鞘翅 (Automatic Elytra)","axolotl-bucket-fix":"4115|美西螈桶修复 (Axolotl Bucket Fix)","xks-decoration":"4116|XK的装饰 (XK's Deco)|1214362","endgame-materials-addons":"4117|更多终局材料 (Endgame Materials Addons)","ravage-and-cabbage":"4118|~","stackup":"4119|~|1026496","shincollecraft":"412|深海舰队收藏 (ShinColle)|420381","simple-anti-x-ray":"4120|~","breakme":"4121|~","mod-info-command":"4122|~","hexxit-gear-fabric":"4123|~","buffed-tools":"4124|属性工具 (Buffed Tools)","thaumcraft-nei-plugin":"4125|神秘时代NEI插件 (Thaumcraft NEI Plugin)|357554","moarrecipes":"4126|更多的配方 (MoarRecipes)","luminium":"4127|~","iguanatweaks-reborn":"4130|蜥蜴微调重生 (IguanaTweaks Reborn)","enter-the-void":"4131|进入虚空 (Enter the void)","tensura-mod-that-time-i-got-reincarnated-as-a-slime":"4132|关于我转生变成史莱姆这档事 (Tensura Mod -That time I got reincarnated as a Slime)","speedometer":"4134|速度表 (Speedometer)","falling-leaves-forge":"4135|落叶 (Falling Leaves)","custom-entity-models-cem":"4138|自定义实体模型 (Custom Entity Models)","tweakmyclient":"4139|~","unicode-font-fixer":"414|Unicode字体修复 (UnicodeFontFixer)|398402","lovely-snails":"4140|可爱蜗牛 (Lovely Snails)","ourse-mod":"4141|~","clipboard":"4142|备忘录 (Clipboard)","crimson-nbt-tags":"4143|~","water-physics-overhaul":"4145|~","netherless":"4146|~","auto-ore-dictionary-converter":"4147|~","elytraboosters":"4148|~","cobblegenrandomizer":"4149|~","lanteacraft":"415|星际之门 (LanteaCraft)","unified-resources":"4150|~","wooden-buckets":"4151|木桶 (Wooden Buckets)","no-nether-portals":"4152|~","beehivetooltips":"4153|蜂巢工具提示 (BeehiveTooltips)","buddycards":"4154|巴迪卡牌 (Buddycards)","expanded-caves":"4155|~","inventorio-forge":"4157|~","more-curios-totems-of-undying":"4158|~","selene":"4159|~","matteroverdrive-legacy":"416|超能物质 (Matter Overdrive)|802474","compatibilitylayerforcustomskinloader":"4160|万用皮肤补丁兼容层 (CompatibilityLayerForCustomSkinLoader)|1109996","no-potion-shift":"4161|~","no-potion-offset":"4162|~","demonslayer":"4163|鬼灭之刃 (Kimetsu no Yaiba)|1220110","nautilium":"4164|鹦鹉螺 (Nautilium)","auto-attack":"4165|自动攻击 (Auto Attack)","tamagotti":"4166|~","signal":"4168|讯号 (Signal)","realistic-horse-genetics":"4169|真实马匹遗传 (Realistic Horse Genetics)","tainted-magic":"417|污秽魔法 (Tainted Magic)|807351","timeless-and-classic-guns":"4170|永恒枪械工坊 (Timeless and Classics)|1264237","tool-progression":"4171|工具进阶 (Tool Progression)","a-paimon":"4174|派蒙 (A Paimon)","music-maker-mod":"4176|~","penguin-lib":"4177|~","flywheel":"4178|飞轮 (Flywheel)","minetweaker3":"418|~|304800","coralreef":"4180|珊瑚礁 (CoralReef)","simply-seasons":"4182|简单季节 (Simply Seasons)","bclib":"4183|~","actually-baubles":"4184|实用拓展饰品 (Actually Baubles)","alexs-mobs-battle-music":"4185|~","lava-waders-bauble":"4186|熔岩魔靴饰品 (Lava Waders Bauble)","hardcore-revival":"4187|硬核复活 (Hardcore Revival)","additional-guns":"4188|更多的枪 (Additional Guns)","oh-my-minecraft-client":"4189|~","treecapitator":"419|砍树 (Tree Capitator)","wooden-armors-stone-armor":"4190|木制盔甲 (Wooden Armors Mod)","insanelib":"4192|~","daydreamer":"4193|~","phantomfaces":"4194|幻灵接口 (Phantomfaces)","improved-villagers":"4195|改进的村民 (Improved Villager Mod)","equipment-compare-fabric":"4196|~","PickupWidely":"4198|~","insta-house":"420|即时建造 (Insta House)","lilliputian":"4200|~","sampler":"4201|~","custom-splash-screen":"4202|自定义加载界面 (Custom Splash Screen)","masa-gadget":"4203|~","meet-your-fight":"4204|迎战 (Meet Your Fight)","hot-or-not-plus":"4205|~","macaws-furniture-tfc":"4206|~","tfc-florae":"4207|~","tfc-elementia":"4208|~","infinity-water-bucket":"4209|无限水桶 (Infinity Water Bucket)","multi-page-chest":"421|多页箱子 (Multi-Page Chest)|101511","tfc-caffeine-addon":"4210|~","tfc-cellars-add-on":"4211|~","boats-and-beeps":"4212|~","konkrete":"4213|~","xp-from-harvest":"4214|收获经验 (XP From Harvest)|930878","modern-beta":"4215|~","tfcflux":"4216|~","tfc-medicinal":"4217|~","water-flasks":"4218|~","markdownmanual":"4219|~","structure-world":"4220|~","macaws-lights-and-lamps":"4221|~","terrarian-slimes":"4222|~","create-gears":"4223|~","simple-big-backpack":"4224|~","croptopia-fabric":"4225|作物盛景 (Croptopia)|1192701","firmalife":"4226|~","supermartijn642s-core-lib":"4227|~","cherished-worlds-fabric":"4228|存档置顶 (Cherished Worlds)|1104346","ironfist":"4229|铁拳 (Ironfist)|399076","draconic-evolution":"423|龙之进化/龙之研究 (Draconic Evolution)|724610","simply-acceleration":"4231|简单加速 (Simply Acceleration)","creeper-habitats":"4232|~","husbandry":"4233|~","its-the-little-things":"4234|~","fruitful-fabric":"4235|硕果累累 (Fruitful)","environmental-energy":"4236|环境科技-发电机 (Environmental Energy)","nakranoths-herdcraft":"4237|群兽行为 (Nakranoth's Herdcraft)","lambdabettergrass":"4238|Lambda的更好的草方块 (LambdaBetterGrass)","galacticraft-add-on-more-planets":"424|更多行星 (More Planets)|453885","bright-ore":"4240|矿石高亮 (Bright Ore)|1201226","chinese-style-sword":"4241|中式剑 (Arsenal Core)","heroic-armory":"4243|英雄武器 (Heroic Armory)","colossal-battery":"4244|巨型电池 (ColossalBattery)","industrial-meat":"4245|~","biomancy":"4246|血肉重铸 (Biomancy)","extra-generators":"4247|额外发电机 (Extra Generators)","horticulture":"4248|园艺 (Horticulture)","mr-pineapples-food-mod":"4249|~","thermal-foundation":"425|热力基本 (Thermal Foundation)","legacyvault":"4252|~","shopaholic":"4253|~","ok-zoomer":"4255|~","untitled-duck-mod-fabric":"4256|无题鸭 (Untitled Duck)","v-tweaks":"4257|~","fairenchanting":"4258|公平附魔 (FairEnchanting)","bedspreads-fabric":"4259|~","piglib":"4260|~","nether-portal-spread-fabric":"4261|~","x-hp":"4262|~","mr-pineapples-toy-guns":"4264|~","feywild":"4266|~|1285921","The-final-sword":"4267|最终之剑重置版 (The final sword)|1201880","gog-skybox":"4269|~","lemon-lib":"4271|~","custom-entity-models-kaimyentity-reborn":"4272|自定义玩家和实体模型 / KAI我的实体：重生 (Custom Player & Entity Models/KAIMyEntity-Reborn)","miniutilities":"4273|迷你实用设备 (Mini Utilities)","stumble-upon-campsites":"4274|邂逅：营地 (Stumble Upon: Campsites)","nomad-books":"4275|游牧之书 (Nomad Books)","yungs-extras-fabric":"4276|~","stoneholm":"4277|地下村庄 (Stoneholm, Underground Villages)","inspecio":"4279|~","ding":"428|界面进入提醒 (Ding)","special-ai":"4280|特殊AI (Special AI)|457169","dream-waifu-mod":"4281|梦中情人 (Dream Waifu mod)","help-wanted":"4282|求助 (Help Wanted)","off-hand-combat":"4283|副手战斗 (Off Hand Combat)","reaping-mod-fabric":"4284|收割 (Reaping Mod)","gilding":"4285|镀金 (Gilding)","grims-transportables":"4286|格里姆的便捷交通工具 (Grim's Transportables)","reroll":"4287|刷新附魔 (Reroll)","tax-free-levels":"4288|免税附魔 (Tax Free Levels)","portable-dimensions":"4289|便携式传送门 (Portable Dimensions)","ender-utilities":"429|末影设备 (Ender Utilities)","stone-age-by-yanny":"4290|~","terra-world-generator":"4291|~","omnis":"4293|灾厄 (Omnis)","omnis-backpacks":"4294|~","superhotmc":"4295|~","bag-of-yurting":"4296|帐篷袋 (Bag of Yurting)|1194614","better-combat-rebirth":"4297|更好的战斗：重生 (Better Combat Rebirth)|813690","iron-and-gold-from-1-17":"4298|来自 1.17 的铁和金 (iron and gold from 1.17)","immersive-cooking":"4299|沉浸烹饪 (Immersive Cooking)","magical-crops":"430|魔法作物 (Magical Crops)|440898","structured-crafting":"4300|~","random-shulker-colours-fabric":"4301|随机潜影贝颜色 (Random Shulker Colours)","create-automated":"4302|~","random-sheep-colours-fabric":"4303|随机绵羊颜色 (Random Sheep Colours)","sleep-sooner-fabric":"4304|早点睡 (Sleep Sooner)","respawning-shulkers-fabric":"4305|潜影贝重生 (Respawning Shulkers)","respawn-delay-fabric":"4306|延迟重生 (Respawn Delay)","realistic-bees":"4307|真实的蜜蜂 (Realistic Bees)","recast-fabric":"4308|持续钓鱼 (Recast)","softer-hay-bales-fabric":"4309|柔软的干草块 (Softer Hay Bales)","headcrumbs":"431|更多头颅 (Headcrumbs)","portable-jukebox-fabric":"4310|便携式唱片机 (Portable Jukebox)","spiders-produce-webs-fabric":"4311|蜘蛛吐网 (Spiders Produce Webs)","gravestone-mod-graves":"4313|墓碑坟墓 (Gravestone mod Graves)","the-earth-mod":"4314|地球 (The Earth Mod)","lifts":"4315|电梯 (Lifts)","corail-recycler":"4316|Corail的回收站 (Corail Recycler)|1161400","move-minecarts":"4317|可移动的矿车 (Move Minecarts)","inventory-totem-fabric":"4318|更好的图腾 (Inventory Totem)","lava-picker-upper":"4319|熔岩收集器 (Lava Picker Upper)","ex-astris":"432|星辉生万物 (Ex Astris)","nethers-exoticism":"4320|~","everpotion":"4321|永恒药水 ⚗️ (EverPotion ⚗️)","quick-shulker":"4322|快捷潜影盒 (Quick Shulker)","respawnable-pets":"4323|宠物可重生 (Respawnable Pets)","schmucks":"4324|小阿呆 (Schmucks!)","automatic-doors-fabric":"4325|自动门 (Automatic Doors)","configurable-despawn-timer":"4326|~","chunkmap":"4327|区块加载小地图 (ChunkMap)|1225181","inventory-tabs":"4328|~","bottle-your-xp-fabric":"4329|装瓶你的经验 (Bottle Your Xp)","xelitez-frostcraft":"433|冰冻工艺 (FrostCraft)","gravestone-mod-extended":"4330|墓碑坟墓 - 拓展 (Gravestone mod - Extended)","better-enchanted-books":"4331|更好的附魔书 (Better Enchanted Books)","easy-steel-forge":"4332|~","fabric-waystones":"4333|Fabric版传送石碑 (Fabric Waystones)|1129480","dark-enchanting":"4336|暗黑附魔 (Dark Enchanting)","better-wandering-traders":"4338|更好的流浪商人 (Better Wandering Traders)","superflat-world-no-slimes-fabric":"4339|没有史莱姆的超平坦世界 (Superflat World No Slimes)","hardcore-ender-expansion":"434|极限末地生存 (Hardcore Ender Expansion)|456093","scorge":"4340|~","beaconoverhaul":"4342|信标改革 (Beacon Overhaul)","contact":"4343|往来 (Contact)|1233489","blockshifter-forge":"4344|~","vanilla-builders-extension":"4346|~","big-beacons":"4348|大信标 (Big Beacons)","wooden-hopper":"4349|~","more-fun-quicksand-mod":"435|更多流沙 (More Fun Quicksand Mod)|449666","ages-api":"4351|~","spiffy-hud-fabric":"4352|~","advanced-compass":"4353|高级指南针 (Advanced Compass)","salutem":"4354|~","the-sol":"4355|太阳系 (The Sol)","better-beds":"4356|更好的床 (Better Beds)","world-lives-mod":"4357|~","lib":"4358|~","fastcraft":"436|快速工艺 (FastCraft)|343542","just-some-chocolate":"4360|只是一些巧克力 (Just some Chocolate)","vacuum-horizon":"4362|~","unique-enchantments-battle":"4363|独特的附魔：战斗扩展 (Unique Enchantments - Battle)","balanced-enchanting":"4364|平衡附魔 (Balanced Enchanting)","pipe":"4365|管道 (Pipe)","simple-ambients":"4366|~","forgeautoshutdown-1-12-2":"437|~","modern-loading-screen":"4370|现代加载界面 (Modern Loading Screen)|1235709","transliterationlib":"4374|~","rpmtw-update-mod":"4376|RPMTW自動中文化模組 (RPMTW Update Mod)|1238681","farsight-spyglasses":"4377|~","not-enough-animations":"4378|更多动画 (Not Enough Animations)","better-beacon":"4379|更好的信标与潮涌核心 (Better Beacon / Conduit)","easy-emerald-tools":"4382|~","cold-sweat":"4383|冷汗 (Cold Sweat)","witchery-rewitched":"4384|巫术：重生 (Witchery: Rewitched)","majou-densetsu-3d":"4385|魔城传说3D (Majou Denetsu 3D)","icarus-wings":"4386|伊卡洛斯之翼 (Icarus Wings)|1240656","keyboard-wizard":"4387|按键精灵 (Keyboard Wizard)|695626","piscary":"4388|~","sao-ui":"439|刀剑神域UI (Sword Art Online UI)|473756","storage-cabinet":"4390|储藏柜 (Storage Cabinet)","first-person-model":"4391|更真实的第一人称模型 (First-person Model)","randore-forge":"4392|~","rising-uppercut-fabric":"4393|上勾拳 (Rising Uppercut)|1240641","jackie-chan-s-weapon":"4394|成龙的武器 (Jackie Chan`s weapon)|1237674","explorers-compass":"4395|探险者指南针 (Explorer's Compass)|1286168","gravestones":"4396|墓碑 (Gravestones)","crafting-dead-survival":"4397|行尸走肉：生存 (Crafting Dead: Survival)","redstone-control-2":"4398|红石控制2 (Redstone Control 2)","csenchants":"4399|~","extratic":"440|匠魂扩展 (Extra TiC)","mystical-customization":"4400|~","lucky-blocks-project-e":"4402|等价交换幸运方块 (Lucky Blocks:ProjectE)|1150908","fmprojecte-fmpe":"4403|等价交换重制-EMC上限扩展版 (FMProjectE)","ibe-editor":"4405|~","exotic-critters":"4406|~","archers-paradox":"4407|弓箭手悖论 (Archer's Paradox)","dynamic-trees-neapolitan":"4408|动态的树：那不勒斯风味附属 (Dynamic Trees - Neapolitan)","dimensional-pockets":"441|四次元口袋 (DimensionalPockets)","randomite-classic":"4410|~","wilds":"4412|~","roughly-searchable":"4413|~","cull-leaves":"4414|树叶渲染优化 (Cull Leaves)","dynamic-trees-atum-2":"4415|动态的树：阿图姆2附属 (Dynamic Trees - Atum 2)","randomtweaker":"4416|~","iron-chests-fabric":"4418|~","steamworld":"4419|~","falling-leaves-fabric":"4421|落叶 (Falling Leaves (Fabric))","craftable-creative-ability":"4422|可合成的创造能力强化 (Craftable Creative Ability)","not-enough-energistics":"4423|~","terracore":"4424|~","seeker-compass":"4426|~","ghosts-explosives":"4427|~","power-drop":"4428|蓄力投掷 (Power Drop)","yungs-better-dungeons-fabric":"4429|YUNG的地牢优化 (YUNG's Better Dungeons)","security-craft":"443|安全工艺 (Security Craft)|774616","ore-controller":"4431|~","morechickens":"4432|更多鸡 (MoreChickens)","ghosts-explosives-2":"4433|~","weaponthrowlite":"4434|武器投掷 (Weapon Throw)","more-villagers-fabric":"4435|更多村民 (More Villagers)","dungeons-mobs":"4436|地下城生物 (Dungeons Mobs)","buildcraft-additions":"444|建筑扩充 (Buildcraft Additions)","uusi-aurinko":"4445|新日 (Uusi Aurinko)|1236639","bedrockium-mod":"445|基岩工艺 (Bedrockium Mod)","chronicler-the-key-of-stellaris":"4456|历史记录者·星之匙 (Chronicler: The Key of Stellaris)|1244435","neubulaeko-slime":"4458|星云子史莱姆 (Neubulaeko Slime)","blocksteps":"446|~","fantasysoup":"4463|~","just-enough-professions-jep":"4464|JEI工作方块 (Just Enough Professions)","plumed-belt":"4467|~","better-with-minecolonies":"4468|~","calemis-utilities":"4469|Calemi的实用设备 (Calemi's Utilities)","thaumic-horizons":"447|神秘视界 (Thaumic Horizons)","botanical-cowardice":"4470|~","travelers-titles-fabric":"4471|~","expand-chinese-sword":"4472|中式剑拓展 (Arsenal Integration)","littleframes":"4474|小画 (LittleFrames)","lavalogged-blocks":"4475|岩浆充填 (Lavalogged blocks)","awoken-world":"4476|~","gt4-reimagined":"4477|格雷科技4：重构想 (GregTech 4 Reimagined)","camouflaged-creepers":"4478|~","ore-tweaker":"4479|~","modtweaker":"448|~","openpython":"4480|~","jei-lotr":"4481|~","capes":"4482|~","attack-speed-enchantment":"4483|攻击速度附魔 (Attack Speed Enchantment)","natures-minerals":"4484|~","balm":"4485|~","resource-hogs":"4486|资源猪 (Resourse Hogs)|1037377","advanced-xray-fabric-edition":"4487|高级透视 (Advanced XRay)","ring-of-attraction-fabric":"4489|吸引戒指 (Ring of Attraction)","lootbags":"449|战利品 (Loot Bags)|720841","customhud":"4490|自定义HUD (CustomHud)","deadly-world":"4491|致命世界 (Deadly World)|457226","fastdecay":"4492|~","essential-commands":"4493|~","caves-and-cliffs-backport":"4494|~","that-future-mod-glow-squid-axolotl-moobloom-etc":"4495|~","diamond-buildcraft":"4496|钻石装饰 (Diamond Buildcraft)","apocalypse-rebooted":"4497|启示录重制 (Apocalypse Rebooted)|1254381","mcwifipnp":"4498|更高级联机设置 (LAN World Plug-n-Play)|1244608","requious-frakto":"4499|~","custom-npcs":"45|自定义NPC (Custom Npcs)|936521","compact-lava-generator":"450|高级地热发电机 (Compact Lava Generator)|522808","capsule":"4503|~","isometric-renders":"4504|~","enchanting-secretaire":"4506|附魔记录 (Enchanting Secretaire)|1250073","sync-fabric":"4507|克隆（Fabric） (Sync (Fabric))","tale-of-kingdoms-a-new-conquest":"4508|王国：新征程 (Tale of Kingdoms: A new Conquest)","project-zulu":"451|祖鲁 (Project Zulu)","schwarz":"4510|黑 (Schwarz)","megane":"4511|~","crusade":"4512|~","vending-machine":"4513|售货机 (Vending Machine)","modernxl":"4514|~","taiga2":"4515|匠魂合金附加2 (Tinkers Alloying Addon Port)","chunkgenlimited":"4516|区块生成限制 (ChunkGenLimiter)|1041769","more-crafting-tables-for-forge":"4517|~","repurposed-structures":"4518|结构变体 (Repurposed Structures)","ezpas":"4519|~","electrona":"4520|~|1314239","reasonable-sorting":"4522|合理排序 (Reasonable Sorting)","chat-heads":"4523|聊天头像 (Chat Heads)","hidden-armor":"4524|隐藏盔甲 (Hidden Armor)","majruszs-progressive-difficulty":"4525|Majrusz的进阶难度 (Majrusz's Progressive Difficulty)","pharmacist":"4526|药师 (Pharmacist)","kappa":"4527|~","equivalent-integrations":"4528|等价集成 (Equivalent Integrations)","keep-equipment":"4529|保留装备 (Keep Equipment)","chinacraft":"453|华夏文明 (ChinaCraft)|518660","herobrines-origin":"4530|Herobrine的起源 (Herobrine's Origin)","the-abyss":"4531|深渊：远古 (The Abyss: Legacy)","sekiro-sense-symbols":"4532|~","lurker":"4533|Cold的潜伏者 (Colds: Lurker)","cavebiomeapi-fabric":"4534|~","extended-block-shapes":"4535|扩展方块形状 (Extended Block Shapes)","passive-mobs":"4536|~","sponsor":"4537|赞助者 (Sponsor)|1080837","between-ores":"4540|~","black-hole":"4541|黑洞 (Black Hole)|1179600","more-and-more-minerals":"4542|越来越多的矿物 (more and more minerals)","permafrost":"4543|~","scootys-plants-vs-zombies-2":"4545|Scooty的植物大战僵尸2 (Scooty's Plant Vs. Zombies 2)","better-furnaces-reforged":"4546|更好的熔炉重铸版 (BetterFurnaces Reforged)","schools-of-magic-second-semester":"4549|魔法学校：第二学期 (Schools of Magic: Second Semester)","dark-loading-screen":"4550|~","hals-exploration-mod":"4551|~","farmers-delight-cookbook-addon":"4552|农夫乐事：烹饪书拓展 (Farmer's Delight Cookbook Addon)","heads-down-display":"4553|~","mrcrayfish-more-furniture-mod":"4554|MrCrayfish 的更多家具 (MrCrayfish's More Furniture Mod)","multi-world":"4555|~","terralith":"4557|~","overworld-two-forge":"4558|~","xl-packets-fabric":"4559|XL数据包 (XL Packets)","betterbeginnings-mod":"456|更好的开局 (Better Beginnings)","rftools-storage":"4560|RF工具：存储 (RFTools Storage)","rftools-builder":"4561|RF工具：建造机 (RFTools Builder)","nethers-delight":"4563|下界乐事 (Nether's Delight)","farmers-extra-foods":"4564|农夫的拓展食物 (Farmer's Extra Foods)","tinkers-delight":"4565|工匠乐事 (Tinker's Delight)","majruszs-accessories":"4568|Majrusz的配件 (Majrusz's Accessories)","water-2-mana":"4569|~","utility-mobs":"457|工具怪物 (Utility Mobs)","craft-and-hunt":"4572|狩猎工艺 (Craft and Hunt)","tmats":"4573|~","the-afterlight":"4574|隐光之域 (The Afterlight)","tinkers-planner":"4575|匠魂蓝图 (Tinker's Planner)","playing-cards":"4576|~","rainbow-oak-trees-2":"4577|彩虹橡树2 (Rainbow Oak Trees 2)","mapfrontiers":"4578|地图边界 (MapFrontiers)","customizable-elytra-fabric":"4579|可自定义鞘翅 (Customizable Elytra)","hunger-overhaul":"458|饥饿改革 (Hunger Overhaul)|785119","puzzles-lib-fabric":"4580|~","unique-enchantments-base":"4581|独特的附魔：基础 (Unique Enchantments Base)","ore-stages":"4582|矿石阶段 (Ore Stages)","krays-magic-candles":"4583|~","thaumcraft-localization-optimizer":"4584|神秘时代本地化优化 (Thaumcraft Localization Optimizer)","drink-beer-forge":"4585|喝啤酒啦 (Drink Beer)","emerald-tools-armour":"4586|~","hidden-recipe-book":"4587|隐藏配方书 (Hidden Recipe Book)","kibe":"4588|羊肉面饼实用设备 (Kibe Utilities)","poisoncraft":"4589|毒药工艺 (Poison craft)","jei":"459|JEI物品管理器 (Just Enough Items)|1175372","detail-armor-bar-forge":"4590|细节盔甲 (Detail Armor Bar)","wings-horns-hooves-the-ultimate-unicorn-mod":"4591|~","project-rankine":"4592|兰金计划 (Project Rankine)","tinkers-mechworks":"4593|~","qdc-quantum-dis-assembly-craft":"4594|量子拆解工艺 (Quantum Dis-Assembly Craft)","william-wythers-overhauled-overworld":"4595|~","infinite-music":"4596|~","cobbler":"4597|可靠的潜影贝工厂 (Shulker's Faithful Factories/Cobbler)","nether-fast-transport-layer":"4598|~","the-outer-end":"4599|~","millenaire":"46|千年村庄 (Millénaire)|93223","jeiaddons":"460|~","hamncheese":"4600|~","buzzy-drones":"4601|~","morevanillaarmor":"4602|~","eternal-tales":"4604|~","oh-the-biomes-youll-go-fixes":"4605|“你将去的生物群系”修复模组 (Oh The Biomes You'll Go Fixes)","wild-world":"4606|~","miskatonic-mysteries-legacy":"4608|~","harvesters-night":"4609|收割者之夜 (Harvester's Night)","magneticraft":"461|磁场工艺 (MagnetiCraft)","slotlock":"4610|锁定槽 (SlotLock)","panorama-tweaker":"4612|~","simple-tomb":"4613|简单坟墓 (Simple Tomb)","modern-life":"4614|摩登生活 (Modern Life)","paxi":"4615|~","waveycapes":"4617|飘扬披风 (Wavey Capes)","skin-layers-3d":"4618|3D皮肤层 (Skin Layers 3D)|1333790","all-the-discs":"4619|唱片大全 (All the Discs)","chromaticraft":"462|缤纷纪元 (ChromatiCraft)","cryptic-cosmos":"4620|~","bayou-blues-fabric":"4621|长沼蓝调 (Bayou Blues)","hex-lands":"4622|六边形地貌 (Hex Lands)","fixrtm":"4623|~","serene-tweaks":"4624|~","ScalingGuis":"4625|界面缩放 (ScalingGUIs)","ide-better-command-block-fabric-editor":"4626|更好的命令方块 (Better Command Block IDE)","tinkers-mechworks-fork":"4628|~","extended-nether-backport":"4629|~","immersive-engineering":"463|沉浸工程 (Immersive Engineering)|450097","borderless":"4630|无边框全屏 (Borderless Window)","lifted-restrictions-structure-block":"4631|更好的结构方块 (Better Structure Block)","entity-model-json":"4632|实体模型JSON (Entity Model JSON)","death-coords":"4633|死亡坐标显示 (Death Coords)","never-enough-currency":"4635|货币多多 (Never Enough Currency)","never-enough-currency-lite":"4636|货币多多：精简版 (Never Enough Currency Lite)","create-chunkloading":"4637|~","name-pain":"4638|~","wireless-chargers":"4639|无线充电器 (Wireless Chargers)","armourers-workshop":"464|时装工坊 (Armourer's Workshop)|382319","bouncier-beds-fabric":"4640|弹力床 (Bouncier Beds)","hexlands-ii":"4641|六边形地貌 2 (HexLands II)","gold-in-river-mod":"4642|河中淘金 (Gold In River Mod)","lorespawn":"4644|怪物巢穴 (Lorespawn)","creatuures":"4645|~","fabrics-biome-api-reforged":"4646|~","stalwart-dungeons":"4647|坚固地牢 (Stalwart Dungeons)","maidens-marvelous-materials":"4648|~","nekoration":"4649|猫咪装饰 (Nekoration)","tomb-many-graves-2":"4650|~","fins-and-tails":"4651|鳍和尾巴 (Fins and Tails)","smarter-farmers-farmers-replant":"4652|更聪明的农夫 (Smarter Farmers/Farmers Replant)|1285789","peculiars":"4653|独特风味 (Peculiars)","draggable-resource-packs":"4654|可拖动资源包 (Draggable Resource Packs)","fastchest":"4655|快速箱子渲染 (FastChest)","yuushya-townscape-fabric":"4656|方块小镇 (Yuushya Townscape)|1255783","architects-palette":"4657|建筑师的调色板 (Architect's Palette)","whisperwoods":"4658|低语之森 (Whisperwoods)","dimensional-dungeons":"4659|~","slash":"466|命令强化 (Slash)","bosses-of-mass-destruction":"4660|~","neoelfeos-medieval-pub-decoration":"4661|~","dustrial-decor":"4662|~","feders-scarecrows":"4663|Feder的稻草人 (Feder's Scarecrows)","zetter":"4664|~","mystical-pumpkins":"4665|神秘南瓜 (Mystical Pumpkins)","skinned-lanterns-fabric":"4666|灯笼皮肤 (Skinned Lanterns)","scarecrows":"4667|稻草人 (Scarecrows)","seasonals":"4668|季节风味 (Seasonals)","mimi-mod":"4669|~","et-futurum":"467|把未来带回现实 (Et Futurum)|459404","blocktuner":"4670|音符盒调音助手 (BlockTuner)|1253993","caged-mobs":"4671|~","advanced-rifles":"4672|~","tome-of-blood":"4673|血之宝典 (Tome of Blood)","blockfront-world-war-ii":"4674|方块前线 (BlockFront)","archaic-guns":"4675|~","blockcarpentry":"4676|~","survival-overhaul":"4677|~","raining-cats-and-dogs":"4678|猫狗雨 (Raining Cats and Dogs)","melt":"4679|~","cooking-for-blockheads":"468|懒人厨房 (Cooking for Blockheads)|545680","stuff-a-sock-in-it":"4681|日志过滤器 (Stuff A Sock In It)","supermartijn642s-config-lib":"4682|~","small-ships":"4683|~","sound-engine-reloader":"4684|重新加载声音 (Sound Engine Reloader)","crystal-caves":"4685|~","increasemobs":"4686|~","scarecrows-territory":"4687|稻草人领域 (Scarecrow's Territory)","dungeons-mod-lite":"4689|~","loot-beams":"4690|战利品光束 (Loot Beams)|1245184","theurgy":"4691|~","better-badlands":"4692|恶地改善 (Better Badlands)","the-mysthical-reworked":"4694|~","villagers-and-monsters-mod-legency":"4695|~","repair-chests":"4696|修损宝盒 (Repair Chests)","relics-of-gaming":"4698|游戏遗物 (Relics Of Gaming)","modular-controller":"4699|模块化控制器 (Modular Controller)","clay-soldiers-mod":"47|粘土士兵 (Clay Soldiers Mod)","psi":"470|~","Item-Collectors":"4701|~","gamemodeoverhaul":"4702|旧版指令 (GamemodeOverhaul)|897542","dash":"4704|~","minecraft-dungeons-content":"4705|地下城内容 (Dungeons Content)","old-beacon":"4706|旧信标 (Old Beacon)","oc2":"4707|开放式电脑 II (OpenComputers II)","botany-pots-tiers":"4708|~","compatchedstorage":"4709|紧凑存储修复 (ComPatchedStorage)","good-nights-sleep":"471|夜眠梦境/晚安的梦境 (Good Night's Sleep)|965322","iseedragons":"4710|~","psionic-peripherals":"4711|~","malum":"4712|灵灾 (Malum)","allomancy":"4713|镕金术 (Allomancy)","steamcraft2":"4714|~","boilerplate":"4715|~","meldexuns-crystalic-void":"4716|~","recipes-and-more":"4717|~","llama-steeds":"4718|骑羊驼 (Llama Steeds)","levellib":"4719|~","enigmatic-graves":"4720|~","boat-item-view":"4721|边划边看 (Boat Item View)","forge-creeper-heal-unofficial":"4722|Forge苦力怕坑修复[非官方版] (Forge Creeper Heal [Unofficial])","desolation":"4723|荒芜 (Desolation)","ma-astral":"4724|~","zaraklib":"4725|~","chipped":"4726|~","mending-for-1-7-10":"4728|给老版本的经验修补 (Mending for Older Version)","unreachable-fantasy-mod":"4729|~","baubles":"473|饰品栏 (Baubles)","ai-reducer":"4730|AI减速器 (AI Reducer)","simple-teleporters-fabric":"4731|简易传送器 (Simple Teleporters)|1099992","killmods":"4732|~","big-brain":"4733|~","adaptive-performance-tweaks":"4734|适应性性能调整 (Adaptive Performance Tweaks)","rltweaker":"4735|~","multibags":"4736|多重背包 (MultiBags)|897303","lavalib":"4737|~","ftb-banners-forge":"4738|~","overpowered-armor-bar":"4739|~","more-swords-mod":"474|更多剑 (MoreSwords)","tinkers-rapier":"4740|匠魂西洋剑 (Tinkers' Rapier)|1261187","earth-reworked":"4741|土方工程重制版 (Earth Reworked)","cinderscapes-reforged":"4742|余烬奇景Forge版 (Cinderscapes Reforged)","better-diving":"4743|~","auto-sprint":"4744|自动冲刺：一键切换 (Auto Sprint : key toggle)","nebula-rpg":"4745|~","betternether-reforged":"4746|更好的下界Forge版 (BetterNether Reforged)","item-stitching-fix":"4747|物品模型修复移植版 (Item Stitching Fix)","blood-and-madness":"4748|~","afraid-of-the-dark":"4749|~","thaumic-bases-unofficial":"475|神秘基础学 (Thaumic Bases)","ores-above-diamonds":"4750|~","crafting-automat":"4751|~","ingotter":"4752|~","presence-footsteps":"4753|脚步声 (Presence Footsteps)","walk-the-air":"4754|~","castle-dungeons":"4755|~","mobs-properties-randomness":"4756|~","iguana-tweaks":"4757|~","enhanced-ai":"4758|~","vulcanite":"4759|软碲铜 (vulcanite)","essentialcraft-3":"476|源质魔法3 (EssentialCraft 3)","ziheasymodding":"4760|~","path-to-dirt":"4761|~","dirt2path":"4762|~","carbonado":"4763|~","strange":"4764|~","tfctweaker":"4765|~","scaling-feast":"4766|~","delete-item":"4767|~","stexcraft-1-12-2-mod":"4768|~","longerdays":"4769|~","mob-heads":"4770|~","compass-coords":"4771|~","neverdark":"4772|~","stats-keeper-fabric":"4773|~","vanillatweaks":"4774|~","bacodifficulty":"4775|~","immersiveposts":"4776|沉浸长杆 (Immersive Posts)","fyres-youwilldiemod":"4777|必死无疑 (The You Will Die Mod)|309230","old-walking-animation":"4778|旧版行走动画 (Old Walking Animation)","enders-magic":"4779|末影魔法 (Ender's magic)","hardcore-questing-mode":"478|困难任务 (Hardcore Questing Mode)|1101667","anvil-patch-lawful":"4780|~","elegant-networking":"4781|~","gemsplusplus":"4782|宝石＋+ (GemsPlusPlus)","defaultsettings-fabric":"4783|默认设置 (DefaultSettings)","draylars-battle-towers":"4784|Draylar的战斗高塔 (Draylar's Battle Towers)|898001","leos-craftable-chainmail":"4786|可制作的锁链甲 (Leo's Craftable Chainmail)","time-to-die":"4787|~","better-survival-mod":"4788|更好的生存 (Better Survival mod)","unidict":"479|矿辞统一 (UniDict)|600649","tschipplib":"4790|~","the-deep-dark-ocean-dimension":"4791|~","online-picture-frame":"4792|在线相框显示2 (Modern Online Picture Frame)","pyromancer":"4793|~","mekanism-fission-recipe":"4794|~","macaws-fences-and-walls":"4795|~","lunae-silva":"4797|~","rainbow6":"4799|我的六号 (Rainbow6:Minesiege)|1117023","mo-creatures":"48|更多生物 (Mo' Creatures)|121946","thermal-dynamics":"480|热动力学 (Thermal Dynamics)","friendlyendermite":"4800|友好的末影螨 (FriendlyEndermite)","food-expansion":"4801|食物扩展 (Food Expansion)","forgotten-items":"4802|被遗忘的物品 (Forgotten Items)","food-expansion-reimagined":"4803|食物扩展：重构想 (Food Expansion: Reimagined)","redstone-igniter":"4804|~","enchanting-tweaks":"4805|~","thrown-slime":"4806|~|780689","inventory-auto-fill":"4808|~","queen-bee":"4809|蜂后 (Queen Bee)","zoology":"481|动物学 (Zoology)","better-barrels":"4810|~","enderbeetles":"4811|~","customport":"4812|~|897492","more-sound-config":"4813|~","undead-expansion":"4814|~","hourglass":"4815|沙漏 (Hourglass)","relics-mod":"4816|遗物 (Relics)","comfortable-nether":"4817|舒适下界 (Comfortable Nether)","arcanecraft-ii":"4818|奥法工艺2 (ArcaneCraft II)","presence-footsteps-forge":"4819|脚步声Forge版 (Presence Footsteps (Forge))","aardvarks-weird-wonderful-wild":"4820|~","ee3-helper":"4824|~","save-your-pets":"4825|拯救你的宠物 (Save Your Pets)","main-menu-scale":"4826|~","potion-fingers":"4827|~","reload-audio-driver-fabric":"4828|音频驱动重载 (Reload Audio Driver)","shieldbreak":"4829|~","thaumic-revelations":"483|神秘启示录 (Thaumic Revelations)","holiday-helper":"4830|~","fabric-tickratechanger-mod":"4831|Fabric版运算变速 (Fabric TickRateChanger)","observable":"4832|可视性能侦测 (Observable)","disenchantment-edit-table":"4833|祛魔编辑台 (Disenchantment Edit Table)","cit-resewn":"4835|~","lazy-language-loader":"4836|~","clef":"4837|~","zettai-magic-2":"4838|~","wotw-mod":"4840|世界之战 (The War of the Worlds Mod)","craftable-netherrack":"4841|可合成的下界岩 (Craftable netherrack)","simple-camp-fire":"4844|简单营火 (Simple Camp Fire)","biome-locator":"4845|生物群系定位器 (Biome Locator)","extra-coals":"4846|~","dark-caverns":"4847|暗黑深穴 (Dark Caverns)","warp-book":"485|传送书 (Warp Book)","ender-ring":"4850|末影环 (Ender Ring)|1264325","milk-all-the-mobs-fabric":"4851|~","roadrunner":"4852|~","pokecube-aoi":"4853|~","grim-statues":"4854|Grim雕像 (Grim Statues)","oauth-fabric":"4855|~","omaypaty-japan-mod":"4856|~","demon-slayer-mod-kimetu-no-yaiba":"4857|鬼灭之刃 (DEMON SLAYER MOD)|1086930","tipthescales":"4858|~","xplosives-mod":"4859|~","ex-compressum":"486|压缩工具 (Ex Compressum)|676165","arkys-environment":"4860|~","candylands":"4861|~|1283253","elements-of-power":"4862|~","aquafina":"4863|~","way-through-dimension":"4864|~","journeymap-integration":"4865|~","damage-tint":"4867|伤害色调 (Damage Tint)","mo-spells":"4868|~","simply-jetpacks":"487|简易喷气背包 (Simply Jetpacks)","blade-works":"4870|剑制 (Blade Works)","create-confectionery":"4871|机械动力甜食 (Create Confectionery)","rotten-piglins-mod":"4875|~","ex-nihilo-random":"4876|无中生有：随想 (Ex Nihilo: Random)","fabrictailor":"4879|离线皮肤切换 (Fabric Tailor)","blood-arsenal":"488|血液兵工厂 (Blood Arsenal)|958995","ambientworld":"4880|~","apple-trees-revived":"4882|苹果树：复生 (Apple Trees Revived)","potatos-lucky-block":"4883|马铃薯幸运方块 (Potato's Lucky block)","even-more-tnt":"4884|~","fun-tnt":"4885|有趣的TNT (Fun TNT)","chilean-craft-bedrock-edition":"4887|智利工艺 (Chilean Craft)","canals":"4888|水渠 (Canals)","sim-u-kraft":"489|模拟城市 (Sim-U-Kraft)","underground-loot-crates":"4890|地下战利品箱 (Underground Loot Crates)","smooth-scrolling-everywhere-fabric":"4892|平滑滚动 (Smooth Scrolling Everywhere)","sword-blocking":"4893|持剑格挡 (Sword Blocking)","better-mount-hud":"4894|更好的骑乘HUD (Better Mount Hud)","fire-overlay-controller":"4895|火焰叠加层调整 (Fire Overlay Controller)","particle-rain":"4897|粒子雨 (Particle Rain)","sodium-reforged":"4898|镁 (Magnesium/Sodium Reforged)","phosphor-reforged":"4899|硫 (Sulfuric/Phosphor Reforged)","superheroes-unlimited":"490|超级英雄无限 (Superheroes Unlimited)|693397","hydrogen-reforged":"4900|氦 (HeIium)","xl-food-mod-plus":"4901|超多食物+ (XL Food Mod+)","botconnect":"4903|群服互联🔗 (Bot Connect🔗)|1267022","ice-and-fire-dragonseeker":"4904|~","reeses-sodium-options":"4905|Reese的钠视频界面 (Reese's Sodium Options)","continuity":"4906|~","airportmod":"4907|~","better-gui-scaling":"4908|更好的界面缩放 (Better GUI Scaling)","titles":"4909|~","skiing":"4910|~","cave-biomes":"4911|~","tatami":"4912|~","final-fantasy-12-mod":"4913|~","mojangster":"4914|加载界面动画 (Mojangster (Animated Loading Screen))","anvil-tweaks":"4915|~","asphaltmod":"4916|沥青 (Asphalt Mod)|1012064","reroll-forge":"4918|刷新附魔Forge版 (Reroll-Forge)","swordenlarger":"4919|剑模型扩大 (SwordEnlarger)","castle-in-the-sky-the-fairytale-of-laputa":"4920|天空之城 (Castle in the Sky)","dimore":"4921|维度矿石 (DimensionalOres)","illagers":"4922|更多的灾厄村民 (Illagers+)","villagers-follow-emeralds-fabric":"4926|~","diabloloot":"4928|暗黑破坏神战利品 (DiabloLoot)","yggdrasil":"4929|世界树 (Yggdrasil)","ftb-dripper-forge":"4930|~","fabric-snad":"4931|子沙1.14+ (Snad)","opentoall":"4933|~","torchbowmod":"4936|火把弓 (TorchBowMod)|786206","esencia":"4937|~","weirdmobs":"4938|~","enchantment-level-language-patch":"4939|附魔等级语言补丁 (EnchLevel-LangPatch)|1266496","witching-gadgets":"494|巫师宝具 (Witching Gadgets)","open-to-lan":"4940|~","simple-translation":"4941|简单翻译 (Simple Translation)","fx-control":"4942|效果控制 (Fx control)","what-are-you-voting-for":"4943|~","steam-powered-create":"4944|蒸汽动力 (Create: Steam Powered)|1272372","creepers-burn":"4945|~","pretty-game-enhhancing-gobblet-pgeg-remake":"4947|魔法森林重置版 (Pretty, Game-Enhhancing Gobblet Remake)|1237458","kvc-equipment":"4949|蛋挞君的原版补全装备篇 (KVCEquipment)|1224426","mooshroomcraft":"4950|哞菇工艺 (Mooshroomcraft)|990356","unearthed-fabric":"4951|出土 (Unearthed)","terrestria-reforged":"4952|~","simplex-terrain-generation":"4953|Simplex地形生成器 (Simplex Terrain Generation)","enderscape":"4954|~","goblin-traders-fabric":"4955|哥布林商人Fabric版 (Goblin Traders (Fabric))","lakeside":"4956|湖畔 (Lakeside)","chenziqius-originality":"4957|CHENZIQIU的创意 (CHENZIQIU's Originality)","alloy-forgery":"4958|~","mechanical-tech":"4959|机械科技 (Mechanical Tech)|1347516","buildcraft-compat":"496|建筑兼容 (Buildcraft Compat)","hadesgame":"4960|阴间游戏 (HadesGame)|1211612","one-block-forge":"4961|~","human-reborn":"4963|~","additional-additions-forge":"4964|额外扩展 (Additional Additions)","earlygame":"4965|~","happiness-is-a-warm-gun":"4966|~","kvc-blocks":"4968|蛋挞君的原版补全方块篇 (KVCBlocks)|1239534","enigtech2-util":"4969|蝙蝠快乐：ET2专版 (EnigTech2 Util)","extrabotany":"497|额外植物学 (ExtraBotany)|596279","environmental-creepers":"4970|环保型苦力怕 (Environmental Creepers)","look-at-that":"4972|~","advanced-peripherals":"4973|~","nether-chest-fabric":"4974|~","levelz":"4976|~","betterend-re-forked":"4977|更好的末地Forge重铸版 (BetterEnd Reforged)","mining-gadgets":"4978|采矿小工具 (Mining Gadgets)","ponderjs":"4979|~","botania-unofficial":"498|植物魔法非官方版 (Botania Unoffical)","majrusz-library":"4980|~","ydms-coppergolem":"4981|YDM的铜傀儡 (YDM's CopperGolem)","chococraft-3":"4982|~","chococraft-plus":"4983|~","travel-huts":"4984|~","expandability":"4985|~","squirrels":"4986|松鼠 (Squirrels)","ftb-power-pots":"4987|~","the-graveyard-fabric":"4988|墓园 (The Graveyard)","nether-agriculture":"4989|下界农业 (Nether Agriculture)","angry-pixel-the-betweenlands-mod":"499|交错次元/黑暗沼泽 (The Betweenlands)|804242","conjuring":"4990|~","awesome-dungeon-datapack":"4991|~","out-of-sight":"4992|~","decorative-blocks-modded-compat":"4993|装饰方块模组兼容 (Decorative Blocks modded compat)","camp-chair":"4994|~","size-matters":"4995|~","chalk":"4996|~","chalk-fabric":"4997|~","yarcf":"4999|合成冲突消除 (Yet Another Recipe Conflict Fixer)","forestry":"5|林业 (Forestry)|708812","extrabiomesxl":"50|更多生态群系 (ExtraBiomesXL)","real-first-person-render":"500|真实的第一人称 (Real First-Person Render)|773042","drones":"5000|~","ticbc":"5001|~","meetle":"5003|~","tarot":"5004|塔罗 (Tarot)","forcecraft":"5005|力量工艺 (ForceCraft)","right-click-harvest":"5006|右击收割 (Right-Click-Harvest)","custom-content-packs":"5007|~","cake-chomps":"5008|~","lod-level-of-detail":"5009|~","betterp2p":"5010|更好的P2P支持 (Better P2P)|1270402","ob-aquamirae":"5011|~","nuclear-tfc":"5012|~","just-more-cakes":"5013|只是更多的蛋糕！ (Just More Cakes!)","image-mod":"5014|~","reinforced-barrels":"5015|增强木桶 (Reinforced Barrels)","spyglass-zoom":"5016|望远镜变焦 (Spyglass Zoom)","npc-variety-port":"5017|NPC变体 (NPC Variety)","just-enough-effects":"5018|~","incorporeal-2-rhododendrite":"5019|幻想多媒体2 (Incorporeal 2 + Rhododendrite)","einsteins-library":"5021|~","worldshape":"5022|~","rslargepatterns":"5023|精致存储大样板 (Refined Storage Large Patterns)","gendustry-jei-addon":"5024|~","statement":"5025|~","mutant-more":"5026|更多突变生物 (Mutant More)","just-enough-keg":"5028|~","paleolithic-revolution":"5029|~","custom-stuff-3":"503|自定义物品3 (Custom Stuff 3)","better-shields":"5030|更好的盾牌 (Better Shields)","yungs-bridges-fabric":"5031|YUNG的桥 (YUNG's Bridges)","project-red-transmission":"5032|红石计划：传导 (ProjectRed - Transmission)","day-dream":"5033|~","savage-ender-dragon":"5034|~","age-of-weapons":"5036|武器时代 (Age of Weapons)|789398","drawerstorage-keychain":"5037|抽屉钥匙扣 (DrawerStorage Keychain)","fracdustry":"5038|分形工业 (Fractal Industry)","magical-forest":"5039|魔法森林 (Magical Forest)","lockdown":"504|地图生成锁定 (Lockdown)","skin-swapper":"5040|皮肤更换器 (Skin Swapper)","owo-lib":"5043|~","picturesign":"5044|~","divine-missions":"5045|神圣任务 (Divine Missions)","gregsieves":"5046|格雷筛子 (GregSieves)","gregtech-food-option":"5047|格雷科技食物优选 (GregTech Food Option)","converting-industrial-wires":"5048|工业线缆：转化版 (Converting Industrial Wires)","tinkers-oredict-cache":"5049|匠魂矿辞缓存 (Tinkers OreDict Cache)","avaritia-1-10":"505|无尽贪婪 (Avaritia)|734399","mentalillness":"5050|精神病 (Mental illness)","better-magnesium-video-settings-button":"5051|更好的镁视频设置按钮 (Better Magnesium Video Settings Button)","adventurez":"5052|~","mobz":"5053|~","villagerquests":"5054|村民任务 (VillagerQuests)","environmentz":"5055|~","homing-ender-eye":"5057|回归之眼 (Homing Ender Eye)|1275011","magical-crops-regrowth-1-16-5":"5058|魔法作物：重生 (Magical Crops: Regrowth)","voidz":"5059|~","transport-simulator-official-vehicle-set":"506|飞行模拟 (Minecraft Flight Simulator)","mining-master":"5060|~","victus":"5062|~","lots-of-food-revived":"5063|更多食物：复生 (Lots of Food Revived)","dontstarve":"5064|不要饿死2 (DontStarve2)|1275610","steves-universe-space-mod":"5065|~","candy-world-recaramelized":"5066|糖果世界：重制版 (Candy World - ReCaramelized)","carrier":"5067|搬运 (Carrier)","undo":"5069|撤销！ (Undo!)","essential-thaumaturgy":"507|源质神秘学 (Essential Thaumaturgy)","unnamed-animal-mod":"5070|无名动物模组 (Unnamed Animal Mod)","camels":"5071|骆驼 (Camels)","food-effects":"5072|~","item-borders-fabric":"5073|物品边框 (Item Borders)","iceberg-fabric":"5074|冰山 (Iceberg)","worldeditcui-forge-edition-3":"5076|~","enhanced-farming":"5077|增强农业 (Enhanced Farming)","abyssalcraft":"508|深渊国度 (AbyssalCraft)|664279","lava-clear-view":"5080|熔岩下清晰视野 (Lava Clear View)","global-xp":"5081|~","universal-graves":"5082|~","more-bows-restrung":"5084|更多弓：重振旗鼓！ (More Bows: Restrung!)","nimble":"5085|灵活 (Nimble)","metal-barrels":"5086|金属储物桶 (Metal Barrels)","calculator":"509|运算工艺 (Calculator)|440074","motiono":"5090|~","vanillarecipe":"5092|香草食谱 (VanillaRecipe)","fantastic-fish-alpha-v1-4":"5095|神奇的鱼 (Fantastic Fish)|400280","more-mounted-storages":"5098|更多存储挂载 (More Mounted Storages)","minecraft-comes-alive-testing":"5099|凡家物语：重生 (MCA Reborn)|1288951","sextiarysector2":"510|~","noodles-apex":"5100|面条的Apex (Noodles'Apex)|1305636","ftb-beast-coin-miner":"5101|货币矿机 (Beast Coin Miner)","scape-and-run-parasites-addon-by-nocube":"5102|~","vanilla-degus":"5103|八齿鼠 (Vanilla Degus)","ksyxis":"5104|~","metallurgy-4-reforged":"5105|冶金4：重铸 (Metallurgy 4: Reforged)","harder-natural-healing":"5106|~","extra-bit-manipulation":"5107|~","spartan-weaponry-twilight-forest":"5108|斯巴达的武器：暮色森林 (Spartan Weaponry: Twilight Forest)","iris-reforged":"5109|~","warpdrive":"511|曲率驱动 (WarpDrive)|713261","additional-lanterns":"5110|更多灯笼 (Additional Lanterns)","bottled-air-fabric":"5111|瓶装空气 (Bottled Air)","fabricproxy-lite":"5112|~","abyssal-depths":"5113|~","tomes":"5114|秘典 (Tomes)","budschies-morph-mod":"5115|~","parzis-star-wars-mod":"5116|帕尔奇的星球大战 (Parzi's Star Wars Mod)|1275203","aquatic-abyss":"5117|~|361152","slimier-slimes":"5118|~","wacky-weapons":"5119|~","futurepack":"512|飞向未来 (Futurepack Mod)|1102237","slime-carnage":"5120|史莱姆杀戮 (Slime Carnage)|381624","portal-tags":"5121|~","eden-ring":"5122|伊甸星环 (Eden Ring)","placement-tweaks":"5123|放置调整 (Placement Tweaks)","kimetsu-animation-demon-slayer-animation":"5124|鬼灭动作 (Kimetsu Animation)","hals-enhanced-biomes":"5125|~","improvedbackpacks":"5126|改良背包 (Improved Backpacks)","ender-skills":"5127|末影技能 (Ender Skills)","useful-railroads":"5128|实用铁轨 (Useful Railroads)","Voluminous-Energy":"5129|~","hbms-nuclear-tech-mod":"513|HBM的核科技 (HBM's Nuclear Tech)","flaminco":"5130|~","simple-graves":"5131|~","wi-zoom":"5134|WI变焦 (WI Zoom)","forge-carpet":"5135|~","fabric-tree-chopper":"5137|砍树 (Fabric Tree Chopper)","i-see-lava":"5138|~","two-players-one-horse":"5139|~","agricraft":"514|农业工艺 (AgriCraft)|1315462","refined-relocation-2":"5140|简单分类2 (Refined Relocation 2)","ftb-sluice":"5141|~","sky-villages-fabric":"5142|天空村庄 (Sky Villages)","gui-clock-fabric-version":"5143|~","hand-over-your-items-fabric":"5144|~","koopas-critters":"5145|~","krypton-reforged":"5146|氪Forge版 (Krypton Reforged)","item-counter":"5147|物品计数器 (Item Counter)|1279592","reality-check-real-life-timer":"5149|~","arcane-engineering":"515|奥法工程学 (Arcane Engineering)","retail":"5150|~","time-core-lib":"5152|~","mclogin":"5154|~","rereskillable":"5155|~","kubejs-blood-magic":"5156|~","kubejs-create":"5157|~","kubejs-ui-forge":"5158|~","kubejs-thermal":"5159|~","immersive-integration":"516|~","kubejs-immersive-engineering":"5160|~","kubejs-mekanism":"5161|~","starter-kit-fabric":"5162|初始套件 (Starter Kit)","stacker":"5164|~","gcm":"5165|~","ocean-floor-clay-sand-and-dirt":"5166|~","linfox-stacked-dimensions-warden-edition":"5167|~","experience-bottler":"5168|~","gregicality-ore-addon":"5169|Gregicality矿物拓展 (Gregicality Ore Addon)","ae2-stuff":"517|~","gregtech-battery-buffer-driver-for-opencomputers":"5170|格雷科技电池箱的开放式电脑驱动 (GregTech Battery Buffer Driver for OpenComputers)","orimod":"5171|~","htm":"5172|~","gtce-inventory":"5173|格雷物品管道 (GregTech CE Inventory Pipes)","mechtech":"5174|机械工程 (MechTech)","gregtech-energistics":"5175|格雷能源 (GregTech Energistics)","empatic":"5176|~","nukepowered-utils":"5177|~","gtce2oc":"5178|格雷科技开放式电脑兼容 (gtce2oc)","azure-rpg-items":"5179|Azure的RPG风格物品 (Azure RPG Items)","minetweaker-recipemaker":"518|可视化合成表编辑器 (MineTweaker RecipeMaker)","mine-and-slash-expansion":"5180|挖矿与砍杀拓展 (Mine and Slash - Expansion Mods)","devil-may-cry-weapons":"5181|鬼泣武器 (Devil May Cry Weapons)","craft-to-exile-custom-uniques":"5182|放逐之路定制物品 (Craft to Exile Custom Uniques)","terraria-arsenal":"5183|泰拉瑞亚装备 (Terraria Arsenal)","world-of-warcraft-weapons":"5184|魔兽世界装备 (World of Warcraft Weapons)","mcdoom":"5185|毁灭战士物品 (MCDoom)","bleach-weapons":"5186|死神装备 (Bleach Weapons)","behgameon":"5187|~","into-the-maelstrom":"5188|冒险漩涡 (Into The Maelstrom)","create-deco":"5189|~","thaumic-dyes":"519|神秘染料 (Thaumic Dyes)","warp-pipes":"5190|~","fertile-farmland":"5191|沃壤千里 (Fertile Farmland)","luckperms":"5192|~","inv-view":"5193|~","ftb-industrial-contraptions":"5194|FTB工业奇械 (FTB Industrial Contraptions)","more-respawn-anchors-forge":"5195|更多重生锚 (More Respawn Anchors)","werewolves-become-a-beast":"5196|狼人 (Werewolves)|1205326","omnipotent-card":"5197|万用卡牌 (Omnipotent Card)|1281444","does-it-tick":"5199|~","gadomancy":"520|魔像秘经 (Gadomancy)","public-gui-announcement":"5200|公开GUI显示 (Public Gui Announcement)","wet-lava-sponge":"5201|~","ripples-of-the-past":"5202|~","cursor-mod":"5204|自定义光标 (Cursor Mod)","amplified-nether":"5205|放大化下界 (Amplified Nether)","oreberries-replanted":"5206|矿莓重制版 (Oreberries Replanted)","eye-contact-prohibited":"5208|禁止眼神交流！ (Eye contact prohibited)|1282818","inventory-pets":"521|背包宠物 (Inventory Pets)|437983","modular-assembly":"5210|模块化组装 (Modular Assembly)","healer":"5211|~","calcium":"5212|钙 (Calcium)","from-the-shadows-forge":"5213|~","l_ender-s-cataclysm":"5214|灾变 (L_Ender 's Cataclysm)","brighter-block-light":"5215|亮光 (Brighter)|1281920","pick-up-notifier-fabric":"5216|拾取提示 (Pick Up Notifier)","talkbubbles":"5218|~","servux":"5219|~","levels":"522|装备等级 (Levels)","config-menus-forge":"5220|~","saplanting":"5221|落苗生根 (Saplanting)","login":"5222|~","edible-bugs":"5223|~","farsight-fabric":"5224|~","atlantis":"5226|亚特兰蒂斯 (Atlantis)","gaia-dimension":"5227|~","pwem":"5228|~","akisephilas-bosses":"5229|~","keeping-inventory":"523|~|592605","fluffys-farming":"5232|~","aquatic-odyssey-mod":"5233|~","vanilla-cookbook":"5234|原版烹饪书 (Vanilla Cookbook)","edible-nether-wart":"5235|可食用下界疣 (Edible Nether Wart)","plasmo-voice":"5236|Plasmo语音 (Plasmo Voice)","armor-sound-tweak":"5237|盔甲音效调整 (Armor Sound Tweak)","hexerei":"5238|~","orespawn":"524|矿石菌种 (OreSpawn)|464954","give-me-water-or-give-me-death":"5240|~","lost-and-found":"5241|~","better-fps-render-distance-fabric":"5242|~","armor-chroma-for-fabric":"5243|盔甲颜色显示Fabric版 (Armor Chroma for Fabric)","ore-reeds":"5244|矿石甘蔗 (Ore Reeds)","connected-glass":"5245|~","blockui":"5246|~","storage-racks":"5247|~","Dung-Pipe":"5248|~","extra-armor":"5249|~","reliquary":"525|圣遗物 (Reliquary Reincarnations (Reliquary))","pig-poop":"5250|~","stupid-horse-stand-still":"5251|~","ceramic-bucket":"5252|陶瓷桶 (Ceramic Bucket)","durability101":"5253|~","ceramic-shears":"5254|陶瓷剪刀 (Ceramic Shears)","torch-bandolier":"5255|火把弹药袋 (Torch Bandolier)","rapid-leaf-decay":"5256|~","netherite-horse-armor-mod":"5257|下界合金马铠 (Netherite Horse Armor Mod)","ambient-environment":"5258|~","glass-cutter":"5259|~","mo-bends":"526|更多弯曲 (Mo' Bends)|205695","dicemc-tiered-armors":"5260|~","tetranomicon":"5261|~","more-observers":"5262|更多侦测器 (More Observers)","villagers-respawn":"5263|村民重生 (Villagers Respawn)","hot-swappable-armor":"5264|热切换护甲 (Hot-Swappable Armor)","advancement-plaques-fabric":"5265|进度牌匾 (Advancement Plaques)","minceraft-mod":"5267|~","alexs-delights":"5268|~","better-bedrock-generator-fabric":"5269|~","quark":"527|夸克 (Quark)|1155355","prehistoric-fauna":"5270|史前生物 (Prehistoric Fauna)","better-conduit-placement-fabric":"5271|更好的潮涌核心放置 (Better Conduit Placement)","death-counter":"5272|死亡计数器 (Death Counter)","dimension-stages":"5273|维度阶段 (Dimension Stages)","passive-dragon":"5274|~","i-want-to-die-at-home":"5275|~","morevanillaweapons":"5276|更多原版武器 (MoreVanillaWeapons)","ore-tree-reborn-fabric":"5277|矿物树：重制 (Ore Tree:Reborn)","player-tracking-compass":"5278|~","tooltipfix":"5280|信息提示修复 (ToolTipFix)","extended-noteblock-fabric":"5281|音符盒扩展 (Extended Noteblock)","ore-prospecting-stick-fabric":"5282|探矿棒 (Ore Prospecting Stick)","worldedit-express-fabric":"5283|~","awesome-dungeon-edition-ocean-fabric":"5284|~","pistorder":"5285|~","escape-rope-pokemon-item-fabric":"5286|~","awesome-flooring-fabric":"5287|~","medievial-entity-fabric":"5288|中世纪生物 (Medieval Entity)","upgraded-shulkers":"5289|更多潜影盒 (Upgraded Shulkers)","official-divinerpg":"529|神圣RPG (DivineRPG)|1080271","bobby":"5291|服务器区块缓存 (Bobby)","boosted-brightness":"5292|亮度增强 (Boosted Brightness)","effective-forge":"5293|~","voidtotem-fabric":"5295|虚空图腾 (Void Totem)","tool-leveling-plus-fabric":"5296|~","mythicmetals":"5297|神话金属 (Mythic Metals)","creeper-firework":"5298|烟花苦力怕 (Creeper Firework)|1285741","second-chance-forge":"5299|~","harvest-festival":"530|丰收物语 (Harvest Festival)|658968","promenade":"5300|~","london-underground":"5301|~","dynamiclights-reforged":"5302|镁/铷：动态光源 (Magnesium/Rubidium Dynamic Lights)","the-wild-mod":"5303|荒野更新 (The Wild Mod)","tuff-depth":"5304|凝灰岩深度 (Tuff Depth)","minefantasy-reforged":"5305|我的幻想重铸版 (MineFantasy Reforged)","framework":"5307|~","tough-as-nails":"531|意志坚定 (Tough As Nails)|849264","anointed-items":"5310|~","golden-age-combat":"5311|黄金时代的战斗 (Golden Age Combat)","magnesium-extras":"5312|镁/铷：附属 (Magnesium/Rubidium Extras)","chest-tracker":"5313|箱子追踪 (Chest Tracker)","advancementinfo":"5314|进度信息展示 (Advancementinfo)","animatica":"5315|~","all-dimension-height-increase":"5316|全维度建筑高度提升 (All Dimension Height Increase)","merchant-markers-fabric":"5317|商人标记 (Merchant Markers)","loot-bag":"5318|战利品袋子 (Loot Bag)","miner-watcher":"5319|矿工监视者 (Miner Watcher)","non-update":"532|不再有更新 (Non Update)","memento-mori-remember-death":"5320|人终有一死/记住死亡 (Memento Mori / Remember Death)","not-enough-gamerules-fabric":"5321|~","archmagus":"5324|~|320407","slimyboyos":"5325|~","fireplace-lib":"5326|~","immersive-geology":"5327|~","wool-tweaks-fabric":"5328|羊毛调整 (Wool Tweaks)","tools-complement":"5329|~","clayium":"533|粘土工业 (Clayium)","adventtic":"5330|~","questionably-immersive":"5331|~","long-fall-boots":"5332|~","total-darkness":"5333|~","true-darkness":"5334|~","starlight-x-create":"5335|~","grand-economy":"5336|~","chinacraft2":"5337|华夏文明2 (ChinaCraft2)|1288124","interactic":"5338|~","fnars-roguelike-dungeons":"5339|冒险地牢-Fnar版 (Roguelike Dungeons -- Fnar's Edition)","better-storage":"534|更好的储存 (Better Storage)","playerex":"5340|~","data-attributes":"5341|~","hardcore-buoyance":"5342|~","gregtech-ce-unofficial":"5343|格雷科技社区版：非官方版 (GregTech CE: Unofficial)","eggtab-forge":"5344|独立刷怪蛋列表 (Egg Tab)","always-a-wither-skull":"5345|必得凋灵骷髅头颅 (Always a Wither Skull)","anvil-restoration":"5346|铁砧修复 (Anvil Restoration)","hide-hands":"5347|隐藏主副手 (Hide Hands)","better-beacon-placement-fabric":"5348|更好的信标放置 (Better Beacon Placement)","dead-totems":"5349|~","davincis-vessels":"535|达芬奇之舟/达芬奇的船 (Davincis Vessels)|475292","functional-storage":"5350|功能性存储 (Functional Storage)","the-wild-update":"5351|荒野更新1.19 (The Wild Update 1.19)","archeology":"5352|考古学 (Archeology Mod)","trinkets-and-baubles":"5354|饰品与小玩意 (Trinkets and Baubles)","rope-ladders":"5356|绳梯 (Rope Ladders)","skewers-updated":"5357|烤串更新版 (Skewers Updated)","keep-my-soil-tilled":"5358|保持肥沃 (Keep My Soil Tilled)","double-doors":"5359|双开门 (Double Doors)","expanded-armor-enchanting":"5360|盔甲附魔扩展 (Expanded Armor Enchanting)","expanded-weapon-enchanting":"5361|武器附魔扩展 (Expanded Weapon Enchanting)","expanded-axe-enchanting":"5362|斧附魔扩展 (Expanded Axe Enchanting)","expanded-trident-enchanting":"5363|三叉戟附魔扩展 (Expanded Trident Enchanting)","urns":"5364|~","pylons":"5365|~","on-soul-fire":"5366|~","wizard-staff":"5367|~","kambrik":"5368|~","additional-bars":"5369|更多的栏杆 (Additional Bars)","techguns":"537|科技枪 (Techguns)|631578","leap":"5370|~","cameraoverhaul":"5371|~","enchantment-id-extender":"5372|~","creeper-overhaul":"5373|苦力怕改革 (Creeper Overhaul)","cool-elytra-roll":"5374|~","camera-overhaul-forge":"5375|~","blame-fabric":"5376|~","patboxs-banhammer":"5377|~","terraformed-api-reforged":"5378|~","multiblocktweaker":"5379|~","Iron-Backpacks":"538|特殊背包 (Iron Backpacks)","good-ol-currency":"5380|~","macaws-bridges-atmospheric":"5381|Macaw的桥梁：悠然一派附属 (Macaw's Bridges - Atmospheric)","leadvillagers":"5382|~","fabric-shield-lib":"5383|~","frys-things-guns-and-more":"5384|~","quickbind":"5385|功能集成 (Quick Bind/Command GUI buttons)","ompd":"5386|开放式模块化被动防御 (Open Modular Passive Defense)","basic-shields-fabric":"5387|~","borderless-mining":"5388|~","ledger":"5389|~|1207255","openmodularturrets":"539|开放式炮台 (OpenModularTurrets)","pet-owner":"5390|~","spartan-hud-baubles":"5391|斯巴达饰品栏HUD (Spartan HUD: Baubles)","mekanism-matter":"5392|通用机械：物质拓展 (Mekanism Matter)","inzhefop-core":"5393|~","legendary-tooltips-fabric":"5396|传说工具提示 (Legendary Tooltips)","myrtrees":"5397|~","tiny-redstone":"5399|~","technomancy":"540|量子魔法 (Technomancy)","icarus-fabric":"5401|伊卡洛斯之翼Fabric版 (Icarus (Fabric))","the-splash-milk":"5402|喷溅牛奶 (Splash Milk)|1289975","fastbench-for-fabric":"5403|工作台性能优化Fabric版 (FastBench for Fabric)","mob-buckets-fabric":"5404|生物桶 (Mob Buckets)","enchantable":"5407|~","glass-doors":"5408|玻璃门 (Glass Doors)","glasscutter":"5409|玻璃切割器 (Glass Cutter)","quantumflux":"541|量子通量 (QuantumFlux)|668576","upgradable-crystal-tools":"5410|~","no-dragon-cheese":"5411|~","glassware":"5412|玻璃制品 (Glassware)","milk-plus":"5413|~","modifiers":"5414|重铸 (Modifiers)","customnpc-plus":"5415|自定义NPC+ (CustomNPC+)","ingredient-extension-api":"5416|~","wireless-networks":"5418|~","compass-manhunt":"5419|~","blocksniffer":"542|方块探测 (Block Sniffer)","exlines-furniture":"5420|~","tinkers-archery":"5421|工匠箭术 (Tinkers' Archery)","designer-modeling":"5422|设计师建模 (Designer Modeling)","netherite-horse-armor-fabric":"5424|下界合金马铠 (Netherite Horse Armor)","netherite-elytra":"5425|下界合金鞘翅 (Netherite Elytra)","more-tcon":"5427|更多匠魂材料 (Moar TCon)","exlines-emerald-equipment":"5428|~","exlines-candy-mod":"5429|~","dragonapi":"543|~","renamer":"5430|代号名称 (Renamer)","the-herobrine-mod-1-7-10":"5432|~","aquatic-armors":"5433|~","immersive-industry":"5434|沉浸工业 (Immersive Industry)","lightmans-currency":"5435|~","hellfire-fireball-launcher-fabric":"5436|地狱火：火焰弹发射器 (Hellfire: Fireball Launcher)","guild":"5437|~","endless-deep-space":"5438|无尽深空 (Endless Deep Space)","electricraft":"544|电力工艺 (ElectriCraft)","dynamic-trees-for-sakura":"5440|动态的树：樱附属 (Dynamic Trees for Sakura)","advanced-fishing":"5441|~","bettertabs":"5443|~","classy-hats":"5444|时髦帽子 (Classy Hats)","bedbreakbegone":"5445|~","bq-multiblock-structure-integration":"5446|更好的任务-多方块与结构扩展 (Better Questing - Multiblock and Structure Integration)","bqtweaker":"5447|~","hypnos":"5448|~","collision-damage":"5449|~","candycraft":"545|糖果世界 (CandyCraft)|459723","project-74246":"5450|毁灭地牢 (Doomlike Dungeons)","dynamic-trees-defiled-lands":"5451|动态的树：污秽之地附属 (Dynamic Trees - Defiled Lands)","xaero-map-addition":"5452|~","lambdacontrols":"5453|Lambda 的控制优化 (LambdaControls)","ducky-mod":"5454|~","quartz":"5456|~","all-the-blocks":"5457|~","allthemodium":"5458|~","ato":"5459|~","just-enough-effect-descriptions-jeed":"5460|JEI药水效果 (Just Enough Effect Descriptions)","hostile-neural-networks":"5461|~","mo-cakes":"5462|更多蛋糕 (Mo' Cake)","fishing-made-better":"5463|更好的钓鱼 (Fishing Made Better)","neon-craft-2-mod":"5464|霓虹灯艺2 (Neon Craft 2 Mod)","architects-dream":"5465|建筑师之梦 (Architect's Dream)","ignition-enderbags":"5466|~","correlated":"5467|~","no-mob-spawning-on-trees":"5469|~","minefantasy2":"547|我的幻想2 (MineFantasy2)","rf-lux":"5470|~","easy-normal-and-magic-foods":"5474|~","tiefix":"5475|~","more-chat-history":"5476|更多聊天记录 (More Chat History)","phosphor-reloaded":"5477|磷重制版 (Phosphor Reloaded)","pigstep-backport":"5479|~","agadars-brewing-api":"5480|~","ae-shield":"5483|奕 秉甲 (Ae Shield)","giant-player-boss":"5485|巨人玩家Boss (Giant Player Boss)","set-bonus":"5486|~","tntutils":"5487|~","giant-swords":"5488|巨剑 (Giant Swords)","terrablender-fabric":"5489|~","rails-of-war":"549|铁路战争 (Rails of War)","commandhelper":"5490|命令助手 (CommandHelper)|1294868","bilibili":"5491|~","creatures":"5493|~","mcdw":"5494|我的世界：地下城武器 (MC Dungeons Weapons)","beta-creepers":"5496|~","macaws-paintings":"5498|~","dyenamics":"5499|~","tale-of-kingdoms":"55|王国 (Tale Of Kingdoms)","actually-additions":"550|实用拓展 (Actually Additions)|841281","multi-piston":"5500|~","resolutioncontrol":"5502|分辨率控制 (Resolution Control)","domum-ornamentum":"5506|~","methodicalmilking":"5507|~","save-and-load-inventories":"5509|~","galaxy-space-addon-for-galacticraft":"551|星空 (Galaxy Space)|857805","forge-config-api-port-fabric":"5510|~","pams-cookables":"5511|~","end-metals":"5512|~","vitality":"5513|~","featured-servers":"5514|~","oldjavawarning":"5515|~","mercurius":"5516|~","all-the-swords":"5517|~","pams-simple-recipes":"5518|~","bow-infinity-fix":"5519|无限附魔修复 (Bow Infinity Fix)","latiao-craft":"552|辣条工艺 (Latiao Craft)|720880","enchanting-infuser-fabric":"5521|附魔灌注台 (Enchanting Infuser)","menumobs":"5522|主菜单生物渲染 (MenuMobs)","tiny-skeletons-fabric":"5524|小骷髅变种 (Tiny Skeletons)","matter-overdrive-community-edition":"5526|超能物质社区版 (Matter Overdrive: Community Edition)","cavetweaks":"5527|洞穴调整 (CaveTweaks)","cosmetic-armor-fabric":"5528|时装盔甲 (Cosmetic Armor)","crimson-chickens":"5531|~","drippy-loading-screen-fabric":"5532|自定义游戏加载界面 (Drippy Loading Screen)","extreme-sound-muffler-fabric-official":"5533|~","dragonloot":"5534|龙战利品 (DragonLoot)","wtfcore":"5535|~","ore-remover":"5536|~","betweenlands-redstone":"5537|~","more-peripherals":"5538|~","ageing-spawners":"5539|~","meteorcraft":"554|陨石工艺 (MeteorCraft)","loot-extra":"5540|战利品表拓展 (LootExtra)","cloud-boots-mod":"5541|云靴 (Cloud Boots Mod!)","better-compatibility-checker":"5542|~","fastfurnace-minus-replacement":"5543|~","harvest":"5544|~","craftpresence":"5545|~","stonecutter-recipe-tags":"5546|~","customnpcsreborn":"5547|自定义NPC：重生 (Custom NPCs Reborn)","nightmare-craft-survival":"5548|梦魇工艺：生存 (Nightmare Craft: Survival)","brassamberbattletowers":"5549|~","jags":"5550|~","sedna":"5551|~","fog-tweaker":"5552|~","squid233s-elevator":"5553|squid233的电梯 (squid233's Elevator)","nullscape-end-reborn":"5555|空无之景 (Nullscape)","brutal-bosses-dungeon":"5556|~","guerrilla-vs-command-mod-high-difficulty-addition":"5557|游击队员vs突击队员 (Guerrilla vs Command)|716532","super-tools-reloaded-reloaded":"5558|超级工具重置版重制版 (Super Tools Reloaded-Reloaded)|1323730","lychee-fabric":"5559|~","arrow-cam":"556|箭矢视角 (Arrow Cam Mod)","morepaths":"5560|~","extended-mushrooms":"5561|~","shear-madness":"5562|~","missing-pieces":"5563|~","hatchery":"5564|~","alexs-delight":"5565|~","creatures-and-beasts":"5566|~","dead-guys-deep-dark":"5567|~","towers-of-the-wild-reworked-datapack":"5568|旷野之息高塔：重制 (Towers of the Wild: Reworked)","towers-of-the-wild-reloaded":"5569|旷野之塔：重置 (Towers of the Wild: Reloaded)","2668920":"557|茶风·纪事 (Tea the Story)|562372","bansoko":"5570|创可贴 (Bansōkō)","inventory-backpack":"5572|~","reinforced-shulker-boxes":"5575|增强潜影盒 (Reinforced Shulker Boxes)","fastopenlinksandfolders":"5576|快速打开链接和文件夹 (FastOpenLinksAndFolders)","reinforced-chests":"5577|增强箱子 (Reinforced Chests)","biome-staff":"5578|~","dynamic-trees-quark":"5579|动态的树:夸克附属 (Dynamic Trees - Quark)","techreborn":"558|科技复兴 (Tech Reborn)|777062","radium-reforged":"5580|镭 (Radium Reforged)","backpackmod":"5581|~","untamedwilds":"5583|不羁野性 (UntamedWilds)|1211422","advancements-tracker":"5584|~","no-null-processors":"5585|~","ma-enchants":"5587|Ma 附魔 (Ma Enchants)","bits-and-chisels":"5588|~","trading-post-fabric":"5589|交易站 (Trading Post)","infusinbrewing":"559|注魔酿造 (Infusion Brewing)","nourished-nether":"5590|~","furnus":"5591|~","permanent-light-generator-fabric":"5592|恒久光发电机 (Permanent Light Generator)","immortuos-calyx":"5594|~","claim-chunk":"5595|~","dicemc-money-mod":"5596|~","client-command-aliases":"5597|~","interactive-corporea":"5598|交互多媒体 (Interactive Corporea)","just-another-auto-clicker":"5599|~","jurassicraft":"560|侏罗纪时代 (JurassiCraft)|831791","better-sneak":"5601|更好的潜行 (Better Sneak)","crapping-copper":"5602|压缩升级铜 (Crapping Copper)","botany-pots-ore_planting-forge":"5603|植物盆栽矿石种植 (Botany Pots Ore_planting)","satin-api":"5605|~","easy-magic-fabric":"5606|~","enlightened-end":"5607|~","rubidium":"5608|铷 (Rubidium)","cultural-delights":"5609|多元乐事 (Cultural Delights)","eternal-singularity":"561|永恒奇点 (Eternal Singularity)","jer-integration":"5611|JER集成 (JER Integration)","just-enough-beacons":"5612|JEI信标 (Just Enough Beacons)","windowed-fullscreen":"5613|~","helpful-hitboxes-forge":"5615|~","vein-mining-fabric":"5616|连锁采集 (Vein Mining)","ars-creo":"5617|~","it-fell-from-the-sky":"5618|~","codechicken-lib-1-8":"562|~","lyonheart":"5626|~","genshin-12":"5627|原神12 (Genshin 12)","ae-additions-extra-cells-2-fork":"5628|~","silent-addons":"5629|~","codechickencore":"563|鸡块核心 (CodeChickenCore)","ars-arsenal":"5630|~","gps-mod-stalker-mod":"5631|~","extended-armor-bars":"5632|~","atom-economy":"5633|基石-经济 (Atom-Economy)","just-enough-piglin-bartering":"5634|JEI猪灵以物易物 (Just Enough Piglin Bartering)","primal-magick":"5637|原初魔法 (Primal Magick)","ore-creeper":"5638|矿石苦力怕 (Ore Creeper)","panthalassa":"5639|泛古洋 (Panthalassa)","stardew-armory":"5640|星露谷武器 (Stardew Armory)","no-more-nether-desert-edition":"5641|~","blaze-gear":"5642|烈焰装备 (Blaze Gear)","rhodonite-tools-armour":"5644|~","more-minecarts":"5645|~","corn-delight":"5646|玉米乐事 (Corn Delight)","blast-craft":"5649|防爆工艺 (Blastcraft)","aobd-singularities":"565|~","zdgx":"5650|mod自动更新|1302410","ore-highlight":"5653|矿石发亮 (Ore Highlight)|1302603","sodium-shadowy-path-blocks":"5654|钠 · 土径阴影 (Sodium Shadowy Path Blocks)","polymer":"5656|~","elytra-bombing":"5657|鞘翅轰炸 (Elytra Bombing)","cuboiddroids-support-mod":"5658|~","universal-singularities":"566|通用奇点 (Universal Singularities)","litematica-tool":"5662|投影工具 (litematica tool)","frozen-up-fabric":"5663|千里冰封 (Frozen Up)","carpet-tis-addition":"5664|~","more-banner-features":"5666|更多旗帜功能 (More Banner Features)","horsestatsvanilla":"5667|马匹状态 (Horse Stats Vanilla)","biome-id-extender":"5668|~","rereskillable-reborn":"5669|~","academy-monster":"567|超能力怪物 (Academy Monster)|677849","rereskillable-rereforked":"5670|~","tetra-pak":"5671|~","ars-magica-legacy":"5672|~","compressium":"5673|~","talking-villagers":"5674|会说话的村民 (Talking Villagers)","artifality":"5675|~","boat-container":"5676|箱船 (Boat Container)","delogger":"5677|~","just-another-vanilla-addon-java":"5678|迫真原版增强 (Just Another Vanilla Addon)|1312820","spectrite-mod":"5679|彩虹 (Spectrite)","sonar-core":"568|声呐核心 (Sonar Core)","genshin-nature":"5680|原神：自然 (Genshin Nature)","power-utilities-remastered":"5681|能源转换重制 (Power Utilities Remastered)","create-gear-addon":"5682|~","gun-mod-tl":"5683|~","energymeter":"5685|~","quantum-generators":"5687|量子发电机 (Quantum Generators)","simply-quarries":"5688|简易采石场 (Simply Quarries)","lethal-peaceful":"5689|~","armorstatushud":"569|耐久信息显示 (ArmorStatusHUD)|138426","storage-drawers-crafting-recipe":"5692|~","enhanced-attack-indicator":"5693|增强攻击提示器 (Enhanced Attack Indicator)","parasites-addon-overlast":"5694|寄生兽：末世扩展 (OverLast)","franciscofunari":"5696|中世纪工艺 (Medieval Craft)","d3core":"5697|~","green-thumb-v1-2-03":"5698|~","greenthumb":"5699|~","wanionlib":"570|~","tfc-adventure":"5700|群峦冒险 (TFC+ Adventure)","just-zoom-forge":"5701|~","eidolons-hexblades":"5704|幻梦咒剑 (Eidolon's Hexblades)","monke-madness":"5705|~","put-ingot-down":"5706|把锭放在地上吧！ (Put Ingot Down!)|1313541","torchtools":"5707|~","lottweaks":"5708|~","quests-additions":"5709|任务拓展 (Quests Additions)","llibrary":"571|~","custom-mob-spawner":"5710|自定义生物生成器 (Custom Mob Spawner)","rpg-hud-fabric":"5711|~","the-wild-update-concept-mod":"5712|~","oreregen":"5715|再生矿石 (OreRegen)","eidolon_tweaker":"5716|~","herodotusutils":"5718|~","platypuses":"5719|~","hostile-villages":"5720|敌对村庄 (Hostile Villages)","throwability":"5721|投掷 (Throwability)","biomeinfo-fabric":"5722|生物群系信息 (BiomeInfo)","clickable-advancements":"5723|可点击的进度 (Clickable advancements)","factory0-resources":"5724|~","epic-knights-armor-and-weapons":"5725|史诗骑士：盾牌，盔甲和武器 (Epic Knights: Shields, Armor and Weapons)","youre-an-expert-harry":"5726|你是个专家，哈利！ (You're an Expert, Harry!)","dragon-mounts-3":"5727|龙骑士3 (Dragon Mounts 3)","viaforge":"5728|~","happy-trails":"5729|~","naturesaura_tweaker":"5730|~","death-finder-fabric":"5731|~","portable-craft":"5733|便携工艺 (Portable Craft)","etched":"5735|~","caves-cliffs-backport-additions":"5736|~","cobblefordays":"5737|~","admin-shop":"5738|官方商店 (Admin Shop)","vanillamagic":"5739|纯净魔法 (Vanilla Magic)|1307461","deep-mob-learning-simulacrum":"5740|~","oculus":"5741|~","simple-planes-tfc":"5742|~","mishang-urban-construction":"5743|迷上城建 (Mishang Urban Construction)","phi":"5745|~","ae2-utilities":"5746|AE2实用设备 (AE2 Utilities)","epic-psi":"5748|~","missingmagic":"5749|~","enchanting-convergence":"5750|~","magical-psideas-model-replacer":"5751|~","linkout":"5752|~","copper-pot":"5758|铜锅！ (Copper Pot!)","viarewind":"5761|~","viabackwards":"5762|~","thaumic-isorropia":"5763|~","loading-manager":"5764|更多加载信息 (Loading Manager)","psitools":"5765|~","psionic-upgrades":"5766|~","psionicolor":"5767|~","reskillable-psi-compat":"5768|~","zettai-psi":"5769|~","psicaster":"5770|~","tweakermore":"5771|~","legacy-display":"5772|~","the-backrooms":"5773|~","creatures-of-the-snow":"5774|雪地里的生物！ (Creatures From The Snow!)","collisions-lib":"5775|~","wooled-boots":"5776|羊毛靴子 (Wooled Boots)","zawa-evolved":"5777|野生动物园：进化 (Zoo and Wild Animals: Evolved)","bongo":"5778|~","impersonate":"5779|~","calemi-core":"5780|~","visual-workbench-fabric":"5783|可视化工作台 (Visual Workbench)","stylish-effects-fabric":"5784|~","death-compass-fabric":"5785|~","portable-stonecutter":"5786|便携式切石机 (Portable Stonecutter)","enchanted-book-redesign":"5788|~","quick-hotbar":"5789|~","modular-augment":"5790|~","lumberjack":"5791|~","better-mods-button":"5792|更好的模组按钮 (Better Mods Button)","improved-mount-hud-forge":"5793|改进的骑乘HUD (Improved Mount HUD)","advancement-frames":"5794|~","dynmapforge":"5796|~","spellbind":"5797|物品魔法 (Spellbind)|1311578","bumpkinbatch":"5799|~","beekeeper":"5800|养蜂人 (Beekeeper)","some-assembly-required":"5801|~","ladylucs-critters-mod":"5802|~","better-signs":"5805|~","create-irrigation":"5815|~","delete-worlds-to-trash-fabric":"5816|~","simple-magnets":"5819|简易磁铁 (Simple Magnets)","guns-without-roses":"5820|~","buddycards-expansions":"5821|巴迪卡牌扩展 (Buddycards Expansions)","zettai-ars":"5822|~","cant-sleep-clowns-will-eat-me":"5823|夜不能寐 (Can't Sleep Clowns Will Eat Me)","colony-cards":"5824|殖民地卡牌 (Colony Cards)","autoharvest":"5825|自动收获 (AutoHarvest)","realistic-block-physics":"5826|~","domestication-innovation":"5827|驯养革新 (Domestication Innovation)","snuffles":"5828|~","flan":"5829|~","environmental-tech":"583|环境科技 (Environmental Tech)|644622","awesome-dungeon-the-end-edition-datapack":"5830|~","tehnuts-torcherino":"5831|~","library-ferret-fabric":"5832|~","awesome-dungeon-nether-edition-datapack":"5833|~","ae2-extended-life":"5834|~","refined-cooking":"5836|精致厨房 (Refined Cooking)","jade-addons":"5837|~","feature-nbt-deadlock-be-gone":"5838|~","real-infinity-bow-allow-inf-mending":"5840|真正的无限弓 (Real Infinity Bow)|1148331","drink-it-forge":"5841|喝下去！ (Drink It!)","foxlib":"5842|~","tails":"5843|~","howling-moon-rebooted-fabric":"5844|~","furnish":"5848|~","iammusicplayer":"5849|~","magic-cookies":"585|魔法饼干 (Magic Cookies)|710008","notenoughheroes":"5850|~","pirates":"5851|海盗 (Pirates)","comics-bubbles-chat":"5852|~","fabric-extended-armor-bars-forked":"5853|~","eating-animation-fabric":"5854|~","dripsounds-fabric":"5855|~","better-horse-hud":"5856|~","thermopolium":"5857|汤饮铺 (Thermopolium)|1314208","thaumic-potatoes":"586|神秘土豆 (Thaumic Potatoes)","orderly-fabric-2-0":"5860|~","entity-texture-features-fabric":"5862|~","sculk-plus":"5863|~","creeper-confetti-fabric":"5864|烟花苦力怕Fabric版 (Creeper Confetti Fabric)","double-jump-attribute":"5865|~","overweight-farming":"5866|~","healthcare":"5867|~","betterloadingscreen":"5868|加载画面改良 (Better Loading Screen)|1314925","fabric-title-changer":"5869|~","torcherino":"587|加速火把 (Torcherino)|788894","window-title-changer":"5870|~","robins-ruby-mod":"5876|~","just-needed-fabric":"5879|~","craftable-nether-star":"588|~","nodami-remake":"5880|伤害免疫机制移除重制版 (NoDamIRemake)","had-enough-items":"5881|HEI物品管理器 (Had Enough Items)","worldinfo":"5882|~","block-helper":"5884|~","gregicprobe":"5887|~","travelers-index":"5889|~","veinminer":"589|连锁采矿/矿脉矿工 (Vein Miner)|387183","dimension-data-fix":"5891|维度数据修复 (Dimension Data Fix)","gtce-bees":"5892|~","armory-expansion-bits-and-pieces":"5895|~","electrostatic-tinkers-toys":"5896|~","banhammer":"5897|~","slabgen":"5898|~","potioncraft":"5899|~","atlas-lib":"5900|~","blood-smeltery":"5901|~","tinkers-memes":"5902|~","tinkers-golems-addon":"5903|~","tinkers-addons-fork":"5904|~","reagenchant":"5905|~","sim-u":"5907|模拟城市 (Simulated town)|1317405","thorium":"5909|钍 (Thorium)|1314572","another-one-bites-the-dust":"591|~","creative-one-punch":"5910|~","radon":"5911|氡 (Radon)","ars-omega":"5912|~","game-stages-conditions":"5913|~","tinkers-construct-tool-leveling-with-random":"5914|~","odd-water-mobs":"5915|~","glowsquids-begone":"5916|~","theundead":"5917|~","framedblocks":"5918|~","nekos-enchanted-books":"5919|~","istc":"5920|我说了算 (I Said The Calculation)","dracovita-farm-life":"5922|~","no-enchant-cap":"5923|~","artisan-automation":"5925|工匠自动化 (Artisan Automation)","enchanted-wolves":"5926|~","rain-growth":"5928|~","scape-and-run-monstress":"5929|逃逸：魔物娘 (Scape and Run: Monstress)","mine-mine-no-mi":"593|恶魔果实 (Mine Mine no Mi)|828931","raised":"5930|~","resetchunks":"5931|~","moreblocksforyou":"5934|~","trident-return":"5935|~","bettertridentreturn":"5936|~","multibeds":"5937|~","enhanced-armaments-reload":"5938|增强装备重制版 (Enhanced Armaments Reload)","entangled":"5939|~","advanced-rocketry":"594|高级火箭 (Advanced Rocketry)|671760","createplus":"5941|~","custom-fluid-mixin":"5942|~","slender-reimagined":"5943|~","doors-by-ichun":"5944|~","slender-man-mod":"5945|~","cookielicious":"5946|曲奇佳味 (Cookielicious)","the-forbidden":"5947|禁忌者 (The Forbidden)","memory-usage-screen":"5948|~","vics-modern-warfare-mod":"595|维克的现代战争 (Vic's Modern Warfare Mod)|692842","blue_skies_tcon":"5953|~","tdv-tweaks":"5954|~","picture-in-picture-pip":"5956|~","guilt-trip":"5957|~","parcool":"5958|~","legacy-mc-kotlin":"5959|~","chance-cubes":"596|机会方块 (Chance Cubes)","minimepets":"5960|~","ugly-scoreboard-fix":"5961|~","pig-grinder":"5966|~","photoreal":"5967|~","keygrip-mocap-mod":"5968|~","gun-customization":"597|~","attachable-grinder":"5970|~","hat-stand":"5971|~","chunk-copy-fabric":"5972|~","inventory-home":"5973|回归箱 (Inventory Home)","nether-hexed-kingdom":"5974|~","talking-ben-mod":"5977|~","in-backpack-eat":"5978|背包内食用 (In-backpack Eat)","endercore":"598|末影核心 (EnderCore)","smooth-swapping":"5980|~","tinkering-with-blood-magic":"5981|~","tinker-toolcasts":"5982|~","thermal-tinkering":"5983|~","deuf-duplicate-entity-uuid-fix":"5984|~","corundum-meadows":"5985|~","millenaire-extended-inuits":"5986|~","mct-smeltery-io":"5987|~","opencomputers-drivers-for-tinkers-construct":"5988|~","oedldoedl-construct":"5989|~","brandons-core":"599|~","millenaire-extended-byzantine":"5990|~","millenaire-extended-normans":"5991|~","millenaire-extended-indians":"5992|~","millenaire-extended-maya":"5993|~","oedldoedl-core":"5994|~","oedldoedl-resources":"5995|~","oedldoedl-gear":"5996|~","disguiseheads":"5997|~","simple-tcon":"5998|~","enchanted-tooltips":"5999|~","railcraft":"6|铁路 (Railcraft)|603270","cofh-core":"600|CoFH核心 (CoFH Core)","stackablepotions":"6000|~","mobifier-fabric":"6001|~","art-of-forging-a-tetra-datapack":"6002|锻造之艺 (Art of Forging)","harder-staged-difficulty":"6003|~","material-changer":"6004|~","tree-harvester-fabric":"6005|~|1123514","itemfx":"6006|~","mekanism-ce":"6007|通用机械1.7.10社区版 (Mekanism 1.7.10 Community Edition)","property-modifier":"6009|~","statuseffecthud":"601|状态信息显示 (StatusEffectHUD)|63123","grimoire-of-tetra":"6010|~","prehistoric-delight-by-nocube":"6011|史前乐事 (Prehistoric Delight)","simple-stations":"6013|~","ars-elemental-elemental-spell-foci":"6014|元素魔艺 (Ars Elemental)","too-many-glyphs":"6015|~","create-cafe":"6016|机械动力：奶茶店 (Create Cafe)","ic2-rpg":"6018|工业RPG (IC2 RPG)|821438","drop-the-meat":"6019|~","lambdalib":"602|~","better-invisibility":"6020|~","tweakerplus":"6021|~","autorun-fabric":"6022|~","fpv-drone":"6023|~","campfire-backport":"6024|~","skip-transitions":"6025|~","just-load":"6026|~","cheese-dragon":"6027|~","boatjump":"6028|~","redstonic":"603|红石电子 (Redstonic)|623471","torched":"6030|~","nyfs-quivers":"6031|Nyf的箭袋 (Nyf's Quivers)","party-parrots":"6032|~","patina-pipeworks":"6033|古铜管道 (Patina Pipeworks)","brewevolution":"6034|酿造进化🍺 (Brewevolution 🍺)","devil-fruits":"6035|恶魔果实 (Devil Fruits)","trail-mix":"6037|~","multiplayer-server-pause-forge":"6038|~","noshelter-reborn":"6039|无庇护所：重生 (NoShelter Reborn)","libvulpes":"604|~","initial-spawn-dimension":"6040|~","the-one-probe-fabric":"6041|~","gehenna-super-spooky-nether-overhaul-for-forge":"6042|~","draconicminus":"6043|~","hygiene":"6044|~","external-view-reload":"6046|~","fluid-drawers-legacy":"6047|储液抽屉：遗产 (Fluid Drawers Legacy)","my-server-is-compatible":"6048|~","medieval-siege-machines":"6049|中世纪攻城机器 (Medieval Siege Machines)","ye-gamol-chattels#t1:description":"605|伊加墨的财产 (Ye Gamol Chattels)|617588","leapoffaith-forge":"6050|信仰之跃 (Leap of Faith)","top-plus":"6051|~","refined-storage-fluxified":"6052|~","quit-confirm":"6053|~","compressedcreativity":"6054|~","applied-mekanistics":"6055|~","craftdumper":"6056|~","immersive-weathering-forge":"6057|沉浸式风化 (Immersive Weathering)","replay-mod-for-forge":"6058|~","bigtrees":"6059|~|376937","ivtoolkit":"606|~","absolutely-not-a-zoom-mod":"6060|绝对不是一个缩放模组 (Absolutely Not A Zoom Mod)","glymworld-lush-caves":"6061|~","colored-crafting-stations":"6062|~","harvest-scythes":"6063|~","croptosis":"6064|~","weeping-angels-mod":"6065|~","hardcore-item-stages":"6066|~","game-stages-viewer":"6067|~","mpm-lotr":"6068|~","guard-villagers-fabric":"6069|警卫村民Fabric版 (Guard Villagers (Fabric))","wolf-armor-and-storage":"607|狼铠 (Wolf Armor and Storage)|672655","item-highlighter":"6071|物品高亮 (Item Highlighter)","origins-environmental-armor-1-18-1-port":"6073|~","health-levels":"6075|~","the-comfort-zone":"6076|~","mekatweaker":"6078|~","smithing-in-the-90s":"6079|~","better-records":"608|更好的播放器 (Better Records)","embellished-enchanting":"6080|~","better-snowball-fight":"6082|更好的打雪仗 (Better Snowball Fight)|1323495","onastick":"6083|~","tradernpcs":"6084|~","more-pads":"6085|更多Pad (More Pads)|1323848","texture-dump":"6086|~","spartan-weaponry-ice-and-fire":"6087|斯巴达的武器：冰火传说 (Spartan Weaponry: Ice and Fire)","hefty-crops":"6088|~","worldedit":"609|创世神 (WorldEdit)","custom-player-models-bukkit":"6090|自定义玩家模型 (Customizable Player Models)","extrachampions":"6091|强敌扩充 (ExtraChampions)|1325026","another-origins-mod":"6095|~","just-another-void-dimension":"6096|~","player-weight-mod":"6097|玩家重量 (Player Weight Mod)","chunk-loaders":"6098|区块加载器 (Chunk Loaders)","tinkerstages":"6099|~","the-twilight-forest":"61|暮色森林 (The Twilight Forest)|733312","eccentric-tome":"6101|~","arnicalib":"6102|~","gregicality-multiblocks":"6104|~","the-box-trot":"6106|~","better-biome-blend":"6107|~","forever-enough-items":"6108|FEI物品管理器 (Forever Enough Items)","chess":"6109|象棋 (Chess)","immersive-fx":"6110|~","ydms-weapon-master":"6111|YDM的武器大师 (YDM's Weapon Master)","galacticrafttweaker":"6112|~","moreleads":"6113|拴绳增强 (More Leads)","simple-discord-rpc":"6115|~","excore":"6117|~","messmod":"6118|~","log4j2-jndi-exploit-fix":"6119|~","worldeditcui-fabric":"612|~|1013295","woodcutter-forge":"6120|~","origins-classes-forge":"6121|起源：职业非官方Forge版 (Origins: Classes (Forge))","tool-stats":"6122|~","thatched":"6123|~","fumo-mod":"6124|~","basement-origins":"6125|~","no-weak-attack":"6126|~","bettas":"6127|搏鱼 (Bettas)","baby-fat":"6128|婴儿肥 (Baby Fat)","quickplant-fabric":"6129|顷刻吐芽 (QuickPlant)","ztones":"613|~","infinite-dungeons":"6130|~","wpo-addon-mod":"6131|~","just-the-binding-of-isaac-pills":"6132|~","pendant-of-life":"6133|~","the-binding-of-isaac-tears-mod":"6134|~","humbling-bundle":"6135|~","grindstone-sharper-tools":"6136|~","nutritious-milk":"6137|~","extract-poison-fabric":"6138|~","zombie-villagers-from-spawner":"6139|~","vine-climber":"6140|~","healing-soup-fabric":"6141|~","idas":"6142|~","mob-sunscreen":"6143|~","decorative-winter":"6145|~","looot":"6146|~","wmch":"6147|~","block-event-separator":"6148|~","no-damage-immunity-reload":"6149|伤害免疫机制移除重制版 (No Damage Immunity Reload)","dummycore":"615|~","sheve":"6150|~","chromatic-currents":"6151|~","dropfullcarts":"6152|~","are-you-blind":"6153|~","alwayseat-reload":"6154|吃不停重制版 (AlwaysEat Reload)","tps-hud-fabric":"6156|~","orcz":"6158|~","sandwichable":"6159|~","extra-utilities":"616|更多实用设备|377817","mod-erate-loading-screen":"6161|~","shrink_":"6162|~","cable-tiers":"6163|~","jumbo-furnace":"6164|~","no-villager-death-messages":"6165|~","tank-null":"6166|~","trajans-tanks-fabric-wip":"6167|~","colds-easy-paxel-lite":"6168|~","openmodslib":"617|开放式模组库 (OpenModsLib)","smooth-chunk-save":"6170|平滑区块保存 (Smooth Chunk Save)","rigoranthus-emortis-mod-compatibility-progression":"6171|~","jei-utilities":"6172|JEI实用设备 (JEI Utilities)","plummet":"6173|~","stackone-mod":"6174|禁止堆叠 (StackOne)|1328904","spectrum":"6175|光谱世界 (Spectrum)|1342883","kitteh6660s-morecraft":"6176|~","angel-ring":"6177|天使指环 (Angel Ring)","nomowanderer":"6179|~","embers":"618|余烬 (Embers)","allthecompressed":"6180|~","cave-enhancements":"6181|~","creative-apiary":"6182|创造蜂场 (Creative Apiary)","creative-crafter":"6183|~","mcmod-search-reborn":"6184|MC百科资料搜索-重生 (MCMOD Search Reborn)","proxy-server":"6185|~","multithreaded-noise":"6186|~","spelling-table-mod":"6187|拼写台 (Spelling Table Mod)","advancedchatcore":"6189|~","neat":"619|极简血量显示 (Neat)|938958","dirt-deco":"6190|~","multiblocked":"6191|~","arcanus":"6192|~","armor-weight":"6193|~","all-the-tweaks":"6194|~","runelic":"6195|~","alexs-cloud-storage":"6196|云存储 (Cloud Storage)","visuality":"6197|~","ecologics":"6198|丰富的生态 (Ecologics)","mob-scarecrows":"6199|~","mob-properties":"620|怪物属性 (Mob Properties)","trolls-community":"6200|~","g4mespeed":"6201|~","ogres-community":"6202|~","goblin-community":"6203|~","kobolds-community":"6204|~","mutant-villager":"6205|~","pick-your-poison":"6206|~","illager-expansion-fabric":"6207|~","immersive-armors":"6208|沉浸式盔甲 (Immersive Armors)","seeds":"6209|~","ganys-surface":"621|Gany的世界 (Gany's Surface)|450171","unusual-drill":"6210|~","frosted-friends":"6211|~","hover-pets":"6212|~","ic2-patcher":"6213|~","useless-sword":"6214|~","jei-professions":"6215|~","atm-additions":"6216|~","extra-tags":"6217|额外标签 (Extra Tags)","advancedchatlog":"6218|~","crafting-station":"6219|合成站 (Crafting Station)","sons-of-sins":"6220|~","advancedchathud":"6221|~","fuzes-relics":"6222|~","chirpys-wildlife":"6223|~","megaparrot":"6224|~","nourish":"6225|~","village-box":"6226|村庄盒子 (Village Box)","waila-stages":"6227|~","steves-vanilla":"6228|~","ezstorage":"623|EZ存储 (EZStorage)","duckling":"6230|~","wandering-bag":"6231|~","friends-and-foes-forge":"6232|~","dynamic-trees-the-betweenlands":"6233|动态的树：交错次元附属 (Dynamic Trees - The Betweenlands)","pyrologer-and-friends":"6235|~","tree-hollows":"6236|~","solar-apocalypse-refabricated":"6237|~","ancient-beasts":"6240|上古凶灵/远古野兽 (Ancient Beasts)","easyauth":"6241|~","depth":"6242|~","slimy-stuff":"6243|~","netheriteroad":"6244|下界之路 (Netherite Road)","organics":"6245|~","kaliastyle":"6247|卡利亚式附魔 (CarianStyle)|1332545","wmitaf":"6249|~","intangible":"625|~","depth-meter":"6250|深度计 (Depth Meter)","omni-hopper":"6251|~","jumpy-boats":"6252|~","carpetclient":"6254|~","dynamic-trees-vampirism":"6256|动态的树：吸血鬼附属 (Dynamic Trees - Vampirism)","connectible-chains-forge":"6259|~","birds-nests-fabric":"6261|鸟巢Fabric版 (Birds Nests (Fabric))","hot-or-not-tfc":"6262|~","eye-of-dragons":"6263|~","paperdoll":"6264|纸娃娃 (PaperDoll)","little-logistics":"6265|~","show-me-what-you-got":"6266|~","herdspanic":"6267|~","extrasounds":"6268|~","brooms":"6269|~","forge-multi-part":"627|~","the-stormlight-archive-mod":"6270|飓光志 (The Stormlight Archive Mod)","extrae":"6271|~","projecte-integration":"6272|~","mekajs":"6273|~","antique-dragons":"6274|~","badpackets":"6275|~","undead-army":"6277|~","ironagefurniture":"6278|~","minekea-fabric":"6279|~","the-titans-mod":"628|泰坦生物 (The Titans)|730072","aeble":"6280|~","trident-mod":"6281|三叉戟 (Trident)","custom-professions":"6282|自定义村民职业 (Custom Villager Professions)","nextspring-fabric":"6284|化作春泥更护花 (NextSpring)","psionic-utilities":"6285|~","lucent":"6286|~","togglesneak":"6287|~","iron-apples":"6288|~","actually-additions-fluxified":"6289|~","enchiridion":"629|~","dank-storage-fabric":"6290|~","pixelgamewizards-banded-torches":"6291|~","dynamic-trees-byg":"6292|动态的树：你将去的生物群系附属 (Dynamic Trees - Oh The Biomes You'll Go)","comfort-magic":"6294|~","colored-lights-fabric":"6295|~","biomes-far-away":"6296|~","better-runtime-resource-pack":"6297|更好的运行时资源包 (Better Runtime Resource Pack)","natures-starlight":"6299|~","portal-gun":"63|传送枪 (Portal Gun)|777495","stimmedcow-nomorerecipeconflict":"630|合成冲突消除 (NoMoreRecipeConflict)|237776","alloygery-and-you":"6300|~","custom-game-rules":"6301|~","lava-walker":"6302|~","pretty-pipes":"6303|更好的管道 (Pretty Pipes)","victorymod":"6305|~","cryptic-assets-pack":"6306|~","dynamicregistries":"6307|~","among-us-mobs":"6308|~","among-us":"6309|在我们之中 (Among Us)","tinker-i-o":"631|工匠接口 (Tinker I/O)|727609","universal-ores-fabric":"6310|~","project-copper":"6312|~","pirates-and-looters-mod":"6313|~","itemchat":"6315|~","resident-evil-8-mod":"6317|生化危机8 (Resident Evil 8)|1206189","solar-forge":"6318|~","colored-allays":"6319|染色悦灵 (Colored Allays)","woot":"632|生物工厂 (Woot)","phantasm":"6321|~","roughly-enough-professions-rep":"6323|REI工作方块 (Roughly Enough Professions)","sophisticated-core":"6324|精妙核心 (Sophisticated Core)","edibles":"6325|~","reach-fix":"6326|~","lootjs-forge":"6327|~","chat-sounds":"6328|~","advancement-screenshot":"6329|~","all-loot-drops":"6330|~","better-taskbar":"6332|~","storage-network":"6333|~","snr-more-metal":"6336|~","gate-of-babylon":"6337|王之财宝 (Gate of Babylon)","evocation":"6339|~","the-illusioners-cabin":"6340|~","gw-pillager-outpost":"6341|~","mercs-and-menaces":"6342|~","illage-and-spillage":"6343|~","more-illagers":"6344|~","probably-chests":"6345|~","illager-plushies-fabric":"6346|~","pillageplunder":"6347|~","extended-illagers-mod":"6348|~","realistic-terrain-generation":"635|真实地形生成 (Realistic Terrain Generation)|681294","wonderful-enchantments":"6350|~","a-lot-of-useless-stuff":"6351|~","lankaster-origins":"6352|~","priority-target":"6355|优先目标 (Priority Target)","advanced-botany":"6356|~","charred":"6357|~","incorporeal-3":"6358|幻想多媒体3 (Incorporeal 3)","mob-rebirth":"636|怪物重生 (Mob Rebirth)|519229","oxygen":"6361|氧 (Oxygen)","better-combat-revamped":"6362|沉浸式战斗 (Immersive Combat)","mystical-index":"6364|~","combat-commons":"6365|~","corail-woodcutter":"6366|~","nolocalizationconflict":"6368|本地化冲突消除 (NoLocalizationConflict)","enhanced-celestials-mobifier-integration-fabric":"6369|~","diseasecraft":"637|疾病 (Disease Craft)|406682","twilightdecor":"6370|~","midas-hunger-fabric":"6371|~","pretty-pistons":"6373|~","more-beautiful-trapdoors":"6374|~","project-expansion":"6375|~","the-corners":"6376|~","deep-mob-learning-reforged":"6377|深度怪物学习：重铸 (Deep Mob Learning: Reforged)","apotheosis-fabric":"6378|神化Fabric版 (Apotheosis (Fabric))","extended-drawers":"6379|~","zombie-infection":"638|僵尸感染 (Zombie Infection)|410512","supplementary-accessories":"6380|~","never-enough-currency-fabric":"6381|货币多多2 (Never Enough Currency 2)","quartz-chests":"6382|石英箱子 (Quartz Chests)","frozen-delight":"6383|冰封乐事 (Frozen Delight)","clean-creative-mod":"6385|~","this-rocks-forge":"6386|~","motschens-puddles":"6387|~","dense-ores-reborn":"6388|致密矿石：重生 (Dense Ores Reborn)","astral-sorcery":"639|星辉魔法 (Astral Sorcery)","tfctreatedwood":"6390|群峦·防腐木 (TFC Treated Wood)","double-hotbar":"6392|双重快捷栏 (Double Hotbar)","lavatech":"6393|熔岩科技 (Lava Tech)","fragile-torches":"6395|~","come-closer":"6397|~","creeper-chain-reaction":"6398|~","tiffitlib":"6399|~","simpleores":"64|简单矿石 (SimpleOres)","neotech":"640|全新科技 (NeoTech)","sanity":"6400|~","dynamic-trees-the-aether-legacy":"6402|动态的树：天境附属 (Dynamic Trees - The Aether Legacy)","dynamic-trees-cuisine":"6403|动态的树：料理工艺附属 (Dynamic Trees - Cuisine)","ancient-classes":"6404|~","bigger-stacks":"6405|~","silence":"6406|快速静音 (Silence!)","dynamic-trees-extra-utilities-2":"6407|动态的树：更多实用设备2附属 (Dynamic Trees - Extra Utilities 2)","platforms-fabric":"6408|~","easierchests":"6409|简便箱子 (EasierChests)","apocalypse-mod":"641|启示录 (Apocalypse)|433738","crackers-wither-storm-mod":"6410|Cracker的凋灵风暴 (Cracker's Wither Storm)","ore-canes-mod":"6411|~","spartan-defiled":"6412|~","mcmtfabricce":"6413|Minecraft多线程增强Mod兼容性增强分支 (Minecraft Multi-Threading Mod Fabric Port Compatibility Enhancement)","dynamic-trees-roots":"6414|动态的树：根源魔法附属 (Dynamic Trees Roots)","dynamic-trees-voyage":"6415|动态的树：Voyage附属 (Dynamic Trees - Voyage)","mystical-biomes":"6416|~","forgero":"6418|~","disenchantingforge":"6419|~","bookshelf-api-library":"642|~","redstone-pen":"6420|红石笔 (Redstone Pen)","ae2-things-forge":"6421|~","endless-fake":"6422|无尽贪婪·伪 (Endless)","dynamic-trees-jurassicraft":"6423|动态的树：侏罗纪时代附属 (Dynamic Trees - JurassiCraft)","dynamic-trees-natures-aura":"6424|动态的树：自然灵气附属 (Dynamic Trees - Nature's Aura)","dynamictreesplus":"6425|动态的树：拓展 (Dynamic Trees +)","dynamic-trees-forbidden-arcanus":"6426|动态的树：禁忌与奥秘附属 (Dynamic Trees - Forbidden And Arcanus)","dynamic-trees-terraforged":"6427|动态的树：TerraForged附属 (Dynamic Trees - TerraForged)","dynamic-trees-corvus":"6428|动态的树：Corvus附属 (Dynamic Trees - Corvus)","dynamic-trees-mystical-biomes":"6429|~","corvus":"6430|~","goat-horns-copper-horns":"6431|山羊角与铜制号角 (Goat Horns & Copper Horns)","mystical-powers":"6432|~","wooden-bucket":"6435|木桶 (Wooden Bucket)","compressed-barrels":"6436|压缩木桶 (Compressed Barrels)","advanced-netherite-fabric":"6438|高级下界合金 (Advanced Netherite)","avaritia-reforged":"6439|无尽贪婪：重铸 (Avaritia:Reforged)","movingworld":"644|~","simply-conveyors-more":"6440|简易传送带 (Simply Conveyors & More)","expanded-delight":"6442|~","spell-bundle":"6443|~","nightmareesm":"6444|~","simply-no-shading":"6445|~","hexcasting":"6446|~","paucal":"6447|~","uneffectual":"6448|~","loot":"6449|~","botania-garden-of-glass":"645|水晶花园 (Garden of Glass)|541959","crafting-dead-immerse":"6450|行尸走肉：沉浸 (Crafting Dead: Immerse)","extended-clouds":"6452|~","distinct-damage-descriptions":"6453|~","technicalities-lib":"6454|~","fantasys-furniture":"6455|Fantasy的家具 (Fantasy's Furniture)","touhou-spell-card-additional":"6456|东方符卡附加包 (Touhou Spell Card Additional Pack)","registrator":"6457|~","apexcore":"6458|~","magiclib":"6459|~","cull-less-leaves":"6460|更好的树叶渲染优化 (Cull Less Leaves)","with-craft":"6462|手工艺 (With Crafts)","fluidconverters":"6463|流体转化器 (FluidConverters)","multiblock-stages":"6464|~","waterskin":"6467|~","realism-thirst":"6468|~","dungeons-libraries":"6469|~","tiny-progressions":"647|微型自动化 (Tiny Progressions)","dynamic-trees-for-hungteens-plants-vs-zombies-mod":"6475|动态的树：HungTeen的植物大战僵尸附属 (Dynamic Trees for PVZ)","elemental-items":"6477|~|456944","onekeyminer":"6479|一键矿工 (OneKeyMiner)|1342383","boathud":"6480|~","ninjaxxs-needs":"6481|~","pixelmon-gui-blocks":"6482|~","more-mekanism-processing":"6484|~","item-banning":"6485|~","probejs":"6486|~","impaled":"6487|更多三叉戟 (Impaled🔱)","laserio":"6488|~","villager-tools":"6489|~","baubles-stuff":"649|更多首饰 (Baubles Stuff)|620576","mcsa":"6491|~","slime-mimic":"6494|~","ldlib":"6498|~","shimmer":"6499|微光 (Shimmer)","smart-moving":"65|灵活动作 (Smart Moving)|292877","thaumaturgical-knowledge":"650|神秘奥义 (Thaumaturgical Knowledge)|690813","ducts":"6500|~","nosiphus-furniture-mod":"6503|~","tf2-engineer-buildings-mod":"6504|~","kubejs-botania":"6505|~","advancements-enlarger":"6506|~","better-muffling":"6507|更好的消音器 (Better Muffling)","lightest-lamps-fabric":"6508|~","bigbuckets-fabric":"6509|大铁桶 (Big Buckets)","advanced-thaumaturgy-2":"651|高等神秘学 (Advanced Thaumaturgy 2)","dimstorage":"6510|~","spawner-imbuer":"6511|~","unnamed-delight":"6513|~","monsters-girls-mushroom-update":"6515|~","ftb-tutorial-mod-forge":"6516|~","mc-terrain-editor":"6517|~","extra-gems":"6518|额外的宝石 (ExtraGems)","various-world":"6519|~","INpureCore":"652|~","better-impaling-forge":"6520|更好的穿刺Forge版 (Better Impaling Forge)","bucketlib":"6521|~","aquatic-torches":"6522|~","better-sponges":"6523|~|1343107","easyexcavate":"6524|~","wooden-shears":"6525|木剪刀 (Wooden Shears)","brick-furnace":"6526|砖熔炉 (Brick Furnace)","brick-hopper":"6527|砖漏斗 (Brick Hopper)","human-companions":"6528|~","odysseyhud":"6529|~","atomicstrykers-battle-towers":"653|战斗高塔 (AtomicStryker's Battle Towers)|142832","colorblindness":"6530|~","aether-addon":"6531|~","server-redirect":"6534|~","city-blocks":"6535|~","useful-hats":"6536|~","modern-splash":"6538|高版本加载界面 (Modern Splash)","babel":"6539|~","reborncore":"654|重生核心 (Reborn Core)","ivan-carpet-addition":"6543|~","food-funk":"6544|~|1189925","wumpleutil":"6545|~","recruits":"6547|~","the-true-backrooms":"6548|~","webstreamer":"6549|~","steves-carts-reborn":"655|史蒂夫矿车：重生 (Steve's Carts Reborn)|728591","op-items-tab":"6550|~","treechop":"6554|~","entity-collision-fps-fix-fabric":"6556|~","hollowwoods":"6557|~|1346623","dynamic-crosshair":"6559|~","refined-relocation":"656|简单分类 (Refined Relocation)","raiders":"6560|~","better-animals-plus-plus":"6561|~","block-overlay-fix":"6562|~","mini-effects-fabric":"6563|~","nature-overhaul":"6564|~","ae2-fluid-crafting-rework":"6565|AE2流体合成套件重置 (AE2 Fluid Crafting Rework)","better-village-fabric":"6569|~","gilded-games-util":"657|~","transparent-cosmetics":"6573|~","right-click-get-crops":"6575|~","oh-my-gourd":"6576|~","v0ids-smart-backpacks":"6579|V0id的智能背包 (V0id's Smart Backpacks)","dangerrpg":"658|危险RPG (Danger RPG)","better-f1":"6585|更好的F1 (Better F1)","removehudbutnothand":"6586|~","tool-part-stages":"6587|~","iron-backpacks-redone":"6589|特殊背包重做版 (Iron Backpacks Redone)","malisisdoors":"659|更多门 (MalisisDoors)","b0bgarys-biome-remover-v-1-0-0-1":"6590|B0bGary的生物群系禁用器 (B0bGary's Biome Remover)","dualwielding":"6591|~","easycrafting":"66|轻松合成 (Easy Crafting)","starflight-innovation":"6604|~","better-rocks":"6609|~","jaffa-foods-a-harvestcraft-addon":"661|更多有趣的食物 (Just Another Fun Food Addon)|500121","horse-combat-controls":"6610|~","simply-houses":"6612|~|1348787","yungs-better-desert-temples-fabric":"6613|YUNG的沙漠神殿优化 (YUNG's Better Desert Temples)","modern-dynamics":"6614|现代动力学 (Modern Dynamics)","doggo-mod":"6615|~","tan-huge-trees":"6616|~","yungs-better-witch-huts-fabric":"6618|YUNG的沼泽小屋优化 (YUNG's Better Witch Huts)","panorama-creator":"6619|全景图创建器 (Panorama Creator)","thermal-smeltery":"662|热力冶炼厂 (Thermal Smeltery)","ui-input-undo-forge":"6620|~","paimeng":"6621|应急食物 (PaiMeng)","nyfs-quivers-expanded":"6622|~","zoomify":"6624|~","golemania":"6625|~","sledgehammer":"6627|~","quilt-loading-screen":"6628|Quilt加载画面 (Quilt Loading Screen)","amethyst-imbuement":"6629|~","nuclear-contraptions":"6631|~","tooltiptweaks":"6633|~","more-babies":"6635|~","armor-visibility":"6639|~","malisiscore":"664|~","the-chicken-came-first":"6641|先有鸡 (The Chicken Came First)","hardcore-dungeons":"6643|~","block-relocation-forge":"6644|~","norecipebook-fabric":"6645|没有配方书Fabric版 (NoRecipeBook (Fabric))","fpsdisplay":"6647|~","microdurability":"6649|~","valkyrielib":"665|~","fishy-delight-a-farmers-delight-add-on":"6651|~","simple-delights":"6652|~","color-me-outlines":"6653|~","upstream-fabric":"6656|~","astemirs-fireflies":"6657|~","ender-crop":"6659|~","waila-harvestability":"666|~","modupdater":"6660|~","fivehead":"6661|~","attained-drops":"6663|可种植掉落物 (Attained Drops)","attained-drops-2":"6664|可种植掉落物2 (Attained Drops 2)","auth-me":"6666|~","runesword":"6669|~","mixed-magic":"667|混合魔法 (Mixed Magic)","autopackager":"6671|~","dynamx":"6672|~","mob-cards":"6673|~","mavm":"6674|~","hidden-names":"6676|隐藏名称 (Hidden Names)","doph":"6677|~","keybinds":"6678|~","hwyla":"668|~|648893","raven-brews-core":"6681|~","raven-coffee":"6682|Raven咖啡 (Raven Coffee)","cqc":"6683|~","geode":"6684|~","realistic-spiders":"6685|真实蜘蛛 (Realistic Spiders)","biome-particle-weather":"6687|~","ftb-backups-2":"6688|FTB备份2 (FTB Backups 2)","crafttweaker":"669|~|769481","illagers-wear-armor":"6692|~","hudium":"6693|~","cobblegen":"6695|~","zombie-extreme":"6696|~","modularmovements":"6697|模块化动作 (ModularMovements)","uncle-js":"6698|~","wither-bones":"6699|~","sleep-warp":"6700|~","diagonal-fences":"6701|~","jumpy-boats-fabric":"6702|跳跃的船（Fabric/Quilt） (Jumpy Boats(Fabric/Quilt))","velocity-based-damage":"6704|~","no-telemetry":"6705|~","create-chromatic-return":"6708|~","coffee-spawner":"6709|~","real-time-chat-translation-mod":"671|实时聊天翻译 (Real Time Chat Translation Mod)","timber-mod":"6710|~","sophisticated-storage":"6711|精妙存储 (Sophisticated Storage)","advanced-lootable-weapons#c6":"6712|~","what-the-bucket":"6713|~","quickhomes":"6714|~","real-time-clock":"6715|~","tardim":"6716|~","aether-extra-structure":"6717|天境结构拓展 (Aether Extra Structures)","luckytnt":"6719|~","pickle-tweaks":"6721|~","dps-chaoscraft":"6722|~","moyai":"6724|~","mega-meteors-mod":"6725|~","mixinbootstraplegacy":"6728|~","freecam":"6729|~","practical-logistics-2":"673|实用物流监控2 (Practical Logistics 2)","fishing-overhaul":"6733|~","kronhud":"6734|~","shared-ender-chest":"6735|~","no-beacon-beams":"6736|~","farmers-respite":"6737|农夫暇事 (Farmer's Respite)","crafting-mania":"6739|~","energyadditions":"674|高级能源 (EnergyAdditions)","loot-goblins":"6740|~","skylib":"6741|~","tbscclick":"6743|~","modern-elevators-and-escalators":"6744|现代电梯与扶梯 (Modern Elevators and Escalators)","extra-inventory":"6746|~","chroma-concrete":"6747|~","dracovita-delight-a-farmers-delight-add-on":"6748|~","gobber-delight-a-farmers-delight-add-on":"6749|~","advanced-generators":"675|高级发电机 (Advanced Generators)","bdlib":"676|~","pressure-pipes":"678|压力管道 (Pressure Pipes)","onlinepictureframe":"679|在线相框显示 (OnlinePictureFrame)","super-circuit-maker":"680|超级电路 (Super Circuit Maker)","switch-bow":"681|~","minecolonies":"682|模拟殖民地 (Minecolonies)|1169256","mcjtylib":"684|~","mcmultipart":"685|~","aroma1997s-dimensional-world":"686|Aroma1997的维度世界 (Aroma1997's Dimensional World)","akashic-tome":"688|阿卡什宝典 (Akashic Tome)|805606","morph-o-tool":"689|变形工具 (Morph-o-Tool)","decocraft":"690|装饰工艺 (Decocraft)","refined-storage":"691|精致存储 (Refined Storage)|612538","deep-resonance":"692|深度共振 (Deep Resonance)","clockwork-phase":"696|时之沙 (Clockwork Phase)","autoreglib":"698|~","roots":"699|根源魔法 (Roots)","guide-api":"700|指南 (Guide-Api)","fraghappy-reborn":"701|~","genetics-reborn":"702|基因重生 (Genetics Reborn)","router-reborn":"704|路由重生 (Router Reborn)","coroutil":"706|~","vanilla-magic":"707|原生魔法 (Vanilla Magic)","taoism":"708|御灵 (Taoism)|668355","essentialcraft-4-unofficial":"709|源质魔法4非官方版 (EssentialCraft 4 Unofficial)","computercraft":"71|电脑 (Computer Craft)|473694","celestial-craft":"710|天体 (Celestial Craft)","lost-thaumaturgy":"711|失落神秘 (Pengu's Lost Thaumaturgy)","compact-machines":"712|更多空间/压缩空间 (Compact Machines)","ex-nihilo-omnia":"714|无中生有-世间万物 (Ex Nihilo Omnia)|631637","last-sword-you-will-ever-need-mo":"715|最终之剑 (The Last Sword You Will Ever Need Mod)","the-last-sword-you-will-ever-need-reboot":"716|最终之剑：重生 (The Last Sword You Will Ever Need Reboot)","ftb-library-legacy-forge":"718|FTB Library（旧版） (FTB Library (Forge) (Legacy))","thaumic-potatoes-2":"721|神秘土豆2 (Thaumic Potatoes 2)","extraplanets":"722|额外行星 (Extra Planets)|799074","xtracraft-mod":"724|X工艺 (XtraCraft Mod)","icbm-classic":"727|洲际导弹经典版 (ICBM - Classic)","voltz-engine":"728|~","blocklings":"729|方块酱 (Blocklings)|831446","inventory-tweaks":"73|R键整理 (Inventory Tweaks)|877466","sbm-wooden-shears":"734|木剪刀 (Wooden Shears)","schools-of-magic":"736|魔法学院 (Schools of Magic)","aether-aspects":"737|天境要素扫描 (Aether Aspects)","arcane-arteries":"738|奥法献祭学 (Arcane Arteries)","thaumic-palmistry":"739|~","one-click-crafting":"740|一键合成 (One click crafting)|943364","essential-thaumaturgy-unofficial":"741|源质神秘学（非官方版） (Essential Thaumaturgy Unofficial)","wireless-crafting-terminal":"742|无线合成终端 (Wireless Crafting Terminal)","waila-plugins":"743|Waila插件 (Waila Plugins)","appleskin":"744|苹果皮 (AppleSkin)|1141428","tcbotaniaexoflame":"745|奥术投射 (TCBotaniaExoflame)","thaumic-equivalence":"746|奥法置换 (Thaumic Equivalence)","thaumcraft-research-helper":"747|神秘研究小助手 (Thaumcraft Research Helper)","thaumic-upholstry":"748|神秘装饰 (Thaumic Upholstry)","thaumic-expansion":"749|神秘膨胀 (Thaumic Expansion)","minecraft-minions":"75|召唤奴仆 (Minecraft Minions)","nodal-mechanics":"750|节点力学 (Nodal Mechanics)","transmute-liquids-addon-for-thaumcraft-4":"751|液体嬗变 (Transmute Liquids)","thaumores":"752|奥能矿物 (ThaumOres)","notenoughthaumcrafttabs":"753|无限神秘标签页 (Not Enough Thaumcraft Tabs)","natures-compass":"754|自然罗盘/生物群系指南针 (Nature's Compass)|977694","warp-theory":"755|神秘扭曲学 (Warp Theory)","hammer-lib":"756|锤子核心 (Hammer Core/Hammer Lib)","thermal-casting":"758|热力铸造室 (Thermal Casting)","thermal-smeltery-redux":"759|热力冶炼厂重置版 (Thermal Smeltery Redux)","ender-storage-1-8":"76|末影存储 (Ender Storage)|870812","brcore":"760|~","industrial-expansion-te-addon":"761|工业扩充（TE附属） (Industrial Expansion [TE Addon])","spmodapi":"764|~","quantum-pack":"765|量子工具包 (Quantum Pack)","netherores":"766|下界矿石 (NetherOres)","tesla":"767|特斯拉 (TESLA)","vanillafoodpantry-mod":"768|食品储藏室 (VanillaFoodPantry Mod)|683091","the-elysium":"769|极乐世界 (The Elysium)","ice-and-fire-dragons":"770|冰火传说 / 冰与火之歌 (Ice and Fire)|847008","yabba":"772|~","useful-nullifiers":"773|实用销毁器 (Useful Nullifiers)","xtones":"774|~","xnet":"775|~","wireless-crafting-grid":"776|无线合成网络 (Wireless Crafting Grid)","top-addons":"778|~","torchmaster":"779|火炬大师 (Torchmaster)","ZeroCore":"780|~","sleeping-bag":"781|睡袋 (Sleeping Bag)","the-one-probe":"782|检测器 (The One Probe)|1155343","simply-jetpacks-2":"784|简易喷气背包2 (Simply Jetpacks 2)","snad":"785|子沙 (Snad)","storage-drawers-extras":"786|~","solar-flux-reborn":"787|日光通量：重制版 (Solar Flux Reborn)","simple-void-world":"788|简单虚空世界 (Simple Void World)|1089311","shetiphiancore-fabric":"789|~","shadowmc":"790|~","scannable":"791|扫描器 (Scannable)|692037","rebornstorage":"792|存储重置 (Reborn Storage)","quantumstorage":"793|量子存储 (QuantumStorage)","p455w0rds-library":"794|~","mtlib":"795|~","open-glider":"797|滑翔翼 (Open Glider)","mputils":"798|~","shadowfacts-forgelin":"799|~","eleccore":"800|ElecCore - Rendering Library","infinitylib":"801|~","dark-utilities":"802|~","flux-networks":"803|通量网络 (Flux Networks)","flat-colored-blocks":"804|平滑色块 (Flat Colored Blocks)","jei-bees":"805|~","chisels-bits-for-fabric":"806|雕凿工艺 (Chisels & Bits)","architecturecraft":"807|建筑师工艺 (Architecture Craft)","chameleon":"808|变色龙 (Chameleon)","mrtjpcore":"809|~","cyclops-core":"810|~","netherportalfix-fabric":"811|下界传送门修正 (NetherPortalFix)|1004332","rftools-dimensions":"812|RF工具：维度 (RFTools Dimensions)","signals":"813|信号 (Signals)","extreme-reactors":"814|极限反应堆 (Extreme Reactors)|841782","et-lunar-environmental-tech-addon":"815|ET：月光发电 (Environmental Lunar Tech)","angel-ring-to-bauble":"816|可装备的天使指环 (Angel Ring To Bauble)","mob-grinding-utils":"817|刷怪塔实用设备 (Mob Grinding Utils)","rftools-control":"818|RF工具：控制 (RFTools Control)","immersive-petroleum":"819|沉浸原油 (Immersive Petroleum)","more-shearables":"820|更多的剪刀用途 (More Shearables)","gregtech-gt-gtplusplus":"821|~","teletoro":"829|远程传送 (TeleToro)","re-zero-kara-hajimeru-isekai-seikatsu":"831|RE:从零开始的异世界 (Re: Zero kara hajimeru isekai seikatsu)","minewatch":"832|~|730508","thaumcraft-inventory-scanning":"833|神秘时代物品栏扫描 (Thaumcraft Inventory Scanning)","cyclic":"834|循环 (Cyclic)|648189","redstoneplusplus":"836|红石++ (Redstone++)","ctm":"837|连接纹理 (ConnectedTexturesMod)","simulated-nights":"838|夜晚模拟 (Simulated Nights)","ftb-utilities":"839|FTB 实用工具 (FTB Utilities)","just-enough-characters":"840|通用拼音搜索 (Just Enough Characters)|639271","redstone-flux":"842|~","cofh-world":"843|~","ancient-warfare-2":"844|古代战争2 (Ancient Warfare2)|665422","integrated-dynamics":"845|动态联合/集成动力 (Integrated Dynamics)","common-capabilities":"846|~","tan-campfire-spit":"848|意志坚定-篝火烤架 (TAN Campfire Spit)","super-solar-panels":"849|超级太阳能发电机 (Super Solar Panels)|699953","rotarycraft":"85|旋转工艺 (RotaryCraft)","ngtlib":"850|~","geomastery":"851|征服大地 (Geomastery)","afsu-mod":"852|~","lightningcraft":"854|雷电工艺 (LightningCraft)|692998","just-enough-resources-jer":"855|~","morpheus":"856|~","wall-jump-fabric":"857|飞檐走壁 (Wall Jump)","condensed-block-mod-reborn":"858|凝结成块 (Condensed Block Mod Reborn)|359511","refined-avaritia":"859|~","weather-storms-tornadoes":"860|局部气候&风暴 (Weather, Storms & Tornadoes)","new-things":"861|~","survivalist":"862|生存主义 (Survivalist)","mystic-divination":"863|秘契占星术 (Mystic Divination)","cofh-lib":"864|~","tabula-rasa":"865|~","cofhtweaks":"866|~","ender-zoo":"867|末影动物园 (Ender IO Zoo)","simple-usage-log":"868|简易日志 (Simple Usage Log)","omnis-core":"869|~","applied-energistics-1":"87|应用能源 (Applied Energistics)|378640","auto-paths":"870|自动路径 (Auto Paths)","react":"871|~","shared-resource-packs":"872|共享材质包 (Shared Resource Packs)","i-know-what-im-doing":"873|我知道我在干什么 (I Know What I'm Doing)","Leather-Works":"874|皮革加工厂 (Leather Works)","cyberware":"875|机械改造 (Cyberware)|618353","thermal-cultivation":"876|热力农业 (Thermal Cultivation)","better-builders-wands":"877|更好的建筑之杖 (Better Builder's Wands)|831822","jaopca":"878|~","chickens":"879|更多鸡 (Chickens)|570570","tragicmc2":"880|悲惨世界2 (TragicMC2)|643050","mobdrip":"881|~","customskinloader":"883|万用皮肤补丁 (CustomSkinLoader)|102922","saltymod":"884|盐 (SaltyMod)|562144","mct-immersive-technology":"885|沉浸科技 (Immersive Technology)|724918","funky-locomotion":"887|~","compatlayer":"888|版本兼容 (CompatLayer)","wopper":"889|木制漏斗 (Wopper)","gorgecore":"890|食用强化 (GorgeCore)","chineseworkshop":"891|中式工坊 (Chinese Workshop)|639428","modular-routers":"892|模块化路由器 (Modular Routers)","darkcore":"893|暗黑核心 (Darkcore)","tardis-mod":"894|时间和空间的相对维度 (TARDIS MOD)","another-one-bites-the-dust-berry-bushes":"897|~","gokistats":"898|天赋技能树 (GokiStats)|674690","tropicraft":"900|热带世界 (Tropicraft)","sumsang":"903|亖圼 (Sumsang)","moblocks":"904|~","creepypasta-1-0-0":"905|蠕动意面 (CreepyPasta)","grue":"906|~","googlyeyes":"908|金鱼眼 (GooglyEyes)","lycanites-mobs":"909|恐怖生物 (Lycanites Mobs)|980282","back-to-eco":"910|生态回归 (Back to Eco)","world-of-warcraft":"911|魔兽世界 (World Of Warcraft)","the-witcher-adventure":"912|猎魔人 (The Witcher Adventure)","fancy-battleaxes":"913|华丽战斧 (Fancy Battleaxes)","zora-no-densha":"914|Zora的电车 (Zora no Densha)|1085883","roguelike-dungeons":"915|冒险地牢 (Roguelike Dungeons)|300785","first-aid":"916|医疗护理 (First Aid)|850687","bonfires":"917|篝火 (Bonfires)|772983","immersive-craft":"918|沉浸工艺 (Immersive Craft)","aroma1997core":"919|~","Universal-Electricity":"92|通用电力 (Universal Electricity)|405261","tatw":"920|~","hostile-mobs-and-girls":"921|敌对生物和女孩们 (Hostile Mobs and Girls)","better-hud":"922|更好的HUD (Better HUD)","custom-stuff-4":"923|自定义物品4 (Custom Stuff 4)","powered-thingies":"924|特斯拉科技 (Tesla Powered Thingies)","mcmusicplayer#t1:description":"926|~","obsidian-suite":"927|~","wizards-of-lua":"928|Lua魔导师 (Wizards of Lua)","mystical-agriculture":"929|神秘农业 (Mystical Agriculture)|707360","vampirism-become-a-vampire":"930|吸血鬼/血族传说 (Vampirism)|982006","itemphysic":"932|物品物理掉落 (ItemPhysic)","minenautica":"933|~","improved-extraction":"934|矿物获取改进 (Improved Extraction)","ecology-mod":"935|生态 (Ecology Mod)","cakeisalie-mod":"936|蛋糕是个谎言 (CakeIsALie)","ex-nihilo-adscensio":"937|无中生有:Adscensio (Ex Nihilo Adscensio)","bookshelf":"938|~","the-aether":"94|天境 (The Aether)|797941","random-things":"940|随意作品 (Random Things)|938101","netherex":"942|下界拓展 (NetherEX)|918772","engender-mod":"943|召唤师 (Engender - The Age of Minecraft)|796593","better-questing":"944|更好的任务 (Better Questing)|695339","ct-mortar":"947|~","ct-watercan":"948|~","totemic":"949|图腾 (Totemic)|1073074","grimoire-of-alice":"950|爱丽丝的魔法书 (Grimoire of Alice)","journey-to-gensokyo":"951|幻想乡之旅 (Journey to Gensokyo)","danmakucore":"952|弹幕核心 (DanmakuCore)","angel-of-vengeance":"953|复仇天使 (Angel of Vengeance)","tammodized":"954|~","ex-nihilo-creatio":"955|无中生有：创世 (Ex Nihilo: Creatio)|727225","colossal-chests":"957|巨型箱子 (Colossal Chests)","auto-pickup":"958|自动拾取 (Auto Pickup)","all-u-want":"959|背包编辑器 (All-U-Want)","potion-core":"960|药水核心 (Potion Core)","solar-expansion":"961|~|541525","blue-power":"962|蓝石力量 (Blue power)|501014","redstone-armory":"963|红石军械库 (Redstone Armory)|600195","qmunitylib":"964|~","the-last-smith":"966|最后的太刀匠人 (The Last Smith)|710736","mineamp":"967|我的音乐 (MineAmp)","quiverbow-restrung":"968|~|283240","cookiecore":"969|~","assassincraft-assassins-creed-mod":"97|刺客信条 (AssassinCraft)|334358","farseek":"970|~","meecreeps":"971|使命必达先生 (MeeCreeps)","streams":"972|溪流 (Streams)","blockcraftery":"974|方块工匠 (Blockcraftery)","bedrockores":"975|基岩矿簇 (Bedrock Ores)|776822","chat-bubbles":"976|聊天泡泡 (Chat Bubbles)","refined-storage-addons":"977|精致存储附属 (Refined Storage Addons)","foamfix-for-minecraft":"978|泡沫修复 (FoamFix)|678442","industrial-foregoing":"979|工业先锋 (Industrial Foregoing)|774112","expanded-armory":"980|扩展装备 (Expanded Armory)","voxelmap":"981|体素地图 (VoxelMap)|177583","mowzies-mobs":"984|Mowzie的生物 (Mowzie's Mobs)","thaumcraft-mob-aspects":"985|更多要素 (More Aspects/Polybius)","magical-psi":"986|~","starcraft-mod-scmc":"987|星际争霸2 (StarCraft II in MineCraft)","covens-reborn":"988|~","grappling-hook-mod":"989|抓钩 (Grappling Hook Mod)","custom-recipes":"99|自定义合成表 (Custom Recipes)","tabbychat-2":"990|~","yoyos":"992|悠悠球 (Yoyos)|932192","cd4017be-library":"993|~","iberia":"994|~","reforged":"995|重铸 (Reforged)|774739","cavern":"996|洞穴 (Cavern)|775036","block-drops-jei-addon":"997|~","iron-tanks":"998|铁储罐 (Iron Tanks)|776893","colorutility#t1:description":"999|颜色代码 (ColorUtility)"} \ No newline at end of file diff --git a/Plain Craft Launcher 2/Resources/NAudio.dll b/Plain Craft Launcher 2/Resources/NAudio.dll new file mode 100644 index 0000000..9dd5ae7 Binary files /dev/null and b/Plain Craft Launcher 2/Resources/NAudio.dll differ diff --git a/Plain Craft Launcher 2/Resources/Newtonsoft.Json.dll b/Plain Craft Launcher 2/Resources/Newtonsoft.Json.dll new file mode 100644 index 0000000..8069902 Binary files /dev/null and b/Plain Craft Launcher 2/Resources/Newtonsoft.Json.dll differ diff --git a/Plain Craft Launcher 2/Resources/Ookii.Dialogs.Wpf.dll b/Plain Craft Launcher 2/Resources/Ookii.Dialogs.Wpf.dll new file mode 100644 index 0000000..29accf8 Binary files /dev/null and b/Plain Craft Launcher 2/Resources/Ookii.Dialogs.Wpf.dll differ diff --git a/Plain Craft Launcher 2/Resources/STUN.dll b/Plain Craft Launcher 2/Resources/STUN.dll new file mode 100644 index 0000000..082d220 Binary files /dev/null and b/Plain Craft Launcher 2/Resources/STUN.dll differ diff --git a/Plain Craft Launcher 2/Resources/forge-installer.jar b/Plain Craft Launcher 2/Resources/forge-installer.jar new file mode 100644 index 0000000..1f650ad Binary files /dev/null and b/Plain Craft Launcher 2/Resources/forge-installer.jar differ diff --git a/Plain Craft Launcher 2/Resources/transformer.jar b/Plain Craft Launcher 2/Resources/transformer.jar new file mode 100644 index 0000000..3ea51be Binary files /dev/null and b/Plain Craft Launcher 2/Resources/transformer.jar differ diff --git a/Plain Craft Launcher 2/app.manifest b/Plain Craft Launcher 2/app.manifest new file mode 100644 index 0000000..bb8082f --- /dev/null +++ b/Plain Craft Launcher 2/app.manifest @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +