diff --git a/Plain Craft Launcher 2/Application.xaml b/Plain Craft Launcher 2/Application.xaml index 7a25967..c10b711 100644 --- a/Plain Craft Launcher 2/Application.xaml +++ b/Plain Craft Launcher 2/Application.xaml @@ -345,7 +345,7 @@ - + diff --git a/Plain Craft Launcher 2/Application.xaml.vb b/Plain Craft Launcher 2/Application.xaml.vb index a0ffcef..8c8a4cc 100644 --- a/Plain Craft Launcher 2/Application.xaml.vb +++ b/Plain Craft Launcher 2/Application.xaml.vb @@ -116,9 +116,9 @@ Public Class Application 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) + 'ServicePointManager.ServerCertificateValidationCallback = New Security.RemoteCertificateValidationCallback(Function() As Boolean + ' Return True + ' End Function) '计时 Log("[Start] 第一阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms") ApplicationStartTick = GetTimeTick() diff --git a/Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb b/Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb index d3ab372..5849df8 100644 --- a/Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyIconButton.xaml.vb @@ -133,7 +133,7 @@ Dim AnimList As New List(Of AniData) Select Case Theme Case Themes.Color - AnimList.Add(AaColor(Path, Shape.FillProperty, "ColorBrush5", AnimationColorOut)) + 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)) diff --git a/Plain Craft Launcher 2/Controls/MyListItem.xaml b/Plain Craft Launcher 2/Controls/MyListItem.xaml index 8bcf167..1624ab8 100644 --- a/Plain Craft Launcher 2/Controls/MyListItem.xaml +++ b/Plain Craft Launcher 2/Controls/MyListItem.xaml @@ -11,7 +11,7 @@ - + diff --git a/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb index ea0e10f..cdaff6f 100644 --- a/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyListItem.xaml.vb @@ -104,42 +104,34 @@ 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 + ''' + ''' 右边距的最小值。 + ''' 在存在右侧按钮时，右边距会被自动设置为 5 + 按钮数 * 25。 + ''' + Public Property MinPaddingRight As Integer = 4 '按钮 - Private _Buttons As IEnumerable - Public Property Buttons As IEnumerable + Private _Buttons As IEnumerable(Of MyIconButton) + Public Property Buttons As IEnumerable(Of MyIconButton) Get Return _Buttons End Get - Set(value As IEnumerable) + Set(value As IEnumerable(Of MyIconButton)) _Buttons = value '没有特殊按钮，移除原 Stack - If Not IsNothing(ButtonStack) Then + If ButtonStack IsNot Nothing 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 + Select Case value.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 + If Btn.Height.Equals(Double.NaN) Then Btn.Height = 25 + If Btn.Width.Equals(Double.NaN) Then Btn.Width = 25 With Btn .Opacity = 0 .Margin = New Thickness(0, 0, 5, 0) @@ -149,22 +141,18 @@ .SnapsToDevicePixels = False .UseLayoutRounding = False End With - SetColumn(Btn, 4) - SetColumnSpan(Btn, 4) - SetRowSpan(Btn, 4) + SetColumnSpan(Btn, 10) : SetRowSpan(Btn, 10) 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) + SetColumnSpan(ButtonStack, 10) : SetRowSpan(ButtonStack, 10) '构造按钮 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 + If Btn.Height.Equals(Double.NaN) Then Btn.Height = 25 + If Btn.Width.Equals(Double.NaN) Then Btn.Width = 25 CType(ButtonStack, StackPanel).Children.Add(Btn) Next Children.Add(ButtonStack) @@ -324,7 +312,8 @@ '添加竖条控件 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, + .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) @@ -532,10 +521,6 @@ Log("[Control] 按下复选列表项（" & (Not Checked).ToString & "）：" & Title) SetChecked(Not Checked, True, True) End Select - '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 '鼠标点击判定 @@ -543,15 +528,12 @@ 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 + If ButtonStack IsNot Nothing 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 + If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True End Sub '实现自定义事件 @@ -605,7 +587,11 @@ '有动画 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)) + If ButtonStack IsNot Nothing Then + Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3)) + Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)), + Math.Max(MinPaddingRight, 5 + Buttons.Count * 25) - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7)) + End If Ani.AddRange({ AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time), AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent) @@ -619,7 +605,11 @@ End If End If Else - If ButtonStack IsNot Nothing Then Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.5)) + If ButtonStack IsNot Nothing Then + Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.4)) + Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)), + MinPaddingRight - ColumnPaddingRight.Width.Value, Time * 0.4)) + End If Ani.Add(AaOpacity(RectBack, -RectBack.Opacity, Time)) If IsScaleAnimationEnabled Then Ani.AddRange({ @@ -634,14 +624,20 @@ Else '无动画 If IsMouseOver AndAlso IsMouseOverAnimationEnabled Then - If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 1 + If ButtonStack IsNot Nothing Then + ButtonStack.Opacity = 1 + ColumnPaddingRight.Width = New GridLength(Math.Max(MinPaddingRight, 5 + Buttons.Count * 25)) + End If '由于鼠标已经移入，所以直接实例化 RectBack RectBack.Background = ColorBg1 RectBack.Opacity = 1 RectBack.RenderTransform = New ScaleTransform(1, 1) Me.RenderTransform = New ScaleTransform(1, 1) Else - If ButtonStack IsNot Nothing Then ButtonStack.Opacity = 0 + If ButtonStack IsNot Nothing Then + ButtonStack.Opacity = 0 + ColumnPaddingRight.Width = New GridLength(MinPaddingRight) + End If Me.RenderTransform = New ScaleTransform(1, 1) If _RectBack IsNot Nothing Then If IsScaleAnimationEnabled Then RectBack.RenderTransform = New ScaleTransform(0.75, 0.75) @@ -659,6 +655,7 @@ Else SetResourceReference(ForegroundProperty, "ColorBrush1") End If + ColumnPaddingRight.Width = New GridLength(MinPaddingRight) If EventType = "打开帮助" Then Try Dim NewElem = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me) diff --git a/Plain Craft Launcher 2/Controls/MyLoading.xaml.vb b/Plain Craft Launcher 2/Controls/MyLoading.xaml.vb index 0fab85b..77e0161 100644 --- a/Plain Craft Launcher 2/Controls/MyLoading.xaml.vb +++ b/Plain Craft Launcher 2/Controls/MyLoading.xaml.vb @@ -67,32 +67,35 @@ Public Class MyLoading ''' 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 {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝", - "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) LabText.Text.Contains(s)) Then - LabText.Text = "网络环境不佳，请重试或尝试使用 VPN" + Private Sub RefreshText() Handles Me.IsErrorChanged, Me.Loaded, _State.ProgressChanged + RunInUi( + Sub() + 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 {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝", + "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) LabText.Text.Contains(s)) Then + LabText.Text = "网络环境不佳，请重试或尝试使用 VPN" + End If End If + Else + LabText.Text = TextError End If Else - LabText.Text = TextError + If ShowProgress AndAlso State.IsLoader Then + LabText.Text = Text & " - " & Math.Floor(CType(State, Object).Progress * 100) & "%" + Else + LabText.Text = Text + End If 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 Sub #End Region @@ -183,46 +186,7 @@ Public Class MyLoading 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({ + 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)), @@ -244,6 +208,8 @@ Public Class MyLoading AniLoop() End Sub,, True) }, "MyLoader Loop " & Uuid & "/" & GetUuid()) + If ShowProgress Then + End If End Sub @@ -294,6 +260,7 @@ Public Interface ILoadingTrigger ReadOnly Property IsLoader As Boolean Property LoadingState As MyLoadingState Event LoadingStateChanged(NewState As MyLoadingState, OldState As MyLoadingState) + Event ProgressChanged(NewProgress As Double, OldProgress As Double) End Interface Public Class MyLoadingStateSimulator @@ -313,4 +280,5 @@ Public Class MyLoadingStateSimulator Public ReadOnly Property IsLoader As Boolean = False Implements ILoadingTrigger.IsLoader Public Event LoadingStateChanged(NewState As MyLoadingState, OldState As MyLoadingState) Implements ILoadingTrigger.LoadingStateChanged + Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged End Class diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb index 356a60e..cfcff52 100644 --- a/Plain Craft Launcher 2/FormMain.xaml.vb +++ b/Plain Craft Launcher 2/FormMain.xaml.vb @@ -1,4 +1,5 @@ Imports System.ComponentModel +Imports System.Runtime.InteropServices Public Class FormMain @@ -134,6 +135,13 @@ Public Class FormMain '3：BUG+ IMP* FEAT- '2：BUG* IMP- '1：BUG- + If LastVersion < 307 Then 'Snapshot 2.6.11 + FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面将显示 Mod 的中文名、图标、标签等信息")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "从 Mod 管理页面查看 Mod 信息时会跳转到其下载详情页面")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新设计 Mod 管理页面的交互与样式")) + FeatureCount += 15 + BugCount += 13 + End If If LastVersion < 307 Then 'Snapshot 2.6.10 FeatureCount += 2 BugCount += 3 @@ -351,7 +359,6 @@ Public Class FormMain End Sub '窗口加载 - Private Declare Auto Function ChangeWindowMessageFilterEx Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal message As UInt32, ByVal action As UInt32, ByVal changeInfo As UInt32) As Boolean Private IsWindowLoadFinished As Boolean = False ''' ''' 是否为联机提权后自动重启。 @@ -489,20 +496,25 @@ Public Class FormMain Catch ex As Exception Log(ex, "清理自动更新文件失败") End Try - '开启管理员权限下的文件拖拽（#2531） - Try - If IsAdmin() Then - Log("[System] PCL 正以管理员权限运行") - ChangeWindowMessageFilterEx(Handle, &H233, 1, Nothing) - ChangeWindowMessageFilterEx(Handle, &H49, 1, Nothing) - End If - Catch ex As Exception - Log(ex, "开启管理员权限下的文件拖拽失败") - End Try + '开启管理员权限下的文件拖拽，但下列代码也没用（#2531） + If IsAdmin() Then + Log("[System] PCL 正以管理员权限运行") + Dim changeInfo As New ChangeFilter + changeInfo.cbSize = Marshal.SizeOf(changeInfo) + ChangeWindowMessageFilterEx(Handle, &H233, 1, changeInfo) + ChangeWindowMessageFilterEx(Handle, &H4A, 1, changeInfo) + ChangeWindowMessageFilterEx(Handle, &H49, 1, changeInfo) + End If End Sub, "Start Loader", ThreadPriority.Lowest) Log("[Start] 第三阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms") End Sub + + Public Structure ChangeFilter + Public cbSize As UInteger + Public ExtStatus As UInteger + End Structure + Private Declare Function ChangeWindowMessageFilterEx Lib "user32.dll" (hwnd As IntPtr, message As UInteger, action As UInteger, changeInfo As ChangeFilter) As Boolean '根据打开次数触发的事件 Private Sub RunCountSub() Setup.Set("SystemCount", Setup.Get("SystemCount") + 1) diff --git a/Plain Craft Launcher 2/Images/Icons/Disabled.png b/Plain Craft Launcher 2/Images/Icons/Disabled.png new file mode 100644 index 0000000..b335561 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Icons/Disabled.png differ diff --git a/Plain Craft Launcher 2/Images/Icons/NoIcon.png b/Plain Craft Launcher 2/Images/Icons/NoIcon.png index 556e72b..0a585a2 100644 Binary files a/Plain Craft Launcher 2/Images/Icons/NoIcon.png and b/Plain Craft Launcher 2/Images/Icons/NoIcon.png differ diff --git a/Plain Craft Launcher 2/Images/Icons/Unavaliable.png b/Plain Craft Launcher 2/Images/Icons/Unavaliable.png new file mode 100644 index 0000000..d400ed0 Binary files /dev/null and b/Plain Craft Launcher 2/Images/Icons/Unavaliable.png differ diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb index 69d3eae..f84b474 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb @@ -11,12 +11,12 @@ Public Module ModBase #Region "声明" '下列版本信息由更新器自动修改 - Public Const VersionBaseName As String = "2.6.100" '不含分支前缀的显示用版本名 - Public Const VersionStandardCode As String = "2.6.100." & VersionBranchCode '标准格式的四段式版本号 + Public Const VersionBaseName As String = "2.6.11" '不含分支前缀的显示用版本名 + Public Const VersionStandardCode As String = "2.6.11." & VersionBranchCode '标准格式的四段式版本号 #If BETA Then Public Const VersionCode As Integer = 308 'Release #Else - Public Const VersionCode As Integer = 307 'Snapshot + Public Const VersionCode As Integer = 309 'Snapshot #End If '自动生成的版本信息 Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName @@ -560,7 +560,7 @@ Public Module ModBase ''' ''' 重命名一个注册表子键。不可用于包含子键的子键。 ''' - Public Sub RegRename(parentKey As Microsoft.Win32.RegistryKey, subKeyName As String, newSubKeyName As String) + Public Sub RenameReg(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 '没有目标项 @@ -1062,7 +1062,7 @@ Public Module ModBase ''' ''' 获取文件 MD5，若失败则返回空字符串。 ''' - Public Function GetAuthMD5(FilePath As String) As String + Public Function GetFileMD5(FilePath As String) As String Dim Retry As Boolean = False Re: Try @@ -1091,7 +1091,7 @@ Re: ''' ''' 获取文件 SHA256，若失败则返回空字符串。 ''' - Public Function GetAuthSHA256(FilePath As String) As String + Public Function GetFileSHA256(FilePath As String) As String Dim Retry As Boolean = False Re: Try @@ -1122,7 +1122,7 @@ Re: ''' ''' 获取文件 SHA1，若失败则返回空字符串。 ''' - Public Function GetAuthSHA1(FilePath As String) As String + Public Function GetFileSHA1(FilePath As String) As String Dim Retry As Boolean = False Re: Try @@ -1210,11 +1210,11 @@ Re: 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.ToLowerInvariant <> GetAuthMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & "，实际为 " & GetAuthMD5(LocalPath) + If Hash.ToLowerInvariant <> GetFileMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & "，实际为 " & GetFileMD5(LocalPath) ElseIf Hash.Length = 64 Then 'SHA256 - If Hash.ToLowerInvariant <> GetAuthSHA256(LocalPath) Then Return "文件 SHA256 应为 " & Hash & "，实际为 " & GetAuthSHA256(LocalPath) + If Hash.ToLowerInvariant <> GetFileSHA256(LocalPath) Then Return "文件 SHA256 应为 " & Hash & "，实际为 " & GetFileSHA256(LocalPath) Else 'SHA1 (40) - If Hash.ToLowerInvariant <> GetAuthSHA1(LocalPath) Then Return "文件 SHA1 应为 " & Hash & "，实际为 " & GetAuthSHA1(LocalPath) + If Hash.ToLowerInvariant <> GetFileSHA1(LocalPath) Then Return "文件 SHA1 应为 " & Hash & "，实际为 " & GetFileSHA1(LocalPath) End If End If If IsJson Then @@ -2321,6 +2321,16 @@ Retry: Return Thread.CurrentThread.ManagedThreadId = UiThreadId End Function + ''' + ''' 检查某个控件是否位于主窗口可视区域内，且控件本身可见。 + ''' + Public Function IsVisibleInForm(element As FrameworkElement) As Boolean + If Not element.IsVisible Then Return False + Dim bounds As Rect = element.TransformToAncestor(FrmMain).TransformBounds(New Rect(0, 0, element.ActualWidth, element.ActualHeight)) + Dim rect As New Rect(0, 0, FrmMain.ActualWidth, FrmMain.ActualHeight) + Return rect.Contains(bounds.TopLeft) OrElse rect.Contains(bounds.BottomRight) + End Function + #End Region #Region "Debug" diff --git a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb index 6a173c1..852541d 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb @@ -153,10 +153,14 @@ End Select End Get Set(value As Double) + If _Progress = value Then Exit Property + Dim OldValue = _Progress _Progress = value + RaiseEvent ProgressChanged(value, OldValue) End Set End Property Private _Progress As Double = -1 + Public Event ProgressChanged(NewProgress As Double, OldProgress As Double) Implements ILoadingTrigger.ProgressChanged ''' ''' 计算总进度时的权重。它应该为预计时间（秒）。 ''' @@ -236,12 +240,16 @@ ''' Public ReadOnly Property IsAborted As Boolean Get - Return LastRunningThread Is Nothing OrElse - Not ReferenceEquals(Thread.CurrentThread, LastRunningThread) OrElse - State = LoadState.Aborted + Return IsAbortedWithThread(Thread.CurrentThread) End Get End Property ''' + ''' 当前执行线程是否应当中断。需要手动提供加载器线程，用于需要跨线程检查的情况。 + ''' + Public Function IsAbortedWithThread(Thread As Thread) As Boolean + Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Aborted + End Function + ''' ''' 在输入相同时使用原有结果的超时，单位为毫秒。 ''' Public ReloadTimeout As Integer = -1 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb index c4fb77a..dcefb92 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb @@ -4,15 +4,15 @@ ''' ''' Mod。 ''' - [Mod] + [Mod] = 0 ''' ''' 整合包。 ''' - ModPack + ModPack = 1 ''' ''' 资源包。 ''' - ResourcePack + ResourcePack = 2 End Enum Public Enum CompModLoaderType 'https://docs.curseforge.com/?http#tocS_ModLoaderType @@ -164,7 +164,7 @@ ''' ''' Logo 图片的下载地址。若为 Nothing 则没有。 ''' - Public ReadOnly LogoUrl As String = Nothing + Public LogoUrl As String = Nothing ''' ''' 游戏大版本列表。例如：18, 16, 15…… ''' @@ -221,174 +221,224 @@ ''' 从工程 Json 中初始化实例。若出错会抛出异常。 ''' Public Sub New(Data As JObject) - FromCurseForge = Data.ContainsKey("gameId") - If FromCurseForge Then -#Region "CurseForge" - '简单信息 - Id = Data("id") - Slug = Data("slug") - RawName = Data("name") - Description = Data("summary") - Website = Data("links")("websiteUrl").ToString.TrimEnd("/") - LastUpdate = Data("dateReleased") '#1194 - DownloadCount = Data("downloadCount") - 'Logo - If Data("logo").Count > 0 Then - If GetPixelSize(1) > 1.25 Then - LogoUrl = Data("logo")("thumbnailUrl").ToString '使用 256x256 图标 - Else - LogoUrl = Data("logo")("thumbnailUrl").ToString.Replace("/256/256/", "/64/64/") '使用 64x64 图标 - End If - End If - 'FileIndexes / GameVersions - Dim Files = If(CType(Data("latestFilesIndexes"), JArray), New JArray). - Where(Function(i) i("gameVersion").ToString.Contains("1.")) - CurseForgeFileIds = Files.Select(Of Integer)(Function(v) v("fileId")).ToList - GameVersions = Files.Select(Of Integer)(Function(v) Val(v("gameVersion").ToString.Split(".")(1).Split("-").First)).Where(Function(v) v > 0). - Distinct.OrderByDescending(Function(v) v).ToList - 'Type - If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then - Type = CompType.Mod - ElseIf Website.Contains("/modpacks/") Then - Type = CompType.ModPack + If Data.ContainsKey("Tags") Then +#Region "CompJson" + FromCurseForge = Data("DataSource") = "CurseForge" + Type = Data("Type").ToObject(Of Integer) + Slug = Data("Slug") + Id = Data("Id") + If Data.ContainsKey("CurseForgeFileIds") Then CurseForgeFileIds = CType(Data("CurseForgeFileIds"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList + RawName = Data("RawName") + Description = Data("Description") + Website = Data("Website") + If Data.ContainsKey("LastUpdate") Then LastUpdate = Data("LastUpdate") + DownloadCount = Data("DownloadCount") + If Data.ContainsKey("ModLoaders") Then + ModLoaders = CType(Data("ModLoaders"), JArray).Select(Function(t) CType(t.ToObject(Of Integer), CompModLoaderType)).ToList Else - Type = CompType.ResourcePack + ModLoaders = New List(Of CompModLoaderType) + End If + Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList + If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl") + If Data.ContainsKey("GameVersions") Then + GameVersions = CType(Data("GameVersions"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList + Else + GameVersions = New List(Of Integer) End If - 'Tags - Tags = New List(Of String) - For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c) - Select Case Category - 'Mod - Case 406 : Tags.Add("世界元素") - Case 407 : Tags.Add("生物群系") - Case 410 : Tags.Add("维度") - Case 408 : Tags.Add("矿物/资源") - Case 409 : Tags.Add("天然结构") - Case 412 : Tags.Add("科技") - Case 415 : Tags.Add("管道/物流") - Case 4843 : Tags.Add("自动化") - Case 417 : Tags.Add("能源") - Case 4558 : Tags.Add("红石") - Case 436 : Tags.Add("食物/烹饪") - Case 416 : Tags.Add("农业") - Case 414 : Tags.Add("运输") - Case 420 : Tags.Add("仓储") - Case 419 : Tags.Add("魔法") - Case 422 : Tags.Add("冒险") - Case 424 : Tags.Add("装饰") - Case 411 : Tags.Add("生物") - Case 434 : Tags.Add("装备") - Case 423 : Tags.Add("信息显示") - Case 435 : Tags.Add("服务器") - Case 5191 : Tags.Add("改良") - Case 421 : Tags.Add("支持库") - '整合包 - Case 4484 : Tags.Add("多人") - Case 4479 : Tags.Add("硬核") - Case 4483 : Tags.Add("战斗") - Case 4478 : Tags.Add("任务") - Case 4472 : Tags.Add("科技") - Case 4473 : Tags.Add("魔法") - Case 4475 : Tags.Add("冒险") - Case 4476 : Tags.Add("探索") - Case 4477 : Tags.Add("小游戏") - Case 4471 : Tags.Add("科幻") - Case 4736 : Tags.Add("空岛") - Case 5128 : Tags.Add("原版改良") - Case 4487 : Tags.Add("FTB") - Case 4480 : Tags.Add("基于地图") - Case 4481 : Tags.Add("轻量") - Case 4482 : Tags.Add("大型") - 'FUTURE: Res - End Select - Next - If Tags.Count = 0 Then Tags.Add("杂项") - 'ModLoaders - ModLoaders = New List(Of CompModLoaderType) - For Each File In If(Data("latestFiles"), {}) - Dim NewFile As New CompFile(File, Type) - If Not NewFile.Available Then Continue For - ModLoaders.AddRange(NewFile.ModLoaders) - Next - ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList #End Region Else -#Region "Modrinth" - '简单信息 - Id = If(Data("project_id"), Data("id")) '两个 API 会返回的 key 不一样 - Slug = Data("slug") - RawName = Data("title") - Description = Data("description") - LastUpdate = Data("date_modified") - DownloadCount = Data("downloads") - LogoUrl = Data("icon_url") - If LogoUrl = "" Then LogoUrl = Nothing - Website = $"https://modrinth.com/{Data("project_type")}/{Slug}" - 'GameVersions - GameVersions = If(CType(Data("versions"), JArray), New JArray). - Select(Function(v) v.ToString).Where(Function(v) v.StartsWith("1.")). - Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0). + FromCurseForge = Data.ContainsKey("summary") + If FromCurseForge Then +#Region "CurseForge" + '简单信息 + Id = Data("id") + Slug = Data("slug") + RawName = Data("name") + Description = Data("summary") + Website = Data("links")("websiteUrl").ToString.TrimEnd("/") + LastUpdate = Data("dateReleased") '#1194 + DownloadCount = Data("downloadCount") + 'Logo + If Data("logo").Count > 0 Then + If GetPixelSize(1) > 1.25 Then + LogoUrl = Data("logo")("thumbnailUrl").ToString '使用 256x256 图标 + Else + LogoUrl = Data("logo")("thumbnailUrl").ToString.Replace("/256/256/", "/64/64/") '使用 64x64 图标 + End If + End If + 'FileIndexes / GameVersions + Dim Files = If(CType(Data("latestFilesIndexes"), JArray), New JArray). + Where(Function(i) i("gameVersion").ToString.Contains("1.")) + CurseForgeFileIds = Files.Select(Of Integer)(Function(v) v("fileId")).Distinct.ToList + GameVersions = Files.Select(Of Integer)(Function(v) Val(v("gameVersion").ToString.Split(".")(1).Split("-").First)).Where(Function(v) v > 0). Distinct.OrderByDescending(Function(v) v).ToList - 'Type - Select Case Data("project_type").ToString - Case "mod" : Type = CompType.Mod - Case "modpack" : Type = CompType.ModPack - Case "resourcepack" : Type = CompType.ResourcePack - End Select - 'Tags & ModLoaders - Tags = New List(Of String) - ModLoaders = New List(Of CompModLoaderType) - For Each Category In Data("categories").Select(Function(t) t.ToString) - Select Case Category - '加载器 - Case "forge" : ModLoaders.Add(CompModLoaderType.Forge) - Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric) - Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt) + 'Type + If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then + Type = CompType.Mod + ElseIf Website.Contains("/modpacks/") Then + Type = CompType.ModPack + Else + Type = CompType.ResourcePack + End If + 'Tags + Tags = New List(Of String) + For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c) + Select Case Category 'Mod - Case "worldgen" : Tags.Add("世界元素") - Case "technology" : Tags.Add("科技") - Case "food" : Tags.Add("食物/烹饪") - Case "game-mechanics" : Tags.Add("游戏机制") - Case "transportation" : Tags.Add("运输") - Case "storage" : Tags.Add("仓储") - Case "magic" : Tags.Add("魔法") - Case "adventure" : Tags.Add("冒险") - Case "decoration" : Tags.Add("装饰") - Case "mobs" : Tags.Add("生物") - Case "equipment" : Tags.Add("装备") - Case "optimization" : Tags.Add("性能优化") - Case "social" : Tags.Add("服务器") - Case "utility" : Tags.Add("改良") - Case "library" : Tags.Add("支持库") + Case 406 : Tags.Add("世界元素") + Case 407 : Tags.Add("生物群系") + Case 410 : Tags.Add("维度") + Case 408 : Tags.Add("矿物/资源") + Case 409 : Tags.Add("天然结构") + Case 412 : Tags.Add("科技") + Case 415 : Tags.Add("管道/物流") + Case 4843 : Tags.Add("自动化") + Case 417 : Tags.Add("能源") + Case 4558 : Tags.Add("红石") + Case 436 : Tags.Add("食物/烹饪") + Case 416 : Tags.Add("农业") + Case 414 : Tags.Add("运输") + Case 420 : Tags.Add("仓储") + Case 419 : Tags.Add("魔法") + Case 422 : Tags.Add("冒险") + Case 424 : Tags.Add("装饰") + Case 411 : Tags.Add("生物") + Case 434 : Tags.Add("装备") + Case 423 : Tags.Add("信息显示") + Case 435 : Tags.Add("服务器") + Case 5191 : Tags.Add("改良") + Case 421 : Tags.Add("支持库") '整合包 - Case "multiplayer" : Tags.Add("多人") - Case "optimization" : Tags.Add("性能优化") - Case "challenging" : Tags.Add("硬核") - Case "combat" : Tags.Add("战斗") - Case "quests" : Tags.Add("任务") - Case "technology" : Tags.Add("科技") - Case "magic" : Tags.Add("魔法") - Case "adventure" : Tags.Add("冒险") - Case "kitchen-sink" : Tags.Add("烹饪") - Case "lightweight" : Tags.Add("轻量") - 'FUTURE: Res - End Select - Next - If Tags.Count = 0 Then Tags.Add("杂项") - Tags.Sort() - ModLoaders.Sort() + Case 4484 : Tags.Add("多人") + Case 4479 : Tags.Add("硬核") + Case 4483 : Tags.Add("战斗") + Case 4478 : Tags.Add("任务") + Case 4472 : Tags.Add("科技") + Case 4473 : Tags.Add("魔法") + Case 4475 : Tags.Add("冒险") + Case 4476 : Tags.Add("探索") + Case 4477 : Tags.Add("小游戏") + Case 4471 : Tags.Add("科幻") + Case 4736 : Tags.Add("空岛") + Case 5128 : Tags.Add("原版改良") + Case 4487 : Tags.Add("FTB") + Case 4480 : Tags.Add("基于地图") + Case 4481 : Tags.Add("轻量") + Case 4482 : Tags.Add("大型") + 'FUTURE: Res + End Select + Next + If Tags.Count = 0 Then Tags.Add("杂项") + 'ModLoaders + ModLoaders = New List(Of CompModLoaderType) + For Each File In If(Data("latestFiles"), {}) + Dim NewFile As New CompFile(File, Type) + If Not NewFile.Available Then Continue For + ModLoaders.AddRange(NewFile.ModLoaders) + Next + ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList #End Region + Else +#Region "Modrinth" + '简单信息 + Id = If(Data("project_id"), Data("id")) '两个 API 会返回的 key 不一样 + Slug = Data("slug") + RawName = Data("title") + Description = Data("description") + LastUpdate = Data("date_modified") + DownloadCount = Data("downloads") + LogoUrl = Data("icon_url") + If LogoUrl = "" Then LogoUrl = Nothing + Website = $"https://modrinth.com/{Data("project_type")}/{Slug}" + 'GameVersions + '搜索结果的键为 versions，获取特定工程的键为 game_versions + GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray). + Select(Function(v) v.ToString).Where(Function(v) v.StartsWith("1.")). + Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0). + Distinct.OrderByDescending(Function(v) v).ToList + 'Type + Select Case Data("project_type").ToString + Case "mod" : Type = CompType.Mod + Case "modpack" : Type = CompType.ModPack + Case "resourcepack" : Type = CompType.ResourcePack + End Select + 'Tags & ModLoaders + Tags = New List(Of String) + ModLoaders = New List(Of CompModLoaderType) + For Each Category In Data("categories").Select(Function(t) t.ToString) + Select Case Category + '加载器 + Case "forge" : ModLoaders.Add(CompModLoaderType.Forge) + Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric) + Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt) + 'Mod + Case "worldgen" : Tags.Add("世界元素") + Case "technology" : Tags.Add("科技") + Case "food" : Tags.Add("食物/烹饪") + Case "game-mechanics" : Tags.Add("游戏机制") + Case "transportation" : Tags.Add("运输") + Case "storage" : Tags.Add("仓储") + Case "magic" : Tags.Add("魔法") + Case "adventure" : Tags.Add("冒险") + Case "decoration" : Tags.Add("装饰") + Case "mobs" : Tags.Add("生物") + Case "equipment" : Tags.Add("装备") + Case "optimization" : Tags.Add("性能优化") + Case "social" : Tags.Add("服务器") + Case "utility" : Tags.Add("改良") + Case "library" : Tags.Add("支持库") + '整合包 + Case "multiplayer" : Tags.Add("多人") + Case "optimization" : Tags.Add("性能优化") + Case "challenging" : Tags.Add("硬核") + Case "combat" : Tags.Add("战斗") + Case "quests" : Tags.Add("任务") + Case "technology" : Tags.Add("科技") + Case "magic" : Tags.Add("魔法") + Case "adventure" : Tags.Add("冒险") + Case "kitchen-sink" : Tags.Add("烹饪") + Case "lightweight" : Tags.Add("轻量") + 'FUTURE: Res + End Select + Next + If Tags.Count = 0 Then Tags.Add("杂项") + Tags.Sort() + ModLoaders.Sort() +#End Region + End If End If '保存缓存 CompProjectCache(Id) = Me End Sub ''' + ''' 将当前实例转为可用于保存缓存的 Json。 + ''' + Public Function ToJson() As JObject + Dim Json As New JObject + Json("DataSource") = If(FromCurseForge, "CurseForge", "Modrinth") + Json("Type") = CInt(Type) + Json("Slug") = Slug + Json("Id") = Id + If CurseForgeFileIds IsNot Nothing Then Json("CurseForgeFileIds") = New JArray(CurseForgeFileIds) + Json("RawName") = RawName + Json("Description") = Description + Json("Website") = Website + If LastUpdate IsNot Nothing Then Json("LastUpdate") = LastUpdate + Json("DownloadCount") = DownloadCount + If ModLoaders IsNot Nothing AndAlso ModLoaders.Count > 0 Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m))) + Json("Tags") = New JArray(Tags) + If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl + If GameVersions.Count > 0 Then Json("GameVersions") = New JArray(GameVersions) + Json("CacheTime") = Date.Now '用于检查缓存时间 + Return Json + End Function + ''' ''' 将当前工程信息实例化为控件。 ''' Public Function ToCompItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean) As MyCompItem '获取版本描述 Dim GameVersionDescription As String - If GameVersions Is Nothing OrElse GameVersions.Count = 0 Then + If GameVersions Is Nothing OrElse Not GameVersions.Any() Then GameVersionDescription = "未知" Else Dim SpaVersions As New List(Of String) @@ -418,94 +468,16 @@ GameVersionDescription = SpaVersions.Join(", ") End If '实例化 UI - Dim NewItem As New MyCompItem With {.Tag = Me} - '整理 FinalName 与 ExNameList - '检查下列代码时可以参考 #1567 的测试例 - Dim FinalName As String = RawName - Dim ExNameList As List(Of String) - If TranslatedName = RawName Then - '没有中文翻译 - '将所有名称分段 - Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries). - Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList - If NameLists.Count = 1 Then GoTo NoExName - '查找其中的缩写、Forge/Fabric 等版本标记 - ExNameList = New List(Of String) - Dim NormalNameList = New List(Of String) - For Each Name In NameLists - Dim LowerName As String = Name.ToLower - If Name.ToUpper = Name AndAlso Name <> "FPS" AndAlso Name <> "HUD" Then - '缩写 - ExNameList.Add(Name) - ElseIf (LowerName.Contains("forge") OrElse LowerName.Contains("fabric") OrElse LowerName.Contains("quilt")) AndAlso - Not RegexCheck(LowerName.Replace("forge", "").Replace("fabric", "").Replace("quilt", ""), "[a-z]+") Then '去掉关键词后没有其他字母 - 'Forge/Fabric 等版本标记 - ExNameList.Add(Name) - Else - '其他部分 - NormalNameList.Add(Name) - End If - Next - '根据分类后的结果处理 - If NormalNameList.Count = 0 OrElse ExNameList.Count = 0 Then GoTo NoExName - '同时包含 NormalName 和 ExName - FinalName = NormalNameList.Join(" - ") - ExNameList = ExNameList - Else - '有中文翻译 - '尝试将文本分为三段：FinalName (EnglishName) - Suffix - '检查时注意 Carpet：它没有中文译名，但有 Suffix - FinalName = TranslatedName.Split(" (").First.Split(" - ").First - Dim Suffix As String = "" - If TranslatedName.Split(")").Last.Contains(" - ") Then Suffix = TranslatedName.Split(")").Last.Split(" - ").Last - Dim EnglishName As String = TranslatedName - If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "") - EnglishName = EnglishName.Replace(FinalName, "").Trim("("c, ")"c, " "c) - '中段的额外信息截取 - ExNameList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries). - Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList - If ExNameList.Count > 1 AndAlso - Not ExNameList.Any(Function(s) s.ToLower.Contains("forge") OrElse s.ToLower.Contains("fabric") OrElse s.ToLower.Contains("quilt")) AndAlso '不是标注 XX 版 - Not (ExNameList.Count = 2 AndAlso ExNameList.Last.ToUpper = ExNameList.Last) Then '不是缩写 - ExNameList = New List(Of String) From {EnglishName} '使用原名 - End If - '添加后缀 - If Suffix <> "" Then ExNameList.Add(Suffix) - End If - ExNameList = ExNameList.Distinct().ToList() - '显示 FinalName 与 ExNameList - If ExNameList.Count = 0 Then -NoExName: - NewItem.LabTitle.Text = FinalName + Dim NewItem As New MyCompItem With {.Tag = Me, .Logo = GetControlLogo()} + Dim Title = GetControlTitle(True) + NewItem.Title = Title.Key + If Title.Value = "" Then CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw) Else - NewItem.LabTitle.Text = FinalName - Dim ExName As String = "" - For Each Ex In ExNameList - '去除 “Forge/Fabric” 这一无意义提示 - If Ex.Length < 16 AndAlso Ex.ToLower.Contains("fabric") AndAlso Ex.ToLower.Contains("forge") Then Continue For - '将 “Forge” 等提示改为 “Forge 版” - If (Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt")) AndAlso Not Ex.Contains("版") AndAlso - Ex.ToLower.Replace("forge", "").Replace("fabric", "").Replace("quilt", "").Length <= 3 Then - Ex = Ex.Replace("Edition", "").Replace("edition", "").Trim.Capitalize & " 版" - End If - '将 “forge” 等词语的首字母大写 - Ex = Ex.Replace("forge", "Forge").Replace("neo", "Neo").Replace("fabric", "Fabric").Replace("quilt", "Quilt") - ExName &= " | " & Ex.Trim - Next - If ExName = "" Then GoTo NoExName - NewItem.LabTitleRaw.Text = ExName + NewItem.SubTitle = Title.Value End If - 'Tag - For Each TagText In Tags - Dim NewTag = GetObjectFromXML( - " - - ") - NewItem.PanTags.Children.Add(NewTag) - Next + NewItem.Tags = Tags + NewItem.Description = Description.Replace(vbCr, "").Replace(vbLf, "") '下边栏 If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then '全部隐藏 @@ -548,7 +520,6 @@ NoExName: End If End Select End If - NewItem.LabInfo.Text = Description.Replace(vbCr, "").Replace(vbLf, "") NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth") If LastUpdate IsNot Nothing Then NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True) @@ -561,14 +532,93 @@ NoExName: NewItem.LabDownload.Text = If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿", If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount)) - '其他 - If LogoUrl Is Nothing Then - NewItem.Logo = "pack://application:,,,/images/Icons/NoIcon.png" - Else - NewItem.Logo = LogoUrl - End If Return NewItem End Function + Public Function GetControlLogo() As String + If LogoUrl Is Nothing Then + Return "pack://application:,,,/images/Icons/NoIcon.png" + Else + Return LogoUrl + End If + End Function + Public Function GetControlTitle(HasModLoaderDescription As Boolean) As KeyValuePair(Of String, String) + '检查下列代码时可以参考 #1567 的测试例 + Dim Title As String = RawName + Dim SubtitleList As List(Of String) + If TranslatedName = RawName Then + '没有中文翻译 + '将所有名称分段 + Dim NameLists = TranslatedName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries). + Select(Function(s) s.Trim(" /\".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList + If NameLists.Count = 1 Then GoTo NoSubtitle + '查找其中的缩写、Forge/Fabric 等版本标记 + SubtitleList = New List(Of String) + Dim NormalNameList = New List(Of String) + For Each Name In NameLists + Dim LowerName As String = Name.ToLower + If Name.ToUpper = Name AndAlso Name <> "FPS" AndAlso Name <> "HUD" Then + '缩写 + SubtitleList.Add(Name) + ElseIf (LowerName.Contains("forge") OrElse LowerName.Contains("fabric") OrElse LowerName.Contains("quilt")) AndAlso + Not RegexCheck(LowerName.Replace("forge", "").Replace("fabric", "").Replace("quilt", ""), "[a-z]+") Then '去掉关键词后没有其他字母 + 'Forge/Fabric 等版本标记 + SubtitleList.Add(Name) + Else + '其他部分 + NormalNameList.Add(Name) + End If + Next + '根据分类后的结果处理 + If NormalNameList.Count = 0 OrElse SubtitleList.Count = 0 Then GoTo NoSubtitle + '同时包含 NormalName 和 Subtitle + Title = NormalNameList.Join(" - ") + Else + '有中文翻译 + '尝试将文本分为三段：Title (EnglishName) - Suffix + '检查时注意 Carpet：它没有中文译名，但有 Suffix + Title = TranslatedName.Split(" (").First.Split(" - ").First + Dim Suffix As String = "" + If TranslatedName.Split(")").Last.Contains(" - ") Then Suffix = TranslatedName.Split(")").Last.Split(" - ").Last + Dim EnglishName As String = TranslatedName + If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "") + EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c) + '中段的额外信息截取 + SubtitleList = EnglishName.Split({" | ", " - ", "(", ")", "[", "]", "{", "}"}, StringSplitOptions.RemoveEmptyEntries). + Select(Function(s) s.Trim(" /".ToCharArray)).Where(Function(w) Not String.IsNullOrEmpty(w)).ToList + If SubtitleList.Count > 1 AndAlso + Not SubtitleList.Any(Function(s) s.ToLower.Contains("forge") OrElse s.ToLower.Contains("fabric") OrElse s.ToLower.Contains("quilt")) AndAlso '不是标注 XX 版 + Not (SubtitleList.Count = 2 AndAlso SubtitleList.Last.ToUpper = SubtitleList.Last) Then '不是缩写 + SubtitleList = New List(Of String) From {EnglishName} '使用原名 + End If + '添加后缀 + If Suffix <> "" Then SubtitleList.Add(Suffix) + End If + SubtitleList = SubtitleList.Distinct().ToList() + '设置标题与描述 + Dim Subtitle As String = "" + If SubtitleList.Count > 0 Then + For Each Ex In SubtitleList + Dim IsModLoaderDescription As Boolean = + Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt") + '是否显示 ModLoader 信息 + If Not HasModLoaderDescription AndAlso IsModLoaderDescription Then Continue For + '去除 “Forge/Fabric” 这一无意义提示 + If Ex.Length < 16 AndAlso Ex.ToLower.Contains("fabric") AndAlso Ex.ToLower.Contains("forge") Then Continue For + '将 “Forge” 等提示改为 “Forge 版” + If IsModLoaderDescription AndAlso Not Ex.Contains("版") AndAlso + Ex.ToLower.Replace("forge", "").Replace("fabric", "").Replace("quilt", "").Length <= 3 Then + Ex = Ex.Replace("Edition", "").Replace("edition", "").Trim.Capitalize & " 版" + End If + '将 “forge” 等词语的首字母大写 + Ex = Ex.Replace("forge", "Forge").Replace("neo", "Neo").Replace("fabric", "Fabric").Replace("quilt", "Quilt") + Subtitle &= " | " & Ex.Trim + Next + Else +NoSubtitle: + Subtitle = "" + End If + Return New KeyValuePair(Of String, String)(Title, Subtitle) + End Function '辅助函数 @@ -761,6 +811,10 @@ NoExName: ''' 可供展示的所有工程的列表。 ''' Public Results As New List(Of CompProject) + ''' + ''' 当前的错误信息。如果没有则为 Nothing。 + ''' + Public ErrorMessage As String = Nothing End Class @@ -770,7 +824,7 @@ NoExName: ''' ''' 已知工程信息的缓存。 ''' - Private CompProjectCache As New Dictionary(Of String, CompProject) + Public CompProjectCache As New Dictionary(Of String, CompProject) ''' ''' 根据搜索请求获取一系列的工程列表。需要基于加载器运行。 ''' @@ -887,6 +941,7 @@ Retry: '启动 CurseForge 线程 Dim CurseForgeUrl As String = Task.Input.GetCurseForgeAddress() + Dim CurseForgeFailed As Boolean = False If CurseForgeUrl IsNot Nothing Then CurseForgeThread = RunInNewThread( Sub() @@ -910,12 +965,14 @@ Retry: Log(ex, "从 CurseForge 获取工程列表失败") Storage.CurseForgeTotal = Storage.CurseForgeOffset [Error] = ex + CurseForgeFailed = True End Try End Sub, "CurseForge Project Request") End If '启动 Modrinth 线程 Dim ModrinthUrl As String = Task.Input.GetModrinthAddress() + Dim ModrinthFailed As Boolean = False If ModrinthUrl IsNot Nothing Then ModrinthThread = RunInNewThread( Sub() @@ -941,6 +998,7 @@ Retry: Log(ex, "从 Modrinth 获取工程列表失败") Storage.ModrinthTotal = Storage.ModrinthOffset [Error] = ex + ModrinthFailed = True End Try End Sub, "Modrinth Project Request") End If @@ -951,7 +1009,8 @@ Retry: If ModrinthThread IsNot Nothing Then ModrinthThread.Join() If Task.IsAborted Then Exit Sub - '确认存在结果 + '确保存在结果 + Storage.ErrorMessage = Nothing If RawResults.Count = 0 Then If [Error] IsNot Nothing Then Throw [Error] @@ -966,6 +1025,13 @@ Retry: Throw New Exception("没有符合条件的结果") End If End If + ElseIf [Error] IsNot Nothing Then + '有结果但是有错误 + If CurseForgeFailed Then + Storage.ErrorMessage = $"无法连接到 CurseForge，所以目前仅显示了来自 Modrinth 的内容，结果可能不全。{vbCrLf}请尝试使用 VPN 或加速器以改善网络。" + Else + Storage.ErrorMessage = $"无法连接到 Modrinth，所以目前仅显示了来自 CurseForge 的内容，结果可能不全。{vbCrLf}请尝试使用 VPN 或加速器以改善网络。" + End If End If Finally @@ -1160,7 +1226,7 @@ Retry: FileName = Data("fileName") 'DownloadAddress Dim Url = Data("downloadUrl").ToString - If Url = "" Then Url = "https://media.forgecdn.net/files/" & Id.ToString.Substring(0, 4) & "/" & Id.ToString.Substring(4).TrimStart("0") & "/" & FileName + If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}" Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码 DownloadAddress = {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"), Url.Replace("-service.overwolf.wtf", ".forgecdn.net"), @@ -1282,7 +1348,6 @@ Retry: ToolTipService.SetHorizontalOffset(BtnSave, 2) AddHandler BtnSave.Click, OnSaveClick NewItem.Buttons = {BtnSave} - NewItem.PaddingRight = 35 End If '结束 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb index 6a5d35c..bd87074 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb @@ -641,7 +641,7 @@ Done: 'If Not Stack.Contains(".") Then Continue For For Each IgnoreStack In { "java", "sun", "javax", "jdk", "oolloo", - "org.lwjgl", "com.sun", "net.minecraftforge", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey", + "org.lwjgl", "com.sun", "net.minecraftforge", "paulscode.sound", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey", "com.electronwill.nightconfig", "it.unimi.dsi", "MojangTricksIntelDriversForPerformance_javaw"} If Stack.StartsWith(IgnoreStack) Then GoTo NextStack @@ -666,7 +666,7 @@ NextStack: If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", - "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", + "gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "fastutil", "optifine", "internal", "platform", "override", "listeners", "scheduler", "minecraft", "transformers", "universal", "multipart", "minecraftforge", "blockentity" diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb index c321242..bccfc08 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb @@ -455,7 +455,7 @@ ''' 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") + Dim Result As String = NetGetCodeByRequestRetry("https://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)") @@ -593,7 +593,7 @@ 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") + Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html") Catch ex As Exception If GetExceptionSummary(ex).Contains("(404)") Then Throw New Exception("没有可用版本") @@ -799,7 +799,7 @@ ''' 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) + Dim Result As JObject = NetGetCodeByRequestRetry("https://dl.liteloader.com/versions/versions.json", IsJson:=True) Try Dim Json As JObject = Result("versions") Dim Versions As New List(Of DlLiteLoaderListEntry) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb index 8ddecd1..5789b60 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb @@ -135,6 +135,8 @@ If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差，因此不再允许使用。你可以使用对应版本的 JDK，而非 JRE！") Catch ex As ApplicationException Throw ex + Catch ex As ThreadInterruptedException + Throw ex Catch ex As Exception Log("[Java] 检查失败的 Java 输出：" & PathFolder & "java.exe" & vbCrLf & If(Output, "无程序输出")) Throw New Exception("检查 Java 失败（" & If(PathJavaw, "Nothing") & "）", ex) @@ -605,6 +607,7 @@ NoUserJava: SyncLock ListLock JavaCheckList.Add(Entry) End SyncLock + Catch ex As ThreadInterruptedException Catch ex As Exception If Entry.IsUserImport Then Log(ex, "位于 " & Entry.PathFolder & " 的 Java 存在异常，将被自动移除", LogLevel.Hint) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb index c3f8c66..03065a9 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb @@ -881,7 +881,7 @@ SystemBrowser: End If Dim Result As String Try - Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 1) + Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 2) Catch ex As Exception If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269 Return {"Relogin", ""} @@ -1000,8 +1000,8 @@ SystemBrowser: ElseIf Message.Contains("(404)") Then Log(ex, "微软登录第 6 步汇报 404") RunInNewThread(Sub() - Select Case MyMsgBox("你可能没有在 Minecraft 官网创建档案，Xbox Game Pass 已到期，或者还没有购买 Minecraft。" & vbCrLf & - "如果你确认拥有 Minecraft，请在官网上创建档案后再试。", "登录失败", "创建档案", "购买 Minecraft", "取消") + Select Case MyMsgBox("你可能没有创建 Minecraft 玩家档案、Xbox Game Pass 已到期，或者还没有购买 Minecraft。" & vbCrLf & + "请先使用官方启动器登录一次，之后即可使用 PCL 登录。", "登录失败", "创建档案", "购买 Minecraft", "取消") Case 1 OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile") Case 2 @@ -1210,6 +1210,7 @@ SystemBrowser: Loop '检查下载结果 + If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872# McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent) If Task.IsAborted Then Exit Sub If McLaunchJavaSelected IsNot Nothing Then @@ -1857,7 +1858,7 @@ NextVersion: End If Case Else '快照版是 99 PackFormat = 17 - 'https://minecraft.fandom.com/zh/wiki/数据包#数据包版本 + 'https://zh.minecraft.wiki/w/数据包#数据包版本 End Select McLaunchLog("正在构建自定义皮肤资源包，格式为：" & PackFormat) '准备文件 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb index f3b9d73..84288a8 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb @@ -1958,9 +1958,7 @@ NextVersion: 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) + Urls.Add(Token.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 @@ -1974,8 +1972,8 @@ NextVersion: 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) + Urls.Add("https://download.mcbbs.net" & OptiFineBase) + Urls.Add("https://bmclapi2.bangbang93.com" & OptiFineBase) ElseIf Urls.Count <= 2 Then '普通文件 Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/"))) @@ -2188,7 +2186,7 @@ NextVersion: '检查文件是否存在 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 + (Not CheckHash OrElse Token.Hash Is Nothing OrElse Token.Hash = GetFileSHA1(Token.LocalPath)) Then Continue For '文件不存在，添加下载 Result.Add(New NetFile(DlSourceResourceGet("https://resources.download.minecraft.net/" & Left(Token.Hash, 2) & "/" & Token.Hash), Token.LocalPath, New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.Hash))) Next diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb index 4088f1b..8789d74 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb @@ -274,31 +274,25 @@ Public Module ModMod If IsLoaded AndAlso Not ForceReload Then Exit Sub '初始化 Init() - '阶段 1：基础可用性检查 - Dim Jar As ZipArchive + Dim Jar As ZipArchive = Nothing Try - '打开 Jar 文件 + '阶段 1：基础可用性检查、打开 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("文件内容为空") + '阶段 2：信息获取 + LoadWithoutClass(Jar) + '阶段 3: Class 信息获取 + If Not IsInfoWithoutClassAvailable Then LoadWithClass(Jar) Catch ex As UnauthorizedAccessException Log(ex, "Mod 文件由于无权限无法打开（" & Path & "）", LogLevel.Developer) _FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限，请尝试右键以管理员身份运行 PCL", 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 + Finally If Jar IsNot Nothing Then Jar.Dispose() - Catch End Try '完成标记 IsLoaded = True @@ -695,6 +689,85 @@ VersionFindFail: IsInfoWithClassAvailable = _ModId IsNot Nothing AndAlso _Version IsNot Nothing End Sub +#End Region + +#Region "网络信息" + + ''' + ''' 该 Mod 关联的网络项目。 + ''' + Public Property Comp As CompProject + Get + Return _Comp + End Get + Set(value As CompProject) + _Comp = value + RaiseEvent OnGetCompProject(Me) + End Set + End Property + Private _Comp As CompProject + Public IsCompFromModrinth = False + Public Event OnGetCompProject(sender As McMod) + + ''' + ''' 获取用于 CurseForge 信息获取的 Hash 值（MurmurHash2）。 + ''' + Public ReadOnly Property CurseForgeHash As UInteger + Get + If _CurseForgeHash Is Nothing Then + '读取文件 + Dim data As New List(Of Byte) + For Each b As Byte In File.ReadAllBytes(Path) + If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For + data.Add(b) + Next + '计算 MurmurHash2 + Dim length As Integer = data.Count + Dim h As UInteger = 1 Xor length '1 是种子 + Dim i As Integer + For i = 0 To length - 4 Step 4 + Dim k As UInteger = data(i) Or CUInt(data(i + 1)) << 8 Or CUInt(data(i + 2)) << 16 Or CUInt(data(i + 3)) << 24 + k = (k * &H5BD1E995L) And &HFFFFFFFFL + k = k Xor (k >> 24) + k = (k * &H5BD1E995L) And &HFFFFFFFFL + h = (h * &H5BD1E995L) And &HFFFFFFFFL + h = h Xor k + Next + Select Case length - i + Case 3 + h = h Xor (data(i) Or CUInt(data(i + 1)) << 8) + h = h Xor (CUInt(data(i + 2)) << 16) + h = (h * &H5BD1E995L) And &HFFFFFFFFL + Case 2 + h = h Xor (data(i) Or CUInt(data(i + 1)) << 8) + h = (h * &H5BD1E995L) And &HFFFFFFFFL + Case 1 + h = h Xor data(i) + h = (h * &H5BD1E995L) And &HFFFFFFFFL + End Select + h = h Xor (h >> 13) + h = (h * &H5BD1E995L) And &HFFFFFFFFL + h = h Xor (h >> 15) + _CurseForgeHash = h + End If + Return _CurseForgeHash + End Get + End Property + Private _CurseForgeHash As UInteger? + + ''' + ''' 获取用于 Modrinth 信息获取的 Hash 值（SHA1）。 + ''' + Public ReadOnly Property ModrinthHash As String + Get + If _ModrinthHash Is Nothing Then + _ModrinthHash = GetFileSHA1(Path) + End If + Return _ModrinthHash + End Get + End Property + Private _ModrinthHash As String + #End Region ''' @@ -741,18 +814,49 @@ VersionFindFail: End If '确定是否显示进度 - Loader.Progress = 0.03 - If ModFileList.Count > 100 Then RunInUi(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = True) + Loader.Progress = 0.05 + If ModFileList.Count > 50 Then RunInUi(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = True) - '加载为 Mod 列表 + '获取本地文件缓存 + Dim CachePath As String = PathTemp & "Cache\LocalMod.json" + Dim Cache As New JObject + Try + Dim CacheContent As String = ReadFile(CachePath) + If CacheContent <> "" Then + Cache = GetJson(CacheContent) + If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then + Log($"[Mod] 本地 Mod 信息缓存版本已过期，将弃用这些缓存信息") + Cache = New JObject + End If + End If + Catch ex As Exception + Log(ex, "读取本地 Mod 信息缓存失败，已重置") + End Try + Cache("version") = LocalModCacheVersion + + '加载 Mod 列表 Dim ModList As New List(Of McMod) + Dim ModUpdateList 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 + Loader.Progress += 0.95 / ModFileList.Count + If Loader.IsAborted Then Exit Sub + '加载 McMod 对象 + Dim ModEntry As New McMod(ModFile.FullName) + ModEntry.Load() + ModList.Add(ModEntry) + '读取 Comp 缓存 + If ModEntry.State = McMod.McModState.Unavaliable Then Continue For + Dim Hash = ModEntry.ModrinthHash + If Cache.ContainsKey(Hash) Then + ModEntry.Comp = New CompProject(Cache(Hash)) + ModEntry.IsCompFromModrinth = Not ModEntry.Comp.FromCurseForge + '如果缓存中的信息在 6 小时以内更新过，则无需重新获取 + If Date.Now - Cache(Hash)("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For + End If + ModUpdateList.Add(ModEntry) Next - Loader.Progress = 0.93 + Loader.Progress = 0.99 + Log($"[Mod] 共有 {ModList.Count} 个 Mod，其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息，{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息") '排序 ModList = Sort(ModList, Function(Left As McMod, Right As McMod) As Boolean @@ -762,18 +866,158 @@ VersionFindFail: Return Not Right.FileName.CompareTo(Left.FileName) End If End Function) - Loader.Progress = 0.98 '回设 If Loader.IsAborted Then Exit Sub Loader.Output = ModList + '开始联网加载 + If ModUpdateList.Any() Then + McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True) + End If + + Loader.Progress = 1 Catch ex As Exception Log(ex, "Mod 列表加载失败", LogLevel.Debug) Throw End Try End Sub + '联网加载 Mod 详情 + Private Const LocalModCacheVersion As Integer = 1 + Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad) + Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)) + Dim Mods As List(Of McMod) = Loader.Input.Key + Dim Cache As JObject = Loader.Input.Value + '获取作为检查目标的加载器和版本 + Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version + Dim ModLoaders As New List(Of String) + If TargetMcVersion.HasForge Then ModLoaders.Add("forge") + If TargetMcVersion.HasFabric Then ModLoaders.Add("fabric") + If TargetMcVersion.HasLiteLoader Then ModLoaders.Add("liteloader") + If Not ModLoaders.Any() Then ModLoaders.AddRange({"forge", "fabric", "liteloader"}) + Dim McVersions As New List(Of String) From {TargetMcVersion.McName} + If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then + McVersions.Add($"1.{TargetMcVersion.McCodeMain}") + For i = 1 To TargetMcVersion.McCodeSub + McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}") + Next + End If + McVersions = McVersions.Distinct().ToList() + '开始网络获取 + Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{McVersions.Join("/")}") + Dim CompletedThread As Integer = 0 + Dim MainThread As Thread = Thread.CurrentThread + '从 Modrinth 获取信息 + RunInNewThread( + Sub() + Try + '步骤 1：获取 Hash 与对应的工程 ID + Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList() + Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST", + $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1"", + ""loaders"": [""{ModLoaders.Join(""",""")}""],""game_versions"": [""{McVersions.Join(""",""")}""]}}", "application/json")), JObject) + Log($"[Mod] 从 Modrinth 获取到 {ModrinthUpdate.Count} 个本地 Mod 的对应信息") + '步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系 + If ModrinthUpdate.Count = 0 Then Exit Sub + Dim ModrinthMapping As New Dictionary(Of String, McMod) + For Each ModEntity In Mods + If Not ModrinthUpdate.ContainsKey(ModEntity.ModrinthHash) Then Continue For + Dim ProjectId = ModrinthUpdate(ModEntity.ModrinthHash)("project_id").ToString + If CompProjectCache.ContainsKey(ProjectId) Then + ModEntity.Comp = CompProjectCache(ProjectId) + Else + ModrinthMapping.Add(ProjectId, ModEntity) + End If + Next + If Loader.IsAbortedWithThread(MainThread) Then Exit Sub + Log($"[Mod] 读取缓存后还需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息") + '步骤 3：获取工程信息 + If Not ModrinthMapping.Any() Then Exit Sub + Dim ModrinthProject = CType(GetJson(NetRequestRetry( + $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]", + "GET", "", "application/json")), JArray) + For Each ProjectJson In ModrinthProject + Dim Project As New CompProject(ProjectJson) + Dim Entry = ModrinthMapping(Project.Id) + If Entry.Comp IsNot Nothing AndAlso Not Entry.IsCompFromModrinth Then + Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 部分 Logo 加载不出来 + End If + Entry.IsCompFromModrinth = True + Entry.Comp = Project + Next + Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束") + Catch ex As Exception + Log(ex, "从 Modrinth 获取本地 Mod 信息失败") + Finally + CompletedThread += 1 + End Try + End Sub, "Mod List Detail Loader Modrinth") + '从 CurseForge 获取信息 + RunInNewThread( + Sub() + Try + '步骤 1：获取 Hash 与对应的工程 ID + Dim CurseForgeHashes As New List(Of UInteger) + For Each ModEntity In Mods + CurseForgeHashes.Add(ModEntity.CurseForgeHash) + If Loader.IsAbortedWithThread(MainThread) Then Exit Sub + Next + Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST", + $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer) + Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息") + '步骤 2：尝试读取工程信息缓存，构建其他 Mod 的对应关系 + If CurseForgeRaw.Count = 0 Then Exit Sub + Dim CurseForgeMapping As New Dictionary(Of Integer, McMod) + For Each Project In CurseForgeRaw + Dim ProjectId = Project("id").ToString + Dim Hash As UInteger = Project("file")("fileFingerprint") + Dim ModEntity = Mods.Find(Function(m) m.CurseForgeHash = Hash) + If CompProjectCache.ContainsKey(ProjectId) Then + ModEntity.Comp = CompProjectCache(ProjectId) + Else + CurseForgeMapping.Add(ProjectId, ModEntity) + End If + Next + If Loader.IsAbortedWithThread(MainThread) Then Exit Sub + Log($"[Mod] 读取缓存后还需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息") + '步骤 3：获取工程信息 + If Not CurseForgeMapping.Any() Then Exit Sub + Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST", + $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data") + For Each ProjectJson In CurseForgeProject + Dim Project As New CompProject(ProjectJson) + Dim Entry = CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏 + If Entry.Comp IsNot Nothing AndAlso Entry.IsCompFromModrinth Then + Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来 + Entry.Comp = Entry.Comp '再次触发修改事件 + Continue For + End If + Entry.IsCompFromModrinth = False + Entry.Comp = Project + Next + Log($"[Mod] 从 CurseForge 获取本地 Mod 信息结束") + Catch ex As Exception + Log(ex, "从 CurseForge 获取本地 Mod 信息失败") + Finally + CompletedThread += 1 + End Try + End Sub, "Mod List Detail Loader CurseForge") + '等待线程结束 + Do Until CompletedThread = 2 + If Loader.IsAborted Then Exit Sub + Thread.Sleep(10) + Loop + '保存缓存 + Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList() + Log($"[Mod] 联网获取本地 Mod 信息完成，为 {Mods.Count} 个 Mod 更新缓存") + If Not Mods.Any() Then Exit Sub + For Each ModEntity In Mods + Cache(ModEntity.ModrinthHash) = ModEntity.Comp.ToJson() + Next + WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) + End Sub + #If DEBUG Then ''' ''' 检查 Mod 列表中存在的错误，返回错误信息的集合。 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml b/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml index cde9262..8fd7bae 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml +++ b/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml @@ -29,15 +29,15 @@ - + - + - textBlock.ActualWidth + End Function + + 'Tag + Public WriteOnly Property Tags As List(Of String) + Set(value As List(Of String)) + PanTags.Children.Clear() + PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed) + For Each TagText In value + Dim NewTag = GetObjectFromXML( + " + + ") + PanTags.Children.Add(NewTag) + Next + End Set + End Property + #End Region #Region "点击" @@ -104,13 +171,28 @@ RetryStart: Log("[Comp] 记录当前已展开的卡片：" & String.Join("、", Titles)) FrmMain.PageCurrent.Additional(1) = Titles End If - FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, .Additional = {sender.Tag, New List(Of String)}}) + '打开详情页 + Dim TargetVersion As String, TargetLoader As CompModLoaderType + Select Case CType(sender.Tag, CompProject).Type + Case CompType.Mod + TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "") + Case CompType.ModPack + TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "") + Case Else 'CompType.ResourcePack + 'FUTURE: Res + TargetVersion = "" 'If(PageDownloadResource.Loader.Input.GameVersion, "") + End Select + If CType(sender.Tag, CompProject).Type = CompType.Mod AndAlso PageDownloadMod.Loader.Input.ModLoader <> CompModLoaderType.Any Then + TargetLoader = PageDownloadMod.Loader.Input.ModLoader + End If + FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, + .Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader}}) End Sub '鼠标点击判定 Private IsMouseDown As Boolean = False Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown - If IsMouseOver Then IsMouseDown = True + If IsMouseOver AndAlso CanInteraction Then IsMouseDown = True End Sub Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp IsMouseDown = False @@ -151,9 +233,12 @@ RetryStart: #End Region Private StateLast As String - Public HasAnimation As Boolean = True + ''' + ''' 是否允许交互。目前仅用于 PageDownloadCompDetail 的顶部栏展示：若关闭碰撞检测，则无法展开 Tooltip。 + ''' + Public CanInteraction 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 + If Not CanInteraction Then Exit Sub '判断当前颜色 Dim StateNew As String, Time As Integer If IsMouseOver Then @@ -200,20 +285,4 @@ RetryStart: 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/Modules/Minecraft/MyLocalModItem.xaml b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml new file mode 100644 index 0000000..f7470c2 --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml @@ -0,0 +1,43 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb new file mode 100644 index 0000000..6eaf88e --- /dev/null +++ b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb @@ -0,0 +1,453 @@ +Imports System.Windows.Forms + +Public Class MyLocalModItem + +#Region "基础属性" + Public Uuid As Integer = GetUuid() + + '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 & "CompLogo\" & GetHash(_Logo) & ".png" + Try + If _Logo.ToLower.StartsWith("http") Then + '网络图片 + If File.Exists(FileAddress) Then + PathLogo.Source = New MyBitmap(FileAddress) + ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo + Log($"[LocalModItem] 发现不支持的 WebP 格式图标，已更改为默认图标：{_Logo}") + PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png") + Else + PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png") + RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal) + End If + Else + '位图 + PathLogo.Source = New MyBitmap(_Logo) + End If + Catch ex As IOException + Log(ex, "加载本地 Mod 图标时读取失败（" & FileAddress & "）") + Catch ex As ArgumentException + '考虑缓存的图片本身可能有误 + Log(ex, "可视化本地 Mod 图标失败（" & FileAddress & "）") + Try + File.Delete(FileAddress) + Log("[LocalModItem] 已清理损坏的本地 Mod 图标：" & FileAddress) + Catch exx As Exception + Log(exx, "清理损坏的本地 Mod 图标缓存失败（" & FileAddress & "）", LogLevel.Hint) + End Try + Catch ex As Exception + Log(ex, "加载本地 Mod 图标失败（" & value & "）") + End Try + End Set + End Property + '后台加载 Logo + Private Sub LogoLoader(Address As String) + Dim Retry As Boolean = False + Dim DownloadEnd As String = GetUuid() +RetryStart: + Try + NetDownload(_Logo, Address & DownloadEnd) + Dim LoadError As Exception = Nothing + RunInUiWait(Sub() + Try + '在地址更换时取消加载 + If Not Address = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png" Then Exit Sub + '在完成正常加载后才保存缓存图片 + PathLogo.Source = New MyBitmap(Address & DownloadEnd) + Catch ex As Exception + Log(ex, "读取本地 Mod 图标失败（" & Address & "）") + File.Delete(Address & DownloadEnd) + LoadError = ex + End Try + End Sub) + If LoadError IsNot Nothing Then Throw LoadError + 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, $"下载本地 Mod 图标失败（{_Logo}）") + RunInUi(Sub() PathLogo.Source = New MyBitmap("pack://application:,,,/images/Icons/NoIcon.png")) + End If + End Try + End Sub + + '标题 + Private _Title As String + Public Property Title As String + Get + Return _Title + End Get + Set(value As String) + Dim RawValue = value + Select Case Entry.State + Case McMod.McModState.Disabled + value &= " [禁用]" + Case McMod.McModState.Unavaliable + value &= " [错误]" + End Select + If LabTitle.Text = value Then Exit Property + LabTitle.Text = value + _Title = RawValue + End Set + End Property + + '副标题 + Public Property SubTitle As String + Get + Return If(LabTitleRaw?.Text, "") + End Get + Set(value As String) + If LabTitleRaw.Text = value Then Exit Property + LabTitleRaw.Text = value + LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible) + End Set + End Property + + '描述 + Public Property Description As String + Get + Return LabInfo.Text + End Get + Set(value As String) + If LabInfo.Text = value Then Exit Property + LabInfo.Text = value + End Set + End Property + + 'Tag + Public WriteOnly Property Tags As List(Of String) + Set(value As List(Of String)) + PanTags.Children.Clear() + PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed) + For Each TagText In value + Dim NewTag = GetObjectFromXML( + " + + ") + PanTags.Children.Add(NewTag) + Next + End Set + End Property + + '相关联的 Mod + Public Property Entry As McMod + Get + Return Tag + End Get + Set(value As McMod) + Tag = value + End Set + End Property + + '前景色绑定 + 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(MyLocalModItem), New PropertyMetadata(CType(Color1, SolidColorBrush))) + +#End Region + +#Region "点击与勾选" + + '触发点击事件 + Public Event Click(sender As Object, e As MouseButtonEventArgs) + Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp + If IsMouseDown Then + RaiseEvent Click(sender, e) + If e.Handled Then Exit Sub + Log("[Control] 按下本地 Mod 列表项：" & LabTitle.Text) + End If + End Sub + + '鼠标点击判定 + Private IsMouseDown As Boolean = False + Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonDown + If Not IsMouseDirectlyOver Then Exit Sub + IsMouseDown = True + If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = False + End Sub + Private Sub Button_MouseLeave(sender As Object, e As Object) Handles Me.MouseLeave, Me.PreviewMouseLeftButtonUp + IsMouseDown = False + If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True + End Sub + + '勾选状态 + Public Event Check(sender As Object, e As RouteEventArgs) + Public Event Changed(sender As Object, e As RouteEventArgs) + Private _Checked As Boolean = False + Public Property Checked As Boolean + Get + Return _Checked + End Get + Set(value As Boolean) + Try + '触发属性值修改 + Dim ChangedEventArgs As New RouteEventArgs(False) + Dim RawValue = _Checked + If value = _Checked Then Exit Property + _Checked = value + If IsInitialized Then + RaiseEvent Changed(Me, ChangedEventArgs) + If ChangedEventArgs.Handled Then + _Checked = RawValue + Exit Property + End If + End If + If value Then + Dim CheckEventArgs As New RouteEventArgs(False) + RaiseEvent Check(Me, CheckEventArgs) + If CheckEventArgs.Handled Then Exit Property + End If + '更改动画 + If IsVisibleInForm() Then + Dim Anim As New List(Of AniData) + If Checked Then + '由无变有 + Dim Delta = 32 - RectCheck.ActualHeight + Anim.Add(AaHeight(RectCheck, Delta * 0.4, 200,, New AniEaseOutFluent(AniEasePower.Weak))) + Anim.Add(AaHeight(RectCheck, Delta * 0.6, 300,, New AniEaseOutBack(AniEasePower.Weak))) + Anim.Add(AaOpacity(RectCheck, 1 - RectCheck.Opacity, 30)) + RectCheck.VerticalAlignment = VerticalAlignment.Center + RectCheck.Margin = New Thickness(-3, 0, 0, 0) + Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush2", 200)) + Else + '由有变无 + Anim.Add(AaHeight(RectCheck, -RectCheck.ActualHeight, 120,, New AniEaseInFluent(AniEasePower.Weak))) + Anim.Add(AaOpacity(RectCheck, -RectCheck.Opacity, 70, 40)) + RectCheck.VerticalAlignment = VerticalAlignment.Center + Anim.Add(AaColor(Me, ForegroundProperty, "ColorBrush1", 120)) + End If + AniStart(Anim, "MyLocalModItem Checked " & Uuid) + Else + '不在窗口上时直接设置 + RectCheck.VerticalAlignment = VerticalAlignment.Center + RectCheck.Margin = New Thickness(-3, 0, 0, 0) + If Checked Then + RectCheck.Height = 32 + RectCheck.Opacity = 1 + Foreground = CType(FindResource("ColorBrush2"), SolidColorBrush) + Else + RectCheck.Height = 0 + RectCheck.Opacity = 0 + Foreground = CType(FindResource("ColorBrush1"), SolidColorBrush) + End If + AniStop("MyLocalModItem Checked " & Uuid) + End If + + Catch ex As Exception + Log(ex, "设置 Checked 失败") + End Try + End Set + End Property + Private Sub ColorInit(sender As Object, e As RoutedEventArgs) Handles Me.Loaded + SetResourceReference(ForegroundProperty, "ColorBrush1") + End Sub + + +#End Region + +#Region "后加载内容" + + '右下角状态指示图标 + Private ImgState As Image + + '指向背景 + Private _RectBack As Border = Nothing + Public ReadOnly Property RectBack As Border + Get + If _RectBack Is Nothing Then + Dim Rect As New Border With { + .Name = "RectBack", + .CornerRadius = New CornerRadius(3), + .RenderTransform = New ScaleTransform(0.8, 0.8), + .RenderTransformOrigin = New Point(0.5, 0.5), + .BorderThickness = New Thickness(GetWPFSize(1)), + .SnapsToDevicePixels = True, + .IsHitTestVisible = False, + .Opacity = 0 + } + Rect.SetResourceReference(Border.BackgroundProperty, "ColorBrush7") + Rect.SetResourceReference(Border.BorderBrushProperty, "ColorBrush6") + SetColumnSpan(Rect, 999) + SetRowSpan(Rect, 999) + Children.Insert(0, Rect) + _RectBack = Rect + ' + End If + Return _RectBack + End Get + End Property + + '按钮 + Public ButtonHandler As Action(Of MyLocalModItem, EventArgs) + Public ButtonStack As FrameworkElement + Private _Buttons As IEnumerable(Of MyIconButton) + Public Property Buttons As IEnumerable(Of MyIconButton) + Get + Return _Buttons + End Get + Set(value As IEnumerable(Of MyIconButton)) + _Buttons = value + '移除原 Stack + If ButtonStack IsNot Nothing Then + Children.Remove(ButtonStack) + ButtonStack = Nothing + End If + If value.Count = 0 Then Exit Property + '添加新 Stack + ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal, + .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False} + SetColumnSpan(ButtonStack, 10) : SetRowSpan(ButtonStack, 10) + '构造按钮 + For Each Btn As MyIconButton In value + If Btn.Height.Equals(Double.NaN) Then Btn.Height = 25 + If Btn.Width.Equals(Double.NaN) Then Btn.Width = 25 + CType(ButtonStack, StackPanel).Children.Add(Btn) + Next + Children.Add(ButtonStack) + End Set + End Property + + '勾选条 + Private _RectCheck As Border + Public ReadOnly Property RectCheck As Border + Get + If _RectCheck Is Nothing Then + _RectCheck = New Border With {.Width = 5, .Height = If(Checked, Double.NaN, 0), .CornerRadius = New CornerRadius(2, 2, 2, 2), + .VerticalAlignment = If(Checked, VerticalAlignment.Stretch, VerticalAlignment.Center), + .HorizontalAlignment = HorizontalAlignment.Left, .UseLayoutRounding = False, .SnapsToDevicePixels = False, + .Margin = If(Checked, New Thickness(-3, 6, 0, 6), New Thickness(-3, 0, 0, 0))} + _RectCheck.SetResourceReference(Border.BackgroundProperty, "ColorBrush3") + SetRowSpan(_RectCheck, 10) + Children.Add(_RectCheck) + End If + Return _RectCheck + End Get + End Property + +#End Region + + Public Sub Refresh() + RunInUi( + Sub() + '标题 + If Entry.Comp Is Nothing Then + Title = Entry.Name + SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version) + Else + Dim Titles = Entry.Comp.GetControlTitle(False) + Title = Titles.Key + SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version) + End If + '描述 + Dim NewDescription As String + Select Case Entry.State + Case McMod.McModState.Fine + NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path) + Case McMod.McModState.Disabled + NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Substring(0, Entry.Path.Count - ".disabled".Count)) + Case Else 'McMod.McModState.Unavaliable + NewDescription = GetFileNameFromPath(Entry.Path) + End Select + If Entry.Comp IsNot Nothing Then + NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "") + ElseIf Entry.Description IsNot Nothing Then + NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "") + ElseIf Not Entry.IsFileAvailable Then + NewDescription += ": " & "存在错误，无法获取信息" + End If + Description = NewDescription + '主 Logo + Logo = If(Entry.Comp Is Nothing, "pack://application:,,,/images/Icons/NoIcon.png", Entry.Comp.GetControlLogo()) + '图标右下角的 Logo + If Entry.State = McMod.McModState.Fine Then + If ImgState IsNot Nothing Then + Children.Remove(ImgState) + ImgState = Nothing + End If + Else + If ImgState Is Nothing Then + ImgState = New Image With { + .Width = 17, .Height = 17, .Margin = New Thickness(0, 0, -4, -3), .IsHitTestVisible = False, + .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom + } + RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality) + SetColumn(ImgState, 1) : SetRow(ImgState, 1) : SetRowSpan(ImgState, 2) + Children.Add(ImgState) + ' + End If + ImgState.Source = New MyBitmap($"pack://application:,,,/images/Icons/{Entry.State}.png") + End If + '标签 + If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags + End Sub) + End Sub + + Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed + '按钮虚拟化检测 + If ButtonHandler IsNot Nothing Then + ButtonHandler(sender, e) + ButtonHandler = Nothing + End If + '触发颜色动画 + Dim Time As Integer = If(IsMouseOver, 120, 180) + Dim Ani As New List(Of AniData) + 'ButtonStack + If ButtonStack IsNot Nothing Then + If IsMouseOver Then + Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3)) + Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)), + 5 + Buttons.Count * 25 - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7)) + Else + Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.4)) + Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)), + 4 - ColumnPaddingRight.Width.Value, Time * 0.4)) + End If + End If + 'RectBack + If IsMouseOver OrElse Checked Then + Ani.AddRange({ + AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time), + AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent) + }) + If IsMouseDown Then + Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent)) + Else + Ani.Add(AaScaleTransform(RectBack, 1 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent)) + End If + Else + Ani.AddRange({ + AaOpacity(RectBack, -RectBack.Opacity, Time), + AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent), + AaScaleTransform(RectBack, -0.196, 1,,, True) + }) + End If + AniStart(Ani, "LocalModItem Color " & Uuid) + End Sub + +End Class diff --git a/Plain Craft Launcher 2/Modules/ModMusic.vb b/Plain Craft Launcher 2/Modules/ModMusic.vb index 1f8f7d7..ed1a234 100644 --- a/Plain Craft Launcher 2/Modules/ModMusic.vb +++ b/Plain Craft Launcher 2/Modules/ModMusic.vb @@ -46,7 +46,7 @@ ''' Private Function DequeueNextMusicAddress() As String '初始化，确保存在音乐 - If MusicAllList Is Nothing OrElse MusicAllList.Count = 0 Then MusicListInit(False) + If MusicAllList Is Nothing OrElse MusicAllList.Count = 0 OrElse MusicWaitingList.Count = 0 Then MusicListInit(False) '出列下一个音乐，如果出列结束则生成新列表 DequeueNextMusicAddress = MusicWaitingList(0) MusicWaitingList.RemoveAt(0) @@ -267,6 +267,7 @@ '当前音乐已播放结束，继续下一曲 If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress) Catch ex As Exception + Log("[Music] 播放音乐失败的文件完整路径：" & MusicCurrent) If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical) ElseIf Not (MusicCurrent.ToLower.EndsWith(".wav") OrElse MusicCurrent.ToLower.EndsWith(".mp3") OrElse MusicCurrent.ToLower.EndsWith(".flac")) Then @@ -274,10 +275,11 @@ Else Log(ex, "播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）", LogLevel.Hint) End If - Log(ex, "播放音乐失败（" & MusicCurrent & "）", LogLevel.Developer) - If MusicAllList.Count > 1 Then - Thread.Sleep(1000) - MusicStartPlay(DequeueNextMusicAddress, IsFirstLoad) + Thread.Sleep(1000) + If TypeOf ex Is FileNotFoundException Then + MusicRefreshPlay(True, IsFirstLoad) + ElseIf MusicAllList.Count > 1 Then + MusicStartPlay(DequeueNextMusicAddress(), IsFirstLoad) End If Finally If CurrentWave IsNot Nothing Then CurrentWave.Dispose() diff --git a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb index 226ee1a..147e981 100644 --- a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb +++ b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb @@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices ' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号 ' 方法是按如下所示使用“*” - - + + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb index 31b8124..3c51c07 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb @@ -190,7 +190,7 @@ Public Module ModDownloadLib 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} + Dim NewItem As New MyListItem With {.Logo = Logo, .SnapsToDevicePixels = True, .Title = Entry("id").ToString, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry} If Entry("lore") Is Nothing Then NewItem.Info = Entry("releaseTime").Value(Of Date).ToString("yyyy/MM/dd HH:mm") Else @@ -718,7 +718,7 @@ Retry: 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, + .Title = Entry.NameDisplay, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Info = If(Entry.IsPreview, "测试版", "正式版") & If(Entry.ReleaseTime = "", "", "，发布于 " & Entry.ReleaseTime) & If(Entry.RequiredForgeVersion Is Nothing, "，不兼容 Forge", If(Entry.RequiredForgeVersion = "", "", "，推荐 Forge 版本：" & Entry.RequiredForgeVersion)), @@ -844,17 +844,17 @@ Retry: '老版本 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") + Address.Add("https://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") + Address.Add("https://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") + Address.Add("https://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") + Address.Add("https://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") + Address.Add("https://dl.liteloader.com/redist/1.5.2/liteloader-installer-1.5.2-01.jar") Case Else Throw New NotSupportedException("未知的 Minecraft 版本（" & DownloadInfo.Inherit & "）") End Select @@ -921,7 +921,7 @@ Retry: 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/""}")) + CType(VersionJson("libraries"), JContainer).Add(GetJson("{""name"": ""com.mumfrey:liteloader:" & DownloadInfo.JsonToken("version").ToString & """,""url"": ""https://dl.liteloader.com/versions/""}")) VersionJson.Add("mainClass", "net.minecraft.launchwrapper.Launch") VersionJson.Add("minimumLauncherVersion", 18) VersionJson.Add("inheritsFrom", DownloadInfo.Inherit) @@ -949,7 +949,7 @@ Retry: 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, + .Title = Entry.Inherit, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Info = If(Entry.IsPreview, "测试版", "稳定版") & If(Entry.ReleaseTime = "", "", "，发布于 " & Entry.ReleaseTime), .Logo = "pack://application:,,,/images/Blocks/Egg.png" } @@ -965,10 +965,8 @@ Retry: 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) @@ -984,10 +982,8 @@ Retry: 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) @@ -1003,7 +999,7 @@ Retry: Else Version = sender.Tag.Tag End If - OpenWebsite("http://jenkins.liteloader.com/view/" & Version.Inherit) + OpenWebsite("https://jenkins.liteloader.com/view/" & Version.Inherit) End Sub Public Sub LiteLoaderSave_Click(sender As Object, e As RoutedEventArgs) 'ListItem 与小按钮都会调用这个方法 @@ -1107,7 +1103,7 @@ Retry: 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 + "https://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}) @@ -1326,7 +1322,7 @@ Retry: '添加主文件 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://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 @@ -1580,7 +1576,7 @@ Retry: 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, + .Title = Entry.Version, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .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), "")), @@ -1626,7 +1622,7 @@ Retry: 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") + OpenWebsite("https://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 @@ -1787,7 +1783,7 @@ Retry: 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, + .Title = Entry("version").ToString.Replace("+build", ""), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Info = If(Entry("stable").ToObject(Of Boolean), "稳定版", "测试版"), .Logo = "pack://application:,,,/images/Blocks/Fabric.png" } @@ -1798,7 +1794,7 @@ Retry: Public Function FabricApiDownloadListItem(Entry As CompFile, 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, + .Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Info = Entry.StatusDescription & "，发布于 " & Entry.ReleaseDate.ToString("yyyy/MM/dd HH:mm"), .Logo = "pack://application:,,,/images/Blocks/Fabric.png" } @@ -1809,7 +1805,7 @@ Retry: Public Function OptiFabricDownloadListItem(Entry As CompFile, 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, + .Title = Entry.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v"), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Info = Entry.StatusDescription & "，发布于 " & Entry.ReleaseDate.ToString("yyyy/MM/dd HH:mm"), .Logo = "pack://application:,,,/images/Blocks/OptiFabric.png" } diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb index 291aa3f..b113f75 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb @@ -1,6 +1,5 @@ Public Class PageDownloadCompDetail Private CompItem As MyCompItem = Nothing - Private Project As CompProject #Region "加载器" @@ -10,8 +9,12 @@ '初始化加载器信息 Private Sub PageDownloadCompDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized Project = FrmMain.PageCurrent.Additional(0) + TargetVersion = FrmMain.PageCurrent.Additional(2) + TargetLoader = FrmMain.PageCurrent.Additional(3) PageLoaderInit(Load, PanLoad, PanMain, CardIntro, CompFileLoader, AddressOf Load_OnFinish) End Sub + Private Project As CompProject + Private TargetVersion As String, TargetLoader As CompModLoaderType '自动重试 Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged Select Case CompFileLoader.State @@ -39,23 +42,8 @@ End Sub End Class Private Sub Load_OnFinish() - '获取目标版本与 Mod 加载器 - Dim TargetVersion As String - Select Case Project.Type - Case CompType.Mod - TargetVersion = If(PageDownloadMod.Loader.Input.GameVersion, "") - Case CompType.ModPack - TargetVersion = If(PageDownloadPack.Loader.Input.GameVersion, "") - Case Else 'CompType.ResourcePack - 'FUTURE: Res - TargetVersion = "" 'If(PageDownloadResource.Loader.Input.GameVersion, "") - End Select - Dim TargetLoader = CompModLoaderType.Any - If Project.Type = CompType.Mod AndAlso PageDownloadMod.Loader.Input.ModLoader <> CompModLoaderType.Any Then - TargetLoader = PageDownloadMod.Loader.Input.ModLoader - End If Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any, - $"目标版本：{TargetVersion} {If(TargetLoader <> CompModLoaderType.Any, TargetLoader, "")}", "") + $"所选版本：{TargetVersion} {If(TargetLoader <> CompModLoaderType.Any, TargetLoader, "")}", "") '初始化字典 Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New VersionSorterWithSelect(TargetCardName)) Dict.Add("未知版本", New List(Of CompFile)) @@ -144,8 +132,7 @@ '放置当前工程 If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem) CompItem = Project.ToCompItem(True, True) - CompItem.IsHitTestVisible = False - CompItem.HasAnimation = False + CompItem.CanInteraction = False CompItem.Margin = New Thickness(-7, -7, 0, 8) PanIntro.Children.Insert(0, CompItem) diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml index 35642d7..98c221b 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml @@ -26,7 +26,7 @@ - + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml index 491c058..da78a28 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml @@ -5,7 +5,7 @@ - @@ -13,10 +13,10 @@ - - @@ -25,7 +25,7 @@ - @@ -34,7 +34,7 @@ - @@ -43,7 +43,7 @@ - @@ -51,7 +51,7 @@ - @@ -60,7 +60,7 @@ - @@ -68,7 +68,7 @@ - diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb index f8ff085..da173ad 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb @@ -99,11 +99,13 @@ Case FormMain.PageSubType.DownloadMod PageDownloadMod.Storage = New CompProjectStorage PageDownloadMod.Page = 0 + CompProjectCache.Clear() If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart() ItemMod.Checked = True Case FormMain.PageSubType.DownloadPack PageDownloadPack.Storage = New CompProjectStorage PageDownloadPack.Page = 0 + CompProjectCache.Clear() If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart() ItemPack.Checked = True Case FormMain.PageSubType.DownloadClient diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml index f42b739..6aab1a8 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml @@ -33,6 +33,7 @@ + @@ -97,6 +98,7 @@ + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb index 02872ae..4fff1a6 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml.vb @@ -46,6 +46,13 @@ BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2) + '错误信息 + If Storage.ErrorMessage Is Nothing Then + HintError.Visibility = Visibility.Collapsed + Else + HintError.Visibility = Visibility.Visible + HintError.Text = Storage.ErrorMessage + End If '强制返回顶部 PanBack.ScrollToTop() Catch ex As Exception diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml index db1460b..c3e3cc4 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml @@ -32,6 +32,7 @@ + @@ -87,6 +88,7 @@ + diff --git a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml.vb index bb3eb66..d9cbd06 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml.vb @@ -45,6 +45,13 @@ BtnPageRight.IsEnabled = Storage.Results.Count > PageSize * (Page + 1) OrElse Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal BtnPageRight.Opacity = If(BtnPageRight.IsEnabled, 1, 0.2) + '错误信息 + If Storage.ErrorMessage Is Nothing Then + HintError.Visibility = Visibility.Collapsed + Else + HintError.Visibility = Visibility.Visible + HintError.Text = Storage.ErrorMessage + End If '强制返回顶部 PanBack.ScrollToTop() Catch ex As Exception diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb index e26a226..6ee13ca 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb @@ -236,7 +236,8 @@ Retry: {"Migrator", "迁移者披风"}, {"MapMaker", "Realms 地图制作者披风"}, {"Moderator", "Mojira 管理员披风"}, {"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"}, {"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"}, - {"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"} + {"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"}, + {"Cherry Blossom Cape", "樱花披风"}, {"CherryBlossomCape", "樱花披风"} } Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}} For Each Cape In SkinData("capes") diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb index 55e07e6..8a51c7d 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb @@ -92,6 +92,10 @@ Download: Log("[Page] 主页预设：简单主页") Url = "https://cdn.wearclub.online/PCL/Custom.xaml" GoTo Download + Case 4 '历史上的今天 + Log("[Page] 主页预设：历史上的今天") + Url = "https://pclnews.52chye.cn/custom.xaml" + GoTo Download End Select End Select RunInUi(Sub() LoadContent(Content)) diff --git a/Plain Craft Launcher 2/Pages/PageLink/PageLinkFeedback.xaml b/Plain Craft Launcher 2/Pages/PageLink/PageLinkFeedback.xaml index b2a0919..c7e5d97 100644 --- a/Plain Craft Launcher 2/Pages/PageLink/PageLinkFeedback.xaml +++ b/Plain Craft Launcher 2/Pages/PageLink/PageLinkFeedback.xaml @@ -14,23 +14,23 @@ Margin="0,0,0,6" /> + Logo="pack://application:,,,/images/Blocks/Grass.png" /> + Logo="pack://application:,,,/images/Blocks/Grass.png" /> + Logo="pack://application:,,,/images/Blocks/Grass.png" /> + Logo="pack://application:,,,/images/Blocks/RedstoneBlock.png" /> diff --git a/Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb b/Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb index eec5ebe..656ac59 100644 --- a/Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLink/PageLinkHiper.xaml.vb @@ -197,7 +197,7 @@ Reopen: GoTo FinishHiperFileCheck End If Log("[Hiper] hiper.exe 的所需 SHA1：" & ChecksumHiper) - If ChecksumHiper = GetAuthSHA1(PathHiper & "HiPer 联机模块.exe") Then + If ChecksumHiper = GetFileSHA1(PathHiper & "HiPer 联机模块.exe") Then Log("[Hiper] hiper.exe 文件校验通过，无需重新下载") GoTo FinishHiperFileCheck End If @@ -233,7 +233,7 @@ FinishHiperFileCheck: GoTo FinishWintunFileCheck End If Log("[Hiper] wintun.dll 的所需 SHA1：" & ChecksumWintun) - If ChecksumWintun = GetAuthSHA1(PathHiper & "wintun.dll") Then + If ChecksumWintun = GetFileSHA1(PathHiper & "wintun.dll") Then Log("[Hiper] wintun.dll 文件校验通过，无需重新下载") GoTo FinishWintunFileCheck End If @@ -269,7 +269,7 @@ FinishWintunFileCheck: GoTo FinishMcbFileCheck End If Log("[Hiper] mcb.exe 的所需 SHA1：" & ChecksumMcb) - If ChecksumMcb = GetAuthSHA1(PathHiper & "MCB 联机模块.exe") Then + If ChecksumMcb = GetFileSHA1(PathHiper & "MCB 联机模块.exe") Then Log("[Hiper] mcb.exe 文件校验通过，无需重新下载") GoTo FinishMcbFileCheck End If diff --git a/Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb b/Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb index 8d7a317..6fad614 100644 --- a/Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLink/PageLinkIoi.xaml.vb @@ -851,7 +851,6 @@ Done: Public Function ToListItem() As MyListItem Dim Item As New MyListItem With { .Title = DisplayName, .Height = 42, .Tag = Me, .Type = MyListItem.CheckType.None, - .PaddingRight = 60, .Logo = "pack://application:,,,/images/Blocks/Grass.png"} '绑定图标按钮 Dim BtnRefresh As New MyIconButton With {.Logo = Logo.IconButtonRefresh, .LogoScale = 0.85, .ToolTip = "刷新", .Tag = Me} @@ -941,7 +940,7 @@ Done: End Function Public Function ToListItem() As MyListItem Dim Item As New MyListItem With { - .Title = DisplayName, .Height = 42, .Info = GetDescription(), .Tag = Me, .PaddingRight = If(IsOwner, 60, 0), + .Title = DisplayName, .Height = 42, .Info = GetDescription(), .Tag = Me, .Type = If(IsOwner, MyListItem.CheckType.None, MyListItem.CheckType.Clickable), .Logo = "pack://application:,,,/images/Blocks/" & If(IsOwner, "GrassPath", "Grass") & ".png"} If IsOwner Then diff --git a/Plain Craft Launcher 2/Pages/PageLink/PageLinkLeft.xaml b/Plain Craft Launcher 2/Pages/PageLink/PageLinkLeft.xaml index d599911..bf07b19 100644 --- a/Plain Craft Launcher 2/Pages/PageLink/PageLinkLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageLink/PageLinkLeft.xaml @@ -7,7 +7,7 @@ mc:Ignorable="d" AnimatedControl="{Binding ElementName=PanItem}" MinWidth="150"> - @@ -17,7 +17,7 @@ - @@ -28,17 +28,17 @@ - - + - - diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml index bf1e472..119a07c 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml @@ -3,7 +3,7 @@ xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}"> - @@ -11,13 +11,13 @@ - - - - diff --git a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb index 3dba754..66a8d42 100644 --- a/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb @@ -71,7 +71,7 @@ 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} + Dim NewItem As New MyListItem With {.IsScaleAnimationEnabled = False, .Type = MyListItem.CheckType.RadioBox, .MinPaddingRight = 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) diff --git a/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb index 215b136..1709a4a 100644 --- a/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb @@ -111,7 +111,7 @@ 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} + Dim NewItem As New MyListItem With {.Title = Version.Name, .Info = Version.Info, .Height = 42, .Tag = Version, .SnapsToDevicePixels = True, .Type = MyListItem.CheckType.Clickable} Try If Version.Logo.EndsWith("PCL\Logo.png") Then NewItem.Logo = Version.Path & "PCL\Logo.png" '修复老版本中，存储的自定义 Logo 使用完整路径，导致移动后无法加载的 Bug diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml index c7319cd..795f41e 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLeft.xaml @@ -4,34 +4,34 @@ xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d" x:Class="PageSetupLeft" d:DesignWidth="152" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}"> - - + - + - + - - + - - + diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml index b53b0f3..32d8fde 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml @@ -3,17 +3,17 @@ xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}"> - - - + - @@ -21,7 +21,7 @@ - diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb index 4059675..9f33fed 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb @@ -89,7 +89,14 @@ Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用 '强制刷新 - If FrmVersionMod IsNot Nothing Then FrmVersionMod.RefreshList(True) '没有 Else，还没加载刷个鬼的新 + Try + CompProjectCache.Clear() + File.Delete(PathTemp & "Cache\LocalMod.json") + Log("[Mod] 由于点击刷新按钮，清理本地 Mod 信息缓存") + Catch ex As Exception + Log(ex, "强制刷新时清理本地 Mod 信息缓存失败") + End Try + If FrmVersionMod IsNot Nothing Then FrmVersionMod.RefreshList(True) '无需 Else，还没加载刷个鬼的新 ItemMod.Checked = True Hint("正在刷新……", Log:=False) End Sub diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml index 2df274d..6f37548 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml @@ -9,23 +9,21 @@ - - - - - - - - - - - - - - + + + + + + + + + + + + + - diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb index 686fa06..18a5492 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb @@ -67,7 +67,7 @@ SearchBox.Text = "" '建立 StackPanel - PanItems = New StackPanel With {.Margin = New Thickness(18, MyCard.SwapedHeight, 18, If(List.Count > 0, 20, 0)), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0)} + PanItems = New StackPanel With {.Margin = New Thickness(20, 38, 18, If(List.Count > 0, 20, 0)), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0)} For Each ModEntity As McMod In List PanItems.Children.Add(McModListItem(ModEntity)) Next @@ -95,63 +95,20 @@ If Counter(McMod.McModState.Unavaliable) > 0 Then TypeList.Add("错误 " & Counter(McMod.McModState.Unavaliable)) Return "Mod 列表（" & Join(TypeList, "，") & "）" 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 - '实例化 + Private Function McModListItem(Entry As McMod) As MyLocalModItem AniControlEnabled += 1 - Dim NewItem As New MyListItem With { - .LogoClickable = True, .Logo = Logo, .SnapsToDevicePixels = True, .Title = Title, .Info = Desc, .Height = 42, .Tag = Entry, - .Type = MyListItem.CheckType.CheckBox, .IsScaleAnimationEnabled = False, - .PaddingRight = 73, - .ContentHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.RawFileName) - } + Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry, + .ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.RawFileName)} + AddHandler Entry.OnGetCompProject, AddressOf NewItem.Refresh + NewItem.Refresh() AniControlEnabled -= 1 Return NewItem End Function - Private Sub McModContent(sender As MyListItem, e As EventArgs) - Dim ModEntity As McMod = sender.Tag - '注册点击事件 + Private Sub McModContent(sender As MyLocalModItem, e As EventArgs) + '点击事件 AddHandler sender.Changed, AddressOf CheckChanged - AddHandler sender.LogoClick, AddressOf ItemLogo_Click + AddHandler sender.Click, Sub(ss As MyLocalModItem, ee As EventArgs) ss.Checked = Not ss.Checked '图标按钮 - 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) @@ -165,7 +122,7 @@ ToolTipService.SetHorizontalOffset(BtnCont, 2) AddHandler BtnCont.Click, AddressOf Info_Click AddHandler sender.MouseRightButtonDown, AddressOf Info_Click - sender.Buttons = {BtnCont, BtnOpen, BtnDel} + sender.Buttons = {BtnCont, BtnOpen} End Sub #End Region @@ -206,7 +163,11 @@ ''' 全选。 ''' Private Sub BtnManageSelectAll_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageSelectAll.Click - ChangeAllSelected(True) + If SelectedMods.Count < If(IsSearching, PanSearchList.Children.Count, McModLoader.Output.Count) Then + ChangeAllSelected(True) + Else + ChangeAllSelected(False) + End If End Sub #End Region @@ -217,10 +178,10 @@ Public SelectedMods As New List(Of String) '单项切换选择状态 - Public Sub CheckChanged(sender As MyListItem, e As RouteEventArgs) + Public Sub CheckChanged(sender As MyLocalModItem, e As RouteEventArgs) If AniControlEnabled <> 0 Then Return '更新选择了的内容 - Dim SelectedKey As String = CType(sender.Tag, McMod).RawFileName + Dim SelectedKey As String = sender.Entry.RawFileName If sender.Checked Then If Not SelectedMods.Contains(SelectedKey) Then SelectedMods.Add(SelectedKey) Else @@ -304,13 +265,13 @@ SelectedMods.Clear() If IsSearching Then '搜索中 - For Each Item As MyListItem In PanSearchList.Children + For Each Item As MyLocalModItem In PanSearchList.Children Item.Checked = Value - If Value Then SelectedMods.Add(CType(Item.Tag, McMod).RawFileName) + If Value Then SelectedMods.Add(Item.Entry.RawFileName) Next If Not Value Then '只取消选择 If PanItems IsNot Nothing Then - For Each Item As MyListItem In PanItems.Children + For Each Item As MyLocalModItem In PanItems.Children Item.Checked = Value Next End If @@ -318,9 +279,9 @@ Else '非搜索中 If PanItems IsNot Nothing Then - For Each Item As MyListItem In PanItems.Children + For Each Item As MyLocalModItem In PanItems.Children Item.Checked = Value - If Value Then SelectedMods.Add(CType(Item.Tag, McMod).RawFileName) + If Value Then SelectedMods.Add(Item.Entry.RawFileName) Next End If End If @@ -372,11 +333,12 @@ End Try '更改 Loader 和 UI 中的列表 Dim NewModEntity As New McMod(NewPath) + NewModEntity.Comp = ModEntity.Comp Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity) McModLoader.Output.RemoveAt(IndexOfLoader) McModLoader.Output.Insert(IndexOfLoader, NewModEntity) Dim List = If(IsSearching, PanSearchList, PanItems).Children - Dim IndexOfUi As Integer = List.IndexOf(List.OfType(Of MyListItem).FirstOrDefault(Function(i) CType(i.Tag, McMod) Is ModEntity)) + Dim IndexOfUi As Integer = List.IndexOf(List.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry Is ModEntity)) If IndexOfUi = -1 Then Continue For '因为未知原因 Mod 的状态已经切换完了 List.RemoveAt(IndexOfUi) List.Insert(IndexOfUi, McModListItem(NewModEntity)) @@ -419,7 +381,7 @@ '更改 Loader 和 UI 中的列表 McModLoader.Output.Remove(ModEntity) Dim Parent As StackPanel = If(IsSearching, PanSearchList, PanItems) - Dim IndexOfUi As Integer = Parent.Children.IndexOf(Parent.Children.OfType(Of MyListItem).First(Function(i) CType(i.Tag, McMod) Is ModEntity)) + Dim IndexOfUi As Integer = Parent.Children.IndexOf(Parent.Children.OfType(Of MyLocalModItem).First(Function(i) i.Entry Is ModEntity)) Parent.Children.RemoveAt(IndexOfUi) Next If Not IsSearching Then @@ -454,165 +416,69 @@ #Region "单个 Mod 项" - '点击 Logo：切换可用状态 / 显示错误原因 - Public Sub ItemLogo_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 & "详细的错误信息：" & GetExceptionDetail(ModEntity.FileUnavailableReason), "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 Not IsSearching Then - '改变禁用数量的显示 - CType(Parent.Parent, MyCard).Title = McModGetTitle(McModLoader.Output) - '更新加载器状态 - LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.UpdateOnly) - End If - RefreshBottomBar() - - 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 IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown - 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 - If IsShiftPressed Then - File.Delete(ModEntity.Path) - Else - My.Computer.FileSystem.DeleteFile(ModEntity.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin) - End If - 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 - '显示提示 - If IsShiftPressed Then - Hint("已删除 " & ModEntity.FileName & "！", HintType.Finish) - Else - Hint("已将 " & ModEntity.FileName & " 删除到回收站！", HintType.Finish) - End If - LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", LoaderFolderRunType.UpdateOnly) - - Catch ex As OperationCanceledException - Log(ex, "删除 Mod 被主动取消") - 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 ModEntry As McMod = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry '加载失败信息 - If ModEntity.State = McMod.McModState.Unavaliable Then - MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息：" & GetExceptionDetail(ModEntity.FileUnavailableReason), "Mod 读取失败") + If ModEntry.State = McMod.McModState.Unavaliable Then + MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息：" & GetExceptionDetail(ModEntry.FileUnavailableReason), "Mod 读取失败") Return End If - '获取信息 - 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) - 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("") - ContentLines.AddRange(DebugInfo) - 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, "百科搜索", "返回") = 1 Then - OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0") - End If + If ModEntry.Comp IsNot Nothing Then + '跳转到 Mod 下载页面 + FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, + .Additional = {ModEntry.Comp, New List(Of String), PageVersionLeft.Version.Version.McName, + If(PageVersionLeft.Version.Version.HasForge, CompModLoaderType.Forge, If(PageVersionLeft.Version.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any))}}) Else - Select Case MyMsgBox(Join(ContentLines, vbCrLf), ModEntity.Name, "打开官网", "百科搜索", "返回") - Case 1 - OpenWebsite(ModEntity.Url) - Case 2 + '获取信息 + Dim ContentLines As New List(Of String) + If ModEntry.Description IsNot Nothing Then ContentLines.Add(ModEntry.Description & vbCrLf) + If ModEntry.Authors IsNot Nothing Then ContentLines.Add("作者：" & ModEntry.Authors) + ContentLines.Add("文件：" & ModEntry.FileName & "（" & GetString(New FileInfo(ModEntry.Path).Length) & "）") + If ModEntry.Version IsNot Nothing Then ContentLines.Add("版本：" & ModEntry.Version) + Dim DebugInfo As New List(Of String) + If ModEntry.ModId IsNot Nothing Then + DebugInfo.Add("Mod ID：" & ModEntry.ModId) + End If + If ModEntry.Dependencies.Count > 0 Then + DebugInfo.Add("依赖于：") + For Each Dep In ModEntry.Dependencies + DebugInfo.Add(" - " & Dep.Key & If(Dep.Value Is Nothing, "", "，版本：" & Dep.Value)) + Next + End If + If DebugInfo.Count > 0 Then + ContentLines.Add("") + ContentLines.AddRange(DebugInfo) + End If + '获取用于搜索的 Mod 名称 + Dim ModOriginalName As String = ModEntry.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 ModEntry.Url Is Nothing Then + If MyMsgBox(Join(ContentLines, vbCrLf), ModEntry.Name, "百科搜索", "返回") = 1 Then OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0") - End Select + End If + Else + Select Case MyMsgBox(Join(ContentLines, vbCrLf), ModEntry.Name, "打开官网", "百科搜索", "返回") + Case 1 + OpenWebsite(ModEntry.Url) + Case 2 + OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0") + End Select + End If End If - Catch ex As Exception Log(ex, "获取 Mod 详情失败", LogLevel.Feedback) End Try @@ -621,9 +487,8 @@ 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 & """") + Dim ListItem As MyLocalModItem = sender.Tag + OpenExplorer("/select,""" & ListItem.Entry.Path & """") Catch ex As Exception Log(ex, "打开 Mod 文件位置失败", LogLevel.Feedback) @@ -632,6 +497,8 @@ #End Region +#Region "搜索" + Public ReadOnly Property IsSearching As Boolean Get Return Not String.IsNullOrWhiteSpace(SearchBox.Text) @@ -643,17 +510,22 @@ '构造请求 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) - } - }) + Dim SearchSource As New List(Of KeyValuePair(Of String, Double)) + SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Name, 1)) + SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.FileName, 1)) + If Entry.Version IsNot Nothing Then SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Version, 0.2)) + If Entry.Description IsNot Nothing AndAlso Entry.Description <> "" Then + SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Description, 0.4)) + End If + If Entry.Comp IsNot Nothing Then + If Entry.Comp.RawName <> Entry.Name Then SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Comp.RawName, 1)) + If Entry.Comp.TranslatedName <> Entry.Comp.RawName Then SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Comp.TranslatedName, 1)) + If Entry.Comp.Description <> Entry.Description Then SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Comp.Description, 0.4)) + End If + QueryList.Add(New SearchEntry(Of McMod) With {.Item = Entry, .SearchSource = SearchSource}) Next '进行搜索，构造列表 - Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=5, MinBlurSimilarity:=0.35) + Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35) PanSearchList.Children.Clear() If SearchResult.Count = 0 Then PanSearch.Title = "无搜索结果" @@ -662,7 +534,7 @@ 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 + If ModeDebug Then Item.Description = If(Result.AbsoluteRight, "完全匹配，", "") & "相似度：" & Math.Round(Result.Similarity, 3) & "，" & Item.Description PanSearchList.Children.Add(Item) Next PanSearchList.Visibility = Visibility.Visible @@ -692,4 +564,6 @@ End If 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 index e902ab1..20b8ebf 100644 --- a/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj +++ b/Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj @@ -189,6 +189,9 @@ + + MyLocalModItem.xaml + MyExtraButton.xaml @@ -463,6 +466,10 @@ FormMain.xaml Code + + MSBuild:Compile + Designer + MSBuild:Compile Designer @@ -905,5 +912,9 @@ + + + + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Resources/Help.zip b/Plain Craft Launcher 2/Resources/Help.zip index d1295a2..5d452ea 100644 Binary files a/Plain Craft Launcher 2/Resources/Help.zip and b/Plain Craft Launcher 2/Resources/Help.zip differ