Merge branch 'main' into #7894

This commit is contained in:
wyc-26
2026-01-10 11:14:48 +08:00
committed by GitHub
80 changed files with 8429 additions and 4849 deletions
+1 -1
View File
@@ -198,7 +198,7 @@ WaitRetry:
Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
Public Shared Function AssemblyResolve(sender As Object, Args As ResolveEventArgs) As Assembly Public Shared Function AssemblyResolve(sender As Object, Args As ResolveEventArgs) As Assembly
'缓存 '缓存
Static Prefixes As String() = {"NAudio", "Newtonsoft.Json", "Ookii.Dialogs.Wpf", "Imazen.WebP", "CacheCow.Common", "CacheCow.Client.FileStore", "CacheCow.Client", "System.Net.Http.Formatting"} Static Prefixes As String() = {"NAudio", "Newtonsoft.Json", "Ookii.Dialogs.Wpf", "Imazen.WebP", "CacheCow.Common", "CacheCow.Client.FileStore", "CacheCow.Client", "System.Net.Http.Formatting", "System.ValueTuple"}
Static Locks As New Dictionary(Of String, Object)(StringComparer.Ordinal) Static Locks As New Dictionary(Of String, Object)(StringComparer.Ordinal)
Static LoadedAssembly As New Dictionary(Of String, Assembly)(StringComparer.Ordinal) Static LoadedAssembly As New Dictionary(Of String, Assembly)(StringComparer.Ordinal)
'查找对应的 DLL '查找对应的 DLL
@@ -35,7 +35,7 @@ Namespace Controls.Behaviors
End Sub End Sub
Public Shared Function GetEnableSafeClipboard(element As DependencyObject) As Boolean Public Shared Function GetEnableSafeClipboard(element As DependencyObject) As Boolean
Return CBool(element.GetValue(EnableSafeClipboardProperty)) Return element.GetValue(EnableSafeClipboardProperty)
End Function End Function
Private Shared Sub OnEnableSafeClipboardChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs) Private Shared Sub OnEnableSafeClipboardChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
@@ -97,6 +97,10 @@ Namespace Controls.Behaviors
If Forms.Clipboard.ContainsText() Then If Forms.Clipboard.ContainsText() Then
Dim pasteText = Forms.Clipboard.GetText() Dim pasteText = Forms.Clipboard.GetText()
'将换行符替换为空格(#7825)
If Not tb.AcceptsReturn Then pasteText = pasteText.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
Dim start = tb.SelectionStart Dim start = tb.SelectionStart
tb.SelectedText = pasteText tb.SelectedText = pasteText
@@ -162,11 +166,12 @@ Namespace Controls.Behaviors
Dim dg = TryCast(sender, DataGrid) Dim dg = TryCast(sender, DataGrid)
If dg Is Nothing OrElse dg.SelectedCells Is Nothing OrElse dg.SelectedCells.Count = 0 Then Return If dg Is Nothing OrElse dg.SelectedCells Is Nothing OrElse dg.SelectedCells.Count = 0 Then Return
Dim sb = New System.Text.StringBuilder() Dim sb = New StringBuilder
Dim rowGroups = dg.SelectedCells.GroupBy(Function(c) c.Item) Dim rowGroups = dg.SelectedCells.GroupBy(Function(c) c.Item)
For Each row In rowGroups For Each row In rowGroups
Dim rowText = String.Join(vbTab, row.Select(Function(cell) Dim rowText = String.Join(vbTab, row.Select(
Function(cell)
Dim tb = TryCast(cell.Column.GetCellContent(cell.Item), TextBlock) Dim tb = TryCast(cell.Column.GetCellContent(cell.Item), TextBlock)
Return If(tb IsNot Nothing, tb.Text, "") Return If(tb IsNot Nothing, tb.Text, "")
End Function)) End Function))
@@ -0,0 +1,47 @@
Public Module LazyLoadBehavior
''' <summary>
''' 指定首次进入 ScrollViewer 的可视范围时执行的操作。
''' </summary>
<Runtime.CompilerServices.Extension()>
Public Sub OnFirstEnterScrollViewerViewport(obj As DependencyObject, value As Action)
obj.SetValue(IsInViewportProperty, value)
End Sub
Private ReadOnly IsInViewportProperty As DependencyProperty =
DependencyProperty.RegisterAttached("IsInViewport", GetType(Action), GetType(LazyLoadBehavior),
New PropertyMetadata(Nothing, AddressOf OnIsInViewportChanged))
Private Sub OnIsInViewportChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
Dim Element = TryCast(d, FrameworkElement)
If Element Is Nothing OrElse e.NewValue Is Nothing Then Return
Dim Handled As Boolean = False
Dim Handler As EventHandler =
Sub()
If Handled Then Return
'判断元素是否可见
If Element.RenderSize.Width < Double.Epsilon Then Return
If Not Element.IsVisible Then Return
'判断是否在 ScrollViewer 的可视区域内
Dim Scroll = FindParentScrollViewer(Element)
If Scroll Is Nothing Then Return
If Not New Rect(0, 0, Scroll.ViewportWidth, Scroll.ViewportHeight).IntersectsWith(
Element.TransformToAncestor(Scroll).TransformBounds(New Rect(New Point(0, 0), Element.RenderSize))) Then Return
'执行
Handled = True
CType(e.NewValue, Action).Invoke()
RemoveHandler Element.LayoutUpdated, Handler
End Sub
AddHandler Element.LayoutUpdated, Handler
End Sub
Private Function FindParentScrollViewer(d As DependencyObject) As ScrollViewer
While d IsNot Nothing
If TypeOf d Is ScrollViewer Then Return CType(d, ScrollViewer)
d = VisualTreeHelper.GetParent(d)
End While
Return Nothing
End Function
End Module
+19 -26
View File
@@ -92,6 +92,7 @@
'改变默认的折叠 '改变默认的折叠
If IsSwapped AndAlso SwapControl IsNot Nothing Then If IsSwapped AndAlso SwapControl IsNot Nothing Then
MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0)) MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
SwapControl.Visibility = Visibility.Collapsed
'取消由于高度变化被迫触发的高度动画 '取消由于高度变化被迫触发的高度动画
Dim RawUseAnimation As Boolean = UseAnimation Dim RawUseAnimation As Boolean = UseAnimation
UseAnimation = False UseAnimation = False
@@ -109,17 +110,21 @@
'这一部分的代码是好几年前留下的究极屎坑,当时还不知道该咋正确调用这种方法,就写了这么一坨屎 '这一部分的代码是好几年前留下的究极屎坑,当时还不知道该咋正确调用这种方法,就写了这么一坨屎
'但是现在……反正勉强能用……懒得改了就这样吧.jpg '但是现在……反正勉强能用……懒得改了就这样吧.jpg
'别骂了别骂了.jpg '别骂了别骂了.jpg
If IsNothing(Stack.Tag) Then Return If Stack.Tag Is Nothing Then Return
'排序 '排序
Dim HasDuplicates As Boolean = False
Select Case Type Select Case Type
Case 3 Case 3
Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).Sort(Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay)) Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).SortByComparison(Function(a, b) CompareVersionGE(a.DisplayName, b.DisplayName))
Case 4, 10 Case 4, 10
Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).Sort(Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit)) Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).SortByComparison(Function(a, b) CompareVersionGE(a.Inherit, b.Inherit))
Case 6 Case 6
Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).Sort(Function(a, b) a.Version > b.Version) Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).OrderByDescending(Function(a) a).ToList
Case 8, 9 Case 8, 9
Stack.Tag = CType(Stack.Tag, List(Of CompFile)).Sort(Function(a, b) a.ReleaseDate > b.ReleaseDate) Stack.Tag = CType(Stack.Tag, List(Of CompFile)).SortByComparison(Function(a, b) a.ReleaseDate > b.ReleaseDate)
HasDuplicates =
CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count
End Select End Select
'控件转换 '控件转换
Select Case Type Select Case Type
@@ -132,9 +137,7 @@
For Each Data As Object In Stack.Tag For Each Data As Object In Stack.Tag
Select Case Type Select Case Type
Case 0 Case 0
Dim VersionItem As MyListItem = CType(Data, McVersion).ToListItem Stack.Children.Add(CType(Data, McInstance).ToListItem(AddressOf PageSelectRight.McInstanceListContent))
VersionItem.ContentHandler = AddressOf PageSelectRight.McVersionListContent
Stack.Children.Add(VersionItem)
Case 2 Case 2
Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True)) Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
Case 3 Case 3
@@ -145,23 +148,13 @@
'不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug '不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False)) Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
Case 8 Case 8
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <> '若存在重复的版本名,则显示文件名而非版本名(#1344)
CType(Stack.Tag, List(Of CompFile)).Count Then Stack.Children.Add(CType(Data, CompFile).ToListItem(
'存在重复的名称(#1344) AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
Else
'不存在重复的名称,正常加载
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click))
End If
Case 9 Case 9
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <> '若存在重复的版本名,则显示文件名而非版本名(#1344)
CType(Stack.Tag, List(Of CompFile)).Count Then Stack.Children.Add(CType(Data, CompFile).ToListItem(
'存在重复的名称(#1344) AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
Else
'不存在重复的名称,正常加载
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click))
End If
Case 10 Case 10
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True)) Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
Case 11 Case 11
@@ -268,7 +261,7 @@
Height = PreviousHeight Height = PreviousHeight
End Sub End Sub
''' <summary> ''' <summary>
''' 通知 MyCard,控件内容已改变,需要中断动画并更新高度。 ''' 通知 MyCard,控件内容已改变,需要中断动画并瞬间更新高度。
''' </summary> ''' </summary>
Public Sub TriggerForceResize() Public Sub TriggerForceResize()
Height = If(IsSwapped, SwapedHeight, Double.NaN) Height = If(IsSwapped, SwapedHeight, Double.NaN)
@@ -282,7 +275,7 @@
'若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠 '若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠
'这是因为不能直接在 XAML 中设置 SwapControl '这是因为不能直接在 XAML 中设置 SwapControl
Public SwapControl As Object Public SwapControl As FrameworkElement
Public Property CanSwap As Boolean = False Public Property CanSwap As Boolean = False
''' <summary> ''' <summary>
''' 被折叠的种类,用于控件虚拟化。 ''' 被折叠的种类,用于控件虚拟化。
@@ -102,7 +102,7 @@ Public Class MyHint
If CanClose AndAlso Setup.Get(RelativeSetup) Then Visibility = Visibility.Collapsed If CanClose AndAlso Setup.Get(RelativeSetup) Then Visibility = Visibility.Collapsed
End Sub End Sub
Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
Setup.Set(RelativeSetup, True) Setup.SetSafe(RelativeSetup, True)
AniDispose(Me, False) AniDispose(Me, False)
End Sub End Sub
+11 -18
View File
@@ -85,8 +85,8 @@
If _ActualSource = value Then Return If _ActualSource = value Then Return
_ActualSource = value _ActualSource = value
Try Try
Dim Bitmap As MyBitmap = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件 Dim Bitmap As ImageSource = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件
RunInUiWait(Sub() MyBase.Source = Bitmap) RunInUi(Sub() MyBase.Source = Bitmap)
Catch ex As Exception Catch ex As Exception
Log(ex, $"加载图片失败({value})") Log(ex, $"加载图片失败({value})")
Try Try
@@ -112,29 +112,25 @@
End If End If
'从缓存加载网络图片 '从缓存加载网络图片
Dim EnableCache As Boolean = Me.EnableCache Dim EnableCache As Boolean = Me.EnableCache
Dim TempPath As String = GetTempPath(Source) & If(EnableCache, "", GetUuid()) '不启用缓存时加上随机字符串,避免冲突 Dim TempPath As String = $"{PathTemp}MyImage\{GetHash(Source)}.png{If(EnableCache, "", GetUuid())}" '不启用缓存时在末尾加上随机字符串,避免冲突
Dim TempFile As New FileInfo(TempPath) Dim TempFile As New FileInfo(TempPath)
If EnableCache AndAlso TempFile.Exists Then If EnableCache AndAlso TempFile.Exists Then
ActualSource = TempPath ActualSource = TempPath '显示缓存的图片
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存 If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
Else
ActualSource = LoadingSource '显示加载中图片
End If End If
RunInNewThread( RunInNewThread(
Sub() Sub()
Dim IsLocalFallback As Boolean = Not String.IsNullOrEmpty(FallbackSource) AndAlso Not FallbackSource.StartsWithF("http") Dim IsLocalFallback As Boolean = Not String.IsNullOrEmpty(FallbackSource) AndAlso Not FallbackSource.StartsWithF("http")
Try Try
'下载 '下载
ActualSource = LoadingSource '显示加载中的占位图片
NetDownloadByLoader( NetDownloadByLoader(
If(FallbackSource?.StartsWithF("http"), {Source, FallbackSource}, {Source}), If(FallbackSource IsNot Nothing AndAlso FallbackSource.StartsWithF("http") AndAlso Source <> FallbackSource,
{Source, FallbackSource}, {Source}),
TempPath, SimulateBrowserHeaders:=True) TempPath, SimulateBrowserHeaders:=True)
If EnableCache Then ActualSource = TempPath
'保存缓存并显示 If Not EnableCache Then File.Delete(TempPath)
RunInUi(Sub() ActualSource = TempPath)
Else
'直接显示
RunInUiWait(Sub() ActualSource = TempPath)
File.Delete(TempPath)
End If
Catch ex As Exception Catch ex As Exception
Try Try
If TempPath IsNot Nothing Then File.Delete(TempPath) If TempPath IsNot Nothing Then File.Delete(TempPath)
@@ -143,7 +139,7 @@
'加载本地备用图片 '加载本地备用图片
If IsLocalFallback Then If IsLocalFallback Then
Try Try
RunInUiWait(Sub() ActualSource = FallbackSource) ActualSource = FallbackSource
Log(ex, $"下载图片失败,使用本地备用图片({Source})") Log(ex, $"下载图片失败,使用本地备用图片({Source})")
Return Return
Catch exx As Exception Catch exx As Exception
@@ -156,8 +152,5 @@
End Try End Try
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal) End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
End Sub End Sub
Public Shared Function GetTempPath(Url As String) As String
Return $"{PathTemp}MyImage\{GetHash(Url)}.png"
End Function
End Class End Class
@@ -396,6 +396,7 @@ Public Class MyListItem
Dim CheckedCount As Integer = 0 Dim CheckedCount As Integer = 0
'收集控件列表与选中个数 '收集控件列表与选中个数
For Each Control In CType(Parent, Object).Children For Each Control In CType(Parent, Object).Children
Control = MyVirtualizingElement.TryInit(Control)
If TypeOf Control Is MyListItem AndAlso CType(Control, MyListItem).Type = CheckType.RadioBox Then If TypeOf Control Is MyListItem AndAlso CType(Control, MyListItem).Type = CheckType.RadioBox Then
RadioboxList.Add(Control) RadioboxList.Add(Control)
If Control.Checked Then CheckedCount += 1 If Control.Checked Then CheckedCount += 1
@@ -544,7 +545,7 @@ Public Class MyListItem
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
'菜单虚拟化检测 '菜单虚拟化检测
If ContentHandler IsNot Nothing Then If ContentHandler IsNot Nothing Then
ContentHandler(sender, e) ContentHandler(Me, e)
ContentHandler = Nothing ContentHandler = Nothing
End If End If
'判断当前颜色 '判断当前颜色
@@ -21,7 +21,9 @@
ShapeLine.StrokeThickness = GetWPFSize(1) ShapeLine.StrokeThickness = GetWPFSize(1)
'添加选择控件 '添加选择控件
Btn1.IsEnabled = False Btn1.IsEnabled = False
For Each Selection As IMyRadio In Converter.Content For Each Content In Converter.Content
Content = MyVirtualizingElement.TryInit(Content)
Dim Selection As IMyRadio = Content
PanSelection.Children.Add(Selection) PanSelection.Children.Add(Selection)
AddHandler Selection.Check, AddressOf OnChecked AddHandler Selection.Check, AddressOf OnChecked
If TypeOf Selection Is MyListItem Then If TypeOf Selection Is MyListItem Then
@@ -30,6 +30,7 @@
Dim AniList As New List(Of AniData) Dim AniList As New List(Of AniData)
Dim Id As Integer = 0, Delay As Integer = 0 Dim Id As Integer = 0, Delay As Integer = 0
For Each Element As FrameworkElement In GetAllAnimControls(True) For Each Element As FrameworkElement In GetAllAnimControls(True)
Element = MyVirtualizingElement.TryInit(Element)
If Element.Visibility = Visibility.Collapsed Then If Element.Visibility = Visibility.Collapsed Then
'还原之前的隐藏动画可能导致的改变(#2436) '还原之前的隐藏动画可能导致的改变(#2436)
Element.Opacity = 1 Element.Opacity = 1
@@ -135,7 +135,7 @@
TriggerEnterAnimation(PanAlways, If(PanContent, Child)) TriggerEnterAnimation(PanAlways, If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then ElseIf PageLoader.State = LoadState.Loading Then
PageState = PageStates.LoaderWait PageState = PageStates.LoaderWait
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid) AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
Else 'PageLoader.State = LoadState.Failed Else 'PageLoader.State = LoadState.Failed
PageState = PageStates.LoaderEnter PageState = PageStates.LoaderEnter
TriggerEnterAnimation(PanAlways, PanLoader) TriggerEnterAnimation(PanAlways, PanLoader)
@@ -147,7 +147,7 @@
TriggerEnterAnimation(If(PanContent, Child)) TriggerEnterAnimation(If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then ElseIf PageLoader.State = LoadState.Loading Then
PageState = PageStates.LoaderWait PageState = PageStates.LoaderWait
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid) AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
Else 'PageLoader.State = LoadState.Failed Else 'PageLoader.State = LoadState.Failed
PageState = PageStates.LoaderEnter PageState = PageStates.LoaderEnter
TriggerEnterAnimation(PanLoader) TriggerEnterAnimation(PanLoader)
@@ -378,7 +378,7 @@
End If End If
'结束 '结束
AniList.Add(AaCode(Sub() PageOnEnterAnimationFinished(),, True)) AniList.Add(AaCode(Sub() PageOnEnterAnimationFinished(),, True))
AniStart(AniList, "PageRight PageChange " & PageUuid) AniStart(AniList, "PageRight PageChange " & PageUuid, True)
End Sub End Sub
'逐个退出动画 '逐个退出动画
@@ -0,0 +1,70 @@
Public Class MyVirtualizingElement(Of T As FrameworkElement)
Inherits FrameworkElement
Private Initializer As Func(Of T)
Public Sub New(Initializer As Func(Of T))
Me.Initializer = Initializer
OnFirstEnterScrollViewerViewport(AddressOf Init)
End Sub
''' <summary>
''' 实例化此控件。
''' </summary>
Public Function Init() As T
Dim Element As T = Initializer()
If Parent IsNot Nothing Then
If TypeOf Parent IsNot Panel Then Throw New Exception("MyVirtualizingElement 的父级必须是一个 Panel")
Dim ParentPanel As Panel = Parent
Dim CurrentIndex As Integer = ParentPanel.Children.IndexOf(Me)
ParentPanel.Children.RemoveAt(CurrentIndex)
ParentPanel.Children.Insert(CurrentIndex, Element)
End If
Return Element
End Function
Public Shared Widening Operator CType(Virtualized As MyVirtualizingElement(Of T)) As T
Return Virtualized.Init()
End Operator
End Class
'非泛型形式
Public Class MyVirtualizingElement
Inherits FrameworkElement
Private Initializer As Func(Of FrameworkElement)
Public Sub New(Initializer As Func(Of FrameworkElement))
Me.Initializer = Initializer
OnFirstEnterScrollViewerViewport(AddressOf Init)
End Sub
''' <summary>
''' 实例化此控件。
''' </summary>
Public Function Init() As FrameworkElement
Dim Element As FrameworkElement = Initializer()
If Parent IsNot Nothing Then
If TypeOf Parent IsNot Panel Then Throw New Exception("MyVirtualizingElement 的父级必须是一个 Panel")
Dim ParentPanel As Panel = Parent
Dim CurrentIndex As Integer = ParentPanel.Children.IndexOf(Me)
ParentPanel.Children.RemoveAt(CurrentIndex)
ParentPanel.Children.Insert(CurrentIndex, Element)
End If
Return Element
End Function
''' <summary>
''' 获取实例化后的控件。
''' 如果该控件没有实例化,则会立即实例化。
''' 如果类型错误,则返回原值。
''' </summary>
Public Shared Function TryInit(Element As FrameworkElement) As FrameworkElement
If GetType(MyVirtualizingElement(Of )).IsInstanceOfGenericType(Element) Then
Return CType(Element, Object).Init()
ElseIf TypeOf Element Is MyVirtualizingElement Then
Return CType(Element, MyVirtualizingElement).Init()
Else
Return Element
End If
End Function
End Class
+74 -53
View File
@@ -11,6 +11,11 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目 '统计更新日志条目
#If BETA Then #If BETA Then
If LastVersion < 376 Then 'Release 2.11.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:联机功能!"))
FeatureCount += 32
BugCount += 21
End If
If LastVersion < 372 Then 'Release 2.10.9 If LastVersion < 372 Then 'Release 2.10.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:如果版本设置了自定义描述,会在标题后面以淡灰色显示其版本号")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:如果版本设置了自定义描述,会在标题后面以淡灰色显示其版本号"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:支持为一个控件设置多个自定义事件")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增:支持为一个控件设置多个自定义事件"))
@@ -113,27 +118,43 @@ Public Class FormMain
'3:BUG+ IMP* FEAT- '3:BUG+ IMP* FEAT-
'2:BUG* IMP- '2:BUG* IMP-
'1:BUG- '1:BUG-
If LastVersion < 375 Then 'Snapshot 2.11.2 If LastVersion < 378 Then 'Snapshot 2.12.1
If LastVersion >= 373 Then If LastVersion >= 377 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:对联机进行了各种各样的优化,以改善稳定性")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:在版本列表中存在 OptiFine 时可能无法加载版本列表"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:若有加入者的网络环境比房主更好,会提示可以让那位加入者担任房主")) BugCount += 2
End If End If
End If
If LastVersion < 377 Then 'Snapshot 2.12.0
If LastVersion >= 373 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "删除:暂时隐藏联机入口……不过只是暂时关闭,它还会回来的!"))
End If
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:适配新的 Minecraft 版本号系统与 Unobfuscated 版本"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:巨幅优化各个下载页面和 Mod 管理页面的性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:更换披风时会显示当前使用的披风"))
FeatureCount += 33
BugCount += 29
End If
If LastVersion < 375 Then 'Snapshot 2.11.2
'If LastVersion >= 373 Then
' FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:对联机进行了各种各样的优化,以改善稳定性"))
' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:若有加入者的网络环境比房主更好,会提示可以让那位加入者担任房主"))
'End If
FeatureCount += 16 FeatureCount += 16
BugCount += 4 BugCount += 4
End If End If
If LastVersion < 374 Then 'Snapshot 2.11.1 If LastVersion < 374 Then 'Snapshot 2.11.1
If LastVersion >= 373 Then 'If LastVersion >= 373 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:使用离线登录也可以直接加入联机房间了")) ' FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:使用离线登录也可以直接加入联机房间了"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:会从所有共享节点中自动选择负载最低的进行中继连接")) ' FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:会从所有共享节点中自动选择负载最低的进行中继连接"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:若复制了邀请码,则可以直接快速加入房间")) ' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:若复制了邀请码,则可以直接快速加入房间"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:关闭 PCL 时总是会提示是否退出联机,防止在关闭 PCL 时无意地关闭或退出了房间")) ' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:关闭 PCL 时总是会提示是否退出联机,防止在关闭 PCL 时无意地关闭或退出了房间"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增:允许自定义要连接的节点")) ' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增:允许自定义要连接的节点"))
End If 'End If
FeatureCount += 9 FeatureCount += 9
BugCount += 7 BugCount += 7
End If End If
If LastVersion < 373 Then 'Snapshot 2.11.0 If LastVersion < 373 Then 'Snapshot 2.11.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:联机功能!")) 'FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:联机功能!"))
FeatureCount += 7 FeatureCount += 7
BugCount += 10 BugCount += 10
End If End If
@@ -725,9 +746,9 @@ Public Class FormMain
'按 ESC 返回上一级 '按 ESC 返回上一级
If e.Key = Key.Escape Then TriggerPageBack() If e.Key = Key.Escape Then TriggerPageBack()
'更改隐藏版本可见性 '更改隐藏版本可见性
If e.Key = Key.F11 AndAlso PageCurrent = FormMain.PageType.VersionSelect Then If e.Key = Key.F11 AndAlso PageCurrent = FormMain.PageType.InstanceSelect Then
FrmSelectRight.ShowHidden = Not FrmSelectRight.ShowHidden FrmSelectRight.ShowHidden = Not FrmSelectRight.ShowHidden
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Return Return
End If End If
'更改功能隐藏可见性 '更改功能隐藏可见性
@@ -772,12 +793,12 @@ Public Class FormMain
'切回窗口 '切回窗口
Private Sub FormMain_Activated() Handles Me.Activated Private Sub FormMain_Activated() Handles Me.Activated
Try Try
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then If PageCurrent = PageType.InstanceSetup AndAlso PageCurrentSub = PageSubType.InstanceMod Then
'Mod 管理自动刷新 'Mod 管理自动刷新
FrmVersionMod.ReloadModList() FrmInstanceMod.ReloadModList()
ElseIf PageCurrent = PageType.VersionSelect Then ElseIf PageCurrent = PageType.InstanceSelect Then
'版本选择自动刷新 '版本选择自动刷新
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "切回窗口时出错", LogLevel.Feedback) Log(ex, "切回窗口时出错", LogLevel.Feedback)
@@ -851,36 +872,36 @@ Public Class FormMain
Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Red) Hint($"输入的 Authlib 验证服务器不符合网址格式({AuthlibServer})!", HintType.Red)
Return Return
End If End If
Dim TargetVersion = If(PageCurrent = PageType.VersionSetup, PageVersionLeft.Version, McVersionCurrent) Dim Target = If(PageCurrent = PageType.InstanceSetup, PageInstanceLeft.Instance, McInstanceSelected)
If TargetVersion Is Nothing Then If Target Is Nothing Then
Hint("请先下载游戏,再设置第三方登录!", HintType.Red) Hint("请先下载游戏,再设置第三方登录!", HintType.Red)
Return Return
End If End If
If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then
'LittleSkin 'LittleSkin
If MyMsgBox($"是否要在版本 {TargetVersion.Name} 中开启 LittleSkin 登录?" & vbCrLf & If MyMsgBox($"是否要在版本 {Target.Name} 中开启 LittleSkin 登录?" & vbCrLf &
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Return Return
End If End If
Setup.Set("VersionServerLogin", 4, Version:=TargetVersion) Setup.Set("VersionServerLogin", 4, Instance:=Target)
Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Version:=TargetVersion) Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Instance:=Target)
Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Version:=TargetVersion) Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Instance:=Target)
Setup.Set("VersionServerAuthName", "LittleSkin 登录", Version:=TargetVersion) Setup.Set("VersionServerAuthName", "LittleSkin 登录", Instance:=Target)
Else Else
'第三方 Authlib 服务器 '第三方 Authlib 服务器
If MyMsgBox($"是否要在版本 {TargetVersion.Name} 中开启第三方登录?" & vbCrLf & If MyMsgBox($"是否要在版本 {Target.Name} 中开启第三方登录?" & vbCrLf &
$"登录服务器:{AuthlibServer}" & vbCrLf & vbCrLf & $"登录服务器:{AuthlibServer}" & vbCrLf & vbCrLf &
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then "你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Return Return
End If End If
Setup.Set("VersionServerLogin", 4, Version:=TargetVersion) Setup.Set("VersionServerLogin", 4, Instance:=Target)
Setup.Set("VersionServerAuthServer", AuthlibServer, Version:=TargetVersion) Setup.Set("VersionServerAuthServer", AuthlibServer, Instance:=Target)
Setup.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Version:=TargetVersion) Setup.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Instance:=Target)
Setup.Set("VersionServerAuthName", "", Version:=TargetVersion) Setup.Set("VersionServerAuthName", "", Instance:=Target)
End If End If
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionSetup Then If PageCurrent = PageType.InstanceSetup AndAlso PageCurrentSub = PageSubType.InstanceSetup Then
'正在服务器选项页,需要刷新设置项显示 '正在服务器选项页,需要刷新设置项显示
FrmVersionSetup.Reload() FrmInstanceSetup.Reload()
ElseIf PageCurrent = PageType.Launch Then ElseIf PageCurrent = PageType.Launch Then
'正在主页,需要刷新左边栏 '正在主页,需要刷新左边栏
FrmLaunchLeft.RefreshPage(True, False) FrmLaunchLeft.RefreshPage(True, False)
@@ -953,7 +974,7 @@ Public Class FormMain
Return Return
End If End If
'安装 Mod '安装 Mod
If PageVersionMod.InstallMods(FilePathList) Then Return If PageInstanceMod.InstallMods(FilePathList) Then Return
'安装整合包 '安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试 If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装") Log("[System] 文件为压缩包,尝试作为整合包安装")
@@ -1086,7 +1107,7 @@ Public Class FormMain
''' <summary> ''' <summary>
''' 版本选择。这是一个副页面。 ''' 版本选择。这是一个副页面。
''' </summary> ''' </summary>
VersionSelect = 5 InstanceSelect = 5
''' <summary> ''' <summary>
''' 下载管理。这是一个副页面。 ''' 下载管理。这是一个副页面。
''' </summary> ''' </summary>
@@ -1094,7 +1115,7 @@ Public Class FormMain
''' <summary> ''' <summary>
''' 版本设置。这是一个副页面。 ''' 版本设置。这是一个副页面。
''' </summary> ''' </summary>
VersionSetup = 7 InstanceSetup = 7
''' <summary> ''' <summary>
''' 资源工程详情。这是一个副页面。 ''' 资源工程详情。这是一个副页面。
''' </summary> ''' </summary>
@@ -1124,23 +1145,23 @@ Public Class FormMain
OtherHelp = 0 OtherHelp = 0
OtherAbout = 1 OtherAbout = 1
OtherTest = 2 OtherTest = 2
VersionOverall = 0 InstanceOverall = 0
VersionSetup = 1 InstanceSetup = 1
VersionMod = 2 InstanceMod = 2
VersionModDisabled = 3 InstanceModDisabled = 3
VersionExport = 4 InstanceExport = 4
End Enum End Enum
''' <summary> ''' <summary>
''' 获取次级页面的名称。若并非次级页面则返回空字符串,故可以以此判断是否为次级页面。 ''' 获取次级页面的名称。若并非次级页面则返回空字符串,故可以以此判断是否为次级页面。
''' </summary> ''' </summary>
Private Function PageNameGet(Stack As PageStackData) As String Private Function PageNameGet(Stack As PageStackData) As String
Select Case Stack.Page Select Case Stack.Page
Case PageType.VersionSelect Case PageType.InstanceSelect
Return "版本选择" Return "版本选择"
Case PageType.DownloadManager Case PageType.DownloadManager
Return "下载管理" Return "下载管理"
Case PageType.VersionSetup Case PageType.InstanceSetup
Return "版本设置 - " & If(PageVersionLeft.Version Is Nothing, "未知版本", PageVersionLeft.Version.Name) Return "版本设置 - " & If(PageInstanceLeft.Instance Is Nothing, "未知版本", PageInstanceLeft.Instance.Name)
Case PageType.CompDetail Case PageType.CompDetail
Return "资源下载 - " & CType(Stack.Additional(0), CompProject).TranslatedName Return "资源下载 - " & CType(Stack.Additional(0), CompProject).TranslatedName
Case PageType.HelpDetail Case PageType.HelpDetail
@@ -1186,9 +1207,9 @@ Public Class FormMain
Case PageType.Other Case PageType.Other
If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
Return FrmOtherLeft.PageID Return FrmOtherLeft.PageID
Case PageType.VersionSetup Case PageType.InstanceSetup
If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft If FrmInstanceLeft Is Nothing Then FrmInstanceLeft = New PageInstanceLeft
Return FrmVersionLeft.PageID Return FrmInstanceLeft.PageID
Case Else Case Else
Return 0 '没有子页面 Return 0 '没有子页面
End Select End Select
@@ -1262,9 +1283,9 @@ Public Class FormMain
Else Else
'切换到次页面 '切换到次页面
Select Case Stack.Page Select Case Stack.Page
Case PageType.VersionSetup Case PageType.InstanceSetup
If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft If FrmInstanceLeft Is Nothing Then FrmInstanceLeft = New PageInstanceLeft
CType(FrmVersionLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent) CType(FrmInstanceLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
End Select End Select
PageChangeActual(Stack, SubType) PageChangeActual(Stack, SubType)
End If End If
@@ -1356,7 +1377,7 @@ Public Class FormMain
Case PageType.Other '更多 Case PageType.Other '更多
If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
PageChangeAnim(FrmOtherLeft, FrmOtherLeft.PageGet(SubType)) PageChangeAnim(FrmOtherLeft, FrmOtherLeft.PageGet(SubType))
Case PageType.VersionSelect '版本选择 Case PageType.InstanceSelect '版本选择
If FrmSelectLeft Is Nothing Then FrmSelectLeft = New PageSelectLeft If FrmSelectLeft Is Nothing Then FrmSelectLeft = New PageSelectLeft
If FrmSelectRight Is Nothing Then FrmSelectRight = New PageSelectRight If FrmSelectRight Is Nothing Then FrmSelectRight = New PageSelectRight
PageChangeAnim(FrmSelectLeft, FrmSelectRight) PageChangeAnim(FrmSelectLeft, FrmSelectRight)
@@ -1364,9 +1385,9 @@ Public Class FormMain
If FrmSpeedLeft Is Nothing Then FrmSpeedLeft = New PageSpeedLeft If FrmSpeedLeft Is Nothing Then FrmSpeedLeft = New PageSpeedLeft
If FrmSpeedRight Is Nothing Then FrmSpeedRight = New PageSpeedRight If FrmSpeedRight Is Nothing Then FrmSpeedRight = New PageSpeedRight
PageChangeAnim(FrmSpeedLeft, FrmSpeedRight) PageChangeAnim(FrmSpeedLeft, FrmSpeedRight)
Case PageType.VersionSetup '版本设置 Case PageType.InstanceSetup '版本设置
If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft If FrmInstanceLeft Is Nothing Then FrmInstanceLeft = New PageInstanceLeft
PageChangeAnim(FrmVersionLeft, FrmVersionLeft.PageGet(SubType)) PageChangeAnim(FrmInstanceLeft, FrmInstanceLeft.PageGet(SubType))
Case PageType.CompDetail 'Mod 信息 Case PageType.CompDetail 'Mod 信息
If FrmDownloadCompDetail Is Nothing Then FrmDownloadCompDetail = New PageDownloadCompDetail If FrmDownloadCompDetail Is Nothing Then FrmDownloadCompDetail = New PageDownloadCompDetail
PageChangeAnim(New MyPageLeft, FrmDownloadCompDetail) PageChangeAnim(New MyPageLeft, FrmDownloadCompDetail)
@@ -840,7 +840,7 @@ Sleeper:
Public Sub AniTimer(DeltaTick As Integer) Public Sub AniTimer(DeltaTick As Integer)
Try Try
If DeltaTick / AniSpeed > 200 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", LogLevel.Developer) If DeltaTick / AniSpeed > 100 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", LogLevel.Developer)
Dim i As Integer = -1 Dim i As Integer = -1
'循环每个动画组 '循环每个动画组
Do While i + 1 < AniGroups.Count Do While i + 1 < AniGroups.Count
+85 -26
View File
@@ -14,13 +14,13 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.11.2" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.12.1" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.11.2." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.12.1." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换 Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 372 'Release Public Const VersionCode As Integer = 372 'Release
#Else #Else
Public Const VersionCode As Integer = 375 'Snapshot Public Const VersionCode As Integer = 378 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -589,8 +589,7 @@ Public Module ModBase
''' </summary> ''' </summary>
Public Function ReadReg(Key As String, Optional DefaultValue As String = "") As String Public Function ReadReg(Key As String, Optional DefaultValue As String = "") As String
Try Try
Dim SubKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, False) Return If(My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, False)?.GetValue(Key), DefaultValue)
Return If(SubKey?.GetValue(Key), DefaultValue)
Catch ex As Exception Catch ex As Exception
Log(ex, "读取注册表出错:" & Key, LogLevel.Hint) Log(ex, "读取注册表出错:" & Key, LogLevel.Hint)
Return DefaultValue Return DefaultValue
@@ -1211,14 +1210,17 @@ Re:
Public Class FileChecker Public Class FileChecker
''' <summary> ''' <summary>
''' 文件的准确大小。 ''' 文件的准确大小。
''' 不检查则为 -1。
''' </summary> ''' </summary>
Public ActualSize As Long = -1 Public ActualSize As Long = -1
''' <summary> ''' <summary>
''' 文件的最小大小。 ''' 文件的最小大小。
''' 不检查则为 -1。
''' </summary> ''' </summary>
Public MinSize As Long = -1 Public MinSize As Long = -1
''' <summary> ''' <summary>
''' 文件的 MD5、SHA1 或 SHA256。会根据输入字符串的长度自动判断种类。 ''' 文件的 MD5、SHA1 或 SHA256。会根据输入字符串的长度自动判断种类。
''' 不检查则为 Nothing。
''' </summary> ''' </summary>
Public Hash As String = Nothing Public Hash As String = Nothing
''' <summary> ''' <summary>
@@ -1226,7 +1228,8 @@ Re:
''' </summary> ''' </summary>
Public CanUseExistsFile As Boolean = True Public CanUseExistsFile As Boolean = True
''' <summary> ''' <summary>
''' 是否为 Json 文件。 ''' 是否要求为 JSON 文件。
''' 即,开头结尾必须为 {} 或 []。
''' </summary> ''' </summary>
Public IsJson As Boolean = False Public IsJson As Boolean = False
Public Sub New(Optional MinSize As Long = -1, Optional ActualSize As Long = -1, Optional Hash As String = Nothing, Optional CanUseExistsFile As Boolean = True, Optional IsJson As Boolean = False) Public Sub New(Optional MinSize As Long = -1, Optional ActualSize As Long = -1, Optional Hash As String = Nothing, Optional CanUseExistsFile As Boolean = True, Optional IsJson As Boolean = False)
@@ -1429,6 +1432,7 @@ RetryDir:
If Ex Is Nothing Then Return "无可用错误信息!" If Ex Is Nothing Then Return "无可用错误信息!"
'获取最底层的异常 '获取最底层的异常
Dim OuterEx As Exception = Ex
Dim InnerEx As Exception = Ex Dim InnerEx As Exception = Ex
Do Until InnerEx.InnerException Is Nothing Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException InnerEx = InnerEx.InnerException
@@ -1452,7 +1456,7 @@ RetryDir:
Loop Loop
'构造输出信息 '构造输出信息
Dim UsualReason As String = AnalyzeUsualReason(InnerEx, Ex, DescList) Dim UsualReason As String = AnalyzeUsualReason(InnerEx, OuterEx, DescList)
If UsualReason Is Nothing Then If UsualReason Is Nothing Then
Return DescList.Join(vbCrLf) Return DescList.Join(vbCrLf)
Else Else
@@ -1466,6 +1470,7 @@ RetryDir:
If Ex Is Nothing Then Return "无可用错误信息!" If Ex Is Nothing Then Return "无可用错误信息!"
'获取最底层的异常 '获取最底层的异常
Dim OuterEx As Exception = Ex
Dim InnerEx As Exception = Ex Dim InnerEx As Exception = Ex
Do Until InnerEx.InnerException Is Nothing Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException InnerEx = InnerEx.InnerException
@@ -1481,7 +1486,7 @@ RetryDir:
Dim Desc As String = Join(DescList, vbCrLf & "→ ") Dim Desc As String = Join(DescList, vbCrLf & "→ ")
'构造输出信息 '构造输出信息
Dim UsualReason As String = AnalyzeUsualReason(InnerEx, Ex, DescList) Dim UsualReason As String = AnalyzeUsualReason(InnerEx, OuterEx, DescList)
If UsualReason IsNot Nothing Then If UsualReason IsNot Nothing Then
Return UsualReason & "详细错误:" & DescList.First Return UsualReason & "详细错误:" & DescList.First
Else Else
@@ -1580,16 +1585,6 @@ RetryDir:
Return Mid(Str.PadRight(Length, Code), Str.Length + 1) & Str Return Mid(Str.PadRight(Length, Code), Str.Length + 1) & Str
End Function End Function
''' <summary> ''' <summary>
''' 将一个小数显示为固定的小数点后位数形式,将向零取整。
''' 如 12 保留 2 位则输出 12.00,而 95.678 保留 2 位则输出 95.67。
''' </summary>
Public Function StrFillNum(Num As Double, Length As Integer) As String
Num = Math.Round(Num, Length, MidpointRounding.AwayFromZero)
StrFillNum = Num
If Not StrFillNum.Contains(".") Then Return (StrFillNum & ".").PadRight(StrFillNum.Length + 1 + Length, "0")
Return StrFillNum.PadRight(StrFillNum.Split(".")(0).Length + 1 + Length, "0")
End Function
''' <summary>
''' 移除字符串首尾的标点符号、回车,以及括号中、冒号后的补充说明内容。 ''' 移除字符串首尾的标点符号、回车,以及括号中、冒号后的补充说明内容。
''' </summary> ''' </summary>
Public Function StrTrim(Str As String, Optional RemoveQuote As Boolean = True) Public Function StrTrim(Str As String, Optional RemoveQuote As Boolean = True)
@@ -1964,7 +1959,7 @@ RetryDir:
Function(Source) Source.Key.Replace(" ", "").ContainsF(QueryPart, True))) Function(Source) Source.Key.Replace(" ", "").ContainsF(QueryPart, True)))
Next Next
'按照相似度进行排序 '按照相似度进行排序
Entries = Entries.Sort( Entries = Entries.SortByComparison(
Function(Left, Right) As Boolean Function(Left, Right) As Boolean
If Left.AbsoluteRight Xor Right.AbsoluteRight Then If Left.AbsoluteRight Xor Right.AbsoluteRight Then
Return Left.AbsoluteRight Return Left.AbsoluteRight
@@ -2031,7 +2026,7 @@ RetryDir:
Implements IDictionary(Of TKey, TValue) Implements IDictionary(Of TKey, TValue)
Implements IEnumerable(Of KeyValuePair(Of TKey, TValue)) Implements IEnumerable(Of KeyValuePair(Of TKey, TValue))
Private ReadOnly SyncRoot As New Object Public ReadOnly SyncRoot As New Object
Private ReadOnly _Dictionary As New Dictionary(Of TKey, TValue) Private ReadOnly _Dictionary As New Dictionary(Of TKey, TValue)
'构造函数 '构造函数
@@ -2229,6 +2224,19 @@ RetryDir:
Return CultureInfo.CurrentCulture.Name.StartsWithF("zh-") OrElse CultureInfo.CurrentUICulture.Name.StartsWithF("zh-") Return CultureInfo.CurrentCulture.Name.StartsWithF("zh-") OrElse CultureInfo.CurrentUICulture.Name.StartsWithF("zh-")
End Function End Function
''' <summary>
''' 判断对象是否为某个泛型类型的实例。
''' </summary>
<Extension> Public Function IsInstanceOfGenericType(genericType As Type, obj As Object) As Boolean
If obj Is Nothing Then Return False
Dim t = obj.GetType()
While t IsNot Nothing
If t.IsGenericType AndAlso t.GetGenericTypeDefinition() Is genericType Then Return True
t = t.BaseType
End While
Return False
End Function
Private Uuid As Integer = 1 Private Uuid As Integer = 1
Private UuidLock As Object Private UuidLock As Object
''' <summary> ''' <summary>
@@ -2256,7 +2264,7 @@ RetryDir:
Next i Next i
End Function End Function
''' <summary> ''' <summary>
''' 数组去重。 ''' 去重。
''' </summary> ''' </summary>
<Extension> Public Function Distinct(Of T)(Arr As ICollection(Of T), IsEqual As ComparisonBoolean(Of T)) As List(Of T) <Extension> Public Function Distinct(Of T)(Arr As ICollection(Of T), IsEqual As ComparisonBoolean(Of T)) As List(Of T)
Dim ResultArray As New List(Of T) Dim ResultArray As New List(Of T)
@@ -2272,6 +2280,15 @@ NextElement:
<Extension> Public Function Any(Arr As UIElementCollection) As Boolean <Extension> Public Function Any(Arr As UIElementCollection) As Boolean
Return Arr?.Count > 0 Return Arr?.Count > 0
End Function End Function
''' <summary>
''' 对集合的每个元素执行指定操作。
''' </summary>
<Extension> Public Function ForEach(Of T)(Collection As IEnumerable(Of T), Action As Action(Of T)) As IEnumerable(Of T)
For Each Item As T In Collection
Action(Item)
Next
Return Collection
End Function
''' <summary> ''' <summary>
''' 获取格式类似于“11:08:52.037”的当前时间的字符串。 ''' 获取格式类似于“11:08:52.037”的当前时间的字符串。
@@ -2494,10 +2511,46 @@ NextElement:
End Sub End Sub
''' <summary> ''' <summary>
''' 按照既定的函数进行选择排序。 ''' 选择最大值对应的对象。
''' 传入两个对象,若第一个对象应该排在前面,则返回 True。 ''' 若没有元素则返回 Nothing。
''' </summary> ''' </summary>
<Extension> Public Function Sort(Of T)(List As IList(Of T), SortRule As ComparisonBoolean(Of T)) As List(Of T) <Extension> Public Function MaxOf(Of T, C As IComparable(Of C))(Source As IEnumerable(Of T), Selector As Func(Of T, C)) As T
Using Enumerator = Source.GetEnumerator()
If Not Enumerator.MoveNext() Then Return Nothing
Dim MaxItem As T = Enumerator.Current
Dim MaxValue As C = Selector(MaxItem)
While Enumerator.MoveNext()
Dim Value = Selector(Enumerator.Current)
If Value.CompareTo(MaxValue) <= 0 Then Continue While
MaxItem = Enumerator.Current
MaxValue = Value
End While
Return MaxItem
End Using
End Function
''' <summary>
''' 选择最小值对应的对象。
''' 若没有元素则返回 Nothing。
''' </summary>
<Extension> Public Function MinOf(Of T, C As IComparable(Of C))(List As IEnumerable(Of T), Selector As Func(Of T, C)) As T
Using Enumerator = List.GetEnumerator()
If Not Enumerator.MoveNext() Then Return Nothing
Dim MinItem As T = Enumerator.Current
Dim MinValue As C = Selector(MinItem)
While Enumerator.MoveNext()
Dim Value = Selector(Enumerator.Current)
If Value.CompareTo(MinValue) >= 0 Then Continue While
MinItem = Enumerator.Current
MinValue = Value
End While
Return MinItem
End Using
End Function
''' <summary>
''' 按照既定的函数进行选择排序。
''' 返回第一个对象是否应该排在前面(a > b)。
''' </summary>
<Extension> Public Function SortByComparison(Of T)(List As IList(Of T), SortRule As ComparisonBoolean(Of T)) As List(Of T)
Dim NewList As New List(Of T) Dim NewList As New List(Of T)
While List.Any While List.Any
Dim Highest = List(0) Dim Highest = List(0)
@@ -2769,19 +2822,25 @@ Retry:
''' <summary> ''' <summary>
''' 将 XML 转换为对应 UI 对象。 ''' 将 XML 转换为对应 UI 对象。
''' 注意:性能较差,不应大量使用。
''' </summary> ''' </summary>
Public Function GetObjectFromXML(Str As XElement) Public Function GetObjectFromXML(Str As XElement)
Return GetObjectFromXML(Str.ToString) Return GetObjectFromXML(Str.ToString)
End Function End Function
''' <summary> ''' <summary>
''' 将 XML 转换为对应 UI 对象。 ''' 将 XML 转换为对应 UI 对象。
''' 注意:性能较差,不应大量使用。
''' </summary> ''' </summary>
Public Function GetObjectFromXML(Str As String) As Object Public Function GetObjectFromXML(Str As String) As Object
Str = Str. '兼容旧版自定义事件写法 Str = Str. '兼容旧版自定义事件写法
Replace("EventType=""", "local:CustomEventService.EventType="""). Replace("EventType=""", "local:CustomEventService.EventType=""").
Replace("EventData=""", "local:CustomEventService.EventData="""). Replace("EventData=""", "local:CustomEventService.EventData=""").
Replace("EventType='", "local:CustomEventService.EventType='").
Replace("EventData='", "local:CustomEventService.EventData='").
Replace("Property=""EventType""", "Property=""local:CustomEventService.EventType"""). Replace("Property=""EventType""", "Property=""local:CustomEventService.EventType""").
Replace("Property=""EventData""", "Property=""local:CustomEventService.EventData""") Replace("Property=""EventData""", "Property=""local:CustomEventService.EventData""").
Replace("Property='EventType'", "Property='local:CustomEventService.EventType'").
Replace("Property='EventData'", "Property='local:CustomEventService.EventData'")
Using Stream As New MemoryStream(Encoding.UTF8.GetBytes(Str)) Using Stream As New MemoryStream(Encoding.UTF8.GetBytes(Str))
'类型检查 '类型检查
Using Reader As New XamlXmlReader(Stream) Using Reader As New XamlXmlReader(Stream)
@@ -3114,7 +3173,7 @@ Retry:
"操作系统:" & My.Computer.Info.OSFullName & "(32 位:" & Is32BitSystem & ")" & vbCrLf & "操作系统:" & My.Computer.Info.OSFullName & "(32 位:" & Is32BitSystem & ")" & vbCrLf &
"剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf & "剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
"DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf & "DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
"MC 文件夹:" & If(PathMcFolder, "Nothing") & vbCrLf & "MC 文件夹:" & If(McFolderSelected, "Nothing") & vbCrLf &
"文件位置:" & Path) "文件位置:" & Path)
End Sub End Sub
+231 -177
View File
@@ -242,7 +242,7 @@ RequestFinished:
If Header.Key.ToLower = "content-type" Then If Header.Key.ToLower = "content-type" Then
Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value) Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
Else Else
Request.Headers.Add(Header.Key, Header.Value) Request.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
End If End If
Next Next
SecretHeadersSign(Url, Request, SimulateBrowserHeaders) SecretHeadersSign(Url, Request, SimulateBrowserHeaders)
@@ -257,7 +257,7 @@ RequestFinished:
'延迟初始化,以避免在程序启动前加载 CacheCow 导致 DLL 加载失败 '延迟初始化,以避免在程序启动前加载 CacheCow 导致 DLL 加载失败
If RequestClient Is Nothing Then If RequestClient Is Nothing Then
RequestClient = CacheCow.Client.ClientExtensions.CreateClient(New CacheCow.Client.FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With { RequestClient = CacheCow.Client.ClientExtensions.CreateClient(New CacheCow.Client.FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With {
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None, .AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip,
.UseCookies = False '不设为 False 就不能从 Header 手动传入 Cookies .UseCookies = False '不设为 False 就不能从 Header 手动传入 Cookies
}) })
End If End If
@@ -308,15 +308,25 @@ RequestFinished:
''' 若解析失败,则返回 Nothing。 ''' 若解析失败,则返回 Nothing。
''' </summary> ''' </summary>
Private Function DNSLookup(Request As HttpRequestMessage, CancelToken As CancellationTokenSource) As String Private Function DNSLookup(Request As HttpRequestMessage, CancelToken As CancellationTokenSource) As String
Dim GetIPReliability = Function(Key) IPReliability.GetOrDefault(Key.ToString, 0) '若一分钟内已失败过,则不再重复尝试解析,以减少断网时的 Exception 数量
'初步 DNS 解析
Dim Host = Request.RequestUri.Host Dim Host = Request.RequestUri.Host
SyncLock DNSFailureRecord.SyncRoot
If DNSFailureRecord.ContainsKey(Host) Then
If Date.Now - DNSFailureRecord(Host) < New TimeSpan(0, 1, 0) Then
Return Nothing
Else
DNSFailureRecord.Remove(Host)
End If
End If
End SyncLock
'初步 DNS 解析
Dim DnsTask As Task(Of IPAddress()) = Nothing Dim DnsTask As Task(Of IPAddress()) = Nothing
Try Try
DnsTask = Dns.GetHostAddressesAsync(Host) DnsTask = Dns.GetHostAddressesAsync(Host)
DnsTask.Wait(CancelToken.Token) DnsTask.Wait(CancelToken.Token)
Catch ex As Exception Catch ex As Exception
Log(ex, $"DNS 解析失败({Host})") Log(ex, $"DNS 解析失败({Host})")
DNSFailureRecord(Host) = Date.Now
Return Nothing Return Nothing
End Try End Try
Dim Candidates As IPAddress() = DnsTask.Result.ToArray Dim Candidates As IPAddress() = DnsTask.Result.ToArray
@@ -325,6 +335,7 @@ RequestFinished:
Return Nothing Return Nothing
End If End If
'若同时存在 IPv4 和 IPv6 地址,仅选择其中一类(因为 GFW 可能只屏蔽了 IPv4 或 IPv6) '若同时存在 IPv4 和 IPv6 地址,仅选择其中一类(因为 GFW 可能只屏蔽了 IPv4 或 IPv6)
Dim GetIPReliability = Function(Key) IPReliability.GetOrDefault(Key.ToString, 0)
Dim IPv4Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetwork).ToArray Dim IPv4Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetwork).ToArray
Dim IPv6Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetworkV6).ToArray Dim IPv6Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetworkV6).ToArray
If IPv4Targets.Any AndAlso IPv6Targets.Any Then If IPv4Targets.Any AndAlso IPv6Targets.Any Then
@@ -347,6 +358,7 @@ RequestFinished:
End If End If
Return TargetIp Return TargetIp
End Function End Function
Private DNSFailureRecord As New SafeDictionary(Of String, Date)
''' <summary> ''' <summary>
''' 记录每个 IP 地址的请求可靠度。 ''' 记录每个 IP 地址的请求可靠度。
''' 通常取值 -1 ~ +0.5,越高越好。未尝试过的 IP 应视为 0。 ''' 通常取值 -1 ~ +0.5,越高越好。未尝试过的 IP 应视为 0。
@@ -387,7 +399,7 @@ RequestFinished:
#Region "多线程下载引擎" #Region "多线程下载引擎"
Private ThreadClient As New HttpClient(New HttpClientHandler With { Private ThreadClient As New HttpClient(New HttpClientHandler With {
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None .AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip
}) })
''' <summary> ''' <summary>
@@ -407,7 +419,6 @@ RequestFinished:
''' </summary> ''' </summary>
Public NetTaskSpeedLimitLeft As Long = -1 Public NetTaskSpeedLimitLeft As Long = -1
Private ReadOnly NetTaskSpeedLimitLeftLock As New Object Private ReadOnly NetTaskSpeedLimitLeftLock As New Object
Private NetTaskSpeedLimitLeftLast As Long
''' <summary> ''' <summary>
''' 正在运行中的线程数。 ''' 正在运行中的线程数。
''' </summary> ''' </summary>
@@ -438,39 +449,35 @@ RequestFinished:
''' <summary> ''' <summary>
''' 尚未进行已存在检查。 ''' 尚未进行已存在检查。
''' </summary> ''' </summary>
WaitForCheck = -1 WaitingToCheck = -1
''' <summary> ''' <summary>
''' 尚未开始。 ''' 尚未开始。
''' </summary> ''' </summary>
WaitForDownload = 0 WaitingToDownload = 0
''' <summary> ''' <summary>
''' 正在连接,尚未获取文件大小。 ''' 正在连接,尚未获取文件大小。
''' </summary> ''' </summary>
Connect = 1 Connecting = 1
''' <summary> ''' <summary>
''' 已获取文件大小,尚未有有效下载。 ''' 已连接,正在尝试接收首个下载数据包。
''' </summary> ''' </summary>
[Get] = 2 Reading = 2
''' <summary> ''' <summary>
''' 正在下载。 ''' 正在下载。
''' </summary> ''' </summary>
Download = 3 Downloading = 3
''' <summary> ''' <summary>
''' 正在合并文件。 ''' 正在合并文件。
''' </summary> ''' </summary>
Merge = 4 Merging = 4
''' <summary>
''' 不进行下载,因为已发现现存的文件。
''' </summary>
WaitForCopy = 5
''' <summary> ''' <summary>
''' 已完成。 ''' 已完成。
''' </summary> ''' </summary>
Finish = 6 Finished = 5
''' <summary> ''' <summary>
''' 已失败或中断。 ''' 已失败或中断。
''' </summary> ''' </summary>
[Error] = 7 Interrupted = 6
End Enum End Enum
''' <summary> ''' <summary>
''' 预下载检查行为。 ''' 预下载检查行为。
@@ -612,13 +619,13 @@ RequestFinished:
''' <summary> ''' <summary>
''' 当前线程的状态。 ''' 当前线程的状态。
''' </summary> ''' </summary>
Public State As NetState = NetState.WaitForDownload Public State As NetState = NetState.WaitingToDownload
''' <summary> ''' <summary>
''' 是否已经结束。 ''' 是否已经结束。
''' </summary> ''' </summary>
Public ReadOnly Property IsEnded As Boolean Public ReadOnly Property IsEnded As Boolean
Get Get
Return State = NetState.Finish OrElse State = NetState.Error Return State = NetState.Finished OrElse State = NetState.Interrupted
End Get End Get
End Property End Property
@@ -716,7 +723,7 @@ RequestFinished:
''' <summary> ''' <summary>
''' 当前的下载状态。 ''' 当前的下载状态。
''' </summary> ''' </summary>
Public State As NetState = NetState.WaitForCheck Public State As NetState = NetState.WaitingToCheck
''' <summary> ''' <summary>
''' 导致下载失败的原因。 ''' 导致下载失败的原因。
''' </summary> ''' </summary>
@@ -741,7 +748,7 @@ RequestFinished:
''' </summary> ''' </summary>
Public ReadOnly Property IsNoSplit As Boolean Public ReadOnly Property IsNoSplit As Boolean
Get Get
Return IsUnknownSize OrElse FileSize < FilePieceLimit Return IsUnknownSize OrElse FileSize < 1024 * 1024 '小于 1MB 的文件不分割
End Get End Get
End Property End Property
''' <summary> ''' <summary>
@@ -797,24 +804,22 @@ RequestFinished:
Public ReadOnly Property Progress As Double Public ReadOnly Property Progress As Double
Get Get
Select Case State Select Case State
Case NetState.WaitForCheck Case NetState.WaitingToCheck
Return 0 Return 0
Case NetState.WaitForCopy Case NetState.WaitingToDownload
Return 0.2
Case NetState.WaitForDownload
Return 0.01 Return 0.01
Case NetState.Connect Case NetState.Connecting
Return 0.02 Return 0.02
Case NetState.Get Case NetState.Reading
Return 0.04 Return 0.04
Case NetState.Download Case NetState.Downloading
'正在下载中,对应 5% ~ 98% '正在下载中,对应 5% ~ 98%
Dim OriginalProgress As Double = If(IsUnknownSize, 0.5, DownloadDone / Math.Max(FileSize, 1)) Dim OriginalProgress As Double = If(IsUnknownSize, 0.5, DownloadDone / Math.Max(FileSize, 1))
OriginalProgress = 1 - (1 - OriginalProgress) ^ 0.9 OriginalProgress = 1 - (1 - OriginalProgress) ^ 0.9
Return OriginalProgress * 0.93 + 0.05 Return OriginalProgress * 0.93 + 0.05
Case NetState.Merge Case NetState.Merging
Return 0.99 Return 0.99
Case NetState.Finish, NetState.Error Case NetState.Finished, NetState.Interrupted
Return 1 Return 1
Case Else Case Else
Throw New ArgumentOutOfRangeException("文件状态未知:" & State) Throw New ArgumentOutOfRangeException("文件状态未知:" & State)
@@ -859,7 +864,7 @@ RequestFinished:
''' 新建一个需要下载的文件。 ''' 新建一个需要下载的文件。
''' </summary> ''' </summary>
''' <param name="LocalPath">包含文件名的本地地址。</param> ''' <param name="LocalPath">包含文件名的本地地址。</param>
Public Sub New(Urls As IEnumerable(Of String), LocalPath As String, Optional Check As FileChecker = Nothing, Optional SimulateBrowserHeaders As Boolean = False) Public Sub New(Urls As IEnumerable(Of String), LocalPath As String, Optional Checker As FileChecker = Nothing, Optional SimulateBrowserHeaders As Boolean = False)
Dim Sources As New List(Of NetSource) Dim Sources As New List(Of NetSource)
Dim Count As Integer = 0 Dim Count As Integer = 0
Urls = Urls.Distinct.ToArray Urls = Urls.Distinct.ToArray
@@ -869,7 +874,7 @@ RequestFinished:
Next Next
Me.Sources = Sources Me.Sources = Sources
Me.LocalPath = LocalPath Me.LocalPath = LocalPath
Me.Check = Check Me.Check = Checker
Me.SimulateBrowserHeaders = SimulateBrowserHeaders Me.SimulateBrowserHeaders = SimulateBrowserHeaders
Me.LocalName = GetFileNameFromPath(LocalPath) Me.LocalName = GetFileNameFromPath(LocalPath)
End Sub End Sub
@@ -886,10 +891,10 @@ RequestFinished:
'条件检测 '条件检测
SyncLock LockSource SyncLock LockSource
If NetTaskThreadCount >= NetTaskThreadLimit OrElse Not HasAvailableSource() OrElse If NetTaskThreadCount >= NetTaskThreadLimit OrElse Not HasAvailableSource() OrElse
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing (IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Interrupted) Then Return Nothing
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing If State >= NetState.Merging OrElse State = NetState.WaitingToCheck Then Return Nothing
SyncLock LockState SyncLock LockState
If State < NetState.Connect Then State = NetState.Connect If State < NetState.Connecting Then State = NetState.Connecting
End SyncLock End SyncLock
'初始化参数 '初始化参数
'获取线程起点与下载源 '获取线程起点与下载源
@@ -897,10 +902,10 @@ RequestFinished:
If IsNoSplit Then GoTo StartSingleThreadDownload If IsNoSplit Then GoTo StartSingleThreadDownload
'只剩下单线程可用点 '只剩下单线程可用点
If Not HasAvailableSource(False) Then If Not HasAvailableSource(False) Then
If SourcesOnce.First.SingleThread IsNot Nothing AndAlso SourcesOnce.First.SingleThread.State <> NetState.Error Then Return Nothing If SourcesOnce.First.SingleThread IsNot Nothing AndAlso SourcesOnce.First.SingleThread.State <> NetState.Interrupted Then Return Nothing
StartSingleThreadDownload: StartSingleThreadDownload:
Reset() Reset()
State = NetState.Get State = NetState.Reading
End If End If
End SyncLock End SyncLock
SyncLock LockChain SyncLock LockChain
@@ -913,7 +918,7 @@ StartSingleThreadDownload:
End If End If
'寻找失败点 '寻找失败点
For Each Thread As NetThread In Threads For Each Thread As NetThread In Threads
If Thread.State = NetState.Error AndAlso Thread.DownloadUndone > 0 Then If Thread.State = NetState.Interrupted AndAlso Thread.DownloadUndone > 0 Then
StartPosition = Thread.DownloadStart + Thread.DownloadDone StartPosition = Thread.DownloadStart + Thread.DownloadDone
StartSource = GetSource(Thread.Source.Id + 1) StartSource = GetSource(Thread.Source.Id + 1)
GoTo StartThread GoTo StartThread
@@ -942,7 +947,7 @@ StartThread:
Dim ThreadUuid As Integer = GetUuid() Dim ThreadUuid As Integer = GetUuid()
If Not Tasks.Any() Then Return Nothing '由于中断,已没有可用任务 If Not Tasks.Any() Then Return Nothing '由于中断,已没有可用任务
Th = New Thread(AddressOf Thread) With {.Name = $"下载 {Tasks(0).Uuid}/{Uuid}/{ThreadUuid}#", .Priority = ThreadPriority.BelowNormal} Th = New Thread(AddressOf Thread) With {.Name = $"下载 {Tasks(0).Uuid}/{Uuid}/{ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload} ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitingToDownload}
'链表处理 '链表处理
If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then
Threads = ThreadInfo Threads = ThreadInfo
@@ -981,8 +986,8 @@ StartThread:
CancelToken As CancellationTokenSource = Nothing, HostIp As String = Nothing CancelToken As CancellationTokenSource = Nothing, HostIp As String = Nothing
'部分下载源真的特别慢,并且只需要一个请求,例如 Ping 为 20s,如果增长太慢,就会造成类似 2.5s 5s 7.5s 10s 12.5s... 的极大延迟 '部分下载源真的特别慢,并且只需要一个请求,例如 Ping 为 20s,如果增长太慢,就会造成类似 2.5s 5s 7.5s 10s 12.5s... 的极大延迟
'延迟过长会导致某些特别慢的链接迟迟不被掐死 '延迟过长会导致某些特别慢的链接迟迟不被掐死
Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 6000) * (1 + Th.Source.FailCount), 30000) Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 10000) * (1 + Th.Source.FailCount), 30000)
Th.State = NetState.Connect Th.State = NetState.Connecting
Try Try
Dim HttpDataCount As Integer = 0 Dim HttpDataCount As Integer = 0
If SourcesOnce.Contains(Th.Source) AndAlso Th <> Th.Source.SingleThread Then GoTo SourceBreak If SourcesOnce.Contains(Th.Source) AndAlso Th <> Th.Source.SingleThread Then GoTo SourceBreak
@@ -994,7 +999,7 @@ StartThread:
Dim ContentLength As Long = 0 Dim ContentLength As Long = 0
Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout) Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
If Not Response.IsSuccessStatusCode Then Throw New Exception($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)}),{Th.Source.Url}") '状态码检查 If Not Response.IsSuccessStatusCode Then Throw New Exception($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)}),{Th.Source.Url}") '状态码检查
If State = NetState.Error Then GoTo SourceBreak '快速中断 If State = NetState.Interrupted Then GoTo SourceBreak '快速中断
If ModeDebug AndAlso Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Log($"[Download] {LocalName}:重定向至 {Response.RequestMessage.RequestUri}") If ModeDebug AndAlso Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Log($"[Download] {LocalName}:重定向至 {Response.RequestMessage.RequestUri}")
'文件大小校验 '文件大小校验
ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1) ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1)
@@ -1045,9 +1050,9 @@ NotSupportRange:
Throw New RangeNotSupportedException($"获取到的分段大小不一致:Range 起始于 {Th.DownloadStart},预期 ContentLength 为 {FileSize - Th.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}") Throw New RangeNotSupportedException($"获取到的分段大小不一致:Range 起始于 {Th.DownloadStart},预期 ContentLength 为 {FileSize - Th.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}")
End If End If
'Log($"[Download] {LocalName} {Info.Uuid}#:通过大小检查,文件大小 {FileSize},起始点 {Info.DownloadStart},ContentLength {ContentLength}") 'Log($"[Download] {LocalName} {Info.Uuid}#:通过大小检查,文件大小 {FileSize},起始点 {Info.DownloadStart},ContentLength {ContentLength}")
Th.State = NetState.Get Th.State = NetState.Reading
SyncLock LockState SyncLock LockState
If State < NetState.Get Then State = NetState.Get If State < NetState.Reading Then State = NetState.Reading
End SyncLock End SyncLock
'创建缓存文件 '创建缓存文件
If IsNoSplit Then If IsNoSplit Then
@@ -1065,7 +1070,7 @@ NotSupportRange:
Dim ResponseBytes As Byte() = New Byte(16384) {} Dim ResponseBytes As Byte() = New Byte(16384) {}
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout) HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成 While (IsUnknownSize OrElse Th.DownloadUndone > 0) AndAlso '判断是否下载完成
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th) HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merging AndAlso (Not Th.Source.IsFailed OrElse Th.Source.SingleThread = Th)
'限速 '限速
While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0 While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0
Threading.Thread.Sleep(16) Threading.Thread.Sleep(16)
@@ -1080,9 +1085,9 @@ NotSupportRange:
'有数据 '有数据
If Th.DownloadDone = 0 Then If Th.DownloadDone = 0 Then
'第一次接受到数据 '第一次接受到数据
Th.State = NetState.Download Th.State = NetState.Downloading
SyncLock LockState SyncLock LockState
If State < NetState.Download Then State = NetState.Download If State < NetState.Downloading Then State = NetState.Downloading
End SyncLock End SyncLock
SyncLock LockCount SyncLock LockCount
ConnectCount += 1 ConnectCount += 1
@@ -1116,16 +1121,16 @@ NotSupportRange:
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout) HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
End While End While
SourceBreak: SourceBreak:
If State = NetState.Error OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then If State = NetState.Interrupted OrElse (Th.Source.IsFailed AndAlso Th.Source.SingleThread <> Th) OrElse (Th.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
'被外部中断 '被外部中断
Th.State = NetState.Error Th.State = NetState.Interrupted
Log($"[Download] {LocalName}:中断") Log($"[Download] {LocalName}:中断")
ElseIf HttpDataCount = 0 AndAlso Th.DownloadUndone > 0 AndAlso Not IsUnknownSize Then ElseIf HttpDataCount = 0 AndAlso Th.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
'服务器无返回数据 '服务器无返回数据
Throw New Exception($"返回的 ContentLength 过多:ContentLength 为 {ContentLength},但获取到的总数据量仅为 {Th.DownloadDone}(全文件总数据量 {DownloadDone})") Throw New Exception($"返回的 ContentLength 过多:ContentLength 为 {ContentLength},但获取到的总数据量仅为 {Th.DownloadDone}(全文件总数据量 {DownloadDone})")
Else Else
'本线程完成 '本线程完成
Th.State = NetState.Finish Th.State = NetState.Finished
If ModeDebug Then Log($"[Download] {LocalName}:完成,已下载 {Th.DownloadDone}({Th.DownloadStart}~{Th.DownloadEnd})") If ModeDebug Then Log($"[Download] {LocalName}:完成,已下载 {Th.DownloadDone}({Th.DownloadStart}~{Th.DownloadEnd})")
RecordIPReliability(HostIp, 0.5) RecordIPReliability(HostIp, 0.5)
End If End If
@@ -1147,7 +1152,7 @@ SourceBreak:
End SyncLock End SyncLock
'合并 '合并
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso
State < NetState.Merge AndAlso Th.State <> NetState.Error Then Merge(Th) State < NetState.Merging AndAlso Th.State <> NetState.Interrupted Then Merge(Th)
End Try End Try
End Sub End Sub
Private Sub SourceFail(Th As NetThread, ex As Exception, IsMergeFailure As Boolean) Private Sub SourceFail(Th As NetThread, ex As Exception, IsMergeFailure As Boolean)
@@ -1158,7 +1163,7 @@ SourceBreak:
Task.FailCount += 1 Task.FailCount += 1
Next Next
End SyncLock End SyncLock
Th.State = NetState.Error Th.State = NetState.Interrupted
Th.Source.Ex = ex Th.Source.Ex = ex
'根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传) '根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传)
Dim IsRangeNotSupported As Boolean = TypeOf ex Is RangeNotSupportedException OrElse ex.Message.Contains("(416)") Dim IsRangeNotSupported As Boolean = TypeOf ex Is RangeNotSupportedException OrElse ex.Message.Contains("(416)")
@@ -1202,13 +1207,13 @@ SourceBreak:
End SyncLock End SyncLock
Reset() Reset()
SyncLock LockState SyncLock LockState
State = NetState.WaitForDownload State = NetState.WaitingToDownload
End SyncLock End SyncLock
ElseIf HasAvailableSource() AndAlso IsMergeFailure Then ElseIf HasAvailableSource() AndAlso IsMergeFailure Then
'合并失败且单个源失败:继续下一个源 '合并失败且单个源失败:继续下一个源
Reset() Reset()
SyncLock LockState SyncLock LockState
State = NetState.WaitForDownload State = NetState.WaitingToDownload
End SyncLock End SyncLock
Else Else
'失败 '失败
@@ -1251,8 +1256,8 @@ SourceBreak:
Private Sub Merge(Th As NetThread) Private Sub Merge(Th As NetThread)
'状态判断 '状态判断
SyncLock LockState SyncLock LockState
If State < NetState.Merge Then If State < NetState.Merging Then
State = NetState.Merge State = NetState.Merging
Else Else
Return Return
End If End If
@@ -1323,7 +1328,11 @@ Retry:
GoTo Retry GoTo Retry
End If End If
'失败,禁用当前下载源并重启下载 '失败,禁用当前下载源并重启下载
Try
If File.Exists(LocalPath) Then File.Delete(LocalPath) If File.Exists(LocalPath) Then File.Delete(LocalPath)
Catch exx As Exception
Log(ex, $"删除合并失败的文件出错({LocalPath})")
End Try
SourceFail(Th, ex, True) SourceFail(Th, ex, True)
Finally Finally
Cache?.Dispose() Cache?.Dispose()
@@ -1334,10 +1343,10 @@ Retry:
''' </summary> ''' </summary>
Private Sub Fail(Optional RaiseEx As Exception = Nothing) Private Sub Fail(Optional RaiseEx As Exception = Nothing)
SyncLock LockState SyncLock LockState
If State >= NetState.Finish Then Return If State >= NetState.Finished Then Return
If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx) If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
'凉凉 '凉凉
State = NetState.Error State = NetState.Interrupted
End SyncLock End SyncLock
AbortInternal() AbortInternal()
For Each Task In Tasks For Each Task In Tasks
@@ -1353,8 +1362,8 @@ Retry:
If Tasks.Any Then Return If Tasks.Any Then Return
'确认中断 '确认中断
SyncLock LockState SyncLock LockState
If State >= NetState.Finish Then Return If State >= NetState.Finished Then Return
State = NetState.Error State = NetState.Interrupted
End SyncLock End SyncLock
AbortInternal() AbortInternal()
End Sub End Sub
@@ -1373,8 +1382,8 @@ Retry:
''' </summary> ''' </summary>
Public Sub Finish(Optional PrintLog As Boolean = True) Public Sub Finish(Optional PrintLog As Boolean = True)
SyncLock LockState SyncLock LockState
If State >= NetState.Finish Then Return If State >= NetState.Finished Then Return
State = NetState.Finish State = NetState.Finished
End SyncLock End SyncLock
SyncLock NetManager.LockRemain SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1 NetManager.FileRemain -= 1
@@ -1483,20 +1492,10 @@ FinishExCatch:
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
If Input IsNot Nothing Then Files = New SafeList(Of NetFile)(Input) If Input IsNot Nothing Then Files = New SafeList(Of NetFile)(Input)
'去重 '去重
Dim ResultArray As New SafeList(Of NetFile) Files = New SafeList(Of NetFile)(Files.Distinct(Function(a, b) a.LocalPath = b.LocalPath))
For i = 0 To Files.Count - 1
For ii = i + 1 To Files.Count - 1
If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement
Next
ResultArray.Add(Files(i))
NextElement:
Next
Files = ResultArray
'设置剩余文件数 '设置剩余文件数
SyncLock FileRemainLock SyncLock FileRemainLock
For Each File In Files FileRemain += Files.Where(Function(f) f.State <> NetState.Finished).Count
If File.State <> NetState.Finish Then FileRemain += 1
Next
End SyncLock End SyncLock
State = LoadState.Loading State = LoadState.Loading
'开始执行 '开始执行
@@ -1517,109 +1516,162 @@ NextElement:
End If End If
Next Next
If Not File.HasAvailableSource() Then Throw New ArgumentException("输入的下载链接不正确!") If Not File.HasAvailableSource() Then Throw New ArgumentException("输入的下载链接不正确!")
File.LocalPath = File.LocalPath.Replace("/", "\")
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确:" & File.LocalPath) If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确:" & File.LocalPath)
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径:" & File.LocalPath) If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径:" & File.LocalPath)
'文件夹检测 Directory.CreateDirectory(GetPathFromFullPath(File.LocalPath)) '创建目标文件夹
Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
Next Next
'接入下载管理器 '接入下载管理器
NetManager.Start(Me) NetManager.Start(Me)
'将文件分配给多个线程以进行已存在查找
Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表 '====================================
Dim FoldersFinal As New List(Of String) '最终用于查找的列表 ' 已存在文件查找
If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制 '====================================
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹,因为 HMCL 会把所有文件存在这里
For Each Folder In McFolderList '整理允许进行查找的文件
Folders.Add(Folder.Path) Dim FilesToCheck As New List(Of NetFile)
Next Dim DisabledCopy As Boolean = Setup.Get("SystemDebugSkipCopy") '在设置中禁用了复制
Folders = Folders.Distinct.ToList
For Each Folder In Folders
If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder)
Next
End If
'最多 5 个线程,最少每个线程分配 10 个文件
Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1)
Dim FilesInThread As New List(Of NetFile)
For Each File In Files For Each File In Files
FilesInThread.Add(File) If Not DisabledCopy AndAlso File.Check?.CanUseExistsFile Then
If FilesInThread.Count = FilesPerThread Then FilesToCheck.Add(File)
Dim FilesToRun As New List(Of NetFile) Else '不允许,直接开始下载
FilesToRun.AddRange(FilesInThread) SyncLock LockState
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "下载 文件复制 " & Uuid) File.State = NetState.WaitingToDownload
FilesInThread.Clear() File.IsCopy = False
End SyncLock
End If End If
Next Next
If FilesInThread.Any Then If Not FilesToCheck.Any Then Return
Dim FilesToRun As New List(Of NetFile) '获取 MC 文件夹列表
FilesToRun.AddRange(FilesInThread) Dim Folders As New List(Of String)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "下载 文件复制 " & Uuid) Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹,因为 HMCL 会把所有文件存在这里
FilesInThread.Clear() Folders.AddRange(McFolderList.Select(Function(f) f.Location))
Folders = Folders.Distinct.Where(Function(f) Directory.Exists(f)).ToList
'平均分配到多个检查线程
Dim ThreadCount As Integer = MathClamp(FilesToCheck.Count \ 40, 1, 8) '每个线程至少 40 个文件,最多 8 线程
If ThreadCount = 1 Then '只有一个线程,直接执行
CheckExistingFiles(FilesToCheck, Folders)
Else
Dim BaseSize = FilesToCheck.Count \ ThreadCount
Dim Remainder = FilesToCheck.Count Mod ThreadCount
Dim Index = 0
For i = 0 To ThreadCount - 1
Dim Size = BaseSize + If(i < Remainder, 1, 0)
Dim ThreadFiles = FilesToCheck.GetRange(Index, Size)
Index += Size
RunInNewThread(Sub() CheckExistingFiles(ThreadFiles, Folders), $"下载 文件复制 {Uuid}/{GetUuid()}")
Next
End If End If
Catch ex As Exception Catch ex As Exception
OnFail(New List(Of Exception) From {ex}) OnFail(New List(Of Exception) From {New Exception("下载初始化失败", ex)})
End Try End Try
End Sub, "L/下载 " & Uuid) End Sub, "L/下载 " & Uuid)
End Sub End Sub
Private Sub StartCopy(Files As List(Of NetFile), FolderList As List(Of String)) Private Sub CheckExistingFiles(Files As List(Of NetFile), FolderList As List(Of String))
Try Try
If ModeDebug Then Log($"[Download] 检查线程分配文件数:{Files.Count},线程名:{Thread.CurrentThread.Name}") If ModeDebug Then Log($"[Download] 文件检查线程已启动,分配的文件数:{Files.Count}")
'试图从已存在的 Minecraft 文件夹中寻找目标文件 '列出 MC 文件夹中的各个版本文件夹
Dim ExistFiles As New List(Of KeyValuePair(Of NetFile, String)) '{NetFile, Target As String} Dim VersionFolders As New List(Of String)
For Each McFolder In FolderList
Dim VersionsFolder As New DirectoryInfo(McFolder & "versions\")
If VersionsFolder.Exists() Then
For Each VersionFolder In VersionsFolder.GetDirectories
VersionFolders.Add(VersionFolder.FullName & "\")
Next
End If
Next
'处理每个文件
For Each File As NetFile In Files For Each File As NetFile In Files
Dim ExistFilePath As String = Nothing Dim Target As String = CheckExistingFile(FolderList, VersionFolders, File)
'判断是否有已存在的文件 If File.State >= NetState.WaitingToDownload Then Return '中断
If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso If Target Is Nothing Then
File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWithF(PathMcFolder) Then '未找到相同文件
Dim Relative = File.LocalPath.Replace(PathMcFolder, "")
For Each Folder In FolderList
Dim Target = Folder & Relative
If File.Check.Check(Target) Is Nothing Then
ExistFilePath = Target
Exit For
End If
Next
End If
'若存在,则改变状态
SyncLock LockState SyncLock LockState
If ExistFilePath IsNot Nothing Then File.State = NetState.WaitingToDownload
File.State = NetState.WaitForCopy
File.IsCopy = True
ExistFiles.Add(New KeyValuePair(Of NetFile, String)(File, ExistFilePath))
Else
File.State = NetState.WaitForDownload
File.IsCopy = False File.IsCopy = False
End If
End SyncLock End SyncLock
Next Else
'复制已存在的文件 '已找到相同文件
For Each FileToken In ExistFiles File.IsCopy = True
Dim File As NetFile = FileToken.Key
SyncLock LockState
If File.State > NetState.WaitForCopy Then Return
End SyncLock
Dim LocalPath As String = FileToken.Value
Dim RetryCount As Integer = 0 Dim RetryCount As Integer = 0
Retry: Retry:
Try Try
Log("[Download] 复制已存在的文件(" & LocalPath & ")") If Target <> File.LocalPath Then
CopyFile(LocalPath, File.LocalPath) Log($"[Download] 复制已存在的文件:{Target} → {File.LocalPath}")
CopyFile(Target, File.LocalPath)
End If
File.Finish(False) File.Finish(False)
Catch ex As Exception Catch ex As Exception
RetryCount += 1 RetryCount += 1
Log(ex, $"复制已存在的文件失败,重试第 {RetryCount} 次({LocalPath} -> {File.LocalPath})") Log(ex, $"复制已存在的文件失败,第 {RetryCount} 次重试({Target} → {File.LocalPath})")
If RetryCount < 3 Then If RetryCount < 3 Then
Thread.Sleep(200) Thread.Sleep(200)
GoTo Retry GoTo Retry
End If End If
File.State = NetState.WaitForDownload '失败,回退到下载
SyncLock LockState
File.State = NetState.WaitingToDownload
File.IsCopy = False File.IsCopy = False
End SyncLock
End Try End Try
End If
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "下载已存在文件查找失败", LogLevel.Feedback) OnFail(New List(Of Exception) From {New Exception("下载已存在文件查找失败", ex)})
End Try End Try
End Sub End Sub
Private Function CheckExistingFile(FolderList As List(Of String), VersionFolders As List(Of String), File As NetFile) As String
'目标文件已存在
If File.Check.Check(File.LocalPath) Is Nothing Then Return File.LocalPath
'没有可用的检查规则,只能开始下载
If File.Check.Hash Is Nothing AndAlso File.Check.ActualSize < 0 Then Return Nothing
'大致判断文件类别
Dim TypeIndexes =
{"\assets\", "\libraries\", "\versions\", "\mods\", "\coremods\", "\lib\", "\resourcepacks\", "\texturepacks\", "\shaderpacks\"}.
Select(Function(FolderName) (FolderName, File.LocalPath.IndexOfF(FolderName, True))).
Where(Function(kv) kv.Item2 >= 0).ToList
If Not TypeIndexes.Any Then
If File.LocalName.EndsWithF(".jar") Then
TypeIndexes.Add(("\versions\", 1)) '总是对 jar 进行版本文件检查,以包括另存为 jar 的情况
Else
Return Nothing
End If
End If
Dim Type = TypeIndexes.MaxOf(Function(kv) kv.Item2).FolderName.TrimStart("\"c)
'根据类别进行查找
Select Case Type
Case "assets\", "libraries\"
'assets/libraries:查找 MC 文件夹下的相同路径
For Each Folder In FolderList
Dim Candidate = Folder & Type & File.LocalPath.AfterFirst(Type)
If File.Check.Check(Candidate) Is Nothing Then Return Candidate
Next
Case "versions\"
'版本 jar 或 json:查找 MC 文件夹下的各个版本文件夹
For Each VersionFolder In VersionFolders
For Each Candidate In Directory.GetFiles(VersionFolder,
"*." & GetFileNameFromPath(File.LocalPath).AfterLast(".").ToLower, SearchOption.TopDirectoryOnly)
If File.Check.Check(Candidate) Is Nothing Then Return Candidate
Next
Next
Case Else
'社区资源
If File.Check.ActualSize < 0 OrElse File.Check.Hash Is Nothing Then Return Nothing '必须要求指定了文件大小和 Hash
For Each Folder In FolderList.Concat(VersionFolders)
Dim TargetFolder = Folder & Type
If Not Directory.Exists(TargetFolder) Then Continue For
For Each Candidate In Directory.GetFiles(TargetFolder)
'快速进行大小校验
Static Sizes As New SafeDictionary(Of String, Long)
If Not Sizes.ContainsKey(Candidate) Then Sizes(Candidate) = New FileInfo(Candidate).Length
If File.Check.ActualSize <> Sizes(Candidate) Then Continue For
'Hash 校验
If File.Check.Check(Candidate) Is Nothing Then Return Candidate
Next
Next
End Select
Return Nothing
End Function
Public Sub OnFileFinish(File As NetFile) Public Sub OnFileFinish(File As NetFile)
'要求全部文件完成 '要求全部文件完成
@@ -1655,7 +1707,7 @@ Retry:
[Error] = If(UsefulExs.FirstOrDefault, ExList.FirstOrDefault) [Error] = If(UsefulExs.FirstOrDefault, ExList.FirstOrDefault)
'获取实际失败的文件 '获取实际失败的文件
For Each File In Files For Each File In Files
If File.State <> NetState.Error Then Continue For If File.State <> NetState.Interrupted Then Continue For
If File.Sources.All(Function(s) TypeOf s.Ex Is OperationCanceledException OrElse TypeOf s.Ex Is TimeoutException OrElse TypeOf s.Ex Is ThreadInterruptedException) Then Continue For If File.Sources.All(Function(s) TypeOf s.Ex Is OperationCanceledException OrElse TypeOf s.Ex Is TimeoutException OrElse TypeOf s.Ex Is ThreadInterruptedException) Then Continue For
Dim Detail As String = Join(File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetBrief())}({s.Url})"), vbCrLf) Dim Detail As String = Join(File.Sources.Select(Function(s) $"{If(s.Ex Is Nothing, "无错误信息。", s.Ex.GetBrief())}({s.Url})"), vbCrLf)
[Error] = New Exception("文件下载失败:" & File.LocalPath & vbCrLf & [Error] = New Exception("文件下载失败:" & File.LocalPath & vbCrLf &
@@ -1736,14 +1788,6 @@ Retry:
Public FileRemain As Integer = 0 Public FileRemain As Integer = 0
Public ReadOnly LockRemain As New Object Public ReadOnly LockRemain As New Object
''' <summary>
''' 上次记速时的已下载大小。
''' </summary>
Private SpeedLastDone As Long = 0
''' <summary>
''' 至多最近 30 次下载速度的记录,较新的在前面。
''' </summary>
Private SpeedLast As New List(Of Long)
'这些属性由 RefreshStat 刷新 '这些属性由 RefreshStat 刷新
''' <summary> ''' <summary>
''' 当前的全局下载速度,单位为 Byte / 秒。 ''' 当前的全局下载速度,单位为 Byte / 秒。
@@ -1764,6 +1808,8 @@ Retry:
RefreshStatLast += DeltaTime RefreshStatLast += DeltaTime
#Region "刷新整体速度" #Region "刷新整体速度"
'计算瞬时速度 '计算瞬时速度
Static SpeedLast As New List(Of Long) '记录至多最近 30 次下载速度的记录,较新的在前面
Static SpeedLastDone As Long = 0 '上次记速时的已下载大小
Dim ActualSpeed As Double = Math.Max(0, (DownloadDone - SpeedLastDone) / (DeltaTime / 1000)) Dim ActualSpeed As Double = Math.Max(0, (DownloadDone - SpeedLastDone) / (DeltaTime / 1000))
SpeedLast.Insert(0, ActualSpeed) SpeedLast.Insert(0, ActualSpeed)
If SpeedLast.Count >= 31 Then SpeedLast.RemoveAt(30) If SpeedLast.Count >= 31 Then SpeedLast.RemoveAt(30)
@@ -1799,8 +1845,9 @@ Retry:
''' 启动监控线程,用于新增下载线程。 ''' 启动监控线程,用于新增下载线程。
''' </summary> ''' </summary>
Private Sub StartManager() Private Sub StartManager()
If IsManagerStarted Then Return Static IsStarted As Boolean = False
IsManagerStarted = True If IsStarted Then Return
IsStarted = True
Dim ThreadStarter = Dim ThreadStarter =
Sub(Id As Integer) '0 或 1 Sub(Id As Integer) '0 或 1
Try Try
@@ -1816,9 +1863,9 @@ Retry:
Dim OngoingFiles As New List(Of NetFile) Dim OngoingFiles As New List(Of NetFile)
For Each File As NetFile In AllFiles For Each File As NetFile In AllFiles
If File.Uuid Mod 2 = Id Then Continue For If File.Uuid Mod 2 = Id Then Continue For
If File.State = NetState.WaitForDownload Then If File.State = NetState.WaitingToDownload Then
WaitingFiles.Add(File) WaitingFiles.Add(File)
ElseIf File.State < NetState.Merge Then ElseIf File.State < NetState.Merging Then
OngoingFiles.Add(File) OngoingFiles.Add(File)
End If End If
Next Next
@@ -1826,7 +1873,7 @@ Retry:
For Each File As NetFile In WaitingFiles For Each File As NetFile In WaitingFiles
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查 If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
Dim NewThread = File.TryBeginThread() Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率(目前每分钟限制 4000 次) If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(100) '减少 BMCLAPI 请求频率
Next Next
'为进行中的文件追加线程 '为进行中的文件追加线程
If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够,无需新增 If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够,无需新增
@@ -1836,9 +1883,9 @@ Retry:
Dim PreparingCount = 0, DownloadingCount = 0 Dim PreparingCount = 0, DownloadingCount = 0
If File.Threads IsNot Nothing Then If File.Threads IsNot Nothing Then
For Each Thread As NetThread In File.Threads.ToList For Each Thread As NetThread In File.Threads.ToList
If Thread.State < NetState.Download Then If Thread.State < NetState.Downloading Then
PreparingCount += 1 PreparingCount += 1
ElseIf Thread.State = NetState.Download Then ElseIf Thread.State = NetState.Downloading Then
DownloadingCount += 1 DownloadingCount += 1
End If End If
Next Next
@@ -1846,7 +1893,7 @@ Retry:
'新增线程 '新增线程
If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程,不再新增 If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程,不再新增
Dim NewThread = File.TryBeginThread() Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率(目前每分钟限制 4000 次) If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(100) '减少 BMCLAPI 请求频率
Next Next
End While End While
Catch ex As Exception Catch ex As Exception
@@ -1858,27 +1905,26 @@ Retry:
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
Dim LastLoopTime As Long Dim NextTick As Long = GetTimeTick()
NetTaskSpeedLimitLeftLast = GetTimeTick()
While True While True
Dim TimeNow = GetTimeTick()
LastLoopTime = TimeNow
'增加限速余量 '增加限速余量
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast) If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 10
NetTaskSpeedLimitLeftLast = TimeNow
'刷新公开属性 '刷新公开属性
RefreshStat() RefreshStat()
'等待直至 80 ms '等待 100 ms
Do While GetTimeTick() - LastLoopTime < 80 NextTick += 100
Thread.Sleep(10) Dim SleepTime = NextTick - GetTimeTick()
Loop If SleepTime > 0 Then
Thread.Sleep(SleepTime)
Else
NextTick = GetTimeTick() '超时,直接追帧,不等待
End If
End While End While
Catch ex As Exception Catch ex As Exception
Log(ex, "下载管理刷新线程出错", LogLevel.Critical) Log(ex, "下载管理刷新线程出错", LogLevel.Critical)
End Try End Try
End Sub, "NetManager StatRefresher") End Sub, "NetManager StatRefresher")
End Sub End Sub
Private IsManagerStarted As Boolean = False
Private DownloadCacheLock As New Object Private DownloadCacheLock As New Object
Private IsDownloadCacheCleared As Boolean = False Private IsDownloadCacheCleared As Boolean = False
@@ -1907,7 +1953,7 @@ Retry:
Dim File = Task.Files(i) Dim File = Task.Files(i)
If Files.ContainsKey(File.LocalPath) Then If Files.ContainsKey(File.LocalPath) Then
'已有该文件 '已有该文件
If Files(File.LocalPath).State >= NetState.Finish Then If Files(File.LocalPath).State >= NetState.Finished Then
'该文件已经下载过一次,且下载完成 '该文件已经下载过一次,且下载完成
'将已下载的文件替换成当前文件,重新下载 '将已下载的文件替换成当前文件,重新下载
File.Tasks.Add(Task) File.Tasks.Add(Task)
@@ -1915,7 +1961,7 @@ Retry:
SyncLock LockRemain SyncLock LockRemain
FileRemain += 1 FileRemain += 1
End SyncLock End SyncLock
If ModeDebug Then Log($"[Download] {File.LocalName}:重新加入下载列表") If ModeDebug Then Log($"[Download] {File.LocalName}:重新加入下载列表,目标 {File.LocalPath}")
Else Else
'该文件正在下载中 '该文件正在下载中
'将当前文件替换成下载中的文件,即两个任务指向同一个文件 '将当前文件替换成下载中的文件,即两个任务指向同一个文件
@@ -1929,7 +1975,7 @@ Retry:
SyncLock LockRemain SyncLock LockRemain
FileRemain += 1 FileRemain += 1
End SyncLock End SyncLock
If ModeDebug Then Log($"[Download] {File.LocalName}:已加入下载列表") If ModeDebug Then Log($"[Download] {File.LocalName}:已加入下载列表,目标 {File.LocalPath}")
End If End If
Task.Files(i) = File '回设 Task.Files(i) = File '回设
Next Next
@@ -2017,7 +2063,15 @@ Retry:
''' 判断某个 Exception 是否为网络问题所导致。 ''' 判断某个 Exception 是否为网络问题所导致。
''' </summary> ''' </summary>
<Extension> Public Function IsNetworkRelated(Ex As Exception) As Boolean <Extension> Public Function IsNetworkRelated(Ex As Exception) As Boolean
Dim Detail = Ex.GetDetail() '提取 Message(不能用 GetDetail,因为堆栈的方法参数中就有 timeout 字样)
Dim Detail As String = ""
Dim InnerEx As Exception = Ex
Detail += InnerEx.Message
Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException
Detail += InnerEx.Message
Loop
'判断
If Detail.Contains("(403)") Then Return False If Detail.Contains("(403)") Then Return False
Return { Return {
"(408)", "超时", "timeout", "网络请求失败", "连接尝试失败", "远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "(408)", "超时", "timeout", "网络请求失败", "连接尝试失败", "远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称",
+18 -15
View File
@@ -4,11 +4,6 @@ Imports System.Drawing.Imaging
Public Class MyBitmap Public Class MyBitmap
''' <summary>
''' 位图缓存。
''' </summary>
Public Shared BitmapCache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
''' <summary> ''' <summary>
''' 存储的图片 ''' 存储的图片
''' </summary> ''' </summary>
@@ -30,14 +25,17 @@ Public Class MyBitmap
End Operator End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource
If Image Is Nothing Then Return Nothing If Image Is Nothing Then Return Nothing
Dim Bitmap = Image.Pic Dim BitmapPic As System.Drawing.Bitmap = Image.Pic
Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height) Dim rect = New System.Drawing.Rectangle(0, 0, BitmapPic.Width, BitmapPic.Height)
Dim bitmapData = Bitmap.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb) Dim bitmapData = BitmapPic.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
Try Try
Dim size = rect.Width * rect.Height * 4 Dim Result = BitmapSource.Create(BitmapPic.Width, BitmapPic.Height, BitmapPic.HorizontalResolution, BitmapPic.VerticalResolution,
Return BitmapSource.Create(Bitmap.Width, Bitmap.Height, Bitmap.HorizontalResolution, Bitmap.VerticalResolution, PixelFormats.Bgra32, Nothing, bitmapData.Scan0, size, bitmapData.Stride) PixelFormats.Bgra32, Nothing, bitmapData.Scan0,
rect.Width * rect.Height * 4, bitmapData.Stride)
Result.Freeze()
Return Result
Finally Finally
Bitmap.UnlockBits(bitmapData) BitmapPic.UnlockBits(bitmapData)
End Try End Try
End Operator End Operator
Public Shared Widening Operator CType(Image As System.Drawing.Bitmap) As MyBitmap Public Shared Widening Operator CType(Image As System.Drawing.Bitmap) As MyBitmap
@@ -65,11 +63,12 @@ Public Class MyBitmap
FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage) FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
If FilePathOrResourceName.StartsWithF(PathImage) Then If FilePathOrResourceName.StartsWithF(PathImage) Then
'使用缓存 '使用缓存
If BitmapCache.ContainsKey(FilePathOrResourceName) Then Static Cache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
Pic = BitmapCache(FilePathOrResourceName).Pic If Cache.ContainsKey(FilePathOrResourceName) Then
Pic = Cache(FilePathOrResourceName).Pic
Else Else
Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource)) Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource))
BitmapCache.TryAdd(FilePathOrResourceName, Pic) Cache.TryAdd(FilePathOrResourceName, Pic)
End If End If
Else Else
'使用这种自己接管 FileStream 的方法加载才能解除文件占用 '使用这种自己接管 FileStream 的方法加载才能解除文件占用
@@ -92,7 +91,11 @@ Public Class MyBitmap
Pic = My.Application.TryFindResource(FilePathOrResourceName) Pic = My.Application.TryFindResource(FilePathOrResourceName)
If Pic Is Nothing Then If Pic Is Nothing Then
Pic = New System.Drawing.Bitmap(1, 1) Pic = New System.Drawing.Bitmap(1, 1)
Throw New Exception($"加载 MyBitmap 失败({FilePathOrResourceName})", ex) If TypeOf ex Is ArgumentException Then
Throw New Exception($"图片格式不支持,或图片文件损坏({FilePathOrResourceName})", ex)
Else
Throw New Exception($"加载 MyBitmap 意外失败({FilePathOrResourceName})", ex)
End If
Else Else
Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", LogLevel.Developer) Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", LogLevel.Developer)
Exit Try Exit Try
@@ -177,13 +177,15 @@
''' </summary> ''' </summary>
Public ReadOnly Tags As List(Of String) Public ReadOnly Tags As List(Of String)
''' <summary> ''' <summary>
''' Logo 图片的下载地址。若为 Nothing 则没有。 ''' Logo 图片的下载地址。
''' 若为 Nothing 则没有,保证不为空字符串。
''' </summary> ''' </summary>
Public LogoUrl As String = Nothing Public LogoUrl As String = Nothing
''' <summary> ''' <summary>
''' 游戏大版本列表。例如:18, 16, 15…… ''' 支持的 Drop 编号,从高到低排序,不为 Nothing。
''' 例如:261(26.1.x)、180(1.18.x)。
''' </summary> ''' </summary>
Public ReadOnly GameVersions As List(Of Integer) Public ReadOnly Drops As List(Of Integer)
'数据库信息 '数据库信息
@@ -249,10 +251,10 @@
End If End If
Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList
If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl") If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl")
If Data.ContainsKey("GameVersions") Then If Data.ContainsKey("Drops") Then
GameVersions = CType(Data("GameVersions"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList Drops = CType(Data("Drops"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
Else Else
GameVersions = New List(Of Integer) Drops = New List(Of Integer)
End If End If
#End Region #End Region
Else Else
@@ -274,6 +276,7 @@
LogoUrl = Data("logo")("thumbnailUrl") LogoUrl = Data("logo")("thumbnailUrl")
End If End If
End If End If
If LogoUrl = "" Then LogoUrl = Nothing
'Type 'Type
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
Type = CompType.Mod Type = CompType.Mod
@@ -288,7 +291,7 @@
Else Else
Type = CompType.DataPack Type = CompType.DataPack
End If End If
'FileIndexes / GameVersions / ModLoaders 'FileIndexes / VanillaMajorVersions / ModLoaders
ModLoaders = New List(Of CompModLoaderType) ModLoaders = New List(Of CompModLoaderType)
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
For Each File In If(Data("latestFiles"), New JArray) For Each File In If(Data("latestFiles"), New JArray)
@@ -296,17 +299,16 @@
If Not NewFile.Available Then Continue For If Not NewFile.Available Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders) ModLoaders.AddRange(NewFile.ModLoaders)
Dim GameVersions = File("gameVersions").ToObject(Of List(Of String)) Dim GameVersions = File("gameVersions").ToObject(Of List(Of String))
If Not GameVersions.Any(Function(v) v.StartsWithF("1.")) Then Continue For If Not GameVersions.Any(Function(v) McVersion.IsFormatFit(v)) Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions)) Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions))
Next Next
For Each File In If(Data("latestFilesIndexes"), New JArray) '这俩玩意儿包含的文件不一样,见 #3599 For Each File In If(Data("latestFilesIndexes"), New JArray) '这俩玩意儿包含的文件不一样,见 #3599
If Not File("gameVersion").ToString.StartsWithF("1.") Then Continue For If Not McVersion.IsFormatFit(File("gameVersion")) Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("fileId"), {File("gameVersion").ToString}.ToList)) Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("fileId"), {File("gameVersion").ToString}.ToList))
Next Next
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")). Drops = Files.SelectMany(Function(f) f.Value).
Select(Function(v) CInt(Val(v.Split(".")(1).BeforeFirst("-")))).Where(Function(v) v > 0). Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v > 0).Distinct.OrderByDescending(Function(v) v).ToList
Distinct.OrderByDescending(Function(v) v).ToList
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Tags 'Tags
Tags = New List(Of String) Tags = New List(Of String)
@@ -333,6 +335,8 @@
Case 424 : Tags.Add("装饰") Case 424 : Tags.Add("装饰")
Case 411 : Tags.Add("生物") Case 411 : Tags.Add("生物")
Case 434 : Tags.Add("装备") Case 434 : Tags.Add("装备")
Case 6814 : Tags.Add("性能优化")
Case 9026 : Tags.Add("创造模式")
Case 423 : Tags.Add("信息显示") Case 423 : Tags.Add("信息显示")
Case 435 : Tags.Add("服务器") Case 435 : Tags.Add("服务器")
Case 5191 : Tags.Add("改良") Case 5191 : Tags.Add("改良")
@@ -399,10 +403,8 @@
Website = $"https://modrinth.com/{Data("project_type")}/{Slug}" Website = $"https://modrinth.com/{Data("project_type")}/{Slug}"
'GameVersions 'GameVersions
'搜索结果的键为 versions,获取特定工程的键为 game_versions '搜索结果的键为 versions,获取特定工程的键为 game_versions
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray). Drops = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")). Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v > 0).Distinct.OrderByDescending(Function(v) v).ToList
Select(Of Integer)(Function(v) Val(v.Split(".")(1).BeforeFirst("-"))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
'Type 'Type
Select Case Data("project_type").ToString Select Case Data("project_type").ToString
Case "modpack" : Type = CompType.ModPack Case "modpack" : Type = CompType.ModPack
@@ -523,58 +525,60 @@
Json("DownloadCount") = DownloadCount Json("DownloadCount") = DownloadCount
If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m))) If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
Json("Tags") = New JArray(Tags) Json("Tags") = New JArray(Tags)
If Not String.IsNullOrEmpty(LogoUrl) Then Json("LogoUrl") = LogoUrl If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions) If Drops.Any Then Json("Drops") = New JArray(Drops)
Json("CacheTime") = Date.Now '用于检查缓存时间 Json("CacheTime") = Date.Now '用于检查缓存时间
Return Json Return Json
End Function End Function
''' <summary> ''' <summary>
''' 将当前工程信息实例化为控件。 ''' 将当前工程信息实例化为控件。
''' </summary> ''' </summary>
Public Function ToCompItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean) As MyCompItem Public Function ToCompItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean) As MyVirtualizingElement(Of MyCompItem)
'获取版本描述 '获取版本描述
Dim GameVersionDescription As String Dim GameVersionDescription As String
If GameVersions Is Nothing OrElse Not GameVersions.Any() Then If Drops Is Nothing OrElse Not Drops.Any() Then
GameVersionDescription = "仅快照版本" '#5412 GameVersionDescription = "仅快照版本" '#5412
Else Else
Dim SpaVersions As New List(Of String) Dim Segments As New List(Of String)
Dim IsOld As Boolean = False Dim IsOld As Boolean = False
For i = 0 To GameVersions.Count - 1 '版本号一定为降序 For i = 0 To Drops.Count - 1 '版本号一定为降序
'获取当前连续的版本号段 '获取当前连续的版本号段
Dim StartVersion As Integer = GameVersions(i), EndVersion As Integer = GameVersions(i) Dim StartDrop As Integer = Drops(i), EndDrop As Integer = Drops(i)
If StartVersion < 10 Then '如果支持新版本,则不显示 1.9- If StartDrop < 100 Then '如果支持新版本,则不显示 1.9-
If SpaVersions.Any() AndAlso Not IsOld Then If Segments.Any() AndAlso Not IsOld Then
Exit For Exit For
Else Else
IsOld = True IsOld = True
End If End If
End If End If
For ii = i + 1 To GameVersions.Count - 1 For ii = i + 1 To Drops.Count - 1
If GameVersions(ii) <> EndVersion - 1 Then Exit For If AllDrops Is Nothing OrElse AllDrops.IndexOf(Drops(ii)) <> AllDrops.IndexOf(EndDrop) + 1 Then Exit For
EndVersion = GameVersions(ii) EndDrop = Drops(ii)
i = ii i = ii
Next Next
'将版本号段转为描述文本 '将版本号段转为描述文本
If StartVersion = EndVersion Then Dim StartName = McVersion.DropToVersion(StartDrop)
SpaVersions.Add("1." & StartVersion) Dim EndName = McVersion.DropToVersion(EndDrop)
ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then If StartDrop = EndDrop Then
If EndVersion < 10 Then Segments.Add(StartName)
SpaVersions.Clear() ElseIf AllDrops IsNot Nothing AndAlso StartDrop >= AllDrops.First Then
SpaVersions.Add("全版本") If EndDrop < 100 Then
Segments.Clear()
Segments.Add("全版本")
Exit For Exit For
Else Else
SpaVersions.Add("1." & EndVersion & "+") Segments.Add(EndName & "+")
End If End If
ElseIf EndVersion < 10 Then ElseIf EndDrop < 100 Then
SpaVersions.Add("1." & StartVersion & "-") Segments.Add(StartName & "-")
Exit For Exit For
ElseIf StartVersion - EndVersion = 1 Then ElseIf AllDrops Is Nothing OrElse AllDrops.IndexOf(EndDrop) - AllDrops.IndexOf(StartDrop) = 1 Then
SpaVersions.Add("1." & StartVersion & ", 1." & EndVersion) Segments.Add(StartName & ", " & EndName)
Else Else
SpaVersions.Add("1." & StartVersion & "~1." & EndVersion) Segments.Add(StartName & "~" & EndName)
End If End If
Next Next
GameVersionDescription = SpaVersions.Join(", ") GameVersionDescription = Segments.Join(", ")
End If End If
'获取 Mod 加载器描述 '获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
@@ -593,11 +597,11 @@
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
Case Else Case Else
Dim MaxVersion As Integer = If(GameVersions.Any, GameVersions.Max, 99) Dim NewestDrop As Integer = If(Drops.Any, Drops.First, 9999)
If ModLoaders.Contains(CompModLoaderType.Forge) AndAlso If ModLoaders.Contains(CompModLoaderType.Forge) AndAlso
(MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso (NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso
(MaxVersion < 20 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso (NewestDrop < 200 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso
(MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then (NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then
ModLoaderDescriptionFull = "任意" ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = "" ModLoaderDescriptionPart = ""
Else Else
@@ -606,7 +610,10 @@
End If End If
End Select End Select
'实例化 UI '实例化 UI
Dim NewItem As New MyCompItem With {.Tag = Me, .Logo = GetControlLogo()} Return New MyVirtualizingElement(Of MyCompItem)(
Function()
Dim NewItem As New MyCompItem With {.Tag = Me}
ApplyLogoToMyImage(NewItem.PathLogo)
Dim Title = GetControlTitle(True) Dim Title = GetControlTitle(True)
NewItem.Title = Title.Key NewItem.Title = Title.Key
If Title.Value = "" Then If Title.Value = "" Then
@@ -647,14 +654,16 @@
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿", If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount)) If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
Return NewItem Return NewItem
End Function) With {.Height = 64}
End Function End Function
Public Function GetControlLogo() As String Public Sub ApplyLogoToMyImage(Img As MyImage)
If String.IsNullOrEmpty(LogoUrl) Then If String.IsNullOrEmpty(LogoUrl) Then
Return PathImage & "Icons/NoIcon.png" Img.Source = PathImage & "Icons/NoIcon.png"
Else Else
Return LogoUrl Img.Source = LogoUrl
Img.FallbackSource = DlSourceModGet(LogoUrl)
End If End If
End Function End Sub
Public Function GetControlTitle(HasModLoaderDescription As Boolean) As KeyValuePair(Of String, String) Public Function GetControlTitle(HasModLoaderDescription As Boolean) As KeyValuePair(Of String, String)
'检查下列代码时可以参考 #1567 的测试例 '检查下列代码时可以参考 #1567 的测试例
Dim Title As String = RawName Dim Title As String = RawName
@@ -755,7 +764,7 @@ NoSubtitle:
'Mod 加载器一致 'Mod 加载器一致
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
'若不为光影,则要求 MC 版本一致 '若不为光影,则要求 MC 版本一致
If Type <> CompType.Shader AndAlso (GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any()) Then Return False If Type <> CompType.Shader AndAlso (Drops.Count <> Project.Drops.Count OrElse Drops.Except(Project.Drops).Any()) Then Return False
'最近更新时间差距在一周以内 '最近更新时间差距在一周以内
If LastUpdate IsNot Nothing AndAlso Project.LastUpdate IsNot Nothing AndAlso If LastUpdate IsNot Nothing AndAlso Project.LastUpdate IsNot Nothing AndAlso
Math.Abs((LastUpdate - Project.LastUpdate).Value.TotalDays) > 7 Then Return False Math.Abs((LastUpdate - Project.LastUpdate).Value.TotalDays) > 7 Then Return False
@@ -967,7 +976,7 @@ NoSubtitle:
#Region "拒绝 1.13- Quilt(这个版本根本没有 Quilt)" #Region "拒绝 1.13- Quilt(这个版本根本没有 Quilt)"
If Request.ModLoader = CompModLoaderType.Quilt AndAlso VersionSortInteger(If(Request.GameVersion, "1.15"), "1.14") = -1 Then If Request.ModLoader = CompModLoaderType.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion) Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
End If End If
@@ -1060,7 +1069,7 @@ Retry:
'在 1.14-,部分老 Mod 没有设置支持的加载器,因此添加 Forge 筛选就会出现遗漏 '在 1.14-,部分老 Mod 没有设置支持的加载器,因此添加 Forge 筛选就会出现遗漏
'所以,在发起请求时不筛选加载器,然后在返回的结果中自行筛除不是 Forge 的 Mod '所以,在发起请求时不筛选加载器,然后在返回的结果中自行筛除不是 Forge 的 Mod
Dim IsOldForgeRequest = Request.ModLoader = CompModLoaderType.Forge AndAlso Request.GameVersion?.Contains(".") AndAlso Val(Request.GameVersion.Split(".")(1)) < 14 Dim IsOldForgeRequest = Request.ModLoader = CompModLoaderType.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion, True) < 140
If IsOldForgeRequest Then Request.ModLoader = CompModLoaderType.Any If IsOldForgeRequest Then Request.ModLoader = CompModLoaderType.Any
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress() Dim CurseForgeUrl As String = Request.GetCurseForgeAddress()
Dim ModrinthUrl As String = Request.GetModrinthAddress() Dim ModrinthUrl As String = Request.GetModrinthAddress()
@@ -1176,9 +1185,9 @@ Retry:
#Region "提取非重复项,存储于 RealResults" #Region "提取非重复项,存储于 RealResults"
'将 Modrinth 排在 CurseForge 的前面,避免加载结束顺序不同导致排名不同 '将 CurseForge 排在 Modrinth 的前面,避免加载结束顺序不同导致排名不同
'这样做的话,去重后将优先保留 CurseForge 内容 '这样做的话,去重后将优先保留 Modrinth 的内容
RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList RawResults = RawResults.Where(Function(x) x.FromCurseForge).Concat(RawResults.Where(Function(x) Not x.FromCurseForge)).ToList
'RawResults 去重 'RawResults 去重
RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b)) RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b))
'已有内容去重 '已有内容去重
@@ -1292,11 +1301,16 @@ Retry:
''' </summary> ''' </summary>
Public ReadOnly DownloadCount As Integer Public ReadOnly DownloadCount As Integer
''' <summary> ''' <summary>
''' Mod 版本号。
''' 不一定是标准格式。CurseForge 上默认为 Nothing。
''' </summary>
Public Version As String
''' <summary>
''' 支持的 Mod 加载器列表。可能为空。 ''' 支持的 Mod 加载器列表。可能为空。
''' </summary> ''' </summary>
Public ReadOnly ModLoaders As List(Of CompModLoaderType) Public ReadOnly ModLoaders As List(Of CompModLoaderType)
''' <summary> ''' <summary>
''' 支持的游戏版本列表。类型包括:"1.18.5","1.18","1.18 预览版","21w15a","未知版本"。 ''' 支持的游戏版本列表。类型包括:"26.1.5","26.1","26.1 预览版","1.18.5","1.18","1.18 预览版","21w15a","未知版本"。
''' </summary> ''' </summary>
Public ReadOnly GameVersions As List(Of String) Public ReadOnly GameVersions As List(Of String)
''' <summary> ''' <summary>
@@ -1369,6 +1383,7 @@ Retry:
FromCurseForge = Data("FromCurseForge").ToObject(Of Boolean) FromCurseForge = Data("FromCurseForge").ToObject(Of Boolean)
Id = Data("Id").ToString Id = Data("Id").ToString
DisplayName = Data("DisplayName").ToString DisplayName = Data("DisplayName").ToString
If Data.ContainsKey("Version") Then Version = Data("Version").ToString
ReleaseDate = Data("ReleaseDate").ToObject(Of Date) ReleaseDate = Data("ReleaseDate").ToObject(Of Date)
DownloadCount = Data("DownloadCount").ToObject(Of Integer) DownloadCount = Data("DownloadCount").ToObject(Of Integer)
Status = CType(Data("Status").ToObject(Of Integer), CompFileStatus) Status = CType(Data("Status").ToObject(Of Integer), CompFileStatus)
@@ -1387,6 +1402,7 @@ Retry:
'简单信息 '简单信息
Id = Data("id") Id = Data("id")
DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ") DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
Version = Nothing
ReleaseDate = Data("fileDate") ReleaseDate = Data("fileDate")
Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus) Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
DownloadCount = Data("downloadCount") DownloadCount = Data("downloadCount")
@@ -1408,9 +1424,9 @@ Retry:
End If End If
'GameVersions 'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList GameVersions = RawVersions.Where(Function(v) McVersion.IsFormatFit(v)).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList
If GameVersions.Count > 1 Then If GameVersions.Count > 1 Then
GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本 If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList GameVersions = GameVersions.ToList
@@ -1429,6 +1445,7 @@ Retry:
'简单信息 '简单信息
Id = Data("id") Id = Data("id")
DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ") DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ")
Version = Data("version_number")
ReleaseDate = Data("date_published") ReleaseDate = Data("date_published")
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha)) Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads") DownloadCount = Data("downloads")
@@ -1467,15 +1484,15 @@ Retry:
End If End If
'GameVersions 'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")). GameVersions = RawVersions.Where(Function(v) v.Contains(".")).
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then If GameVersions.Count > 1 Then
GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本 If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then ElseIf GameVersions.Count = 1 Then
'无需处理 '无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")).ToList
Else Else
GameVersions = New List(Of String) From {"未知版本"} GameVersions = New List(Of String) From {"未知版本"}
End If End If
@@ -1504,6 +1521,7 @@ Retry:
Dim Json As New JObject Dim Json As New JObject
Json.Add("FromCurseForge", FromCurseForge) Json.Add("FromCurseForge", FromCurseForge)
Json.Add("Id", Id) Json.Add("Id", Id)
If Version IsNot Nothing Then Json.Add("Version", Version)
Json.Add("DisplayName", DisplayName) Json.Add("DisplayName", DisplayName)
Json.Add("ReleaseDate", ReleaseDate) Json.Add("ReleaseDate", ReleaseDate)
Json.Add("DownloadCount", DownloadCount) Json.Add("DownloadCount", DownloadCount)
@@ -1521,14 +1539,18 @@ Retry:
''' 将当前文件信息实例化为控件。 ''' 将当前文件信息实例化为控件。
''' </summary> ''' </summary>
Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing, Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing,
Optional BadDisplayName As Boolean = False) As MyListItem Optional BadDisplayName As Boolean = False) As MyVirtualizingElement(Of MyListItem)
Return New MyVirtualizingElement(Of MyListItem)(
Function()
'获取描述信息 '获取描述信息
Dim Title As String = If(BadDisplayName, FileName, DisplayName) Dim Title As String = If(BadDisplayName, FileName, DisplayName)
Dim Info As New List(Of String) Dim Info As New List(Of String)
If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast(".")) If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast("."))
If Dependencies.Any Then Info.Add(Dependencies.Count & " 项前置") If Dependencies.Any Then Info.Add(Dependencies.Count & " 项前置")
If GameVersions.All(Function(v) Not IsVersionNameLikeRelease(v)) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}") If GameVersions.All(
Function(VerName)
Return Not VerName.Contains(".") OrElse {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) VerName.ContainsF(s, True))
End Function) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0 If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次")) Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
End If End If
@@ -1560,17 +1582,13 @@ Retry:
AddHandler BtnSave.Click, OnSaveClick AddHandler BtnSave.Click, OnSaveClick
NewItem.Buttons = {BtnSave} NewItem.Buttons = {BtnSave}
End If End If
'结束
Return NewItem Return NewItem
End Function) With {.Height = 42}
End Function End Function
'辅助函数
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Return $"{Id}: {FileName}" Return $"{Id}: {FileName}"
End Function End Function
End Class End Class
'获取 '获取
@@ -2,9 +2,9 @@
'构造函数 '构造函数
Private TempFolder As String Private TempFolder As String
Private TargetVersion As McVersion Private TargetInstance As McInstance
Public Sub New(Optional TargetVersion As McVersion = Nothing) Public Sub New(Optional TargetInstance As McInstance = Nothing)
Me.TargetVersion = TargetVersion Me.TargetInstance = TargetInstance
'构建文件结构 '构建文件结构
TempFolder = RequestTaskTempFolder() TempFolder = RequestTaskTempFolder()
Directory.CreateDirectory(TempFolder & "Temp\") Directory.CreateDirectory(TempFolder & "Temp\")
@@ -391,7 +391,7 @@ Extracted:
''' <summary> ''' <summary>
''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。 ''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。
''' </summary> ''' </summary>
Public Sub Analyze(Optional Version As McVersion = Nothing) Public Sub Analyze()
Log("[Crash] 步骤 3:分析崩溃原因") Log("[Crash] 步骤 3:分析崩溃原因")
LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "") LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "")
@@ -538,7 +538,7 @@ Done:
'确定的 Mod 导致崩溃 '确定的 Mod 导致崩溃
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray))) If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'Mod 重复 / 前置问题 'Mod 重复 / 前置问题
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList) If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
@@ -607,7 +607,7 @@ Done:
Return True Return True
End If End If
'JSON 名称匹配 'JSON 名称匹配
For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(]{1})[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline) For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(])[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
AppendReason(CrashReason.ModMixin失败, AppendReason(CrashReason.ModMixin失败,
TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", ""))) TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
Return True Return True
@@ -926,7 +926,7 @@ NextStack:
'上报 '上报
If IsManualAnalyze Then Return If IsManualAnalyze Then Return
Telemetry("Minecraft 崩溃", Telemetry("Minecraft 崩溃",
"Version", If(TargetVersion Is Nothing, "null", TargetVersion.Version.ToString), "Version", If(TargetInstance Is Nothing, "null", TargetInstance.VersionDisplayName),
"Detail", FilterUserName(Detail, "*")) "Detail", FilterUserName(Detail, "*"))
End Sub End Sub
''' <summary> ''' <summary>
@@ -6,40 +6,40 @@
''' 返回某 Minecraft 版本对应的原版主 Jar 文件的下载信息,要求对应依赖版本已存在。 ''' 返回某 Minecraft 版本对应的原版主 Jar 文件的下载信息,要求对应依赖版本已存在。
''' 失败则抛出异常,不需要下载则返回 Nothing。 ''' 失败则抛出异常,不需要下载则返回 Nothing。
''' </summary> ''' </summary>
Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile Public Function DlClientJarGet(Instance As McInstance, ReturnNothingOnFileUseable As Boolean) As NetFile
'获取底层继承版本 '获取底层继承版本
Try Try
Do While Not String.IsNullOrEmpty(Version.InheritVersion) Do While Not String.IsNullOrEmpty(Instance.InheritName)
Version = New McVersion(Version.InheritVersion) Instance = New McInstance(Instance.InheritName)
Loop Loop
Catch ex As Exception Catch ex As Exception
Log(ex, "获取底层继承版本失败") Log(ex, "获取底层继承版本失败")
End Try End Try
'检查 Json 是否标准 '检查 Json 是否标准
If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("client") Is Nothing OrElse Instance.JsonObject("downloads")("client")("url") Is Nothing Then
Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息") Throw New Exception("底层版本 " & Instance.Name & " 中无 jar 文件下载信息")
End If End If
'检查文件 '检查文件
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1")) Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Instance.JsonObject("downloads")("client")("size"), -1), Hash:=Instance.JsonObject("downloads")("client")("sha1"))
If ReturnNothingOnFileUseable AndAlso Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验 If ReturnNothingOnFileUseable AndAlso Checker.Check(Instance.PathVersion & Instance.Name & ".jar") Is Nothing Then Return Nothing '通过校验
'返回下载信息 '返回下载信息
Dim JarUrl As String = Version.JsonObject("downloads")("client")("url") Dim JarUrl As String = Instance.JsonObject("downloads")("client")("url")
Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker) Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Instance.PathVersion & Instance.Name & ".jar", Checker)
End Function End Function
''' <summary> ''' <summary>
''' 返回某 Minecraft 版本对应的原版主 AssetIndex 文件的下载信息,要求对应依赖版本已存在。 ''' 返回某 Minecraft 版本对应的原版主 AssetIndex 文件的下载信息,要求对应依赖版本已存在。
''' 若未找到,则会返回 Legacy 资源文件或 Nothing。 ''' 若未找到,则会返回 Legacy 资源文件或 Nothing。
''' </summary> ''' </summary>
Public Function DlClientAssetIndexGet(Version As McVersion) As NetFile Public Function DlClientAssetIndexGet(Instance As McInstance) As NetFile
'获取底层继承版本 '获取底层继承版本
Do While Not String.IsNullOrEmpty(Version.InheritVersion) Do While Not String.IsNullOrEmpty(Instance.InheritName)
Version = New McVersion(Version.InheritVersion) Instance = New McInstance(Instance.InheritName)
Loop Loop
'获取信息 '获取信息
Dim IndexInfo = McAssetsGetIndex(Version, True, True) Dim IndexInfo = McAssetsGetIndex(Instance, True, True)
Dim IndexAddress As String = PathMcFolder & "assets\indexes\" & IndexInfo("id").ToString & ".json" Dim IndexAddress As String = McFolderSelected & "assets\indexes\" & IndexInfo("id").ToString & ".json"
Log("[Download] 版本 " & Version.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString) Log("[Download] 版本 " & Instance.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString)
Dim IndexUrl As String = If(IndexInfo("url"), "") Dim IndexUrl As String = If(IndexInfo("url"), "")
If IndexUrl = "" Then If IndexUrl = "" Then
Return Nothing Return Nothing
@@ -51,12 +51,12 @@
''' <summary> ''' <summary>
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。 ''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
''' </summary> ''' </summary>
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase) Public Function DlClientFix(Instance As McInstance, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
#Region "下载支持库文件" #Region "下载支持库文件"
Dim LoadersLib As New List(Of LoaderBase) From { Dim LoadersLib As New List(Of LoaderBase) From {
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1}, New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibNetFilesFromInstance(Instance)) With {.ProgressWeight = 1},
New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15} New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
} }
'构造加载器 '构造加载器
@@ -64,7 +64,7 @@
#End Region #End Region
#Region "下载资源文件" #Region "下载资源文件"
If ShouldIgnoreFileCheck(Version) Then If ShouldIgnoreFileCheck(Instance) Then
Log("[Download] 已跳过所有 Assets 检查") Log("[Download] 已跳过所有 Assets 检查")
Else Else
Dim LoadersAssets As New List(Of LoaderBase) Dim LoadersAssets As New List(Of LoaderBase)
@@ -72,10 +72,10 @@
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址", LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try Try
Dim IndexFile = DlClientAssetIndexGet(Version) Dim IndexFile = DlClientAssetIndexGet(Instance)
If IndexFile Is Nothing Then If IndexFile Is Nothing Then
Task.Output = New List(Of NetFile) Task.Output = New List(Of NetFile)
Log("[Download] 未找到版本 " & Version.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug) Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug)
ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile) Task.Output = New List(Of NetFile)
Else Else
@@ -94,9 +94,9 @@
Dim RealAddress As String = Nothing Dim RealAddress As String = Nothing
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址", LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version) Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
If BackAssetsFile Is Nothing Then If BackAssetsFile Is Nothing Then
Log("[Download] 未找到版本 " & Version.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug) Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug)
Task.Abort() Task.Abort()
Throw New ThreadInterruptedException Throw New ThreadInterruptedException
End If End If
@@ -121,14 +121,12 @@
Updater.Start() Updater.Start()
End If End If
'获取资源文件地址 '获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件", LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("获取资源文件列表",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task) Task.Output = McAssetsFixList(Instance, CheckAssetsHash, Task)) With {.ProgressWeight = 0.01})
Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
'下载资源文件 '下载资源文件
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25}) LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
'构造加载器 '构造加载器
Loaders.Add(New LoaderCombo(Of String)("下载资源文件(主加载器)", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 30.5}) Loaders.Add(New LoaderCombo(Of String)("下载资源文件(主加载器)", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 27})
End If End If
#End Region #End Region
@@ -153,6 +151,25 @@
#Region "DlClientList | Minecraft 客户端 版本列表" #Region "DlClientList | Minecraft 客户端 版本列表"
''' <summary>
''' 所有正式版的 Minecraft Drop 序数。
''' 若从未完成过获取,返回 Nothing;否则必定存在元素,且从高到低排列。
''' </summary>
Public Property AllDrops As List(Of Integer)
Get
If _AllDrops Is Nothing Then
_AllDrops = Setup.Get("CacheDrops").ToString.
Split(",".ToCharArray, StringSplitOptions.RemoveEmptyEntries).Select(Function(d) CInt(Val(d))).ToList()
End If
Return If(_AllDrops.Any, _AllDrops, Nothing) '不要将 _AllDrops 再设为 Nothing,以防止反复获取设置尝试初始化
End Get
Set(value As List(Of Integer))
_AllDrops = value
Setup.Set("CacheDrops", value.Join(","))
End Set
End Property
Private _AllDrops As List(Of Integer) = Nothing
'主加载器 '主加载器
Public Structure DlClientListResult Public Structure DlClientListResult
''' <summary> ''' <summary>
@@ -167,10 +184,6 @@
''' 获取到的 Json 数据。 ''' 获取到的 Json 数据。
''' </summary> ''' </summary>
Public Value As JObject Public Value As JObject
'''' <summary>
'''' 官方源的失败原因。若没有则为 Nothing。
'''' </summary>
'Public OfficialError As Exception
End Structure End Structure
''' <summary> ''' <summary>
''' Minecraft 客户端 版本列表,主加载器。 ''' Minecraft 客户端 版本列表,主加载器。
@@ -195,6 +208,12 @@
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60) New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
End Select End Select
'提取所有 Drop 序数
Dim Drops As New List(Of Integer)
For Each Version As JObject In Loader.Output.Value("versions")
Drops.Add(McVersion.VersionToDrop(Version("id")))
Next
AllDrops = Drops.Distinct.OrderByDescending(Function(d) d).ToList()
End Sub End Sub
'各个下载源的分加载器 '各个下载源的分加载器
@@ -202,7 +221,6 @@
''' Minecraft 客户端 版本列表,Mojang 官方源加载器。 ''' Minecraft 客户端 版本列表,Mojang 官方源加载器。
''' </summary> ''' </summary>
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain) Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private IsNewClientVersionHinted As Boolean = False
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult)) Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim StartTime As Long = GetTimeTick() Dim StartTime As Long = GetTimeTick()
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True)) Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
@@ -219,20 +237,25 @@
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json"))) If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
'返回 '返回
Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json} Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
'解析更新提示(Release) 'MC 更新提示
Dim Version As String = Json("latest")("release") Static IsHinted As Boolean = False
If Setup.Get("ToolUpdateRelease") AndAlso Not Setup.Get("ToolUpdateReleaseLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateReleaseLast") = Version Then Dim Version As String
McDownloadClientUpdateHint(Version, Json) '快照版
IsNewClientVersionHinted = True
End If
McVersionHighest = Version.Split(".")(1)
Setup.Set("ToolUpdateReleaseLast", Version)
'解析更新提示(Snapshot)
Version = Json("latest")("snapshot") Version = Json("latest")("snapshot")
If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = Version AndAlso Not IsNewClientVersionHinted Then If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso
Setup.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json) McDownloadClientUpdateHint(Version, Json)
End If End If
Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing")) Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
'正式版
Version = Json("latest")("release")
If Setup.Get("ToolUpdateRelease") AndAlso Not Setup.Get("ToolUpdateReleaseLast") = "" AndAlso
Setup.Get("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json)
End If
Setup.Set("ToolUpdateReleaseLast", Version)
Catch ex As Exception Catch ex As Exception
Throw New Exception("Minecraft 官方源版本列表解析失败", ex) Throw New Exception("Minecraft 官方源版本列表解析失败", ex)
End Try End Try
@@ -319,15 +342,15 @@
''' <summary> ''' <summary>
''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。 ''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。
''' </summary> ''' </summary>
Public NameDisplay As String Public DisplayName As String
''' <summary> ''' <summary>
''' 原始文件名称,如“preview_OptiFine_1.11_HD_U_E1_pre.jar”。 ''' 原始文件名称,如“preview_OptiFine_1.11_HD_U_E1_pre.jar”。
''' </summary> ''' </summary>
Public NameFile As String Public FileName As String
''' <summary> ''' <summary>
''' 对应的版本名称,如“1.13.2-OptiFine_HD_U_E6”。 ''' 对应的版本名称,如“1.13.2-OptiFine_HD_U_E6”。
''' </summary> ''' </summary>
Public NameVersion As String Public InstanceName As String
''' <summary> ''' <summary>
''' 是否为测试版。 ''' 是否为测试版。
''' </summary> ''' </summary>
@@ -399,14 +422,14 @@
For i = 0 To ReleaseTime.Count - 1 For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ") Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With { Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "), .DisplayName = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"), .ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ContainsF("pre", True), .IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0), .Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar", .FileName = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")} .RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "") Entry.InstanceName = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry) Versions.Add(Entry)
Next Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions} Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
@@ -425,15 +448,15 @@
Dim Versions As New List(Of DlOptiFineListEntry) Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json For Each Token As JObject In Json
Dim Entry As New DlOptiFineListEntry With { Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "), .DisplayName = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "", .ReleaseTime = "",
.IsPreview = Token("patch").ToString.ContainsF("pre", True), .IsPreview = Token("patch").ToString.ContainsF("pre", True),
.Inherit = Token("mcversion").ToString, .Inherit = Token("mcversion").ToString,
.NameFile = Token("filename").ToString, .FileName = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "") .RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
} }
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "") Entry.InstanceName = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry) Versions.Add(Entry)
Next Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions} Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
@@ -493,7 +516,7 @@
Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", SimulateBrowserHeaders:=True) Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", SimulateBrowserHeaders:=True)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")") 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)") Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+((_pre|[_-]snapshot[_-]?)[0-9]?)?(?=.html)")
Names.Add("1.2.4") '1.2.4 不会被匹配上 Names.Add("1.2.4") '1.2.4 不会被匹配上
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")") If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names} Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names}
@@ -504,11 +527,10 @@
''' </summary> ''' </summary>
Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain) Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult)) Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding:=Encoding.Default) Dim Result As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")") Encoding:=Encoding.Default, RequireJson:=True))
'获取所有版本信息 Dim Names As List(Of String) = Result.Select(Function(v) v.ToString).ToList
Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?") If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足")
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names} Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names}
End Sub End Sub
@@ -517,60 +539,47 @@
#Region "DlForgeVersion | Forge 版本列表" #Region "DlForgeVersion | Forge 版本列表"
Public MustInherit Class DlForgelikeEntry Public MustInherit Class DlForgelikeEntry
Implements IComparable(Of DlForgelikeEntry)
Public IsNeoForge As Boolean Public IsNeoForge As Boolean
''' <summary> ''' <summary>
''' 加载器名称。Forge 或 NeoForge。 ''' 加载器名称。Forge 或 NeoForge。
''' </summary> ''' </summary>
Public ReadOnly Property LoaderName As String Public MustOverride ReadOnly Property LoaderName As String
Get
Return If(IsNeoForge, "NeoForge", "Forge")
End Get
End Property
''' <summary> ''' <summary>
''' 文件扩展名。不以小数点开头。 ''' 文件扩展名。不以小数点开头。
''' </summary> ''' </summary>
Public ReadOnly Property FileExtension As String Public MustOverride ReadOnly Property FileExtension As String
Get
If IsNeoForge Then
Return "jar"
Else
Return If(CType(Me, DlForgeVersionEntry).Category = "installer", "jar", "zip")
End If
End Get
End Property
''' <summary> ''' <summary>
''' Forge:MC 版本是否小于 1.13。 ''' 标准化后的版本号,仅可用于比较与排序,且 NeoForge 项不包含 alpha/beta 编号!
''' NeoForge:MC 版本是否为 1.20.1。
''' </summary>
Public ReadOnly Property IsLegacy As Boolean
Get
'虽然很抽象,但确实可以这样判断
'Forge:1.13+ 的版本号首位都大于 20
'NeoForge:1.20.1 的版本号首位人为规定为 19 开头
Return Version.Major < 20
End Get
End Property
''' <summary>
''' 标准化后的版本号,仅可用于比较与排序。
''' 格式:Major.Minor.Build.Revision ''' 格式:Major.Minor.Build.Revision
''' Forge:如 “50.1.9.0”(最后一位固定为 0)、“14.22.1.2478”(Legacy)。 ''' Forge:如 “50.1.9.0”(最后一位固定为 0)、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30.0”(最后一位固定为 0)、“19.47.1.99”(Legacy:第一位固定为 19)。 ''' NeoForge:如 “20.4.30.0”(最后一位固定为 0)、“19.47.1.99”(Legacy:第一位固定为 19)。
''' </summary> ''' </summary>
Public Version As Version Public Version As Version
''' <summary> ''' <summary>
''' 可对玩家显示的非格式化版本名。 ''' 可读的非格式化版本名。
''' Forge:如 “50.1.9”、“14.22.1.2478”(Legacy)。 ''' Forge:如 “50.1.9”、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30-beta”、“47.1.99”(Legacy)。 ''' NeoForge:如 “20.4.30-beta”、“47.1.99”(Legacy)。
''' </summary> ''' </summary>
Public VersionName As String Public VersionName As String
''' <summary> ''' <summary>
''' 对应的 Minecraft 版本,如“1.12.2”。 ''' 对应的 Minecraft 版本,如 1.12.2、26.1-snapshot-1。
''' </summary> ''' </summary>
Public Inherit As String Public Inherit As String
Public Function CompareTo(other As DlForgelikeEntry) As Integer Implements IComparable(Of DlForgelikeEntry).CompareTo
If Version <> other.Version Then
Return Version.CompareTo(other.Version)
Else
Return CompareVersion(VersionName, other.VersionName)
End If
End Function
End Class End Class
Public Class DlForgeVersionEntry Public Class DlForgeVersionEntry
Inherits DlForgelikeEntry Inherits DlForgelikeEntry
''' <summary> ''' <summary>
''' 发布时间,格式为“yyyy/MM/dd HH:mm”。 ''' 发布时间,格式为“yyyy/MM/dd HH:mm”。
''' </summary> ''' </summary>
@@ -592,6 +601,23 @@
''' </summary> ''' </summary>
Public FileVersion As String Public FileVersion As String
''' <summary>
''' 加载器名称。Forge 或 NeoForge。
''' </summary>
Public Overrides ReadOnly Property LoaderName As String
Get
Return "Forge"
End Get
End Property
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public Overrides ReadOnly Property FileExtension As String
Get
Return If(Category = "installer", "jar", "zip")
End Get
End Property
Public Sub New(Version As String, Branch As String, Inherit As String) Public Sub New(Version As String, Branch As String, Inherit As String)
'司马版本的特殊处理 '司马版本的特殊处理
If Version = "11.15.1.2318" OrElse Version = "11.15.1.1902" OrElse Version = "11.15.1.1890" Then Branch = "1.8.9" If Version = "11.15.1.2318" OrElse Version = "11.15.1.1902" OrElse Version = "11.15.1.1890" Then Branch = "1.8.9"
@@ -603,6 +629,7 @@
Me.Inherit = Inherit Me.Inherit = Inherit
FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch) FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
End Sub End Sub
End Class End Class
''' <summary> ''' <summary>
@@ -641,7 +668,7 @@
".html", SimulateBrowserHeaders:=True) ".html", SimulateBrowserHeaders:=True)
Catch ex As Exception Catch ex As Exception
If ex.GetBrief().Contains("(404)") Then If ex.GetBrief().Contains("(404)") Then
Throw New Exception("不可用") Throw New Exception("无")
Else Else
Throw Throw
End If End If
@@ -699,7 +726,7 @@
Catch ex As Exception Catch ex As Exception
Throw New Exception("Forge 官方源版本列表解析失败(" & Result & ")", ex) Throw New Exception("Forge 官方源版本列表解析失败(" & Result & ")", ex)
End Try End Try
If Not Versions.Any() Then Throw New Exception("不可用") If Not Versions.Any() Then Throw New Exception("无")
Loader.Output = Versions Loader.Output = Versions
End Sub End Sub
@@ -753,7 +780,7 @@
Catch ex As Exception Catch ex As Exception
Throw New Exception("Forge BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex) Throw New Exception("Forge BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try End Try
If Not Versions.Any() Then Throw New Exception("不可用") If Not Versions.Any() Then Throw New Exception("无")
Loader.Output = Versions Loader.Output = Versions
End Sub End Sub
@@ -778,6 +805,7 @@
Public Class DlNeoForgeListEntry Public Class DlNeoForgeListEntry
Inherits DlForgelikeEntry Inherits DlForgelikeEntry
''' <summary> ''' <summary>
''' 是否是 Beta 版。 ''' 是否是 Beta 版。
''' </summary> ''' </summary>
@@ -791,11 +819,28 @@
''' </summary> ''' </summary>
Public ReadOnly Property UrlBase As String Public ReadOnly Property UrlBase As String
Get Get
Dim PackageName As String = If(IsLegacy, "forge", "neoforge") Dim PackageName As String = If(Inherit = "1.20.1", "forge", "neoforge")
Return $"https://maven.neoforged.net/releases/net/neoforged/{PackageName}/{ApiName}/{PackageName}-{ApiName}" Return $"https://maven.neoforged.net/releases/net/neoforged/{PackageName}/{ApiName}/{PackageName}-{ApiName}"
End Get End Get
End Property End Property
''' <summary>
''' 加载器名称。Forge 或 NeoForge。
''' </summary>
Public Overrides ReadOnly Property LoaderName As String
Get
Return "NeoForge"
End Get
End Property
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public Overrides ReadOnly Property FileExtension As String
Get
Return "jar"
End Get
End Property
Public Sub New(ApiName As String) Public Sub New(ApiName As String)
IsNeoForge = True IsNeoForge = True
Me.ApiName = ApiName Me.ApiName = ApiName
@@ -804,10 +849,20 @@
VersionName = ApiName.Replace("1.20.1-", "") VersionName = ApiName.Replace("1.20.1-", "")
Version = New Version("19." & VersionName) Version = New Version("19." & VersionName)
Inherit = "1.20.1" Inherit = "1.20.1"
Else '20.4.30-beta ElseIf ApiName.StartsWith("0.") Then '0.25w14craftmine.3-beta
VersionName = ApiName
Dim Segments = ApiName.BeforeFirst("-").Split("."c)
Version = New Version(0, 0, Segments.Last)
Inherit = Segments(1)
Else '20.4.30-beta;26.1.0.0-alpha.1+snapshot-1
VersionName = ApiName VersionName = ApiName
Version = New Version(ApiName.BeforeFirst("-")) Version = New Version(ApiName.BeforeFirst("-"))
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor) If Version.Major >= 24 Then
Inherit = Version.ToString.Replace(".0", "")
Else
Inherit = "1." & Version.Major & If(Version.Minor > 0, "." & Version.Minor, "")
End If
If VersionName.Contains("+") Then Inherit &= "-" & VersionName.AfterFirst("+")
End If End If
End Sub End Sub
End Class End Class
@@ -874,12 +929,12 @@
Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry) Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry)
Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson, Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson,
"(?<="")(1\.20\.1-)?\d+\.\d+\.\d+(-beta)?(?="")") '我寻思直接正则就行.jpg "(?<="")(1\.20\.1-)?\d+\.[^\.]+\.\d+(\.\d+)?(-(beta|alpha)(\.\d+)?)?(\+snapshot-\d+)?(?="")")
Dim Versions = VersionNames. Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中,但不能下载 Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中,但不能下载
Select(Function(name) New DlNeoForgeListEntry(name)).ToList Select(Function(name) New DlNeoForgeListEntry(name)).
If Not Versions.Any() Then Throw New Exception("不可用") OrderByDescending(Function(a) a).ToList
Versions = Versions.OrderByDescending(Function(a) a.Version).ToList If Not Versions.Any() Then Throw New Exception("无")
Return Versions Return Versions
End Function End Function
@@ -1294,7 +1349,7 @@
For ii = 0 To LoaderList.Count - 1 For ii = 0 To LoaderList.Count - 1
LoaderList(ii).Key.Input = Nothing '重置输入,以免以同样的输入“重试加载”时直接失败 LoaderList(ii).Key.Input = Nothing '重置输入,以免以同样的输入“重试加载”时直接失败
If LoaderList(ii).Key.Error IsNot Nothing Then If LoaderList(ii).Key.Error IsNot Nothing Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("不可用") Then If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message = "无" Then
ErrorInfo = LoaderList(ii).Key.Error ErrorInfo = LoaderList(ii).Key.Error
End If End If
End If End If
@@ -35,7 +35,7 @@
''' <summary> ''' <summary>
''' Java 的大版本号。 ''' Java 的大版本号。
''' </summary> ''' </summary>
Public ReadOnly Property VersionCode As Integer Public ReadOnly Property MajorVersion As Integer
Get Get
Return Version.Minor Return Version.Minor
End Get End Get
@@ -71,7 +71,7 @@
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Dim VersionString = Version.ToString Dim VersionString = Version.ToString
If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3) If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3)
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")" & If(Is64Bit, "", ",32 位") & If(IsUserImport, ",手动导入", "") & ":" & PathFolder Return If(IsJre, "JRE ", "JDK ") & MajorVersion & " (" & VersionString & ")" & If(Is64Bit, "", ",32 位") & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
End Function End Function
'构造 '构造
@@ -124,7 +124,7 @@
'#3649:在 64 位系统上禁用 32 位 Java '#3649:在 64 位系统上禁用 32 位 Java
If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本,请安装 64 位的 Java") If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本,请安装 64 位的 Java")
'#2249:JRE 17 似乎会导致 Forge 安装失败,干脆禁用更多版本的 JRE '#2249:JRE 17 似乎会导致 Forge 安装失败,干脆禁用更多版本的 JRE
If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差,因此不再允许使用。你可以使用对应版本的 JDK,而非 JRE!") If IsJre AndAlso MajorVersion >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差,因此不再允许使用。你可以使用对应版本的 JDK,而非 JRE!")
Catch ex As ApplicationException Catch ex As ApplicationException
Throw ex Throw ex
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
@@ -199,19 +199,19 @@
''' 必须在工作线程调用,且必须包括 SyncLock JavaLock。 ''' 必须在工作线程调用,且必须包括 SyncLock JavaLock。
''' </summary> ''' </summary>
Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing, Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing,
Optional RelatedVersion As McVersion = Nothing) As JavaEntry Optional GameInstance As McInstance = Nothing) As JavaEntry
Try Try
Dim AllowedJavaList As New List(Of JavaEntry) Dim AllowedJavaList As New List(Of JavaEntry)
'添加特定的 Java '添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean) Dim JavaPreList As New Dictionary(Of String, Boolean)
If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then If McFolderSelected.Split("\").Count > 3 AndAlso Not McFolderSelected.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录或 %APPDATA% 的话) JavaSearchFolder(GetPathFromFullPath(McFolderSelected), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录或 %APPDATA% 的话)
End If End If
JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹 JavaSearchFolder(McFolderSelected, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")). JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java(#4286) ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java(#4286)
If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹 If GameInstance IsNot Nothing Then JavaSearchFolder(GameInstance.PathVersion, JavaPreList, False, True) '所选版本文件夹
Dim TargetJavaList As New List(Of JavaEntry) Dim TargetJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList For Each Entry In JavaPreList
TargetJavaList.Add(New JavaEntry(Entry.Key, Entry.Value)) TargetJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
@@ -232,8 +232,8 @@
'获取版本独立设置中指定的 Java '获取版本独立设置中指定的 Java
Dim VersionSelect As String = "" Dim VersionSelect As String = ""
If RelatedVersion IsNot Nothing Then If GameInstance IsNot Nothing Then
VersionSelect = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion) VersionSelect = Setup.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If VersionSelect.StartsWithF("{") Then If VersionSelect.StartsWithF("{") Then
Try Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect)) UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
@@ -242,7 +242,7 @@
Throw Throw
Catch ex As Exception Catch ex As Exception
UserJava = Nothing UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion) Setup.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint) Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try End Try
End If End If
@@ -330,8 +330,8 @@ RetryGet:
Dim Right As String = MaxVersion.Minor & If(ShowRevision, "." & MaxVersion.MajorRevision & "." & MaxVersion.MinorRevision, "") Dim Right As String = MaxVersion.Minor & If(ShowRevision, "." & MaxVersion.MajorRevision & "." & MaxVersion.MinorRevision, "")
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right) Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If End If
Dim JavaCurrent As String = UserJava.VersionCode & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "") Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion) Then If GameInstance IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", GameInstance) Then
'直接跳过弹窗 '直接跳过弹窗
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug) Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug)
AllowedJavaList = New List(Of JavaEntry) From {UserJava} AllowedJavaList = New List(Of JavaEntry) From {UserJava}
@@ -372,7 +372,7 @@ ExitUserJavaCheck:
UserPass: UserPass:
'对适合的 Java 进行排序 '对适合的 Java 进行排序
AllowedJavaList = AllowedJavaList.Sort(AddressOf JavaSorter) AllowedJavaList = AllowedJavaList.SortByComparison(AddressOf JavaSorter)
Log($"[Java] 排序后的 Java 优先顺序:") Log($"[Java] 排序后的 Java 优先顺序:")
For Each Java In AllowedJavaList For Each Java In AllowedJavaList
Log($"[Java] - {Java}") Log($"[Java] - {Java}")
@@ -408,12 +408,12 @@ UserPass:
''' <summary> ''' <summary>
''' 是否强制指定了 64 位 Java。如果没有强制指定,返回是否安装了 64 位 Java。 ''' 是否强制指定了 64 位 Java。如果没有强制指定,返回是否安装了 64 位 Java。
''' </summary> ''' </summary>
Public Function JavaIs64Bit(Optional RelatedVersion As McVersion = Nothing) As Boolean Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean
Try Try
'检查强制指定 '检查强制指定
Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect") Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect")
If RelatedVersion IsNot Nothing Then If GameInstance IsNot Nothing Then
Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion) Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion
End If End If
If UserSetup <> "" Then If UserSetup <> "" Then
@@ -422,7 +422,7 @@ UserPass:
UserJava = JavaEntry.FromJson(GetJson(UserSetup)) UserJava = JavaEntry.FromJson(GetJson(UserSetup))
Catch ex As Exception Catch ex As Exception
Log(ex, "版本指定的 Java 信息已损坏,已重置版本设置中指定的 Java") Log(ex, "版本指定的 Java 信息已损坏,已重置版本设置中指定的 Java")
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=RelatedVersion) Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance)
GoTo NoUserJava GoTo NoUserJava
End Try End Try
For Each Java In JavaList For Each Java In JavaList
@@ -446,14 +446,14 @@ NoUserJava:
''' </summary> ''' </summary>
Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
Dim PathInfo As New DirectoryInfo(Path) Dim PathInfo As New DirectoryInfo(Path)
Dim PathMcInfo As New DirectoryInfo(PathMcFolder) Dim PathMcInfo As New DirectoryInfo(McFolderSelected)
'1. 尽量在当前文件夹或当前 Minecraft 文件夹 '1. 尽量在当前文件夹或当前 Minecraft 文件夹
Dim ProgramPathParent As String, MinecraftPathParent As String = "" Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName
If PathMcFolder <> "" Then MinecraftPathParent = If(PathMcInfo.Parent, PathMcInfo).FullName If McFolderSelected <> "" Then MinecraftPathParent = If(PathMcInfo.Parent, PathMcInfo).FullName
If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
If PathMcFolder <> "" Then If McFolderSelected <> "" Then
If Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return True If Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return False If Not Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return False
End If End If
@@ -464,10 +464,10 @@ NoUserJava:
If Left.IsJre AndAlso Not Right.IsJre Then Return True If Left.IsJre AndAlso Not Right.IsJre Then Return True
If Not Left.IsJre AndAlso Right.IsJre Then Return False If Not Left.IsJre AndAlso Right.IsJre Then Return False
'4. Java 大版本 '4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then If Left.MajorVersion <> Right.MajorVersion Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23... ' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23...
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18} Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18}
Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode) Return Weight.ElementAtOrDefault(Left.MajorVersion) >= Weight.ElementAtOrDefault(Right.MajorVersion)
End If End If
'5. 最次级版本号更接近 51 '5. 最次级版本号更接近 51
Return Math.Abs(Left.Version.Revision - 51) <= Math.Abs(Right.Version.Revision - 51) Return Math.Abs(Left.Version.Revision - 51) <= Math.Abs(Right.Version.Revision - 51)
@@ -487,11 +487,11 @@ NoUserJava:
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub) End Sub)
End If End If
If FrmVersionSetup IsNot Nothing Then If FrmInstanceSetup IsNot Nothing Then
RunInUiWait( RunInUiWait(
Sub() Sub()
FrmVersionSetup.ComboArgumentJava.Items.Clear() FrmInstanceSetup.ComboArgumentJava.Items.Clear()
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) FrmInstanceSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub) End Sub)
End If End If
@@ -525,8 +525,8 @@ NoUserJava:
'查找启动器目录中的 Java '查找启动器目录中的 Java
JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True) JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
'查找所选 Minecraft 文件夹中的 Java '查找所选 Minecraft 文件夹中的 Java
If Not String.IsNullOrWhiteSpace(PathMcFolder) AndAlso Path <> PathMcFolder Then If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso Path <> McFolderSelected Then
JavaSearchFolder(PathMcFolder, JavaPreList, False, IsFullSearch:=True) JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
End If End If
'若不全为符号链接,则清除符号链接的地址 '若不全为符号链接,则清除符号链接的地址
@@ -579,7 +579,7 @@ NoUserJava:
For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794 For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value)) NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next Next
NewJavaList = JavaCheckList(NewJavaList).Sort(AddressOf JavaSorter) NewJavaList = JavaCheckList(NewJavaList).SortByComparison(AddressOf JavaSorter)
'修改设置项 '修改设置项
Dim AllList As New JArray Dim AllList As New JArray
@@ -596,7 +596,7 @@ NoUserJava:
Log("[Java] Java 搜索完成,发现 " & JavaList.Count & " 个 Java") Log("[Java] Java 搜索完成,发现 " & JavaList.Count & " 个 Java")
If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.RefreshJavaComboBox()) If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.RefreshJavaComboBox())
If FrmVersionSetup IsNot Nothing Then RunInUi(Sub() FrmVersionSetup.RefreshJavaComboBox()) If FrmInstanceSetup IsNot Nothing Then RunInUi(Sub() FrmInstanceSetup.RefreshJavaComboBox())
End Sub End Sub
''' <summary> ''' <summary>
@@ -695,28 +695,12 @@ Wait:
#Region "下载" #Region "下载"
''' <summary> ''' <summary>
''' 提示 Java 缺失,并弹窗确认是否自动下载。返回玩家选择是否下载。 ''' 获取下载 Java 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' </summary> ''' </summary>
Public Function JavaDownloadConfirm(VersionDescription As String, Optional ForcedManualDownload As Boolean = False) As Boolean Public Function GetJavaDownloadLoader() As LoaderCombo(Of String)
If ForcedManualDownload Then
MyMsgBox($"PCL 未找到 {VersionDescription}。" & vbCrLf &
$"请自行搜索并安装 {VersionDescription},安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。",
"未找到 Java")
Return False
Else
Return MyMsgBox($"PCL 未找到 {VersionDescription},是否需要 PCL 自动下载?" & vbCrLf &
$"如果你已经安装了 {VersionDescription},可以在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"自动下载 Java?", "自动下载", "取消") = 1
End If
End Function
''' <summary>
''' 获取下载 Java 8/14/17/21 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' </summary>
Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer)
Dim JavaDownloadLoader As New LoaderDownload("下载 Java 文件", New List(Of NetFile)) With {.ProgressWeight = 10} Dim JavaDownloadLoader As New LoaderDownload("下载 Java 文件", New List(Of NetFile)) With {.ProgressWeight = 10}
Dim Loader = New LoaderCombo(Of Integer)($"下载 Java {Version}", { Dim Loader = New LoaderCombo(Of String)($"下载 Java", {
New LoaderTask(Of Integer, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2}, New LoaderTask(Of String, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2},
JavaDownloadLoader, JavaDownloadLoader,
JavaSearchLoader JavaSearchLoader
}) })
@@ -733,22 +717,29 @@ Wait:
Return Loader Return Loader
End Function End Function
Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹,防止残留只下了一半但 -version 能跑的 Java Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹,防止残留只下了一半但 -version 能跑的 Java
Private Sub JavaFileList(Loader As LoaderTask(Of Integer, List(Of NetFile))) Private Sub JavaFileList(Loader As LoaderTask(Of String, List(Of NetFile)))
Log("[Java] 开始获取 Java 下载信息") Log("[Java] 开始获取 Java 下载信息")
Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder( Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder(
{"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}, {"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"} {"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}
), IsJson:=True) ), IsJson:=True)
'获取下载地址 '查找要下载的目标 Java
Dim MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}") Dim TargetEntry As JProperty = Nothing
Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项(最新) Dim Components As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
SelectMany(Function(e As JProperty) CType(e.Value, JArray).Select(Function(v) New KeyValuePair(Of String, JObject)(e.Name, v))) If Components.ContainsKey(Loader.Input) Then '精确匹配
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWithF(Loader.Input)) TargetEntry = Components.Property(Loader.Input)
Dim Address As String = TargetEntry.Value("manifest")("url") Else '模糊匹配
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}") TargetEntry = Components.Properties.FirstOrDefault(
Function(c) c.Value IsNot Nothing AndAlso c.Value.ToArray.FirstOrDefault()?("version")("name").ToString.StartsWithF(Loader.Input))
If TargetEntry Is Nothing Then Throw New Exception($"未能找到所需的 Java {Loader.Input}")
End If
Dim TargetComponent = TargetEntry.Value.ToArray.FirstOrDefault
If TargetComponent Is Nothing Then Throw New Exception($"Mojang 未提供所需的 Java {Loader.Input}")
'获取文件列表 '获取文件列表
Dim Address As String = TargetComponent("manifest")("url")
McLaunchLog($"准备下载 Java {TargetComponent("version")("name")}({TargetEntry.Name}):{Address}")
Dim ListFileStr As String = NetRequestByLoader(DlSourceOrder({Address}, {Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com")}), IsJson:=True) Dim ListFileStr As String = NetRequestByLoader(DlSourceOrder({Address}, {Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com")}), IsJson:=True)
LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\" LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Name & "\"
Dim Results As New List(Of NetFile) Dim Results As New List(Of NetFile)
For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files") For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files")
If CType(File.Value, JObject)("downloads")?("raw") Is Nothing Then Continue For If CType(File.Value, JObject)("downloads")?("raw") Is Nothing Then Continue For
@@ -18,9 +18,9 @@ Public Module ModLaunch
Public SaveBatch As String = Nothing Public SaveBatch As String = Nothing
''' <summary> ''' <summary>
''' 强行指定启动的 MC 版本。 ''' 强行指定启动的 MC 版本。
''' 默认值:Nothing。使用 McVersionCurrent。 ''' 默认值:Nothing。使用 McInstanceCurrent。
''' </summary> ''' </summary>
Public Version As McVersion = Nothing Public Instance As McInstance = Nothing
''' <summary> ''' <summary>
''' 额外的启动参数。 ''' 额外的启动参数。
''' </summary> ''' </summary>
@@ -39,23 +39,30 @@ Public Module ModLaunch
Return False Return False
End If End If
'强制切换需要启动的版本 '强制切换需要启动的版本
If CurrentLaunchOptions.Version IsNot Nothing AndAlso McVersionCurrent <> CurrentLaunchOptions.Version Then If CurrentLaunchOptions.Instance IsNot Nothing AndAlso McInstanceSelected <> CurrentLaunchOptions.Instance Then
McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Version.Name) McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Instance.Name)
'检查版本是否存在
Try
CurrentLaunchOptions.Instance.GetJsonPath()
Catch
Hint($"无法启动 {CurrentLaunchOptions.Instance.Name}:当前 Minecraft 文件夹中尚未安装该版本!", HintType.Red)
Return False
End Try
'检查版本 '检查版本
CurrentLaunchOptions.Version.Load() CurrentLaunchOptions.Instance.Load()
If CurrentLaunchOptions.Version.State = McVersionState.Error Then If CurrentLaunchOptions.Instance.State = McInstanceState.Error Then
Hint("无法启动 Minecraft:" & CurrentLaunchOptions.Version.Info, HintType.Red) Hint($"无法启动 {CurrentLaunchOptions.Instance.Name}:{CurrentLaunchOptions.Instance.Info}", HintType.Red)
Return False Return False
End If End If
'切换版本 '切换版本
McVersionCurrent = CurrentLaunchOptions.Version McInstanceSelected = CurrentLaunchOptions.Instance
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name) Setup.Set("LaunchVersionSelect", McInstanceSelected.Name)
FrmLaunchLeft.RefreshButtonsUI() FrmLaunchLeft.RefreshButtonsUI()
FrmLaunchLeft.RefreshPage(False, False) FrmLaunchLeft.RefreshPage(False, False)
End If End If
FrmMain.AprilGiveup() FrmMain.AprilGiveup()
'禁止进入版本选择页面(否则就可以在启动中切换 McVersionCurrent 了) '禁止进入版本选择页面(否则就可以在启动中切换 McInstanceSelected 了)
FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.VersionSelect).ToList FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.InstanceSelect).ToList
'实际启动加载器 '实际启动加载器
McLaunchLoader.Start(Options, IsForceRestart:=True) McLaunchLoader.Start(Options, IsForceRestart:=True)
Return True Return True
@@ -109,7 +116,7 @@ Public Module ModLaunch
Dim Loaders As New List(Of LoaderBase) From { Dim Loaders As New List(Of LoaderBase) From {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False}, New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
McLoginLoader, '.ProgressWeight = 15, .Block = False McLoginLoader, '.ProgressWeight = 15, .Block = False
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False}, New LoaderCombo(Of String)("补全文件", DlClientFix(McInstanceSelected, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2}, New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2}, New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1}, New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
@@ -119,7 +126,7 @@ Public Module ModLaunch
New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1} New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
} }
'内存优化 '内存优化
Select Case Setup.Get("VersionRamOptimize", Version:=McVersionCurrent) Select Case Setup.Get("VersionRamOptimize", Instance:=McInstanceSelected)
Case 0 '全局 Case 0 '全局
If Setup.Get("LaunchArgumentRam") Then '使用全局设置 If Setup.Get("LaunchArgumentRam") Then '使用全局设置
CType(Loaders(2), LoaderCombo(Of String)).Block = False CType(Loaders(2), LoaderCombo(Of String)).Block = False
@@ -140,17 +147,17 @@ Public Module ModLaunch
LoaderTaskbarAdd(LaunchLoader) LoaderTaskbarAdd(LaunchLoader)
Do While LaunchLoader.State = LoadState.Loading Do While LaunchLoader.State = LoadState.Loading
FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh) FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
Thread.Sleep(200) Thread.Sleep(100)
Loop Loop
FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh) FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
'成功与失败处理 '成功与失败处理
Select Case LaunchLoader.State Select Case LaunchLoader.State
Case LoadState.Finished Case LoadState.Finished
Hint(McVersionCurrent.Name & " 启动成功!", HintType.Green) Hint(McInstanceSelected.Name & " 启动成功!", HintType.Green)
'上报 '上报
If Not IsSavingBatch Then If Not IsSavingBatch Then
Telemetry("Minecraft 启动成功", Telemetry("Minecraft 启动成功",
"Version", McVersionCurrent.Version.ToString, "Version", McInstanceSelected.VersionDisplayName,
"LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType))) "LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType)))
End If End If
Case LoadState.Aborted Case LoadState.Aborted
@@ -185,7 +192,7 @@ NextInner:
'上报 '上报
If Not IsSavingBatch Then If Not IsSavingBatch Then
Telemetry("Minecraft 启动失败", Telemetry("Minecraft 启动失败",
"Version", McVersionCurrent.Version.ToString, "Version", McInstanceSelected.VersionDisplayName,
"LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType)), "LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType)),
"Exception", FilterUserName(FilterAccessToken(ex.GetDetail(), "*"), "*")) "Exception", FilterUserName(FilterAccessToken(ex.GetDetail(), "*"), "*"))
End If End If
@@ -223,12 +230,12 @@ NextInner:
Private Sub McLaunchPrecheck() Private Sub McLaunchPrecheck()
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000)) If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
'检查路径 '检查路径
If McVersionCurrent.PathIndie.Contains("!") OrElse McVersionCurrent.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;(" & McVersionCurrent.PathIndie & ")") If McInstanceSelected.PathIndie.Contains("!") OrElse McInstanceSelected.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;(" & McInstanceSelected.PathIndie & ")")
If McVersionCurrent.Path.Contains("!") OrElse McVersionCurrent.Path.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;(" & McVersionCurrent.Path & ")") If McInstanceSelected.PathVersion.Contains("!") OrElse McInstanceSelected.PathVersion.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;(" & McInstanceSelected.PathVersion & ")")
'检查版本 '检查版本
If McVersionCurrent Is Nothing Then Throw New Exception("未选择 Minecraft 版本!") If McInstanceSelected Is Nothing Then Throw New Exception("未选择 Minecraft 版本!")
McVersionCurrent.Load() McInstanceSelected.Load()
If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题:" & McVersionCurrent.Info) If McInstanceSelected.State = McInstanceState.Error Then Throw New Exception("Minecraft 存在问题:" & McInstanceSelected.Info)
'检查输入信息 '检查输入信息
Dim CheckResult As String = "" Dim CheckResult As String = ""
RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput())) RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
@@ -817,7 +824,7 @@ LoginFinish:
Dim ErrorMessage As String = Nothing Dim ErrorMessage As String = Nothing
Try Try
Dim Response = DirectCast(ex, ResponsedWebException).Response Dim Response = DirectCast(ex, ResponsedWebException).Response
If ErrorMessage.ContainsF("errorMessage", True) Then ErrorMessage = GetJson(Response)("errorMessage") If Response.ContainsF("errorMessage", True) Then ErrorMessage = GetJson(Response)("errorMessage").ToString()
Catch Catch
End Try End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
@@ -940,9 +947,7 @@ Retry:
}" }"
Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post, Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
Content:=Request, ContentType:="application/json", RequireJson:=True) Content:=Request, ContentType:="application/json", RequireJson:=True)
Dim ResultJson As JObject = GetJson(Result) Return GetJson(Result)("Token").ToString
Dim XBLToken As String = ResultJson("Token").ToString
Return XBLToken
End Function End Function
'微软登录步骤 3:从 XBLToken 获取 {XSTSToken, UHS} '微软登录步骤 3:从 XBLToken 获取 {XSTSToken, UHS}
Private Function MsLoginStep3(XBLToken As String) As String() Private Function MsLoginStep3(XBLToken As String) As String()
@@ -951,9 +956,7 @@ Retry:
Dim Request As String = "{ Dim Request As String = "{
""Properties"": { ""Properties"": {
""SandboxId"": ""RETAIL"", ""SandboxId"": ""RETAIL"",
""UserTokens"": [ ""UserTokens"": [""" & XBLToken & """]
""" & XBLToken & """
]
}, },
""RelyingParty"": ""rp://api.minecraftservices.com/"", ""RelyingParty"": ""rp://api.minecraftservices.com/"",
""TokenType"": ""JWT"" ""TokenType"": ""JWT""
@@ -1098,7 +1101,7 @@ Retry:
'使用正版用户名 '使用正版用户名
Try Try
If SkinName <> "" AndAlso If SkinName <> "" AndAlso
McVersionCurrent IsNot Nothing AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项(#3746) McInstanceSelected IsNot Nothing AndAlso McInstanceSelected.Version.Vanilla.Major < 20 Then '1.20+ 或快照版不能使用该项(#3746)
Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName) Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName)
Uuid = McLoginMojangUuid(SkinName, False) Uuid = McLoginMojangUuid(SkinName, False)
End If End If
@@ -1151,85 +1154,94 @@ Retry:
Private Sub McLaunchJava(Task As LoaderTask(Of Integer, Integer)) Private Sub McLaunchJava(Task As LoaderTask(Of Integer, Integer))
Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999) Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
'MC 大版本检测 '原版 26-:通过版本号判断
If (Not McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2024, 4, 2)) OrElse If (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2024, 4, 2)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 20, 5)) Then (McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla >= New Version(20, 0, 5)) Then
'1.20.5+(24w14a+):至少 Java 21 '1.20.5+(24w14a+):至少 Java 21
MinVer = New Version(1, 21, 0, 0) MinVer = New Version(1, 21, 0, 0)
ElseIf (Not McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16)) OrElse ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 11, 16)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 18)) Then (McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 18) Then
'1.18 pre2+:至少 Java 17 '1.18 pre2+:至少 Java 17
MinVer = New Version(1, 17, 0, 0) MinVer = New Version(1, 17, 0, 0)
ElseIf (Not McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2021, 5, 11)) OrElse ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 5, 11)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 17)) Then (McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 17) Then
'1.17+ (21w19a+):至少 Java 16 '1.17+ (21w19a+):至少 Java 16
MinVer = New Version(1, 16, 0, 0) MinVer = New Version(1, 16, 0, 0)
ElseIf McVersionCurrent.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年,太棒了 ElseIf McInstanceSelected.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年,太棒了
'1.12+:至少 Java 8 '1.12+:至少 Java 8
MinVer = New Version(1, 8, 0, 0) MinVer = New Version(1, 8, 0, 0)
ElseIf McVersionCurrent.ReleaseTime <= New Date(2013, 5, 1) AndAlso McVersionCurrent.ReleaseTime.Year >= 2001 Then '避免某些版本写个 1960 年 ElseIf McInstanceSelected.ReleaseTime <= New Date(2013, 5, 1) AndAlso McInstanceSelected.ReleaseTime.Year >= 2001 Then '避免某些版本写个 1960 年
'1.5.2-:最高 Java 12 '1.5.2-:最高 Java 8
MaxVer = New Version(1, 12, 999, 999) MaxVer = New Version(1, 8, 999, 999)
End If End If
If McVersionCurrent.JsonVersion?("java_version") IsNot Nothing Then
Dim RecommendedJava As Integer = McVersionCurrent.JsonVersion("java_version").ToObject(Of Integer) '原版 26+:获取 Mojang 要求的 Java 版本
McLaunchLog("Mojang 推荐使用 Java " & RecommendedJava) Dim RecommendedComponent As String = Nothing
If RecommendedJava >= 22 Then MinVer = New Version(1, RecommendedJava, 0, 0) '潜在的向后兼容 Dim RecommendedCode As Integer =
If(McInstanceSelected.JsonObject?("javaVersion")?("majorVersion")?.ToObject(Of Integer),
If(McInstanceSelected.JsonVersion?("java_version")?.ToObject(Of Integer), 0))
If RecommendedCode >= 22 Then
McLaunchLog("Mojang 要求至少使用 Java " & RecommendedCode)
MinVer = New Version(1, RecommendedCode, 0, 0)
RecommendedComponent =
If(McInstanceSelected.JsonObject?("javaVersion")?("component")?.ToString,
McInstanceSelected.JsonVersion?("java_component")?.ToString)
If RecommendedComponent = "" Then RecommendedComponent = Nothing
End If End If
'OptiFine 检测 'OptiFine 检测
If McVersionCurrent.Version.HasOptiFine AndAlso McVersionCurrent.Version.IsStandardVersion Then '不管非标准版本 If McInstanceSelected.Version.HasOptiFine AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
If McVersionCurrent.Version.McVersion < New Version(1, 7) Then If McInstanceSelected.Version.Vanilla.Major < 7 Then
'<1.7:至多 Java 8 '<1.7:至多 Java 8
MaxVer = New Version(1, 8, 999, 999) MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McVersion >= New Version(1, 8) AndAlso McVersionCurrent.Version.McVersion < New Version(1, 12) Then ElseIf McInstanceSelected.Version.Vanilla.Major >= 8 AndAlso McInstanceSelected.Version.Vanilla.Major < 12 Then
'1.8 - 1.11:必须恰好 Java 8 '1.8 - 1.11:必须恰好 Java 8
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999) MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain = 12 Then ElseIf McInstanceSelected.Version.Vanilla.Major = 12 Then
'1.12:最高 Java 8 '1.12:最高 Java 8
MaxVer = New Version(1, 8, 999, 999) MaxVer = New Version(1, 8, 999, 999)
End If End If
End If End If
'Forge 检测 'Forge 检测
If McVersionCurrent.Version.HasForge Then If McInstanceSelected.Version.HasForge Then
If McVersionCurrent.Version.McVersion >= New Version(1, 6, 1) AndAlso McVersionCurrent.Version.McVersion <= New Version(1, 7, 2) Then If McInstanceSelected.Version.Vanilla >= New Version(6, 0, 1) AndAlso McInstanceSelected.Version.Vanilla <= New Version(7, 0, 2) Then
'1.6.1 - 1.7.2:必须 Java 7 '1.6.1 - 1.7.2:必须 Java 7
MinVer = If(New Version(1, 7, 0, 0) > MinVer, New Version(1, 7, 0, 0), MinVer) MinVer = If(New Version(1, 7, 0, 0) > MinVer, New Version(1, 7, 0, 0), MinVer)
MaxVer = If(New Version(1, 7, 999, 999) < MaxVer, New Version(1, 7, 999, 999), MaxVer) MaxVer = If(New Version(1, 7, 999, 999) < MaxVer, New Version(1, 7, 999, 999), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain <= 12 OrElse Not McVersionCurrent.Version.IsStandardVersion Then '非标准版本 ElseIf McInstanceSelected.Version.Vanilla.Major <= 12 OrElse Not McInstanceSelected.Version.Vaild Then '非标准版本
'<=1.12:Java 8 '<=1.12:Java 8
MaxVer = New Version(1, 8, 999, 999) MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 14 Then ElseIf McInstanceSelected.Version.Vanilla.Major <= 14 Then
'1.13 - 1.14:Java 8 - 10 '1.13 - 1.14:Java 8 - 10
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer) MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
MaxVer = If(New Version(1, 10, 999, 999) < MaxVer, New Version(1, 10, 999, 999), MaxVer) MaxVer = If(New Version(1, 10, 999, 999) < MaxVer, New Version(1, 10, 999, 999), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain = 15 Then ElseIf McInstanceSelected.Version.Vanilla.Major = 15 Then
'1.15:Java 8 - 15 '1.15:Java 8 - 15
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer) MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
MaxVer = If(New Version(1, 15, 999, 999) < MaxVer, New Version(1, 15, 999, 999), MaxVer) MaxVer = If(New Version(1, 15, 999, 999) < MaxVer, New Version(1, 15, 999, 999), MaxVer)
ElseIf VersionSortBoolean(McVersionCurrent.Version.ForgeVersion, "34.0.0") AndAlso VersionSortBoolean("36.2.25", McVersionCurrent.Version.ForgeVersion) Then ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "34.0.0") AndAlso CompareVersionGE("36.2.25", McInstanceSelected.Version.Forge) Then
'1.16,Forge 34.X ~ 36.2.25:最高 Java 8u320 '1.16,Forge 34.X ~ 36.2.25:最高 Java 8u320
MaxVer = If(New Version(1, 8, 0, 320) < MaxVer, New Version(1, 8, 0, 320), MaxVer) MaxVer = If(New Version(1, 8, 0, 320) < MaxVer, New Version(1, 8, 0, 320), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 19 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305 ElseIf McInstanceSelected.Version.Vanilla.Major >= 18 AndAlso McInstanceSelected.Version.Vanilla.Major < 19 AndAlso McInstanceSelected.Version.HasOptiFine Then '#305
'1.18:若安装了 OptiFine,最高 Java 18 '1.18:若安装了 OptiFine,最高 Java 18
MaxVer = If(New Version(1, 18, 999, 999) < MaxVer, New Version(1, 18, 999, 999), MaxVer) MaxVer = If(New Version(1, 18, 999, 999) < MaxVer, New Version(1, 18, 999, 999), MaxVer)
End If End If
End If End If
'Fabric 检测 'Fabric 检测
If McVersionCurrent.Version.HasFabric AndAlso McVersionCurrent.Version.IsStandardVersion Then '不管非标准版本 If McInstanceSelected.Version.HasFabric AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 Then If McInstanceSelected.Version.Vanilla.Major >= 15 AndAlso McInstanceSelected.Version.Vanilla.Major <= 16 Then
'1.15 - 1.16:Java 8+ '1.15 - 1.16:Java 8+
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer) MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 Then ElseIf McInstanceSelected.Version.Vanilla.Major >= 18 Then
'1.18+:Java 17+ '1.18+:Java 17+
MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer) MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer)
End If End If
End If End If
'LiteLoader 检测 'LiteLoader 检测
If McVersionCurrent.Version.HasLiteLoader AndAlso McVersionCurrent.Version.IsStandardVersion Then '不管非标准版本 If McInstanceSelected.Version.HasLiteLoader AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
'最高 Java 8 '最高 Java 8
MaxVer = If(New Version(1, 8, 999, 999) < MaxVer, New Version(1, 8, 999, 999), MaxVer) MaxVer = If(New Version(1, 8, 999, 999) < MaxVer, New Version(1, 8, 999, 999), MaxVer)
End If End If
@@ -1244,7 +1256,7 @@ Retry:
'选择 Java '选择 Java
McLaunchLog("Java 版本需求:最低 " & MinVer.ToString & ",最高 " & MaxVer.ToString) McLaunchLog("Java 版本需求:最低 " & MinVer.ToString & ",最高 " & MaxVer.ToString)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent) McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
If Task.IsAborted Then Return If Task.IsAborted Then Return
If McLaunchJavaSelected IsNot Nothing Then If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString) McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
@@ -1255,40 +1267,25 @@ Retry:
If Task.IsAborted Then Return '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java If Task.IsAborted Then Return '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
McLaunchLog("无合适的 Java,需要确认是否自动下载") McLaunchLog("无合适的 Java,需要确认是否自动下载")
Dim JavaCode As String Dim JavaCode As String
If MinVer >= New Version(1, 22) Then '潜在的向后兼容 If MinVer >= New Version(1, 9) Then
JavaCode = MinVer.Minor JavaCode = MinVer.Minor
If Not JavaDownloadConfirm("Java " & JavaCode) Then Throw New Exception("$$")
ElseIf MinVer >= New Version(1, 21) Then
JavaCode = 21
If Not JavaDownloadConfirm("Java 21") Then Throw New Exception("$$")
ElseIf MinVer >= New Version(1, 9) Then
JavaCode = 17
If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8) Then ElseIf MaxVer < New Version(1, 8) Then
JavaCode = 7 MyMsgBox($"你需要安装 Java 7 才能启动该版本。{vbCrLf}请自行搜索并安装 Java 7,安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
If McVersionCurrent.Version.HasForge Then Throw New Exception("$$")
MyMsgBox("你需要先安装 LegacyJavaFixer Mod,或自行安装 Java 7,然后才能启动该版本。", "未找到 Java")
Else
If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
End If
ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u141" MyMsgBox($"你需要安装 Java 8u141 ~ 8u320 才能启动该版本。{vbCrLf}请自行搜索并安装,安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
If Not JavaDownloadConfirm("Java 8.0.141 ~ 8.0.320", True) Then Throw New Exception("$$") Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) Then ElseIf MinVer > New Version(1, 8, 0, 140) Then
JavaCode = "8u141" MyMsgBox($"你需要安装 Java 8u141 或更高版本的 Java 8 才能启动该版本。{vbCrLf}请自行搜索并安装,安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
If Not JavaDownloadConfirm("Java 8.0.141 或更高版本的 Java 8", True) Then Throw New Exception("$$") Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = 8
If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$")
Else Else
JavaCode = 8 JavaCode = 8
If Not JavaDownloadConfirm("Java 8") Then Throw New Exception("$$")
End If End If
'开始自动下载 '开始自动下载
Dim JavaLoader = JavaFixLoaders(JavaCode) Dim JavaLoader = GetJavaDownloadLoader()
Try Try
JavaLoader.Start(JavaCode, IsForceRestart:=True) JavaLoader.Start(If(RecommendedComponent, JavaCode), IsForceRestart:=True) '在 Java 22+ 时优先使用 Mojang 提供的 Component 字段
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted
Task.Progress = JavaLoader.Progress Task.Progress = JavaLoader.Progress
Thread.Sleep(10) Thread.Sleep(10)
@@ -1299,7 +1296,7 @@ Retry:
'检查下载结果 '检查下载结果
If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872# If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872#
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent) McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
If Task.IsAborted Then Return If Task.IsAborted Then Return
If McLaunchJavaSelected IsNot Nothing Then If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString) McLaunchLog("选择的 Java:" & McLaunchJavaSelected.ToString)
@@ -1356,32 +1353,32 @@ Retry:
McLaunchLog("开始获取 Minecraft 启动参数") McLaunchLog("开始获取 Minecraft 启动参数")
'获取基准字符串与参数信息 '获取基准字符串与参数信息
Dim Arguments As String Dim Arguments As String
If McVersionCurrent.JsonObject("arguments") IsNot Nothing AndAlso McVersionCurrent.JsonObject("arguments")("jvm") IsNot Nothing Then If McInstanceSelected.JsonObject("arguments") IsNot Nothing AndAlso McInstanceSelected.JsonObject("arguments")("jvm") IsNot Nothing Then
McLaunchLog("获取新版 JVM 参数") McLaunchLog("获取新版 JVM 参数")
Arguments = McLaunchArgumentsJvmNew(McVersionCurrent) Arguments = McLaunchArgumentsJvmNew(McInstanceSelected)
McLaunchLog("新版 JVM 参数获取成功:") McLaunchLog("新版 JVM 参数获取成功:")
McLaunchLog(Arguments) McLaunchLog(Arguments)
Else Else
McLaunchLog("获取旧版 JVM 参数") McLaunchLog("获取旧版 JVM 参数")
Arguments = McLaunchArgumentsJvmOld(McVersionCurrent) Arguments = McLaunchArgumentsJvmOld(McInstanceSelected)
McLaunchLog("旧版 JVM 参数获取成功:") McLaunchLog("旧版 JVM 参数获取成功:")
McLaunchLog(Arguments) McLaunchLog(Arguments)
End If End If
If Not String.IsNullOrEmpty(McVersionCurrent.JsonObject("minecraftArguments")) Then '有的版本是空字符串 If Not String.IsNullOrEmpty(McInstanceSelected.JsonObject("minecraftArguments")) Then '有的版本是空字符串
McLaunchLog("获取旧版 Game 参数") McLaunchLog("获取旧版 Game 参数")
Arguments += " " & McLaunchArgumentsGameOld(McVersionCurrent) Arguments += " " & McLaunchArgumentsGameOld(McInstanceSelected)
McLaunchLog("旧版 Game 参数获取成功") McLaunchLog("旧版 Game 参数获取成功")
End If End If
If McVersionCurrent.JsonObject("arguments") IsNot Nothing AndAlso McVersionCurrent.JsonObject("arguments")("game") IsNot Nothing Then If McInstanceSelected.JsonObject("arguments") IsNot Nothing AndAlso McInstanceSelected.JsonObject("arguments")("game") IsNot Nothing Then
McLaunchLog("获取新版 Game 参数") McLaunchLog("获取新版 Game 参数")
Arguments += " " & McLaunchArgumentsGameNew(McVersionCurrent) Arguments += " " & McLaunchArgumentsGameNew(McInstanceSelected)
McLaunchLog("新版 Game 参数获取成功") McLaunchLog("新版 Game 参数获取成功")
End If End If
'编码参数(#4700、#5892、#5909) '编码参数(#4700、#5892、#5909)
If McLaunchJavaSelected.VersionCode >= 18 Then 'Dfile.encoding 需要放在 Dstdout.encoding 后面(#6934) If McLaunchJavaSelected.MajorVersion >= 18 Then 'Dfile.encoding 需要放在 Dstdout.encoding 后面(#6934)
If Not Arguments.Contains("-Dfile.encoding=") Then Arguments = "-Dfile.encoding=COMPAT " & Arguments If Not Arguments.Contains("-Dfile.encoding=") Then Arguments = "-Dfile.encoding=COMPAT " & Arguments
End If End If
If McLaunchJavaSelected.VersionCode > 8 Then If McLaunchJavaSelected.MajorVersion > 8 Then
If Not Arguments.Contains("-Dstdout.encoding=") Then Arguments = "-Dstdout.encoding=UTF-8 " & Arguments If Not Arguments.Contains("-Dstdout.encoding=") Then Arguments = "-Dstdout.encoding=UTF-8 " & Arguments
If Not Arguments.Contains("-Dstderr.encoding=") Then Arguments = "-Dstderr.encoding=UTF-8 " & Arguments If Not Arguments.Contains("-Dstderr.encoding=") Then Arguments = "-Dstderr.encoding=UTF-8 " & Arguments
End If End If
@@ -1394,10 +1391,10 @@ Retry:
Arguments += " " & Arg.Trim Arguments += " " & Arg.Trim
Next Next
'自定义 '自定义
Dim ArgumentGame As String = Setup.Get("VersionAdvanceGame", Version:=McVersionCurrent) Dim ArgumentGame As String = Setup.Get("VersionAdvanceGame", Instance:=McInstanceSelected)
Arguments += " " & ArgumentReplace(If(ArgumentGame = "", Setup.Get("LaunchAdvanceGame"), ArgumentGame)) Arguments += " " & ArgumentReplace(If(ArgumentGame = "", Setup.Get("LaunchAdvanceGame"), ArgumentGame))
'进行参数替换 '进行参数替换
Dim ReplaceArguments = McLaunchArgumentsReplace(McVersionCurrent, Loader) Dim ReplaceArguments = McLaunchArgumentsReplace(McInstanceSelected, Loader)
If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then
'若自定义信息为空,则去掉该部分 '若自定义信息为空,则去掉该部分
Arguments = Arguments.Replace(" --versionType ${version_type}", "") Arguments = Arguments.Replace(" --versionType ${version_type}", "")
@@ -1414,11 +1411,11 @@ Retry:
FinalArguments = FinalArguments.TrimEnd FinalArguments = FinalArguments.TrimEnd
'替换 Module Path 为短路径(Forge 会在版本 JSON 硬编码这些路径) '替换 Module Path 为短路径(Forge 会在版本 JSON 硬编码这些路径)
FinalArguments = FinalArguments.RegexReplaceEach("(?<= (-p|--module-path) "")[^""]+(?="" )", FinalArguments = FinalArguments.RegexReplaceEach("(?<= (-p|--module-path) "")[^""]+(?="" )",
Function(ModulePath) ModulePath.Value.RegexReplaceEach("[A-Z]{1}:\\[^;]+", Function(m) ShortenPath(m.Value))) Function(ModulePath) ModulePath.Value.RegexReplaceEach("[A-Z]:\\[^;]+", Function(m) ShortenPath(m.Value)))
'进服 '进服
Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), CurrentLaunchOptions.ServerIp) Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McInstanceSelected), CurrentLaunchOptions.ServerIp)
If Server.Length > 0 Then If Server.Length > 0 Then
If McVersionCurrent.ReleaseTime > New Date(2023, 4, 4) Then If McInstanceSelected.ReleaseTime > New Date(2023, 4, 4) Then
'QuickPlay 'QuickPlay
FinalArguments += $" --quickPlayMultiplayer ""{Server}""" FinalArguments += $" --quickPlayMultiplayer ""{Server}"""
Else Else
@@ -1430,7 +1427,7 @@ Retry:
'不包含端口号 '不包含端口号
FinalArguments += $" --server {Server} --port 25565" FinalArguments += $" --server {Server} --port 25565"
End If End If
If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容,有概率导致材质丢失甚至游戏崩溃!", HintType.Red) If McInstanceSelected.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容,有概率导致材质丢失甚至游戏崩溃!", HintType.Red)
End If End If
End If End If
'输出 '输出
@@ -1440,30 +1437,30 @@ Retry:
End Sub End Sub
'Jvm 部分(第一段) 'Jvm 部分(第一段)
Private Function McLaunchArgumentsJvmOld(Version As McVersion) As String Private Function McLaunchArgumentsJvmOld(Instance As McInstance) As String
'存储以空格为间隔的启动参数列表 '存储以空格为间隔的启动参数列表
Dim DataList As New List(Of String) Dim DataList As New List(Of String)
'输出固定参数 '输出固定参数
DataList.Add("-XX:HeapDumpPath=MojangTricksIntelDriversForPerformance_javaw.exe_minecraft.exe.heapdump") DataList.Add("-XX:HeapDumpPath=MojangTricksIntelDriversForPerformance_javaw.exe_minecraft.exe.heapdump")
Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent) Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Instance:=McInstanceSelected)
If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm") If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm")
If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true" If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理 ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理
DataList.Insert(0, ArgumentReplace(ArgumentJvm)) '可变 JVM 参数 DataList.Insert(0, ArgumentReplace(ArgumentJvm)) '可变 JVM 参数
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.15) & "m") DataList.Add("-Xmn" & Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m") DataList.Add("-Xmx" & Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """") DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """")
DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表 DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表
'统一通行证 '统一通行证
If McLoginLoader.Output.Type = "Nide" Then If McLoginLoader.Output.Type = "Nide" Then
DataList.Insert(0, "-Dnide8auth.client=true -javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent)) DataList.Insert(0, "-Dnide8auth.client=true -javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Instance:=McInstanceSelected))
End If End If
'Authlib-Injector 'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then If McLoginLoader.Output.Type = "Auth" Then
If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书(5252#) If McLaunchJavaSelected.MajorVersion >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书(5252#)
Dim Server As String = Setup.Get("VersionServerAuthServer", McVersionCurrent) Dim Server As String = Setup.Get("VersionServerAuthServer", McInstanceSelected)
Try Try
Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8) Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server & DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1475,17 +1472,17 @@ Retry:
End If End If
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McVersionCurrent) Then If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McInstanceSelected) Then
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED") If McLaunchJavaSelected.MajorVersion >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """") DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """") DataList.Add("-jar """ & ExtractJavaWrapper() & """")
End If End If
'添加 MainClass '添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then If Instance.JsonObject("mainClass") Is Nothing Then
Throw New Exception("版本 json 中没有 mainClass 项!") Throw New Exception("版本 json 中没有 mainClass 项!")
Else Else
DataList.Add(Version.JsonObject("mainClass")) DataList.Add(Instance.JsonObject("mainClass"))
End If End If
'处理 DataList 的换行符 '处理 DataList 的换行符
@@ -1493,14 +1490,14 @@ Retry:
Return Join(DataList, " ") Return Join(DataList, " ")
End Function End Function
Private Function McLaunchArgumentsJvmNew(Version As McVersion) As String Private Function McLaunchArgumentsJvmNew(Instance As McInstance) As String
Dim DataList As New List(Of String) Dim DataList As New List(Of String)
'获取 Json 中的 DataList '获取 Json 中的 DataList
Dim CurrentVersion As McVersion = Version Dim CurrentInstance As McInstance = Instance
NextVersion: NextInstance:
If CurrentVersion.JsonObject("arguments") IsNot Nothing AndAlso CurrentVersion.JsonObject("arguments")("jvm") IsNot Nothing Then If CurrentInstance.JsonObject("arguments") IsNot Nothing AndAlso CurrentInstance.JsonObject("arguments")("jvm") IsNot Nothing Then
For Each SubJson As JToken In CurrentVersion.JsonObject("arguments")("jvm") For Each SubJson As JToken In CurrentInstance.JsonObject("arguments")("jvm")
If SubJson.Type = JTokenType.String Then If SubJson.Type = JTokenType.String Then
'字符串类型 '字符串类型
DataList.Add(SubJson.ToString) DataList.Add(SubJson.ToString)
@@ -1519,9 +1516,9 @@ NextVersion:
End If End If
Next Next
End If End If
If CurrentVersion.InheritVersion <> "" Then If CurrentInstance.InheritName <> "" Then
CurrentVersion = New McVersion(CurrentVersion.InheritVersion) CurrentInstance = New McInstance(CurrentInstance.InheritName)
GoTo NextVersion GoTo NextInstance
End If End If
'内存、Log4j 防御参数等 '内存、Log4j 防御参数等
@@ -1529,12 +1526,12 @@ NextVersion:
'统一通行证 '统一通行证
If McLoginLoader.Output.Type = "Nide" Then If McLoginLoader.Output.Type = "Nide" Then
DataList.Insert(0, "-javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent)) DataList.Insert(0, "-javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Instance:=McInstanceSelected))
End If End If
'Authlib-Injector 'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then If McLoginLoader.Output.Type = "Auth" Then
If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书(5252#) If McLaunchJavaSelected.MajorVersion >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书(5252#)
Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent) Dim Server As String = Setup.Get("VersionServerAuthServer", Instance:=McInstanceSelected)
Try Try
Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8) Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server & DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1546,8 +1543,8 @@ NextVersion:
End If End If
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McVersionCurrent) Then If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McInstanceSelected) Then
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED") If McLaunchJavaSelected.MajorVersion >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """") DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """") DataList.Add("-jar """ & ExtractJavaWrapper() & """")
End If End If
@@ -1575,28 +1572,28 @@ NextVersion:
Dim Result As String = DeDuplicateDataList.Distinct.Join(" ") Dim Result As String = DeDuplicateDataList.Distinct.Join(" ")
'添加 MainClass '添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then If Instance.JsonObject("mainClass") Is Nothing Then
Throw New Exception("版本 json 中没有 mainClass 项!") Throw New Exception("版本 json 中没有 mainClass 项!")
Else Else
Result += " " & Version.JsonObject("mainClass").ToString Result += " " & Instance.JsonObject("mainClass").ToString
End If End If
Return Result Return Result
End Function End Function
'Game 部分(第二段) 'Game 部分(第二段)
Private Function McLaunchArgumentsGameOld(Version As McVersion) As String Private Function McLaunchArgumentsGameOld(Instance As McInstance) As String
Dim DataList As New List(Of String) Dim DataList As New List(Of String)
'本地化 Minecraft 启动信息 '本地化 Minecraft 启动信息
Dim BasicString As String = Version.JsonObject("minecraftArguments").ToString Dim BasicString As String = Instance.JsonObject("minecraftArguments").ToString
If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}" If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}"
DataList.Add(BasicString) DataList.Add(BasicString)
Dim Result As String = DataList.Join(" ") Dim Result As String = DataList.Join(" ")
'特别改变 OptiFineTweaker '特别改变 OptiFineTweaker
If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then If (Instance.Version.HasForge OrElse Instance.Version.HasLiteLoader) AndAlso Instance.Version.HasOptiFine Then
'把 OptiFineForgeTweaker 放在最后,不然会导致崩溃! '把 OptiFineForgeTweaker 放在最后,不然会导致崩溃!
If Result.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then If Result.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
Log("[Launch] 发现正确的 OptiFineForge TweakClass,目前参数:" & Result) Log("[Launch] 发现正确的 OptiFineForge TweakClass,目前参数:" & Result)
@@ -1606,7 +1603,7 @@ NextVersion:
Log("[Launch] 发现错误的 OptiFineForge TweakClass,目前参数:" & Result) Log("[Launch] 发现错误的 OptiFineForge TweakClass,目前参数:" & Result)
Result = Result.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker" Result = Result.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try Try
WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker")) WriteFile(Instance.PathVersion & Instance.Name & ".json", ReadFile(Instance.PathVersion & Instance.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
Catch ex As Exception Catch ex As Exception
Log(ex, "替换 OptiFineForge TweakClass 失败") Log(ex, "替换 OptiFineForge TweakClass 失败")
End Try End Try
@@ -1615,14 +1612,14 @@ NextVersion:
Return Result Return Result
End Function End Function
Private Function McLaunchArgumentsGameNew(Version As McVersion) As String Private Function McLaunchArgumentsGameNew(Instance As McInstance) As String
Dim DataList As New List(Of String) Dim DataList As New List(Of String)
'获取 Json 中的 DataList '获取 Json 中的 DataList
Dim CurrentVersion As McVersion = Version Dim CurrentInstance As McInstance = Instance
NextVersion: NextInstance:
If CurrentVersion.JsonObject("arguments") IsNot Nothing AndAlso CurrentVersion.JsonObject("arguments")("game") IsNot Nothing Then If CurrentInstance.JsonObject("arguments") IsNot Nothing AndAlso CurrentInstance.JsonObject("arguments")("game") IsNot Nothing Then
For Each SubJson As JToken In CurrentVersion.JsonObject("arguments")("game") For Each SubJson As JToken In CurrentInstance.JsonObject("arguments")("game")
If SubJson.Type = JTokenType.String Then If SubJson.Type = JTokenType.String Then
'字符串类型 '字符串类型
DataList.Add(SubJson.ToString) DataList.Add(SubJson.ToString)
@@ -1641,9 +1638,9 @@ NextVersion:
End If End If
Next Next
End If End If
If CurrentVersion.InheritVersion <> "" Then If CurrentInstance.InheritName <> "" Then
CurrentVersion = New McVersion(CurrentVersion.InheritVersion) CurrentInstance = New McInstance(CurrentInstance.InheritName)
GoTo NextVersion GoTo NextInstance
End If End If
'将 "-XXX" 与后面 "XXX" 合并到一起 '将 "-XXX" 与后面 "XXX" 合并到一起
@@ -1667,7 +1664,7 @@ NextVersion:
McLaunchArgumentsGameNew = Join(DeDuplicateDataList.Distinct.ToList, " ") McLaunchArgumentsGameNew = Join(DeDuplicateDataList.Distinct.ToList, " ")
'特别改变 OptiFineTweaker '特别改变 OptiFineTweaker
If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then If (Instance.Version.HasForge OrElse Instance.Version.HasLiteLoader) AndAlso Instance.Version.HasOptiFine Then
'把 OptiFineForgeTweaker 放在最后,不然会导致崩溃! '把 OptiFineForgeTweaker 放在最后,不然会导致崩溃!
If McLaunchArgumentsGameNew.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then If McLaunchArgumentsGameNew.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
Log("[Launch] 发现正确的 OptiFineForge TweakClass,目前参数:" & McLaunchArgumentsGameNew) Log("[Launch] 发现正确的 OptiFineForge TweakClass,目前参数:" & McLaunchArgumentsGameNew)
@@ -1677,7 +1674,7 @@ NextVersion:
Log("[Launch] 发现错误的 OptiFineForge TweakClass,目前参数:" & McLaunchArgumentsGameNew) Log("[Launch] 发现错误的 OptiFineForge TweakClass,目前参数:" & McLaunchArgumentsGameNew)
McLaunchArgumentsGameNew = McLaunchArgumentsGameNew.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker" McLaunchArgumentsGameNew = McLaunchArgumentsGameNew.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try Try
WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker")) WriteFile(Instance.PathVersion & Instance.Name & ".json", ReadFile(Instance.PathVersion & Instance.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
Catch ex As Exception Catch ex As Exception
Log(ex, "替换 OptiFineForge TweakClass 失败") Log(ex, "替换 OptiFineForge TweakClass 失败")
End Try End Try
@@ -1686,21 +1683,21 @@ NextVersion:
End Function End Function
'替换 Arguments '替换 Arguments
Private Function McLaunchArgumentsReplace(Version As McVersion, ByRef Loader As LoaderTask(Of String, List(Of McLibToken))) As Dictionary(Of String, String) Private Function McLaunchArgumentsReplace(Instance As McInstance, ByRef Loader As LoaderTask(Of String, List(Of McLibToken))) As Dictionary(Of String, String)
Dim GameArguments As New Dictionary(Of String, String) Dim GameArguments As New Dictionary(Of String, String)
'基础参数 '基础参数
GameArguments.Add("${classpath_separator}", ";") GameArguments.Add("${classpath_separator}", ";")
GameArguments.Add("${natives_directory}", ShortenPath(GetNativesFolder())) GameArguments.Add("${natives_directory}", ShortenPath(GetNativesFolder()))
GameArguments.Add("${library_directory}", ShortenPath(PathMcFolder & "libraries")) GameArguments.Add("${library_directory}", ShortenPath(McFolderSelected & "libraries"))
GameArguments.Add("${libraries_directory}", ShortenPath(PathMcFolder & "libraries")) GameArguments.Add("${libraries_directory}", ShortenPath(McFolderSelected & "libraries"))
GameArguments.Add("${launcher_name}", "PCL") GameArguments.Add("${launcher_name}", "PCL")
GameArguments.Add("${launcher_version}", VersionCode) GameArguments.Add("${launcher_version}", VersionCode)
GameArguments.Add("${version_name}", Version.Name) GameArguments.Add("${version_name}", Instance.Name)
Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Version:=McVersionCurrent) Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Instance:=McInstanceSelected)
GameArguments.Add("${version_type}", ArgumentReplace(If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo))) GameArguments.Add("${version_type}", ArgumentReplace(If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo)))
GameArguments.Add("${game_directory}", ShortenPath(Left(McVersionCurrent.PathIndie, McVersionCurrent.PathIndie.Count - 1))) GameArguments.Add("${game_directory}", ShortenPath(Left(McInstanceSelected.PathIndie, McInstanceSelected.PathIndie.Count - 1)))
GameArguments.Add("${assets_root}", ShortenPath(PathMcFolder & "assets")) GameArguments.Add("${assets_root}", ShortenPath(McFolderSelected & "assets"))
GameArguments.Add("${user_properties}", "{}") GameArguments.Add("${user_properties}", "{}")
GameArguments.Add("${auth_player_name}", McLoginLoader.Output.Name) GameArguments.Add("${auth_player_name}", McLoginLoader.Output.Name)
GameArguments.Add("${auth_uuid}", McLoginLoader.Output.Uuid) GameArguments.Add("${auth_uuid}", McLoginLoader.Output.Uuid)
@@ -1708,7 +1705,7 @@ NextVersion:
GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken) GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken) GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${user_type}", "msa") '#1221 GameArguments.Add("${user_type}", "msa") '#1221
GameArguments.Add("${primary_jar}", ShortenPath(Version.Path & Version.Name & ".jar")) '#6942 GameArguments.Add("${primary_jar}", ShortenPath(Instance.PathVersion & Instance.Name & ".jar")) '#6942
'窗口尺寸参数 '窗口尺寸参数
Dim GameSize As Size Dim GameSize As Size
@@ -1723,10 +1720,10 @@ NextVersion:
Case Else Case Else
GameSize = New Size(854, 480) GameSize = New Size(854, 480)
End Select End Select
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso '修复 1.12.2- 下 JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍(#3463)
McLaunchJavaSelected.VersionCode <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso If McInstanceSelected.Version.Vanilla.Major <= 12 AndAlso
Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then McLaunchJavaSelected.MajorVersion <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
'修复 #3463:1.12.2-,JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍 Not McInstanceSelected.Version.HasOptiFine AndAlso Not McInstanceSelected.Version.HasForge Then
McLaunchLog($"已应用窗口大小过大修复({McLaunchJavaSelected.Version.Revision})") McLaunchLog($"已应用窗口大小过大修复({McLaunchJavaSelected.Version.Revision})")
GameSize.Width /= DPI / 96 GameSize.Width /= DPI / 96
GameSize.Height /= DPI / 96 GameSize.Height /= DPI / 96
@@ -1735,11 +1732,11 @@ NextVersion:
GameArguments.Add("${resolution_height}", Math.Round(GameSize.Height)) GameArguments.Add("${resolution_height}", Math.Round(GameSize.Height))
'Assets 相关参数 'Assets 相关参数
GameArguments.Add("${game_assets}", ShortenPath(PathMcFolder & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并 GameArguments.Add("${game_assets}", ShortenPath(McFolderSelected & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Version)) GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Instance))
'支持库参数 '支持库参数
Dim LibList As List(Of McLibToken) = McLibListGet(Version, True) Dim LibList As List(Of McLibToken) = McLibListGet(Instance, True)
Loader.Output = LibList Loader.Output = LibList
Dim CpStrings As New List(Of String) Dim CpStrings As New List(Of String)
Dim OptiFineCp As String = Nothing Dim OptiFineCp As String = Nothing
@@ -1827,7 +1824,7 @@ NextVersion:
''' 获取 Natives 文件夹路径,不以 \ 结尾。 ''' 获取 Natives 文件夹路径,不以 \ 结尾。
''' </summary> ''' </summary>
Private Function GetNativesFolder() As String Private Function GetNativesFolder() As String
Dim Result As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives" Dim Result As String = McInstanceSelected.PathVersion & McInstanceSelected.Name & "-natives"
If Not (IsGBKEncoding OrElse Result.IsASCII()) Then If Not (IsGBKEncoding OrElse Result.IsASCII()) Then
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives" Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
If Not Result.IsASCII() Then If Not Result.IsASCII() Then
@@ -1844,7 +1841,7 @@ NextVersion:
Private Sub McLaunchPrerun() Private Sub McLaunchPrerun()
'要求 Java 使用高性能显卡 '使用高性能显卡
If Setup.Get("LaunchAdvanceGraphicCard") Then If Setup.Get("LaunchAdvanceGraphicCard") Then
Try Try
SetGPUPreference(McLaunchJavaSelected.PathJava) SetGPUPreference(McLaunchJavaSelected.PathJava)
@@ -1871,7 +1868,7 @@ NextVersion:
Try Try
'确保可用 '确保可用
If Not McLoginLoader.Output.Type = "Microsoft" Then Exit Try If Not McLoginLoader.Output.Type = "Microsoft" Then Exit Try
McFolderLauncherProfilesJsonCreate(PathMcFolder) McFolderLauncherProfilesJsonCreate(McFolderSelected)
'构建需要替换的 Json 对象 '构建需要替换的 Json 对象
Dim ReplaceJsonString As String = " Dim ReplaceJsonString As String = "
{ {
@@ -1893,15 +1890,15 @@ NextVersion:
}" }"
Dim ReplaceJson As JObject = GetJson(ReplaceJsonString) Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
'更新文件 '更新文件
Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json")) Dim Profiles As JObject = GetJson(ReadFile(McFolderSelected & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson) Profiles.Merge(ReplaceJson)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030")) WriteFile(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已更新 launcher_profiles.json") McLaunchLog("已更新 launcher_profiles.json")
Catch ex As Exception Catch ex As Exception
Log(ex, "更新 launcher_profiles.json 失败,将在删除文件后重试") Log(ex, "更新 launcher_profiles.json 失败,将在删除文件后重试")
Try Try
File.Delete(PathMcFolder & "launcher_profiles.json") File.Delete(McFolderSelected & "launcher_profiles.json")
McFolderLauncherProfilesJsonCreate(PathMcFolder) McFolderLauncherProfilesJsonCreate(McFolderSelected)
'构建需要替换的 Json 对象 '构建需要替换的 Json 对象
Dim ReplaceJsonString As String = " Dim ReplaceJsonString As String = "
{ {
@@ -1923,9 +1920,9 @@ NextVersion:
}" }"
Dim ReplaceJson As JObject = GetJson(ReplaceJsonString) Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
'更新文件 '更新文件
Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json")) Dim Profiles As JObject = GetJson(ReadFile(McFolderSelected & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson) Profiles.Merge(ReplaceJson)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030")) WriteFile(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已在删除后更新 launcher_profiles.json") McLaunchLog("已在删除后更新 launcher_profiles.json")
Catch exx As Exception Catch exx As Exception
Log(exx, "更新 launcher_profiles.json 失败", LogLevel.Feedback) Log(exx, "更新 launcher_profiles.json 失败", LogLevel.Feedback)
@@ -1933,10 +1930,10 @@ NextVersion:
End Try End Try
'更新 options.txt '更新 options.txt
Dim SetupFileAddress As String = McVersionCurrent.PathIndie & "options.txt" Dim SetupFileAddress As String = McInstanceSelected.PathIndie & "options.txt"
If Not File.Exists(SetupFileAddress) Then If Not File.Exists(SetupFileAddress) Then
'Yosbr Mod 兼容(#2385):https://www.curseforge.com/minecraft/mc-mods/yosbr 'Yosbr Mod 兼容(#2385):https://www.curseforge.com/minecraft/mc-mods/yosbr
Dim YosbrFileAddress As String = McVersionCurrent.PathIndie & "config\yosbr\options.txt" Dim YosbrFileAddress As String = McInstanceSelected.PathIndie & "config\yosbr\options.txt"
If File.Exists(YosbrFileAddress) Then If File.Exists(YosbrFileAddress) Then
McLaunchLog("将修改 Yosbr Mod 中的 options.txt") McLaunchLog("将修改 Yosbr Mod 中的 options.txt")
SetupFileAddress = YosbrFileAddress SetupFileAddress = YosbrFileAddress
@@ -1951,9 +1948,9 @@ NextVersion:
'1.11 ~ 12:zh_cn 时正常,zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文 '1.11 ~ 12:zh_cn 时正常,zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文
'1.13+ :zh_cn 时正常,zh_CN 时自动切换为英文 '1.13+ :zh_cn 时正常,zh_CN 时自动切换为英文
Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none") Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none")
Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves"), '#3844,整合包可能已经自带了 options.txt Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not Directory.Exists(McInstanceSelected.PathIndie & "saves"), '#3844,整合包可能已经自带了 options.txt
If(Setup.Get("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.ToLower) If(Setup.Get("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.ToLower)
If McVersionCurrent.Version.McCodeMain < 12 Then '注意老版本(包含 MC 1.1)的 McCodeMain 可能为 -1 If Not McInstanceSelected.Version.Vaild OrElse McInstanceSelected.Version.Vanilla.Major <= 10 Then
'将最后两位改为大写,前面的部分保留 '将最后两位改为大写,前面的部分保留
RequiredLang = RequiredLang.Substring(0, RequiredLang.Length - 2) & RequiredLang.Substring(RequiredLang.Length - 2).ToUpper RequiredLang = RequiredLang.Substring(0, RequiredLang.Length - 2) & RequiredLang.Substring(RequiredLang.Length - 2).ToUpper
End If End If
@@ -1965,7 +1962,7 @@ NextVersion:
McLaunchLog($"已将语言从 {CurrentLang} 修改为 {RequiredLang}") McLaunchLog($"已将语言从 {CurrentLang} 修改为 {RequiredLang}")
End If End If
''如果是初次设置,一并修改 forceUnicodeFont ''如果是初次设置,一并修改 forceUnicodeFont
'If Setup.Get("ToolHelpChinese") AndAlso (CurrentLang = "none" OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves")) Then 'If Setup.Get("ToolHelpChinese") AndAlso (CurrentLang = "none" OrElse Not Directory.Exists(McInstanceSelected.PathIndie & "saves")) Then
' WriteIni(SetupFileAddress, "forceUnicodeFont", "true") ' WriteIni(SetupFileAddress, "forceUnicodeFont", "true")
' McLaunchLog("已开启 forceUnicodeFont") ' McLaunchLog("已开启 forceUnicodeFont")
'End If 'End If
@@ -1982,7 +1979,7 @@ NextVersion:
End Try End Try
'离线皮肤 Alex 警告 '离线皮肤 Alex 警告
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.2 ~ 1.7 If McInstanceSelected.Version.Vanilla.Major <= 7 AndAlso McInstanceSelected.Version.Vanilla.Major >= 2 AndAlso '1.2 ~ 1.7
McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录 McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
(Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex (Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
(Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤 (Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
@@ -1991,17 +1988,17 @@ NextVersion:
'离线皮肤资源包 '离线皮肤资源包
Try Try
Directory.CreateDirectory(McVersionCurrent.PathIndie & "resourcepacks\") Directory.CreateDirectory(McInstanceSelected.PathIndie & "resourcepacks\")
Dim ZipFileAddress As String = McVersionCurrent.PathIndie & "resourcepacks\PCL2 Skin.zip" Dim ZipFileAddress As String = McInstanceSelected.PathIndie & "resourcepacks\PCL2 Skin.zip"
Dim NewTypeSetup As Boolean = McVersionCurrent.Version.McCodeMain >= 13 OrElse McVersionCurrent.Version.McCodeMain < 6 Dim NewTypeSetup As Boolean = McInstanceSelected.Version.Vanilla.Major >= 13 OrElse McInstanceSelected.Version.Vanilla.Major < 6
If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Setup.Get("LaunchSkinType") = 4 AndAlso File.Exists(PathAppdata & "CustomSkin.png") Then If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Setup.Get("LaunchSkinType") = 4 AndAlso File.Exists(PathAppdata & "CustomSkin.png") Then
Directory.CreateDirectory(PathTemp) Directory.CreateDirectory(PathTemp)
Dim MetaFileAddress As String = PathTemp & "pack.mcmeta" Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
Dim PackPicAddress As String = PathTemp & "pack.png" Dim PackPicAddress As String = PathTemp & "pack.png"
Dim PackFormat As Integer Dim PackFormat As Integer
Select Case McVersionCurrent.Version.McCodeMain Select Case McInstanceSelected.Version.Vanilla.Major
Case 0, 1, 2, 3, 4, 5 Case 0, 1, 2, 3, 4, 5
'更早的版本没有资源包;如果判断失败该值为 -1,不会跑到这 '更早的版本没有资源包
McLaunchLog("Minecraft 版本过老,尚不支持自定义离线皮肤") McLaunchLog("Minecraft 版本过老,尚不支持自定义离线皮肤")
GoTo IgnoreCustomSkin GoTo IgnoreCustomSkin
Case 6, 7, 8 Case 6, 7, 8
@@ -2019,24 +2016,24 @@ NextVersion:
Case 17 Case 17
PackFormat = 7 PackFormat = 7
Case 18 Case 18
If McVersionCurrent.Version.McCodeSub <= 2 Then If McInstanceSelected.Version.Vanilla.Minor <= 2 Then
PackFormat = 8 PackFormat = 8
Else Else
PackFormat = 9 PackFormat = 9
End If End If
Case 19 Case 19
If McVersionCurrent.Version.McCodeSub <= 3 Then If McInstanceSelected.Version.Vanilla.Minor <= 3 Then
PackFormat = 9 PackFormat = 9
Else Else
PackFormat = 12 PackFormat = 12
End If End If
Case 20 Case 20
If McVersionCurrent.Version.McCodeSub <= 1 Then If McInstanceSelected.Version.Vanilla.Minor <= 1 Then
PackFormat = 15 PackFormat = 15
Else Else
PackFormat = 17 PackFormat = 17
End If End If
Case Else '快照版是 99 Case Else '快照版是 9999
PackFormat = 17 PackFormat = 17
'https://zh.minecraft.wiki/w/数据包#数据包版本 'https://zh.minecraft.wiki/w/数据包#数据包版本
End Select End Select
@@ -2046,7 +2043,7 @@ NextVersion:
Bit.Save(PackPicAddress) Bit.Save(PackPicAddress)
WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}") WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png") Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png")
If (McVersionCurrent.Version.McCodeMain = 6 OrElse McVersionCurrent.Version.McCodeMain = 7) AndAlso Skin.Pic.Height = 64 Then If (McInstanceSelected.Version.Vanilla.Major = 6 OrElse McInstanceSelected.Version.Vanilla.Major = 7) AndAlso Skin.Pic.Height = 64 Then
McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪") McLaunchLog("该 Minecraft 版本不支持双层皮肤,已进行裁剪")
Skin = Skin.Clip(0, 0, 64, 32) Skin = Skin.Clip(0, 0, 64, 32)
End If End If
@@ -2057,22 +2054,13 @@ NextVersion:
ZipAr.CreateEntryFromFile(MetaFileAddress, "pack.mcmeta") ZipAr.CreateEntryFromFile(MetaFileAddress, "pack.mcmeta")
ZipAr.CreateEntryFromFile(PackPicAddress, "pack.png") ZipAr.CreateEntryFromFile(PackPicAddress, "pack.png")
'1.19.3+ 使用复杂版本的替换 '1.19.3+ 使用复杂版本的替换
Dim IsOldType As Boolean If McInstanceSelected.Version.Vanilla >= New Version(19, 0, 3) Then
Select Case McVersionCurrent.Version.McCodeMain
Case Is < 19
IsOldType = True
Case 19
IsOldType = McVersionCurrent.Version.McCodeSub <= 2
Case Else
IsOldType = False
End Select
If IsOldType Then
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Setup.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
Else
For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"} For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png",
$"assets/minecraft/textures/entity/player/{If(Setup.Get("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png") $"assets/minecraft/textures/entity/player/{If(Setup.Get("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png")
Next Next
Else
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Setup.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
End If End If
End Using End Using
End Using End Using
@@ -2131,24 +2119,24 @@ IgnoreCustomSkin:
'获取自定义命令 '获取自定义命令
Dim CustomCommandGlobal As String = Setup.Get("LaunchAdvanceRun") Dim CustomCommandGlobal As String = Setup.Get("LaunchAdvanceRun")
If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal) If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal)
Dim CustomCommandVersion As String = Setup.Get("VersionAdvanceRun", Version:=McVersionCurrent) Dim CustomCommandVersion As String = Setup.Get("VersionAdvanceRun", Instance:=McInstanceSelected)
If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion) If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion)
'输出 bat '输出 bat
Try Try
Dim CmdString As String = Dim CmdString As String =
$"{If(McLaunchJavaSelected.VersionCode > 8, "chcp 65001>nul" & vbCrLf, "")}" & $"{If(McLaunchJavaSelected.MajorVersion > 8, "chcp 65001>nul" & vbCrLf, "")}" &
"@echo off" & vbCrLf & "@echo off" & vbCrLf &
$"title 启动 - {McVersionCurrent.Name}" & vbCrLf & $"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
"echo 游戏正在启动,请稍候。" & vbCrLf & "echo 游戏正在启动,请稍候。" & vbCrLf &
$"cd /D ""{ShortenPath(McVersionCurrent.PathIndie)}""" & vbCrLf & $"cd /D ""{ShortenPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
CustomCommandGlobal & vbCrLf & CustomCommandGlobal & vbCrLf &
CustomCommandVersion & vbCrLf & CustomCommandVersion & vbCrLf &
$"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf & $"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf &
"echo 游戏已退出。" & vbCrLf & "echo 游戏已退出。" & vbCrLf &
"pause" "pause"
WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), FilterAccessToken(CmdString, "F"), WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), FilterAccessToken(CmdString, "F"),
Encoding:=If(McLaunchJavaSelected.VersionCode > 8, Encoding.UTF8, Encoding.Default)) Encoding:=If(McLaunchJavaSelected.MajorVersion > 8, Encoding.UTF8, Encoding.Default))
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成,强制结束启动过程") McLaunchLog("导出启动脚本完成,强制结束启动过程")
AbortHint = "导出启动脚本成功!" AbortHint = "导出启动脚本成功!"
@@ -2169,7 +2157,7 @@ IgnoreCustomSkin:
CustomProcess = StartProcess(New ProcessStartInfo With { CustomProcess = StartProcess(New ProcessStartInfo With {
.FileName = "cmd.exe", .FileName = "cmd.exe",
.Arguments = $"/c ""{CustomCommandGlobal}""", .Arguments = $"/c ""{CustomCommandGlobal}""",
.WorkingDirectory = PathMcFolder, .WorkingDirectory = McFolderSelected,
.UseShellExecute = False, .UseShellExecute = False,
.CreateNoWindow = True .CreateNoWindow = True
}) })
@@ -2194,11 +2182,11 @@ IgnoreCustomSkin:
CustomProcess = StartProcess(New ProcessStartInfo With { CustomProcess = StartProcess(New ProcessStartInfo With {
.FileName = "cmd.exe", .FileName = "cmd.exe",
.Arguments = $"/c ""{CustomCommandVersion}""", .Arguments = $"/c ""{CustomCommandVersion}""",
.WorkingDirectory = PathMcFolder, .WorkingDirectory = McFolderSelected,
.UseShellExecute = False, .UseShellExecute = False,
.CreateNoWindow = True .CreateNoWindow = True
}) })
If Setup.Get("VersionAdvanceRunWait", Version:=McVersionCurrent) Then If Setup.Get("VersionAdvanceRunWait", Instance:=McInstanceSelected) Then
Do Until CustomProcess.HasExited OrElse Loader.IsAborted Do Until CustomProcess.HasExited OrElse Loader.IsAborted
Thread.Sleep(10) Thread.Sleep(10)
Loop Loop
@@ -2225,10 +2213,10 @@ IgnoreCustomSkin:
If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";")) If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder)) Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder))
StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";") StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder) StartInfo.EnvironmentVariables("appdata") = ShortenPath(McFolderSelected)
'设置其他参数 '设置其他参数
StartInfo.WorkingDirectory = McVersionCurrent.PathIndie StartInfo.WorkingDirectory = McInstanceSelected.PathIndie
StartInfo.UseShellExecute = False StartInfo.UseShellExecute = False
StartInfo.RedirectStandardOutput = True StartInfo.RedirectStandardOutput = True
StartInfo.RedirectStandardError = True StartInfo.RedirectStandardError = True
@@ -2267,14 +2255,14 @@ IgnoreCustomSkin:
McLaunchLog("") McLaunchLog("")
McLaunchLog("~ 基础参数 ~") McLaunchLog("~ 基础参数 ~")
McLaunchLog("PCL 版本:" & VersionDisplayName & " (" & VersionCode & ")") McLaunchLog("PCL 版本:" & VersionDisplayName & " (" & VersionCode & ")")
McLaunchLog("游戏版本:" & McVersionCurrent.Version.ToString & "(识别为 1." & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & ")") McLaunchLog($"游戏版本:{McInstanceSelected.VersionDisplayName}({McInstanceSelected.Version.Vanilla},Drop {McInstanceSelected.Version.Drop}{If(McInstanceSelected.Version.Reliable, "", ",无法完全确定")})")
McLaunchLog("资源版本:" & McAssetsGetIndexName(McVersionCurrent)) McLaunchLog("资源版本:" & McAssetsGetIndexName(McInstanceSelected))
McLaunchLog("版本继承:" & If(McVersionCurrent.InheritVersion = "", "无", McVersionCurrent.InheritVersion)) McLaunchLog("版本继承:" & If(McInstanceSelected.InheritName = "", "无", McInstanceSelected.InheritName))
McLaunchLog("分配的内存:" & PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) & " GB(" & Math.Round(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB)") McLaunchLog("分配的内存:" & PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) & " GB(" & Math.Round(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB)")
McLaunchLog("MC 文件夹:" & PathMcFolder) McLaunchLog("MC 文件夹:" & McFolderSelected)
McLaunchLog("版本文件夹:" & McVersionCurrent.Path) McLaunchLog("版本文件夹:" & McInstanceSelected.PathVersion)
McLaunchLog("版本隔离:" & (McVersionCurrent.PathIndie = McVersionCurrent.Path)) McLaunchLog("版本隔离:" & (McInstanceSelected.PathIndie = McInstanceSelected.PathVersion))
McLaunchLog("HMCL 格式:" & McVersionCurrent.IsHmclFormatJson) McLaunchLog("HMCL 格式:" & McInstanceSelected.IsHmclFormatJson)
McLaunchLog("Java 信息:" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java")) McLaunchLog("Java 信息:" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
McLaunchLog("环境变量:" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置")) McLaunchLog("环境变量:" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置"))
McLaunchLog("Natives 文件夹:" & GetNativesFolder()) McLaunchLog("Natives 文件夹:" & GetNativesFolder())
@@ -2288,12 +2276,12 @@ IgnoreCustomSkin:
McLaunchLog("") McLaunchLog("")
'获取窗口标题 '获取窗口标题
Dim WindowTitle As String = Setup.Get("VersionArgumentTitle", Version:=McVersionCurrent) Dim WindowTitle As String = Setup.Get("VersionArgumentTitle", Instance:=McInstanceSelected)
If WindowTitle = "" Then WindowTitle = Setup.Get("LaunchArgumentTitle") If WindowTitle = "" Then WindowTitle = Setup.Get("LaunchArgumentTitle")
WindowTitle = ArgumentReplace(WindowTitle, ReplaceTime:=False) WindowTitle = ArgumentReplace(WindowTitle, ReplaceTime:=False)
'初始化等待 '初始化等待
Dim Watcher As New Watcher(Loader, McVersionCurrent, WindowTitle) Dim Watcher As New Watcher(Loader, McInstanceSelected, WindowTitle)
McLaunchWatcher = Watcher McLaunchWatcher = Watcher
'等待 '等待
File diff suppressed because it is too large Load Diff
@@ -1,7 +1,7 @@
Imports System.IO.Compression Imports System.IO.Compression
Public Module ModMod Public Module ModMod
Private Const LocalModCacheVersion As Integer = 8 Private Const LocalModCacheVersion As Integer = 10
Public Class McMod Public Class McMod
@@ -46,10 +46,7 @@ Public Module ModMod
''' </summary> ''' </summary>
Public ReadOnly Property State As McModState Public ReadOnly Property State As McModState
Get Get
Load() If Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
If Not IsFileAvailable Then
Return McModState.Unavailable
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
Return McModState.Disabled Return McModState.Disabled
Else Else
Return McModState.Fine Return McModState.Fine
@@ -59,7 +56,6 @@ Public Module ModMod
Public Enum McModState As Integer Public Enum McModState As Integer
Fine = 0 Fine = 0
Disabled = 1 Disabled = 1
Unavailable = 2
End Enum End Enum
#End Region #End Region
@@ -67,12 +63,17 @@ Public Module ModMod
#Region "信息项" #Region "信息项"
''' <summary> ''' <summary>
''' Mod 的名称。若不可用则为 ModID 或无扩展的文件名。 ''' 当任何信息在初始化后更新时触发。
''' </summary> ''' </summary>
Public Property Name As String Public Event OnUpdate(sender As McMod)
''' <summary>
''' Mod 的可读名称。
''' 可能为无扩展的文件名,但不会是 Nothing。
''' </summary>
Public Property DisplayName As String
Get Get
If _Name Is Nothing Then Load() If _Name Is Nothing Then _Name = CompFile?.DisplayName
If _Name Is Nothing Then _Name = _ModId
If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path) If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path)
Return _Name Return _Name
End Get End Get
@@ -87,12 +88,10 @@ Public Module ModMod
''' <summary> ''' <summary>
''' Mod 的描述信息。 ''' Mod 的描述信息。
''' 可能为 Nothing。
''' </summary> ''' </summary>
Public Property Description As String Public Property Description As String
Get Get
If _Description Is Nothing Then Load()
If _Description Is Nothing AndAlso FileUnavailableReason IsNot Nothing Then _Description = FileUnavailableReason.Message
'If _Description Is Nothing Then _Description = Path
Return _Description Return _Description
End Get End Get
Set(value As String) Set(value As String)
@@ -106,182 +105,33 @@ Public Module ModMod
Private _Description As String = Nothing Private _Description As String = Nothing
''' <summary> ''' <summary>
''' Mod 的版本,不保证符合版本格式规范。 ''' Mod 的版本。
''' 不保证符合版本格式规范,且可能为 Nothing。
''' </summary> ''' </summary>
Public Property Version As String Public Property Version As String
Get Get
If _Version Is Nothing Then Load() If _Version Is Nothing Then _Version = CompFile?.Version
Return _Version Return _Version
End Get End Get
Set(value As String) Set(value As String)
If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
If value?.ContainsF("version", True) Then value = "version" '需要修改的标识 If value IsNot Nothing AndAlso value.ContainsF("version", True) Then value = "version" '需要修改的标识
_Version = value _Version = value
End Set End Set
End Property End Property
Public _Version As String = Nothing Public _Version As String = Nothing
''' <summary>
''' 用于依赖检查的 ModID。
''' </summary>
Public Property ModId As String
Get
If _ModId Is Nothing Then Load()
Return _ModId
End Get
Set(value As String)
If value Is Nothing Then Return
value = RegexSeek(value, "[0-9a-zA-Z_-]+")
If value Is Nothing OrElse value.Count <= 1 OrElse Val(value).ToString = value Then Return
If value.ContainsF("name", True) OrElse value.ContainsF("modid", True) Then Return
If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
If _ModId Is Nothing Then _ModId = value
End Set
End Property
Private _ModId As String = Nothing
''' <summary>
''' 其他可能的 ModID。
''' </summary>
Public PossibleModId As New List(Of String)
''' <summary>
''' Mod 的主页。
''' </summary>
Public Property Url As String
Get
If _Url Is Nothing Then Load()
Return _Url
End Get
Set(value As String)
If _Url Is Nothing AndAlso value IsNot Nothing AndAlso value.StartsWithF("http") Then
_Url = value
End If
End Set
End Property
Private _Url As String = Nothing
''' <summary>
''' Mod 的作者列表。
''' </summary>
Public Property Authors As String
Get
If _Authors Is Nothing Then Load()
Return _Authors
End Get
Set(value As String)
If _Authors Is Nothing AndAlso Not String.IsNullOrWhiteSpace(value) Then
_Authors = value
End If
End Set
End Property
Private _Authors As String = Nothing
''' <summary>
''' 依赖项,其中包括了 Minecraft 的版本要求。格式为 ModID - VersionRequirement,若无版本要求则为 Nothing。
''' </summary>
Public ReadOnly Property Dependencies As Dictionary(Of String, String)
Get
Load()
Return _Dependencies
End Get
End Property
Private _Dependencies As New Dictionary(Of String, String)
Private Sub AddDependency(ModID As String, Optional VersionRequirement As String = Nothing)
'确保信息正确
If ModID Is Nothing OrElse ModID.Count < 2 Then Return
ModID = ModID.ToLower
If ModID = "name" OrElse Val(ModID).ToString = ModID Then Return '跳过 name 与纯数字 id
If VersionRequirement Is Nothing OrElse ((Not VersionRequirement.Contains(".")) AndAlso (Not VersionRequirement.Contains("-"))) OrElse VersionRequirement.Contains("$") Then
VersionRequirement = Nothing
Else
If (Not VersionRequirement.StartsWithF("[")) AndAlso (Not VersionRequirement.StartsWithF("(")) AndAlso (Not VersionRequirement.EndsWithF("]")) AndAlso (Not VersionRequirement.EndsWithF(")")) Then VersionRequirement = "[" & VersionRequirement & ",)"
End If
'向依赖项中添加
If _Dependencies.ContainsKey(ModID) Then
If _Dependencies(ModID) Is Nothing Then _Dependencies(ModID) = VersionRequirement
Else
_Dependencies.Add(ModID, VersionRequirement)
End If
End Sub
#End Region #End Region
#Region "加载步骤标记" #Region "从 JAR 获取信息"
'1. 进行文件可用性检查
' 成功:继续第二步。
' 失败:标记 FileUnavailableReason, 并停止后续加载。
''' <summary>
''' 是否已进行 Mod 文件的基础加载。(这包括第一步和第二步)
''' </summary>
Private IsLoaded As Boolean = False
''' <summary>
''' Mod 文件是否可被正常读取。
''' </summary>
Public ReadOnly Property IsFileAvailable As Boolean
Get
Load()
Return FileUnavailableReason Is Nothing
End Get
End Property
''' <summary>
''' Mod 文件出错的原因。若无错误,则为 Nothing。
''' </summary>
Public ReadOnly Property FileUnavailableReason As Exception
Get
Load()
Return _FileUnavailableReason
End Get
End Property
Private _FileUnavailableReason As Exception = Nothing
'2. 进行 .class 以外的信息获取
' 成功:标记 IsInfoWithoutClassAvailable。
' 失败:什么也不干。如果需要补充信息的话,检测到 IsInfoWithoutClassAvailable 为 False,会自动继续加载。
''' <summary>
''' 是否已在不获取 .class 文件的前提下完成了所需信息的加载。
''' </summary>
Private IsInfoWithoutClassAvailable As Boolean = False
'3. 尝试从 .class 文件中获取信息
' 成功:标记 IsInfoWithClassAvailable。
' 失败:什么也不干。
''' <summary>
''' 是否已进行 .class 文件的信息获取。
''' </summary>
Private IsInfoWithClassLoaded As Boolean = False
''' <summary>
''' 是否已在 .class 文件中完成了所需信息的加载。
''' </summary>
Private IsInfoWithClassAvailable As Boolean = False
#End Region
#Region "加载"
''' <summary> ''' <summary>
''' 初始化所有数据。 ''' 从 JAR 文件中获取 Mod 信息。
''' </summary> ''' </summary>
Private Sub Init() Public Sub LoadMetadataFromJar()
_Name = Nothing Static IsLoaded As Boolean = False
_Description = Nothing If IsLoaded Then Return
_Version = Nothing IsLoaded = True
_ModId = Nothing
PossibleModId = New List(Of String)
_Dependencies = New Dictionary(Of String, String)
IsLoaded = False
_FileUnavailableReason = Nothing
IsInfoWithClassLoaded = False
IsInfoWithClassAvailable = False
End Sub
''' <summary>
''' 进行文件可用性检查与 .class 以外的信息获取。
''' </summary>
Public Sub Load(Optional ForceReload As Boolean = False)
If IsLoaded AndAlso Not ForceReload Then Return
'初始化
Init()
Dim Jar As ZipArchive = Nothing Dim Jar As ZipArchive = Nothing
Try Try
'基础可用性检查、打开 Jar 文件 '基础可用性检查、打开 Jar 文件
@@ -289,24 +139,16 @@ Public Module ModMod
If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件(" & Path & ")") If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件(" & Path & ")")
Jar = New ZipArchive(New FileStream(Path, FileMode.Open)) Jar = New ZipArchive(New FileStream(Path, FileMode.Open))
'信息获取 '信息获取
LookupMetadata(Jar) LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException Catch ex As UnauthorizedAccessException
Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer) Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer)
_FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL", ex)
Catch ex As Exception Catch ex As Exception
Log(ex, "Mod 文件无法打开(" & Path & ")", LogLevel.Developer) Log(ex, "Mod 文件无法打开(" & Path & ")", LogLevel.Developer)
_FileUnavailableReason = ex
Finally Finally
If Jar IsNot Nothing Then Jar.Dispose() If Jar IsNot Nothing Then Jar.Dispose()
End Try End Try
'完成标记
IsLoaded = True
End Sub End Sub
Private Sub LoadMetadataFromJar(Jar As ZipArchive)
''' <summary>
''' 从 jar 文件中获取 Mod 信息。
''' </summary>
Private Sub LookupMetadata(Jar As ZipArchive)
#Region "尝试使用 mcmod.info" #Region "尝试使用 mcmod.info"
Try Try
@@ -327,45 +169,9 @@ Public Module ModMod
InfoObject = JsonObject("modList")(0) InfoObject = JsonObject("modList")(0)
End If End If
'从文件中获取 Mod 信息项 '从文件中获取 Mod 信息项
Name = InfoObject("name") DisplayName = InfoObject("name")
Description = InfoObject("description") Description = InfoObject("description")
Version = InfoObject("version") Version = InfoObject("version")
Url = InfoObject("url")
ModId = InfoObject("modid")
Dim AuthorJson As JArray = InfoObject("authorList")
If AuthorJson IsNot Nothing Then
Dim Author As New List(Of String)
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Any Then Authors = Join(Author, ", ")
End If
Dim Reqs As JArray = InfoObject("requiredMods")
If Reqs IsNot Nothing Then
For Each Token As String In Reqs
If Not String.IsNullOrEmpty(Token) Then
Token = Token.Substring(Token.IndexOfF(":") + 1)
If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else
AddDependency(Token)
End If
End If
Next
End If
Reqs = InfoObject("dependancies")
If Reqs IsNot Nothing Then
For Each Token As String In Reqs
If Not String.IsNullOrEmpty(Token) Then
Token = Token.Substring(Token.IndexOfF(":") + 1)
If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else
AddDependency(Token)
End If
End If
Next
End If
Catch ex As Exception Catch ex As Exception
Log(ex, "读取 mcmod.info 时出现未知错误(" & Path & ")", LogLevel.Developer) Log(ex, "读取 mcmod.info 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try End Try
@@ -383,37 +189,9 @@ Public Module ModMod
Dim FabricObject As JObject = GetJson(FabricText) Dim FabricObject As JObject = GetJson(FabricText)
GotFabric: GotFabric:
'从文件中获取 Mod 信息项 '从文件中获取 Mod 信息项
If FabricObject.ContainsKey("name") Then Name = FabricObject("name") If FabricObject.ContainsKey("name") Then DisplayName = FabricObject("name")
If FabricObject.ContainsKey("version") Then Version = FabricObject("version") If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
If FabricObject.ContainsKey("description") Then Description = FabricObject("description") If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
If FabricObject.ContainsKey("id") Then ModId = FabricObject("id")
If FabricObject.ContainsKey("contact") Then Url = If(FabricObject("contact")("homepage"), "")
Dim AuthorJson As JArray = FabricObject("authors")
If AuthorJson IsNot Nothing Then
Dim Author As New List(Of String)
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Any Then Authors = Join(Author, ", ")
End If
'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
' '添加 Minecraft 依赖
' Dim DepMinecraft As String = If(If(FabricObject("acceptedMinecraftVersions") IsNot Nothing, FabricObject("acceptedMinecraftVersions")("value"), ""), "")
' If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
' '添加其他依赖
' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "")
' If Deps <> "" Then
' For Each Dep In Deps.Split(";")
' If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
' If Dep.Contains("@") Then
' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
' Else
' AddDependency(Dep)
' End If
' Next
' End If
'End If
'加载成功 '加载成功
GoTo Finished GoTo Finished
Catch ex As Exception Catch ex As Exception
@@ -500,22 +278,9 @@ GotFabric:
End If End If
Next Next
If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try
ModId = ModEntry("modId") If ModEntry.ContainsKey("displayName") Then DisplayName = ModEntry("displayName")
If _ModId Is Nothing Then Exit Try '设置了无效的 ModID
If ModEntry.ContainsKey("displayName") Then Name = ModEntry("displayName")
If ModEntry.ContainsKey("description") Then Description = ModEntry("description") If ModEntry.ContainsKey("description") Then Description = ModEntry("description")
If ModEntry.ContainsKey("version") Then Version = ModEntry("version") If ModEntry.ContainsKey("version") Then Version = ModEntry("version")
If TomlData(0).Value.ContainsKey("displayURL") Then Url = TomlData(0).Value("displayURL")
If TomlData(0).Value.ContainsKey("authors") Then Authors = TomlData(0).Value("authors")
For Each TomlSubData In TomlData
If TomlSubData.Key.ToLower = $"dependencies.{ModId.ToLower}" Then
Dim DepEntry As Dictionary(Of String, Object) = TomlSubData.Value
If DepEntry.ContainsKey("modId") AndAlso DepEntry.ContainsKey("mandatory") AndAlso DepEntry("mandatory") AndAlso
DepEntry.ContainsKey("side") AndAlso Not DepEntry("side").ToString.ToLower = "server" Then
AddDependency(DepEntry("modId"), If(DepEntry.ContainsKey("versionRange"), DepEntry("versionRange"), Nothing))
End If
End If
Next
'加载成功 '加载成功
GoTo Finished GoTo Finished
Catch ex As Exception Catch ex As Exception
@@ -551,41 +316,16 @@ GotFabric:
Exit Try Exit Try
Got: Got:
'从文件中获取 Mod 信息项 '从文件中获取 Mod 信息项
If FmlObject.ContainsKey("useMetadata") AndAlso If(FmlObject("useMetadata")("value"), "").ToString.ToLower = "true" Then If FmlObject.ContainsKey("name") Then DisplayName = FmlObject("name")("value")
'要求使用 mcmod.info 中的信息
Dim value As String = FmlObject("modid")("value")
If value Is Nothing Then Exit Try
value = RegexSeek(value.ToLower, "[0-9a-z_]+")
If value IsNot Nothing AndAlso value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
End If
Exit Try
End If
If FmlObject.ContainsKey("name") Then Name = FmlObject("name")("value")
If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value") If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value")
If FmlObject.ContainsKey("modid") Then ModId = FmlObject("modid")("value") '加载成功
If (Not FmlObject.ContainsKey("serverSideOnly")) OrElse FmlObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then GoTo Finished
'添加 Minecraft 依赖
Dim DepMinecraft As String = If(If(FmlObject("acceptedMinecraftVersions") IsNot Nothing, FmlObject("acceptedMinecraftVersions")("value"), ""), "")
If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
'添加其他依赖
Dim Deps As String = If(If(FmlObject("dependencies") IsNot Nothing, FmlObject("dependencies")("value"), ""), "")
If Deps <> "" Then
For Each Dep In Deps.Split(";")
If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
If Dep.Contains("@") Then
AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
Else
AddDependency(Dep)
End If
Next
End If
End If
Catch ex As Exception Catch ex As Exception
Log(ex, "读取 fml_cache_annotation.json 时出现未知错误(" & Path & ")", LogLevel.Developer) Log(ex, "读取 fml_cache_annotation.json 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try End Try
#End Region #End Region
Return '没能成功获取任何信息
Finished: Finished:
#Region "将 Version 代号转换为 META-INF 中的版本" #Region "将 Version 代号转换为 META-INF 中的版本"
If _Version = "version" Then If _Version = "version" Then
@@ -606,6 +346,7 @@ Finished:
End If End If
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
#End Region #End Region
RaiseEvent OnUpdate(Me)
End Sub End Sub
@@ -613,11 +354,6 @@ Finished:
#Region "网络信息" #Region "网络信息"
''' <summary>
''' 当任何网络信息更新时触发。
''' </summary>
Public Event OnCompUpdate(sender As McMod)
''' <summary> ''' <summary>
''' 该 Mod 关联的网络项目。 ''' 该 Mod 关联的网络项目。
''' </summary> ''' </summary>
@@ -627,7 +363,7 @@ Finished:
End Get End Get
Set(value As CompProject) Set(value As CompProject)
_Comp = value _Comp = value
RaiseEvent OnCompUpdate(Me) RaiseEvent OnUpdate(Me)
End Set End Set
End Property End Property
Private _Comp As CompProject Private _Comp As CompProject
@@ -646,7 +382,7 @@ Finished:
End Get End Get
Set(value As CompFile) Set(value As CompFile)
_UpdateFile = value _UpdateFile = value
RaiseEvent OnCompUpdate(Me) RaiseEvent OnUpdate(Me)
End Set End Set
End Property End Property
Private _UpdateFile As CompFile Private _UpdateFile As CompFile
@@ -688,7 +424,7 @@ Finished:
''' </summary> ''' </summary>
Public ReadOnly Property CanUpdate As Boolean Public ReadOnly Property CanUpdate As Boolean
Get Get
Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso Not Setup.Get("VersionAdvanceDisableModUpdate", Version:=PageVersionLeft.Version) AndAlso ChangelogUrls.Any() Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso Not Setup.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso ChangelogUrls.Any()
End Get End Get
End Property End Property
@@ -787,10 +523,10 @@ Finished:
#End Region #End Region
''' <summary> ''' <summary>
''' 是否可能为前置 Mod。 ''' 是否可能为前置 Mod。目前非常不准确。
''' </summary> ''' </summary>
Public Function IsPresetMod() As Boolean Public Function IsPresetMod() As Boolean
Return Not Dependencies.Any() AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib")) Return DisplayName IsNot Nothing AndAlso (DisplayName.ToLower.Contains("core") OrElse DisplayName.ToLower.Contains("lib"))
End Function End Function
''' <summary> ''' <summary>
@@ -811,21 +547,21 @@ Finished:
Public McModLoader As New LoaderTask(Of String, List(Of McMod))("Mod List Loader", AddressOf McModLoad) Public McModLoader As New LoaderTask(Of String, List(Of McMod))("Mod List Loader", AddressOf McModLoad)
Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of McMod))) Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of McMod)))
Try Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = False) RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.ShowProgress = False)
'等待 Mod 更新完成 '等待 Mod 更新完成
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then If PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表:" & Loader.Input) Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表:" & Loader.Input)
Try Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod") RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input) Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
If Loader.IsAborted Then Return If Loader.IsAborted Then Return
Thread.Sleep(100) Thread.Sleep(100)
Loop Loop
Finally Finally
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表") RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在加载 Mod 列表")
End Try End Try
FrmVersionMod.LoaderRun(LoaderFolderRunType.UpdateOnly) FrmInstanceMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
End If End If
'获取 Mod 文件夹下的可用文件列表 '获取 Mod 文件夹下的可用文件列表
@@ -835,9 +571,9 @@ Finished:
For Each File As FileInfo In EnumerateFiles(Loader.Input) For Each File As FileInfo In EnumerateFiles(Loader.Input)
If File.DirectoryName.ToLower & "\" <> RawName Then If File.DirectoryName.ToLower & "\" <> RawName Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod '仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod
If Not (PageVersionLeft.Version IsNot Nothing AndAlso PageVersionLeft.Version.Version.HasForge AndAlso If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
PageVersionLeft.Version.Version.McCodeMain < 13 AndAlso PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
File.Directory.Name = $"1.{PageVersionLeft.Version.Version.McCodeMain}.{PageVersionLeft.Version.Version.McCodeSub}") Then File.Directory.Name = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then
Continue For Continue For
End If End If
End If End If
@@ -845,10 +581,6 @@ Finished:
Next Next
End If End If
'确定是否显示进度
Loader.Progress = 0.05
If ModFileList.Count > 50 Then RunInUi(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = True)
'获取本地文件缓存 '获取本地文件缓存
Dim CachePath As String = PathTemp & "Cache\LocalMod.json" Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
Dim Cache As New JObject Dim Cache As New JObject
@@ -869,13 +601,9 @@ Finished:
'加载 Mod 列表 '加载 Mod 列表
Dim ModList As New List(Of McMod) Dim ModList As New List(Of McMod)
Dim ModUpdateList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList For Each ModFile As FileInfo In ModFileList
Loader.Progress += 0.94 / ModFileList.Count
If Loader.IsAborted Then Return If Loader.IsAborted Then Return
'加载 McMod 对象
Dim ModEntry As New McMod(ModFile.FullName) Dim ModEntry As New McMod(ModFile.FullName)
ModEntry.Load()
Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName) Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName)
If DumpMod IsNot Nothing Then If DumpMod IsNot Nothing Then
Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry) Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry)
@@ -884,31 +612,16 @@ Finished:
Continue For Continue For
Else Else
ModList.Remove(DisabledMod) ModList.Remove(DisabledMod)
ModUpdateList.Remove(DisabledMod)
End If End If
End If End If
ModList.Add(ModEntry) ModList.Add(ModEntry)
'读取 Comp 缓存
If ModEntry.State = McMod.McModState.Unavailable Then Continue For
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If
ModUpdateList.Add(ModEntry)
Next Next
Loader.Progress = 0.99 Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
Log($"[Mod] 共有 {ModList.Count} 个 Mod,其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息,{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息")
'排序 '排序
ModList = ModList.Sort( ModList = ModList.SortByComparison(
Function(Left As McMod, Right As McMod) As Boolean Function(Left, Right) As Boolean
If (Left.State = McMod.McModState.Unavailable) <> (Right.State = McMod.McModState.Unavailable) Then
Return Left.State = McMod.McModState.Unavailable
Else
Return Not Right.FileName.CompareTo(Left.FileName) Return Not Right.FileName.CompareTo(Left.FileName)
End If
End Function) End Function)
'回设 '回设
@@ -916,10 +629,8 @@ Finished:
Loader.Output = ModList Loader.Output = ModList
'开始联网加载 '开始联网加载
If ModUpdateList.Any() Then
'TODO: 添加信息获取中提示 'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True) McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModList, Cache), IsForceRestart:=True)
End If
Catch ex As Exception Catch ex As Exception
Log(ex, "Mod 列表加载失败", LogLevel.Debug) Log(ex, "Mod 列表加载失败", LogLevel.Debug)
@@ -929,15 +640,31 @@ Finished:
'联网加载 Mod 详情 '联网加载 Mod 详情
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad) 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)) Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key Dim Mods As New List(Of McMod)
Dim Cache As JObject = Loader.Input.Value Dim Cache As JObject = Loader.Input.Value
'读取 Comp 缓存,获取需要更新的 Mod 列表
For Each ModEntry As McMod In Loader.Input.Key
If Loader.IsAborted Then Return
Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If
Mods.Add(ModEntry)
Next
Log($"[Mod] 有 {Mods.Where(Function(m) m.Comp Is Nothing).Count} 个 Mod 需要联网获取信息,{Mods.Where(Function(m) m.Comp IsNot Nothing).Count} 个 Mod 需要更新信息")
If Not Mods.Any Then
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForEach(Sub(m) m.LoadMetadataFromJar()) '从 JAR 中获取缺失的版本信息(下面有另一个分支)
Return
End If
'获取作为检查目标的加载器和版本 '获取作为检查目标的加载器和版本
'此处不应向下扩展检查的 MC 小版本,例如 Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2 '此处不应向下扩展检查的 MC 小版本,例如 Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version Dim TargetMcVersion As McVersion = PageInstanceLeft.Instance.Version
Dim ModLoaders = GetTargetModLoaders() Dim ModLoaders = GetTargetModLoaders()
Dim McVersion = TargetMcVersion.McName Dim VanillaVersion = TargetMcVersion.VanillaName
'开始网络获取 '开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}") Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{VanillaVersion}")
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim CurrentTaskThread As Thread = Thread.CurrentThread Dim CurrentTaskThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息 '从 Modrinth 获取信息
@@ -961,7 +688,11 @@ Finished:
ModrinthMapping(ProjectId).Add(Entry) ModrinthMapping(ProjectId).Add(Entry)
'记录对应的 CompFile '记录对应的 CompFile
Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod) Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then
Entry.CompFile = File
Else
Entry.CompFile.Version = File.Version '使用来自 Modrinth 的版本号
End If
Next Next
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息") Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
@@ -979,7 +710,7 @@ Finished:
'步骤 4:获取更新信息 '步骤 4:获取更新信息
Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post, Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"", $"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json") ""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
For Each Entry In Mods For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod) Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
@@ -988,11 +719,11 @@ Finished:
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件 '设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并 If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}") Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}")
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源 UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件 Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换 ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}"} Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}"}
Entry.UpdateFile = UpdateFile Entry.UpdateFile = UpdateFile
End If End If
Next Next
@@ -1059,9 +790,9 @@ Finished:
For Each IndexEntry In ProjectJson("latestFilesIndexes") For Each IndexEntry In ProjectJson("latestFilesIndexes")
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配 If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion") Dim IndexVersion As String = IndexEntry("gameVersion")
If IndexVersion <> McVersion Then Continue For 'MC 版本匹配 If IndexVersion <> VanillaVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件 '由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本 If NewestVersion IsNot Nothing AndAlso CompareVersion(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then If NewestVersion <> IndexVersion Then
NewestVersion = IndexVersion NewestVersion = IndexVersion
NewestFileIds.Clear() NewestFileIds.Clear()
@@ -1111,6 +842,8 @@ Finished:
EndedThreadCount += 1 EndedThreadCount += 1
End Try End Try
End Sub, "Mod List Detail Loader CurseForge") End Sub, "Mod List Detail Loader CurseForge")
'从 JAR 中获取缺失的版本信息(上面有另一个分支)
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForEach(Sub(m) m.LoadMetadataFromJar())
'等待线程结束 '等待线程结束
Do Until EndedThreadCount = 2 Do Until EndedThreadCount = 2
Thread.Sleep(10) Thread.Sleep(10)
@@ -1122,155 +855,25 @@ Finished:
If Not Mods.Any() Then Return If Not Mods.Any() Then Return
For Each Entry In Mods For Each Entry In Mods
Entry.CompLoaded = Not IsFailed Entry.CompLoaded = Not IsFailed
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson() Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = Entry.ToJson()
Next Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏 '刷新边栏
If Loader.IsAborted Then Return If Loader.IsAborted Then Return
If FrmVersionMod?.Filter = PageVersionMod.FilterType.CanUpdate Then If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmVersionMod?.RefreshUI()) '同步 “可更新” 列表 (#4677) RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else Else
RunInUi(Sub() FrmVersionMod?.RefreshBars()) RunInUi(Sub() FrmInstanceMod?.RefreshBars())
End If End If
End Sub End Sub
Public Function GetTargetModLoaders() As List(Of CompModLoaderType) Public Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType) Dim ModLoaders As New List(Of CompModLoaderType)
If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge) If PageInstanceLeft.Instance.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge) If PageInstanceLeft.Instance.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageVersionLeft.Version.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric) If PageInstanceLeft.Instance.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If PageVersionLeft.Version.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader) If PageInstanceLeft.Instance.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt}) If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Return ModLoaders Return ModLoaders
End Function End Function
#If DEBUG Then
''' <summary>
''' 检查 Mod 列表中存在的错误,返回错误信息的集合。
''' </summary>
Public Function McModCheck(Version As McVersion, Mods As List(Of McMod)) As List(Of String)
Dim Result As New List(Of String)
'令所有 Mod 进行基础检查,并归纳需要检查的 Mod
Dim CurrentModList As New List(Of McMod)
For Each ModEntity In Mods
If Not ModEntity.IsFileAvailable Then
Result.Add("无法读取的 Mod 文件。" & vbCrLf & " - " & ModEntity.Path)
Continue For
End If
If ModEntity.State = McMod.McModState.Fine AndAlso ModEntity.ModId IsNot Nothing Then CurrentModList.Add(ModEntity)
Next
'添加默认依赖
Dim CurrentDependencies As New Dictionary(Of String, String()) '{DependencyVersion, Path}
If Version.State = McVersionState.Forge Then CurrentDependencies.Add("forge", {Version.Version.ForgeVersion, "Forge"})
CurrentDependencies.Add("minecraft", {Version.Version.McName, "Minecraft"})
'检查重复的 Mod,并添加对应的依赖
For Each ModEntity In CurrentModList
For Each PossibleModId In ModEntity.PossibleModId
If CurrentDependencies.ContainsKey(PossibleModId) Then
If CurrentDependencies(PossibleModId)(2) = 1 Then
Result.Add("重复添加了相同的 Mod,请尝试删除其中一个(ModID:" & PossibleModId & ")。" & vbCrLf &
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1))
Else
Log("[Minecraft] 由于可能有多个 ModID,跳过疑似的重复项(ModID:" & PossibleModId & ")。" & vbCrLf &
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1), LogLevel.Developer)
End If
Else
CurrentDependencies.Add(PossibleModId, {ModEntity.Version, ModEntity.FileName, ModEntity.PossibleModId.Count})
End If
Next
Next
'检查依赖
For Each ModEntity In CurrentModList
Try
For Each Dependency In ModEntity.Dependencies
Dim ReqId As String = Dependency.Key
If ReqId.Count < 2 Then Continue For '确保正常
If ReqId = ModEntity.ModId Then Continue For '跳过自体引用
If ReqId = "forgemultipartcbe" Then Continue For '跳过莫名其妙的引用
If Dependency.Value IsNot Nothing Then
'获取分段后的详细版本信息
Dim ReqVersion As String = Dependency.Value
Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWithF("[")
Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWithF("]")
Dim ReqVersionHead As String
Dim ReqVersionTail As String
If ReqVersion.Contains(",") Then
ReqVersionHead = ReqVersion.Split(",")(0).Trim("([ ".ToCharArray())
ReqVersionTail = ReqVersion.Split(",")(1).Trim("]) ".ToCharArray())
Else
ReqVersionHead = ReqVersion.Trim("([]) ".ToCharArray())
ReqVersionTail = ReqVersionHead
If ReqId = "minecraft" AndAlso ReqVersionHead.Split(".").Count = 2 Then
ReqVersionTail = ReqVersionHead.Split(".")(0) & "." & (Val(ReqVersionHead.Split(".")(1)) + 1)
ReqVersionTailCanEqual = False
End If
End If
If ReqVersionHead.StartsWithF("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOfF("-") + 1)
If ReqVersionTail.StartsWithF("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOfF("-") + 1)
'获取报错描述文本
Dim VersionRequire As String
If ReqVersionHead = ReqVersionTail Then
VersionRequire = "应为 " & ReqVersionHead
ElseIf ReqVersionHead.Contains(".") AndAlso ReqVersionTail.Contains(".") Then
VersionRequire = $"应为 {ReqVersionHead} 至 {ReqVersionTail}"
ElseIf ReqVersionHead.Contains(".") Then
If ReqVersionHeadCanEqual Then
VersionRequire = "最低应为 " & ReqVersionHead
Else
VersionRequire = "应高于 " & ReqVersionHead
End If
ElseIf ReqVersionTail.Contains(".") Then
If ReqVersionTailCanEqual Then
VersionRequire = "最高应为 " & ReqVersionHead
Else
VersionRequire = "应低于 " & ReqVersionHead
End If
Else
VersionRequire = ""
End If
'检查前置 Mod 是否存在,并获取其版本
If Not CurrentDependencies.ContainsKey(ReqId) Then
Result.Add($"缺少前置 Mod:{ReqId}{If(VersionRequire = "", "", ",其版本" & VersionRequire)}。{vbCrLf} - {ModEntity.FileName}")
Continue For
End If
Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0")
If CurrentVersion.StartsWithF("1.") AndAlso CurrentVersion.Contains("-") Then CurrentVersion = CurrentVersion.Substring(CurrentVersion.LastIndexOfF("-") + 1)
'对比前置 Mod 头部版本
If ReqVersionHead.Contains(".") Then
If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过低,其版本" & VersionRequire & ",而当前版本为 " & CurrentVersion & "。" & vbCrLf &
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置:{CurrentDependencies(ReqId)(1)}", ""))
Continue For
End If
End If
'对比前置 Mod 尾部版本
If ReqVersionTail.Contains(".") Then
If VersionSortInteger(CurrentVersion, ReqVersionTail) > If(ReqVersionTailCanEqual, 0, -1) Then
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过高,其版本" & VersionRequire & ",而当前版本为 " & CurrentVersion & "。" & vbCrLf &
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置:{CurrentDependencies(ReqId)(1)}", ""))
Continue For
End If
End If
Else
If Not CurrentDependencies.ContainsKey(Dependency.Key) Then
Result.Add($"缺少前置 Mod:{Dependency.Key}。{vbCrLf} - {ModEntity.FileName}")
Continue For
End If
End If
Next
Catch ex As Exception
Result.Add($"检查 Mod 时出错:{ex.GetBrief()}{vbCrLf} - {ModEntity.FileName}")
Log(ex, "检查 Mod 时出错")
End Try
Next
If Not Result.Any() Then
Log("[Minecraft] Mod 检查未发现异常")
Else
Log($"[Minecraft] Mod 检查异常结果:{vbCrLf}{Join(Result, vbCrLf)}")
End If
Return Result
End Function
#End If
End Module End Module
@@ -24,13 +24,13 @@ Public Module ModModpack
''' 必须在工作线程执行。 ''' 必须在工作线程执行。
''' </summary> ''' </summary>
''' <exception cref="CancelledException" /> ''' <exception cref="CancelledException" />
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String) Public Function ModpackInstall(File As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Log("[ModPack] 整合包安装请求:" & If(File, "null")) Log("[ModPack] 整合包安装请求:" & If(File, "null"))
Dim Archive As ZipArchive = Nothing Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = "" Dim ArchiveBaseFolder As String = ""
Try Try
'字符校验 '字符校验
Dim TargetFolder As String = $"{PathMcFolder}versions\{VersionName}\" Dim TargetFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号:" & TargetFolder, HintType.Red) : Throw New CancelledException If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号:" & TargetFolder, HintType.Red) : Throw New CancelledException
'获取整合包种类与关键 Json '获取整合包种类与关键 Json
Dim PackType As Integer = -1 Dim PackType As Integer = -1
@@ -84,7 +84,7 @@ Public Module ModModpack
Select Case PackType Select Case PackType
Case 0 Case 0
Log("[ModPack] 整合包种类:CurseForge") Log("[ModPack] 整合包种类:CurseForge")
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo) Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 1 Case 1
Log("[ModPack] 整合包种类:HMCL") Log("[ModPack] 整合包种类:HMCL")
Return InstallPackHMCL(File, Archive, ArchiveBaseFolder) Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
@@ -93,10 +93,10 @@ Public Module ModModpack
Return InstallPackMMC(File, Archive, ArchiveBaseFolder) Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
Case 3 Case 3
Log("[ModPack] 整合包种类:MCBBS") Log("[ModPack] 整合包种类:MCBBS")
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName) Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, InstanceName)
Case 4 Case 4
Log("[ModPack] 整合包种类:Modrinth") Log("[ModPack] 整合包种类:Modrinth")
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo) Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 9 Case 9
Log("[ModPack] 整合包种类:带启动器的压缩包") Log("[ModPack] 整合包种类:带启动器的压缩包")
Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder) Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
@@ -180,7 +180,7 @@ Retry:
'CurseForge 'CurseForge
Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String) Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
@@ -192,12 +192,12 @@ Retry:
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息") If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息")
'获取版本名 '获取版本名
If VersionName Is Nothing Then If InstanceName Is Nothing Then
VersionName = If(Json("name"), "") InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
End If End If
'获取 Mod API 版本信息 '获取 Mod API 版本信息
@@ -234,7 +234,7 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613 InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
$"{PathMcFolder}versions\{VersionName}", $"{McFolderSelected}versions\{InstanceName}",
Task, 0.4) Task, 0.4)
End Sub) With { End Sub) With {
.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s .ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
@@ -278,7 +278,7 @@ Retry:
If ModJson("modules").Any Then 'modules 可能返回 null(#1006) If ModJson("modules").Any Then 'modules 可能返回 null(#1006)
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
ModJson?("FileName")?.ToString?.EndsWithF(".jar", True) Then ModJson?("FileName")?.ToString.EndsWithF(".jar", True) Then
TargetFolder = "mods" : Type = CompType.Mod TargetFolder = "mods" : Type = CompType.Mod
ElseIf ModuleNames.Contains("pack.mcmeta") Then ElseIf ModuleNames.Contains("pack.mcmeta") Then
TargetFolder = "resourcepacks" : Type = CompType.ResourcePack TargetFolder = "resourcepacks" : Type = CompType.ResourcePack
@@ -292,7 +292,7 @@ Retry:
Dim File As New CompFile(ModJson, Type) Dim File As New CompFile(ModJson, Type)
If Not File.Available Then Continue For If Not File.Available Then Continue For
'实际的添加 '实际的添加
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{TargetFolder}\")) FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\"))
Task.Progress += 1 / (1 + ModList.Count) Task.Progress += 1 / (1 + ModList.Count)
Next Next
Task.Output = FileList.Values.ToList Task.Output = FileList.Values.ToList
@@ -306,8 +306,8 @@ Retry:
'构造加载器 '构造加载器
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .NewInstanceName = InstanceName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("minecraft")("version").ToString, .MinecraftName = Json("minecraft")("version").ToString,
.ForgeVersion = ForgeVersion, .ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion, .NeoForgeVersion = NeoForgeVersion,
@@ -321,7 +321,7 @@ Retry:
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件", Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String)) Sub(Task As LoaderTask(Of String, String))
'设置图标 '设置图标
Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\" Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True) File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png") WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -342,7 +342,7 @@ Retry:
End Sub) With {.ProgressWeight = 0.1, .Show = False}) End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查 '重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " " Dim LoaderName As String = "CurseForge 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Red) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New CancelledException
@@ -350,7 +350,7 @@ Retry:
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -358,7 +358,7 @@ Retry:
End Function End Function
'Modrinth 'Modrinth
Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String) Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
@@ -392,12 +392,12 @@ Retry:
End Select End Select
Next Next
'获取版本名 '获取版本名
If VersionName Is Nothing Then If InstanceName Is Nothing Then
VersionName = If(Json("name"), "") InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
End If End If
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
@@ -407,11 +407,11 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides", InstallTemp & ArchiveBaseFolder & "overrides",
PathMcFolder & "versions\" & VersionName, McFolderSelected & "versions\" & InstanceName,
Task, 0.4) Task, 0.4)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "client-overrides", InstallTemp & ArchiveBaseFolder & "client-overrides",
PathMcFolder & "versions\" & VersionName, McFolderSelected & "versions\" & InstanceName,
Task, 0.1) Task, 0.1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表 '获取下载文件列表
@@ -433,8 +433,8 @@ Retry:
Dim Urls = File("downloads").SelectMany(Function(t) CompFile.HandleCurseForgeDownloadUrls(t.ToString)).ToList Dim Urls = File("downloads").SelectMany(Function(t) CompFile.HandleCurseForgeDownloadUrls(t.ToString)).ToList
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList) Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = Urls.Distinct.ToList() Urls = Urls.Distinct.ToList()
Dim TargetPath As String = $"{PathMcFolder}versions\{VersionName}\{File("path")}" Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{PathMcFolder}versions\{VersionName}\", True) Then If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹,请向整合包作者反馈此问题!" & vbCrLf & "错误的文件:" & TargetPath, "文件路径校验失败", IsWarn:=True) MyMsgBox($"整合包的文件路径超出了版本文件夹,请向整合包作者反馈此问题!" & vbCrLf & "错误的文件:" & TargetPath, "文件路径校验失败", IsWarn:=True)
Throw New CancelledException Throw New CancelledException
End If End If
@@ -447,8 +447,8 @@ Retry:
'构造加载器 '构造加载器
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .NewInstanceName = InstanceName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = MinecraftVersion, .MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion, .ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion, .NeoForgeVersion = NeoForgeVersion,
@@ -462,7 +462,7 @@ Retry:
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件", Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String)) Sub(Task As LoaderTask(Of String, String))
'设置图标 '设置图标
Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\" Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True) File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png") WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -483,7 +483,7 @@ Retry:
End Sub) With {.ProgressWeight = 0.1, .Show = False}) End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查 '重复任务检查
Dim LoaderName As String = $"Modrinth 整合包安装:{VersionName} " Dim LoaderName As String = $"Modrinth 整合包安装:{InstanceName} "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Red) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New CancelledException
@@ -491,7 +491,7 @@ Retry:
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -508,11 +508,11 @@ Retry:
Throw New Exception("HMCL 整合包安装信息存在问题", ex) Throw New Exception("HMCL 整合包安装信息存在问题", ex)
End Try End Try
'获取版本名 '获取版本名
Dim VersionName As String = If(Json("name"), "") Dim InstanceName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
@@ -521,14 +521,14 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "minecraft", InstallTemp & ArchiveBaseFolder & "minecraft",
PathMcFolder & "versions\" & VersionName, McFolderSelected & "versions\" & InstanceName,
Task, 0.4) Task, 0.4)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造游戏本体安装加载器 '构造游戏本体安装加载器
If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息,无法安装!") If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息,无法安装!")
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .NewInstanceName = InstanceName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("gameVersion").ToString .MinecraftName = Json("gameVersion").ToString
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
@@ -538,14 +538,14 @@ Retry:
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)} New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}
} }
'重复任务检查 '重复任务检查
Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " " Dim LoaderName As String = "HMCL 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Red) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New CancelledException
End If End If
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -563,21 +563,21 @@ Retry:
Throw New Exception("MMC 整合包安装信息存在问题", ex) Throw New Exception("MMC 整合包安装信息存在问题", ex)
End Try End Try
'获取版本名 '获取版本名
Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "") Dim InstanceName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini" Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer)) Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & ".minecraft", InstallTemp & ArchiveBaseFolder & ".minecraft",
PathMcFolder & "versions\" & VersionName, McFolderSelected & "versions\" & InstanceName,
Task, 0.4) Task, 0.4)
'读取 MMC 设置文件(#2655) '读取 MMC 设置文件(#2655)
Try Try
@@ -616,7 +616,7 @@ Retry:
If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True) WriteIni(SetupFile, "LogoCustom", True)
WriteIni(SetupFile, "Logo", "PCL\Logo.png") WriteIni(SetupFile, "Logo", "PCL\Logo.png")
CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{PathMcFolder}versions\{VersionName}\PCL\Logo.png") CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png")
Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)") Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)")
End If End If
'JVM 参数 'JVM 参数
@@ -638,7 +638,7 @@ Retry:
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造版本安装请求 '构造版本安装请求
If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息,无法安装!") If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息,无法安装!")
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"} Dim Request As New McInstallRequest With {.NewInstanceName = InstanceName, .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\"}
For Each Component As JObject In PackJson("components") For Each Component As JObject In PackJson("components")
If Not Component.ContainsKey("uid") Then Continue For If Not Component.ContainsKey("uid") Then Continue For
Select Case Component("uid").ToString Select Case Component("uid").ToString
@@ -665,7 +665,7 @@ Retry:
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}) Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
'重复任务检查 '重复任务检查
Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " " Dim LoaderName As String = "MMC 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Red) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New CancelledException
@@ -673,7 +673,7 @@ Retry:
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -682,7 +682,7 @@ Retry:
'MCBBS 'MCBBS
Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing) As LoaderCombo(Of String) Optional InstanceName As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
@@ -692,23 +692,23 @@ Retry:
Throw New Exception("MCBBS 整合包安装信息存在问题", ex) Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
End Try End Try
'获取版本名 '获取版本名
If VersionName Is Nothing Then If InstanceName Is Nothing Then
VersionName = If(Json("name"), "") InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
End If End If
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini" Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer)) Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides", InstallTemp & ArchiveBaseFolder & "overrides",
PathMcFolder & "versions\" & VersionName, McFolderSelected & "versions\" & InstanceName,
Task, 0.4) Task, 0.4)
'JVM 参数 'JVM 参数
If Json("launchInfo") IsNot Nothing Then If Json("launchInfo") IsNot Nothing Then
@@ -729,8 +729,8 @@ Retry:
Throw New CancelledException Throw New CancelledException
End If End If
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .NewInstanceName = InstanceName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Addons("game"), .MinecraftName = Addons("game"),
.OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing), .OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing), .ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
@@ -744,7 +744,7 @@ Retry:
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}) Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
'重复任务检查 '重复任务检查
Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " " Dim LoaderName As String = "MCBBS 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Red) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New CancelledException
@@ -753,7 +753,7 @@ Retry:
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件” 'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -805,11 +805,11 @@ Retry:
End If End If
OpenExplorer(TargetFolder) OpenExplorer(TargetFolder)
'加入文件夹列表 '加入文件夹列表
Dim VersionName As String = GetFolderNameFromPath(TargetFolder) Dim InstanceName As String = GetFolderNameFromPath(TargetFolder)
Directory.CreateDirectory(TargetFolder & ".minecraft\") Directory.CreateDirectory(TargetFolder & ".minecraft\")
PageSelectLeft.AddFolder( PageSelectLeft.AddFolder(
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串) TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
VersionName, False) InstanceName, False)
'调用 modpack 文件进行安装 '调用 modpack 文件进行安装
Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
Log("[Modpack] 调用 modpack 文件继续安装:" & ModpackFile) Log("[Modpack] 调用 modpack 文件继续安装:" & ModpackFile)
@@ -835,10 +835,9 @@ Retry:
Exit For Exit For
End If End If
Next Next
If Match Is Nothing Then Throw New Exception("未能找到适合的文件结构,这可能不是一个 MC 压缩包") '没有匹配 If Match Is Nothing Then Throw New Exception("文件结构不匹配,这可能不是 Minecraft 客户端压缩包?") '没有匹配
Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如:包裹文件夹\.minecraft\(最短为空字符串) Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
Dim VersionName As String = Match.Groups(1).Value Log("[ModPack] 检测到压缩包的 .minecraft 根目录:" & ArchiveBaseFolder & ",命中的版本名:" & Match.Groups(1).Value)
Log("[ModPack] 检测到压缩包的 .minecraft 根目录:" & ArchiveBaseFolder & ",命中的版本名:" & VersionName)
'获取解压路径 '获取解压路径
MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True) MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)") Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
@@ -853,7 +852,7 @@ Retry:
'加入文件夹列表 '加入文件夹列表
PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False) PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
Thread.Sleep(400) '避免文件争用 Thread.Sleep(400) '避免文件争用
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.VersionSelect)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.InstanceSelect))
End Sub) End Sub)
}) With {.OnStateChanged = AddressOf McInstallState} }) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(TargetFolder) Loader.Start(TargetFolder)
@@ -58,13 +58,13 @@
'初始化 '初始化
Public GameProcess As Process Public GameProcess As Process
Public Version As McVersion Public Instance As McInstance
Private WindowTitle As String = "" Private WindowTitle As String = ""
Private PID As Integer Private PID As Integer
Public Loader As LoaderTask(Of Process, Integer) Public Loader As LoaderTask(Of Process, Integer)
Public Sub New(Loader As LoaderTask(Of Process, Integer), Version As McVersion, WindowTitle As String) Public Sub New(Loader As LoaderTask(Of Process, Integer), Instance As McInstance, WindowTitle As String)
Me.Loader = Loader Me.Loader = Loader
Me.Version = Version Me.Instance = Instance
Me.WindowTitle = WindowTitle Me.WindowTitle = WindowTitle
Me.PID = Loader.Input.Id Me.PID = Loader.Input.Id
WatcherLog("开始 Minecraft 日志监控") WatcherLog("开始 Minecraft 日志监控")
@@ -97,7 +97,7 @@
'设置窗口标题 '设置窗口标题
For i = 1 To 3 For i = 1 To 3
If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss")) Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy'/'M'/'d")).Replace("{time}", Date.Now.ToString("HH':'mm':'ss"))
SetWindowText(WindowHandle, RealTitle.ToCharArray) SetWindowText(WindowHandle, RealTitle.ToCharArray)
End If End If
Thread.Sleep(64) Thread.Sleep(64)
@@ -164,7 +164,7 @@
'窗口未出现 '窗口未出现
WatcherLog("Minecraft 尚未加载完成,可能已崩溃") WatcherLog("Minecraft 尚未加载完成,可能已崩溃")
Crashed() Crashed()
ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Version.ReleaseTime.Year >= 2012 Then ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Instance.ReleaseTime.Year >= 2012 Then
'返回值不为 0 且未结束 '返回值不为 0 且未结束
WatcherLog("Minecraft 返回值异常,可能已崩溃") WatcherLog("Minecraft 返回值异常,可能已崩溃")
Crashed() Crashed()
@@ -356,12 +356,12 @@
Try Try
Thread.Sleep(2000) Thread.Sleep(2000)
WatcherLog("崩溃分析开始") WatcherLog("崩溃分析开始")
Dim Analyzer As New CrashAnalyzer(Version) Dim Analyzer As New CrashAnalyzer(Instance)
Analyzer.Collect(Version.PathIndie, LatestLog.ToList) Analyzer.Collect(Instance.PathIndie, LatestLog.ToList)
Analyzer.Prepare() Analyzer.Prepare()
Analyzer.Analyze(Version) Analyzer.Analyze()
Analyzer.Output(False, New List(Of String) From Analyzer.Output(False, New List(Of String) From
{Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"}) {Instance.PathVersion & Instance.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
Catch ex As Exception Catch ex As Exception
Log(ex, "崩溃分析失败", LogLevel.Feedback) Log(ex, "崩溃分析失败", LogLevel.Feedback)
End Try End Try
+33 -8
View File
@@ -96,11 +96,36 @@ End Module
''' 自定义事件。 ''' 自定义事件。
''' </summary> ''' </summary>
Public Class CustomEvent Public Class CustomEvent
Inherits DependencyObject
#Region "属性与触发" #Region "属性与触发"
Public Property Type As EventType = EventType.None Public Property Type As EventType
Public Property Data As String = Nothing Get
Dim Value As EventType = EventType.None
RunInUiWait(Sub() Value = GetValue(TypeProperty))
Return Value
End Get
Set(value As EventType)
SetValue(TypeProperty, value)
End Set
End Property
Public Shared ReadOnly TypeProperty As DependencyProperty =
DependencyProperty.Register("Type", GetType(EventType), GetType(CustomEvent), New PropertyMetadata(EventType.None))
Public Property Data As String
Get
Dim Value As String = Nothing
RunInUiWait(Sub() Value = GetValue(DataProperty))
Return Value
End Get
Set(value As String)
SetValue(DataProperty, value)
End Set
End Property
Public Shared ReadOnly DataProperty As DependencyProperty =
DependencyProperty.Register("Data", GetType(String), GetType(CustomEvent), New PropertyMetadata(Nothing))
Public Sub New() Public Sub New()
End Sub End Sub
Public Sub New(Type As EventType, Data As String) Public Sub New(Type As EventType, Data As String)
@@ -150,10 +175,10 @@ Public Class CustomEvent
Public Shared Sub Raise(Type As EventType, Arg As String) Public Shared Sub Raise(Type As EventType, Arg As String)
If Type = EventType.None Then Return If Type = EventType.None Then Return
Log($"[Control] 执行自定义事件:{Type}, {Arg}") Log($"[Control] 执行自定义事件:{Type}, {Arg}")
If Arg Is Nothing Then Arg = ""
Dim Args As String() = Arg.Split("|")
Try Try
Dim Args As String() = If(Arg?.Split("|"), {""})
Select Case Type Select Case Type
Case EventType.打开网页 Case EventType.打开网页
Arg = Arg.Replace("\", "/") Arg = Arg.Replace("\", "/")
If Not Arg.Contains("://") OrElse Arg.StartsWithF("file", True) Then '为了支持更多协议(#2200) If Not Arg.Contains("://") OrElse Arg.StartsWithF("file", True) Then '为了支持更多协议(#2200)
@@ -190,17 +215,17 @@ Public Class CustomEvent
Case EventType.启动游戏 Case EventType.启动游戏
If Args(0) = "\current" Then If Args(0) = "\current" Then
If McVersionCurrent Is Nothing Then If McInstanceSelected Is Nothing Then
Hint("请先选择一个 Minecraft 版本!", HintType.Red) Hint("请先选择一个 Minecraft 版本!", HintType.Red)
Return Return
Else Else
Args(0) = McVersionCurrent.Name Args(0) = McInstanceSelected.Name
End If End If
End If End If
RunInUi( RunInUi(
Sub() Sub()
If McLaunchStart(New McLaunchOptions With If McLaunchStart(New McLaunchOptions With
{.ServerIp = If(Args.Length >= 2, Args(1), Nothing), .Version = New McVersion(Args(0))}) Then {.ServerIp = If(Args.Length >= 2, Args(1), Nothing), .Instance = New McInstance(Args(0))}) Then
Hint($"正在启动 {Args(0)}……") Hint($"正在启动 {Args(0)}……")
End If End If
End Sub) End Sub)
@@ -276,7 +301,7 @@ Public Class CustomEvent
Case EventType.修改设置, EventType.写入设置 Case EventType.修改设置, EventType.写入设置
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 UiLauncherTransparent|400") If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 UiLauncherTransparent|400")
Setup.SetSafe(Args(0), Args(1), Version:=McVersionCurrent) Setup.SetSafe(Args(0), Args(1), Instance:=McInstanceSelected)
If Args.Length = 2 Then Hint($"已写入设置:{Args(0)} → {Args(1)}", HintType.Green) If Args.Length = 2 Then Hint($"已写入设置:{Args(0)} → {Args(1)}", HintType.Green)
Case EventType.修改变量, EventType.写入变量 Case EventType.修改变量, EventType.写入变量
+18 -19
View File
@@ -410,12 +410,12 @@ EndHint:
Public FrmLoginMsSkin As PageLoginMsSkin Public FrmLoginMsSkin As PageLoginMsSkin
'版本设置页面声明 '版本设置页面声明
Public FrmVersionLeft As PageVersionLeft Public FrmInstanceLeft As PageInstanceLeft
Public FrmVersionOverall As PageVersionOverall Public FrmInstanceOverall As PageInstanceOverall
Public FrmVersionMod As PageVersionMod Public FrmInstanceMod As PageInstanceMod
Public FrmVersionModDisabled As PageVersionModDisabled Public FrmInstanceModDisabled As PageInstanceModDisabled
Public FrmVersionSetup As PageVersionSetup Public FrmInstanceSetup As PageInstanceSetup
Public FrmVersionExport As PageVersionExport Public FrmInstanceExport As PageInstanceExport
'资源信息分页声明 '资源信息分页声明
Public FrmDownloadCompDetail As PageDownloadCompDetail Public FrmDownloadCompDetail As PageDownloadCompDetail
@@ -792,8 +792,7 @@ NextFile:
'查看现有设置 '查看现有设置
Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False) Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False)
If ReadOnlyKey IsNot Nothing Then If ReadOnlyKey IsNot Nothing Then
Dim CurrentValue = ReadOnlyKey.GetValue(Executeable) If REG_VALUE = ReadOnlyKey.GetValue(Executeable)?.ToString() Then
If REG_VALUE = CurrentValue?.ToString() Then
Log($"[System] 无需调整显卡设置:{Executeable}") Log($"[System] 无需调整显卡设置:{Executeable}")
Return Return
End If End If
@@ -834,20 +833,20 @@ NextFile:
Text = Text.Replace("{path_temp}", Replacer(PathTemp)) Text = Text.Replace("{path_temp}", Replacer(PathTemp))
'时间 '时间
If ReplaceTime Then '在窗口标题中,时间会被后续动态替换,所以此时不应该替换 If ReplaceTime Then '在窗口标题中,时间会被后续动态替换,所以此时不应该替换
Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy/M/d"))) Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy'/'M'/'d")))
Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH:mm:ss"))) Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH':'mm':'ss")))
End If End If
'Minecraft 'Minecraft
Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.PathFolder)) Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.PathFolder))
Text = Text.Replace("{minecraft}", Replacer(PathMcFolder)) Text = Text.Replace("{minecraft}", Replacer(McFolderSelected))
If McVersionCurrent IsNot Nothing Then If McInstanceSelected?.IsLoaded Then
Text = Text.Replace("{version_path}", Replacer(McVersionCurrent.Path)) : Text = Text.Replace("{verpath}", Replacer(McVersionCurrent.Path)) Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion))
Text = Text.Replace("{version_indie}", Replacer(McVersionCurrent.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McVersionCurrent.PathIndie)) Text = Text.Replace("{version_indie}", Replacer(McInstanceSelected.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McInstanceSelected.PathIndie))
Text = Text.Replace("{name}", Replacer(McVersionCurrent.Name)) Text = Text.Replace("{name}", Replacer(McInstanceSelected.Name))
If {"unknown", "old", "pending"}.Contains(McVersionCurrent.Version.McName.ToLower) Then If {"unknown", "old", "pending"}.Contains(McInstanceSelected.Version.VanillaName.ToLower) Then
Text = Text.Replace("{version}", Replacer(McVersionCurrent.Name)) Text = Text.Replace("{version}", Replacer(McInstanceSelected.Name))
Else Else
Text = Text.Replace("{version}", Replacer(McVersionCurrent.Version.McName)) Text = Text.Replace("{version}", Replacer(McInstanceSelected.Version.VanillaName))
End If End If
Else Else
Text = Text.Replace("{version_path}", Replacer(Nothing)) : Text = Text.Replace("{verpath}", Replacer(Nothing)) Text = Text.Replace("{version_path}", Replacer(Nothing)) : Text = Text.Replace("{verpath}", Replacer(Nothing))
@@ -877,7 +876,7 @@ NextFile:
'高级 '高级
Text = Text.RegexReplaceEach("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint())) Text = Text.RegexReplaceEach("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
Text = Text.RegexReplaceEach("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave())) Text = Text.RegexReplaceEach("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave()))
Text = Text.RegexReplaceEach("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Setup.GetSafe(m.Groups(1).Value, McVersionCurrent))) Text = Text.RegexReplaceEach("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Setup.GetSafe(m.Groups(1).Value, McInstanceSelected)))
Text = Text.RegexReplaceEach("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value))) Text = Text.RegexReplaceEach("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Text = Text.RegexReplaceEach("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value))) Text = Text.RegexReplaceEach("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Return Text Return Text
@@ -261,6 +261,7 @@
''' <summary> ''' <summary>
''' 当前正在播放的 NAudio.Wave.WaveOutEvent。 ''' 当前正在播放的 NAudio.Wave.WaveOutEvent。
''' 如果为它赋了类别,则会没有必要地加载 NAudio.dll。
''' </summary> ''' </summary>
Public MusicNAudio = Nothing Public MusicNAudio = Nothing
''' <summary> ''' <summary>
+3 -3
View File
@@ -63,11 +63,11 @@ Friend Module ModSecret
End Function End Function
Friend Sub SecretLaunchJvmArgs(ByRef DataList As List(Of String)) Friend Sub SecretLaunchJvmArgs(ByRef DataList As List(Of String))
Dim DataJvmCustom As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent) Dim DataJvmCustom As String = Setup.Get("VersionAdvanceJvm", Instance:=McInstanceSelected)
DataList.Insert(0, ArgumentReplace(If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom))) '可变 JVM 参数 DataList.Insert(0, ArgumentReplace(If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom))) '可变 JVM 参数
McLaunchLog("当前剩余内存:" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G") McLaunchLog("当前剩余内存:" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024 * 0.15) & "m") DataList.Add("-Xmn" & Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & "m") DataList.Add("-Xmx" & Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected) * 1024) & "m")
If Not DataList.Any(Function(d) d.Contains("-Dlog4j2.formatMsgNoLookups=true")) Then DataList.Add("-Dlog4j2.formatMsgNoLookups=true") If Not DataList.Any(Function(d) d.Contains("-Dlog4j2.formatMsgNoLookups=true")) Then DataList.Add("-Dlog4j2.formatMsgNoLookups=true")
End Sub End Sub
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.11.2.0")> <Assembly: AssemblyVersion("2.12.1.0")>
<Assembly: AssemblyFileVersion("2.11.2.0")> <Assembly: AssemblyFileVersion("2.12.1.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
+10
View File
@@ -200,6 +200,16 @@ Namespace My.Resources
End Get End Get
End Property End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property System_ValueTuple() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("System.ValueTuple", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
@@ -160,6 +160,9 @@
<data name="System.Net.Http.Formatting" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="System.Net.Http.Formatting" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\System.Net.Http.Formatting.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\System.Net.Http.Formatting.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="System.ValueTuple" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\System.ValueTuple.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
@@ -3,16 +3,6 @@
#Region "基础属性" #Region "基础属性"
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
'Logo
Public Property Logo As String
Get
Return PathLogo.Source
End Get
Set(value As String)
PathLogo.Source = value
End Set
End Property
'标题 '标题
Public Property Title As String Public Property Title As String
Get Get
@@ -64,17 +54,17 @@
'Tag 'Tag
Public WriteOnly Property Tags As List(Of String) Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String)) Set(Tags As List(Of String))
PanTags.Children.Clear() PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed) PanTags.Visibility = If(Tags.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value For Each TagText In Tags
Dim NewTag = GetObjectFromXML( Dim BorderTag As New Border With {
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" .Background = New MyColor("#11000000"), .Padding = New Thickness(3, 1, 3, 1), .CornerRadius = New CornerRadius(3),
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0"" .Margin = New Thickness(0, 0, 3, 0), .SnapsToDevicePixels = True, .UseLayoutRounding = False}
SnapsToDevicePixels=""True"" UseLayoutRounding=""False""> Dim LabTag As New TextBlock With {
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" /> .Text = TagText, .Foreground = New MyColor("#868686"), .FontSize = 11}
</Border>") BorderTag.Child = LabTag
PanTags.Children.Add(NewTag) PanTags.Children.Add(BorderTag)
Next Next
End Set End Set
End Property End Property
@@ -34,16 +34,14 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320"> <local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" /> <local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.10" /> <local:MyComboBoxItem Content="1.21.11" />
<local:MyComboBoxItem Content="1.21.1" /> <local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.20.6" /> <local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.1" /> <local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" /> <local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" /> <local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.16.5" /> <local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.12.2" /> <local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.8.9" /> <local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" /> <local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox> </local:MyComboBox>
@@ -67,7 +67,7 @@ Public Class PageComp
''' <summary> ''' <summary>
''' 在切换到页面时,应自动将筛选项设置为与该目标 MC 版本和加载器相同。 ''' 在切换到页面时,应自动将筛选项设置为与该目标 MC 版本和加载器相同。
''' </summary> ''' </summary>
Public Shared TargetVersion As McVersion = Nothing Public Shared TargetInstance As McInstance = Nothing
''' <summary> ''' <summary>
''' 在切换到该页面时自动设置的搜索框内的内容。 ''' 在切换到该页面时自动设置的搜索框内的内容。
''' </summary> ''' </summary>
@@ -76,13 +76,13 @@ Public Class PageComp
'在点击 MyCompItem 时会获取 Loader 的输入,以使资源详情页面可以应用相同的筛选项 '在点击 MyCompItem 时会获取 Loader 的输入,以使资源详情页面可以应用相同的筛选项
Public Loader As New LoaderTask(Of CompProjectRequest, Integer)("社区资源获取:XXX", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000} Public Loader As New LoaderTask(Of CompProjectRequest, Integer)("社区资源获取:XXX", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Private IsLoaderInited As Boolean = False
Private Sub PageCompControls_Inited(sender As Object, e As EventArgs) Handles Me.Loaded Private Sub PageCompControls_Inited(sender As Object, e As EventArgs) Handles Me.Loaded
Static IsFirstLoaded As Boolean = False
'不知道从 Initialized 改成 Loaded 会不会有问题,但用 Initialized 会导致初始的筛选器修改被覆盖回默认值 '不知道从 Initialized 改成 Loaded 会不会有问题,但用 Initialized 会导致初始的筛选器修改被覆盖回默认值
If TargetVersion IsNot Nothing Then If TargetInstance IsNot Nothing Then
'设置目标 '设置目标
ResetFilter() '重置筛选器 ResetFilter() '重置筛选器
TextSearchVersion.Text = TargetVersion.Version.McName TextSearchVersion.Text = TargetInstance.Version.VanillaName
Dim GetTargetItemByName = Dim GetTargetItemByName =
Function(Name As String) As MyComboBoxItem Function(Name As String) As MyComboBoxItem
For Each Item As MyComboBoxItem In ComboSearchLoader.Items For Each Item As MyComboBoxItem In ComboSearchLoader.Items
@@ -90,30 +90,36 @@ Public Class PageComp
Next Next
Return ComboSearchLoader.Items(0) Return ComboSearchLoader.Items(0)
End Function End Function
If TargetVersion.Version.HasForge Then If TargetInstance.Version.HasForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Forge") ComboSearchLoader.SelectedItem = GetTargetItemByName("Forge")
ElseIf TargetVersion.Version.HasFabric Then ElseIf TargetInstance.Version.HasFabric Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Fabric") ComboSearchLoader.SelectedItem = GetTargetItemByName("Fabric")
ElseIf TargetVersion.Version.HasNeoForge Then ElseIf TargetInstance.Version.HasNeoForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("NeoForge") ComboSearchLoader.SelectedItem = GetTargetItemByName("NeoForge")
End If End If
TargetVersion = Nothing TargetInstance = Nothing
If TargetName IsNot Nothing Then If TargetName IsNot Nothing Then
TextSearchName.Text = TargetName TextSearchName.Text = TargetName
TargetName = Nothing TargetName = Nothing
End If End If
'如果已经完成请求,则重新开始 '如果已经完成请求,则重新开始
If IsLoaderInited Then StartNewSearch() If IsFirstLoaded Then StartNewSearch()
ScrollToHome() ScrollToHome()
End If End If
'加载器初始化 '加载器初始化
If IsLoaderInited Then Return If IsFirstLoaded Then Return
IsLoaderInited = True IsFirstLoaded = True
CType(Parent, MyPageRight).PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput) CType(Parent, MyPageRight).PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
If McVersionHighest = -1 Then McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1))) '将最高 Drop 加入筛选
If AllDrops IsNot Nothing AndAlso AllDrops.First > 250 Then
Dim HighestVersion As String = McVersion.DropToVersion(AllDrops.First)
If CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString <> HighestVersion Then '0 是全部
TextSearchVersion.Items.Insert(1, New MyComboBoxItem With {.Content = HighestVersion})
End If
End If
End Sub End Sub
Private Function LoaderInput() As CompProjectRequest Private Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(PageType, Storage, (Page + 1) * PageSize) Dim Request As New CompProjectRequest(PageType, Storage, (Page + 1) * PAGE_SIZE)
Dim GameVersion As String = If(TextSearchVersion.Text = "全部 (也可自行输入)", Nothing, Dim GameVersion As String = If(TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w"), TextSearchVersion.Text, Nothing)) If(TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w"), TextSearchVersion.Text, Nothing))
With Request With Request
@@ -132,7 +138,7 @@ Public Class PageComp
''' <summary> ''' <summary>
''' 每页展示的结果数量。 ''' 每页展示的结果数量。
''' </summary> ''' </summary>
Public Const PageSize = 40 Public Const PAGE_SIZE = 40
Public Page As Integer = 0 Public Page As Integer = 0
'结果 UI 化 '结果 UI 化
@@ -141,8 +147,9 @@ Public Class PageComp
Log($"[Comp] 开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页") Log($"[Comp] 开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
'列表项 '列表项
PanProjects.Children.Clear() PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1) Dim Index As Integer = Math.Min(Page * PAGE_SIZE, Storage.Results.Count - 1)
PanProjects.Children.Add(Storage.Results(i).ToCompItem( For Each Result In Storage.Results.GetRange(Index, Math.Min(Storage.Results.Count - Index, PAGE_SIZE))
PanProjects.Children.Add(Result.ToCompItem(
ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing, ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing,
ShowLoaderDesc:=Loader.Input.ModLoader = CompModLoaderType.Any AndAlso (PageType = CompType.Mod OrElse PageType = CompType.ModPack))) ShowLoaderDesc:=Loader.Input.ModLoader = CompModLoaderType.Any AndAlso (PageType = CompType.Mod OrElse PageType = CompType.ModPack)))
Next Next
@@ -156,7 +163,7 @@ Public Class PageComp
BtnPageLeft.IsEnabled = Page > 0 BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(Page > 0, 1, 0.2) BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319) Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
Storage.Results.Count > PageSize * (Page + 1) OrElse Storage.Results.Count > PAGE_SIZE * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2) BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
@@ -19,12 +19,12 @@
End Sub End Sub
Public Sub LoadTargetFromAdditional() Handles Me.Loaded Public Sub LoadTargetFromAdditional() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0) Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2) TargetInstance = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3) TargetLoader = FrmMain.PageCurrent.Additional(3)
PageType = FrmMain.PageCurrent.Additional(4) PageType = FrmMain.PageCurrent.Additional(4)
End Sub End Sub
Private Project As CompProject Private Project As CompProject
Private TargetVersion As String, TargetLoader As CompModLoaderType Private TargetInstance As String, TargetLoader As CompModLoaderType
''' <summary> ''' <summary>
''' 当前页面应展示的内容类别。可能为 Any。 ''' 当前页面应展示的内容类别。可能为 Any。
''' </summary> ''' </summary>
@@ -52,16 +52,16 @@
If x = Topmost Then Return -1 If x = Topmost Then Return -1
If y = Topmost Then Return 1 If y = Topmost Then Return 1
'特殊版本 '特殊版本
Dim IsXSpecial As Boolean = x.EndsWithF("版本") Dim IsXSpecial As Boolean = Not x.Contains(".")
Dim IsYSpecial As Boolean = y.EndsWithF("版本") Dim IsYSpecial As Boolean = Not y.Contains(".")
If IsXSpecial AndAlso IsYSpecial Then Return x.CompareTo(y) If IsXSpecial AndAlso IsYSpecial Then Return x.CompareTo(y)
If IsXSpecial Then Return 1 If IsXSpecial Then Return 1
If IsYSpecial Then Return -1 If IsYSpecial Then Return -1
'比较版本号 '比较版本号
Dim VersionCodeSort = -VersionSortInteger(x.Replace(x.BeforeFirst(" ") & " ", ""), y.Replace(y.BeforeFirst(" ") & " ", "")) Dim VersionCodeSort = -CompareVersion(x.Replace(x.BeforeFirst(" ") & " ", ""), y.Replace(y.BeforeFirst(" ") & " ", ""))
If VersionCodeSort <> 0 Then Return VersionCodeSort If VersionCodeSort <> 0 Then Return VersionCodeSort
'比较全部 '比较全部
Return -VersionSortInteger(x, y) Return -CompareVersion(x, y)
End Function End Function
Public Sub New(Optional Topmost As String = "") Public Sub New(Optional Topmost As String = "")
Me.Topmost = If(Topmost, "") Me.Topmost = If(Topmost, "")
@@ -69,7 +69,8 @@
End Class End Class
Private VersionFilter As String Private VersionFilter As String
Private IsMajorVersionFilter As Boolean '是否按大版本号筛选(1.21 / 1.20 / 1.19 / ...)而非小版本号(1.21.1 / 1.21 / 1.20.4 / ...) Private GroupedDrop As Boolean '是否按 Drop 筛选(1.21 / 1.20 / 1.19 / ...)而非小版本号(1.21.1 / 1.21 / 1.20.4 / ...)
Private GroupedOld As Boolean '是否折叠远古版本为一个选项
'筛选类型相同的结果(Modrinth 会返回 Mod、服务端插件、数据包混合的列表) '筛选类型相同的结果(Modrinth 会返回 Mod、服务端插件、数据包混合的列表)
Private Function GetResults() As List(Of CompFile) Private Function GetResults() As List(Of CompFile)
Dim Results As List(Of CompFile) = CompFileLoader.Output Dim Results As List(Of CompFile) = CompFileLoader.Output
@@ -87,32 +88,40 @@
Dim Results = GetResults() Dim Results = GetResults()
'初始化筛选器 '初始化筛选器
Dim VersionFilters As List(Of String) Dim Filters As List(Of String) = Nothing
Dim UpdateFilters =
Sub()
Filters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld)).
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
End Sub
'按小版本号筛选? '确定分组方式
IsMajorVersionFilter = False GroupedDrop = False : GroupedOld = False
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)). UpdateFilters()
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList If Filters.Count < 9 Then GoTo GroupDone
'按大版本号筛选? GroupedDrop = True : GroupedOld = False
If VersionFilters.Count >= 9 Then UpdateFilters()
IsMajorVersionFilter = True If Filters.Count < 9 Then GoTo GroupDone
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)). GroupedDrop = False : GroupedOld = True
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList UpdateFilters()
End If If Filters.Count < 9 Then GoTo GroupDone
GroupedDrop = True : GroupedOld = True
UpdateFilters()
GroupDone:
'UI 化筛选器 'UI 化筛选器
PanFilter.Children.Clear() PanFilter.Children.Clear()
If VersionFilters.Count < 2 Then If Filters.Count < 2 Then
CardFilter.Visibility = Visibility.Collapsed CardFilter.Visibility = Visibility.Collapsed
VersionFilter = Nothing VersionFilter = Nothing
Else Else
CardFilter.Visibility = Visibility.Visible CardFilter.Visibility = Visibility.Visible
VersionFilters.Insert(0, "全部") Filters.Insert(0, "全部")
'转化为按钮 '转化为按钮
For Each Version As String In VersionFilters For Each Version As String In Filters
Dim NewButton As New MyRadioButton With { Dim NewButton As New MyRadioButton With {
.Text = Version, .Margin = New Thickness(2, 0, 2, 0), .ColorType = MyRadioButton.ColorState.Highlight} .Text = Version, .Margin = New Thickness(2, 0, 2, 0), .ColorType = MyRadioButton.ColorState.Highlight}
NewButton.LabText.Margin = New Thickness(-2, 0, 8, 0) NewButton.LabText.Margin = New Thickness(-2, 0, 10, 0)
AddHandler NewButton.Check, AddHandler NewButton.Check,
Sub(sender As MyRadioButton, raiseByMouse As Boolean) Sub(sender As MyRadioButton, raiseByMouse As Boolean)
VersionFilter = If(sender.Text = "全部", Nothing, sender.Text) VersionFilter = If(sender.Text = "全部", Nothing, sender.Text)
@@ -122,10 +131,10 @@
Next Next
'自动选择 '自动选择
Dim ToCheck As MyRadioButton = Nothing Dim ToCheck As MyRadioButton = Nothing
If TargetVersion <> "" Then If TargetInstance <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion)) Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetInstance))
If TargetFile IsNot Nothing Then If TargetFile IsNot Nothing Then
Dim TargetGroup = GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True) Dim TargetGroup = GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld)
For Each Button As MyRadioButton In PanFilter.Children For Each Button As MyRadioButton In PanFilter.Children
If Button.Text <> TargetGroup Then Continue For If Button.Text <> TargetGroup Then Continue For
ToCheck = Button ToCheck = Button
@@ -143,24 +152,24 @@
Private Sub UpdateFilterResult() Private Sub UpdateFilterResult()
Dim Results = GetResults() Dim Results = GetResults()
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any, Dim TargetCardName As String = If(TargetInstance <> "" OrElse TargetLoader <> CompModLoaderType.Any,
$"所选版本:{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "") $"{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetInstance}(所选版本)", "")
'归类到卡片下 '归类到卡片下
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName)) Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName))
Dict.Add("其他版本", New List(Of CompFile)) Dict.Add("其他", New List(Of CompFile))
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType))) Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType)))
For Each Version As CompFile In Results For Each Version As CompFile In Results
For Each GameVersion In Version.GameVersions For Each GameVersion In Version.GameVersions
'检查是否符合版本筛选器 '检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso If VersionFilter IsNot Nothing AndAlso
GetGroupedVersionName(GameVersion, IsMajorVersionFilter, True) <> VersionFilter Then Continue For GetGroupedVersionName(GameVersion, GroupedDrop, GroupedOld) <> VersionFilter Then Continue For
'决定添加到哪个卡片 '决定添加到哪个卡片
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False) Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
'遍历加入的加载器列表 '遍历加入的加载器列表
Dim Loaders As New List(Of String) Dim Loaders As New List(Of String)
If Project.ModLoaders.Count > 1 AndAlso '工程至少有两个加载器 If Project.ModLoaders.Count > 1 AndAlso '工程至少有两个加载器
Version.Type = CompType.Mod AndAlso '是 Mod Version.Type = CompType.Mod AndAlso '是 Mod
VerName.StartsWith("1.") Then '不是 “快照版本” 之类的 McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的
For Each Loader In Version.ModLoaders For Each Loader In Version.ModLoaders
If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ") If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
@@ -176,14 +185,14 @@
Next Next
Next Next
'添加筛选的版本的卡片 '添加筛选的版本的卡片
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True).StartsWithF(VersionFilter)) Then If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then
Dict.Add(TargetCardName, New List(Of CompFile)) Dict.Add(TargetCardName, New List(Of CompFile))
For Each Version As CompFile In Results For Each Version As CompFile In Results
If Version.GameVersions.Contains(TargetVersion) AndAlso If Version.GameVersions.Contains(TargetInstance) AndAlso
(TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then (TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then
'检查是否符合版本筛选器 '检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso If VersionFilter IsNot Nothing AndAlso
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True) = VersionFilter) Then Continue For Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld) = VersionFilter) Then Continue For
If Not Dict(TargetCardName).Contains(Version) Then Dict(TargetCardName).Add(Version) If Not Dict(TargetCardName).Contains(Version) Then Dict(TargetCardName).Add(Version)
End If End If
Next Next
@@ -193,6 +202,7 @@
PanResults.Children.Clear() PanResults.Children.Clear()
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
If Not Pair.Value.Any() Then Continue For If Not Pair.Value.Any() Then Continue For
If Pair.Key = TargetCardName.Replace("(所选版本)", "") Then Continue For
'增加卡片 '增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(PageType = CompType.ModPack, 9, 8)} '9 是安装,8 是另存为 Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(PageType = CompType.ModPack, 9, 8)} '9 是安装,8 是另存为
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value} Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -208,7 +218,7 @@
NewCard.IsSwapped = True NewCard.IsSwapped = True
End If End If
'增加提示 '增加提示
If Pair.Key = "其他版本" Then If Pair.Key = "其他" Then
NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢,可能无法识别刚更新的 MC 版本。几天后即可正常识别。", .Theme = MyHint.Themes.Yellow, .Margin = New Thickness(5, 0, 0, 8)}) NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢,可能无法识别刚更新的 MC 版本。几天后即可正常识别。", .Theme = MyHint.Themes.Yellow, .Margin = New Thickness(5, 0, 0, 8)})
End If End If
Next Next
@@ -220,15 +230,17 @@
Log(ex, "可视化工程下载列表出错", LogLevel.Feedback) Log(ex, "可视化工程下载列表出错", LogLevel.Feedback)
End Try End Try
End Sub End Sub
Private Function GetGroupedVersionName(Name As String, MajorOnly As Boolean, FoldOldRelease As Boolean) As String Private Function GetGroupedVersionName(Name As String, GroupedByDrop As Boolean, FoldOld As Boolean) As String
If Name Is Nothing Then If Name Is Nothing Then
Return "其他版本" Return "其他"
ElseIf Name.Contains("w") Then ElseIf Name.Contains("w") Then
Return "快照版本" Return "快照版"
ElseIf Name.StartsWith("1.0") OrElse Not Name.StartsWith("1.") OrElse (FoldOldRelease AndAlso Val(Name.Split(".")(1)) < 10) Then ElseIf Not McVersion.IsFormatFit(Name) OrElse (FoldOld AndAlso McVersion.VersionToDrop(Name, True) < 120) Then
Return "远古版本" Return "远古版"
ElseIf GroupedByDrop Then
Return McVersion.DropToVersion(McVersion.VersionToDrop(Name, True))
Else Else
Return If(MajorOnly, "1." & Name.Split(".")(1).BeforeFirst(" "), Name) Return Name
End If End If
End Function End Function
@@ -250,7 +262,7 @@
'放置当前工程 '放置当前工程
If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem) If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem)
CompItem = Project.ToCompItem(True, True) CompItem = Project.ToCompItem(True, True).Init()
CompItem.CanInteraction = False CompItem.CanInteraction = False
CompItem.Margin = New Thickness(-7, -7, 0, 8) CompItem.Margin = New Thickness(-7, -7, 0, 8)
PanIntro.Children.Insert(0, CompItem) PanIntro.Children.Insert(0, CompItem)
@@ -272,18 +284,18 @@
'获取版本名 '获取版本名
Dim PackName As String = Project.TranslatedName.Replace(".zip", "").Replace(".rar", "").Replace(".mrpack", "").Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":") Dim PackName As String = Project.TranslatedName.Replace(".zip", "").Replace(".rar", "").Replace(".mrpack", "").Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(PackName) <> "" Then PackName = "" If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) Dim InstanceName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return If String.IsNullOrEmpty(InstanceName) Then Return
'构造步骤加载器 '构造步骤加载器
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
Dim Target As String = $"{PathMcFolder}versions\{VersionName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}" Dim Target As String = $"{McFolderSelected}versions\{InstanceName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo) Dim LogoFileAddress As String = CompItem.PathLogo.ActualSource
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True}) Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包", Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() ModpackInstall(Target, VersionName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1}) Sub() ModpackInstall(Target, InstanceName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
@@ -298,7 +310,7 @@
End Select End Select
McInstallFailedClearFolder(MyLoader) McInstallFailedClearFolder(MyLoader)
End Sub} End Sub}
Loader.Start(PathMcFolder & "versions\" & VersionName & "\") Loader.Start(McFolderSelected & "versions\" & InstanceName & "\")
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
@@ -332,7 +344,7 @@
Case CompType.Shader : SubFolder = "shaderpacks\" Case CompType.Shader : SubFolder = "shaderpacks\"
Case CompType.DataPack : SubFolder = "" '导航到版本根目录 Case CompType.DataPack : SubFolder = "" '导航到版本根目录
End Select End Select
Dim IsVersionSuitable As Func(Of McVersion, Boolean) = Nothing Dim IsInstanceSuitable As Func(Of McInstance, Boolean) = Nothing
'获取资源所需的加载器 '获取资源所需的加载器
Dim AllowedLoaders As New List(Of CompModLoaderType) Dim AllowedLoaders As New List(Of CompModLoaderType)
If File.ModLoaders.Any Then If File.ModLoaders.Any Then
@@ -342,51 +354,51 @@
End If End If
Log($"[Comp] {Desc}要求的加载器种类:" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求")) Log($"[Comp] {Desc}要求的加载器种类:" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
'判断某个版本是否符合资源要求 '判断某个版本是否符合资源要求
IsVersionSuitable = IsInstanceSuitable =
Function(Version) Function(Instance As McInstance)
If Not Version.IsLoaded Then Version.Load() If Not Instance.IsLoaded Then Instance.Load()
'只对 Mod 和数据包进行版本检测 '只对 Mod 和数据包进行版本检测
If File.Type = CompType.Mod OrElse File.Type = CompType.DataPack Then If File.Type = CompType.Mod OrElse File.Type = CompType.DataPack Then
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Instance.Version.VanillaName) Then Return False
End If End If
'加载器 '加载器
If Not AllowedLoaders.Any() Then Return True '无要求 If Not AllowedLoaders.Any() Then Return True '无要求
If AllowedLoaders.Contains(CompModLoaderType.Forge) AndAlso Version.Version.HasForge Then Return True If AllowedLoaders.Contains(CompModLoaderType.Forge) AndAlso Instance.Version.HasForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.Fabric) AndAlso Version.Version.HasFabric Then Return True If AllowedLoaders.Contains(CompModLoaderType.Fabric) AndAlso Instance.Version.HasFabric Then Return True
If AllowedLoaders.Contains(CompModLoaderType.NeoForge) AndAlso Version.Version.HasNeoForge Then Return True If AllowedLoaders.Contains(CompModLoaderType.NeoForge) AndAlso Instance.Version.HasNeoForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.LiteLoader) AndAlso Version.Version.HasLiteLoader Then Return True If AllowedLoaders.Contains(CompModLoaderType.LiteLoader) AndAlso Instance.Version.HasLiteLoader Then Return True
Return False Return False
End Function End Function
'获取常规资源默认下载位置 '获取常规资源默认下载位置
If CachedFolder.ContainsKey(File.Type) Then If CachedFolder.ContainsKey(File.Type) Then
DefaultFolder = CachedFolder(File.Type) DefaultFolder = CachedFolder(File.Type)
Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}") Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then ElseIf McInstanceSelected IsNot Nothing AndAlso IsInstanceSuitable(McInstanceSelected) Then
DefaultFolder = $"{McVersionCurrent.PathIndie}{SubFolder}" DefaultFolder = $"{McInstanceSelected.PathIndie}{SubFolder}"
Directory.CreateDirectory(DefaultFolder) Directory.CreateDirectory(DefaultFolder)
Log($"[Comp] 使用当前版本作为默认下载位置:{DefaultFolder}") Log($"[Comp] 使用当前版本作为默认下载位置:{DefaultFolder}")
Else Else
'查找所有可能的版本 '查找所有可能的版本
Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished
If NeedLoad Then If NeedLoad Then
Hint("正在查找适合的游戏版本……") Hint("正在查找适合的游戏版本……")
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
End If End If
Dim SuitableVersions = McVersionList.Values.SelectMany(Function(l) l).Where(Function(v) IsVersionSuitable(v)). Dim SuitableInstanceList = McInstanceList.Values.SelectMany(Function(l) l).Where(Function(v) IsInstanceSuitable(v)).
Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}")) Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}"))
If SuitableVersions.Any Then If SuitableInstanceList.Any Then
Dim SelectedVersion = SuitableVersions. Dim SelectedInstance = SuitableInstanceList.
OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序 OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序 ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
First() First()
DefaultFolder = SelectedVersion.FullName DefaultFolder = SelectedInstance.FullName
Directory.CreateDirectory(DefaultFolder) Directory.CreateDirectory(DefaultFolder)
Log($"[Comp] 使用适合的游戏版本作为默认下载位置:{DefaultFolder}") Log($"[Comp] 使用适合的游戏版本作为默认下载位置:{DefaultFolder}")
Else Else
DefaultFolder = PathMcFolder DefaultFolder = McFolderSelected
If NeedLoad Then If NeedLoad Then
Hint("当前 MC 文件夹中没有找到适合此资源的版本!") Hint($"当前 MC 文件夹中没有找到合适的版本!")
Else Else
Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置") Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If End If
@@ -413,6 +425,7 @@
FileName = File.FileName FileName = File.FileName
End Select End Select
End If End If
If File.Type = CompType.Mod Then FileName = FileName.Replace("~", "-") '~ 会导致 Mixin 加载失败
RunInUi( RunInUi(
Sub() Sub()
'弹窗要求选择保存位置 '弹窗要求选择保存位置
@@ -27,7 +27,8 @@
<local:MyComboBoxItem Content="生物" Tag="411/mobs" /> <local:MyComboBoxItem Content="生物" Tag="411/mobs" />
<local:MyComboBoxItem Content="实用" Tag="5191/utility" /> <local:MyComboBoxItem Content="实用" Tag="5191/utility" />
<local:MyComboBoxItem Content="装备与工具" Tag="434/equipment" /> <local:MyComboBoxItem Content="装备与工具" Tag="434/equipment" />
<local:MyComboBoxItem Content="性能优化" Tag="/optimization" /> <local:MyComboBoxItem Content="创造模式" Tag="9026/" />
<local:MyComboBoxItem Content="性能优化" Tag="6814/optimization" />
<local:MyComboBoxItem Content="信息显示" Tag="423/" /> <local:MyComboBoxItem Content="信息显示" Tag="423/" />
<local:MyComboBoxItem Content="服务器" Tag="435/social" /> <local:MyComboBoxItem Content="服务器" Tag="435/social" />
<local:MyComboBoxItem Content="支持库" Tag="421/library" /> <local:MyComboBoxItem Content="支持库" Tag="421/library" />
@@ -10,10 +10,6 @@ Public Module ModDownloadLib
''' 如果 OptiFine 与 Forge 同时复制原版 Jar,就会导致复制文件时冲突。 ''' 如果 OptiFine 与 Forge 同时复制原版 Jar,就会导致复制文件时冲突。
''' </summary> ''' </summary>
Private VanillaSyncLock As New Object Private VanillaSyncLock As New Object
''' <summary>
''' 最高的 Minecraft 大版本号,-1 代表尚未获取。
''' </summary>
Public McVersionHighest As Integer = -1
#Region "Minecraft 下载" #Region "Minecraft 下载"
@@ -25,7 +21,7 @@ Public Module ModDownloadLib
''' <param name="JsonUrl">Json 文件的 Mojang 官方地址。</param> ''' <param name="JsonUrl">Json 文件的 Mojang 官方地址。</param>
Public Function McDownloadClient(Behaviour As NetPreDownloadBehaviour, Id As String, Optional JsonUrl As String = Nothing) As LoaderCombo(Of String) Public Function McDownloadClient(Behaviour As NetPreDownloadBehaviour, Id As String, Optional JsonUrl As String = Nothing) As LoaderCombo(Of String)
Try Try
Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\" Dim VersionFolder As String = McFolderSelected & "versions\" & Id & "\"
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList() For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -62,11 +58,11 @@ Public Module ModDownloadLib
''' <summary> ''' <summary>
''' 获取下载某个 Minecraft 版本的加载器列表。 ''' 获取下载某个 Minecraft 版本的加载器列表。
''' 它必须安装到 PathMcFolder,但是可以自定义版本名(不过自定义的版本名不会修改 Json 中的 id 项)。 ''' 它必须安装到 McFolderSelected,但是可以自定义版本名(不过自定义的版本名不会修改 Json 中的 id 项)。
''' </summary> ''' </summary>
Private Function McDownloadClientLoader(Id As String, Optional JsonUrl As String = Nothing, Optional VersionName As String = Nothing) As List(Of LoaderBase) Private Function McDownloadClientLoader(Id As String, Optional JsonUrl As String = Nothing, Optional InstanceName As String = Nothing) As List(Of LoaderBase)
VersionName = If(VersionName, Id) InstanceName = If(InstanceName, Id)
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\" Dim VersionFolder As String = McFolderSelected & "versions\" & InstanceName & "\"
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
@@ -75,11 +71,11 @@ Public Module ModDownloadLib
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取原版 json 文件下载地址", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取原版 json 文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim JsonAddress As String = DlClientListGet(Id) Dim JsonAddress As String = DlClientListGet(Id)
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JsonAddress), VersionFolder & VersionName & ".json")} Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JsonAddress), VersionFolder & InstanceName & ".json")}
End Sub) With {.ProgressWeight = 2, .Show = False}) End Sub) With {.ProgressWeight = 2, .Show = False})
End If End If
Loaders.Add(New LoaderDownload(McDownloadClientJsonName, New List(Of NetFile) From { Loaders.Add(New LoaderDownload(McDownloadClientJsonName, New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(If(JsonUrl, "")), VersionFolder & VersionName & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True)) New NetFile(DlSourceLauncherOrMetaGet(If(JsonUrl, "")), VersionFolder & InstanceName & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 3}) }) With {.ProgressWeight = 3})
'下载支持库文件 '下载支持库文件
@@ -88,7 +84,7 @@ Public Module ModDownloadLib
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Thread.Sleep(50) '等待 JSON 文件实际写入硬盘(#3710) Thread.Sleep(50) '等待 JSON 文件实际写入硬盘(#3710)
Log("[Download] 开始分析原版支持库文件:" & VersionFolder) Log("[Download] 开始分析原版支持库文件:" & VersionFolder)
Task.Output = McLibFix(New McVersion(VersionFolder)) Task.Output = McLibNetFilesFromInstance(New McInstance(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False}) End Sub) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载原版支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False}) LoadersLib.Add(New LoaderDownload("下载原版支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False})
Loaders.Add(New LoaderCombo(Of String)(McDownloadClientLibName, LoadersLib) With {.Block = False, .ProgressWeight = 14}) Loaders.Add(New LoaderCombo(Of String)(McDownloadClientLibName, LoadersLib) With {.Block = False, .ProgressWeight = 14})
@@ -98,28 +94,25 @@ Public Module ModDownloadLib
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址(副加载器)", LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try Try
Dim Version As New McVersion(VersionFolder) Dim AssetIndex = DlClientAssetIndexGet(New McInstance(VersionFolder))
Dim AssetIndex = DlClientAssetIndexGet(Version)
Task.Output = If(AssetIndex Is Nothing, New List(Of NetFile), New List(Of NetFile) From {AssetIndex}) Task.Output = If(AssetIndex Is Nothing, New List(Of NetFile), New List(Of NetFile) From {AssetIndex})
Catch ex As Exception Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex) Throw New Exception("分析资源文件索引地址失败", ex)
End Try End Try
'顺手添加 Json 项目 '顺手添加 Json 项目
Try Try
Dim VersionJson As JObject = GetJson(ReadFile(VersionFolder & VersionName & ".json")) Dim InstanceJson As JObject = GetJson(ReadFile(VersionFolder & InstanceName & ".json"))
VersionJson.Add("clientVersion", Id) InstanceJson.Add("clientVersion", Id)
WriteFile(VersionFolder & VersionName & ".json", VersionJson.ToString) WriteFile($"{VersionFolder}{InstanceName}.json", InstanceJson.ToString)
Catch ex As Exception Catch ex As Exception
Throw New Exception("添加客户端版本失败", ex) Throw New Exception("添加客户端版本失败", ex)
End Try End Try
End Sub) With {.ProgressWeight = 1, .Show = False}) End Sub) With {.ProgressWeight = 1, .Show = False})
LoadersAssets.Add(New LoaderDownload("下载资源文件索引(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 3, .Show = False}) LoadersAssets.Add(New LoaderDownload("下载资源文件索引(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 3, .Show = False})
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析所需资源文件(副加载器)", LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析所需资源文件(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task) Task.Output = McAssetsFixList(New McInstance(VersionFolder), True, Task)) With {.ProgressWeight = 0.01, .Show = False})
Task.Output = McAssetsFixList(New McVersion(VersionFolder), True, Task)
End Sub) With {.ProgressWeight = 3, .Show = False})
LoadersAssets.Add(New LoaderDownload("下载资源文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 14, .Show = False}) LoadersAssets.Add(New LoaderDownload("下载资源文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 14, .Show = False})
Loaders.Add(New LoaderCombo(Of String)("下载原版资源文件", LoadersAssets) With {.Block = False, .ProgressWeight = 21}) Loaders.Add(New LoaderCombo(Of String)("下载原版资源文件", LoadersAssets) With {.Block = False, .ProgressWeight = 18})
Return Loaders Return Loaders
@@ -131,7 +124,9 @@ Public Module ModDownloadLib
#Region "Minecraft 下载菜单" #Region "Minecraft 下载菜单"
Public Function McDownloadListItem(Entry As JObject, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem Public Function McDownloadListItem(Entry As JObject, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyVirtualizingElement(Of MyListItem)
Return New MyVirtualizingElement(Of MyListItem)(
Function()
'确定图标 '确定图标
Dim Logo As String Dim Logo As String
Select Case Entry("type") Select Case Entry("type")
@@ -161,6 +156,7 @@ Public Module ModDownloadLib
End If End If
'结束 '结束
Return NewItem Return NewItem
End Function) With {.Height = 42}
End Function End Function
Private Sub McDownloadSaveMenuBuild(sender As Object, e As EventArgs) Private Sub McDownloadSaveMenuBuild(sender As Object, e As EventArgs)
Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"}
@@ -236,8 +232,8 @@ Public Module ModDownloadLib
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("构建服务端", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("构建服务端",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'分析服务端 JAR 文件下载地址 '分析服务端 JAR 文件下载地址
Dim McVersion As New McVersion(VersionFolder) Dim Instance As New McInstance(VersionFolder)
If McVersion.JsonObject("downloads") Is Nothing OrElse McVersion.JsonObject("downloads")("server") Is Nothing OrElse McVersion.JsonObject("downloads")("server")("url") Is Nothing Then If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("server") Is Nothing OrElse Instance.JsonObject("downloads")("server")("url") Is Nothing Then
File.Delete(VersionFolder & Id & ".json") File.Delete(VersionFolder & Id & ".json")
If Not New DirectoryInfo(VersionFolder).GetFileSystemInfos.Any() Then Directory.Delete(VersionFolder) If Not New DirectoryInfo(VersionFolder).GetFileSystemInfos.Any() Then Directory.Delete(VersionFolder)
Task.Output = New List(Of NetFile) Task.Output = New List(Of NetFile)
@@ -246,8 +242,8 @@ Public Module ModDownloadLib
Task.Abort() Task.Abort()
Return Return
End If End If
Dim JarUrl As String = McVersion.JsonObject("downloads")("server")("url") Dim JarUrl As String = Instance.JsonObject("downloads")("server")("url")
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(McVersion.JsonObject("downloads")("server")("size"), -1), Hash:=McVersion.JsonObject("downloads")("server")("sha1")) Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Instance.JsonObject("downloads")("server")("size"), -1), Hash:=Instance.JsonObject("downloads")("server")("sha1"))
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JarUrl), VersionFolder & Id & "-server.jar", Checker)} Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JarUrl), VersionFolder & Id & "-server.jar", Checker)}
'添加启动脚本 '添加启动脚本
Dim Bat As String = Dim Bat As String =
@@ -266,8 +262,7 @@ pause"
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030"))) Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
'删除版本 JSON '删除版本 JSON
File.Delete(VersionFolder & Id & ".json") File.Delete(VersionFolder & Id & ".json")
End Sub End Sub) With {.ProgressWeight = 0.5, .Show = False})
) With {.ProgressWeight = 0.5, .Show = False})
'下载服务端文件 '下载服务端文件
Loaders.Add(New LoaderDownload("下载服务端文件", New List(Of NetFile)) With {.ProgressWeight = 5}) Loaders.Add(New LoaderDownload("下载服务端文件", New List(Of NetFile)) With {.ProgressWeight = 5})
@@ -311,7 +306,7 @@ pause"
}) With {.ProgressWeight = 2}) }) With {.ProgressWeight = 2})
'获取支持库文件地址 '获取支持库文件地址
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 JAR 文件下载地址", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 JAR 文件下载地址",
Sub(Task) Task.Output = New List(Of NetFile) From {DlClientJarGet(New McVersion(VersionFolder), False)} Sub(Task) Task.Output = New List(Of NetFile) From {DlClientJarGet(New McInstance(VersionFolder), False)}
) With {.ProgressWeight = 0.5, .Show = False}) ) With {.ProgressWeight = 0.5, .Show = False})
'下载支持库文件 '下载支持库文件
Loaders.Add(New LoaderDownload("下载核心 JAR 文件", New List(Of NetFile)) With {.ProgressWeight = 5}) Loaders.Add(New LoaderDownload("下载核心 JAR 文件", New List(Of NetFile)) With {.ProgressWeight = 5})
@@ -329,10 +324,10 @@ pause"
''' <summary> ''' <summary>
''' 显示某 Minecraft 版本的更新日志。 ''' 显示某 Minecraft 版本的更新日志。
''' </summary> ''' </summary>
''' <param name="VersionJson">在 version_manifest.json 中的对应项。</param> ''' <param name="InstanceJson">在 version_manifest.json 中的对应项。</param>
Public Sub McUpdateLogShow(VersionJson As JToken) Public Sub McUpdateLogShow(InstanceJson As JToken)
Dim WikiName As String Dim WikiName As String
Dim Id As String = VersionJson("id").ToString.ToLower Dim Id As String = InstanceJson("id").ToString.ToLower
If Id = "3d shareware v1.34" Then If Id = "3d shareware v1.34" Then
WikiName = "3D_Shareware_v1.34" WikiName = "3D_Shareware_v1.34"
ElseIf Id = "2.0" Then ElseIf Id = "2.0" Then
@@ -365,7 +360,7 @@ pause"
WikiName = "Java版Beta_1.9_Prerelease_6" WikiName = "Java版Beta_1.9_Prerelease_6"
ElseIf Id.Contains("b1.9") Then ElseIf Id.Contains("b1.9") Then
WikiName = "Java版Beta_1.9_Prerelease" WikiName = "Java版Beta_1.9_Prerelease"
ElseIf VersionJson("type") = "release" OrElse VersionJson("type") = "snapshot" OrElse VersionJson("type") = "special" Then ElseIf InstanceJson("type") = "release" OrElse InstanceJson("type") = "snapshot" OrElse InstanceJson("type") = "special" Then
WikiName = If(Id.Contains("w"), "", "Java版") & Id.Replace(" Pre-Release ", "-pre") WikiName = If(Id.Contains("w"), "", "Java版") & Id.Replace(" Pre-Release ", "-pre")
ElseIf Id.StartsWithF("b") Then ElseIf Id.StartsWithF("b") Then
WikiName = "Java版" & Id.TrimEnd("a", "b", "c", "d", "e").Replace("b", "Beta_") WikiName = "Java版" & Id.TrimEnd("a", "b", "c", "d", "e").Replace("b", "Beta_")
@@ -394,18 +389,18 @@ pause"
Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry) Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry)
Try Try
Dim Id As String = DownloadInfo.NameVersion Dim Id As String = DownloadInfo.InstanceName
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.NameFile, "OptiFine Jar (*.jar)|*.jar") Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName, "OptiFine Jar (*.jar)|*.jar")
If Not Target.Contains("\") Then Return If Not Target.Contains("\") Then Return
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList() For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"OptiFine {DownloadInfo.NameDisplay} 下载" Then Continue For If OngoingLoader.Name <> $"OptiFine {DownloadInfo.DisplayName} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Red) Hint("该版本正在下载中!", HintType.Red)
Return Return
Next Next
Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly} Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.DisplayName & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(DownloadInfo) Loader.Start(DownloadInfo)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
@@ -421,9 +416,8 @@ pause"
SyncLock JavaLock SyncLock JavaLock
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0)) Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
If Java Is Nothing Then If Java Is Nothing Then
If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java,已取消安装。")
'开始自动下载 '开始自动下载
Dim JavaLoader = JavaFixLoaders(17) Dim JavaLoader = GetJavaDownloadLoader()
Try Try
JavaLoader.Start(17, IsForceRestart:=True) JavaLoader.Start(17, IsForceRestart:=True)
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted
@@ -445,7 +439,7 @@ pause"
Else Else
Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer" Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer"
End If End If
If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments If Java.MajorVersion >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动 '开始启动
SyncLock InstallSyncLock SyncLock InstallSyncLock
Dim Info = New ProcessStartInfo With { Dim Info = New ProcessStartInfo With {
@@ -539,14 +533,14 @@ pause"
Private Function McDownloadOptiFineLoader(DownloadInfo As DlOptiFineListEntry, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional ClientFolder As String = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase) Private Function McDownloadOptiFineLoader(DownloadInfo As DlOptiFineListEntry, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional ClientFolder As String = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase)
'参数初始化 '参数初始化
McFolder = If(McFolder, PathMcFolder) McFolder = If(McFolder, McFolderSelected)
Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder Dim IsCustomFolder As Boolean = McFolder <> McFolderSelected
Dim Id As String = DownloadInfo.NameVersion Dim Id As String = DownloadInfo.InstanceName
Dim VersionFolder As String = McFolder & "versions\" & Id & "\" Dim VersionFolder As String = McFolder & "versions\" & Id & "\"
Dim IsNewVersion As Boolean = DownloadInfo.Inherit.Contains("w") OrElse Val(DownloadInfo.Inherit.Split(".")(1)) >= 14 Dim IsNewerVersion As Boolean = DownloadInfo.Inherit.Contains("w") OrElse McVersion.VersionToDrop(DownloadInfo.Inherit) >= 140
Dim Target As String = If(IsNewVersion, Dim Target As String = If(IsNewerVersion,
$"{RequestTaskTempFolder()}OptiFine.jar", $"{RequestTaskTempFolder()}OptiFine.jar",
$"{McFolder}libraries\optifine\OptiFine\{DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "")}\{DownloadInfo.NameFile.Replace("OptiFine_", "OptiFine-").Replace("preview_", "")}") $"{McFolder}libraries\optifine\OptiFine\{DownloadInfo.FileName.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "")}\{DownloadInfo.FileName.Replace("OptiFine_", "OptiFine-").Replace("preview_", "")}")
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
'获取下载地址 '获取下载地址
@@ -563,20 +557,20 @@ pause"
Dim BmclapiInherit As String = DownloadInfo.Inherit Dim BmclapiInherit As String = DownloadInfo.Inherit
If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281 If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281
If DownloadInfo.IsPreview Then If DownloadInfo.IsPreview Then
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.DisplayName.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
Else Else
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.DisplayName.Replace(DownloadInfo.Inherit & " ", ""))
End If End If
'官方源 '官方源
Dim PageData As String Dim PageData As String
Try Try
PageData = NetRequestByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, PageData = NetRequestByClient("https://optifine.net/adloadx?f=" & DownloadInfo.FileName,
Encoding:=New UTF8Encoding(False), Timeout:=15000, Accept:="text/html", SimulateBrowserHeaders:=True) Encoding:=New UTF8Encoding(False), Timeout:=15000, Accept:="text/html", SimulateBrowserHeaders:=True)
Task.Progress = 0.8 Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址:" & Sources.Last) Log("[Download] OptiFine " & DownloadInfo.DisplayName & " 官方下载地址:" & Sources.Last)
Catch ex As Exception Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败") Log(ex, "获取 OptiFine " & DownloadInfo.DisplayName & " 官方下载地址失败")
End Try End Try
'构造文件请求 '构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))} Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))}
@@ -610,7 +604,7 @@ pause"
End Sub) With {.ProgressWeight = 0.1, .Show = False}) End Sub) With {.ProgressWeight = 0.1, .Show = False})
'安装(新旧方式均需要原版 Jar 和 Json) '安装(新旧方式均需要原版 Jar 和 Json)
If IsNewVersion Then If IsNewerVersion Then
Log("[Download] 检测为新版 OptiFine:" & DownloadInfo.Inherit) Log("[Download] 检测为新版 OptiFine:" & DownloadInfo.Inherit)
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine(方式 A)", Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine(方式 A)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
@@ -667,24 +661,24 @@ Retry:
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar") CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar")
Task.Progress = 0.7 Task.Progress = 0.7
'建立 Json 文件 '建立 Json 文件
Dim InheritVersion As New McVersion(McFolder & "versions\" & DownloadInfo.Inherit) Dim InheritInstance As New McInstance(McFolder & "versions\" & DownloadInfo.Inherit)
Dim Json As String = "{ Dim Json As String = "{
""id"": """ & Id & """, ""id"": """ & Id & """,
""inheritsFrom"": """ & DownloadInfo.Inherit & """, ""inheritsFrom"": """ & DownloadInfo.Inherit & """,
""time"": """ & If(DownloadInfo.ReleaseTime = "", InheritVersion.ReleaseTime.ToString("yyyy'-'MM'-'dd"), DownloadInfo.ReleaseTime.Replace("/", "-")) & "T23:33:33+08:00"", ""time"": """ & If(DownloadInfo.ReleaseTime = "", InheritInstance.ReleaseTime.ToString("yyyy'-'MM'-'dd"), DownloadInfo.ReleaseTime.Replace("/", "-")) & "T23:33:33+08:00"",
""releaseTime"": """ & If(DownloadInfo.ReleaseTime = "", InheritVersion.ReleaseTime.ToString("yyyy'-'MM'-'dd"), DownloadInfo.ReleaseTime.Replace("/", "-")) & "T23:33:33+08:00"", ""releaseTime"": """ & If(DownloadInfo.ReleaseTime = "", InheritInstance.ReleaseTime.ToString("yyyy'-'MM'-'dd"), DownloadInfo.ReleaseTime.Replace("/", "-")) & "T23:33:33+08:00"",
""type"": ""release"", ""type"": ""release"",
""libraries"": [ ""libraries"": [
{""name"": ""optifine:OptiFine:" & DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "") & """}, {""name"": ""optifine:OptiFine:" & DownloadInfo.FileName.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "") & """},
{""name"": ""net.minecraft:launchwrapper:1.12""} {""name"": ""net.minecraft:launchwrapper:1.12""}
], ],
""mainClass"": ""net.minecraft.launchwrapper.Launch""," ""mainClass"": ""net.minecraft.launchwrapper.Launch"","
Task.Progress = 0.8 Task.Progress = 0.8
If InheritVersion.IsOldJson Then If InheritInstance.IsOldJson Then
'输出旧版 Json 格式 '输出旧版 Json 格式
Json += " Json += "
""minimumLauncherVersion"": 18, ""minimumLauncherVersion"": 18,
""minecraftArguments"": """ & InheritVersion.JsonObject("minecraftArguments").ToString & " --tweakClass optifine.OptiFineTweaker"" ""minecraftArguments"": """ & InheritInstance.JsonObject("minecraftArguments").ToString & " --tweakClass optifine.OptiFineTweaker""
}" }"
Else Else
'输出新版 Json 格式 '输出新版 Json 格式
@@ -708,7 +702,7 @@ Retry:
'下载支持库 '下载支持库
If FixLibrary Then If FixLibrary Then
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 OptiFine 支持库文件", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 OptiFine 支持库文件",
Sub(Task) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) Sub(Task) Task.Output = McLibNetFilesFromInstance(New McInstance(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
Loaders.Add(New LoaderDownload("下载 OptiFine 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 4}) Loaders.Add(New LoaderDownload("下载 OptiFine 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 4})
End If End If
@@ -727,20 +721,20 @@ Retry:
Dim BmclapiInherit As String = DownloadInfo.Inherit Dim BmclapiInherit As String = DownloadInfo.Inherit
If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281 If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281
If DownloadInfo.IsPreview Then If DownloadInfo.IsPreview Then
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.DisplayName.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
Else Else
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.DisplayName.Replace(DownloadInfo.Inherit & " ", ""))
End If End If
'官方源 '官方源
Dim PageData As String Dim PageData As String
Try Try
PageData = NetRequestByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, PageData = NetRequestByClient("https://optifine.net/adloadx?f=" & DownloadInfo.FileName,
Encoding:=New UTF8Encoding(False), Timeout:=15000, Accept:="text/html", SimulateBrowserHeaders:=True) Encoding:=New UTF8Encoding(False), Timeout:=15000, Accept:="text/html", SimulateBrowserHeaders:=True)
Task.Progress = 0.8 Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址:" & Sources.Last) Log("[Download] OptiFine " & DownloadInfo.DisplayName & " 官方下载地址:" & Sources.Last)
Catch ex As Exception Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败") Log(ex, "获取 OptiFine " & DownloadInfo.DisplayName & " 官方下载地址失败")
End Try End Try
Task.Progress = 0.9 Task.Progress = 0.9
'构造文件请求 '构造文件请求
@@ -755,10 +749,12 @@ Retry:
#Region "OptiFine 下载菜单" #Region "OptiFine 下载菜单"
Public Function OptiFineDownloadListItem(Entry As DlOptiFineListEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem Public Function OptiFineDownloadListItem(Entry As DlOptiFineListEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyVirtualizingElement(Of MyListItem)
Return New MyVirtualizingElement(Of MyListItem)(
Function()
'建立控件 '建立控件
Dim NewItem As New MyListItem With { Dim NewItem As New MyListItem With {
.Title = Entry.NameDisplay, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Title = Entry.DisplayName, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = If(Entry.IsPreview, "测试版", "正式版") & .Info = If(Entry.IsPreview, "测试版", "正式版") &
If(Entry.ReleaseTime = "", "", ",发布于 " & Entry.ReleaseTime) & If(Entry.ReleaseTime = "", "", ",发布于 " & Entry.ReleaseTime) &
If(Entry.RequiredForgeVersion Is Nothing, ",不兼容 Forge", If(Entry.RequiredForgeVersion = "", "", ",兼容 Forge " & Entry.RequiredForgeVersion)), If(Entry.RequiredForgeVersion Is Nothing, ",不兼容 Forge", If(Entry.RequiredForgeVersion = "", "", ",兼容 Forge " & Entry.RequiredForgeVersion)),
@@ -771,8 +767,8 @@ Retry:
Else Else
NewItem.ContentHandler = AddressOf OptiFineContMenuBuild NewItem.ContentHandler = AddressOf OptiFineContMenuBuild
End If End If
'结束
Return NewItem Return NewItem
End Function) With {.Height = 42}
End Function End Function
Private Sub OptiFineSaveContMenuBuild(sender As Object, e As EventArgs) Private Sub OptiFineSaveContMenuBuild(sender As Object, e As EventArgs)
Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"} Dim BtnInfo As New MyIconButton With {.LogoScale = 1.05, .Logo = Logo.IconButtonInfo, .ToolTip = "更新日志"}
@@ -804,7 +800,7 @@ Retry:
Else Else
Version = sender.Parent.Parent.Tag Version = sender.Parent.Parent.Tag
End If End If
OpenWebsite("https://optifine.net/changelog?f=" & Version.NameFile) OpenWebsite("https://optifine.net/changelog?f=" & Version.FileName)
End Sub End Sub
Public Sub OptiFineSave_Click(sender As Object, e As RoutedEventArgs) Public Sub OptiFineSave_Click(sender As Object, e As RoutedEventArgs)
Dim Version As DlOptiFineListEntry Dim Version As DlOptiFineListEntry
@@ -826,8 +822,8 @@ Retry:
Try Try
Dim Id As String = DownloadInfo.Inherit Dim Id As String = DownloadInfo.Inherit
Dim Target As String = PathTemp & "Download\" & Id & "-Liteloader.jar" Dim Target As String = PathTemp & "Download\" & Id & "-Liteloader.jar"
Dim VersionName As String = DownloadInfo.Inherit & "-LiteLoader" Dim InstanceName As String = DownloadInfo.Inherit & "-LiteLoader"
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\" Dim VersionFolder As String = McFolderSelected & "versions\" & InstanceName & "\"
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList() For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -837,10 +833,10 @@ Retry:
Next Next
'已有版本检查 '已有版本检查
If File.Exists(VersionFolder & VersionName & ".json") Then If File.Exists(VersionFolder & InstanceName & ".json") Then
If MyMsgBox("版本 " & VersionName & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 和 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then If MyMsgBox("版本 " & InstanceName & " 已存在,是否重新下载?" & vbCrLf & "这会覆盖版本的 json 和 jar 文件,但不会影响版本隔离的文件。", "版本已存在", "继续", "取消") = 1 Then
File.Delete(VersionFolder & VersionName & ".jar") File.Delete(VersionFolder & InstanceName & ".jar")
File.Delete(VersionFolder & VersionName & ".json") File.Delete(VersionFolder & InstanceName & ".json")
Else Else
Return Return
End If End If
@@ -913,8 +909,8 @@ Retry:
Private Function McDownloadLiteLoaderLoader(DownloadInfo As DlLiteLoaderListEntry, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase) Private Function McDownloadLiteLoaderLoader(DownloadInfo As DlLiteLoaderListEntry, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase)
'参数初始化 '参数初始化
McFolder = If(McFolder, PathMcFolder) McFolder = If(McFolder, McFolderSelected)
Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder Dim IsCustomFolder As Boolean = McFolder <> McFolderSelected
Dim Id As String = DownloadInfo.Inherit Dim Id As String = DownloadInfo.Inherit
Dim Target As String = PathTemp & "Download\" & Id & "-Liteloader.jar" Dim Target As String = PathTemp & "Download\" & Id & "-Liteloader.jar"
Dim VersionName As String = DownloadInfo.Inherit & "-LiteLoader" Dim VersionName As String = DownloadInfo.Inherit & "-LiteLoader"
@@ -938,8 +934,8 @@ Retry:
'构造版本 Json '构造版本 Json
Dim VersionJson As New JObject Dim VersionJson As New JObject
VersionJson.Add("id", VersionName) VersionJson.Add("id", VersionName)
VersionJson.Add("time", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.CurrentCulture)) VersionJson.Add("time", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.InvariantCulture))
VersionJson.Add("releaseTime", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.CurrentCulture)) VersionJson.Add("releaseTime", Date.ParseExact(DownloadInfo.ReleaseTime, "yyyy/MM/dd HH:mm", Globalization.CultureInfo.InvariantCulture))
VersionJson.Add("type", "release") VersionJson.Add("type", "release")
VersionJson.Add("arguments", GetJson("{""game"":[""--tweakClass"",""" & DownloadInfo.JsonToken("tweakClass").ToString & """]}")) VersionJson.Add("arguments", GetJson("{""game"":[""--tweakClass"",""" & DownloadInfo.JsonToken("tweakClass").ToString & """]}"))
VersionJson.Add("libraries", DownloadInfo.JsonToken("libraries")) VersionJson.Add("libraries", DownloadInfo.JsonToken("libraries"))
@@ -957,7 +953,7 @@ Retry:
'下载支持库 '下载支持库
If FixLibrary Then If FixLibrary Then
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 LiteLoader 支持库文件", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 LiteLoader 支持库文件",
Sub(Task) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) Sub(Task) Task.Output = McLibNetFilesFromInstance(New McInstance(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
Loaders.Add(New LoaderDownload("下载 LiteLoader 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 6}) Loaders.Add(New LoaderDownload("下载 LiteLoader 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 6})
End If End If
@@ -968,7 +964,9 @@ Retry:
#Region "LiteLoader 下载菜单" #Region "LiteLoader 下载菜单"
Public Function LiteLoaderDownloadListItem(Entry As DlLiteLoaderListEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem Public Function LiteLoaderDownloadListItem(Entry As DlLiteLoaderListEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyVirtualizingElement(Of MyListItem)
Return New MyVirtualizingElement(Of MyListItem)(
Function()
'建立控件 '建立控件
Dim NewItem As New MyListItem With { Dim NewItem As New MyListItem With {
.Title = Entry.Inherit, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Title = Entry.Inherit, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
@@ -984,6 +982,7 @@ Retry:
End If End If
'结束 '结束
Return NewItem Return NewItem
End Function) With {.Height = 42}
End Function End Function
Private Sub LiteLoaderSaveContMenuBuild(sender As MyListItem, e As EventArgs) Private Sub LiteLoaderSaveContMenuBuild(sender As MyListItem, e As EventArgs)
If sender.Tag.IsLegacy Then If sender.Tag.IsLegacy Then
@@ -1056,8 +1055,8 @@ Retry:
Dim Files As New List(Of NetFile) Dim Files As New List(Of NetFile)
If Info.IsNeoForge Then If Info.IsNeoForge Then
'NeoForge 'NeoForge
Dim Neo As DlNeoForgeListEntry = Info Dim NeoForge As DlNeoForgeListEntry = Info
Dim Url As String = Neo.UrlBase & "-installer.jar" Dim Url As String = NeoForge.UrlBase & "-installer.jar"
Files.Add(New NetFile({ Files.Add(New NetFile({
Url.Replace("maven.neoforged.net/releases", "bmclapi2.bangbang93.com/maven"), Url Url.Replace("maven.neoforged.net/releases", "bmclapi2.bangbang93.com/maven"), Url
}, Target, New FileChecker(MinSize:=64 * 1024))) }, Target, New FileChecker(MinSize:=64 * 1024)))
@@ -1092,9 +1091,8 @@ Retry:
SyncLock JavaLock SyncLock JavaLock
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60)) Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60))
If Java Is Nothing Then If Java Is Nothing Then
If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java,已取消安装。")
'开始自动下载 '开始自动下载
Dim JavaLoader = JavaFixLoaders(17) Dim JavaLoader = GetJavaDownloadLoader()
Try Try
JavaLoader.Start(17, IsForceRestart:=True) JavaLoader.Start(17, IsForceRestart:=True)
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted
@@ -1116,7 +1114,7 @@ Retry:
Else Else
Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}" Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}"
End If End If
If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments If Java.MajorVersion >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动 '开始启动
SyncLock InstallSyncLock SyncLock InstallSyncLock
Dim Info = New ProcessStartInfo With { Dim Info = New ProcessStartInfo With {
@@ -1247,10 +1245,10 @@ Retry:
''' <summary> ''' <summary>
''' 获取下载某个 Forgelike 版本的加载器列表。 ''' 获取下载某个 Forgelike 版本的加载器列表。
''' </summary> ''' </summary>
Private Function McDownloadForgelikeLoader(IsNeoForge As Boolean, LoaderVersion As String, TargetVersion As String, Inherit As String, Optional Info As DlForgelikeEntry = Nothing, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional ClientFolder As String = Nothing) As List(Of LoaderBase) Private Function McDownloadForgelikeLoader(IsNeoForge As Boolean, LoaderVersion As String, NewInstanceName As String, Inherit As String, Optional Info As DlForgelikeEntry = Nothing, Optional McFolder As String = Nothing, Optional ClientDownloadLoader As LoaderCombo(Of String) = Nothing, Optional ClientFolder As String = Nothing) As List(Of LoaderBase)
'参数初始化 '参数初始化
McFolder = If(McFolder, PathMcFolder) McFolder = If(McFolder, McFolderSelected)
If IsNeoForge AndAlso Info Is Nothing Then If IsNeoForge AndAlso Info Is Nothing Then
'需要传入 API Name,但整合包版本可能不以 1.20.1- 开头,所以需要进行特别处理 '需要传入 API Name,但整合包版本可能不以 1.20.1- 开头,所以需要进行特别处理
If Inherit = "1.20.1" AndAlso Not LoaderVersion.StartsWithF("1.20.1-") Then If Inherit = "1.20.1" AndAlso Not LoaderVersion.StartsWithF("1.20.1-") Then
@@ -1265,12 +1263,12 @@ Retry:
LoaderVersion = LoaderVersion.AfterLast("-") LoaderVersion = LoaderVersion.AfterLast("-")
End If End If
Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge") Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge")
Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder Dim IsCustomFolder As Boolean = McFolder <> McFolderSelected
Dim InstallerAddress As String = RequestTaskTempFolder() & "forge_installer.jar" Dim InstallerAddress As String = RequestTaskTempFolder() & "forge_installer.jar"
Dim VersionFolder As String = $"{McFolder}versions\{TargetVersion}\" Dim VersionFolder As String = $"{McFolder}versions\{NewInstanceName}\"
Dim DisplayName As String = $"{LoaderName} {Inherit} - {LoaderVersion}" Dim DisplayName As String = $"{LoaderName} {Inherit} - {LoaderVersion}"
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
Dim LibVersionFolder As String = $"{PathMcFolder}versions\{TargetVersion}\" '作为 Lib 文件目标的版本文件夹 Dim LibVersionFolder As String = $"{McFolderSelected}versions\{NewInstanceName}\" '作为 Lib 文件目标的版本文件夹
'获取 Forge 下载信息 '获取 Forge 下载信息
If Info Is Nothing Then If Info Is Nothing Then
@@ -1282,7 +1280,7 @@ Retry:
Task.Progress = 0.8 Task.Progress = 0.8
'查找对应版本 '查找对应版本
For Each ForgeVersion In ForgeLoader.Output For Each ForgeVersion In ForgeLoader.Output
If VersionSortInteger(ForgeVersion.Version.ToString, LoaderVersion) = 0 Then If CompareVersion(ForgeVersion.Version.ToString, LoaderVersion) = 0 Then
Info = ForgeVersion Info = ForgeVersion
Return Return
End If End If
@@ -1362,21 +1360,21 @@ Retry:
Exit For Exit For
End If End If
Next Next
Task.Output = McLibFixFromLibToken(Libs, PathMcFolder) Task.Output = McLibNetFilesFromTokens(Libs, McFolderSelected)
Catch ex As Exception Catch ex As Exception
Throw New Exception($"获取{If(IsNeoForge, " Neo", "新版 ")}Forge 支持库列表失败", ex) Throw New Exception($"获取{If(IsNeoForge, " Neo", "新版 ")}Forge 支持库列表失败", ex)
Finally Finally
'释放文件 '释放文件
If Installer IsNot Nothing Then Installer.Dispose() If Installer IsNot Nothing Then Installer.Dispose()
End Try End Try
End Sub) With {.ProgressWeight = 2}) End Sub) With {.ProgressWeight = 1})
Loaders.Add(New LoaderDownload($"下载 {LoaderName} 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 12}) Loaders.Add(New LoaderDownload($"下载 {LoaderName} 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 12})
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"获取 {LoaderName} 支持库文件", Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"获取 {LoaderName} 支持库文件",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
#Region "Forgelike 文件" #Region "Forgelike 文件"
If IsCustomFolder Then If IsCustomFolder Then
For Each LibFile As McLibToken In Libs For Each LibFile As McLibToken In Libs
Dim RealPath As String = LibFile.LocalPath.Replace(PathMcFolder, McFolder) Dim RealPath As String = LibFile.LocalPath.Replace(McFolderSelected, McFolder)
If Not File.Exists(RealPath) Then If Not File.Exists(RealPath) Then
Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath)) Directory.CreateDirectory(IO.Path.GetDirectoryName(RealPath))
CopyFile(LibFile.LocalPath, RealPath) CopyFile(LibFile.LocalPath, RealPath)
@@ -1458,8 +1456,8 @@ Retry:
'如果没有新增文件夹,那么预测的文件夹名就是正确的 '如果没有新增文件夹,那么预测的文件夹名就是正确的
'如果只新增 1 个文件夹,那么拷贝 json 文件 '如果只新增 1 个文件夹,那么拷贝 json 文件
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First() Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
WriteFile(VersionFolder & TargetVersion & ".json", ReadFile(JsonFile.FullName)) WriteFile(VersionFolder & NewInstanceName & ".json", ReadFile(JsonFile.FullName))
Log($"[Download] 已拷贝新增的版本 JSON 文件:{JsonFile.FullName} -> {VersionFolder}{TargetVersion}.json") Log($"[Download] 已拷贝新增的版本 JSON 文件:{JsonFile.FullName} -> {VersionFolder}{NewInstanceName}.json")
ElseIf DeltaList.Count > 1 Then ElseIf DeltaList.Count > 1 Then
'新增了多个文件夹 '新增了多个文件夹
Log($"[Download] 有多个疑似的新增版本,无法确定:{DeltaList.Select(Function(d) d.Name).Join(";")}") Log($"[Download] 有多个疑似的新增版本,无法确定:{DeltaList.Select(Function(d) d.Name).Join(";")}")
@@ -1498,8 +1496,8 @@ Retry:
Log("[Download] 开始进行 Forge 安装,Legacy 方式 1:" & InstallerAddress) Log("[Download] 开始进行 Forge 安装,Legacy 方式 1:" & InstallerAddress)
'建立 Json 文件 '建立 Json 文件
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open)) Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
JsonVersion("id") = TargetVersion JsonVersion("id") = NewInstanceName
WriteFile(VersionFolder & TargetVersion & ".json", JsonVersion.ToString) WriteFile(VersionFolder & NewInstanceName & ".json", JsonVersion.ToString)
Task.Progress = 0.6 Task.Progress = 0.6
'解压支持库文件 '解压支持库文件
Installer.Dispose() Installer.Dispose()
@@ -1515,9 +1513,9 @@ Retry:
WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open) WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
Task.Progress = 0.9 Task.Progress = 0.9
'建立 Json 文件 '建立 Json 文件
Json("versionInfo")("id") = TargetVersion Json("versionInfo")("id") = NewInstanceName
If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit) If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit)
WriteFile(VersionFolder & TargetVersion & ".json", Json("versionInfo").ToString) WriteFile(VersionFolder & NewInstanceName & ".json", Json("versionInfo").ToString)
End If End If
Catch ex As Exception Catch ex As Exception
Throw New Exception("非新版方式安装 Forge 失败", ex) Throw New Exception("非新版方式安装 Forge 失败", ex)
@@ -1549,7 +1547,7 @@ Retry:
If Entries.Any Then If Entries.Any Then
FreshVersion = Entries(0) FreshVersion = Entries(0)
Else Else
Log("[System] 未找到可用的 Forge 版本", LogLevel.Debug) Log("[System] 未找到可用的 Forge 版本")
End If End If
Dim RecommendedVersion As DlForgeVersionEntry = Nothing Dim RecommendedVersion As DlForgeVersionEntry = Nothing
For Each Entry In Entries For Each Entry In Entries
@@ -1559,19 +1557,21 @@ Retry:
If FreshVersion IsNot Nothing AndAlso FreshVersion Is RecommendedVersion Then FreshVersion = Nothing If FreshVersion IsNot Nothing AndAlso FreshVersion Is RecommendedVersion Then FreshVersion = Nothing
'显示各个版本 '显示各个版本
If RecommendedVersion IsNot Nothing Then If RecommendedVersion IsNot Nothing Then
Dim Recommended = ForgeDownloadListItem(RecommendedVersion, OnClick, IsSaveOnly) Dim Recommended = ForgeDownloadListItem(RecommendedVersion, OnClick, IsSaveOnly).Init()
Recommended.Info = "推荐版" & If(Recommended.Info = "", "", "," & Recommended.Info) Recommended.Info = "推荐版" & If(Recommended.Info = "", "", "," & Recommended.Info)
Stack.Children.Add(Recommended) Stack.Children.Add(Recommended)
End If End If
If FreshVersion IsNot Nothing Then If FreshVersion IsNot Nothing Then
Dim Fresh = ForgeDownloadListItem(FreshVersion, OnClick, IsSaveOnly) Dim Fresh = ForgeDownloadListItem(FreshVersion, OnClick, IsSaveOnly).Init()
Fresh.Info = "最新版" & If(Fresh.Info = "", "", "," & Fresh.Info) Fresh.Info = "最新版" & If(Fresh.Info = "", "", "," & Fresh.Info)
Stack.Children.Add(Fresh) Stack.Children.Add(Fresh)
End If End If
'添加间隔 '添加间隔
Stack.Children.Add(New TextBlock With {.Text = "全部版本 (" & Entries.Count & ")", .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 13, 0, 4)}) Stack.Children.Add(New TextBlock With {.Text = "全部版本 (" & Entries.Count & ")", .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 13, 0, 4)})
End Sub End Sub
Public Function ForgeDownloadListItem(Entry As DlForgeVersionEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem Public Function ForgeDownloadListItem(Entry As DlForgeVersionEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyVirtualizingElement(Of MyListItem)
Return New MyVirtualizingElement(Of MyListItem)(
Function()
'建立控件 '建立控件
Dim NewItem As New MyListItem With { Dim NewItem As New MyListItem With {
.Title = Entry.VersionName, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Title = Entry.VersionName, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
@@ -1588,6 +1588,7 @@ Retry:
End If End If
'结束 '结束
Return NewItem Return NewItem
End Function) With {.Height = 42}
End Function End Function
Private Sub ForgeContMenuBuild(sender As MyListItem, e As EventArgs) Private Sub ForgeContMenuBuild(sender As MyListItem, e As EventArgs)
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
@@ -1683,7 +1684,7 @@ Retry:
Return Nothing Return Nothing
End If End If
Dim Json As JObject = GetJson(List) Dim Json As JObject = GetJson(List)
If Json Is Nothing OrElse (Not If(McVersion, "null").Contains(".")) OrElse Not Json.ContainsKey(McVersion) Then Return Nothing If Json Is Nothing OrElse (Not If(McVersion, "").Contains(".")) OrElse Not Json.ContainsKey(McVersion) Then Return Nothing
Return If(Json(McVersion), "").ToString Return If(Json(McVersion), "").ToString
Catch ex As Exception Catch ex As Exception
Log(ex, "获取 Forge 推荐版本失败(" & If(McVersion, "null") & ")", LogLevel.Feedback) Log(ex, "获取 Forge 推荐版本失败(" & If(McVersion, "null") & ")", LogLevel.Feedback)
@@ -1715,19 +1716,21 @@ Retry:
End If End If
'显示各个版本 '显示各个版本
If FreshStableVersion IsNot Nothing Then If FreshStableVersion IsNot Nothing Then
Dim Fresh = NeoForgeDownloadListItem(FreshStableVersion, OnClick, IsSaveOnly) Dim Fresh = NeoForgeDownloadListItem(FreshStableVersion, OnClick, IsSaveOnly).Init()
Fresh.Info = If(Fresh.Info = "", "最新稳定版", "最新" & Fresh.Info) Fresh.Info = If(Fresh.Info = "", "最新稳定版", "最新" & Fresh.Info)
Stack.Children.Add(Fresh) Stack.Children.Add(Fresh)
End If End If
If FreshBetaVersion IsNot Nothing Then If FreshBetaVersion IsNot Nothing Then
Dim Fresh = NeoForgeDownloadListItem(FreshBetaVersion, OnClick, IsSaveOnly) Dim Fresh = NeoForgeDownloadListItem(FreshBetaVersion, OnClick, IsSaveOnly).Init()
Fresh.Info = If(Fresh.Info = "", "最新测试版", "最新" & Fresh.Info) Fresh.Info = If(Fresh.Info = "", "最新测试版", "最新" & Fresh.Info)
Stack.Children.Add(Fresh) Stack.Children.Add(Fresh)
End If End If
'添加间隔 '添加间隔
Stack.Children.Add(New TextBlock With {.Text = "全部版本 (" & Entries.Count & ")", .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 13, 0, 4)}) Stack.Children.Add(New TextBlock With {.Text = "全部版本 (" & Entries.Count & ")", .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 13, 0, 4)})
End Sub End Sub
Public Function NeoForgeDownloadListItem(Info As DlNeoForgeListEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyListItem Public Function NeoForgeDownloadListItem(Info As DlNeoForgeListEntry, OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) As MyVirtualizingElement(Of MyListItem)
Return New MyVirtualizingElement(Of MyListItem)(
Function()
'建立控件 '建立控件
Dim NewItem As New MyListItem With { Dim NewItem As New MyListItem With {
.Title = Info.VersionName, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Info, .Title = Info.VersionName, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Info,
@@ -1741,9 +1744,10 @@ Retry:
Else Else
NewItem.ContentHandler = AddressOf NeoForgeContMenuBuild NewItem.ContentHandler = AddressOf NeoForgeContMenuBuild
End If End If
'结束
Return NewItem Return NewItem
End Function End Function
) With {.Height = 42}
End Function
Private Sub NeoForgeContMenuBuild(sender As MyListItem, e As EventArgs) Private Sub NeoForgeContMenuBuild(sender As MyListItem, e As EventArgs)
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center) ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
@@ -1832,8 +1836,8 @@ Retry:
Private Function McDownloadFabricLoader(FabricVersion As String, MinecraftName As String, Optional McFolder As String = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase) Private Function McDownloadFabricLoader(FabricVersion As String, MinecraftName As String, Optional McFolder As String = Nothing, Optional FixLibrary As Boolean = True) As List(Of LoaderBase)
'参数初始化 '参数初始化
McFolder = If(McFolder, PathMcFolder) McFolder = If(McFolder, McFolderSelected)
Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder Dim IsCustomFolder As Boolean = McFolder <> McFolderSelected
Dim Id As String = "fabric-loader-" & FabricVersion & "-" & MinecraftName Dim Id As String = "fabric-loader-" & FabricVersion & "-" & MinecraftName
Dim VersionFolder As String = McFolder & "versions\" & Id & "\" Dim VersionFolder As String = McFolder & "versions\" & Id & "\"
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
@@ -1858,7 +1862,7 @@ Retry:
'下载支持库 '下载支持库
If FixLibrary Then If FixLibrary Then
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Fabric 支持库文件", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Fabric 支持库文件",
Sub(Task) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) Sub(Task) Task.Output = McLibNetFilesFromInstance(New McInstance(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
Loaders.Add(New LoaderDownload("下载 Fabric 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 8}) Loaders.Add(New LoaderDownload("下载 Fabric 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 8})
End If End If
@@ -1869,38 +1873,41 @@ Retry:
#Region "Fabric 下载菜单" #Region "Fabric 下载菜单"
Public Function FabricDownloadListItem(Entry As JObject, OnClick As MyListItem.ClickEventHandler) As MyListItem Public Function FabricDownloadListItem(Entry As JObject, OnClick As MyListItem.ClickEventHandler) As MyVirtualizingElement(Of MyListItem)
'建立控件 Return New MyVirtualizingElement(Of MyListItem)(
Function()
Dim NewItem As New MyListItem With { Dim NewItem As New MyListItem With {
.Title = Entry("version").ToString.Replace("+build", ""), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Title = Entry("version").ToString.Replace("+build", ""), .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = If(Entry("stable").ToObject(Of Boolean), "稳定版", "测试版"), .Info = If(Entry("stable").ToObject(Of Boolean), "稳定版", "测试版"),
.Logo = PathImage & "Blocks/Fabric.png" .Logo = PathImage & "Blocks/Fabric.png"
} }
AddHandler NewItem.Click, OnClick AddHandler NewItem.Click, OnClick
'结束
Return NewItem Return NewItem
End Function) With {.Height = 42}
End Function End Function
Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyVirtualizingElement(Of MyListItem)
'建立控件 Return New MyVirtualizingElement(Of MyListItem)(
Function()
Dim NewItem As New MyListItem With { Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").BeforeFirst("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").BeforeFirst("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"), .Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Logo = PathImage & "Blocks/Fabric.png" .Logo = PathImage & "Blocks/Fabric.png"
} }
AddHandler NewItem.Click, OnClick AddHandler NewItem.Click, OnClick
'结束
Return NewItem Return NewItem
End Function) With {.Height = 42}
End Function End Function
Public Function OptiFabricDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem Public Function OptiFabricDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyVirtualizingElement(Of MyListItem)
'建立控件 Return New MyVirtualizingElement(Of MyListItem)(
Function()
Dim NewItem As New MyListItem With { 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, .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"), .Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Logo = PathImage & "Blocks/OptiFabric.png" .Logo = PathImage & "Blocks/OptiFabric.png"
} }
AddHandler NewItem.Click, OnClick AddHandler NewItem.Click, OnClick
'结束
Return NewItem Return NewItem
End Function) With {.Height = 42}
End Function End Function
#End Region #End Region
@@ -1915,11 +1922,11 @@ Retry:
''' <summary> ''' <summary>
''' 必填。安装目标版本名称。 ''' 必填。安装目标版本名称。
''' </summary> ''' </summary>
Public TargetVersionName As String Public NewInstanceName As String
''' <summary> ''' <summary>
''' 必填。安装目标文件夹。 ''' 必填。安装目标文件夹。
''' </summary> ''' </summary>
Public TargetVersionFolder As String Public VersionFolder As String
''' <summary> ''' <summary>
''' 必填。欲下载的 Minecraft 的版本名。 ''' 必填。欲下载的 Minecraft 的版本名。
@@ -2002,7 +2009,7 @@ Retry:
Public Sub McInstallState(Loader As LoaderBase) Public Sub McInstallState(Loader As LoaderBase)
Select Case Loader.State Select Case Loader.State
Case LoadState.Finished Case LoadState.Finished
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '清空缓存(合并安装会先生成文件夹,这会在刷新时误判为可以使用缓存) WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '清空缓存(合并安装会先生成文件夹,这会在刷新时误判为可以使用缓存)
Hint(Loader.Name & "成功!", HintType.Green) Hint(Loader.Name & "成功!", HintType.Green)
Case LoadState.Failed Case LoadState.Failed
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red) Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red)
@@ -2012,7 +2019,7 @@ Retry:
Return '不重新加载版本列表 Return '不重新加载版本列表
End Select End Select
McInstallFailedClearFolder(Loader) McInstallFailedClearFolder(Loader)
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub End Sub
Public Sub McInstallFailedClearFolder(Loader) Public Sub McInstallFailedClearFolder(Loader)
Try Try
@@ -2038,10 +2045,10 @@ Retry:
Try Try
Dim SubLoaders = McInstallLoader(Request) Dim SubLoaders = McInstallLoader(Request)
If SubLoaders Is Nothing Then Return False If SubLoaders Is Nothing Then Return False
Dim Loader As New LoaderCombo(Of String)(Request.TargetVersionName & " 安装", SubLoaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(Request.NewInstanceName & " 安装", SubLoaders) With {.OnStateChanged = AddressOf McInstallState}
'启动 '启动
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
@@ -2063,21 +2070,21 @@ Retry:
Dim TempMcFolder As String = RequestTaskTempFolder(Request.OptiFineEntry IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing) Dim TempMcFolder As String = RequestTaskTempFolder(Request.OptiFineEntry IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing)
'获取参数 '获取参数
Dim VersionFolder As String = PathMcFolder & "versions\" & Request.TargetVersionName & "\" Dim VersionFolder As String = McFolderSelected & "versions\" & Request.NewInstanceName & "\"
If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder) If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder)
Dim OptiFineFolder As String = Nothing Dim OptiFineFolder As String = Nothing
If Request.OptiFineVersion IsNot Nothing Then If Request.OptiFineVersion IsNot Nothing Then
If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.AfterLast("_HD_U_") '#735 If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.AfterLast("_HD_U_") '#735
Request.OptiFineEntry = New DlOptiFineListEntry With { Request.OptiFineEntry = New DlOptiFineListEntry With {
.NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"), .DisplayName = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"),
.Inherit = Request.MinecraftName, .Inherit = Request.MinecraftName,
.IsPreview = Request.OptiFineVersion.ContainsF("pre", True), .IsPreview = Request.OptiFineVersion.ContainsF("pre", True),
.NameVersion = Request.MinecraftName & "-OptiFine_" & Request.OptiFineVersion, .InstanceName = Request.MinecraftName & "-OptiFine_" & Request.OptiFineVersion,
.NameFile = If(Request.OptiFineVersion.ContainsF("pre", True), "preview_", "") & .FileName = If(Request.OptiFineVersion.ContainsF("pre", True), "preview_", "") &
"OptiFine_" & Request.MinecraftName & "_" & Request.OptiFineVersion & ".jar" "OptiFine_" & Request.MinecraftName & "_" & Request.OptiFineVersion & ".jar"
} }
End If End If
If Request.OptiFineEntry IsNot Nothing Then OptiFineFolder = TempMcFolder & "versions\" & Request.OptiFineEntry.NameVersion If Request.OptiFineEntry IsNot Nothing Then OptiFineFolder = TempMcFolder & "versions\" & Request.OptiFineEntry.InstanceName
Dim ForgeFolder As String = Nothing Dim ForgeFolder As String = Nothing
If Request.ForgeEntry IsNot Nothing Then Request.ForgeVersion = If(Request.ForgeVersion, Request.ForgeEntry.VersionName) If Request.ForgeEntry IsNot Nothing Then Request.ForgeVersion = If(Request.ForgeVersion, Request.ForgeEntry.VersionName)
If Request.ForgeVersion IsNot Nothing Then ForgeFolder = TempMcFolder & "versions\forge-" & Request.ForgeVersion If Request.ForgeVersion IsNot Nothing Then ForgeFolder = TempMcFolder & "versions\forge-" & Request.ForgeVersion
@@ -2107,8 +2114,8 @@ Retry:
Log("[Download] 对应的原版版本:" & Request.MinecraftName) Log("[Download] 对应的原版版本:" & Request.MinecraftName)
'重复版本检查 '重复版本检查
If File.Exists($"{VersionFolder}{Request.TargetVersionName}.json") Then If File.Exists($"{VersionFolder}{Request.NewInstanceName}.json") Then
Hint("版本 " & Request.TargetVersionName & " 已经存在!", HintType.Red) Hint("版本 " & Request.NewInstanceName & " 已经存在!", HintType.Red)
Throw New CancelledException Throw New CancelledException
End If End If
@@ -2124,27 +2131,27 @@ Retry:
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False}) LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False})
End If End If
'原版 '原版
Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.TargetVersionName)) With {.Show = False, .ProgressWeight = 39, Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.NewInstanceName)) With {.Show = False, .ProgressWeight = 39,
.Block = Request.ForgeVersion Is Nothing AndAlso Request.NeoForgeVersion Is Nothing AndAlso Request.OptiFineEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing} .Block = Request.ForgeVersion Is Nothing AndAlso Request.NeoForgeVersion Is Nothing AndAlso Request.OptiFineEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}
LoaderList.Add(ClientLoader) LoaderList.Add(ClientLoader)
'OptiFine 'OptiFine
If Request.OptiFineEntry IsNot Nothing Then If Request.OptiFineEntry IsNot Nothing Then
If OptiFineAsMod Then If OptiFineAsMod Then
LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.NameDisplay, McDownloadOptiFineSaveLoader(Request.OptiFineEntry, OptiFineFolder & Request.OptiFineEntry.NameFile)) With {.Show = False, .ProgressWeight = 16, LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.DisplayName, McDownloadOptiFineSaveLoader(Request.OptiFineEntry, OptiFineFolder & Request.OptiFineEntry.FileName)) With {.Show = False, .ProgressWeight = 16,
.Block = Request.ForgeVersion Is Nothing AndAlso Request.NeoForgeVersion Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}) .Block = Request.ForgeVersion Is Nothing AndAlso Request.NeoForgeVersion Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
Else Else
LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.NameDisplay, McDownloadOptiFineLoader(Request.OptiFineEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder, False)) With {.Show = False, .ProgressWeight = 24, LoaderList.Add(New LoaderCombo(Of String)("下载 OptiFine " & Request.OptiFineEntry.DisplayName, McDownloadOptiFineLoader(Request.OptiFineEntry, TempMcFolder, ClientLoader, Request.VersionFolder, False)) With {.Show = False, .ProgressWeight = 24,
.Block = Request.ForgeVersion Is Nothing AndAlso Request.NeoForgeVersion Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}) .Block = Request.ForgeVersion Is Nothing AndAlso Request.NeoForgeVersion Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
End If End If
End If End If
'Forge 'Forge
If Request.ForgeVersion IsNot Nothing Then If Request.ForgeVersion IsNot Nothing Then
LoaderList.Add(New LoaderCombo(Of String)("下载 Forge " & Request.ForgeVersion, McDownloadForgelikeLoader(False, Request.ForgeVersion, "forge-" & Request.ForgeVersion, Request.MinecraftName, Request.ForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder)) With {.Show = False, .ProgressWeight = 25, LoaderList.Add(New LoaderCombo(Of String)("下载 Forge " & Request.ForgeVersion, McDownloadForgelikeLoader(False, Request.ForgeVersion, "forge-" & Request.ForgeVersion, Request.MinecraftName, Request.ForgeEntry, TempMcFolder, ClientLoader, Request.VersionFolder)) With {.Show = False, .ProgressWeight = 25,
.Block = Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing AndAlso Request.NeoForgeEntry Is Nothing}) .Block = Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing AndAlso Request.NeoForgeEntry Is Nothing})
End If End If
'NeoForge 'NeoForge
If Request.NeoForgeVersion IsNot Nothing Then If Request.NeoForgeVersion IsNot Nothing Then
LoaderList.Add(New LoaderCombo(Of String)("下载 NeoForge " & Request.NeoForgeVersion, McDownloadForgelikeLoader(True, Request.NeoForgeVersion, "neoforge-" & Request.NeoForgeVersion, Request.MinecraftName, Request.NeoForgeEntry, TempMcFolder, ClientLoader, Request.TargetVersionFolder)) With {.Show = False, .ProgressWeight = 25, LoaderList.Add(New LoaderCombo(Of String)("下载 NeoForge " & Request.NeoForgeVersion, McDownloadForgelikeLoader(True, Request.NeoForgeVersion, "neoforge-" & Request.NeoForgeVersion, Request.MinecraftName, Request.NeoForgeEntry, TempMcFolder, ClientLoader, Request.VersionFolder)) With {.Show = False, .ProgressWeight = 25,
.Block = Request.ForgeEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}) .Block = Request.ForgeEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing})
End If End If
'LiteLoader 'LiteLoader
@@ -2164,24 +2171,24 @@ Retry:
MergeJson(VersionFolder, VersionFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder) MergeJson(VersionFolder, VersionFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.2 Task.Progress = 0.2
'迁移文件 '迁移文件
If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", PathMcFolder & "libraries") If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", McFolderSelected & "libraries")
Task.Progress = 0.8 Task.Progress = 0.8
'创建 Mod 和资源包文件夹 '创建 Mod 和资源包文件夹
Dim ModsFolder = New McVersion(VersionFolder).PathIndie & "mods\" '版本隔离信息在此时被决定 Dim ModsFolder = New McInstance(VersionFolder).PathIndie & "mods\" '版本隔离信息在此时被决定
If Directory.Exists(ModsTempFolder) Then If Directory.Exists(ModsTempFolder) Then
CopyDirectory(ModsTempFolder, ModsFolder) CopyDirectory(ModsTempFolder, ModsFolder)
ElseIf Modable Then ElseIf Modable Then
Directory.CreateDirectory(ModsFolder) Directory.CreateDirectory(ModsFolder)
Log("[Download] 自动创建 Mod 文件夹:" & ModsFolder) Log("[Download] 自动创建 Mod 文件夹:" & ModsFolder)
End If End If
Dim ResourcepacksFolder = New McVersion(VersionFolder).PathIndie & "resourcepacks\" Dim ResourcepacksFolder = New McInstance(VersionFolder).PathIndie & "resourcepacks\"
Directory.CreateDirectory(ResourcepacksFolder) Directory.CreateDirectory(ResourcepacksFolder)
Log("[Download] 自动创建资源包文件夹:" & ResourcepacksFolder) Log("[Download] 自动创建资源包文件夹:" & ResourcepacksFolder)
End Sub) With {.ProgressWeight = 2, .Block = True}) End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件 '补全文件
If Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then If Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task) Task.Output = McLibNetFilesFromInstance(New McInstance(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False}) LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
LoaderList.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) LoaderList.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
End If End If
@@ -14,9 +14,9 @@
DlNeoForgeListLoader.Start() DlNeoForgeListLoader.Start()
'重载预览 '重载预览
TextSelectName.ValidateRules = New ObjectModel.Collection(Of Validate) From {New ValidateFolderName(PathMcFolder & "versions")} TextSelectName.ValidateRules = New ObjectModel.Collection(Of Validate) From {New ValidateFolderName(McFolderSelected & "versions")}
TextSelectName.Validate() TextSelectName.Validate()
SelectReload() ReloadSelected()
'非重复加载部分 '非重复加载部分
If IsLoad Then Return If IsLoad Then Return
@@ -71,10 +71,10 @@
Next Next
'启动 Forge 加载 '启动 Forge 加载
If SelectedMinecraftId.StartsWith("1.") Then If McVersion.IsFormatFit(VanillaName) Then
Dim ForgeLoader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion " & SelectedMinecraftId, AddressOf DlForgeVersionMain) Dim ForgeLoader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion " & VanillaName, AddressOf DlForgeVersionMain)
LoadForge.State = ForgeLoader LoadForge.State = ForgeLoader
ForgeLoader.Start(SelectedMinecraftId) ForgeLoader.Start(VanillaName)
End If End If
'启动 Fabric API、OptiFabric 加载 '启动 Fabric API、OptiFabric 加载
@@ -95,7 +95,7 @@
Fabric_Loaded() Fabric_Loaded()
FabricApi_Loaded() FabricApi_Loaded()
OptiFabric_Loaded() OptiFabric_Loaded()
SelectReload() ReloadSelected()
PanMinecraft.Visibility = Visibility.Collapsed PanMinecraft.Visibility = Visibility.Collapsed
End Sub, After:=True), End Sub, After:=True),
AaOpacity(PanSelect, 1 - PanSelect.Opacity, 70, 100), AaOpacity(PanSelect, 1 - PanSelect.Opacity, 70, 100),
@@ -124,7 +124,7 @@
DisabledPageAnimControls.Add(BtnStart) DisabledPageAnimControls.Add(BtnStart)
BtnStart.Show = False BtnStart.Show = False
SelectClear() '清除已选择项 ClearSelected() '清除已选择项
PanMinecraft.Visibility = Visibility.Visible PanMinecraft.Visibility = Visibility.Visible
PanSelect.IsHitTestVisible = False PanSelect.IsHitTestVisible = False
PanMinecraft.IsHitTestVisible = True PanMinecraft.IsHitTestVisible = True
@@ -145,9 +145,9 @@
}, "FrmDownloadInstall SelectPageSwitch") }, "FrmDownloadInstall SelectPageSwitch")
End Sub End Sub
Public Sub MinecraftSelected(sender As MyListItem, e As MouseButtonEventArgs) Public Sub MinecraftSelected(sender As MyListItem, e As MouseButtonEventArgs)
SelectedMinecraftId = sender.Title VanillaName = sender.Title
SelectedMinecraftJsonUrl = sender.Tag("url").ToString VanillaData = sender.Tag
SelectedMinecraftIcon = sender.Logo VanillaIcon = sender.Logo
EnterSelectPage() EnterSelectPage()
End Sub End Sub
@@ -156,157 +156,31 @@
#Region "选择" #Region "选择"
'Minecraft 'Minecraft
Private SelectedMinecraftId As String Private VanillaName As String
Private SelectedMinecraftJsonUrl As String Private VanillaData As JObject
Private SelectedMinecraftIcon As String Private VanillaIcon As String
Private ReadOnly Property VanillaDrop As Integer
Get
Return McVersion.VersionToDrop(VanillaName, True)
End Get
End Property
'OptiFine '附加组件
Private SelectedOptiFine As DlOptiFineListEntry = Nothing Private SelectedOptiFine As DlOptiFineListEntry = Nothing
Private Sub SetOptiFineInfoShow(IsShow As String)
If PanOptiFineInfo.Tag = IsShow Then Return
PanOptiFineInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanOptiFineInfo, -CType(PanOptiFineInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanOptiFineInfo, 1 - PanOptiFineInfo.Opacity, 80, 90)
}, "SetOptiFineInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanOptiFineInfo, 6 - CType(PanOptiFineInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanOptiFineInfo, -PanOptiFineInfo.Opacity, 50)
}, "SetOptiFineInfoShow")
End If
End Sub
'LiteLoader
Private SelectedLiteLoader As DlLiteLoaderListEntry = Nothing Private SelectedLiteLoader As DlLiteLoaderListEntry = Nothing
Private Sub SetLiteLoaderInfoShow(IsShow As String)
If PanLiteLoaderInfo.Tag = IsShow Then Return
PanLiteLoaderInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanLiteLoaderInfo, -CType(PanLiteLoaderInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanLiteLoaderInfo, 1 - PanLiteLoaderInfo.Opacity, 80, 90)
}, "SetLiteLoaderInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanLiteLoaderInfo, 6 - CType(PanLiteLoaderInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanLiteLoaderInfo, -PanLiteLoaderInfo.Opacity, 50)
}, "SetLiteLoaderInfoShow")
End If
End Sub
'Forge
Private SelectedForge As DlForgeVersionEntry = Nothing Private SelectedForge As DlForgeVersionEntry = Nothing
Private Sub SetForgeInfoShow(IsShow As String)
If PanForgeInfo.Tag = IsShow Then Return
PanForgeInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanForgeInfo, -CType(PanForgeInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanForgeInfo, 1 - PanForgeInfo.Opacity, 80, 90)
}, "SetForgeInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanForgeInfo, 6 - CType(PanForgeInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanForgeInfo, -PanForgeInfo.Opacity, 50)
}, "SetForgeInfoShow")
End If
End Sub
'NeoForge
Private SelectedNeoForge As DlNeoForgeListEntry = Nothing Private SelectedNeoForge As DlNeoForgeListEntry = Nothing
Private Sub SetNeoForgeInfoShow(IsShow As String)
If PanNeoForgeInfo.Tag = IsShow Then Return
PanNeoForgeInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanNeoForgeInfo, -CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanNeoForgeInfo, 1 - PanNeoForgeInfo.Opacity, 80, 90)
}, "SetNeoForgeInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanNeoForgeInfo, 6 - CType(PanNeoForgeInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanNeoForgeInfo, -PanNeoForgeInfo.Opacity, 50)
}, "SetNeoForgeInfoShow")
End If
End Sub
'Fabric
Private SelectedFabric As String = Nothing Private SelectedFabric As String = Nothing
Private Sub SetFabricInfoShow(IsShow As String)
If PanFabricInfo.Tag = IsShow Then Return
PanFabricInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanFabricInfo, -CType(PanFabricInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanFabricInfo, 1 - PanFabricInfo.Opacity, 80, 90)
}, "SetFabricInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanFabricInfo, 6 - CType(PanFabricInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanFabricInfo, -PanFabricInfo.Opacity, 50)
}, "SetFabricInfoShow")
End If
End Sub
'FabricApi
Private SelectedFabricApi As CompFile = Nothing Private SelectedFabricApi As CompFile = Nothing
Private Sub SetFabricApiInfoShow(IsShow As String)
If PanFabricApiInfo.Tag = IsShow Then Return
PanFabricApiInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanFabricApiInfo, -CType(PanFabricApiInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanFabricApiInfo, 1 - PanFabricApiInfo.Opacity, 80, 90)
}, "SetFabricApiInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanFabricApiInfo, 6 - CType(PanFabricApiInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanFabricApiInfo, -PanFabricApiInfo.Opacity, 50)
}, "SetFabricApiInfoShow")
End If
End Sub
'OptiFabric
Private SelectedOptiFabric As CompFile = Nothing Private SelectedOptiFabric As CompFile = Nothing
Private Sub SetOptiFabricInfoShow(IsShow As String)
If PanOptiFabricInfo.Tag = IsShow Then Return
PanOptiFabricInfo.Tag = IsShow
If IsShow = "True" Then
'显示信息栏
AniStart({
AaTranslateY(PanOptiFabricInfo, -CType(PanOptiFabricInfo.RenderTransform, TranslateTransform).Y, 200, 100, Ease:=New AniEaseOutFluent),
AaOpacity(PanOptiFabricInfo, 1 - PanOptiFabricInfo.Opacity, 80, 90)
}, "SetOptiFabricInfoShow")
Else
'隐藏信息栏
AniStart({
AaTranslateY(PanOptiFabricInfo, 6 - CType(PanOptiFabricInfo.RenderTransform, TranslateTransform).Y, 120),
AaOpacity(PanOptiFabricInfo, -PanOptiFabricInfo.Opacity, 50)
}, "SetOptiFabricInfoShow")
End If
End Sub
Private IsReloading As Boolean = False '#3742 中,LoadOptiFineGetError 会初始化 LoadOptiFine,触发事件 LoadOptiFine.StateChanged,导致再次调用 SelectReload
''' <summary> ''' <summary>
''' 重载已选择的项目的显示。 ''' 重载已选择的项目的显示。
''' </summary> ''' </summary>
Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardNeoForge.Swap, LoadNeoForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged Private Sub ReloadSelected() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardNeoForge.Swap, LoadNeoForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
If SelectedMinecraftId Is Nothing OrElse IsReloading Then Return Static Ongoing As Boolean = False '#3742 中,LoadOptiFineGetError 会初始化 LoadOptiFine,触发事件 LoadOptiFine.StateChanged,导致再次调用 SelectReload
IsReloading = True If VanillaName Is Nothing OrElse Ongoing Then Return
Ongoing = True
'主预览 '主预览
SelectNameUpdate() SelectNameUpdate()
ImgLogo.Source = GetSelectLogo() ImgLogo.Source = GetSelectLogo()
@@ -314,7 +188,7 @@
Dim OptiFineError As String = LoadOptiFineGetError() Dim OptiFineError As String = LoadOptiFineGetError()
CardOptiFine.MainSwap.Visibility = If(OptiFineError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardOptiFine.MainSwap.Visibility = If(OptiFineError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If OptiFineError IsNot Nothing Then CardOptiFine.IsSwapped = True '例如在同时展开卡片时选择了不兼容项则强制折叠 If OptiFineError IsNot Nothing Then CardOptiFine.IsSwapped = True '例如在同时展开卡片时选择了不兼容项则强制折叠
SetOptiFineInfoShow(CardOptiFine.IsSwapped) SetPanelVisibility(PanOptiFineInfo, CardOptiFine.IsSwapped)
If SelectedOptiFine Is Nothing Then If SelectedOptiFine Is Nothing Then
BtnOptiFineClear.Visibility = Visibility.Collapsed BtnOptiFineClear.Visibility = Visibility.Collapsed
ImgOptiFine.Visibility = Visibility.Collapsed ImgOptiFine.Visibility = Visibility.Collapsed
@@ -323,18 +197,18 @@
Else Else
BtnOptiFineClear.Visibility = Visibility.Visible BtnOptiFineClear.Visibility = Visibility.Visible
ImgOptiFine.Visibility = Visibility.Visible ImgOptiFine.Visibility = Visibility.Visible
LabOptiFine.Text = SelectedOptiFine.NameDisplay.Replace(SelectedMinecraftId & " ", "") LabOptiFine.Text = SelectedOptiFine.DisplayName.Replace(VanillaName & " ", "")
LabOptiFine.Foreground = ColorGray1 LabOptiFine.Foreground = ColorGray1
End If End If
'LiteLoader 'LiteLoader
If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then If VanillaDrop >= 130 Then
CardLiteLoader.Visibility = Visibility.Collapsed CardLiteLoader.Visibility = Visibility.Collapsed
Else Else
CardLiteLoader.Visibility = Visibility.Visible CardLiteLoader.Visibility = Visibility.Visible
Dim LiteLoaderError As String = LoadLiteLoaderGetError() Dim LiteLoaderError As String = LoadLiteLoaderGetError()
CardLiteLoader.MainSwap.Visibility = If(LiteLoaderError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardLiteLoader.MainSwap.Visibility = If(LiteLoaderError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If LiteLoaderError IsNot Nothing Then CardLiteLoader.IsSwapped = True '例如在同时展开卡片时选择了不兼容项则强制折叠 If LiteLoaderError IsNot Nothing Then CardLiteLoader.IsSwapped = True '例如在同时展开卡片时选择了不兼容项则强制折叠
SetLiteLoaderInfoShow(CardLiteLoader.IsSwapped) SetPanelVisibility(PanLiteLoaderInfo, CardLiteLoader.IsSwapped)
If SelectedLiteLoader Is Nothing Then If SelectedLiteLoader Is Nothing Then
BtnLiteLoaderClear.Visibility = Visibility.Collapsed BtnLiteLoaderClear.Visibility = Visibility.Collapsed
ImgLiteLoader.Visibility = Visibility.Collapsed ImgLiteLoader.Visibility = Visibility.Collapsed
@@ -348,10 +222,14 @@
End If End If
End If End If
'Forge 'Forge
If Not McVersion.IsFormatFit(VanillaName) Then
CardForge.Visibility = Visibility.Collapsed
Else
CardForge.Visibility = Visibility.Visible
Dim ForgeError As String = LoadForgeGetError() Dim ForgeError As String = LoadForgeGetError()
CardForge.MainSwap.Visibility = If(ForgeError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardForge.MainSwap.Visibility = If(ForgeError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If ForgeError IsNot Nothing Then CardForge.IsSwapped = True If ForgeError IsNot Nothing Then CardForge.IsSwapped = True
SetForgeInfoShow(CardForge.IsSwapped) SetPanelVisibility(PanForgeInfo, CardForge.IsSwapped)
If SelectedForge Is Nothing Then If SelectedForge Is Nothing Then
BtnForgeClear.Visibility = Visibility.Collapsed BtnForgeClear.Visibility = Visibility.Collapsed
ImgForge.Visibility = Visibility.Collapsed ImgForge.Visibility = Visibility.Collapsed
@@ -363,15 +241,16 @@
LabForge.Text = SelectedForge.VersionName LabForge.Text = SelectedForge.VersionName
LabForge.Foreground = ColorGray1 LabForge.Foreground = ColorGray1
End If End If
End If
'NeoForge 'NeoForge
If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) <= 19 Then If VanillaData("releaseTime").ToObject(Of Date) < New Date(2023, 6, 11) Then '匹配 1.20.1+ 与一些愚人节版本
CardNeoForge.Visibility = Visibility.Collapsed CardNeoForge.Visibility = Visibility.Collapsed
Else Else
CardNeoForge.Visibility = Visibility.Visible CardNeoForge.Visibility = Visibility.Visible
Dim NeoForgeError As String = LoadNeoForgeGetError() Dim NeoForgeError As String = LoadNeoForgeGetError()
CardNeoForge.MainSwap.Visibility = If(NeoForgeError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardNeoForge.MainSwap.Visibility = If(NeoForgeError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If NeoForgeError IsNot Nothing Then CardNeoForge.IsSwapped = True If NeoForgeError IsNot Nothing Then CardNeoForge.IsSwapped = True
SetNeoForgeInfoShow(CardNeoForge.IsSwapped) SetPanelVisibility(PanNeoForgeInfo, CardNeoForge.IsSwapped)
If SelectedNeoForge Is Nothing Then If SelectedNeoForge Is Nothing Then
BtnNeoForgeClear.Visibility = Visibility.Collapsed BtnNeoForgeClear.Visibility = Visibility.Collapsed
ImgNeoForge.Visibility = Visibility.Collapsed ImgNeoForge.Visibility = Visibility.Collapsed
@@ -385,14 +264,14 @@
End If End If
End If End If
'Fabric 'Fabric
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) <= 13 Then If VanillaDrop <= 130 Then
CardFabric.Visibility = Visibility.Collapsed CardFabric.Visibility = Visibility.Collapsed
Else Else
CardFabric.Visibility = Visibility.Visible CardFabric.Visibility = Visibility.Visible
Dim FabricError As String = LoadFabricGetError() Dim FabricError As String = LoadFabricGetError()
CardFabric.MainSwap.Visibility = If(FabricError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardFabric.MainSwap.Visibility = If(FabricError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If FabricError IsNot Nothing Then CardFabric.IsSwapped = True If FabricError IsNot Nothing Then CardFabric.IsSwapped = True
SetFabricInfoShow(CardFabric.IsSwapped) SetPanelVisibility(PanFabricInfo, CardFabric.IsSwapped)
If SelectedFabric Is Nothing Then If SelectedFabric Is Nothing Then
BtnFabricClear.Visibility = Visibility.Collapsed BtnFabricClear.Visibility = Visibility.Collapsed
ImgFabric.Visibility = Visibility.Collapsed ImgFabric.Visibility = Visibility.Collapsed
@@ -413,7 +292,7 @@
Dim FabricApiError As String = LoadFabricApiGetError() Dim FabricApiError As String = LoadFabricApiGetError()
CardFabricApi.MainSwap.Visibility = If(FabricApiError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardFabricApi.MainSwap.Visibility = If(FabricApiError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If FabricApiError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardFabricApi.IsSwapped = True If FabricApiError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardFabricApi.IsSwapped = True
SetFabricApiInfoShow(CardFabricApi.IsSwapped) SetPanelVisibility(PanFabricApiInfo, CardFabricApi.IsSwapped)
If SelectedFabricApi Is Nothing Then If SelectedFabricApi Is Nothing Then
BtnFabricApiClear.Visibility = Visibility.Collapsed BtnFabricApiClear.Visibility = Visibility.Collapsed
ImgFabricApi.Visibility = Visibility.Collapsed ImgFabricApi.Visibility = Visibility.Collapsed
@@ -434,7 +313,7 @@
Dim OptiFabricError As String = LoadOptiFabricGetError() Dim OptiFabricError As String = LoadOptiFabricGetError()
CardOptiFabric.MainSwap.Visibility = If(OptiFabricError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardOptiFabric.MainSwap.Visibility = If(OptiFabricError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If OptiFabricError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardOptiFabric.IsSwapped = True If OptiFabricError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardOptiFabric.IsSwapped = True
SetOptiFabricInfoShow(CardOptiFabric.IsSwapped) SetPanelVisibility(PanOptiFabricInfo, CardOptiFabric.IsSwapped)
If SelectedOptiFabric Is Nothing Then If SelectedOptiFabric Is Nothing Then
BtnOptiFabricClear.Visibility = Visibility.Collapsed BtnOptiFabricClear.Visibility = Visibility.Collapsed
ImgOptiFabric.Visibility = Visibility.Collapsed ImgOptiFabric.Visibility = Visibility.Collapsed
@@ -454,7 +333,7 @@
HintFabricAPI.Visibility = Visibility.Collapsed HintFabricAPI.Visibility = Visibility.Collapsed
End If End If
If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then If VanillaDrop >= 140 AndAlso VanillaDrop <= 150 Then
HintOptiFabric.Visibility = Visibility.Collapsed HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Visible HintOptiFabricOld.Visibility = Visibility.Visible
Else Else
@@ -465,22 +344,22 @@
HintOptiFabric.Visibility = Visibility.Collapsed HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Collapsed HintOptiFabricOld.Visibility = Visibility.Collapsed
End If End If
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) >= 16 AndAlso SelectedOptiFine IsNot Nothing AndAlso If VanillaDrop >= 160 AndAlso SelectedOptiFine IsNot Nothing AndAlso
(SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) Then (SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) Then
HintModOptiFine.Visibility = Visibility.Visible HintModOptiFine.Visibility = Visibility.Visible
Else Else
HintModOptiFine.Visibility = Visibility.Collapsed HintModOptiFine.Visibility = Visibility.Collapsed
End If End If
'结束 '结束
IsReloading = False Ongoing = False
End Sub End Sub
''' <summary> ''' <summary>
''' 清空已选择的项目。 ''' 清空已选择的项目。
''' </summary> ''' </summary>
Private Sub SelectClear() Private Sub ClearSelected()
SelectedMinecraftId = Nothing VanillaName = Nothing
SelectedMinecraftJsonUrl = Nothing VanillaData = Nothing
SelectedMinecraftIcon = Nothing VanillaIcon = Nothing
SelectedOptiFine = Nothing SelectedOptiFine = Nothing
SelectedLiteLoader = Nothing SelectedLiteLoader = Nothing
SelectedForge = Nothing SelectedForge = Nothing
@@ -488,6 +367,23 @@
SelectedFabric = Nothing SelectedFabric = Nothing
SelectedFabricApi = Nothing SelectedFabricApi = Nothing
SelectedOptiFabric = Nothing SelectedOptiFabric = Nothing
IsSelectNameEdited = False
End Sub
'信息栏动画
Private Sub SetPanelVisibility(Panel As Grid, IsVisible As Boolean)
If Panel.Tag = IsVisible.ToString Then Return
Panel.Tag = IsVisible.ToString
If IsVisible Then
AniStart({
AaTranslateY(Panel, -CType(Panel.RenderTransform, TranslateTransform).Y, 150, Ease:=New AniEaseOutFluent),
AaOpacity(Panel, 1 - Panel.Opacity, 60)
}, "PageDownloadInstall Visibility " & Panel.Name)
Else
AniStart({
AaTranslateY(Panel, 6 - CType(Panel.RenderTransform, TranslateTransform).Y, 60),
AaOpacity(Panel, -Panel.Opacity, 60)
}, "PageDownloadInstall Visibility " & Panel.Name)
End If
End Sub End Sub
''' <summary> ''' <summary>
@@ -505,7 +401,7 @@
ElseIf SelectedOptiFine IsNot Nothing Then ElseIf SelectedOptiFine IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/GrassPath.png" Return "pack://application:,,,/images/Blocks/GrassPath.png"
Else Else
Return SelectedMinecraftIcon Return VanillaIcon
End If End If
End Function End Function
@@ -514,22 +410,12 @@
''' 获取默认版本名。 ''' 获取默认版本名。
''' </summary> ''' </summary>
Private Function GetSelectName() As String Private Function GetSelectName() As String
Dim Name As String = SelectedMinecraftId Dim Name As String = VanillaName
If SelectedFabric IsNot Nothing Then If SelectedFabric IsNot Nothing Then Name += "-Fabric " & SelectedFabric.BeforeFirst("+")
Name += "-Fabric " & SelectedFabric.Replace("+build", "") If SelectedForge IsNot Nothing Then Name += "-Forge_" & SelectedForge.VersionName
End If If SelectedNeoForge IsNot Nothing Then Name += "-NeoForge_" & SelectedNeoForge.VersionName.BeforeFirst("+")
If SelectedForge IsNot Nothing Then If SelectedLiteLoader IsNot Nothing Then Name += "-LiteLoader"
Name += "-Forge_" & SelectedForge.VersionName If SelectedOptiFine IsNot Nothing Then Name += "-OptiFine_" & SelectedOptiFine.DisplayName.Replace(VanillaName & " ", "").Replace(" ", "_")
End If
If SelectedNeoForge IsNot Nothing Then
Name += "-NeoForge_" & SelectedNeoForge.VersionName
End If
If SelectedLiteLoader IsNot Nothing Then
Name += "-LiteLoader"
End If
If SelectedOptiFine IsNot Nothing Then
Name += "-OptiFine_" & SelectedOptiFine.NameDisplay.Replace(SelectedMinecraftId & " ", "").Replace(" ", "_")
End If
Return Name Return Name
End Function End Function
Private IsSelectNameEdited As Boolean = False Private IsSelectNameEdited As Boolean = False
@@ -543,7 +429,7 @@
Private Sub TextSelectName_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextSelectName.TextChanged Private Sub TextSelectName_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextSelectName.TextChanged
If IsSelectNameChanging Then Return If IsSelectNameChanging Then Return
IsSelectNameEdited = True IsSelectNameEdited = True
SelectReload() ReloadSelected()
End Sub End Sub
Private Sub TextSelectName_ValidateChanged(sender As Object, e As EventArgs) Handles TextSelectName.ValidateChanged Private Sub TextSelectName_ValidateChanged(sender As Object, e As EventArgs) Handles TextSelectName.ValidateChanged
BtnStart.IsEnabled = TextSelectName.IsValidated BtnStart.IsEnabled = TextSelectName.IsValidated
@@ -638,12 +524,12 @@
PanMinecraft.Children.Add(NewCard) PanMinecraft.Children.Add(NewCard)
Next Next
'自动选择版本 '自动选择版本
If McVersionWaitingForSelect Is Nothing Then Exit Try If VersionWaitingSelect Is Nothing Then Exit Try
Log("[Download] 自动选择 MC 版本:" & McVersionWaitingForSelect) Log("[Download] 自动选择 MC 版本:" & VersionWaitingSelect)
For Each Version As JObject In Versions For Each Version As JObject In Versions
If Version("id").ToString <> McVersionWaitingForSelect Then Continue For If Version("id").ToString <> VersionWaitingSelect Then Continue For
Dim Item = McDownloadListItem(Version, Sub() Dim Item = McDownloadListItem(Version, Sub()
End Sub, False) End Sub, False).Init()
MinecraftSelected(Item, Nothing) MinecraftSelected(Item, Nothing)
Next Next
Catch ex As Exception Catch ex As Exception
@@ -653,7 +539,7 @@
''' <summary> ''' <summary>
''' 当 MC 版本列表加载完时,立即自动选择的版本。用于外部调用。 ''' 当 MC 版本列表加载完时,立即自动选择的版本。用于外部调用。
''' </summary> ''' </summary>
Public Shared McVersionWaitingForSelect As String = Nothing Public Shared VersionWaitingSelect As String = Nothing
#End Region #End Region
@@ -664,30 +550,30 @@
''' </summary> ''' </summary>
Private Function LoadOptiFineGetError() As String Private Function LoadOptiFineGetError() As String
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容" If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
If LoadOptiFine Is Nothing OrElse LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……"
If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFine.State, Object).Error.Message
'检查 Forge 1.13 - 1.14.3:全部不兼容 '检查 Forge 1.13 - 1.14.3:全部不兼容
If SelectedForge IsNot Nothing AndAlso If SelectedForge IsNot Nothing AndAlso
VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then CompareVersion(VanillaName, "1.13") >= 0 AndAlso CompareVersion("1.14.3", VanillaName) >= 0 Then
Return "与 Forge 不兼容" Return "与 Forge 不兼容"
End If End If
'检查 Fabric 1.20.5+:全部不兼容 '检查 Fabric 1.20.5+:全部不兼容
If SelectedFabric IsNot Nothing AndAlso If SelectedFabric IsNot Nothing AndAlso
VersionSortInteger(SelectedMinecraftId, "1.20.4") > 0 Then CompareVersion(VanillaName, "1.20.4") > 0 Then
Return "与 Fabric 不兼容" Return "与 Fabric 不兼容"
End If End If
'检查 Loader
If GetLoaderError(LoadOptiFine) IsNot Nothing Then Return GetLoaderError(LoadOptiFine)
'检查 Forge 版本 '检查 Forge 版本
Dim HasAny As Boolean = False Dim HasAny As Boolean = False
Dim HasRequiredVersion As Boolean = False Dim HasRequiredVersion As Boolean = False
For Each OptiFineVersion As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value For Each OptiFineVersion As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
If Not OptiFineVersion.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Continue For '不是同一个大版本 If Not OptiFineVersion.DisplayName.StartsWith(VanillaName & " ") Then Continue For '不是同一个大版本
HasAny = True HasAny = True
If SelectedForge Is Nothing Then Return Nothing '未选择 Forge If SelectedForge Is Nothing Then Return Nothing '未选择 Forge
If IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then Return Nothing '该版本可用 If IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then Return Nothing '该版本可用
If OptiFineVersion.RequiredForgeVersion IsNot Nothing Then HasRequiredVersion = True If OptiFineVersion.RequiredForgeVersion IsNot Nothing Then HasRequiredVersion = True
Next Next
If Not HasAny Then If Not HasAny Then
Return "不可用" Return "无"
ElseIf HasRequiredVersion Then ElseIf HasRequiredVersion Then
Return "仅兼容特定版本的 Forge" Return "仅兼容特定版本的 Forge"
Else Else
@@ -701,7 +587,7 @@
If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge
If String.IsNullOrWhiteSpace(OptiFine.RequiredForgeVersion) Then Return True '#4183 If String.IsNullOrWhiteSpace(OptiFine.RequiredForgeVersion) Then Return True '#4183
If OptiFine.RequiredForgeVersion.Contains(".") Then 'XX.X.XXX If OptiFine.RequiredForgeVersion.Contains(".") Then 'XX.X.XXX
Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) = 0 Return CompareVersion(Forge.Version.ToString, OptiFine.RequiredForgeVersion) = 0
Else 'XXXX Else 'XXXX
Return Forge.Version.Revision = OptiFine.RequiredForgeVersion Return Forge.Version.Revision = OptiFine.RequiredForgeVersion
End If End If
@@ -723,15 +609,15 @@
Dim Versions As New List(Of DlOptiFineListEntry) Dim Versions As New List(Of DlOptiFineListEntry)
For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(Version, SelectedForge) Then Continue For If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(Version, SelectedForge) Then Continue For
If Version.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Versions.Add(Version) If Version.DisplayName.StartsWith(VanillaName & " ") Then Versions.Add(Version)
Next Next
If Not Versions.Any() Then Return If Not Versions.Any() Then Return
'排序 '排序
Versions = Versions.Sort( Versions = Versions.SortByComparison(
Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
If Left.IsPreview AndAlso Not Right.IsPreview Then Return False If Left.IsPreview AndAlso Not Right.IsPreview Then Return False
Return VersionSortBoolean(Left.NameDisplay, Right.NameDisplay) Return CompareVersionGE(Left.DisplayName, Right.DisplayName)
End Function) End Function)
'可视化 '可视化
PanOptiFine.Children.Clear() PanOptiFine.Children.Clear()
@@ -751,7 +637,7 @@
Forge_Loaded() Forge_Loaded()
NeoForge_Loaded() NeoForge_Loaded()
CardOptiFine.IsSwapped = True CardOptiFine.IsSwapped = True
SelectReload() ReloadSelected()
End Sub End Sub
Private Sub OptiFine_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnOptiFineClear.MouseLeftButtonUp Private Sub OptiFine_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnOptiFineClear.MouseLeftButtonUp
SelectedOptiFine = Nothing SelectedOptiFine = Nothing
@@ -761,7 +647,7 @@
e.Handled = True e.Handled = True
Forge_Loaded() Forge_Loaded()
NeoForge_Loaded() NeoForge_Loaded()
SelectReload() ReloadSelected()
End Sub End Sub
#End Region #End Region
@@ -772,13 +658,10 @@
''' 获取 LiteLoader 的加载异常信息。若正常则返回 Nothing。 ''' 获取 LiteLoader 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadLiteLoaderGetError() As String Private Function LoadLiteLoaderGetError() As String
If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then Return "不可用" '检查 Loader
If LoadLiteLoader Is Nothing OrElse LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……" If GetLoaderError(LoadLiteLoader) IsNot Nothing Then Return GetLoaderError(LoadLiteLoader)
If LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadLiteLoader.State, Object).Error.Message '检查版本
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value Return If(DlLiteLoaderListLoader.Output.Value.Any(Function(v) v.Inherit = VanillaName), Nothing, "无")
If Version.Inherit = SelectedMinecraftId Then Return Nothing
Next
Return "不可用"
End Function End Function
'限制展开 '限制展开
@@ -795,7 +678,7 @@
'获取版本列表 '获取版本列表
Dim Versions As New List(Of DlLiteLoaderListEntry) Dim Versions As New List(Of DlLiteLoaderListEntry)
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
If Version.Inherit = SelectedMinecraftId Then Versions.Add(Version) If Version.Inherit = VanillaName Then Versions.Add(Version)
Next Next
If Not Versions.Any() Then Return If Not Versions.Any() Then Return
'可视化 '可视化
@@ -812,13 +695,13 @@
Private Sub LiteLoader_Selected(sender As MyListItem, e As EventArgs) Private Sub LiteLoader_Selected(sender As MyListItem, e As EventArgs)
SelectedLiteLoader = sender.Tag SelectedLiteLoader = sender.Tag
CardLiteLoader.IsSwapped = True CardLiteLoader.IsSwapped = True
SelectReload() ReloadSelected()
End Sub End Sub
Private Sub LiteLoader_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnLiteLoaderClear.MouseLeftButtonUp Private Sub LiteLoader_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnLiteLoaderClear.MouseLeftButtonUp
SelectedLiteLoader = Nothing SelectedLiteLoader = Nothing
CardLiteLoader.IsSwapped = True CardLiteLoader.IsSwapped = True
e.Handled = True e.Handled = True
SelectReload() ReloadSelected()
End Sub End Sub
#End Region #End Region
@@ -829,36 +712,24 @@
''' 获取 Forge 的加载异常信息。若正常则返回 Nothing。 ''' 获取 Forge 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadForgeGetError() As String Private Function LoadForgeGetError() As String
If Not SelectedMinecraftId.StartsWith("1.") Then Return "不可用" If CompareVersionGE("1.5.1", VanillaName) AndAlso CompareVersionGE(VanillaName, "1.1") Then Return "无"
If Not LoadForge.State.IsLoader Then Return "加载中……" '检查 Loader
If GetLoaderError(LoadForge) IsNot Nothing Then Return GetLoaderError(LoadForge)
Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = LoadForge.State Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = LoadForge.State
If SelectedMinecraftId <> Loader.Input Then Return "加载中……" If VanillaName <> Loader.Input Then Return "获取中……"
If Loader.State = LoadState.Loading Then Return "加载中……" '检查版本
If Loader.State = LoadState.Failed Then
Dim ErrorMessage As String = Loader.Error.Message
If ErrorMessage.Contains("不可用") Then
Return "不可用"
Else
Return "获取版本列表失败:" & ErrorMessage
End If
End If
If Loader.State <> LoadState.Finished Then Return "获取版本列表失败:未知错误,状态为 " & GetStringFromEnum(Loader.State)
Dim NotSuitForOptiFine As Boolean = False
For Each Version In Loader.Output For Each Version In Loader.Output
If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本 If Version.Category = "universal" OrElse Version.Category = "client" Then Continue For '跳过无法自动安装的版本
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容" If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容" If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If SelectedOptiFine IsNot Nothing AndAlso If SelectedOptiFine IsNot Nothing AndAlso
VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then CompareVersionGE(VanillaName, "1.13") AndAlso CompareVersionGE("1.14.3", VanillaName) Then
Return "与 OptiFine 不兼容" '1.13 ~ 1.14.3 OptiFine 检查 Return "与 OptiFine 不兼容" '1.13 ~ 1.14.3 OptiFine 检查
End If End If
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, Version) Then If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, Version) Then Continue For
NotSuitForOptiFine = True '与 OptiFine 不兼容
Continue For
End If
Return Nothing Return Nothing
Next Next
Return If(NotSuitForOptiFine, "与 OptiFine 不兼容", "该版本不支持自动安装") Return "与 OptiFine 不兼容"
End Function End Function
'限制展开 '限制展开
@@ -873,7 +744,7 @@
Try Try
If Not LoadForge.State.IsLoader Then Return If Not LoadForge.State.IsLoader Then Return
Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = LoadForge.State Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = LoadForge.State
If SelectedMinecraftId <> Loader.Input Then Return If VanillaName <> Loader.Input Then Return
If Loader.State <> LoadState.Finished Then Return If Loader.State <> LoadState.Finished Then Return
'获取要显示的版本 '获取要显示的版本
Dim Versions = Loader.Output.ToList '复制数组,以免 Output 在实例化后变空 Dim Versions = Loader.Output.ToList '复制数组,以免 Output 在实例化后变空
@@ -884,7 +755,7 @@
If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本 If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False
Return True Return True
End Function).OrderByDescending(Function(v) v.Version).ToList() End Function).OrderByDescending(Function(v) v).ToList()
ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False) ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False)
For Each Version In Versions For Each Version In Versions
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False)) PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
@@ -900,14 +771,14 @@
CardForge.IsSwapped = True CardForge.IsSwapped = True
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, SelectedForge) Then SelectedOptiFine = Nothing If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, SelectedForge) Then SelectedOptiFine = Nothing
OptiFine_Loaded() OptiFine_Loaded()
SelectReload() ReloadSelected()
End Sub End Sub
Private Sub Forge_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnForgeClear.MouseLeftButtonUp Private Sub Forge_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnForgeClear.MouseLeftButtonUp
SelectedForge = Nothing SelectedForge = Nothing
CardForge.IsSwapped = True CardForge.IsSwapped = True
e.Handled = True e.Handled = True
OptiFine_Loaded() OptiFine_Loaded()
SelectReload() ReloadSelected()
End Sub End Sub
#End Region #End Region
@@ -918,17 +789,13 @@
''' 获取 NeoForge 的加载异常信息。若正常则返回 Nothing。 ''' 获取 NeoForge 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadNeoForgeGetError() As String Private Function LoadNeoForgeGetError() As String
If Not SelectedMinecraftId.StartsWith("1.") Then Return "不可用"
If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容" If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容"
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容" If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容" If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If LoadNeoForge Is Nothing OrElse LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……" '检查 Loader
If LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadNeoForge.State, Object).Error.Message If GetLoaderError(LoadNeoForge) IsNot Nothing Then Return GetLoaderError(LoadNeoForge)
If DlNeoForgeListLoader.Output.Value.Any(Function(v) v.Inherit = SelectedMinecraftId) Then '检查版本
Return Nothing Return If(DlNeoForgeListLoader.Output.Value.Any(Function(v) v.Inherit = VanillaName), Nothing, "无")
Else
Return "不可用"
End If
End Function End Function
'限制展开 '限制展开
@@ -943,7 +810,7 @@
Try Try
'获取版本列表 '获取版本列表
If DlNeoForgeListLoader.State <> LoadState.Finished Then Return If DlNeoForgeListLoader.State <> LoadState.Finished Then Return
Dim Versions = DlNeoForgeListLoader.Output.Value.Where(Function(v) v.Inherit = SelectedMinecraftId).ToList Dim Versions = DlNeoForgeListLoader.Output.Value.Where(Function(v) v.Inherit = VanillaName).ToList
If Not Versions.Any() Then Return If Not Versions.Any() Then Return
'可视化 '可视化
PanNeoForge.Children.Clear() PanNeoForge.Children.Clear()
@@ -961,14 +828,14 @@
SelectedNeoForge = sender.Tag SelectedNeoForge = sender.Tag
CardNeoForge.IsSwapped = True CardNeoForge.IsSwapped = True
OptiFine_Loaded() OptiFine_Loaded()
SelectReload() ReloadSelected()
End Sub End Sub
Private Sub NeoForge_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnNeoForgeClear.MouseLeftButtonUp Private Sub NeoForge_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnNeoForgeClear.MouseLeftButtonUp
SelectedNeoForge = Nothing SelectedNeoForge = Nothing
CardNeoForge.IsSwapped = True CardNeoForge.IsSwapped = True
e.Handled = True e.Handled = True
OptiFine_Loaded() OptiFine_Loaded()
SelectReload() ReloadSelected()
End Sub End Sub
#End Region #End Region
@@ -979,21 +846,19 @@
''' 获取 Fabric 的加载异常信息。若正常则返回 Nothing。 ''' 获取 Fabric 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadFabricGetError() As String Private Function LoadFabricGetError() As String
If LoadFabric Is Nothing OrElse LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……"
If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadFabric.State, Object).Error.Message
'检查 OptiFine 1.20.5+:没有 OptiFabric 故全部不兼容 '检查 OptiFine 1.20.5+:没有 OptiFabric 故全部不兼容
If SelectedOptiFine IsNot Nothing AndAlso If SelectedOptiFine IsNot Nothing AndAlso CompareVersionGE(VanillaName, "1.20.5") Then Return "与 OptiFine 不兼容"
VersionSortInteger(SelectedMinecraftId, "1.20.4") > 0 Then '检查 Loader
Return "与 OptiFine 不兼容" If GetLoaderError(LoadFabric) IsNot Nothing Then Return GetLoaderError(LoadFabric)
End If '检查版本
For Each Version As JObject In DlFabricListLoader.Output.Value("game") For Each Version As JObject In DlFabricListLoader.Output.Value("game")
If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3") Then If Version("version").ToString = VanillaName.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3") Then
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容" If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容" If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
Return Nothing Return Nothing
End If End If
Next Next
Return "不可用" Return "无"
End Function End Function
'限制展开 '限制展开
@@ -1026,7 +891,7 @@
FabricApi_Loaded() FabricApi_Loaded()
OptiFabric_Loaded() OptiFabric_Loaded()
CardFabric.IsSwapped = True CardFabric.IsSwapped = True
SelectReload() ReloadSelected()
End Sub End Sub
Private Sub Fabric_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnFabricClear.MouseLeftButtonUp Private Sub Fabric_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnFabricClear.MouseLeftButtonUp
SelectedFabric = Nothing SelectedFabric = Nothing
@@ -1036,7 +901,7 @@
AutoSelectedOptiFabric = False AutoSelectedOptiFabric = False
CardFabric.IsSwapped = True CardFabric.IsSwapped = True
e.Handled = True e.Handled = True
SelectReload() ReloadSelected()
End Sub End Sub
#End Region #End Region
@@ -1044,21 +909,22 @@
#Region "Fabric API 列表" #Region "Fabric API 列表"
''' <summary> ''' <summary>
''' 从显示名判断该 API 是否与某版本适配。 ''' 判断某 Fabric API 是否适配当前选择的原版版本。
''' </summary> ''' </summary>
Public Shared Function IsSuitableFabricApi(DisplayName As String, MinecraftVersion As String) As Boolean Public Function IsFabricApiCompatible(FabricApi As CompFile) As Boolean
Dim FabricApiName = FabricApi.DisplayName
Try Try
If DisplayName Is Nothing OrElse MinecraftVersion Is Nothing Then Return False If FabricApiName Is Nothing OrElse VanillaName Is Nothing Then Return False
DisplayName = DisplayName.ToLower : MinecraftVersion = MinecraftVersion.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3").ToLower FabricApiName = FabricApiName.ToLower : VanillaName = VanillaName.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3").ToLower
If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True If FabricApiName.StartsWith("[" & VanillaName & "]") Then Return True
If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False If Not FabricApiName.Contains("/") OrElse Not FabricApiName.Contains("]") Then Return False
'直接的判断(例如 1.18.1/22w03a) '直接的判断(例如 1.18.1/22w03a)
For Each Part As String In DisplayName.BeforeFirst("]").TrimStart("[").Split("/") For Each Part As String In FabricApiName.BeforeFirst("]").TrimStart("[").Split("/")
If Part = MinecraftVersion Then Return True If Part = VanillaName Then Return True
Next Next
'将版本名分割语素(例如 1.16.4/5) '将版本名分割语素(例如 1.16.4/5)
Dim Lefts = RegexSearch(DisplayName.BeforeFirst("]"), "[a-z/]+|[0-9/]+") Dim Lefts = RegexSearch(FabricApiName.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
Dim Rights = RegexSearch(MinecraftVersion.BeforeFirst("]"), "[a-z/]+|[0-9/]+") Dim Rights = RegexSearch(VanillaName.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
'对每段进行判断 '对每段进行判断
Dim i As Integer = 0 Dim i As Integer = 0
While True While True
@@ -1077,7 +943,7 @@
End While End While
Return True Return True
Catch ex As Exception Catch ex As Exception
Log(ex, "判断 Fabric API 版本适配性出错(" & DisplayName & ", " & MinecraftVersion & ")") Log(ex, "判断 Fabric API 版本适配性出错(" & FabricApiName & ", " & VanillaName & ")")
Return False Return False
End Try End Try
End Function End Function
@@ -1086,18 +952,15 @@
''' 获取 FabricApi 的加载异常信息。若正常则返回 Nothing。 ''' 获取 FabricApi 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadFabricApiGetError() As String Private Function LoadFabricApiGetError() As String
If LoadFabricApi Is Nothing OrElse LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……" '检查 Loader
If LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadFabricApi.State, Object).Error.Message If GetLoaderError(LoadFabricApi) IsNot Nothing Then Return GetLoaderError(LoadFabricApi)
If DlFabricApiLoader.Output Is Nothing Then If DlFabricApiLoader.Output Is Nothing Then Return If(SelectedFabric Is Nothing, "需要安装 Fabric", "获取中……")
If SelectedFabric Is Nothing Then Return "需要安装 Fabric" '检查版本
Return "加载中……" If DlFabricApiLoader.Output.Any(Function(f) IsFabricApiCompatible(f)) Then
Return If(SelectedFabric Is Nothing, "需要安装 Fabric", Nothing)
Else
Return "无"
End If End If
For Each Version In DlFabricApiLoader.Output
If Not IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Continue For
If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
Return Nothing
Next
Return "不可用"
End Function End Function
'限制展开 '限制展开
@@ -1112,14 +975,14 @@
Private Sub FabricApi_Loaded() Handles LoadFabricApi.StateChanged Private Sub FabricApi_Loaded() Handles LoadFabricApi.StateChanged
Try Try
If DlFabricApiLoader.State <> LoadState.Finished Then Return If DlFabricApiLoader.State <> LoadState.Finished Then Return
If SelectedMinecraftId Is Nothing OrElse SelectedFabric Is Nothing Then Return If VanillaName Is Nothing OrElse SelectedFabric Is Nothing Then Return
'获取版本列表 '获取版本列表
Dim Versions As New List(Of CompFile) Dim Versions As New List(Of CompFile)
For Each Version In DlFabricApiLoader.Output For Each Version In DlFabricApiLoader.Output
If IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then If IsFabricApiCompatible(Version) Then
If Not Version.DisplayName.StartsWith("[") Then If Not Version.DisplayName.StartsWith("[") Then
Log("[Download] 已特判修改 Fabric API 显示名:" & Version.DisplayName, LogLevel.Debug) Log("[Download] 已特判修改 Fabric API 显示名:" & Version.DisplayName, LogLevel.Debug)
Version.DisplayName = "[" & SelectedMinecraftId & "] " & Version.DisplayName Version.DisplayName = "[" & VanillaName & "] " & Version.DisplayName
End If End If
Versions.Add(Version) Versions.Add(Version)
End If End If
@@ -1129,14 +992,15 @@
'可视化 '可视化
PanFabricApi.Children.Clear() PanFabricApi.Children.Clear()
For Each Version In Versions For Each Version In Versions
If Not IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Continue For If Not IsFabricApiCompatible(Version) Then Continue For
PanFabricApi.Children.Add(FabricApiDownloadListItem(Version, AddressOf FabricApi_Selected)) PanFabricApi.Children.Add(FabricApiDownloadListItem(Version, AddressOf FabricApi_Selected))
Next Next
'自动选择 Fabric API '自动选择 Fabric API
If Not AutoSelectedFabricApi Then If Not AutoSelectedFabricApi Then
AutoSelectedFabricApi = True AutoSelectedFabricApi = True
Log($"[Download] 已自动选择 Fabric API:{CType(PanFabricApi.Children(0), MyListItem).Title}") Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanFabricApi.Children(0))
FabricApi_Selected(PanFabricApi.Children(0), Nothing) Log($"[Download] 已自动选择 Fabric API:{Item.Title}")
FabricApi_Selected(Item, Nothing)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化 Fabric API 安装版本列表出错", LogLevel.Feedback) Log(ex, "可视化 Fabric API 安装版本列表出错", LogLevel.Feedback)
@@ -1147,13 +1011,13 @@
Private Sub FabricApi_Selected(sender As MyListItem, e As EventArgs) Private Sub FabricApi_Selected(sender As MyListItem, e As EventArgs)
SelectedFabricApi = sender.Tag SelectedFabricApi = sender.Tag
CardFabricApi.IsSwapped = True CardFabricApi.IsSwapped = True
SelectReload() ReloadSelected()
End Sub End Sub
Private Sub FabricApi_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnFabricApiClear.MouseLeftButtonUp Private Sub FabricApi_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnFabricApiClear.MouseLeftButtonUp
SelectedFabricApi = Nothing SelectedFabricApi = Nothing
CardFabricApi.IsSwapped = True CardFabricApi.IsSwapped = True
e.Handled = True e.Handled = True
SelectReload() ReloadSelected()
End Sub End Sub
#End Region #End Region
@@ -1161,14 +1025,14 @@
#Region "OptiFabric 列表" #Region "OptiFabric 列表"
''' <summary> ''' <summary>
''' 从显示名判断该 Mod 是否与某版本适配。 ''' 判断某 OptiFabric 是否适配当前选择的原版版本。
''' </summary> ''' </summary>
Private Function IsSuitableOptiFabric(ModFile As CompFile, MinecraftVersion As String) As Boolean Private Function IsOptiFabricCompatible(ModFile As CompFile) As Boolean
Try Try
If MinecraftVersion Is Nothing Then Return False If VanillaName Is Nothing Then Return False
Return ModFile.GameVersions.Contains(MinecraftVersion) Return ModFile.GameVersions.Contains(VanillaName)
Catch ex As Exception Catch ex As Exception
Log(ex, "判断 OptiFabric 版本适配性出错(" & MinecraftVersion & ")") Log(ex, "判断 OptiFabric 版本适配性出错(" & VanillaName & ")")
Return False Return False
End Try End Try
End Function End Function
@@ -1178,23 +1042,24 @@
''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。 ''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadOptiFabricGetError() As String Private Function LoadOptiFabricGetError() As String
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric,请手动下载 OptiFabric Origins" If VanillaDrop >= 140 AndAlso VanillaDrop <= 150 Then Return "不兼容老版本 Fabric,请手动下载 OptiFabric Origins"
If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……" '检查 Loader
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFabric.State, Object).Error.Message If GetLoaderError(LoadOptiFabric) IsNot Nothing Then Return GetLoaderError(LoadOptiFabric)
'检查版本
If DlOptiFabricLoader.Output Is Nothing Then If DlOptiFabricLoader.Output Is Nothing Then
If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric" If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric"
If SelectedFabric Is Nothing Then Return "需要安装 Fabric" If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine" If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine"
Return "加载中……" Return "获取中……"
End If End If
For Each Version In DlOptiFabricLoader.Output For Each Version In DlOptiFabricLoader.Output
If Not IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Continue For '2135# If Not IsOptiFabricCompatible(Version) Then Continue For '2135#
If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric" If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric"
If SelectedFabric Is Nothing Then Return "需要安装 Fabric" If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine" If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine"
Return Nothing '通过检查 Return Nothing '通过检查
Next Next
Return "不可用" Return "无"
End Function End Function
'限制展开 '限制展开
@@ -1208,11 +1073,11 @@
Private Sub OptiFabric_Loaded() Handles LoadOptiFabric.StateChanged Private Sub OptiFabric_Loaded() Handles LoadOptiFabric.StateChanged
Try Try
If DlOptiFabricLoader.State <> LoadState.Finished Then Return If DlOptiFabricLoader.State <> LoadState.Finished Then Return
If SelectedMinecraftId Is Nothing OrElse SelectedFabric Is Nothing OrElse SelectedOptiFine Is Nothing Then Return If VanillaName Is Nothing OrElse SelectedFabric Is Nothing OrElse SelectedOptiFine Is Nothing Then Return
'获取版本列表 '获取版本列表
Dim Versions As New List(Of CompFile) Dim Versions As New List(Of CompFile)
For Each Version In DlOptiFabricLoader.Output For Each Version In DlOptiFabricLoader.Output
If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Versions.Add(Version) If IsOptiFabricCompatible(Version) Then Versions.Add(Version)
Next Next
If Not Versions.Any() Then Return If Not Versions.Any() Then Return
'排序 '排序
@@ -1220,16 +1085,15 @@
'可视化 '可视化
PanOptiFabric.Children.Clear() PanOptiFabric.Children.Clear()
For Each Version In Versions For Each Version In Versions
If Not IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Continue For If Not IsOptiFabricCompatible(Version) Then Continue For
PanOptiFabric.Children.Add(OptiFabricDownloadListItem(Version, AddressOf OptiFabric_Selected)) PanOptiFabric.Children.Add(OptiFabricDownloadListItem(Version, AddressOf OptiFabric_Selected))
Next Next
'自动选择 OptiFabric '自动选择 OptiFabric
If Not AutoSelectedOptiFabric AndAlso If AutoSelectedOptiFabric OrElse VanillaDrop >= 140 AndAlso VanillaDrop <= 150 Then Return '1.14~15 不自动选择
Not (SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15")) Then '1.14~15 不自动选择
AutoSelectedOptiFabric = True AutoSelectedOptiFabric = True
Log($"[Download] 已自动选择 OptiFabric:{CType(PanOptiFabric.Children(0), MyListItem).Title}") Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanOptiFabric.Children(0))
OptiFabric_Selected(PanOptiFabric.Children(0), Nothing) Log($"[Download] 已自动选择 OptiFabric:{Item.Title}")
End If OptiFabric_Selected(Item, Nothing)
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化 OptiFabric 安装版本列表出错", LogLevel.Feedback) Log(ex, "可视化 OptiFabric 安装版本列表出错", LogLevel.Feedback)
End Try End Try
@@ -1239,13 +1103,13 @@
Private Sub OptiFabric_Selected(sender As MyListItem, e As EventArgs) Private Sub OptiFabric_Selected(sender As MyListItem, e As EventArgs)
SelectedOptiFabric = sender.Tag SelectedOptiFabric = sender.Tag
CardOptiFabric.IsSwapped = True CardOptiFabric.IsSwapped = True
SelectReload() ReloadSelected()
End Sub End Sub
Private Sub OptiFabric_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnOptiFabricClear.MouseLeftButtonUp Private Sub OptiFabric_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnOptiFabricClear.MouseLeftButtonUp
SelectedOptiFabric = Nothing SelectedOptiFabric = Nothing
CardOptiFabric.IsSwapped = True CardOptiFabric.IsSwapped = True
e.Handled = True e.Handled = True
SelectReload() ReloadSelected()
End Sub End Sub
#End Region #End Region
@@ -1266,12 +1130,12 @@
End If End If
End If End If
'提交安装申请 '提交安装申请
Dim VersionName As String = TextSelectName.Text Dim InstanceName As String = TextSelectName.Text
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .NewInstanceName = InstanceName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftJson = SelectedMinecraftJsonUrl, .MinecraftJson = VanillaData("url").ToString,
.MinecraftName = SelectedMinecraftId, .MinecraftName = VanillaName,
.OptiFineEntry = SelectedOptiFine, .OptiFineEntry = SelectedOptiFine,
.ForgeEntry = SelectedForge, .ForgeEntry = SelectedForge,
.NeoForgeEntry = SelectedNeoForge, .NeoForgeEntry = SelectedNeoForge,
@@ -1287,4 +1151,20 @@
#End Region #End Region
Private Function GetLoaderError(Loader As MyLoading) As String
If Loader Is Nothing Then Return "获取中……"
If Not Loader.State.IsLoader Then Return "获取中……"
Select Case Loader.State.LoadingState
Case MyLoading.MyLoadingState.Run
Return "获取中……"
Case MyLoading.MyLoadingState.Error
Dim Message As String = CType(Loader.State, LoaderBase).Error.Message
Return If(Message = "无", "无", "获取失败:" & Message)
Case MyLoading.MyLoadingState.Unloaded
Return "未知错误,状态为 Unloaded"
Case Else
Return Nothing
End Select
End Function
End Class End Class
@@ -11,7 +11,7 @@
''' <summary> ''' <summary>
''' 勾选事件改变页面。 ''' 勾选事件改变页面。
''' </summary> ''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemMod.Check, ItemPack.Check, ItemResourcePack.Check, ItemShader.Check, ItemDataPack.Check Private Sub PageCheck(sender As FrameworkElement, e As RouteEventArgs) Handles ItemInstall.Check, ItemMod.Check, ItemPack.Check, ItemResourcePack.Check, ItemShader.Check, ItemDataPack.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0 '尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False) '若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -5,16 +5,6 @@ Public Class MyLocalModItem
#Region "基础属性" #Region "基础属性"
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
'Logo
Public Property Logo As String
Get
Return PathLogo.Source
End Get
Set(value As String)
PathLogo.Source = value
End Set
End Property
'标题 '标题
Private _Title As String Private _Title As String
Public Property Title As String Public Property Title As String
@@ -28,9 +18,6 @@ Public Class MyLocalModItem
LabTitle.TextDecorations = Nothing LabTitle.TextDecorations = Nothing
Case McMod.McModState.Disabled Case McMod.McModState.Disabled
LabTitle.TextDecorations = TextDecorations.Strikethrough LabTitle.TextDecorations = TextDecorations.Strikethrough
Case McMod.McModState.Unavailable
LabTitle.TextDecorations = TextDecorations.Strikethrough
value &= " [错误]"
End Select End Select
If LabTitle.Text = value Then Return If LabTitle.Text = value Then Return
LabTitle.Text = value LabTitle.Text = value
@@ -63,17 +50,17 @@ Public Class MyLocalModItem
'Tag 'Tag
Public WriteOnly Property Tags As List(Of String) Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String)) Set(Tags As List(Of String))
PanTags.Children.Clear() PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed) PanTags.Visibility = If(Tags.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value For Each TagText In Tags
Dim NewTag = GetObjectFromXML( Dim BorderTag As New Border With {
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" .Background = New MyColor("#0A000000"), .Padding = New Thickness(3, 1, 3, 1), .CornerRadius = New CornerRadius(3),
Background=""#0C000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0"" .Margin = New Thickness(0, 0, 3, 0), .SnapsToDevicePixels = True, .UseLayoutRounding = False}
SnapsToDevicePixels=""True"" UseLayoutRounding=""False""> Dim LabTag As New TextBlock With {
<TextBlock Text=""" & TagText & """ Foreground=""#88000000"" FontSize=""11"" /> .Text = TagText, .Foreground = New MyColor("#B0B0B0"), .FontSize = 11}
</Border>") BorderTag.Child = LabTag
PanTags.Children.Add(NewTag) PanTags.Children.Add(BorderTag)
Next Next
End Set End Set
End Property End Property
@@ -123,7 +110,7 @@ Public Class MyLocalModItem
End Get End Get
Set(value As Boolean) Set(value As Boolean)
_Swiping = value _Swiping = value
FrmVersionMod.CardSelect.IsHitTestVisible = Not value FrmInstanceMod.CardSelect.IsHitTestVisible = Not value
End Set End Set
End Property End Property
Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值 Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值
@@ -313,11 +300,11 @@ Public Class MyLocalModItem
#End Region #End Region
Private Function GetUpdateCompareDescription() As String Private Function GetUpdateCompareDescription() As String
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "") Dim CurrentName = If(Entry.CompFile.Version, Entry.CompFile.DisplayName).Replace(".jar", "")
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "") Dim NewestName = If(Entry.UpdateFile.Version, Entry.UpdateFile.DisplayName).Replace(".jar", "")
'简化名称对比 '简化名称对比
Dim CurrentSegs = CurrentName.Split("-"c).ToList() Dim CurrentSegs = CurrentName.Split("-_+ ".ToCharArray).ToList()
Dim NewestSegs = NewestName.Split("-"c).ToList() Dim NewestSegs = NewestName.Split("-_+ ".ToCharArray).ToList()
Dim Shortened As Boolean = False Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList() For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For If Not NewestSegs.Contains(Seg) Then Continue For
@@ -332,9 +319,19 @@ Public Class MyLocalModItem
End If End If
Return $"当前版本:{CurrentName}({GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}){vbCrLf}最新版本:{NewestName}({GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)})" Return $"当前版本:{CurrentName}({GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}){vbCrLf}最新版本:{NewestName}({GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)})"
End Function End Function
Public Sub Refresh() Handles Me.Loaded
RunInUi( '懒加载
Sub() Public Sub New()
InitializeComponent()
OnFirstEnterScrollViewerViewport(AddressOf FirstEnterScrollViewerViewport)
End Sub
Private HasEnteredViewport As Boolean = False
Private Sub FirstEnterScrollViewerViewport()
HasEnteredViewport = True
Refresh()
End Sub
Public Sub Refresh()
If Not HasEnteredViewport Then Return '避免在未显示时因为 Comp 更新而加载内容
'更新 '更新
If Entry.CanUpdate Then If Entry.CanUpdate Then
BtnUpdate.Visibility = Visibility.Visible BtnUpdate.Visibility = Visibility.Visible
@@ -357,7 +354,7 @@ Public Class MyLocalModItem
SubTitle = "" SubTitle = ""
'描述 '描述
If Entry.Comp Is Nothing Then If Entry.Comp Is Nothing Then
NewDescription = Entry.Name NewDescription = Entry.DisplayName
Else Else
Dim Titles = Entry.Comp.GetControlTitle(False) Dim Titles = Entry.Comp.GetControlTitle(False)
NewDescription = Titles.Key & Titles.Value NewDescription = Titles.Key & Titles.Value
@@ -368,7 +365,7 @@ Public Class MyLocalModItem
'标题显示译名,详情显示文件名 '标题显示译名,详情显示文件名
'标题 '标题
If Entry.Comp Is Nothing Then If Entry.Comp Is Nothing Then
Title = Entry.Name Title = Entry.DisplayName
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version) SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else Else
Dim Titles = Entry.Comp.GetControlTitle(False) Dim Titles = Entry.Comp.GetControlTitle(False)
@@ -382,8 +379,6 @@ Public Class MyLocalModItem
NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "") NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Entry.Description IsNot Nothing Then ElseIf Entry.Description IsNot Nothing Then
NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "") NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Not Entry.IsFileAvailable Then
NewDescription += ": " & "存在错误,无法获取信息"
End If End If
Description = NewDescription Description = NewDescription
If Checked Then If Checked Then
@@ -392,7 +387,11 @@ Public Class MyLocalModItem
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4")) LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If End If
'主 Logo '主 Logo
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo()) If Entry.Comp IsNot Nothing Then
Entry.Comp.ApplyLogoToMyImage(PathLogo)
Else
PathLogo.Source = PathImage & "Icons/NoIcon.png"
End If
'图标右下角的 Logo '图标右下角的 Logo
If Entry.State = McMod.McModState.Fine Then If Entry.State = McMod.McModState.Fine Then
If ImgState IsNot Nothing Then If ImgState IsNot Nothing Then
@@ -417,7 +416,6 @@ Public Class MyLocalModItem
End If End If
'标签 '标签
If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
End Sub)
End Sub End Sub
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed
@@ -488,9 +486,9 @@ Public Class MyLocalModItem
'触发更新 '触发更新
Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
Select Case MyMsgBox($"是否要更新 {Entry.Name}?{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消") Select Case MyMsgBox($"是否要更新 {Entry.DisplayName}?{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
Case 1 '更新 Case 1 '更新
FrmVersionMod.UpdateMods({Entry}) FrmInstanceMod.UpdateMods({Entry})
Case 2 '查看更新日志 Case 2 '查看更新日志
ShowUpdateLog() ShowUpdateLog()
Case 3 '取消 Case 3 '取消
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:System="clr-namespace:System;assembly=mscorlib" xmlns:System="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageVersionExport" mc:Ignorable="d" x:Class="PageInstanceExport"
PanScroll="PanBack"> PanScroll="PanBack">
<Grid x:Name="PanAllBack"> <Grid x:Name="PanAllBack">
<Grid.Resources> <Grid.Resources>
@@ -249,8 +249,8 @@
Theme="Yellow" Margin="0,2,0,8" Visibility="{Binding Checked, ElementName=CheckAdvancedInclude, Converter={StaticResource BooleanToVisibilityConverter}}" /> Theme="Yellow" Margin="0,2,0,8" Visibility="{Binding Checked, ElementName=CheckAdvancedInclude, Converter={StaticResource BooleanToVisibilityConverter}}" />
<local:MyCheckBox Text="打包资源文件,以避免在导入时下载" x:Name="CheckAdvancedInclude" <local:MyCheckBox Text="打包资源文件,以避免在导入时下载" x:Name="CheckAdvancedInclude"
ToolTip="将 Mod、资源包、光影包的文件直接放入整合包中,这样在导入时就无需联网下载它们。&#xa;建议仅在无法稳定连接 CurseForge 或 Modrinth 时才考虑勾选。" /> ToolTip="将 Mod、资源包、光影包的文件直接放入整合包中,这样在导入时就无需联网下载它们。&#xa;建议仅在无法稳定连接 CurseForge 或 Modrinth 时才考虑勾选。" />
<local:MyCheckBox Text="Modrinth 上传模式" x:Name="CheckAdvancedModrinth" <local:MyCheckBox Text="仅从 Modrinth 下载资源文件" x:Name="CheckAdvancedModrinth"
ToolTip="如果你想要打包上传到 Modrinth,勾选此项会生成完全符合 Modrinth 要求的整合包文件。&#xa;由于 Modrinth 要求,只能从 CurseForge 下载的资源将无法联网下载,会被直接放入整合包中。&#xa;此外,勾选后也不能在整合包中包含 PCL 启动器文件。" /> ToolTip="若资源未在 Modrinth 上托管,则将其原始文件直接放入整合包中。&#xa;如果你想将整合包上传到 Modrinth,这能帮助你分辨哪些文件未在 Modrinth 上托管。" />
<local:MyHint Theme="Blue" RelativeSetup="HintExportConfig" CanClose="True" Margin="0,20,0,2" <local:MyHint Theme="Blue" RelativeSetup="HintExportConfig" CanClose="True" Margin="0,20,0,2"
Text="配置文件中含有更多高级选项,例如精准控制导出的文件、设置整合包存放位置等。&#xa;要修改这些选项,请先点击 “保存配置”,在编辑配置文件后再导入。" /> Text="配置文件中含有更多高级选项,例如精准控制导出的文件、设置整合包存放位置等。&#xa;要修改这些选项,请先点击 “保存配置”,在编辑配置文件后再导入。" />
<Grid Height="35" Margin="0,12,0,0"> <Grid Height="35" Margin="0,12,0,0">
@@ -15,28 +15,28 @@ Public Class ExportOption
Public Property RequireModLoaderOrOptiFine As Boolean = False Public Property RequireModLoaderOrOptiFine As Boolean = False
End Class End Class
Public Class PageVersionExport Public Class PageInstanceExport
Implements IRefreshable Implements IRefreshable
Private CurrentVersion As String = "" Private CurrentInstance As String = ""
Private Sub PageVersionExport_Loaded() Handles Me.Loaded Private Sub PageInstanceExport_Loaded() Handles Me.Loaded
AniControlEnabled += 1 AniControlEnabled += 1
If CurrentVersion <> PageVersionLeft.Version.Path Then RefreshAll() '切换到了另一个版本,重置页面 If CurrentInstance <> PageInstanceLeft.Instance.PathVersion Then RefreshAll() '切换到了另一个版本,重置页面
CustomEventService.SetEventData(BtnAdvancedHelp, CustomEventService.SetEventData(BtnAdvancedHelp,
If(VersionBranchName = "Release", "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json")) If(VersionBranchName = "Release", "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json"))
AniControlEnabled -= 1 AniControlEnabled -= 1
End Sub End Sub
Public Sub RefreshAll() Implements IRefreshable.Refresh Public Sub RefreshAll() Implements IRefreshable.Refresh
Log($"[Export] 刷新导出页面") Log($"[Export] 刷新导出页面")
HintOptiFine.Visibility = If(PageVersionLeft.Version.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed) HintOptiFine.Visibility = If(PageInstanceLeft.Instance.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
CurrentVersion = PageVersionLeft.Version.Path CurrentInstance = PageInstanceLeft.Instance.PathVersion
TextExportName.Text = "" TextExportName.Text = ""
TextExportName.HintText = PageVersionLeft.Version.Name TextExportName.HintText = PageInstanceLeft.Instance.Name
TextExportVersion.Text = "" TextExportVersion.Text = ""
TextExportVersion.HintText = "1.0.0" TextExportVersion.HintText = "1.0.0"
CheckAdvancedInclude.Checked = False CheckAdvancedInclude.Checked = False
CheckAdvancedModrinth.Checked = False CheckAdvancedModrinth.Checked = False
GetExportOption(CheckOptionsBasic).Description = PageVersionLeft.Version.GetVersionDescription() GetExportOption(CheckOptionsBasic).Description = PageInstanceLeft.Instance.VersionDisplayName()
ResetConfigOverrides() ResetConfigOverrides()
ReloadAllSubOptions() ReloadAllSubOptions()
RefreshAllOptionsUI() RefreshAllOptionsUI()
@@ -58,7 +58,7 @@ Public Class PageVersionExport
Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String()) Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String())
Panel.Children.Clear() Panel.Children.Clear()
For Each Folder In Folders For Each Folder In Folders
Dim TargetFolder As New DirectoryInfo(PageVersionLeft.Version.PathIndie & Folder) Dim TargetFolder As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Folder)
If Not TargetFolder.Exists() Then Continue For If Not TargetFolder.Exists() Then Continue For
'查找文件夹下的对应项 '查找文件夹下的对应项
If AcceptCompressedFile Then If AcceptCompressedFile Then
@@ -100,7 +100,7 @@ Public Class PageVersionExport
Return False Return False
End Try End Try
End Function End Function
Dim PathInfo As New DirectoryInfo(PageVersionLeft.Version.PathIndie) Dim PathInfo As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie)
AllEntries.AddRange(PathInfo.EnumerateFiles().Select(Function(f) f.Name)) AllEntries.AddRange(PathInfo.EnumerateFiles().Select(Function(f) f.Name))
For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory) For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory)
AllEntries.Add($"{SubFolder.Name}\") AllEntries.Add($"{SubFolder.Name}\")
@@ -112,9 +112,9 @@ Public Class PageVersionExport
Dim IsVisible = Dim IsVisible =
Function(TargetOption As ExportOption) As Boolean Function(TargetOption As ExportOption) As Boolean
'检查需要 OptiFine 或 Mod 加载器 '检查需要 OptiFine 或 Mod 加载器
If TargetOption.RequireOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine Then Return False If TargetOption.RequireOptiFine AndAlso Not PageInstanceLeft.Instance.Version.HasOptiFine Then Return False
If TargetOption.RequireModLoader AndAlso Not PageVersionLeft.Version.Modable Then Return False If TargetOption.RequireModLoader AndAlso Not PageInstanceLeft.Instance.Modable Then Return False
If TargetOption.RequireModLoaderOrOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine AndAlso Not PageVersionLeft.Version.Modable Then Return False If TargetOption.RequireModLoaderOrOptiFine AndAlso Not PageInstanceLeft.Instance.Version.HasOptiFine AndAlso Not PageInstanceLeft.Instance.Modable Then Return False
'粗略检查是否可能有符合规则的文件/文件夹 '粗略检查是否可能有符合规则的文件/文件夹
Return StandardizeLines(If(TargetOption.Rules, TargetOption.ShowRules).Split("|"c), True).Any( Return StandardizeLines(If(TargetOption.Rules, TargetOption.ShowRules).Split("|"c), True).Any(
Function(Rule As String) Function(Rule As String)
@@ -130,9 +130,9 @@ Public Class PageVersionExport
Rule = Rule.Trim("*?".ToCharArray) Rule = Rule.Trim("*?".ToCharArray)
If Rule.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries).Count >= 3 Then If Rule.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries).Count >= 3 Then
If Rule.EndsWithF("\") Then If Rule.EndsWithF("\") Then
Return IsValidDirectory(New DirectoryInfo(PageVersionLeft.Version.PathIndie & Rule)) '文件夹有效 Return IsValidDirectory(New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Rule)) '文件夹有效
Else Else
Return File.Exists(PageVersionLeft.Version.PathIndie & Rule) '文件有效 Return File.Exists(PageInstanceLeft.Instance.PathIndie & Rule) '文件有效
End If End If
Else Else
Return False Return False
@@ -324,9 +324,9 @@ Public Class PageVersionExport
ConfigLines.Add("# 二次分发可能违反使用协议,请尽量不要公开发布包含资源文件的整合包!") ConfigLines.Add("# 二次分发可能违反使用协议,请尽量不要公开发布包含资源文件的整合包!")
ConfigLines.Add("DontCheckHostedAssets:" & CheckAdvancedInclude.Checked) ConfigLines.Add("DontCheckHostedAssets:" & CheckAdvancedInclude.Checked)
ConfigLines.Add("") ConfigLines.Add("")
ConfigLines.Add("# 如果你想要打包上传到 Modrinth,启用此项会生成完全符合 Modrinth 要求的整合包文件。") ConfigLines.Add("# 若资源未在 Modrinth 上托管,则将其原始文件直接放入整合包中。")
ConfigLines.Add("# 由于 Modrinth 要求,只能从 CurseForge 下载的资源将无法联网下载,会被直接放入整合包中。") ConfigLines.Add("# 如果你想将整合包上传到 Modrinth,这能帮助你分辨哪些文件未在 Modrinth 上托管。")
ConfigLines.Add("# 此选项与 IncludeLauncher、IncludeLauncherCustom、DontCheckHostedAssets 冲突。") ConfigLines.Add("# 此选项与 DontCheckHostedAssets 冲突。")
ConfigLines.Add("ModrinthUploadMode:" & CheckAdvancedModrinth.Checked) ConfigLines.Add("ModrinthUploadMode:" & CheckAdvancedModrinth.Checked)
ConfigLines.Add("") ConfigLines.Add("")
ConfigLines.Add("# 导出的文件的存放位置。") ConfigLines.Add("# 导出的文件的存放位置。")
@@ -435,7 +435,7 @@ Public Class PageVersionExport
'缓存所需参数 '缓存所需参数
Dim CacheFolder = RequestTaskTempFolder() Dim CacheFolder = RequestTaskTempFolder()
Dim OverridesFolder = CacheFolder & "modpack\overrides\" Dim OverridesFolder = CacheFolder & "modpack\overrides\"
Dim McVersion = PageVersionLeft.Version Dim McVersion = PageInstanceLeft.Instance
Dim PathIndie As String = McVersion.PathIndie Dim PathIndie As String = McVersion.PathIndie
Dim CheckHostedAssets As Boolean = Not CheckAdvancedInclude.Checked Dim CheckHostedAssets As Boolean = Not CheckAdvancedInclude.Checked
Dim ModrinthUploadMode As Boolean = CheckAdvancedModrinth.Checked Dim ModrinthUploadMode As Boolean = CheckAdvancedModrinth.Checked
@@ -530,7 +530,7 @@ Public Class PageVersionExport
Next Next
Loader.Progress = 0.97 Loader.Progress = 0.97
'复制 PCL 版本设置 '复制 PCL 版本设置
CopyDirectory(McVersion.Path & "PCL\", OverridesFolder & "PCL\") CopyDirectory(McVersion.PathVersion & "PCL\", OverridesFolder & "PCL\")
WriteIni(OverridesFolder & "PCL\Setup.ini", "IsStar", False) WriteIni(OverridesFolder & "PCL\Setup.ini", "IsStar", False)
#If BETA Then #If BETA Then
'复制 PCL 本体 '复制 PCL 本体
@@ -589,7 +589,7 @@ Public Class PageVersionExport
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
If ModrinthUploadMode Then Return 'Modrinth 上传模式下,不能从 CurseForge 获取信息 If ModrinthUploadMode Then Return 'Modrinth 上传模式下,不从 CurseForge 获取信息
Dim CurseForgeHashes = Loader.Input.Select(Function(m) m.CurseForgeHash) Dim CurseForgeHashes = Loader.Input.Select(Function(m) m.CurseForgeHash)
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432/", HttpMethod.Post, Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432/", HttpMethod.Post,
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches") $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
@@ -648,17 +648,17 @@ Public Class PageVersionExport
Files.Add(New JObject From { Files.Add(New JObject From {
{"path", ModFile.Path.AfterFirst(OverridesFolder).Replace("\", "/")}, {"path", ModFile.Path.AfterFirst(OverridesFolder).Replace("\", "/")},
{"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.Path)}}}, {"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.Path)}}},
{"downloads", New JArray(Pair.Value.OrderByDescending(Function(u) u.Contains("modrinth.com")))}, {"downloads", New JArray(Pair.Value.OrderBy(Function(u) u.Contains("modrinth.com")))}, '不优先选择 Modrinth
{"fileSize", New FileInfo(ModFile.Path).Length} {"fileSize", New FileInfo(ModFile.Path).Length}
}) })
File.Delete(ModFile.Path) File.Delete(ModFile.Path)
Next Next
Loader.Progress = 0.2 Loader.Progress = 0.2
'导出最终 JSON 文件 '导出最终 JSON 文件
Dim Dependencies As New JObject From {{"minecraft", McVersion.Version.McName}} Dim Dependencies As New JObject From {{"minecraft", McVersion.Version.VanillaName}}
If McVersion.Version.HasForge Then Dependencies.Add("forge", McVersion.Version.ForgeVersion) If McVersion.Version.HasForge Then Dependencies.Add("forge", McVersion.Version.Forge)
If McVersion.Version.HasFabric Then Dependencies.Add("fabric-loader", McVersion.Version.FabricVersion) If McVersion.Version.HasFabric Then Dependencies.Add("fabric-loader", McVersion.Version.Fabric)
If McVersion.Version.HasNeoForge Then Dependencies.Add("neoforge", McVersion.Version.NeoForgeVersion) If McVersion.Version.HasNeoForge Then Dependencies.Add("neoforge", McVersion.Version.NeoForge)
Dim ResultJson As New JObject From { Dim ResultJson As New JObject From {
{"game", "minecraft"}, {"game", "minecraft"},
{"formatVersion", 1}, {"formatVersion", 1},
@@ -711,12 +711,6 @@ Public Class PageVersionExport
End If End If
End Sub End Sub
'勾选 Modrinth 上传模式时,禁止打包 PCL
Private Sub CheckAdvancedModrinth_Change(sender As Object, user As Boolean) Handles CheckAdvancedModrinth.Change
If CheckAdvancedModrinth.Checked Then CheckOptionsPcl.Checked = False
CheckOptionsPcl.IsEnabled = Not CheckAdvancedModrinth.Checked
End Sub
'勾选打包资源文件时,禁止开启 Modrinth 上传模式 '勾选打包资源文件时,禁止开启 Modrinth 上传模式
Private Sub CheckAdvancedInclude_Change(sender As Object, user As Boolean) Handles CheckAdvancedInclude.Change Private Sub CheckAdvancedInclude_Change(sender As Object, user As Boolean) Handles CheckAdvancedInclude.Change
If CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = False If CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = False
@@ -1,4 +1,4 @@
<local:MyPageLeft x:Class="PageVersionLeft" <local:MyPageLeft x:Class="PageInstanceLeft"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" AnimatedControl="PanItem"> xmlns:local="clr-namespace:PCL" AnimatedControl="PanItem">
@@ -1,13 +1,13 @@
Public Class PageVersionLeft Public Class PageInstanceLeft
Implements IRefreshable Implements IRefreshable
''' <summary> ''' <summary>
''' 当前显示设置的 MC 版本。 ''' 当前显示设置的 MC 版本。
''' </summary> ''' </summary>
Public Shared Version As McVersion = Nothing Public Shared Instance As McInstance = Nothing
Public Sub RefreshModDisabled() Handles Me.Loaded Public Sub RefreshModDisabled() Handles Me.Loaded
If Version IsNot Nothing AndAlso Version.Modable Then If Instance IsNot Nothing AndAlso Instance.Modable Then
ItemMod.Visibility = Visibility.Visible ItemMod.Visibility = Visibility.Visible
ItemModDisabled.Visibility = Visibility.Collapsed ItemModDisabled.Visibility = Visibility.Collapsed
Else Else
@@ -26,7 +26,7 @@
''' <summary> ''' <summary>
''' 勾选事件改变页面。 ''' 勾选事件改变页面。
''' </summary> ''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemOverall.Check, ItemMod.Check, ItemModDisabled.Check, ItemSetup.Check, ItemExport.Check Private Sub PageCheck(sender As FrameworkElement, e As RouteEventArgs) Handles ItemOverall.Check, ItemMod.Check, ItemModDisabled.Check, ItemSetup.Check, ItemExport.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0 '尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False) '若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -35,21 +35,21 @@
Public Function PageGet(Optional ID As FormMain.PageSubType = -1) Public Function PageGet(Optional ID As FormMain.PageSubType = -1)
If ID = -1 Then ID = PageID If ID = -1 Then ID = PageID
Select Case ID Select Case ID
Case FormMain.PageSubType.VersionOverall Case FormMain.PageSubType.InstanceOverall
If FrmVersionOverall Is Nothing Then FrmVersionOverall = New PageVersionOverall If FrmInstanceOverall Is Nothing Then FrmInstanceOverall = New PageInstanceOverall
Return FrmVersionOverall Return FrmInstanceOverall
Case FormMain.PageSubType.VersionMod Case FormMain.PageSubType.InstanceMod
If FrmVersionMod Is Nothing Then FrmVersionMod = New PageVersionMod If FrmInstanceMod Is Nothing Then FrmInstanceMod = New PageInstanceMod
Return FrmVersionMod Return FrmInstanceMod
Case FormMain.PageSubType.VersionModDisabled Case FormMain.PageSubType.InstanceModDisabled
If FrmVersionModDisabled Is Nothing Then FrmVersionModDisabled = New PageVersionModDisabled If FrmInstanceModDisabled Is Nothing Then FrmInstanceModDisabled = New PageInstanceModDisabled
Return FrmVersionModDisabled Return FrmInstanceModDisabled
Case FormMain.PageSubType.VersionSetup Case FormMain.PageSubType.InstanceSetup
If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup If IsNothing(FrmInstanceSetup) Then FrmInstanceSetup = New PageInstanceSetup
Return FrmVersionSetup Return FrmInstanceSetup
Case FormMain.PageSubType.VersionExport Case FormMain.PageSubType.InstanceExport
If FrmVersionExport Is Nothing Then FrmVersionExport = New PageVersionExport If FrmInstanceExport Is Nothing Then FrmInstanceExport = New PageInstanceExport
Return FrmVersionExport Return FrmInstanceExport
Case Else Case Else
Throw New Exception("未知的版本设置子页面种类:" & ID) Throw New Exception("未知的版本设置子页面种类:" & ID)
End Select End Select
@@ -99,19 +99,19 @@
End Sub End Sub
Public Sub Refresh(SubType As FormMain.PageSubType) Public Sub Refresh(SubType As FormMain.PageSubType)
Select Case SubType Select Case SubType
Case FormMain.PageSubType.VersionMod Case FormMain.PageSubType.InstanceMod
PageVersionMod.Refresh() PageInstanceMod.Refresh()
ItemMod.Checked = True ItemMod.Checked = True
Case FormMain.PageSubType.VersionExport Case FormMain.PageSubType.InstanceExport
If FrmVersionExport IsNot Nothing Then FrmVersionExport.RefreshAll() If FrmInstanceExport IsNot Nothing Then FrmInstanceExport.RefreshAll()
ItemExport.Checked = True ItemExport.Checked = True
End Select End Select
End Sub End Sub
Public Sub Reset(sender As Object, e As EventArgs) Public Sub Reset(sender As Object, e As EventArgs)
If MyMsgBox("是否要初始化该版本的版本独立设置?该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then If MyMsgBox("是否要初始化该版本的版本独立设置?该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then
If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup If IsNothing(FrmInstanceSetup) Then FrmInstanceSetup = New PageInstanceSetup
FrmVersionSetup.Reset() FrmInstanceSetup.Reset()
ItemSetup.Checked = True ItemSetup.Checked = True
End If End If
End Sub End Sub
@@ -2,7 +2,7 @@
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" 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="PageVersionMod" mc:Ignorable="d" x:Class="PageInstanceMod"
PanScroll="PanBack"> PanScroll="PanBack">
<Grid> <Grid>
<Grid x:Name="PanAllBack"> <Grid x:Name="PanAllBack">
@@ -22,7 +22,6 @@
<local:MyButton x:Name="BtnManageInstall" Grid.Column="1" MinWidth="110" Text="从文件安装" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnManageInstall" Grid.Column="1" MinWidth="110" Text="从文件安装" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageDownload" Grid.Column="2" MinWidth="110" Text="下载新 Mod" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnManageDownload" Grid.Column="2" MinWidth="110" Text="下载新 Mod" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageSelectAll" Grid.Column="3" MinWidth="110" Text="全选" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnManageSelectAll" Grid.Column="3" MinWidth="110" Text="全选" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageCheck" Grid.Column="4" MinWidth="110" Text="检查 Mod" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" ToolTip="快速检查 Mod 的版本要求、重复、前置缺失等问题。&#xa;结果仅供参考,由于部分 Mod 标注的信息有误,可能并不准确。" Visibility="Collapsed" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,14" Title=" " MinHeight="55"> <local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,14" Title=" " MinHeight="55">
@@ -31,7 +30,6 @@
<local:MyRadioButton Tag="1" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已启用" x:Name="BtnFilterEnabled" /> <local:MyRadioButton Tag="1" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已启用" x:Name="BtnFilterEnabled" />
<local:MyRadioButton Tag="2" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已禁用" x:Name="BtnFilterDisabled" /> <local:MyRadioButton Tag="2" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已禁用" x:Name="BtnFilterDisabled" />
<local:MyRadioButton Tag="3" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="可更新" x:Name="BtnFilterCanUpdate" /> <local:MyRadioButton Tag="3" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="可更新" x:Name="BtnFilterCanUpdate" />
<local:MyRadioButton Tag="4" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="错误" x:Name="BtnFilterError" />
</StackPanel> </StackPanel>
<StackPanel Margin="20,48,18,22" Name="PanList" VerticalAlignment="Top" /> <StackPanel Margin="20,48,18,22" Name="PanList" VerticalAlignment="Top" />
</local:MyCard> </local:MyCard>
@@ -1,4 +1,4 @@
Public Class PageVersionMod Public Class PageInstanceMod
Implements IRefreshable Implements IRefreshable
#Region "初始化" #Region "初始化"
@@ -23,28 +23,22 @@
Btn.LabText.Margin = New Thickness(-2, 0, 8, 0) Btn.LabText.Margin = New Thickness(-2, 0, 8, 0)
Next Next
#If DEBUG Then
BtnManageCheck.Visibility = Visibility.Visible
#End If
End Sub End Sub
''' <summary> ''' <summary>
''' 刷新 Mod 列表。 ''' 刷新 Mod 列表。
''' </summary> ''' </summary>
Public Sub ReloadModList(Optional ForceReload As Boolean = False) Public Sub ReloadModList(Optional ForceReload As Boolean = False)
If LoaderRun(If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then If Not LoaderRun(If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then Return
Log("[System] 已刷新 Mod 列表") Log("[System] 已刷新 Mod 列表")
Filter = FilterType.All Filter = FilterType.All
PanBack.ScrollToHome() PanBack.ScrollToHome()
SearchBox.Text = "" SearchBox.Text = ""
End If
End Sub End Sub
'强制刷新 '强制刷新
Private Sub RefreshSelf() Implements IRefreshable.Refresh Private Sub RefreshSelf() Implements IRefreshable.Refresh
Refresh() Refresh()
End Sub End Sub
Public Shared Sub Refresh() Public Shared Sub Refresh()
'强制刷新
Try Try
CompProjectCache.Clear() CompProjectCache.Clear()
CompFilesCache.Clear() CompFilesCache.Clear()
@@ -53,8 +47,8 @@
Catch ex As Exception Catch ex As Exception
Log(ex, "强制刷新时清理本地 Mod 信息缓存失败") Log(ex, "强制刷新时清理本地 Mod 信息缓存失败")
End Try End Try
If FrmVersionMod IsNot Nothing Then FrmVersionMod.ReloadModList(True) '无需 Else,还没加载刷个鬼的新 If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.ReloadModList(True) '无需 Else,还没加载刷个鬼的新
FrmVersionLeft.ItemMod.Checked = True FrmInstanceLeft.ItemMod.Checked = True
Hint("正在刷新……", Log:=False) Hint("正在刷新……", Log:=False)
End Sub End Sub
@@ -67,7 +61,7 @@
End If End If
End Sub End Sub
Public Function LoaderRun(Type As LoaderFolderRunType) As Boolean Public Function LoaderRun(Type As LoaderFolderRunType) As Boolean
Return LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", Type) Return LoaderFolderRun(McModLoader, PageInstanceLeft.Instance.PathIndie & "mods\", Type)
End Function End Function
#End Region #End Region
@@ -109,8 +103,7 @@
AniControlEnabled += 1 AniControlEnabled += 1
Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry, Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry,
.ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.RawFileName)} .ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.RawFileName)}
AddHandler Entry.OnCompUpdate, AddressOf NewItem.Refresh AddHandler Entry.OnUpdate, Sub() RunInUi(AddressOf NewItem.Refresh)
NewItem.Refresh()
AniControlEnabled -= 1 AniControlEnabled -= 1
Return NewItem Return NewItem
End Function End Function
@@ -144,11 +137,7 @@
ToolTipService.SetVerticalOffset(BtnED, 30) ToolTipService.SetVerticalOffset(BtnED, 30)
ToolTipService.SetHorizontalOffset(BtnED, 2) ToolTipService.SetHorizontalOffset(BtnED, 2)
AddHandler BtnED.Click, AddressOf ED_Click AddHandler BtnED.Click, AddressOf ED_Click
If sender.Entry.State = McMod.McModState.Unavailable Then
sender.Buttons = {BtnCont, BtnOpen, BtnDelete}
Else
sender.Buttons = {BtnCont, BtnOpen, BtnED, BtnDelete} sender.Buttons = {BtnCont, BtnOpen, BtnED, BtnDelete}
End If
End Sub End Sub
''' <summary> ''' <summary>
@@ -188,13 +177,11 @@
Dim EnabledCount As Integer = 0 Dim EnabledCount As Integer = 0
Dim DisabledCount As Integer = 0 Dim DisabledCount As Integer = 0
Dim UpdateCount As Integer = 0 Dim UpdateCount As Integer = 0
Dim UnavalialeCount As Integer = 0
For Each ModItem In If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of McMod))) For Each ModItem In If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of McMod)))
AnyCount += 1 AnyCount += 1
If ModItem.CanUpdate Then UpdateCount += 1 If ModItem.CanUpdate Then UpdateCount += 1
If ModItem.State.Equals(McMod.McModState.Fine) Then EnabledCount += 1 If ModItem.State.Equals(McMod.McModState.Fine) Then EnabledCount += 1
If ModItem.State.Equals(McMod.McModState.Disabled) Then DisabledCount += 1 If ModItem.State.Equals(McMod.McModState.Disabled) Then DisabledCount += 1
If ModItem.State.Equals(McMod.McModState.Unavailable) Then UnavalialeCount += 1
Next Next
'显示 '显示
BtnFilterAll.Text = If(IsSearching, "搜索结果", "全部") & $" ({AnyCount})" BtnFilterAll.Text = If(IsSearching, "搜索结果", "全部") & $" ({AnyCount})"
@@ -204,8 +191,6 @@
BtnFilterEnabled.Visibility = If(Filter = FilterType.Enabled OrElse (EnabledCount > 0 AndAlso EnabledCount < AnyCount), Visibility.Visible, Visibility.Collapsed) BtnFilterEnabled.Visibility = If(Filter = FilterType.Enabled OrElse (EnabledCount > 0 AndAlso EnabledCount < AnyCount), Visibility.Visible, Visibility.Collapsed)
BtnFilterDisabled.Text = $"禁用 ({DisabledCount})" BtnFilterDisabled.Text = $"禁用 ({DisabledCount})"
BtnFilterDisabled.Visibility = If(Filter = FilterType.Disabled OrElse DisabledCount > 0, Visibility.Visible, Visibility.Collapsed) BtnFilterDisabled.Visibility = If(Filter = FilterType.Disabled OrElse DisabledCount > 0, Visibility.Visible, Visibility.Collapsed)
BtnFilterError.Text = $"错误 ({UnavalialeCount})"
BtnFilterError.Visibility = If(Filter = FilterType.Unavailable OrElse UnavalialeCount > 0, Visibility.Visible, Visibility.Collapsed)
'----------------- '-----------------
' 底部栏 ' 底部栏
@@ -289,31 +274,13 @@
''' </summary> ''' </summary>
Private Sub BtnManageOpen_Click(sender As Object, e As EventArgs) Handles BtnManageOpen.Click, BtnHintOpen.Click Private Sub BtnManageOpen_Click(sender As Object, e As EventArgs) Handles BtnManageOpen.Click, BtnHintOpen.Click
Try Try
Directory.CreateDirectory(PageVersionLeft.Version.PathIndie & "mods\") Directory.CreateDirectory(PageInstanceLeft.Instance.PathIndie & "mods\")
OpenExplorer(PageVersionLeft.Version.PathIndie & "mods\") OpenExplorer(PageInstanceLeft.Instance.PathIndie & "mods\")
Catch ex As Exception Catch ex As Exception
Log(ex, "打开 Mods 文件夹失败", LogLevel.Msgbox) Log(ex, "打开 Mods 文件夹失败", LogLevel.Msgbox)
End Try End Try
End Sub End Sub
#If DEBUG Then
''' <summary>
''' 检查 Mod。
''' </summary>
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try
Dim Result = McModCheck(PageVersionLeft.Version, McModLoader.Output)
If Result.Any Then
MyMsgBox(Join(Result, vbCrLf & vbCrLf), "Mod 检查结果")
Else
Hint("Mod 检查完成,未发现任何问题!", HintType.Green)
End If
Catch ex As Exception
Log(ex, "进行 Mod 检查时出错", LogLevel.Feedback)
End Try
End Sub
#End If
''' <summary> ''' <summary>
''' 全选。 ''' 全选。
''' </summary> ''' </summary>
@@ -344,14 +311,14 @@
Return True Return True
End If End If
'获取并检查目标版本 '获取并检查目标版本
Dim TargetVersion As McVersion = McVersionCurrent Dim Instance As McInstance = McInstanceSelected
If FrmMain.PageCurrent = FormMain.PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version If FrmMain.PageCurrent = FormMain.PageType.InstanceSetup Then Instance = PageInstanceLeft.Instance
If FrmMain.PageCurrent = FormMain.PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Modable Then If FrmMain.PageCurrent = FormMain.PageType.InstanceSelect OrElse Instance Is Nothing OrElse Not Instance.Modable Then
'正在选择版本,或当前版本不能安装 Mod '正在选择版本,或当前版本不能安装 Mod
Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!") Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!")
ElseIf Not (FrmMain.PageCurrent = FormMain.PageType.VersionSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.VersionMod) Then ElseIf Not (FrmMain.PageCurrent = FormMain.PageType.InstanceSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.InstanceMod) Then
'未处于 Mod 管理页面 '未处于 Mod 管理页面
If MyMsgBox($"是否要将这{If(FilePathList.Count = 1, "个", "些")}文件作为 Mod 安装到 {TargetVersion.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install If MyMsgBox($"是否要将这{If(FilePathList.Count = 1, "个", "些")}文件作为 Mod 安装到 {Instance.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
Else Else
'处于 Mod 管理页面 '处于 Mod 管理页面
Install: Install:
@@ -359,7 +326,7 @@ Install:
For Each ModFile In FilePathList For Each ModFile In FilePathList
Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "").Replace(".old", "") Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "").Replace(".old", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227 If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName) CopyFile(ModFile, Instance.PathIndie & "mods\" & NewFileName)
Next Next
If FilePathList.Count = 1 Then If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}!", HintType.Green) Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}!", HintType.Green)
@@ -367,8 +334,8 @@ Install:
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Green) Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Green)
End If End If
'刷新列表 '刷新列表
If FrmMain.PageCurrent = FormMain.PageType.VersionSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.VersionMod Then If FrmMain.PageCurrent = FormMain.PageType.InstanceSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.InstanceMod Then
LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun) LoaderFolderRun(McModLoader, Instance.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox) Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox)
@@ -382,7 +349,7 @@ Install:
''' </summary> ''' </summary>
Private Sub BtnManageDownload_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageDownload.Click, BtnHintDownload.Click Private Sub BtnManageDownload_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageDownload.Click, BtnHintDownload.Click
'预设置当前版本和搜索框内容 '预设置当前版本和搜索框内容
PageComp.TargetVersion = PageVersionLeft.Version PageComp.TargetInstance = PageInstanceLeft.Instance
PageComp.TargetName = SearchBox.Text PageComp.TargetName = SearchBox.Text
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadMod) FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadMod)
End Sub End Sub
@@ -455,10 +422,8 @@ Install:
BtnFilterEnabled.Checked = True BtnFilterEnabled.Checked = True
Case FilterType.Disabled Case FilterType.Disabled
BtnFilterDisabled.Checked = True BtnFilterDisabled.Checked = True
Case FilterType.CanUpdate
BtnFilterCanUpdate.Checked = True
Case Else Case Else
BtnFilterError.Checked = True BtnFilterCanUpdate.Checked = True
End Select End Select
RefreshUI() RefreshUI()
End Set End Set
@@ -468,7 +433,6 @@ Install:
Enabled = 1 Enabled = 1
Disabled = 2 Disabled = 2
CanUpdate = 3 CanUpdate = 3
Unavailable = 4
End Enum End Enum
''' <summary> ''' <summary>
@@ -484,15 +448,13 @@ Install:
Return CheckingMod.State = McMod.McModState.Disabled Return CheckingMod.State = McMod.McModState.Disabled
Case FilterType.CanUpdate Case FilterType.CanUpdate
Return CheckingMod.CanUpdate Return CheckingMod.CanUpdate
Case FilterType.Unavailable
Return CheckingMod.State = McMod.McModState.Unavailable
Case Else Case Else
Return False Return False
End Select End Select
End Function End Function
'点击筛选项触发的改变 '点击筛选项触发的改变
Private Sub ChangeFilter(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnFilterAll.Check, BtnFilterCanUpdate.Check, BtnFilterDisabled.Check, BtnFilterEnabled.Check, BtnFilterError.Check Private Sub ChangeFilter(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnFilterAll.Check, BtnFilterCanUpdate.Check, BtnFilterDisabled.Check, BtnFilterEnabled.Check
Filter = sender.Tag Filter = sender.Tag
RefreshUI() RefreshUI()
End Sub End Sub
@@ -586,7 +548,7 @@ Install:
''' <summary> ''' <summary>
''' 记录正在进行 Mod 更新的 mods 文件夹路径。 ''' 记录正在进行 Mod 更新的 mods 文件夹路径。
''' </summary> ''' </summary>
Public Shared UpdatingVersions As New List(Of String) Public Shared UpdatingInstanceModFolders As New List(Of String)
Public Sub UpdateMods(ModList As IEnumerable(Of McMod)) Public Sub UpdateMods(ModList As IEnumerable(Of McMod))
'更新前警告 '更新前警告
If Not Setup.Get("HintUpdateMod") OrElse ModList.Count >= 15 Then If Not Setup.Get("HintUpdateMod") OrElse ModList.Count >= 15 Then
@@ -665,8 +627,8 @@ Install:
End Try End Try
End Sub)) End Sub))
'结束处理 '结束处理
Dim Loader As New LoaderCombo(Of IEnumerable(Of McMod))("Mod 更新:" & PageVersionLeft.Version.Name, InstallLoaders) Dim Loader As New LoaderCombo(Of IEnumerable(Of McMod))("Mod 更新:" & PageInstanceLeft.Instance.Name, InstallLoaders)
Dim PathMods As String = PageVersionLeft.Version.PathIndie & "mods\" Dim PathMods As String = PageInstanceLeft.Instance.PathIndie & "mods\"
Loader.OnStateChanged = Loader.OnStateChanged =
Sub() Sub()
'结果提示 '结果提示
@@ -688,7 +650,7 @@ Install:
Return Return
End Select End Select
Log($"[Mod] 已从正在进行 Mod 更新的文件夹列表移除:{PathMods}") Log($"[Mod] 已从正在进行 Mod 更新的文件夹列表移除:{PathMods}")
UpdatingVersions.Remove(PathMods) UpdatingInstanceModFolders.Remove(PathMods)
'清理缓存 '清理缓存
RunInNewThread( RunInNewThread(
Sub() Sub()
@@ -703,7 +665,7 @@ Install:
End Sub End Sub
'启动加载器 '启动加载器
Log($"[Mod] 开始更新 {ModList.Count} 个 Mod:{PathMods}") Log($"[Mod] 开始更新 {ModList.Count} 个 Mod:{PathMods}")
UpdatingVersions.Add(PathMods) UpdatingInstanceModFolders.Add(PathMods)
Loader.Start() Loader.Start()
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
@@ -807,41 +769,27 @@ Install:
Dim ModEntry As McMod = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry Dim ModEntry As McMod = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry
'加载失败信息 '加载失败信息
If ModEntry.State = McMod.McModState.Unavailable Then
MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息:" & ModEntry.FileUnavailableReason.GetDetail(), "Mod 读取失败")
Return
End If
If ModEntry.Comp IsNot Nothing Then If ModEntry.Comp IsNot Nothing Then
'跳转到 Mod 下载页面 '跳转到 Mod 下载页面
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {ModEntry.Comp, New List(Of String), PageVersionLeft.Version.Version.McName, .Additional = {ModEntry.Comp, New List(Of String), PageInstanceLeft.Instance.Version.VanillaName,
If(PageVersionLeft.Version.Version.HasForge, CompModLoaderType.Forge, If(PageInstanceLeft.Instance.Version.HasForge, CompModLoaderType.Forge,
If(PageVersionLeft.Version.Version.HasNeoForge, CompModLoaderType.NeoForge, If(PageInstanceLeft.Instance.Version.HasNeoForge, CompModLoaderType.NeoForge,
If(PageVersionLeft.Version.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any))), If(PageInstanceLeft.Instance.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any))),
CompType.Mod}}) CompType.Mod}})
Else Else
'获取信息 '获取信息
Dim ContentLines As New List(Of String) Dim ContentLines As New List(Of String)
If ModEntry.Description IsNot Nothing Then ContentLines.Add(ModEntry.Description & vbCrLf) 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) & ")") ContentLines.Add("文件:" & ModEntry.FileName & "(" & GetString(New FileInfo(ModEntry.Path).Length) & ")")
If ModEntry.Version IsNot Nothing Then ContentLines.Add("版本:" & ModEntry.Version) If ModEntry.Version IsNot Nothing Then ContentLines.Add("版本:" & ModEntry.Version)
Dim DebugInfo As New List(Of String) Dim DebugInfo As New List(Of String)
If ModEntry.ModId IsNot Nothing Then
DebugInfo.Add("Mod ID:" & ModEntry.ModId)
End If
If ModEntry.Dependencies.Any 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.Any Then If DebugInfo.Any Then
ContentLines.Add("") ContentLines.Add("")
ContentLines.AddRange(DebugInfo) ContentLines.AddRange(DebugInfo)
End If End If
'获取用于搜索的 Mod 名称 '获取用于搜索的 Mod 名称
Dim ModOriginalName As String = ModEntry.Name.Replace(" ", "+") Dim ModOriginalName As String = ModEntry.DisplayName.Replace(" ", "+")
Dim ModSearchName As String = ModOriginalName.Substring(0, 1) Dim ModSearchName As String = ModOriginalName.Substring(0, 1)
For i = 1 To ModOriginalName.Count - 1 For i = 1 To ModOriginalName.Count - 1
Dim IsLastLower As Boolean = ModOriginalName(i - 1).ToString.ToLower.Equals(ModOriginalName(i - 1).ToString) Dim IsLastLower As Boolean = ModOriginalName(i - 1).ToString.ToLower.Equals(ModOriginalName(i - 1).ToString)
@@ -853,19 +801,10 @@ Install:
ModSearchName += ModOriginalName(i) ModSearchName += ModOriginalName(i)
Next Next
ModSearchName = ModSearchName.Replace("++", "+").Replace("pti+Fine", "ptiFine") ModSearchName = ModSearchName.Replace("++", "+").Replace("pti+Fine", "ptiFine")
'显示 '百科搜索链接
If ModEntry.Url Is Nothing Then If MyMsgBox(Join(ContentLines, vbCrLf), ModEntry.DisplayName, "百科搜索", "返回") = 1 Then
If MyMsgBox(Join(ContentLines, vbCrLf), ModEntry.Name, "百科搜索", "返回") = 1 Then
OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0") OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0")
End If 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 End If
Catch ex As Exception Catch ex As Exception
Log(ex, "获取 Mod 详情失败", LogLevel.Feedback) Log(ex, "获取 Mod 详情失败", LogLevel.Feedback)
@@ -907,7 +846,7 @@ Install:
Dim QueryList As New List(Of SearchEntry(Of McMod)) Dim QueryList As New List(Of SearchEntry(Of McMod))
For Each Entry As McMod In McModLoader.Output For Each Entry As McMod In McModLoader.Output
Dim SearchSource As New List(Of KeyValuePair(Of String, Double)) 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.DisplayName, 1))
SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.FileName, 1)) SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.FileName, 1))
If Entry.Version IsNot Nothing Then If Entry.Version IsNot Nothing Then
SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Version, 0.2)) SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Version, 0.2))
@@ -916,7 +855,7 @@ Install:
SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Description, 0.4)) SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Description, 0.4))
End If End If
If Entry.Comp IsNot Nothing Then 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.RawName <> Entry.DisplayName 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.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)) If Entry.Comp.Description <> Entry.Description Then SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Comp.Description, 0.4))
SearchSource.Add(New KeyValuePair(Of String, Double)(String.Join("", Entry.Comp.Tags), 0.2)) SearchSource.Add(New KeyValuePair(Of String, Double)(String.Join("", Entry.Comp.Tags), 0.2))
@@ -1,4 +1,4 @@
<local:MyPageRight x:Class="PageVersionModDisabled" <local:MyPageRight x:Class="PageInstanceModDisabled"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
@@ -1,11 +1,11 @@
Class PageVersionModDisabled Class PageInstanceModDisabled
Private Sub BtnDownload_Click(sender As Object, e As EventArgs) Handles BtnDownload.Click Private Sub BtnDownload_Click(sender As Object, e As EventArgs) Handles BtnDownload.Click
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall) FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End Sub End Sub
Private Sub BtnVersion_Click(sender As Object, e As EventArgs) Handles BtnVersion.Click Private Sub BtnVersion_Click(sender As Object, e As EventArgs) Handles BtnVersion.Click
FrmMain.PageChange(FormMain.PageType.Launch) '在版本选择页面选定版本的时候只会返回一层,因此如果不先锚定 Launch,在选择版本后会回退到版本设置的这个页面 FrmMain.PageChange(FormMain.PageType.Launch) '在版本选择页面选定版本的时候只会返回一层,因此如果不先锚定 Launch,在选择版本后会回退到版本设置的这个页面
FrmMain.PageChange(FormMain.PageType.VersionSelect) FrmMain.PageChange(FormMain.PageType.InstanceSelect)
End Sub End Sub
Public Sub BtnDownload_Loaded() Handles BtnDownload.Loaded Public Sub BtnDownload_Loaded() Handles BtnDownload.Loaded
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:System="clr-namespace:System;assembly=mscorlib" xmlns:System="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageVersionOverall" mc:Ignorable="d" x:Class="PageInstanceOverall"
PanScroll="PanBack" Grid.IsSharedSizeScope="True"> PanScroll="PanBack" Grid.IsSharedSizeScope="True">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10"> <StackPanel x:Name="PanMain" Margin="25,10">
@@ -25,7 +25,7 @@
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="图标" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="图标" Margin="0,0,25,0" />
<local:MyComboBox Grid.Column="1" x:Name="ComboDisplayLogo"> <local:MyComboBox Grid.Column="1" x:Name="ComboDisplayLogo">
<local:MyComboBoxItem Content="自动" IsSelected="True" Tag="" /> <local:MyComboBoxItem Content="自动" IsSelected="True" Tag="" />
<local:MyComboBoxItem Content="自定义..." x:Name="ItemDisplayLogoCustom" /> <local:MyComboBoxItem Content="自定义..." x:Name="ItemDisplayLogoCustom" Tag="PCL\Logo.png" />
<local:MyComboBoxItem Content="圆石" Tag="pack://application:,,,/images/Blocks/CobbleStone.png" /> <local:MyComboBoxItem Content="圆石" Tag="pack://application:,,,/images/Blocks/CobbleStone.png" />
<local:MyComboBoxItem Content="命令方块" Tag="pack://application:,,,/images/Blocks/CommandBlock.png" /> <local:MyComboBoxItem Content="命令方块" Tag="pack://application:,,,/images/Blocks/CommandBlock.png" />
<local:MyComboBoxItem Content="金块" Tag="pack://application:,,,/images/Blocks/GoldBlock.png" /> <local:MyComboBoxItem Content="金块" Tag="pack://application:,,,/images/Blocks/GoldBlock.png" />
@@ -1,4 +1,4 @@
Public Class PageVersionOverall Public Class PageInstanceOverall
Private IsLoad As Boolean = False Private IsLoad As Boolean = False
Private Sub PageSetupLaunch_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub PageSetupLaunch_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
@@ -7,7 +7,6 @@
PanBack.ScrollToHome() PanBack.ScrollToHome()
'更新设置 '更新设置
ItemDisplayLogoCustom.Tag = "PCL\Logo.png"
Reload() Reload()
'非重复加载部分 '非重复加载部分
@@ -17,7 +16,7 @@
End Sub End Sub
Public ItemVersion As MyListItem Public InstanceHeaderItem As MyListItem
''' <summary> ''' <summary>
''' 确保当前页面上的信息已正确显示。 ''' 确保当前页面上的信息已正确显示。
''' </summary> ''' </summary>
@@ -25,19 +24,19 @@
AniControlEnabled += 1 AniControlEnabled += 1
'刷新设置项目 '刷新设置项目
ComboDisplayType.SelectedIndex = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto) ComboDisplayType.SelectedIndex = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Auto)
BtnDisplayStar.Text = If(PageVersionLeft.Version.IsStar, "从收藏夹中移除", "加入收藏夹") BtnDisplayStar.Text = If(PageInstanceLeft.Instance.IsStar, "从收藏夹中移除", "加入收藏夹")
BtnFolderMods.Visibility = If(PageVersionLeft.Version.Modable, Visibility.Visible, Visibility.Collapsed) BtnFolderMods.Visibility = If(PageInstanceLeft.Instance.Modable, Visibility.Visible, Visibility.Collapsed)
'刷新版本显示 '刷新版本显示
PanDisplayItem.Children.Clear() PanDisplayItem.Children.Clear()
ItemVersion = PageVersionLeft.Version.ToListItem InstanceHeaderItem = PageInstanceLeft.Instance.ToListItem().Init()
ItemVersion.IsHitTestVisible = False InstanceHeaderItem.IsHitTestVisible = False
PanDisplayItem.Children.Add(ItemVersion) PanDisplayItem.Children.Add(InstanceHeaderItem)
FrmMain.PageNameRefresh() FrmMain.PageNameRefresh()
'刷新版本图标 '刷新版本图标
ComboDisplayLogo.SelectedIndex = 0 ComboDisplayLogo.SelectedIndex = 0
Dim Logo As String = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "Logo", "") Dim Logo As String = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "Logo", "")
Dim LogoCustom As Boolean = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "LogoCustom", "False") Dim LogoCustom As Boolean = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "LogoCustom", "False")
If LogoCustom Then If LogoCustom Then
For Each Selection As MyComboBoxItem In ComboDisplayLogo.Items For Each Selection As MyComboBoxItem In ComboDisplayLogo.Items
If Selection.Tag = Logo OrElse (Selection.Tag = "PCL\Logo.png" AndAlso Logo.EndsWith("PCL\Logo.png")) Then If Selection.Tag = Logo OrElse (Selection.Tag = "PCL\Logo.png" AndAlso Logo.EndsWith("PCL\Logo.png")) Then
@@ -59,14 +58,14 @@
'改为不隐藏 '改为不隐藏
Try Try
'若设置分类为可安装 Mod,则显示正常的 Mod 管理页面 '若设置分类为可安装 Mod,则显示正常的 Mod 管理页面
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", ComboDisplayType.SelectedIndex) WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "DisplayType", ComboDisplayType.SelectedIndex)
PageVersionLeft.Version.DisplayType = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto) PageInstanceLeft.Instance.DisplayType = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Auto)
FrmVersionLeft.RefreshModDisabled() FrmInstanceLeft.RefreshModDisabled()
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '要求刷新缓存 WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "修改版本分类失败(" & PageVersionLeft.Version.Name & ")", LogLevel.Feedback) Log(ex, "修改版本分类失败(" & PageInstanceLeft.Instance.Name & ")", LogLevel.Feedback)
End Try End Try
Reload() '更新 “打开 Mod 文件夹” 按钮 Reload() '更新 “打开 Mod 文件夹” 按钮
Else Else
@@ -79,11 +78,11 @@
End If End If
Setup.Set("HintHide", True) Setup.Set("HintHide", True)
End If End If
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Hidden) WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Hidden)
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '要求刷新缓存 WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "隐藏版本 " & PageVersionLeft.Version.Name & " 失败", LogLevel.Feedback) Log(ex, "隐藏版本 " & PageInstanceLeft.Instance.Name & " 失败", LogLevel.Feedback)
End Try End Try
End If End If
End Sub End Sub
@@ -91,14 +90,14 @@
'更改描述 '更改描述
Private Sub BtnDisplayDesc_Click(sender As Object, e As EventArgs) Handles BtnDisplayDesc.Click Private Sub BtnDisplayDesc_Click(sender As Object, e As EventArgs) Handles BtnDisplayDesc.Click
Try Try
Dim OldInfo As String = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "CustomInfo") Dim OldInfo As String = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "CustomInfo")
Dim NewInfo As String = MyMsgBoxInput("更改描述", "修改版本的描述文本,留空则使用 PCL 的默认描述。", OldInfo, New ObjectModel.Collection(Of Validate), "默认描述") Dim NewInfo As String = MyMsgBoxInput("更改描述", "修改版本的描述文本,留空则使用 PCL 的默认描述。", OldInfo, New ObjectModel.Collection(Of Validate), "默认描述")
If NewInfo IsNot Nothing AndAlso OldInfo <> NewInfo Then WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "CustomInfo", NewInfo) If NewInfo IsNot Nothing AndAlso OldInfo <> NewInfo Then WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "CustomInfo", NewInfo)
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load() PageInstanceLeft.Instance = New McInstance(PageInstanceLeft.Instance.Name).Load()
Reload() Reload()
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "版本 " & PageVersionLeft.Version.Name & " 描述更改失败", LogLevel.Msgbox) Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 描述更改失败", LogLevel.Msgbox)
End Try End Try
End Sub End Sub
@@ -106,32 +105,32 @@
Private Sub BtnDisplayRename_Click(sender As Object, e As EventArgs) Handles BtnDisplayRename.Click Private Sub BtnDisplayRename_Click(sender As Object, e As EventArgs) Handles BtnDisplayRename.Click
Try Try
'确认输入的新名称 '确认输入的新名称
Dim OldName As String = PageVersionLeft.Version.Name Dim OldName As String = PageInstanceLeft.Instance.Name
Dim OldPath As String = PageVersionLeft.Version.Path Dim OldPath As String = PageInstanceLeft.Instance.PathVersion
'修改此部分的同时修改快速安装的版本名检测* '修改此部分的同时修改快速安装的版本名检测*
Dim NewName As String = MyMsgBoxInput("重命名版本", "", OldName, New ObjectModel.Collection(Of Validate) From { Dim NewName As String = MyMsgBoxInput("重命名版本", "", OldName, New ObjectModel.Collection(Of Validate) From {
New ValidateFolderName(PathMcFolder & "versions", IgnoreCase:=False), New ValidateExceptSame(OldName & "_temp", "不能使用该名称!")}) New ValidateFolderName(McFolderSelected & "versions", IgnoreCase:=False), New ValidateExceptSame(OldName & "_temp", "不能使用该名称!")})
If String.IsNullOrWhiteSpace(NewName) Then Return If String.IsNullOrWhiteSpace(NewName) Then Return
Dim NewPath As String = PathMcFolder & "versions\" & NewName & "\" Dim NewPath As String = McFolderSelected & "versions\" & NewName & "\"
'获取临时中间名,以防止仅修改大小写的重命名失败 '获取临时中间名,以防止仅修改大小写的重命名失败
Dim TempName As String = NewName & "_temp" Dim TempName As String = NewName & "_temp"
Dim TempPath As String = PathMcFolder & "versions\" & TempName & "\" Dim TempPath As String = McFolderSelected & "versions\" & TempName & "\"
Dim OnlyChangedCase As Boolean = NewName.ToLower = OldName.ToLower Dim OnlyChangedCase As Boolean = NewName.ToLower = OldName.ToLower
'重新读取版本 JSON 信息,避免 JsonObject 中已被合并的项被重新存储 '重新读取版本 JSON 信息,避免 JsonObject 中已被合并的项被重新存储
Dim JsonObject As JObject Dim JsonObject As JObject
Dim OldJsonPath As String = PageVersionLeft.Version.GetJsonPath() Dim OldJsonPath As String = PageInstanceLeft.Instance.GetJsonPath()
Try Try
JsonObject = GetJson(ReadFile(OldJsonPath)) JsonObject = GetJson(ReadFile(OldJsonPath))
Catch ex As Exception Catch ex As Exception
Log(ex, "在重命名读取 json 时失败") Log(ex, "在重命名读取 json 时失败")
JsonObject = PageVersionLeft.Version.JsonObject JsonObject = PageInstanceLeft.Instance.JsonObject
End Try End Try
'重命名主文件夹 '重命名主文件夹
My.Computer.FileSystem.RenameDirectory(OldPath, TempName) My.Computer.FileSystem.RenameDirectory(OldPath, TempName)
My.Computer.FileSystem.RenameDirectory(TempPath, NewName) My.Computer.FileSystem.RenameDirectory(TempPath, NewName)
'清理 ini 缓存 '清理 ini 缓存
IniClearCache(PageVersionLeft.Version.PathIndie & "options.txt") IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt")
IniClearCache(PageVersionLeft.Version.Path & "PCL\Setup.ini") IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini")
'重命名 jar 文件与 natives 文件夹 '重命名 jar 文件与 natives 文件夹
'不能进行遍历重命名,否则在版本名很短的时候容易误伤其他文件(#6443) '不能进行遍历重命名,否则在版本名很短的时候容易误伤其他文件(#6443)
If Directory.Exists($"{NewPath}{OldName}-natives") Then If Directory.Exists($"{NewPath}{OldName}-natives") Then
@@ -157,8 +156,8 @@
WriteFile(NewPath & "PCL\Setup.ini", ReadFile(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath)) WriteFile(NewPath & "PCL\Setup.ini", ReadFile(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath))
End If End If
'更改已选中的版本 '更改已选中的版本
If ReadIni(PathMcFolder & "PCL.ini", "Version") = OldName Then If ReadIni(McFolderSelected & "PCL.ini", "Version") = OldName Then
WriteIni(PathMcFolder & "PCL.ini", "Version", NewName) WriteIni(McFolderSelected & "PCL.ini", "Version", NewName)
End If End If
'更新版本 Json '更新版本 Json
Try Try
@@ -170,10 +169,10 @@
End Try End Try
'刷新与提示 '刷新与提示
Hint("重命名成功!", HintType.Green) Hint("重命名成功!", HintType.Green)
PageVersionLeft.Version = New McVersion(NewName).Load() PageInstanceLeft.Instance = New McInstance(NewName).Load()
If Not IsNothing(McVersionCurrent) AndAlso McVersionCurrent.Equals(PageVersionLeft.Version) Then WriteIni(PathMcFolder & "PCL.ini", "Version", NewName) If Not IsNothing(McInstanceSelected) AndAlso McInstanceSelected.Equals(PageInstanceLeft.Instance) Then WriteIni(McFolderSelected & "PCL.ini", "Version", NewName)
Reload() Reload()
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "重命名版本失败", LogLevel.Msgbox) Log(ex, "重命名版本失败", LogLevel.Msgbox)
End Try End Try
@@ -190,38 +189,38 @@
Reload() '还原选项 Reload() '还原选项
Return Return
End If End If
CopyFile(FileName, PageVersionLeft.Version.Path & "PCL\Logo.png") CopyFile(FileName, PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
Else Else
File.Delete(PageVersionLeft.Version.Path & "PCL\Logo.png") File.Delete(PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "更改自定义版本图标失败(" & PageVersionLeft.Version.Name & ")", LogLevel.Feedback) Log(ex, "更改自定义版本图标失败(" & PageInstanceLeft.Instance.Name & ")", LogLevel.Feedback)
End Try End Try
'进行更改 '进行更改
Try Try
Dim NewLogo As String = ComboDisplayLogo.SelectedItem.Tag Dim NewLogo As String = ComboDisplayLogo.SelectedItem.Tag
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "Logo", NewLogo) WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "Logo", NewLogo)
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "LogoCustom", Not NewLogo = "") WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "LogoCustom", Not NewLogo = "")
'刷新显示 '刷新显示
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '要求刷新缓存 WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load() PageInstanceLeft.Instance = New McInstance(PageInstanceLeft.Instance.Name).Load()
Reload() Reload()
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "更改版本图标失败(" & PageVersionLeft.Version.Name & ")", LogLevel.Feedback) Log(ex, "更改版本图标失败(" & PageInstanceLeft.Instance.Name & ")", LogLevel.Feedback)
End Try End Try
End Sub End Sub
'收藏夹 '收藏夹
Private Sub BtnDisplayStar_Click(sender As Object, e As EventArgs) Handles BtnDisplayStar.Click Private Sub BtnDisplayStar_Click(sender As Object, e As EventArgs) Handles BtnDisplayStar.Click
Try Try
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "IsStar", Not PageVersionLeft.Version.IsStar) WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "IsStar", Not PageInstanceLeft.Instance.IsStar)
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load() PageInstanceLeft.Instance = New McInstance(PageInstanceLeft.Instance.Name).Load()
Reload() Reload()
McVersionListForceRefresh = True McInstanceListForceRefresh = True
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception Catch ex As Exception
Log(ex, "版本 " & PageVersionLeft.Version.Name & " 收藏状态更改失败", LogLevel.Msgbox) Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 收藏状态更改失败", LogLevel.Msgbox)
End Try End Try
End Sub End Sub
@@ -231,22 +230,22 @@
'版本文件夹 '版本文件夹
Private Sub BtnFolderVersion_Click() Handles BtnFolderVersion.Click Private Sub BtnFolderVersion_Click() Handles BtnFolderVersion.Click
OpenVersionFolder(PageVersionLeft.Version) OpenInstanceFolder(PageInstanceLeft.Instance)
End Sub End Sub
Public Shared Sub OpenVersionFolder(Version As McVersion) Public Shared Sub OpenInstanceFolder(Instance As McInstance)
OpenExplorer(Version.Path) OpenExplorer(Instance.PathVersion)
End Sub End Sub
'存档文件夹 '存档文件夹
Private Sub BtnFolderSaves_Click() Handles BtnFolderSaves.Click Private Sub BtnFolderSaves_Click() Handles BtnFolderSaves.Click
Dim FolderPath As String = PageVersionLeft.Version.PathIndie & "saves\" Dim FolderPath As String = PageInstanceLeft.Instance.PathIndie & "saves\"
Directory.CreateDirectory(FolderPath) Directory.CreateDirectory(FolderPath)
OpenExplorer(FolderPath) OpenExplorer(FolderPath)
End Sub End Sub
'Mod 文件夹 'Mod 文件夹
Private Sub BtnFolderMods_Click() Handles BtnFolderMods.Click Private Sub BtnFolderMods_Click() Handles BtnFolderMods.Click
Dim FolderPath As String = PageVersionLeft.Version.PathIndie & "mods\" Dim FolderPath As String = PageInstanceLeft.Instance.PathIndie & "mods\"
Directory.CreateDirectory(FolderPath) Directory.CreateDirectory(FolderPath)
OpenExplorer(FolderPath) OpenExplorer(FolderPath)
End Sub End Sub
@@ -259,7 +258,7 @@
Private Sub BtnManageScript_Click() Handles BtnManageScript.Click Private Sub BtnManageScript_Click() Handles BtnManageScript.Click
Try Try
'弹窗要求指定脚本的保存位置 '弹窗要求指定脚本的保存位置
Dim SavePath As String = SelectSaveFile("选择脚本保存位置", "启动 " & PageVersionLeft.Version.Name & ".bat", "批处理文件(*.bat)|*.bat") Dim SavePath As String = SelectSaveFile("选择脚本保存位置", "启动 " & PageInstanceLeft.Instance.Name & ".bat", "批处理文件(*.bat)|*.bat")
If SavePath = "" Then Return If SavePath = "" Then Return
'检查中断(等玩家选完弹窗指不定任务就结束了呢……) '检查中断(等玩家选完弹窗指不定任务就结束了呢……)
If McLaunchLoader.State = LoadState.Loading Then If McLaunchLoader.State = LoadState.Loading Then
@@ -267,7 +266,7 @@
Return Return
End If End If
'生成脚本 '生成脚本
If McLaunchStart(New McLaunchOptions With {.SaveBatch = SavePath, .Version = PageVersionLeft.Version}) Then If McLaunchStart(New McLaunchOptions With {.SaveBatch = SavePath, .Instance = PageInstanceLeft.Instance}) Then
If Setup.Get("LoginType") = McLoginType.Legacy Then If Setup.Get("LoginType") = McLoginType.Legacy Then
Hint("正在导出启动脚本……") Hint("正在导出启动脚本……")
Else Else
@@ -275,7 +274,7 @@
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "导出启动脚本失败(" & PageVersionLeft.Version.Name & ")", LogLevel.Msgbox) Log(ex, "导出启动脚本失败(" & PageInstanceLeft.Instance.Name & ")", LogLevel.Msgbox)
End Try End Try
End Sub End Sub
@@ -283,18 +282,18 @@
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try Try
'忽略文件检查提示 '忽略文件检查提示
If ShouldIgnoreFileCheck(PageVersionLeft.Version) Then If ShouldIgnoreFileCheck(PageInstanceLeft.Instance) Then
Hint("请先关闭 [版本设置 → 设置 → 高级启动选项 → 关闭文件校验],然后再尝试补全文件!", HintType.Blue) Hint("请先关闭 [版本设置 → 设置 → 高级启动选项 → 关闭文件校验],然后再尝试补全文件!", HintType.Blue)
Return Return
End If End If
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar For Each OngoingLoader In LoaderTaskbar
If OngoingLoader.Name <> PageVersionLeft.Version.Name & " 文件补全" Then Continue For If OngoingLoader.Name <> PageInstanceLeft.Instance.Name & " 文件补全" Then Continue For
Hint("正在处理中,请稍候!", HintType.Red) Hint("正在处理中,请稍候!", HintType.Red)
Return Return
Next Next
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload)) Dim Loader As New LoaderCombo(Of String)(PageInstanceLeft.Instance.Name & " 文件补全", DlClientFix(PageInstanceLeft.Instance, True, AssetsIndexExistsBehaviour.AlwaysDownload))
Loader.OnStateChanged = Loader.OnStateChanged =
Sub() Sub()
Select Case Loader.State Select Case Loader.State
@@ -306,12 +305,12 @@
Hint(Loader.Name & "已取消!", HintType.Blue) Hint(Loader.Name & "已取消!", HintType.Blue)
End Select End Select
End Sub End Sub
Loader.Start(PageVersionLeft.Version.Name) Loader.Start(PageInstanceLeft.Instance.Name)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception Catch ex As Exception
Log(ex, "尝试补全文件失败(" & PageVersionLeft.Version.Name & ")", LogLevel.Msgbox) Log(ex, "尝试补全文件失败(" & PageInstanceLeft.Instance.Name & ")", LogLevel.Msgbox)
End Try End Try
End Sub End Sub
@@ -320,29 +319,28 @@
Private Sub BtnManageDelete_Click(sender As Object, e As EventArgs) Handles BtnManageDelete.Click Private Sub BtnManageDelete_Click(sender As Object, e As EventArgs) Handles BtnManageDelete.Click
Try Try
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder Dim IsHintIndie As Boolean = PageInstanceLeft.Instance.State <> McInstanceState.Error AndAlso PageInstanceLeft.Instance.PathIndie <> McFolderSelected
Select Case MyMsgBox($"你确定要{If(IsShiftPressed, "永久", "")}删除版本 {PageVersionLeft.Version.Name} 吗?" & Select Case MyMsgBox($"你确定要{If(IsShiftPressed, "永久", "")}删除版本 {PageInstanceLeft.Instance.Name} 吗?" &
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""), If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""),
"版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed) "版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed)
Case 1 Case 1
IniClearCache(PageVersionLeft.Version.PathIndie & "options.txt") IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt")
IniClearCache(PageVersionLeft.Version.Path & "PCL\Setup.ini") IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini")
If IsShiftPressed Then If IsShiftPressed Then
DeleteDirectory(PageVersionLeft.Version.Path) DeleteDirectory(PageInstanceLeft.Instance.PathVersion)
Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除!", HintType.Green)
Else Else
FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin) FileIO.FileSystem.DeleteDirectory(PageInstanceLeft.Instance.PathVersion, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站!", HintType.Green)
End If End If
Hint("已删除版本 " & PageInstanceLeft.Instance.Name & "!", HintType.Green)
Case 2 Case 2
Return Return
End Select End Select
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
FrmMain.PageBack() FrmMain.PageBack()
Catch ex As OperationCanceledException Catch ex As OperationCanceledException
Log(ex, "删除版本 " & PageVersionLeft.Version.Name & " 被主动取消") Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 被主动取消")
Catch ex As Exception Catch ex As Exception
Log(ex, "删除版本 " & PageVersionLeft.Version.Name & " 失败", LogLevel.Msgbox) Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 失败", LogLevel.Msgbox)
End Try End Try
End Sub End Sub
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:System="clr-namespace:System;assembly=mscorlib" xmlns:System="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageVersionSetup" mc:Ignorable="d" x:Class="PageInstanceSetup"
PanScroll="PanBack"> PanScroll="PanBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,25,25,25"> <StackPanel x:Name="PanMain" Margin="25,25,25,25">
@@ -1,4 +1,4 @@
Public Class PageVersionSetup Public Class PageInstanceSetup
Private Shadows IsLoaded As Boolean = False Private Shadows IsLoaded As Boolean = False
@@ -27,41 +27,41 @@
Try Try
'启动参数 '启动参数
TextArgumentTitle.Text = Setup.Get("VersionArgumentTitle", Version:=PageVersionLeft.Version) TextArgumentTitle.Text = Setup.Get("VersionArgumentTitle", Instance:=PageInstanceLeft.Instance)
TextArgumentInfo.Text = Setup.Get("VersionArgumentInfo", Version:=PageVersionLeft.Version) TextArgumentInfo.Text = Setup.Get("VersionArgumentInfo", Instance:=PageInstanceLeft.Instance)
Dim _unused = PageVersionLeft.Version.PathIndie '触发自动判定 Dim _unused = PageInstanceLeft.Instance.PathIndie '触发自动判定
ComboArgumentIndieV2.SelectedIndex = If(Setup.Get("VersionArgumentIndieV2", Version:=PageVersionLeft.Version), 0, 1) ComboArgumentIndieV2.SelectedIndex = If(Setup.Get("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance), 0, 1)
RefreshJavaComboBox() RefreshJavaComboBox()
'游戏内存 '游戏内存
CType(FindName("RadioRamType" & Setup.Load("VersionRamType", Version:=PageVersionLeft.Version)), MyRadioBox).Checked = True CType(FindName("RadioRamType" & Setup.Load("VersionRamType", Instance:=PageInstanceLeft.Instance)), MyRadioBox).Checked = True
SliderRamCustom.Value = Setup.Get("VersionRamCustom", Version:=PageVersionLeft.Version) SliderRamCustom.Value = Setup.Get("VersionRamCustom", Instance:=PageInstanceLeft.Instance)
ComboRamOptimize.SelectedIndex = Setup.Get("VersionRamOptimize", Version:=PageVersionLeft.Version) ComboRamOptimize.SelectedIndex = Setup.Get("VersionRamOptimize", Instance:=PageInstanceLeft.Instance)
'服务器 '服务器
TextServerEnter.Text = Setup.Get("VersionServerEnter", Version:=PageVersionLeft.Version) TextServerEnter.Text = Setup.Get("VersionServerEnter", Instance:=PageInstanceLeft.Instance)
ComboServerLogin.SelectedIndex = Setup.Get("VersionServerLogin", Version:=PageVersionLeft.Version) ComboServerLogin.SelectedIndex = Setup.Get("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
ComboServerLoginLast = ComboServerLogin.SelectedIndex ComboServerLoginLast = ComboServerLogin.SelectedIndex
ServerLogin(ComboServerLogin.SelectedIndex) ServerLogin(ComboServerLogin.SelectedIndex)
TextServerNide.Text = Setup.Get("VersionServerNide", Version:=PageVersionLeft.Version) TextServerNide.Text = Setup.Get("VersionServerNide", Instance:=PageInstanceLeft.Instance)
TextServerAuthServer.Text = Setup.Get("VersionServerAuthServer", Version:=PageVersionLeft.Version) TextServerAuthServer.Text = Setup.Get("VersionServerAuthServer", Instance:=PageInstanceLeft.Instance)
TextServerAuthName.Text = Setup.Get("VersionServerAuthName", Version:=PageVersionLeft.Version) TextServerAuthName.Text = Setup.Get("VersionServerAuthName", Instance:=PageInstanceLeft.Instance)
TextServerAuthRegister.Text = Setup.Get("VersionServerAuthRegister", Version:=PageVersionLeft.Version) TextServerAuthRegister.Text = Setup.Get("VersionServerAuthRegister", Instance:=PageInstanceLeft.Instance)
'高级设置 '高级设置
TextAdvanceJvm.Text = Setup.Get("VersionAdvanceJvm", Version:=PageVersionLeft.Version) TextAdvanceJvm.Text = Setup.Get("VersionAdvanceJvm", Instance:=PageInstanceLeft.Instance)
TextAdvanceGame.Text = Setup.Get("VersionAdvanceGame", Version:=PageVersionLeft.Version) TextAdvanceGame.Text = Setup.Get("VersionAdvanceGame", Instance:=PageInstanceLeft.Instance)
TextAdvanceRun.Text = Setup.Get("VersionAdvanceRun", Version:=PageVersionLeft.Version) TextAdvanceRun.Text = Setup.Get("VersionAdvanceRun", Instance:=PageInstanceLeft.Instance)
CheckAdvanceRunWait.Checked = Setup.Get("VersionAdvanceRunWait", Version:=PageVersionLeft.Version) CheckAdvanceRunWait.Checked = Setup.Get("VersionAdvanceRunWait", Instance:=PageInstanceLeft.Instance)
If Setup.Get("VersionAdvanceAssets", Version:=PageVersionLeft.Version) = 2 Then If Setup.Get("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) = 2 Then
Log("[Setup] 已迁移老版本的关闭文件校验设置") Log("[Setup] 已迁移老版本的关闭文件校验设置")
Setup.Reset("VersionAdvanceAssets", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance)
Setup.Set("VersionAdvanceAssetsV2", True, Version:=PageVersionLeft.Version) Setup.Set("VersionAdvanceAssetsV2", True, Instance:=PageInstanceLeft.Instance)
End If End If
CheckAdvanceAssetsV2.Checked = Setup.Get("VersionAdvanceAssetsV2", Version:=PageVersionLeft.Version) CheckAdvanceAssetsV2.Checked = Setup.Get("VersionAdvanceAssetsV2", Instance:=PageInstanceLeft.Instance)
CheckAdvanceJava.Checked = Setup.Get("VersionAdvanceJava", Version:=PageVersionLeft.Version) CheckAdvanceJava.Checked = Setup.Get("VersionAdvanceJava", Instance:=PageInstanceLeft.Instance)
CheckAdvanceDisableJLW.Checked = Setup.Get("VersionAdvanceDisableJLW", Version:=PageVersionLeft.Version) CheckAdvanceDisableJLW.Checked = Setup.Get("VersionAdvanceDisableJLW", Instance:=PageInstanceLeft.Instance)
CheckAdvanceDisableModUpdate.Checked = Setup.Get("VersionAdvanceDisableModUpdate", Version:=PageVersionLeft.Version) CheckAdvanceDisableModUpdate.Checked = Setup.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance)
Catch ex As Exception Catch ex As Exception
Log(ex, "重载版本独立设置时出错", LogLevel.Feedback) Log(ex, "重载版本独立设置时出错", LogLevel.Feedback)
@@ -72,29 +72,29 @@
Public Sub Reset() Public Sub Reset()
Try Try
Setup.Reset("VersionServerEnter", Version:=PageVersionLeft.Version) Setup.Reset("VersionServerEnter", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerLogin", Version:=PageVersionLeft.Version) Setup.Reset("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerNide", Version:=PageVersionLeft.Version) Setup.Reset("VersionServerNide", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerAuthServer", Version:=PageVersionLeft.Version) Setup.Reset("VersionServerAuthServer", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerAuthRegister", Version:=PageVersionLeft.Version) Setup.Reset("VersionServerAuthRegister", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerAuthName", Version:=PageVersionLeft.Version) Setup.Reset("VersionServerAuthName", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentTitle", Version:=PageVersionLeft.Version) Setup.Reset("VersionArgumentTitle", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentInfo", Version:=PageVersionLeft.Version) Setup.Reset("VersionArgumentInfo", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentIndieV2", Version:=PageVersionLeft.Version) Setup.Reset("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionRamType", Version:=PageVersionLeft.Version) Setup.Reset("VersionRamType", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionRamCustom", Version:=PageVersionLeft.Version) Setup.Reset("VersionRamCustom", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionRamOptimize", Version:=PageVersionLeft.Version) Setup.Reset("VersionRamOptimize", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceJvm", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceJvm", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceGame", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceGame", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceAssets", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceAssetsV2", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceAssetsV2", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceJava", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceJava", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceRun", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceRun", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceRunWait", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceRunWait", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceDisableJLW", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceDisableJLW", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceDisableModUpdate", Version:=PageVersionLeft.Version) Setup.Reset("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentJavaSelect", Version:=PageVersionLeft.Version) Setup.Reset("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
JavaSearchLoader.Start(IsForceRestart:=True) JavaSearchLoader.Start(IsForceRestart:=True)
Log("[Setup] 已初始化版本独立设置") Log("[Setup] 已初始化版本独立设置")
@@ -108,27 +108,27 @@
'将控件改变路由到设置改变 '将控件改变路由到设置改变
Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioRamType0.Check, RadioRamType1.Check, RadioRamType2.Check Private Shared Sub RadioBoxChange(sender As MyRadioBox, e As Object) Handles RadioRamType0.Check, RadioRamType1.Check, RadioRamType2.Check
If AniControlEnabled = 0 Then Setup.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1)), Version:=PageVersionLeft.Version) If AniControlEnabled = 0 Then Setup.Set(sender.Tag.ToString.Split("/")(0), Val(sender.Tag.ToString.Split("/")(1)), Instance:=PageInstanceLeft.Instance)
End Sub End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextServerEnter.ValidatedTextChanged, TextArgumentInfo.ValidatedTextChanged, TextAdvanceGame.ValidatedTextChanged, TextAdvanceJvm.ValidatedTextChanged, TextServerNide.ValidatedTextChanged, TextServerAuthName.ValidatedTextChanged, TextServerAuthRegister.ValidatedTextChanged, TextServerAuthServer.ValidatedTextChanged, TextArgumentTitle.ValidatedTextChanged, TextAdvanceRun.ValidatedTextChanged Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextServerEnter.ValidatedTextChanged, TextArgumentInfo.ValidatedTextChanged, TextAdvanceGame.ValidatedTextChanged, TextAdvanceJvm.ValidatedTextChanged, TextServerNide.ValidatedTextChanged, TextServerAuthName.ValidatedTextChanged, TextServerAuthRegister.ValidatedTextChanged, TextServerAuthServer.ValidatedTextChanged, TextArgumentTitle.ValidatedTextChanged, TextAdvanceRun.ValidatedTextChanged
If AniControlEnabled = 0 Then If AniControlEnabled = 0 Then
'#3194,不能删减 / '#3194,不能删减 /
'Dim HandledText As String = sender.Text 'Dim HandledText As String = sender.Text
'If sender.Tag = "VersionServerAuthServer" OrElse sender.Tag = "VersionServerAuthRegister" Then HandledText = HandledText.TrimEnd("/") 'If sender.Tag = "VersionServerAuthServer" OrElse sender.Tag = "VersionServerAuthRegister" Then HandledText = HandledText.TrimEnd("/")
Setup.Set(sender.Tag, sender.Text, Version:=PageVersionLeft.Version) Setup.Set(sender.Tag, sender.Text, Instance:=PageInstanceLeft.Instance)
End If End If
End Sub End Sub
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value, Version:=PageVersionLeft.Version) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value, Instance:=PageInstanceLeft.Instance)
End Sub End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboRamOptimize.SelectionChanged Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboRamOptimize.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex, Version:=PageVersionLeft.Version) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex, Instance:=PageInstanceLeft.Instance)
End Sub End Sub
Private Shared Sub CheckBoxLikeComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndieV2.SelectionChanged Private Shared Sub CheckBoxLikeComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndieV2.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex = 0, Version:=PageVersionLeft.Version) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex = 0, Instance:=PageInstanceLeft.Instance)
End Sub End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceRunWait.Change, CheckAdvanceAssetsV2.Change, CheckAdvanceJava.Change, CheckAdvanceDisableJLW.Change, CheckAdvanceDisableModUpdate.Change Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceRunWait.Change, CheckAdvanceAssetsV2.Change, CheckAdvanceJava.Change, CheckAdvanceDisableJLW.Change, CheckAdvanceDisableModUpdate.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked, Version:=PageVersionLeft.Version) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked, Instance:=PageInstanceLeft.Instance)
End Sub End Sub
#Region "游戏内存" #Region "游戏内存"
@@ -142,9 +142,9 @@
''' 刷新 UI 上的 RAM 显示。 ''' 刷新 UI 上的 RAM 显示。
''' </summary> ''' </summary>
Public Sub RefreshRam(ShowAnim As Boolean) Public Sub RefreshRam(ShowAnim As Boolean)
If LabRamGame Is Nothing OrElse LabRamUsed Is Nothing OrElse FrmMain.PageCurrent <> FormMain.PageType.VersionSetup OrElse FrmVersionLeft.PageID <> FormMain.PageSubType.VersionSetup Then Return If LabRamGame Is Nothing OrElse LabRamUsed Is Nothing OrElse FrmMain.PageCurrent <> FormMain.PageType.InstanceSetup OrElse FrmInstanceLeft.PageID <> FormMain.PageSubType.InstanceSetup Then Return
'获取内存情况 '获取内存情况
Dim RamGame As Double = Math.Round(GetRam(PageVersionLeft.Version), 5) Dim RamGame As Double = Math.Round(GetRam(PageInstanceLeft.Instance), 5)
Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024, 1) Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024, 1)
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024, 1) Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024, 1)
Dim RamGameActual As Double = Math.Round(Math.Min(RamGame, RamAvailable), 5) Dim RamGameActual As Double = Math.Round(Math.Min(RamGame, RamAvailable), 5)
@@ -165,7 +165,7 @@
If(RamGame <> RamGameActual, " (可用 " & If(RamGameActual = Math.Floor(RamGameActual), RamGameActual & ".0", RamGameActual) & " GB)", "") If(RamGame <> RamGameActual, " (可用 " & If(RamGameActual = Math.Floor(RamGameActual), RamGameActual & ".0", RamGameActual) & " GB)", "")
LabRamUsed.Text = If(RamUsed = Math.Floor(RamUsed), RamUsed & ".0", RamUsed) & " GB" LabRamUsed.Text = If(RamUsed = Math.Floor(RamUsed), RamUsed & ".0", RamUsed) & " GB"
LabRamTotal.Text = " / " & If(RamTotal = Math.Floor(RamTotal), RamTotal & ".0", RamTotal) & " GB" LabRamTotal.Text = " / " & If(RamTotal = Math.Floor(RamTotal), RamTotal & ".0", RamTotal) & " GB"
LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaIs64Bit(PageVersionLeft.Version) AndAlso Not Is32BitSystem AndAlso JavaList.Any, Visibility.Visible, Visibility.Collapsed) LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not JavaIs64Bit(PageInstanceLeft.Instance) AndAlso Not Is32BitSystem AndAlso JavaList.Any, Visibility.Visible, Visibility.Collapsed)
If ShowAnim Then If ShowAnim Then
'宽度动画 '宽度动画
AniStart({ AniStart({
@@ -269,10 +269,10 @@
''' <summary> ''' <summary>
''' 获取当前设置的 RAM 值。单位为 GB。 ''' 获取当前设置的 RAM 值。单位为 GB。
''' </summary> ''' </summary>
Public Shared Function GetRam(Version As McVersion, Optional Is32BitJava As Boolean? = Nothing) As Double Public Shared Function GetRam(Instance As McInstance, Optional Is32BitJava As Boolean? = Nothing) As Double
'跟随全局设置 '跟随全局设置
If Setup.Get("VersionRamType", Version:=Version) = 2 Then If Setup.Get("VersionRamType", Instance:=Instance) = 2 Then
Return PageSetupLaunch.GetRam(Version, True, Is32BitJava) Return PageSetupLaunch.GetRam(Instance, True, Is32BitJava)
End If End If
'------------------------------------------ '------------------------------------------
@@ -281,7 +281,7 @@
'使用当前版本的设置 '使用当前版本的设置
Dim RamGive As Double Dim RamGive As Double
If Setup.Get("VersionRamType", Version:=Version) = 0 Then If Setup.Get("VersionRamType", Instance:=Instance) = 0 Then
'自动配置 '自动配置
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
'确定需求的内存值 '确定需求的内存值
@@ -289,16 +289,16 @@
Dim RamTarget1 As Double '估计能勉强带动了的内存 Dim RamTarget1 As Double '估计能勉强带动了的内存
Dim RamTarget2 As Double '估计没啥问题了的内存 Dim RamTarget2 As Double '估计没啥问题了的内存
Dim RamTarget3 As Double '安装过多附加组件需要的内存 Dim RamTarget3 As Double '安装过多附加组件需要的内存
If Version IsNot Nothing AndAlso Not Version.IsLoaded Then Version.Load() If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load()
If Version IsNot Nothing AndAlso Version.Modable Then If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 Mod 的版本 '可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\") Dim ModDir As New DirectoryInfo(Instance.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0) Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0)
RamMininum = 0.5 + ModCount / 150 RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90 RamTarget1 = 1.5 + ModCount / 90
RamTarget2 = 2.7 + ModCount / 50 RamTarget2 = 2.7 + ModCount / 50
RamTarget3 = 4.5 + ModCount / 25 RamTarget3 = 4.5 + ModCount / 25
ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then ElseIf Instance IsNot Nothing AndAlso Instance.Version.HasOptiFine Then
'OptiFine 版本 'OptiFine 版本
RamMininum = 0.5 RamMininum = 0.5
RamTarget1 = 1.5 RamTarget1 = 1.5
@@ -337,7 +337,7 @@ PreFin:
RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1) RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1)
Else Else
'手动配置 '手动配置
Dim Value As Integer = Setup.Get("VersionRamCustom", Version:=Version) Dim Value As Integer = Setup.Get("VersionRamCustom", Instance:=Instance)
If Value <= 12 Then If Value <= 12 Then
RamGive = Value * 0.1 + 0.3 RamGive = Value * 0.1 + 0.3
ElseIf Value <= 25 Then ElseIf Value <= 25 Then
@@ -349,7 +349,7 @@ PreFin:
End If End If
End If End If
'若使用 32 位 Java,则限制为 1G '若使用 32 位 Java,则限制为 1G
If If(Is32BitJava, Not JavaIs64Bit(PageVersionLeft.Version)) Then RamGive = Math.Min(1, RamGive) If If(Is32BitJava, Not JavaIs64Bit(PageInstanceLeft.Instance)) Then RamGive = Math.Min(1, RamGive)
Return RamGive Return RamGive
End Function End Function
@@ -423,9 +423,9 @@ PreFin:
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"}) ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"})
'更新列表 '更新列表
Dim SelectedItem As MyComboBoxItem = Nothing Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Setup.Get("VersionArgumentJavaSelect", Version:=PageVersionLeft.Version) Dim SelectedBySetup As String = Setup.Get("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
Try Try
For Each Java In JavaList.Clone().OrderByDescending(Function(v) v.VersionCode) For Each Java In JavaList.Clone().OrderByDescending(Function(v) v.MajorVersion)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java} Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
ToolTipService.SetHorizontalOffset(ListItem, 400) ToolTipService.SetHorizontalOffset(ListItem, 400)
ComboArgumentJava.Items.Add(ListItem) ComboArgumentJava.Items.Add(ListItem)
@@ -434,7 +434,7 @@ PreFin:
If JavaEntry.FromJson(GetJson(SelectedBySetup)).PathFolder = Java.PathFolder Then SelectedItem = ListItem If JavaEntry.FromJson(GetJson(SelectedBySetup)).PathFolder = Java.PathFolder Then SelectedItem = ListItem
Next Next
Catch ex As Exception Catch ex As Exception
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=PageVersionLeft.Version) Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log(ex, "更新版本设置 Java 下拉框失败", LogLevel.Feedback) Log(ex, "更新版本设置 Java 下拉框失败", LogLevel.Feedback)
End Try End Try
'更新选择项 '更新选择项
@@ -469,15 +469,15 @@ PreFin:
Dim SelectedJava = ComboArgumentJava.SelectedItem.Tag Dim SelectedJava = ComboArgumentJava.SelectedItem.Tag
If "使用全局设置".Equals(SelectedJava) Then If "使用全局设置".Equals(SelectedJava) Then
'选择 “自动” '选择 “自动”
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=PageVersionLeft.Version) Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置:跟随全局设置") Log("[Java] 修改版本 Java 选择设置:跟随全局设置")
ElseIf "自动选择".Equals(SelectedJava) Then ElseIf "自动选择".Equals(SelectedJava) Then
'选择 “自动” '选择 “自动”
Setup.Set("VersionArgumentJavaSelect", "", Version:=PageVersionLeft.Version) Setup.Set("VersionArgumentJavaSelect", "", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置:自动选择") Log("[Java] 修改版本 Java 选择设置:自动选择")
Else Else
'选择指定项 '选择指定项
Setup.Set("VersionArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None), Version:=PageVersionLeft.Version) Setup.Set("VersionArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None), Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置:" & SelectedJava.ToString) Log("[Java] 修改版本 Java 选择设置:" & SelectedJava.ToString)
End If End If
RefreshRam(True) RefreshRam(True)
@@ -178,7 +178,7 @@
Try Try
'更新缓存 '更新缓存
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsV2Uuid"), SkinAddress) WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsV2Uuid"), SkinAddress)
Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("CacheMsV2Uuid"), SkinAddress)) Log($"[Skin] 已写入皮肤地址缓存 {Setup.Get("CacheMsV2Uuid")} -> {SkinAddress}")
'刷新控件 '刷新控件
For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy} For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}
SkinLoader.WaitForExit(IsForceRestart:=True) SkinLoader.WaitForExit(IsForceRestart:=True)
@@ -246,7 +246,7 @@ Retry:
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"}, {"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"},
{"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}, {"Minecraft Experience", "村民救援披风"}, {"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}, {"Minecraft Experience", "村民救援披风"},
{"Mojang Office", "Mojang 办公室披风"}, {"Home", "家园披风"}, {"Menace", "入侵披风"}, {"Yearn", "渴望披风"}, {"Mojang Office", "Mojang 办公室披风"}, {"Home", "家园披风"}, {"Menace", "入侵披风"}, {"Yearn", "渴望披风"},
{"Common", "普通披风"}, {"Pan", "薄煎饼披风"}, {"Founder's", "创始人披风"}, {"Copper", "铜披风"} {"Common", "普通披风"}, {"Pan", "薄煎饼披风"}, {"Founder's", "创始人披风"}, {"Copper", "铜披风"}, {"Zombie Horse", "僵尸马披风"}
} }
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}} Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
Dim Id As Integer = 0 Dim Id As Integer = 0
@@ -254,8 +254,8 @@ Retry:
Id += 1 Id += 1
Dim CapeName As String = Cape("alias").ToString Dim CapeName As String = Cape("alias").ToString
If CapeNames.ContainsKey(CapeName) Then CapeName = CapeNames(CapeName) If CapeNames.ContainsKey(CapeName) Then CapeName = CapeNames(CapeName)
If Cape("state") = "ACTIVE" Then CurId = Id If Cape("state")?.ToString = "ACTIVE" Then CurId = Id
SelectionControl.Add(New MyRadioBox With {.Text = CapeName, .Checked = (Cape("state") = "ACTIVE")}) SelectionControl.Add(New MyRadioBox With {.Text = CapeName, .Checked = Cape("state")?.ToString = "ACTIVE"})
Next Next
SelId = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消") SelId = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception Catch ex As Exception
@@ -14,7 +14,7 @@
AniControlEnabled += 1 AniControlEnabled += 1
'开始按钮 '开始按钮
AddHandler McVersionListLoader.LoadingStateChanged, AddressOf RefreshButtonsUI AddHandler McInstanceListLoader.LoadingStateChanged, AddressOf RefreshButtonsUI
AddHandler McFolderListLoader.LoadingStateChanged, AddressOf RefreshButtonsUI AddHandler McFolderListLoader.LoadingStateChanged, AddressOf RefreshButtonsUI
RefreshButtonsUI() RefreshButtonsUI()
@@ -37,18 +37,18 @@
McFolderListLoader.WaitForExit() McFolderListLoader.WaitForExit()
End If End If
'确认 Minecraft 文件夹存在 '确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path) McFolderSelected = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then If McFolderSelected = "" OrElse Not Directory.Exists(McFolderSelected) Then
'无效的文件夹 '无效的文件夹
If PathMcFolder = "" Then If McFolderSelected = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹") Log("[Launch] 没有已储存的 Minecraft 文件夹")
Else Else
Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & PathMcFolder, LogLevel.Debug) Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & McFolderSelected, LogLevel.Debug)
End If End If
McFolderListLoader.WaitForExit(IsForceRestart:=True) McFolderListLoader.WaitForExit(IsForceRestart:=True)
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$")) Setup.Set("LaunchFolderSelect", McFolderList(0).Location.Replace(Path, "$"))
End If End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder) Log("[Launch] Minecraft 文件夹:" & McFolderSelected)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000)) If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'自动整合包安装 '自动整合包安装
If PackInstallPath IsNot Nothing Then If PackInstallPath IsNot Nothing Then
@@ -68,24 +68,24 @@
End If End If
'确认 Minecraft 版本存在 '确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect") Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion = If(Selection = "", Nothing, New McVersion(Selection)) Dim Instance As McInstance = If(Selection = "", Nothing, New McInstance(Selection))
If Version Is Nothing OrElse Not Version.Path.StartsWithF(PathMcFolder) OrElse Not Version.Check() Then If Instance Is Nothing OrElse Not Instance.PathVersion.StartsWithF(McFolderSelected) OrElse Not Instance.Check() Then
'无效的版本 '无效的版本
Log("[Launch] 当前选择的 Minecraft 版本无效:" & If(Version Is Nothing, "null", Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug)) Log("[Launch] 当前选择的 Minecraft 版本无效:" & If(Instance Is Nothing, "null", Instance.PathVersion), If(IsNothing(Instance), LogLevel.Normal, LogLevel.Debug))
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) If Not McInstanceListLoader.State = LoadState.Finished Then LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then If Not McInstanceList.Any() OrElse McInstanceList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing Instance = Nothing
Setup.Set("LaunchVersionSelect", "") Setup.Set("LaunchVersionSelect", "")
Log("[Launch] 无可用 Minecraft 版本") Log("[Launch] 无可用 Minecraft 版本")
Else Else
Version = McVersionList.First.Value(0) Instance = McInstanceList.First.Value(0)
Setup.Set("LaunchVersionSelect", Version.Name) Setup.Set("LaunchVersionSelect", Instance.Name)
Log("[Launch] 自动选择 Minecraft 版本:" & Version.Path) Log("[Launch] 自动选择 Minecraft 版本:" & Instance.PathVersion)
End If End If
End If End If
RunInUi( RunInUi(
Sub() Sub()
McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变 McInstanceSelected = Instance '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
IsLoadFinished = True IsLoadFinished = True
RefreshButtonsUI() RefreshButtonsUI()
RefreshPage(False, False) '有可能选择的版本变化了,需要重新刷新 RefreshPage(False, False) '有可能选择的版本变化了,需要重新刷新
@@ -119,7 +119,7 @@
LabLaunchingMethod.Text = "Authlib-Injector" LabLaunchingMethod.Text = "Authlib-Injector"
End Select End Select
'初始化页面 '初始化页面
LabLaunchingName.Text = McVersionCurrent.Name LabLaunchingName.Text = McInstanceSelected.Name
LabLaunchingStage.Text = "初始化" LabLaunchingStage.Text = "初始化"
LabLaunchingTitle.Text = If(CurrentLaunchOptions?.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本") LabLaunchingTitle.Text = If(CurrentLaunchOptions?.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")
LabLaunchingProgress.Text = "0.00 %" LabLaunchingProgress.Text = "0.00 %"
@@ -278,9 +278,9 @@
'获取页面的可用种类并回写缓存 '获取页面的可用种类并回写缓存
Dim Type As PageType Dim Type As PageType
Dim LoginPageType As Integer Dim LoginPageType As Integer
If McVersionCurrent IsNot Nothing Then If McInstanceSelected IsNot Nothing Then
LoginPageType = Setup.Get("VersionServerLogin", Version:=McVersionCurrent) LoginPageType = Setup.Get("VersionServerLogin", Instance:=McInstanceSelected)
'缓存当前版本的页面种类,下一次打开 McVersionCurrent 为空时才能加载出正确的页面 '缓存当前版本的页面种类,下一次打开 McInstanceSelected 为空时才能加载出正确的页面
Setup.Set("LoginPageType", LoginPageType) Setup.Set("LoginPageType", LoginPageType)
Else Else
LoginPageType = Setup.Get("LoginPageType") LoginPageType = Setup.Get("LoginPageType")
@@ -344,7 +344,7 @@ UnknownType:
PanType.Visibility = Visibility.Collapsed PanType.Visibility = Visibility.Collapsed
PanTypeOne.Visibility = Visibility.Visible PanTypeOne.Visibility = Visibility.Visible
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard) PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard)
LabTypeOne.Text = If(McVersionCurrent Is Nothing, Setup.Get("CacheAuthServerName"), Setup.Get("VersionServerAuthName", Version:=McVersionCurrent)) LabTypeOne.Text = If(McInstanceSelected Is Nothing, Setup.Get("CacheAuthServerName"), Setup.Get("VersionServerAuthName", Instance:=McInstanceSelected))
If LabTypeOne.Text = "" Then LabTypeOne.Text = "第三方登录" If LabTypeOne.Text = "" Then LabTypeOne.Text = "第三方登录"
Case Else Case Else
Log("[Control] 未知的登录页面:" & LoginPageType, LogLevel.Hint) Log("[Control] 未知的登录页面:" & LoginPageType, LogLevel.Hint)
@@ -591,7 +591,7 @@ Finish:
'版本选择按钮 '版本选择按钮
Private Sub BtnVersion_Click(sender As Object, e As EventArgs) Handles BtnVersion.Click Private Sub BtnVersion_Click(sender As Object, e As EventArgs) Handles BtnVersion.Click
If McLaunchLoader.State = LoadState.Loading Then Return If McLaunchLoader.State = LoadState.Loading Then Return
FrmMain.PageChange(FormMain.PageType.VersionSelect) FrmMain.PageChange(FormMain.PageType.InstanceSelect)
End Sub End Sub
'启动按钮 '启动按钮
Public Sub LaunchButtonClick() Handles BtnLaunch.Click Public Sub LaunchButtonClick() Handles BtnLaunch.Click
@@ -615,15 +615,15 @@ Finish:
End If End If
End Sub End Sub
Private BtnLaunchState As Integer = 0 Private BtnLaunchState As Integer = 0
Private BtnLaunchVersion As McVersion = Nothing Private BtnLaunchInstance As McInstance = Nothing
Public Sub RefreshButtonsUI() Handles BtnLaunch.Loaded Public Sub RefreshButtonsUI() Handles BtnLaunch.Loaded
If Not BtnLaunch.IsLoaded Then Return If Not BtnLaunch.IsLoaded Then Return
'获取当前状态 '获取当前状态
Dim CurrentState As Integer Dim CurrentState As Integer
If (Not IsLoadFinished) OrElse McVersionListLoader.State = LoadState.Loading OrElse McFolderListLoader.State = LoadState.Loading Then If (Not IsLoadFinished) OrElse McInstanceListLoader.State = LoadState.Loading OrElse McFolderListLoader.State = LoadState.Loading Then
CurrentState = 0 CurrentState = 0
Else Else
If McVersionCurrent Is Nothing Then If McInstanceSelected Is Nothing Then
If Setup.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow Then If Setup.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow Then
CurrentState = 1 CurrentState = 1
Else Else
@@ -635,8 +635,8 @@ Finish:
End If End If
'更新状态 '更新状态
If CurrentState = BtnLaunchState AndAlso If CurrentState = BtnLaunchState AndAlso
If(McVersionCurrent Is Nothing, "", McVersionCurrent.Path) = If(BtnLaunchVersion Is Nothing, "", BtnLaunchVersion.Path) Then GoTo ExitRefresh If(McInstanceSelected Is Nothing, "", McInstanceSelected.PathVersion) = If(BtnLaunchInstance Is Nothing, "", BtnLaunchInstance.PathVersion) Then GoTo ExitRefresh
BtnLaunchVersion = McVersionCurrent BtnLaunchInstance = McInstanceSelected
BtnLaunchState = CurrentState BtnLaunchState = CurrentState
Select Case CurrentState Select Case CurrentState
Case 0 Case 0
@@ -661,11 +661,11 @@ Finish:
FrmLaunchLeft.BtnVersion.IsEnabled = True FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 3 Case 3
Log("[Minecraft] 启动按钮:Minecraft 版本:" & McVersionCurrent.Path) Log("[Minecraft] 启动按钮:Minecraft 版本:" & McInstanceSelected.PathVersion)
FrmLaunchLeft.BtnLaunch.Text = "启动游戏" FrmLaunchLeft.BtnLaunch.Text = "启动游戏"
FrmLaunchLeft.BtnVersion.IsEnabled = True FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnLaunch.IsEnabled = True FrmLaunchLeft.BtnLaunch.IsEnabled = True
FrmLaunchLeft.LabVersion.Text = McVersionCurrent.Name FrmLaunchLeft.LabVersion.Text = McInstanceSelected.Name
'FrmLaunchLeft.BtnMore.Visibility = Visibility.Visible '由功能隐藏设置修改 'FrmLaunchLeft.BtnMore.Visibility = Visibility.Visible '由功能隐藏设置修改
End Select End Select
ExitRefresh: ExitRefresh:
@@ -694,12 +694,12 @@ ExitRefresh:
'版本设置按钮 '版本设置按钮
Private Sub BtnMore_Click(sender As Object, e As EventArgs) Handles BtnMore.Click Private Sub BtnMore_Click(sender As Object, e As EventArgs) Handles BtnMore.Click
If McLaunchLoader.State = LoadState.Loading Then Return If McLaunchLoader.State = LoadState.Loading Then Return
McVersionCurrent.Load() McInstanceSelected.Load()
PageVersionLeft.Version = McVersionCurrent PageInstanceLeft.Instance = McInstanceSelected
FrmMain.PageChange(FormMain.PageType.VersionSetup, 0) FrmMain.PageChange(FormMain.PageType.InstanceSetup, 0)
End Sub End Sub
''' <summary> ''' <summary>
''' 每 0.2s 执行一次,刷新启动的数据 UI 显示。 ''' 每 0.1s 执行一次,刷新启动的数据 UI 显示。
''' </summary> ''' </summary>
Public Sub LaunchingRefresh() Public Sub LaunchingRefresh()
Try Try
@@ -719,20 +719,27 @@ ExitRefresh:
Log(ex, "获取是否启动完成失败,可能是由于启动状态改变导致集合已修改") Log(ex, "获取是否启动完成失败,可能是由于启动状态改变导致集合已修改")
Return Return
End Try End Try
LabLaunchingTitle.Text = If(IsLaunched OrElse McLaunchLoaderReal.State = LoadState.Finished,
"已启动游戏",
If(CurrentLaunchOptions.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本"))
If AniIsRun("Launch State Page") Then IsLaunched = False '等待页面切换动画完成 If AniIsRun("Launch State Page") Then IsLaunched = False '等待页面切换动画完成
'计算应显示的进度 '更新进度
Dim ActualProgress = McLaunchLoaderReal.Progress Dim ActualProgress = McLaunchLoaderReal.Progress
If ActualProgress >= ShowProgress Then ShowProgress += (ActualProgress - ShowProgress) * 0.2 + 0.005 '向实际进度靠一点 If ActualProgress >= ShowProgress Then ShowProgress += (ActualProgress - ShowProgress) * 0.1 + 0.0025 '向实际进度靠一点
If ActualProgress <= ShowProgress Then ShowProgress = ActualProgress '原来或处理后变得比实际进度高,直接回退 If ActualProgress <= ShowProgress Then ShowProgress = ActualProgress '原来或处理后变得比实际进度高,直接回退
If IsLaunched Then ShowProgress = 1 '如果已经完成了,就不卖关子了 If IsLaunched Then ShowProgress = 1 '如果已经完成了,就不卖关子了
'文本 LabLaunchingProgress.Text = (ShowProgress * 100).ToString("0.00") & " %"
LabLaunchingTitle.Text = If(IsLaunched, "已启动游戏", If(CurrentLaunchOptions.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")) '更新下载速度
LabLaunchingProgress.Text = StrFillNum(ShowProgress * 100, 2) & " %"
Dim HasLaunchDownloader As Boolean = False Dim HasLaunchDownloader As Boolean = False
Try Try
If NetManager.Speed = 0 AndAlso LabLaunchingDownload.Visibility = Visibility.Collapsed Then
'可能只是在检查文件,没有实际下载
HasLaunchDownloader = False
Else
For Each Loader In NetManager.Tasks For Each Loader In NetManager.Tasks
If Loader.RealParent IsNot Nothing AndAlso Loader.RealParent.Name = "Minecraft 启动" AndAlso Loader.State = LoadState.Loading Then HasLaunchDownloader = True If Loader.RealParent IsNot Nothing AndAlso Loader.RealParent.Name = "Minecraft 启动" AndAlso Loader.State = LoadState.Loading Then HasLaunchDownloader = True
Next Next
End If
Catch ex As Exception Catch ex As Exception
Log(ex, "获取 Minecraft 启动下载器失败,可能是因为启动被取消") Log(ex, "获取 Minecraft 启动下载器失败,可能是因为启动被取消")
HasLaunchDownloader = False HasLaunchDownloader = False
@@ -740,17 +747,17 @@ ExitRefresh:
LabLaunchingDownload.Text = GetString(NetManager.Speed) & "/s" LabLaunchingDownload.Text = GetString(NetManager.Speed) & "/s"
'进度改变动画 '进度改变动画
Dim AnimList As New List(Of AniData) From { Dim AnimList As New List(Of AniData) From {
AaGridLengthWidth(ProgressLaunchingFinished, ShowProgress - ProgressLaunchingFinished.Width.Value, 260,, New AniEaseOutFluent), AaGridLengthWidth(ProgressLaunchingFinished, ShowProgress - ProgressLaunchingFinished.Width.Value, 130,, New AniEaseOutFluent),
AaGridLengthWidth(ProgressLaunchingUnfinished, 1 - ShowProgress - ProgressLaunchingUnfinished.Width.Value, 260,, New AniEaseOutFluent) AaGridLengthWidth(ProgressLaunchingUnfinished, 1 - ShowProgress - ProgressLaunchingUnfinished.Width.Value, 130,, New AniEaseOutFluent)
} }
Dim IsDownloadStateChanged As Boolean = HasLaunchDownloader = (LabLaunchingDownload.Visibility = Visibility.Collapsed) If HasLaunchDownloader = (LabLaunchingDownload.Visibility = Visibility.Collapsed) Then 'IsDownloadStateChanged
If IsDownloadStateChanged Then
LabLaunchingDownload.Visibility = Visibility.Visible LabLaunchingDownload.Visibility = Visibility.Visible
LabLaunchingDownloadLeft.Visibility = Visibility.Visible LabLaunchingDownloadLeft.Visibility = Visibility.Visible
AnimList.AddRange({ AnimList.AddRange({
AaOpacity(LabLaunchingDownload, If(HasLaunchDownloader, 1, 0) - LabLaunchingDownload.Opacity, 100), AaOpacity(LabLaunchingDownload, If(HasLaunchDownloader, 1, 0) - LabLaunchingDownload.Opacity, 90),
AaOpacity(LabLaunchingDownloadLeft, If(HasLaunchDownloader, 0.5, 0) - LabLaunchingDownloadLeft.Opacity, 100), AaOpacity(LabLaunchingDownloadLeft, If(HasLaunchDownloader, 0.5, 0) - LabLaunchingDownloadLeft.Opacity, 90),
AaCode(Sub() AaCode(
Sub()
If Not HasLaunchDownloader Then If Not HasLaunchDownloader Then
LabLaunchingDownload.Visibility = Visibility.Collapsed LabLaunchingDownload.Visibility = Visibility.Collapsed
LabLaunchingDownloadLeft.Visibility = Visibility.Collapsed LabLaunchingDownloadLeft.Visibility = Visibility.Collapsed
@@ -758,22 +765,14 @@ ExitRefresh:
End Sub, 110) End Sub, 110)
}) })
End If End If
Dim IsProgressStateChanged As Boolean = (Not IsLaunched) = (LabLaunchingProgress.Visibility = Visibility.Collapsed) If (Not IsLaunched) = (LabLaunchingProgress.Visibility = Visibility.Collapsed) Then 'IsProgressStateChanged
If IsProgressStateChanged Then
LabLaunchingProgress.Visibility = Visibility.Visible LabLaunchingProgress.Visibility = Visibility.Visible
LabLaunchingProgressLeft.Visibility = Visibility.Visible LabLaunchingProgressLeft.Visibility = Visibility.Visible
If IsLaunched Then If IsLaunched Then PanLaunchingHint.Visibility = Visibility.Visible
'IsWidthAnimating = True
PanLaunchingHint.Visibility = Visibility.Visible
'AniStop("Launching Info Width")
'PanLaunchingInfo.Width = 260
'ActualUsedWidth = 260
'IsWidthAnimating = False
End If
AnimList.AddRange({ AnimList.AddRange({
AaOpacity(LabLaunchingProgress, If(Not IsLaunched, 1, 0) - LabLaunchingProgress.Opacity, 100), AaOpacity(LabLaunchingProgress, If(Not IsLaunched, 1, 0) - LabLaunchingProgress.Opacity, 90),
AaOpacity(LabLaunchingProgressLeft, If(Not IsLaunched, 0.5, 0) - LabLaunchingProgressLeft.Opacity, 100), AaOpacity(LabLaunchingProgressLeft, If(Not IsLaunched, 0.5, 0) - LabLaunchingProgressLeft.Opacity, 90),
AaOpacity(PanLaunchingHint, If(IsLaunched, 1, 0) - PanLaunchingHint.Opacity, 100) AaOpacity(PanLaunchingHint, If(IsLaunched, 1, 0) - PanLaunchingHint.Opacity, 90)
}) })
End If End If
AniStart(AnimList, "Launching Progress") AniStart(AnimList, "Launching Progress")
@@ -107,6 +107,12 @@ Public Class PageLaunchRight
Case 13 Case 13
Log("[Page] 主页预设:PCL 更新摘要") Log("[Page] 主页预设:PCL 更新摘要")
Url = "https://raw.gitcode.com/ENC_Euphony/PCL-AI-Summary-HomePage/raw/master/Custom.xaml" Url = "https://raw.gitcode.com/ENC_Euphony/PCL-AI-Summary-HomePage/raw/master/Custom.xaml"
Case 14
Log("[Page] 主页预设:今日新闻热点")
Url = "https://pcl.wyc-w.top/index.xaml"
Case 15
Log("[Page] 主页预设:Minecraft 芝士站")
Url = "https://www.xxag.top/mkss"
End Select End Select
End Select End Select
'联网下载 '联网下载
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McVersionCurrent), Setup.Get("CacheAuthServerServer"), Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)) & "/authserver" Dim Server As String = If(IsNothing(McInstanceSelected), Setup.Get("CacheAuthServerServer"), Setup.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver"
If FrmLoginAuth Is Nothing Then If FrmLoginAuth Is Nothing Then
Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = "", .Password = "", .Description = "Authlib-Injector", .Type = McLoginType.Auth} Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = "", .Password = "", .Description = "Authlib-Injector", .Type = McLoginType.Auth}
Else Else
@@ -71,15 +71,15 @@
End Sub End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then If BtnLink.Content = "注册账号" Then
OpenWebsite(If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister"))) OpenWebsite(If(McInstanceSelected IsNot Nothing, Setup.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Setup.Get("CacheAuthServerRegister")))
Else Else
Dim Website As String = If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")) Dim Website As String = If(McInstanceSelected IsNot Nothing, Setup.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Setup.Get("CacheAuthServerRegister"))
OpenWebsite(Website.Replace("/auth/register", "/auth/forgot")) OpenWebsite(Website.Replace("/auth/register", "/auth/forgot"))
End If End If
End Sub End Sub
'切换注册按钮可见性 '切换注册按钮可见性
Private Sub ReloadRegisterButton() Handles Me.Loaded Private Sub ReloadRegisterButton() Handles Me.Loaded
Dim Address As String = If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")) Dim Address As String = If(McInstanceSelected IsNot Nothing, Setup.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Setup.Get("CacheAuthServerRegister"))
BtnLink.Visibility = If(String.IsNullOrEmpty(New ValidateHttp().Validate(Address)), Visibility.Visible, Visibility.Collapsed) BtnLink.Visibility = If(String.IsNullOrEmpty(New ValidateHttp().Validate(Address)), Visibility.Visible, Visibility.Collapsed)
End Sub End Sub
@@ -21,7 +21,7 @@
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McVersionCurrent), Setup.Get("CacheAuthServerServer"), Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)) & "/authserver" Dim Server As String = If(IsNothing(McInstanceSelected), Setup.Get("CacheAuthServerServer"), Setup.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver"
Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = Setup.Get("CacheAuthUsername"), .Password = Setup.Get("CacheAuthPass"), .Description = "Authlib-Injector", .Type = McLoginType.Auth} Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = Setup.Get("CacheAuthUsername"), .Password = Setup.Get("CacheAuthPass"), .Description = "Authlib-Injector", .Type = McLoginType.Auth}
End Function End Function
@@ -78,7 +78,7 @@
End Sub End Sub
Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click
Dim Address As String = If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister")) Dim Address As String = If(McInstanceSelected IsNot Nothing, Setup.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Setup.Get("CacheAuthServerRegister"))
If String.IsNullOrEmpty(New ValidateHttp().Validate(Address)) Then OpenWebsite(Address.Replace("/auth/register", "/user/closet")) If String.IsNullOrEmpty(New ValidateHttp().Validate(Address)) Then OpenWebsite(Address.Replace("/auth/register", "/user/closet"))
End Sub End Sub
@@ -44,8 +44,8 @@ Public Class PageLoginLegacy
Public Shared Function IsVaild(LoginData As McLoginLegacy) As String Public Shared Function IsVaild(LoginData As McLoginLegacy) As String
If LoginData.UserName.Trim = "" Then Return "玩家名不能为空!" If LoginData.UserName.Trim = "" Then Return "玩家名不能为空!"
If LoginData.UserName.Contains("""") Then Return "玩家名不能包含英文引号!" If LoginData.UserName.Contains("""") Then Return "玩家名不能包含英文引号!"
If McVersionCurrent IsNot Nothing AndAlso If McInstanceSelected IsNot Nothing AndAlso
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 20, 3)) AndAlso McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla >= New Version(20, 0, 3) AndAlso
LoginData.UserName.Trim.Length > 16 Then LoginData.UserName.Trim.Length > 16 Then
Return "自 1.20.3 起,玩家名至多只能包含 16 个字符!" Return "自 1.20.3 起,玩家名至多只能包含 16 个字符!"
End If End If
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McVersionCurrent), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Version:=McVersionCurrent)) Dim Server As String = If(IsNothing(McInstanceSelected), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Instance:=McInstanceSelected))
If FrmLoginNide Is Nothing Then If FrmLoginNide Is Nothing Then
Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = "", .Password = "", .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"} Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = "", .Password = "", .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
Else Else
@@ -71,7 +71,7 @@
End Sub End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then If BtnLink.Content = "注册账号" Then
OpenWebsite("https://login.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=McVersionCurrent) & "/register") OpenWebsite("https://login.mc-user.com:233/" & Setup.Get("VersionServerNide", Instance:=McInstanceSelected) & "/register")
Else Else
OpenWebsite("https://login.mc-user.com:233/account/login") OpenWebsite("https://login.mc-user.com:233/account/login")
End If End If
@@ -21,7 +21,7 @@
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginServer Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McVersionCurrent), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Version:=McVersionCurrent)) Dim Server As String = If(IsNothing(McInstanceSelected), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Instance:=McInstanceSelected))
Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = Setup.Get("CacheNideUsername"), .Password = Setup.Get("CacheNidePass"), .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"} Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = Setup.Get("CacheNideUsername"), .Password = Setup.Get("CacheNidePass"), .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
End Function End Function
@@ -54,7 +54,7 @@
End Sub End Sub
Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click
OpenWebsite("https://login.mc-user.com:233/" & If(IsNothing(McVersionCurrent), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Version:=McVersionCurrent)) & "/skin") OpenWebsite("https://login.mc-user.com:233/" & If(IsNothing(McInstanceSelected), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Instance:=McInstanceSelected)) & "/skin")
End Sub End Sub
End Class End Class
@@ -202,6 +202,7 @@
</Grid> </Grid>
</Grid> </Grid>
<Grid x:Name="PanAlways" HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="15" Opacity="0.5"> <Grid x:Name="PanAlways" HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="15" Opacity="0.5">
<local:MyTextButton Text="示例文本 www.meloong.com" Opacity="0.4" />
</Grid> </Grid>
</Grid> </Grid>
</local:MyPageRight> </local:MyPageRight>
@@ -430,7 +430,7 @@ Public Class PageLinkMain
If ServerConfig Is Nothing Then Throw New Exception("无法从服务器获取配置") If ServerConfig Is Nothing Then Throw New Exception("无法从服务器获取配置")
'检查是否已禁用联机功能 '检查是否已禁用联机功能
Dim DisableReason = ServerConfig("Link")?("DisableReason2")?.ToString Dim DisableReason = ServerConfig("Link")?("DisableReason2")?.ToString
If Not String.IsNullOrEmpty(DisableReason) Then Throw New Exception("$" & DisableReason) If Not String.IsNullOrEmpty(DisableReason) Then Throw New Exception("$" & DisableReason) 'TODO: 可能不会显示错误原因?
If CType(ServerConfig("Link"), JObject).ContainsKey("MinVersionCode") AndAlso If CType(ServerConfig("Link"), JObject).ContainsKey("MinVersionCode") AndAlso
VersionCode < ServerConfig("Link")("MinVersionCode").ToObject(Of Integer) Then VersionCode < ServerConfig("Link")("MinVersionCode").ToObject(Of Integer) Then
Throw New Exception("$你的 PCL 版本太老了,请在更新 PCL 之后再联机!") Throw New Exception("$你的 PCL 版本太老了,请在更新 PCL 之后再联机!")
@@ -523,7 +523,7 @@ Public Class PageLinkMain
Dim ListenersPort As Integer = FreePorts(2) '它会占用【当前、当前 +1、当前 +2】共三个端口 Dim ListenersPort As Integer = FreePorts(2) '它会占用【当前、当前 +1、当前 +2】共三个端口
'获取启动参数 '获取启动参数
Dim Arguments As String = ServerConfig("Link")("Argument") Dim Arguments As String = ServerConfig("Link")("Argument")
Arguments += $" --network-name={NetworkName} --network-secret={NetworkSecret} --listeners {ListenersPort} --rpc-portal {RPCPort}" Arguments += $" --network-name={NetworkName} --network-secret={NetworkSecret} --listeners {ListenersPort} --rpc-portal {RPCPort} --private-mode true"
Dim HostName = If(IsServerSide, "Server-", "Client-") & RadixConvert(Math.Abs(Identify.GetHashCode), 10, 36) Dim HostName = If(IsServerSide, "Server-", "Client-") & RadixConvert(Math.Abs(Identify.GetHashCode), 10, 36)
If IsServerSide Then If IsServerSide Then
Arguments += $" -i 10.114.114.114 --hostname={HostName} --tcp-whitelist={ServerPort} --udp-whitelist={ServerPort}" Arguments += $" -i 10.114.114.114 --hostname={HostName} --tcp-whitelist={ServerPort} --udp-whitelist={ServerPort}"
@@ -539,7 +539,6 @@ Public Class PageLinkMain
For Each Peer As String In RawPeers For Each Peer As String In RawPeers
Arguments += $" -p=""{Peer}""" Arguments += $" -p=""{Peer}"""
Next Next
Arguments += " --private-mode true" '老好人模式现在莫得用:If Not Setup.Get("LinkShareMode") Then
If Setup.Get("LinkLatencyMode") = 1 Then Arguments += " --latency-first" If Setup.Get("LinkLatencyMode") = 1 Then Arguments += " --latency-first"
'启动进程 '启动进程
ProcessStart(Arguments) ProcessStart(Arguments)
File diff suppressed because it is too large Load Diff
@@ -49,7 +49,7 @@
''' <summary> ''' <summary>
''' 勾选事件改变页面。 ''' 勾选事件改变页面。
''' </summary> ''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemAbout.Check, ItemHelp.Check, ItemTest.Check Private Sub PageCheck(sender As FrameworkElement, e As RouteEventArgs) Handles ItemAbout.Check, ItemHelp.Check, ItemTest.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0 '尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False) '若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -34,7 +34,7 @@
'添加控件 '添加控件
Dim ContMenu As ContextMenu = Nothing Dim ContMenu As ContextMenu = Nothing
Select Case Folder.Type Select Case Folder.Type
Case McFolderType.Original Case McFolder.Types.Original
ContMenu = GetObjectFromXML( ContMenu = GetObjectFromXML(
<ContextMenu xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL;assembly=Plain Craft Launcher 2"> <ContextMenu xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL;assembly=Plain Craft Launcher 2">
<local:MyMenuItem x:Name="Rename" Header="重命名" Padding="0,2,0,0" Icon="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z"/> <local:MyMenuItem x:Name="Rename" Header="重命名" Padding="0,2,0,0" Icon="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z"/>
@@ -43,7 +43,7 @@
<local:MyMenuItem x:Name="Delete" Header="删除" Padding="0,0,0,2" Icon="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z "/> <local:MyMenuItem x:Name="Delete" Header="删除" Padding="0,0,0,2" Icon="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z "/>
</ContextMenu> </ContextMenu>
) )
Case McFolderType.RenamedOriginal Case McFolder.Types.RenamedOriginal
ContMenu = GetObjectFromXML( ContMenu = GetObjectFromXML(
<ContextMenu xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL;assembly=Plain Craft Launcher 2"> <ContextMenu xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL;assembly=Plain Craft Launcher 2">
<local:MyMenuItem x:Name="Remove" Header="复原名称" Padding="0,2,0,0" Icon="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z"/> <local:MyMenuItem x:Name="Remove" Header="复原名称" Padding="0,2,0,0" Icon="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z"/>
@@ -53,7 +53,7 @@
<local:MyMenuItem x:Name="Delete" Header="删除" Padding="0,0,0,2" Icon="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z "/> <local:MyMenuItem x:Name="Delete" Header="删除" Padding="0,0,0,2" Icon="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z "/>
</ContextMenu> </ContextMenu>
) )
Case McFolderType.Custom Case McFolder.Types.Custom
ContMenu = GetObjectFromXML( ContMenu = GetObjectFromXML(
<ContextMenu xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL;assembly=Plain Craft Launcher 2"> <ContextMenu xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:local="clr-namespace:PCL;assembly=Plain Craft Launcher 2">
<local:MyMenuItem x:Name="Rename" Header="重命名" Padding="0,2,0,0" Icon="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z"/> <local:MyMenuItem x:Name="Rename" Header="重命名" Padding="0,2,0,0" Icon="F1 M 53.2929,21.2929L 54.7071,22.7071C 56.4645,24.4645 56.4645,27.3137 54.7071,29.0711L 52.2323,31.5459L 44.4541,23.7677L 46.9289,21.2929C 48.6863,19.5355 51.5355,19.5355 53.2929,21.2929 Z M 31.7262,52.052L 23.948,44.2738L 43.0399,25.182L 50.818,32.9601L 31.7262,52.052 Z M 23.2409,47.1023L 28.8977,52.7591L 21.0463,54.9537L 23.2409,47.1023 Z"/>
@@ -64,15 +64,15 @@
</ContextMenu> </ContextMenu>
) )
End Select End Select
If (Folder.Type = McFolderType.Original OrElse Folder.Type = McFolderType.RenamedOriginal) AndAlso Folder.Path = Path & ".minecraft\" AndAlso McFolderList.Count = 1 Then CType(ContMenu.FindName("Delete"), MyMenuItem).Header = "清空" If (Folder.Type = McFolder.Types.Original OrElse Folder.Type = McFolder.Types.RenamedOriginal) AndAlso Folder.Location = Path & ".minecraft\" AndAlso McFolderList.Count = 1 Then CType(ContMenu.FindName("Delete"), MyMenuItem).Header = "清空"
'注册事件 '注册事件
If Not Folder.Type = McFolderType.Original Then CType(ContMenu.FindName("Remove"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Remove_Click)) If Not Folder.Type = McFolder.Types.Original Then CType(ContMenu.FindName("Remove"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Remove_Click))
CType(ContMenu.FindName("Open"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Open_Click)) CType(ContMenu.FindName("Open"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Open_Click))
CType(ContMenu.FindName("Delete"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Delete_Click)) CType(ContMenu.FindName("Delete"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Delete_Click))
CType(ContMenu.FindName("Rename"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Rename_Click)) CType(ContMenu.FindName("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)) 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, .MinPaddingRight = 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.Location, .Height = 40, .ContextMenu = ContMenu, .Tag = Folder}
AddHandler NewItem.Changed, AddressOf FrmSelectLeft.Folder_Change AddHandler NewItem.Changed, AddressOf FrmSelectLeft.Folder_Change
Dim NewIconButton As New MyIconButton With {.Logo = Logo.IconButtonSetup, .LogoScale = 1.1} Dim NewIconButton As New MyIconButton With {.Logo = Logo.IconButtonSetup, .LogoScale = 1.1}
AddHandler NewIconButton.Click, Sub(sender, e) AddHandler NewIconButton.Click, Sub(sender, e)
@@ -81,7 +81,7 @@
End Sub End Sub
NewItem.Buttons = {NewIconButton} NewItem.Buttons = {NewIconButton}
FrmSelectLeft.PanList.Children.Add(NewItem) FrmSelectLeft.PanList.Children.Add(NewItem)
Log("[Minecraft] 有效的 Minecraft 文件夹:" & Folder.Name & " > " & Folder.Path) Log("[Minecraft] 有效的 Minecraft 文件夹:" & Folder.Name & " > " & Folder.Location)
Next Next
'标题文本 '标题文本
@@ -125,7 +125,7 @@
'确认勾选状态 '确认勾选状态
For i = 0 To McFolderList.Count - 1 For i = 0 To McFolderList.Count - 1
If McFolderList(i).Path = PathMcFolder Then If McFolderList(i).Location = McFolderSelected Then
CType(FrmSelectLeft.PanList.Children(i + 1), MyListItem).Checked = True '去掉第一个标题 CType(FrmSelectLeft.PanList.Children(i + 1), MyListItem).Checked = True '去掉第一个标题
Return Return
End If End If
@@ -133,14 +133,14 @@
If Not McFolderList.Any() Then If Not McFolderList.Any() Then
Throw New ArgumentNullException("没有可用的 Minecraft 文件夹") Throw New ArgumentNullException("没有可用的 Minecraft 文件夹")
Else Else
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$")) Setup.Set("LaunchFolderSelect", McFolderList(0).Location.Replace(Path, "$"))
CType(FrmSelectLeft.PanList.Children(1), MyListItem).Checked = True CType(FrmSelectLeft.PanList.Children(1), MyListItem).Checked = True
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "构建 Minecraft 文件夹列表 UI 出错", LogLevel.Feedback) Log(ex, "构建 Minecraft 文件夹列表 UI 出错", LogLevel.Feedback)
Finally Finally
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表 LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表
End Try End Try
End Sub End Sub
Private McFolderListLast As List(Of McFolder) Private McFolderListLast As List(Of McFolder)
@@ -232,20 +232,20 @@
Dim ModFolder As New DirectoryInfo(FolderPath & "mods\") Dim ModFolder As New DirectoryInfo(FolderPath & "mods\")
If Not (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count >= 3) Then Return If Not (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count >= 3) Then Return
'2. 版本数较少,可能为整合包 '2. 版本数较少,可能为整合包
Dim VersionFolder As New DirectoryInfo(FolderPath & "versions\") Dim VersionFolderInfo As New DirectoryInfo(FolderPath & "versions\")
If Not (VersionFolder.Exists AndAlso VersionFolder.EnumerateDirectories.Count <= 3) Then Return If Not (VersionFolderInfo.Exists AndAlso VersionFolderInfo.EnumerateDirectories.Count <= 3) Then Return
'3. 能够找到可安装 Mod 的版本 '3. 能够找到可安装 Mod 的版本
For Each VersionPath In VersionFolder.EnumerateDirectories For Each VersionFolder In VersionFolderInfo.EnumerateDirectories
Dim Version As New McVersion(VersionPath.FullName) Dim Instance As New McInstance(VersionFolder.FullName)
Version.Load() Instance.Load()
If Not Version.Modable Then Continue For If Not Instance.Modable Then Continue For
'4. 该版本的隔离文件夹下不存在 mods '4. 该版本的隔离文件夹下不存在 mods
Dim ModIndieFolder As New DirectoryInfo(Version.Path & "mods\") Dim ModIndieFolder As New DirectoryInfo(Instance.PathVersion & "mods\")
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Return If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Return
'满足以上全部条件则视为根目录整合包 '满足以上全部条件则视为根目录整合包
Setup.Set("VersionArgumentIndie", 2, Version:=Version) Setup.Set("VersionArgumentIndie", 2, Instance:=Instance)
Setup.Set("VersionArgumentIndieV2", False, Version:=Version) Setup.Set("VersionArgumentIndieV2", False, Instance:=Instance)
Log("[Setup] 已自动关闭单版本隔离:" & Version.Name, LogLevel.Debug) Log("[Setup] 已自动关闭单版本隔离:" & Instance.Name, LogLevel.Debug)
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "向文件夹列表中添加新文件夹失败", LogLevel.Feedback) Log(ex, "向文件夹列表中添加新文件夹失败", LogLevel.Feedback)
@@ -276,14 +276,14 @@
Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
'若为 “移除”,则提醒是否删除 PCL 的配置文件 '若为 “移除”,则提醒是否删除 PCL 的配置文件
If Folder.Type = McFolderType.Custom Then If Folder.Type = McFolder.Types.Custom Then
Select Case MyMsgBox("是否需要清理 PCL 在该文件夹中的配置文件?" & vbCrLf & "这包括各个版本的独立设置(如自定义图标、第三方登录配置)等,对游戏本身没有影响。", "配置文件清理", "删除", "保留", "取消") Select Case MyMsgBox("是否需要清理 PCL 在该文件夹中的配置文件?" & vbCrLf & "这包括各个版本的独立设置(如自定义图标、第三方登录配置)等,对游戏本身没有影响。", "配置文件清理", "删除", "保留", "取消")
Case 1 Case 1
'删除配置文件 '删除配置文件
If File.Exists(Folder.Path & "PCL.ini") Then File.Delete(Folder.Path & "PCL.ini") If File.Exists(Folder.Location & "PCL.ini") Then File.Delete(Folder.Location & "PCL.ini")
If Directory.Exists(Folder.Path & "versions\") Then If Directory.Exists(Folder.Location & "versions\") Then
For Each Version In New DirectoryInfo(Folder.Path & "versions\").EnumerateDirectories For Each InstanceInfo In New DirectoryInfo(Folder.Location & "versions\").EnumerateDirectories
If Directory.Exists(Version.FullName & "\PCL\") Then Directory.Delete(Version.FullName & "\PCL\", True) If Directory.Exists(InstanceInfo.FullName & "\PCL\") Then Directory.Delete(InstanceInfo.FullName & "\PCL\", True)
Next Next
End If End If
Case 2 Case 2
@@ -299,7 +299,7 @@
Dim Name As String = "" Dim Name As String = ""
For i = 0 To Folders.Count - 1 For i = 0 To Folders.Count - 1
If Folders(i) = "" Then Exit For If Folders(i) = "" Then Exit For
If Folders(i).ToString.EndsWith(Folder.Path) Then If Folders(i).ToString.EndsWith(Folder.Location) Then
Name = Folders(i).ToString.BeforeFirst(">") Name = Folders(i).ToString.BeforeFirst(">")
Folders.RemoveAt(i) Folders.RemoveAt(i)
Exit For Exit For
@@ -307,7 +307,7 @@
Next Next
'保存 '保存
Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|"))) Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
Hint(If(Folder.Type = McFolderType.Custom, "文件夹 " & Name & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Green) Hint(If(Folder.Type = McFolder.Types.Custom, "文件夹 " & Name & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Green)
McFolderListLoader.Start(IsForceRestart:=True) McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception Catch ex As Exception
@@ -316,15 +316,15 @@
End Sub End Sub
Public Sub Delete_Click(sender As Object, e As RoutedEventArgs) Public Sub Delete_Click(sender As Object, e As RoutedEventArgs)
Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
Dim DeleteText As String = If((Folder.Type = McFolderType.Original OrElse Folder.Type = McFolderType.RenamedOriginal) AndAlso Folder.Path = Path & ".minecraft\" AndAlso McFolderList.Count = 1, "清空", "删除") Dim DeleteText As String = If((Folder.Type = McFolder.Types.Original OrElse Folder.Type = McFolder.Types.RenamedOriginal) AndAlso Folder.Location = Path & ".minecraft\" AndAlso McFolderList.Count = 1, "清空", "删除")
If MyMsgBox("你确定要" & DeleteText & "这个文件夹吗?" & vbCrLf & "目标文件夹:" & Folder.Path & vbCrLf & vbCrLf & "这会导致该文件夹中的所有存档与其他文件永久丢失,且不可恢复!", "删除警告", "取消", "确认", "取消") <> 2 Then Return If MyMsgBox("你确定要" & DeleteText & "这个文件夹吗?" & vbCrLf & "目标文件夹:" & Folder.Location & vbCrLf & vbCrLf & "这会导致该文件夹中的所有存档与其他文件永久丢失,且不可恢复!", "删除警告", "取消", "确认", "取消") <> 2 Then Return
If MyMsgBox("如果你在该文件夹中存放了除 MC 以外的其他文件,这些文件也会被一同删除!" & vbCrLf & "继续删除会导致该文件夹中的所有文件永久丢失,请在仔细确认后再继续!" & vbCrLf & "目标文件夹:" & Folder.Path & vbCrLf & vbCrLf & "这是最后一次警告!", "删除警告", "确认" & DeleteText, "取消", IsWarn:=True) <> 1 Then Return If MyMsgBox("如果你在该文件夹中存放了除 MC 以外的其他文件,这些文件也会被一同删除!" & vbCrLf & "继续删除会导致该文件夹中的所有文件永久丢失,请在仔细确认后再继续!" & vbCrLf & "目标文件夹:" & Folder.Location & vbCrLf & vbCrLf & "这是最后一次警告!", "删除警告", "确认" & DeleteText, "取消", IsWarn:=True) <> 1 Then Return
'移出列表 '移出列表
If Folder.Type = McFolderType.Custom Then If Folder.Type = McFolder.Types.Custom Then
Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|")) Dim Folders As New List(Of String)(Setup.Get("LaunchFolders").ToString.Split("|"))
For i = 0 To Folders.Count - 1 For i = 0 To Folders.Count - 1
If Folders(i) = "" Then Exit For If Folders(i) = "" Then Exit For
If Folders(i).ToString.EndsWith(Folder.Path) Then If Folders(i).ToString.EndsWith(Folder.Location) Then
'Name = Folders(i).ToString.Before(">") 'Name = Folders(i).ToString.Before(">")
Folders.RemoveAt(i) Folders.RemoveAt(i)
Exit For Exit For
@@ -337,8 +337,8 @@
'删除文件夹 '删除文件夹
Try Try
Hint("正在" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Blue) Hint("正在" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Blue)
DeleteDirectory(Folder.Path) DeleteDirectory(Folder.Location)
If DeleteText = "清空" Then Directory.CreateDirectory(Folder.Path) If DeleteText = "清空" Then Directory.CreateDirectory(Folder.Location)
Hint("已" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Green) Hint("已" & DeleteText & "文件夹 " & Folder.Name & "!", HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, DeleteText & "文件夹 " & Folder.Name & " 失败", LogLevel.Hint) Log(ex, DeleteText & "文件夹 " & Folder.Name & " 失败", LogLevel.Hint)
@@ -353,14 +353,14 @@
End Sub End Sub
Public Sub Refresh_Click(sender As Object, e As RoutedEventArgs) Public Sub Refresh_Click(sender As Object, e As RoutedEventArgs)
Dim Data As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag Dim Data As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
RefreshCurrent(Data.Path) RefreshCurrent(Data.Location)
End Sub End Sub
Public Sub RefreshCurrent() Implements IRefreshable.Refresh Public Sub RefreshCurrent() Implements IRefreshable.Refresh
RefreshCurrent(PathMcFolder) RefreshCurrent(McFolderSelected)
End Sub End Sub
Public Shared Sub RefreshCurrent(Folder As String) Public Shared Sub RefreshCurrent(Folder As String)
WriteIni(Folder & "PCL.ini", "VersionCache", "") '删除缓存以强制要求下一次加载时更新列表 WriteIni(Folder & "PCL.ini", "InstanceCache", "") '删除缓存以强制要求下一次加载时更新列表
If Folder = PathMcFolder Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") If Folder = McFolderSelected Then LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub End Sub
Public Sub Rename_Click(sender As Object, e As RoutedEventArgs) Public Sub Rename_Click(sender As Object, e As RoutedEventArgs)
Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
@@ -376,19 +376,19 @@
For i = 0 To Folders.Count - 1 For i = 0 To Folders.Count - 1
Dim FolderCurrent As String = Folders(i) Dim FolderCurrent As String = Folders(i)
If FolderCurrent = "" Then Continue For If FolderCurrent = "" Then Continue For
If FolderCurrent.Split(">")(1) = Folder.Path Then If FolderCurrent.Split(">")(1) = Folder.Location Then
IsAdded = True IsAdded = True
If FolderCurrent.Split(">")(0) = NewName Then If FolderCurrent.Split(">")(0) = NewName Then
'名称未修改 '名称未修改
Return Return
Else Else
Folders(i) = NewName & ">" & Folder.Path Folders(i) = NewName & ">" & Folder.Location
End If End If
Exit For Exit For
End If End If
Next Next
'如果没有添加过,则添加进去(因为修改了默认项的名称) '如果没有添加过,则添加进去(因为修改了默认项的名称)
If Not IsAdded Then Folders.Add(NewName & ">" & Folder.Path) If Not IsAdded Then Folders.Add(NewName & ">" & Folder.Location)
Hint("文件夹名称已更新为 " & NewName & " !", HintType.Green) Hint("文件夹名称已更新为 " & NewName & " !", HintType.Green)
'保存 '保存
Setup.Set("LaunchFolders", Join(Folders.ToArray, "|")) Setup.Set("LaunchFolders", Join(Folders.ToArray, "|"))
@@ -408,9 +408,9 @@
Return Return
End If End If
'更换 '更换
Setup.Set("LaunchFolderSelect", CType(sender.Tag, McFolder).Path.Replace(Path, "$")) Setup.Set("LaunchFolderSelect", CType(sender.Tag, McFolder).Location.Replace(Path, "$"))
McFolderListLoader.Start(IsForceRestart:=True) McFolderListLoader.Start(IsForceRestart:=True)
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表 LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表
End Sub End Sub
End Class End Class
@@ -2,15 +2,15 @@
'窗口基础 '窗口基础
Private Sub PageSelectRight_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub PageSelectRight_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
PanBack.ScrollToHome() PanBack.ScrollToHome()
End Sub End Sub
Private Sub LoaderInit() Handles Me.Initialized Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanAllBack, Nothing, McVersionListLoader, AddressOf McVersionListUI, AutoRun:=False) PageLoaderInit(Load, PanLoad, PanAllBack, Nothing, McInstanceListLoader, AddressOf McInstanceListUI, AutoRun:=False)
End Sub End Sub
Private Sub Load_Click(sender As Object, e As MouseButtonEventArgs) Handles Load.Click Private Sub Load_Click(sender As Object, e As MouseButtonEventArgs) Handles Load.Click
If McVersionListLoader.State = LoadState.Failed Then If McInstanceListLoader.State = LoadState.Failed Then
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End If End If
End Sub End Sub
@@ -22,30 +22,29 @@
#Region "结果 UI 化" #Region "结果 UI 化"
Private Sub McVersionListUI(Loader As LoaderTask(Of String, Integer)) Private Sub McInstanceListUI(Loader As LoaderTask(Of String, Integer))
Try Try
Dim Path As String = Loader.Input
'加载 UI '加载 UI
PanMain.Children.Clear() PanMain.Children.Clear()
For Each Card As KeyValuePair(Of McVersionCardType, List(Of McVersion)) In McVersionList.ToArray For Each Card As KeyValuePair(Of McInstanceCardType, List(Of McInstance)) In McInstanceList.ToArray
'确认是否为隐藏版本显示状态 '确认是否为隐藏版本显示状态
If Card.Key = McVersionCardType.Hidden Xor ShowHidden Then Continue For If Card.Key = McInstanceCardType.Hidden Xor ShowHidden Then Continue For
#Region "确认卡片名称" #Region "确认卡片名称"
Dim CardName As String = "" Dim CardName As String = ""
Select Case Card.Key Select Case Card.Key
Case McVersionCardType.OriginalLike Case McInstanceCardType.OriginalLike
CardName = "常规版本" CardName = "常规版本"
Case McVersionCardType.API Case McInstanceCardType.API
Dim IsForgeExists As Boolean = False Dim IsForgeExists As Boolean = False
Dim IsNeoForgeExists As Boolean = False Dim IsNeoForgeExists As Boolean = False
Dim IsFabricExists As Boolean = False Dim IsFabricExists As Boolean = False
Dim IsLiteExists As Boolean = False Dim IsLiteExists As Boolean = False
For Each Version As McVersion In Card.Value For Each Instance As McInstance In Card.Value
If Version.Version.HasFabric Then IsFabricExists = True If Instance.Version.HasFabric Then IsFabricExists = True
If Version.Version.HasLiteLoader Then IsLiteExists = True If Instance.Version.HasLiteLoader Then IsLiteExists = True
If Version.Version.HasForge Then IsForgeExists = True If Instance.Version.HasForge Then IsForgeExists = True
If Version.Version.HasNeoForge Then IsNeoForgeExists = True If Instance.Version.HasNeoForge Then IsNeoForgeExists = True
Next Next
If If(IsLiteExists, 1, 0) + If(IsForgeExists, 1, 0) + If(IsFabricExists, 1, 0) + If(IsNeoForgeExists, 1, 0) > 1 Then If If(IsLiteExists, 1, 0) + If(IsForgeExists, 1, 0) + If(IsFabricExists, 1, 0) + If(IsNeoForgeExists, 1, 0) > 1 Then
CardName = "可安装 Mod" CardName = "可安装 Mod"
@@ -58,15 +57,15 @@
Else Else
CardName = "Fabric 版本" CardName = "Fabric 版本"
End If End If
Case McVersionCardType.Error Case McInstanceCardType.Error
CardName = "错误的版本" CardName = "错误的版本"
Case McVersionCardType.Hidden Case McInstanceCardType.Hidden
CardName = "隐藏的版本" CardName = "隐藏的版本"
Case McVersionCardType.Rubbish Case McInstanceCardType.Rubbish
CardName = "不常用版本" CardName = "不常用版本"
Case McVersionCardType.Star Case McInstanceCardType.Star
CardName = "收藏夹" CardName = "收藏夹"
Case McVersionCardType.Fool Case McInstanceCardType.Fool
CardName = "愚人节版本" CardName = "愚人节版本"
Case Else Case Else
Throw New ArgumentException("未知的卡片种类(" & Card.Key & ")") Throw New ArgumentException("未知的卡片种类(" & Card.Key & ")")
@@ -80,7 +79,7 @@
NewCard.SwapControl = NewStack NewCard.SwapControl = NewStack
PanMain.Children.Add(NewCard) PanMain.Children.Add(NewCard)
'确定卡片是否展开 '确定卡片是否展开
If Card.Key = McVersionCardType.Rubbish OrElse Card.Key = McVersionCardType.Error OrElse Card.Key = McVersionCardType.Fool Then If Card.Key = McInstanceCardType.Rubbish OrElse Card.Key = McInstanceCardType.Error OrElse Card.Key = McInstanceCardType.Fool Then
NewCard.IsSwapped = True NewCard.IsSwapped = True
Else Else
MyCard.StackInstall(NewStack, 0, CardTitle) MyCard.StackInstall(NewStack, 0, CardTitle)
@@ -114,13 +113,13 @@
Log(ex, "将版本列表转换显示时失败", LogLevel.Feedback) Log(ex, "将版本列表转换显示时失败", LogLevel.Feedback)
End Try End Try
End Sub End Sub
Public Shared Sub McVersionListContent(sender As MyListItem, e As EventArgs) Public Shared Sub McInstanceListContent(sender As MyListItem, e As EventArgs)
Dim Version As McVersion = sender.Tag Dim Instance As McInstance = sender.Tag
'注册点击事件 '注册点击事件
AddHandler sender.Click, AddressOf Item_Click AddHandler sender.Click, AddressOf Item_Click
'图标按钮 '图标按钮
Dim BtnStar As New MyIconButton Dim BtnStar As New MyIconButton
If Version.IsStar Then If Instance.IsStar Then
BtnStar.ToolTip = "取消收藏" BtnStar.ToolTip = "取消收藏"
ToolTipService.SetPlacement(BtnStar, Primitives.PlacementMode.Center) ToolTipService.SetPlacement(BtnStar, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnStar, 30) ToolTipService.SetVerticalOffset(BtnStar, 30)
@@ -136,17 +135,17 @@
BtnStar.Logo = Logo.IconButtonLikeLine BtnStar.Logo = Logo.IconButtonLikeLine
End If End If
AddHandler BtnStar.Click, Sub() AddHandler BtnStar.Click, Sub()
WriteIni(Version.Path & "PCL\Setup.ini", "IsStar", Not Version.IsStar) WriteIni(Instance.PathVersion & "PCL\Setup.ini", "IsStar", Not Instance.IsStar)
McVersionListForceRefresh = True McInstanceListForceRefresh = True
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub End Sub
Dim BtnDel As New MyIconButton With {.LogoScale = 1.1, .Logo = Logo.IconButtonDelete} Dim BtnDel As New MyIconButton With {.LogoScale = 1.1, .Logo = Logo.IconButtonDelete}
BtnDel.ToolTip = "删除" BtnDel.ToolTip = "删除"
ToolTipService.SetPlacement(BtnDel, Primitives.PlacementMode.Center) ToolTipService.SetPlacement(BtnDel, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnDel, 30) ToolTipService.SetVerticalOffset(BtnDel, 30)
ToolTipService.SetHorizontalOffset(BtnDel, 2) ToolTipService.SetHorizontalOffset(BtnDel, 2)
AddHandler BtnDel.Click, Sub() DeleteVersion(sender, Version) AddHandler BtnDel.Click, Sub() DeleteInstance(sender, Instance)
If Version.State <> McVersionState.Error Then If Instance.State <> McInstanceState.Error Then
Dim BtnCont As New MyIconButton With {.LogoScale = 1.1, .Logo = Logo.IconButtonSetup} Dim BtnCont As New MyIconButton With {.LogoScale = 1.1, .Logo = Logo.IconButtonSetup}
BtnCont.ToolTip = "设置" BtnCont.ToolTip = "设置"
ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center) ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center)
@@ -154,13 +153,13 @@
ToolTipService.SetHorizontalOffset(BtnCont, 2) ToolTipService.SetHorizontalOffset(BtnCont, 2)
AddHandler BtnCont.Click, AddHandler BtnCont.Click,
Sub() Sub()
PageVersionLeft.Version = Version PageInstanceLeft.Instance = Instance
FrmMain.PageChange(FormMain.PageType.VersionSetup, 0) FrmMain.PageChange(FormMain.PageType.InstanceSetup, 0)
End Sub End Sub
AddHandler sender.MouseRightButtonUp, AddHandler sender.MouseRightButtonUp,
Sub() Sub()
PageVersionLeft.Version = Version PageInstanceLeft.Instance = Instance
FrmMain.PageChange(FormMain.PageType.VersionSetup, 0) FrmMain.PageChange(FormMain.PageType.InstanceSetup, 0)
End Sub End Sub
sender.Buttons = {BtnStar, BtnDel, BtnCont} sender.Buttons = {BtnStar, BtnDel, BtnCont}
Else Else
@@ -169,8 +168,8 @@
ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center) ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnCont, 30) ToolTipService.SetVerticalOffset(BtnCont, 30)
ToolTipService.SetHorizontalOffset(BtnCont, 2) ToolTipService.SetHorizontalOffset(BtnCont, 2)
AddHandler BtnCont.Click, Sub() PageVersionOverall.OpenVersionFolder(Version) AddHandler BtnCont.Click, Sub() PageInstanceOverall.OpenInstanceFolder(Instance)
AddHandler sender.MouseRightButtonUp, Sub() PageVersionOverall.OpenVersionFolder(Version) AddHandler sender.MouseRightButtonUp, Sub() PageInstanceOverall.OpenInstanceFolder(Instance)
sender.Buttons = {BtnStar, BtnDel, BtnCont} sender.Buttons = {BtnStar, BtnDel, BtnCont}
End If End If
End Sub End Sub
@@ -181,15 +180,15 @@
'点击选项 '点击选项
Public Shared Sub Item_Click(sender As MyListItem, e As EventArgs) Public Shared Sub Item_Click(sender As MyListItem, e As EventArgs)
Dim Version As McVersion = sender.Tag Dim Instance As McInstance = sender.Tag
If New McVersion(Version.Path).Check Then If New McInstance(Instance.PathVersion).Check Then
'正常版本 '正常版本
McVersionCurrent = Version McInstanceSelected = Instance
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name) Setup.Set("LaunchVersionSelect", McInstanceSelected.Name)
FrmMain.PageBack() FrmMain.PageBack()
Else Else
'错误版本 '错误版本
PageVersionOverall.OpenVersionFolder(Version) PageInstanceOverall.OpenInstanceFolder(Instance)
End If End If
End Sub End Sub
@@ -197,29 +196,28 @@
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall) FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End Sub End Sub
'修改此代码时,同时修改 PageVersionOverall 中的代码 '修改此代码时,同时修改 PageInstanceOverall 中的代码
Public Shared Sub DeleteVersion(Item As MyListItem, Version As McVersion) Public Shared Sub DeleteInstance(Item As MyListItem, Instance As McInstance)
Try Try
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim IsHintIndie As Boolean = Version.State <> McVersionState.Error AndAlso Version.PathIndie <> PathMcFolder Dim IsHintIndie As Boolean = Instance.State <> McInstanceState.Error AndAlso Instance.PathIndie <> McFolderSelected
Select Case MyMsgBox($"你确定要{If(IsShiftPressed, "永久", "")}删除版本 {Version.Name} 吗?" & Select Case MyMsgBox($"你确定要{If(IsShiftPressed, "永久", "")}删除版本 {Instance.Name} 吗?" &
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""), If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""),
"版本删除确认", , "取消",, True) "版本删除确认", , "取消",, True)
Case 1 Case 1
IniClearCache(Version.PathIndie & "options.txt") IniClearCache(Instance.PathIndie & "options.txt")
IniClearCache(Version.Path & "PCL\Setup.ini") IniClearCache(Instance.PathVersion & "PCL\Setup.ini")
If IsShiftPressed Then If IsShiftPressed Then
DeleteDirectory(Version.Path) DeleteDirectory(Instance.PathVersion)
Hint("版本 " & Version.Name & " 已永久删除!", HintType.Green)
Else Else
FileIO.FileSystem.DeleteDirectory(Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin) FileIO.FileSystem.DeleteDirectory(Instance.PathVersion, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & Version.Name & " 已删除!", HintType.Green)
End If End If
Hint("版本 " & Instance.Name & " 已删除!", HintType.Green)
Case 2 Case 2
Return Return
End Select End Select
'从 UI 中移除 '从 UI 中移除
If Version.DisplayType = McVersionCardType.Hidden OrElse Not Version.IsStar Then If Instance.DisplayType = McInstanceCardType.Hidden OrElse Not Instance.IsStar Then
'仅出现在当前卡片 '仅出现在当前卡片
Dim Parent As StackPanel = Item.Parent Dim Parent As StackPanel = Item.Parent
If Parent.Children.Count > 2 Then '当前的项目与一个占位符 If Parent.Children.Count > 2 Then '当前的项目与一个占位符
@@ -227,23 +225,23 @@
Dim Card As MyCard = Parent.Parent Dim Card As MyCard = Parent.Parent
Card.Title = Card.Title.Replace(Parent.Children.Count - 1, Parent.Children.Count - 2) '有一个占位符 Card.Title = Card.Title.Replace(Parent.Children.Count - 1, Parent.Children.Count - 2) '有一个占位符
Parent.Children.Remove(Item) Parent.Children.Remove(Item)
If McVersionCurrent IsNot Nothing AndAlso Version.Path = McVersionCurrent.Path Then If McInstanceSelected IsNot Nothing AndAlso Instance.PathVersion = McInstanceSelected.PathVersion Then
'删除当前版本就更改选择 '删除当前版本就更改选择
McVersionCurrent = CType(Parent.Children(0), MyListItem).Tag McInstanceSelected = MyVirtualizingElement.TryInit(Parent.Children(0)).Tag
End If End If
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.UpdateOnly, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.UpdateOnly, MaxDepth:=1, ExtraPath:="versions\")
Else Else
'删除后没剩了 '删除后没剩了
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End If End If
Else Else
'同时出现在当前卡片与收藏夹 '同时出现在当前卡片与收藏夹
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End If End If
Catch ex As OperationCanceledException Catch ex As OperationCanceledException
Log(ex, "删除版本 " & Version.Name & " 被主动取消") Log(ex, "删除版本 " & Instance.Name & " 被主动取消")
Catch ex As Exception Catch ex As Exception
Log(ex, "删除版本 " & Version.Name & " 失败", LogLevel.Msgbox) Log(ex, "删除版本 " & Instance.Name & " 失败", LogLevel.Msgbox)
End Try End Try
End Sub End Sub
@@ -1,9 +1,6 @@
Public Class ModSetup Public Class ModSetup
Private Const VersionSetup As Integer = 1
''' <summary>
''' 设置的更新号。
''' </summary>
Public Const VersionSetup As Integer = 1
''' <summary> ''' <summary>
''' 设置列表。 ''' 设置列表。
''' </summary> ''' </summary>
@@ -43,6 +40,7 @@
{"SystemSystemUpdate", New SetupEntry(0)}, {"SystemSystemUpdate", New SetupEntry(0)},
{"SystemSystemActivity", New SetupEntry(0)}, {"SystemSystemActivity", New SetupEntry(0)},
{"SystemSystemTelemetry", New SetupEntry(True, Source:=SetupSource.Registry)}, {"SystemSystemTelemetry", New SetupEntry(True, Source:=SetupSource.Registry)},
{"CacheDrops", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheConfig", New SetupEntry(0, Source:=SetupSource.Registry)}, {"CacheConfig", New SetupEntry(0, Source:=SetupSource.Registry)},
{"CacheExportConfig", New SetupEntry("", Source:=SetupSource.Registry)}, {"CacheExportConfig", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheSavedPageUrl", New SetupEntry("", Source:=SetupSource.Registry)}, {"CacheSavedPageUrl", New SetupEntry("", Source:=SetupSource.Registry)},
@@ -112,7 +110,6 @@
{"LaunchRamType", New SetupEntry(0)}, {"LaunchRamType", New SetupEntry(0)},
{"LaunchRamCustom", New SetupEntry(15)}, {"LaunchRamCustom", New SetupEntry(15)},
{"LinkLastAutoJoinInviteCode", New SetupEntry("", Source:=SetupSource.Registry)}, {"LinkLastAutoJoinInviteCode", New SetupEntry("", Source:=SetupSource.Registry)},
{"LinkShareMode", New SetupEntry(True, Source:=SetupSource.Registry)},
{"LinkLatencyMode", New SetupEntry(0, Source:=SetupSource.Registry)}, {"LinkLatencyMode", New SetupEntry(0, Source:=SetupSource.Registry)},
{"LinkCustomPeer", New SetupEntry("")}, {"LinkCustomPeer", New SetupEntry("")},
{"LinkEasyTierVersion", New SetupEntry(-1, Source:=SetupSource.Registry)}, {"LinkEasyTierVersion", New SetupEntry(-1, Source:=SetupSource.Registry)},
@@ -174,29 +171,29 @@
{"UiHiddenOtherVote", New SetupEntry(False)}, {"UiHiddenOtherVote", New SetupEntry(False)},
{"UiHiddenOtherAbout", New SetupEntry(False)}, {"UiHiddenOtherAbout", New SetupEntry(False)},
{"UiHiddenOtherTest", New SetupEntry(False)}, {"UiHiddenOtherTest", New SetupEntry(False)},
{"VersionAdvanceJvm", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionAdvanceJvm", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionAdvanceGame", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionAdvanceGame", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionAdvanceAssets", New SetupEntry(0, Source:=SetupSource.Version)}, {"VersionAdvanceAssets", New SetupEntry(0, Source:=SetupSource.Instance)},
{"VersionAdvanceAssetsV2", New SetupEntry(False, Source:=SetupSource.Version)}, {"VersionAdvanceAssetsV2", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionAdvanceJava", New SetupEntry(False, Source:=SetupSource.Version)}, {"VersionAdvanceJava", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionAdvanceRun", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionAdvanceRun", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionAdvanceRunWait", New SetupEntry(True, Source:=SetupSource.Version)}, {"VersionAdvanceRunWait", New SetupEntry(True, Source:=SetupSource.Instance)},
{"VersionAdvanceDisableJLW", New SetupEntry(False, Source:=SetupSource.Version)}, {"VersionAdvanceDisableJLW", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionAdvanceDisableModUpdate", New SetupEntry(False, Source:=SetupSource.Version)}, {"VersionAdvanceDisableModUpdate", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionRamType", New SetupEntry(2, Source:=SetupSource.Version)}, {"VersionRamType", New SetupEntry(2, Source:=SetupSource.Instance)},
{"VersionRamCustom", New SetupEntry(15, Source:=SetupSource.Version)}, {"VersionRamCustom", New SetupEntry(15, Source:=SetupSource.Instance)},
{"VersionRamOptimize", New SetupEntry(0, Source:=SetupSource.Version)}, {"VersionRamOptimize", New SetupEntry(0, Source:=SetupSource.Instance)},
{"VersionArgumentTitle", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionArgumentTitle", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionArgumentInfo", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionArgumentInfo", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionArgumentIndie", New SetupEntry(-1, Source:=SetupSource.Version)}, {"VersionArgumentIndie", New SetupEntry(-1, Source:=SetupSource.Instance)},
{"VersionArgumentIndieV2", New SetupEntry(False, Source:=SetupSource.Version)}, {"VersionArgumentIndieV2", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionArgumentJavaSelect", New SetupEntry("使用全局设置", Source:=SetupSource.Version)}, {"VersionArgumentJavaSelect", New SetupEntry("使用全局设置", Source:=SetupSource.Instance)},
{"VersionServerEnter", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionServerEnter", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerLogin", New SetupEntry(0, Source:=SetupSource.Version)}, {"VersionServerLogin", New SetupEntry(0, Source:=SetupSource.Instance)},
{"VersionServerNide", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionServerNide", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerAuthRegister", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionServerAuthRegister", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerAuthName", New SetupEntry("", Source:=SetupSource.Version)}, {"VersionServerAuthName", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerAuthServer", New SetupEntry("", Source:=SetupSource.Version)} {"VersionServerAuthServer", New SetupEntry("", Source:=SetupSource.Instance)}
} }
#Region "基础" #Region "基础"
@@ -204,7 +201,7 @@
Private Enum SetupSource Private Enum SetupSource
Normal Normal
Registry Registry
Version Instance
End Enum End Enum
Private Class SetupEntry Private Class SetupEntry
@@ -239,18 +236,18 @@
''' <summary> ''' <summary>
''' 改变某个设置项的值。 ''' 改变某个设置项的值。
''' </summary> ''' </summary>
Public Sub [Set](Key As String, Value As Object, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing) Public Sub [Set](Key As String, Value As Object, Optional ForceReload As Boolean = False, Optional Instance As McInstance = Nothing)
[Set](Key, Value, SetupDict(Key), ForceReload, Version) [Set](Key, Value, SetupDict(Key), ForceReload, Instance)
End Sub End Sub
''' <summary> ''' <summary>
''' 写入某个未经加密的设置项。 ''' 写入某个未经加密的设置项。
''' 若该设置项经过了加密,则会抛出异常。 ''' 若该设置项经过了加密,则会抛出异常。
''' </summary> ''' </summary>
Public Sub SetSafe(Key As String, Value As Object, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing) Public Sub SetSafe(Key As String, Value As Object, Optional ForceReload As Boolean = False, Optional Instance As McInstance = Nothing)
If SetupDict(Key).Encoded Then Throw New InvalidOperationException("禁止写入加密设置项:" & Key) If SetupDict(Key).Encoded Then Throw New InvalidOperationException("禁止写入加密设置项:" & Key)
[Set](Key, Version, ForceReload, Version) [Set](Key, Instance, ForceReload, Instance)
End Sub End Sub
Private Sub [Set](Key As String, Value As Object, E As SetupEntry, ForceReload As Boolean, Version As McVersion) Private Sub [Set](Key As String, Value As Object, E As SetupEntry, ForceReload As Boolean, Instance As McInstance)
Try Try
Value = CTypeDynamic(Value, E.Type) Value = CTypeDynamic(Value, E.Type)
@@ -259,7 +256,7 @@
If E.Value = Value AndAlso Not ForceReload Then Return If E.Value = Value AndAlso Not ForceReload Then Return
Else Else
'如果未应用,则直接更改并应用 '如果未应用,则直接更改并应用
If E.Source <> SetupSource.Version Then E.State = 2 If E.Source <> SetupSource.Instance Then E.State = 2
End If End If
'设置新值 '设置新值
E.Value = Value E.Value = Value
@@ -277,9 +274,9 @@
WriteIni("Setup", Key, Value) WriteIni("Setup", Key, Value)
Case SetupSource.Registry Case SetupSource.Registry
WriteReg(Key, Value) WriteReg(Key, Value)
Case SetupSource.Version Case SetupSource.Instance
If Version Is Nothing Then Throw New Exception($"更改版本设置 {Key} 时未提供目标版本") If Instance Is Nothing Then Throw New Exception($"更改版本设置 {Key} 时未提供目标版本")
WriteIni(Version.Path & "PCL\Setup.ini", Key, Value) WriteIni(Instance.PathVersion & "PCL\Setup.ini", Key, Value)
End Select End Select
'应用 '应用
'例如 VersionServerLogin 要求在设置之后再引发事件 '例如 VersionServerLogin 要求在设置之后再引发事件
@@ -294,15 +291,15 @@
''' <summary> ''' <summary>
''' 应用某个设置项的值。 ''' 应用某个设置项的值。
''' </summary> ''' </summary>
Public Function Load(Key As String, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing) Public Function Load(Key As String, Optional ForceReload As Boolean = False, Optional Instance As McInstance = Nothing)
Return Load(Key, SetupDict(Key), ForceReload, Version) Return Load(Key, SetupDict(Key), ForceReload, Instance)
End Function End Function
Private Function Load(Key As String, E As SetupEntry, ForceReload As Boolean, Version As McVersion) Private Function Load(Key As String, E As SetupEntry, ForceReload As Boolean, Instance As McInstance)
'如果已经应用过,则什么也不干 '如果已经应用过,则什么也不干
If E.State = 2 AndAlso Not ForceReload Then Return E.Value If E.State = 2 AndAlso Not ForceReload Then Return E.Value
'读取,应用并设置状态 '读取,应用并设置状态
Read(Key, E, Version) Read(Key, E, Instance)
If E.Source <> SetupSource.Version Then E.State = 2 If E.Source <> SetupSource.Instance Then E.State = 2
Dim Method As Reflection.MethodInfo = GetType(ModSetup).GetMethod(Key) Dim Method As Reflection.MethodInfo = GetType(ModSetup).GetMethod(Key)
If Method IsNot Nothing Then Method.Invoke(Me, {E.Value}) If Method IsNot Nothing Then Method.Invoke(Me, {E.Value})
Return E.Value Return E.Value
@@ -311,19 +308,19 @@
''' <summary> ''' <summary>
''' 获取某个设置项的值。 ''' 获取某个设置项的值。
''' </summary> ''' </summary>
Public Function [Get](Key As String, Optional Version As McVersion = Nothing) Public Function [Get](Key As String, Optional Instance As McInstance = Nothing)
If Not SetupDict.ContainsKey(Key) Then Throw New KeyNotFoundException("未找到设置项:" & Key) If Not SetupDict.ContainsKey(Key) Then Throw New KeyNotFoundException("未找到设置项:" & Key)
Return [Get](Key, SetupDict(Key), Version) Return [Get](Key, SetupDict(Key), Instance)
End Function End Function
''' <summary> ''' <summary>
''' 获取某个未经加密的设置项的值。 ''' 获取某个未经加密的设置项的值。
''' 若该设置项经过了加密,则会抛出异常。 ''' 若该设置项经过了加密,则会抛出异常。
''' </summary> ''' </summary>
Public Function GetSafe(Key As String, Optional Version As McVersion = Nothing) Public Function GetSafe(Key As String, Optional Instance As McInstance = Nothing)
If SetupDict(Key).Encoded Then Throw New InvalidOperationException("禁止读取加密设置项:" & Key) If SetupDict(Key).Encoded Then Throw New InvalidOperationException("禁止读取加密设置项:" & Key)
Return [Get](Key, Version) Return [Get](Key, Instance)
End Function End Function
Private Function [Get](Key As String, E As SetupEntry, Version As McVersion) Private Function [Get](Key As String, E As SetupEntry, Instance As McInstance)
'获取强制值 '获取强制值
Dim Force As String = ForceValue(Key) Dim Force As String = ForceValue(Key)
If Force IsNot Nothing Then If Force IsNot Nothing Then
@@ -332,8 +329,8 @@
End If End If
'如果尚未读取过,则读取 '如果尚未读取过,则读取
If E.State = 0 Then If E.State = 0 Then
Read(Key, E, Version) Read(Key, E, Instance)
If E.Source <> SetupSource.Version Then E.State = 1 If E.Source <> SetupSource.Instance Then E.State = 1
End If End If
'返回现在的值 '返回现在的值
Return E.Value Return E.Value
@@ -342,17 +339,17 @@
''' <summary> ''' <summary>
''' 初始化某个设置项的值。 ''' 初始化某个设置项的值。
''' </summary> ''' </summary>
Public Sub Reset(Key As String, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing) Public Sub Reset(Key As String, Optional ForceReload As Boolean = False, Optional Instance As McInstance = Nothing)
Dim E As SetupEntry = SetupDict(Key) Dim E As SetupEntry = SetupDict(Key)
[Set](Key, E.DefaultValue, E, ForceReload, Version) [Set](Key, E.DefaultValue, E, ForceReload, Instance)
Select Case SetupDict(Key).Source Select Case SetupDict(Key).Source
Case SetupSource.Normal Case SetupSource.Normal
DeleteIniKey("Setup", Key) DeleteIniKey("Setup", Key)
Case SetupSource.Registry Case SetupSource.Registry
DeleteReg(Key) DeleteReg(Key)
Case Else 'SetupSource.Version Case Else 'SetupSource.Instance
If Version Is Nothing Then Throw New Exception($"重置版本设置 {Key} 时未提供目标版本") If Instance Is Nothing Then Throw New Exception($"重置版本设置 {Key} 时未提供目标版本")
DeleteIniKey(Version.Path & "PCL\Setup.ini", Key) DeleteIniKey(Instance.PathVersion & "PCL\Setup.ini", Key)
End Select End Select
End Sub End Sub
''' <summary> ''' <summary>
@@ -364,22 +361,22 @@
''' <summary> ''' <summary>
''' 某个设置项是否从未被设置过。 ''' 某个设置项是否从未被设置过。
''' </summary> ''' </summary>
Public Function IsUnset(Key As String, Optional Version As McVersion = Nothing) As Boolean Public Function IsUnset(Key As String, Optional Instance As McInstance = Nothing) As Boolean
Select Case SetupDict(Key).Source Select Case SetupDict(Key).Source
Case SetupSource.Normal Case SetupSource.Normal
Return Not HasIniKey("Setup", Key) Return Not HasIniKey("Setup", Key)
Case SetupSource.Registry Case SetupSource.Registry
Return Not HasReg(Key) Return Not HasReg(Key)
Case Else 'SetupSource.Version Case Else 'SetupSource.Instance
If Version Is Nothing Then Throw New Exception($"判断版本设置 {Key} 是否存在时未提供目标版本") If Instance Is Nothing Then Throw New Exception($"判断版本设置 {Key} 是否存在时未提供目标版本")
Return Not HasIniKey(Version.Path & "PCL\Setup.ini", Key) Return Not HasIniKey(Instance.PathVersion & "PCL\Setup.ini", Key)
End Select End Select
End Function End Function
''' <summary> ''' <summary>
''' 读取设置。 ''' 读取设置。
''' </summary> ''' </summary>
Private Sub Read(Key As String, ByRef E As SetupEntry, Version As McVersion) Private Sub Read(Key As String, ByRef E As SetupEntry, Instance As McInstance)
Try Try
If Not E.State = 0 Then Return If Not E.State = 0 Then Return
Dim SourceValue As String = Nothing '先用 String 储存,避免类型转换 Dim SourceValue As String = Nothing '先用 String 储存,避免类型转换
@@ -388,11 +385,11 @@
SourceValue = ReadIni("Setup", Key, E.DefaultValueEncoded) SourceValue = ReadIni("Setup", Key, E.DefaultValueEncoded)
Case SetupSource.Registry Case SetupSource.Registry
SourceValue = ReadReg(Key, E.DefaultValueEncoded) SourceValue = ReadReg(Key, E.DefaultValueEncoded)
Case SetupSource.Version Case SetupSource.Instance
If Version Is Nothing Then If Instance Is Nothing Then
Throw New Exception("读取版本设置 " & Key & " 时未提供目标版本") Throw New Exception("读取版本设置 " & Key & " 时未提供目标版本")
Else Else
SourceValue = ReadIni(Version.Path & "PCL\Setup.ini", Key, E.DefaultValueEncoded) SourceValue = ReadIni(Instance.PathVersion & "PCL\Setup.ini", Key, E.DefaultValueEncoded)
End If End If
End Select End Select
If E.Encoded Then If E.Encoded Then
@@ -420,6 +417,8 @@
#If BETA Then #If BETA Then
If Key = "UiLauncherTheme" Then Return "0" If Key = "UiLauncherTheme" Then Return "0"
#End If #End If
If Key = "UiHiddenPageLink" Then Return True
If Key = "UiHiddenSetupLink" Then Return True
Return Nothing Return Nothing
End Function End Function
@@ -430,11 +429,11 @@
'切换选择 '切换选择
Public Sub LaunchVersionSelect(Value As String) Public Sub LaunchVersionSelect(Value As String)
Log("[Setup] 当前选择的 Minecraft 版本:" & Value) Log("[Setup] 当前选择的 Minecraft 版本:" & Value)
WriteIni(PathMcFolder & "PCL.ini", "Version", If(IsNothing(McVersionCurrent), "", McVersionCurrent.Name)) WriteIni(McFolderSelected & "PCL.ini", "Version", If(IsNothing(McInstanceSelected), "", McInstanceSelected.Name))
End Sub End Sub
Public Sub LaunchFolderSelect(Value As String) Public Sub LaunchFolderSelect(Value As String)
Log("[Setup] 当前选择的 Minecraft 文件夹:" & Value.ToString.Replace("$", Path)) Log("[Setup] 当前选择的 Minecraft 文件夹:" & Value.ToString.Replace("$", Path))
PathMcFolder = Value.ToString.Replace("$", Path) McFolderSelected = Value.ToString.Replace("$", Path)
End Sub End Sub
'游戏内存 '游戏内存
@@ -762,18 +761,18 @@
'游戏内存 '游戏内存
Public Sub VersionRamType(Type As Integer) Public Sub VersionRamType(Type As Integer)
If FrmVersionSetup Is Nothing Then Return If FrmInstanceSetup Is Nothing Then Return
FrmVersionSetup.RamType(Type) FrmInstanceSetup.RamType(Type)
End Sub End Sub
'服务器 '服务器
Public Sub VersionServerLogin(Type As Integer) Public Sub VersionServerLogin(Type As Integer)
If FrmVersionSetup Is Nothing Then Return If FrmInstanceSetup Is Nothing Then Return
'为第三方登录清空缓存以更新描述 '为第三方登录清空缓存以更新描述
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "")
If PageVersionLeft.Version Is Nothing Then Return If PageInstanceLeft.Instance Is Nothing Then Return
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load() PageInstanceLeft.Instance = New McInstance(PageInstanceLeft.Instance.Name).Load()
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub End Sub
#End Region #End Region
@@ -252,8 +252,8 @@
<StackPanel Margin="0,12,0,4" Grid.Row="6" Grid.ColumnSpan="2" HorizontalAlignment="Left"> <StackPanel Margin="0,12,0,4" Grid.Row="6" Grid.ColumnSpan="2" HorizontalAlignment="Left">
<local:MyCheckBox Height="28" Text="禁用 Java Launch Wrapper" x:Name="CheckAdvanceDisableJLW" Tag="LaunchAdvanceDisableJLW" <local:MyCheckBox Height="28" Text="禁用 Java Launch Wrapper" x:Name="CheckAdvanceDisableJLW" Tag="LaunchAdvanceDisableJLW"
ToolTipService.Placement="Right" ToolTip="PCL 会使用 Java Launch Wrapper 来修复老版本 Java 在中文路径下无法启动的问题。&#xa;如果这被反作弊拦截,或遇到其他问题,也可以将其关闭。" /> ToolTipService.Placement="Right" ToolTip="PCL 会使用 Java Launch Wrapper 来修复老版本 Java 在中文路径下无法启动的问题。&#xa;如果这被反作弊拦截,或遇到其他问题,也可以将其关闭。" />
<local:MyCheckBox Height="28" Text="要求 Java 使用高性能显卡" x:Name="CheckAdvanceGraphicCard" Tag="LaunchAdvanceGraphicCard" <local:MyCheckBox Height="28" Text="使用高性能显卡" x:Name="CheckAdvanceGraphicCard" Tag="LaunchAdvanceGraphicCard"
ToolTipService.Placement="Right" ToolTip="自动在 Windows 设置 → 系统 → 屏幕 → 显示卡 中将 Java 改为使用高性能显卡。&#xa;如果电脑同时有集显和独显,这能确保 MC 使用独显进行渲染,以大幅提高性能。" /> ToolTipService.Placement="Right" ToolTip="自动在 Windows 设置 → 系统 → 屏幕 → 显示卡 中将 PCL 和 Java 改为使用高性能显卡。&#xa;如果同时有集成显卡和独立显卡,这能确保 MC 使用独立显卡进行渲染,以大幅提高帧率。" />
</StackPanel> </StackPanel>
<local:MyHint Text="版本独立设置中还有更多高级选项可供调整。" Margin="0,5,0,10" Theme="Blue" Grid.Row="7" Grid.ColumnSpan="2" <local:MyHint Text="版本独立设置中还有更多高级选项可供调整。" Margin="0,5,0,10" Theme="Blue" Grid.Row="7" Grid.ColumnSpan="2"
CanClose="True" RelativeSetup="HintMoreAdvancedSetup" /> CanClose="True" RelativeSetup="HintMoreAdvancedSetup" />
@@ -7,7 +7,7 @@
'重复加载部分 '重复加载部分
PanBack.ScrollToHome() PanBack.ScrollToHome()
RefreshRam(False) RefreshRam(False)
If McVersionCurrent Is Nothing Then If McInstanceSelected Is Nothing Then
BtnSwitch.Visibility = Visibility.Collapsed BtnSwitch.Visibility = Visibility.Collapsed
Else Else
BtnSwitch.Visibility = Visibility.Visible BtnSwitch.Visibility = Visibility.Visible
@@ -197,7 +197,7 @@
Public Sub RefreshRam(ShowAnim As Boolean) Public Sub RefreshRam(ShowAnim As Boolean)
If LabRamGame Is Nothing OrElse LabRamUsed Is Nothing OrElse FrmMain.PageCurrent <> FormMain.PageType.Setup OrElse FrmSetupLeft.PageID <> FormMain.PageSubType.SetupLaunch Then Return If LabRamGame Is Nothing OrElse LabRamUsed Is Nothing OrElse FrmMain.PageCurrent <> FormMain.PageType.Setup OrElse FrmSetupLeft.PageID <> FormMain.PageSubType.SetupLaunch Then Return
'获取内存情况 '获取内存情况
Dim RamGame As Double = Math.Round(GetRam(McVersionCurrent, False), 5) Dim RamGame As Double = Math.Round(GetRam(McInstanceSelected, False), 5)
Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024, 1) Dim RamTotal As Double = Math.Round(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024 / 1024, 1)
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024, 1) Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024, 1)
Dim RamGameActual As Double = Math.Round(Math.Min(RamGame, RamAvailable), 5) Dim RamGameActual As Double = Math.Round(Math.Min(RamGame, RamAvailable), 5)
@@ -324,10 +324,10 @@
''' <summary> ''' <summary>
''' 获取当前设置的 RAM 值。单位为 GB。 ''' 获取当前设置的 RAM 值。单位为 GB。
''' </summary> ''' </summary>
Public Shared Function GetRam(Version As McVersion, UseVersionJavaSetup As Boolean, Optional Is32BitJava As Boolean? = Nothing) As Double Public Shared Function GetRam(Instance As McInstance, UseVersionJavaSetup As Boolean, Optional Is32BitJava As Boolean? = Nothing) As Double
'------------------------------------------ '------------------------------------------
' 修改下方代码时需要一并修改 PageVersionSetup ' 修改下方代码时需要一并修改 PageInstanceSetup
'------------------------------------------ '------------------------------------------
Dim RamGive As Double Dim RamGive As Double
@@ -339,16 +339,16 @@
Dim RamTarget1 As Double '估计能勉强带动了的内存 Dim RamTarget1 As Double '估计能勉强带动了的内存
Dim RamTarget2 As Double '估计没啥问题了的内存 Dim RamTarget2 As Double '估计没啥问题了的内存
Dim RamTarget3 As Double '放一百万个材质和 Mod 和光影需要的内存 Dim RamTarget3 As Double '放一百万个材质和 Mod 和光影需要的内存
If Version IsNot Nothing AndAlso Not Version.IsLoaded Then Version.Load() If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load()
If Version IsNot Nothing AndAlso Version.Modable Then If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 Mod 的版本 '可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\") Dim ModDir As New DirectoryInfo(Instance.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0) Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0)
RamMininum = 0.5 + ModCount / 150 RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90 RamTarget1 = 1.5 + ModCount / 90
RamTarget2 = 2.7 + ModCount / 50 RamTarget2 = 2.7 + ModCount / 50
RamTarget3 = 4.5 + ModCount / 25 RamTarget3 = 4.5 + ModCount / 25
ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then ElseIf Instance IsNot Nothing AndAlso Instance.Version.HasOptiFine Then
'OptiFine 版本 'OptiFine 版本
RamMininum = 0.5 RamMininum = 0.5
RamTarget1 = 1.5 RamTarget1 = 1.5
@@ -399,7 +399,7 @@ PreFin:
End If End If
End If End If
'若使用 32 位 Java,则限制为 1G '若使用 32 位 Java,则限制为 1G
If If(Is32BitJava, Not JavaIs64Bit(If(UseVersionJavaSetup, Version, Nothing))) Then RamGive = Math.Min(1, RamGive) If If(Is32BitJava, Not JavaIs64Bit(If(UseVersionJavaSetup, Instance, Nothing))) Then RamGive = Math.Min(1, RamGive)
Return RamGive Return RamGive
End Function End Function
@@ -417,7 +417,7 @@ PreFin:
Dim SelectedItem As MyComboBoxItem = Nothing Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Setup.Get("LaunchArgumentJavaSelect") Dim SelectedBySetup As String = Setup.Get("LaunchArgumentJavaSelect")
Try Try
For Each Java In JavaList.Clone().OrderByDescending(Function(v) v.VersionCode) For Each Java In JavaList.Clone().OrderByDescending(Function(v) v.MajorVersion)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java} Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
ToolTipService.SetHorizontalOffset(ListItem, 400) ToolTipService.SetHorizontalOffset(ListItem, 400)
ComboArgumentJava.Items.Add(ListItem) ComboArgumentJava.Items.Add(ListItem)
@@ -580,9 +580,9 @@ PreFin:
'切换到版本独立设置 '切换到版本独立设置
Private Sub BtnSwitch_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSwitch.Click Private Sub BtnSwitch_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSwitch.Click
McVersionCurrent.Load() McInstanceSelected.Load()
PageVersionLeft.Version = McVersionCurrent PageInstanceLeft.Instance = McInstanceSelected
FrmMain.PageChange(FormMain.PageType.VersionSetup, FormMain.PageSubType.VersionSetup) FrmMain.PageChange(FormMain.PageType.InstanceSetup, FormMain.PageSubType.InstanceSetup)
End Sub End Sub
'去除参数中的回车 '去除参数中的回车
@@ -39,8 +39,6 @@
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义节点" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义节点" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextCustomPeer" Tag="LinkCustomPeer" Grid.Column="1" MaxHeight="28" <local:MyTextBox x:Name="TextCustomPeer" Tag="LinkCustomPeer" Grid.Column="1" MaxHeight="28"
ToolTip="覆盖 PCL 所选择的节点,仅连接此处填写的节点。&#xa;如果你自己搭建了 EasyTier 节点,你可以用这个设置让 PCL 连接它。&#xa;&#xa;使用逗号分隔多个节点,例如:&#xa;tcp://public.easytier.cn:11010,tcp://public2.easytier.cn:54321&#xa;&#xa;房主和加入者必须连接到至少一个相同节点,才能互相连上。" /> ToolTip="覆盖 PCL 所选择的节点,仅连接此处填写的节点。&#xa;如果你自己搭建了 EasyTier 节点,你可以用这个设置让 PCL 连接它。&#xa;&#xa;使用逗号分隔多个节点,例如:&#xa;tcp://public.easytier.cn:11010,tcp://public2.easytier.cn:54321&#xa;&#xa;房主和加入者必须连接到至少一个相同节点,才能互相连上。" />
<local:MyCheckBox Text="老好人模式" x:Name="CheckShareMode" Grid.Row="1" Tag="LinkShareMode" Height="22" Visibility="Collapsed"
ToolTip="启动联机后,用你的网络帮助其他玩家建立连接、降低延迟!&#xa;即使你不开启,开启了这个选项的其他玩家也会帮助你,不过,人人为我,我为人人嘛……" />
<StackPanel Orientation="Horizontal" Grid.Row="2" Grid.ColumnSpan="2" HorizontalAlignment="Left"> <StackPanel Orientation="Horizontal" Grid.Row="2" Grid.ColumnSpan="2" HorizontalAlignment="Left">
<local:MyButton MinWidth="140" Padding="13,5" Margin="0,0,20,0" HorizontalAlignment="Left" <local:MyButton MinWidth="140" Padding="13,5" Margin="0,0,20,0" HorizontalAlignment="Left"
Text=" 光荣地贡献节点!" ColorType="Highlight" Text=" 光荣地贡献节点!" ColorType="Highlight"
@@ -18,7 +18,6 @@
End Sub End Sub
Public Sub Reload() Public Sub Reload()
ComboLatencyMode.SelectedIndex = Setup.Get("LinkLatencyMode") ComboLatencyMode.SelectedIndex = Setup.Get("LinkLatencyMode")
CheckShareMode.Checked = Setup.Get("LinkShareMode")
TextCustomPeer.Text = Setup.Get("LinkCustomPeer") TextCustomPeer.Text = Setup.Get("LinkCustomPeer")
End Sub End Sub
@@ -26,7 +25,6 @@
Public Sub Reset() Public Sub Reset()
Try Try
Setup.Reset("LinkLatencyMode") Setup.Reset("LinkLatencyMode")
Setup.Reset("LinkShareMode")
Setup.Reset("LinkCustomPeer") Setup.Reset("LinkCustomPeer")
Log("[Setup] 已初始化联机页设置") Log("[Setup] 已初始化联机页设置")
@@ -42,9 +40,6 @@
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextCustomPeer.ValidatedTextChanged Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextCustomPeer.ValidatedTextChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text)
End Sub End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckShareMode.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboLatencyMode.SelectionChanged Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboLatencyMode.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub End Sub
@@ -248,12 +248,14 @@
<local:MyComboBoxItem Content="Minecraft 皮肤推荐(作者:wkea)" /> <local:MyComboBoxItem Content="Minecraft 皮肤推荐(作者:wkea)" />
<local:MyComboBoxItem Content="OpenBMCLAPI 仪表盘 Lite(作者:Silverteal、Mxmilu666)" /> <local:MyComboBoxItem Content="OpenBMCLAPI 仪表盘 Lite(作者:Silverteal、Mxmilu666)" />
<local:MyComboBoxItem Content="PCL 主页市场(作者:凌云)" /> <local:MyComboBoxItem Content="PCL 主页市场(作者:凌云)" />
<local:MyComboBoxItem Content="PCL 新闻速报(作者:Joker2184)" /> <local:MyComboBoxItem Content="PCL 新闻速报(作者:Joker2184)" Visibility="Collapsed" />
<local:MyComboBoxItem Content="PCL 新功能说明书(作者:WForst-Breeze)" /> <local:MyComboBoxItem Content="PCL 新功能说明书(作者:WForst-Breeze)" />
<local:MyComboBoxItem Content="OpenMCIM 仪表盘(作者:SALTWOOD)" Visibility="Collapsed" /> <local:MyComboBoxItem Content="OpenMCIM 仪表盘(作者:SALTWOOD)" Visibility="Collapsed" />
<local:MyComboBoxItem Content="杂志主页(作者:CreeperIsASpy)" /> <local:MyComboBoxItem Content="杂志主页(作者:CreeperIsASpy)" />
<local:MyComboBoxItem Content="PCL GitHub 仪表盘(作者:Deep-Dark-Forest)" /> <local:MyComboBoxItem Content="PCL GitHub 仪表盘(作者:Deep-Dark-Forest)" />
<local:MyComboBoxItem Content="Minecraft 更新摘要(作者:pynickle,部分由 AI 生成)" /> <local:MyComboBoxItem Content="Minecraft 更新摘要(作者:pynickle,部分由 AI 生成)" />
<local:MyComboBoxItem Content="今日新闻热点(作者:EYicheng,部分由 AI 生成)" />
<local:MyComboBoxItem Content="Minecraft 芝士站(作者:awaEric233,部分由 AI 生成)" />
</local:MyComboBox> </local:MyComboBox>
</Grid> </Grid>
</StackPanel> </StackPanel>
@@ -281,12 +283,12 @@
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock Grid.Row="1" VerticalAlignment="Center" HorizontalAlignment="Left" Text="主页面" /> <TextBlock Grid.Row="1" VerticalAlignment="Center" HorizontalAlignment="Left" Text="主页面" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="2" Text="下载" x:Name="CheckHiddenPageDownload" Tag="UiHiddenPageDownload" /> <local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="2" Text="下载" x:Name="CheckHiddenPageDownload" Tag="UiHiddenPageDownload" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="3" Text="联机" x:Name="CheckHiddenPageLink" Tag="UiHiddenPageLink" /> <local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="3" Text="联机" x:Name="CheckHiddenPageLink" Tag="UiHiddenPageLink" IsEnabled="False" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="4" Text="设置" x:Name="CheckHiddenPageSetup" Tag="UiHiddenPageSetup" /> <local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="4" Text="设置" x:Name="CheckHiddenPageSetup" Tag="UiHiddenPageSetup" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="5" Text="更多" x:Name="CheckHiddenPageOther" Tag="UiHiddenPageOther" /> <local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="1" Grid.Column="5" Text="更多" x:Name="CheckHiddenPageOther" Tag="UiHiddenPageOther" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="设置 子页面" /> <TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="设置 子页面" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="2" Text="启动" x:Name="CheckHiddenSetupLaunch" Tag="UiHiddenSetupLaunch" /> <local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="2" Text="启动" x:Name="CheckHiddenSetupLaunch" Tag="UiHiddenSetupLaunch" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" Text="联机" x:Name="CheckHiddenSetupLink" Tag="UiHiddenSetupLink" /> <local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" Text="联机" x:Name="CheckHiddenSetupLink" Tag="UiHiddenSetupLink" IsEnabled="False" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="4" Text="个性化" x:Name="CheckHiddenSetupUI" Tag="UiHiddenSetupUi" /> <local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="4" Text="个性化" x:Name="CheckHiddenSetupUI" Tag="UiHiddenSetupUi" />
<local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="5" Text="其他" x:Name="CheckHiddenSetupSystem" Tag="UiHiddenSetupSystem" /> <local:MyCheckBox Height="22" VerticalAlignment="Center" Grid.Row="2" Grid.Column="5" Text="其他" x:Name="CheckHiddenSetupSystem" Tag="UiHiddenSetupSystem" />
<TextBlock Grid.Row="3" VerticalAlignment="Center" HorizontalAlignment="Left" Text="更多 子页面" /> <TextBlock Grid.Row="3" VerticalAlignment="Center" HorizontalAlignment="Left" Text="更多 子页面" />
@@ -523,7 +523,7 @@ Refresh:
'顶部栏未被全部隐藏 '顶部栏未被全部隐藏
FrmMain.PanTitleSelect.Visibility = Visibility.Visible FrmMain.PanTitleSelect.Visibility = Visibility.Visible
FrmMain.BtnTitleSelect1.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageDownload"), Visibility.Collapsed, Visibility.Visible) FrmMain.BtnTitleSelect1.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageDownload"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect2.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageLink"), Visibility.Collapsed, Visibility.Visible) FrmMain.BtnTitleSelect2.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageLink"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect3.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageSetup"), Visibility.Collapsed, Visibility.Visible) FrmMain.BtnTitleSelect3.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageSetup"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect4.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageOther"), Visibility.Collapsed, Visibility.Visible) FrmMain.BtnTitleSelect4.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageOther"), Visibility.Collapsed, Visibility.Visible)
End If End If
@@ -536,13 +536,13 @@ Refresh:
If FrmSetupLeft IsNot Nothing Then If FrmSetupLeft IsNot Nothing Then
FrmSetupLeft.ItemLaunch.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupLaunch"), Visibility.Collapsed, Visibility.Visible) FrmSetupLeft.ItemLaunch.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupLaunch"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemUI.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupUi"), Visibility.Collapsed, Visibility.Visible) FrmSetupLeft.ItemUI.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupUi"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemLink.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupLink"), Visibility.Collapsed, Visibility.Visible) FrmSetupLeft.ItemLink.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupLink"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemSystem.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupSystem"), Visibility.Collapsed, Visibility.Visible) FrmSetupLeft.ItemSystem.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenSetupSystem"), Visibility.Collapsed, Visibility.Visible)
'隐藏左边选择卡 '隐藏左边选择卡
Dim AvaliableCount As Integer = 0 Dim AvaliableCount As Integer = 0
If Not Setup.Get("UiHiddenSetupLaunch") Then AvaliableCount += 1 If Not Setup.Get("UiHiddenSetupLaunch") Then AvaliableCount += 1
If Not Setup.Get("UiHiddenSetupUi") Then AvaliableCount += 1 If Not Setup.Get("UiHiddenSetupUi") Then AvaliableCount += 1
If Not Setup.Get("UiHiddenSetupLink") Then AvaliableCount += 1 'If Not Setup.Get("UiHiddenSetupLink") Then AvaliableCount += 1
If Not Setup.Get("UiHiddenSetupSystem") Then AvaliableCount += 1 If Not Setup.Get("UiHiddenSetupSystem") Then AvaliableCount += 1
FrmSetupLeft.PanItem.Visibility = If(AvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible) FrmSetupLeft.PanItem.Visibility = If(AvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If End If
@@ -574,9 +574,9 @@ Refresh:
FrmMain.BtnTitleSelect4.Text = "更多" FrmMain.BtnTitleSelect4.Text = "更多"
End If End If
'各个页面的入口 '各个页面的入口
If FrmMain.PageCurrent = FormMain.PageType.VersionSelect Then FrmSelectRight.BtnEmptyDownload_Loaded() If FrmMain.PageCurrent = FormMain.PageType.InstanceSelect Then FrmSelectRight.BtnEmptyDownload_Loaded()
If FrmMain.PageCurrent = FormMain.PageType.Launch Then FrmLaunchLeft.RefreshButtonsUI() If FrmMain.PageCurrent = FormMain.PageType.Launch Then FrmLaunchLeft.RefreshButtonsUI()
If FrmMain.PageCurrent = FormMain.PageType.VersionSetup AndAlso FrmVersionModDisabled IsNot Nothing Then FrmVersionModDisabled.BtnDownload_Loaded() If FrmMain.PageCurrent = FormMain.PageType.InstanceSetup AndAlso FrmInstanceModDisabled IsNot Nothing Then FrmInstanceModDisabled.BtnDownload_Loaded()
'备注 '备注
If FrmSetupUI IsNot Nothing Then FrmSetupUI.CardSwitch.Title = If(HiddenForceShow, "功能隐藏(已暂时关闭,按 F12 以重新启用)", "功能隐藏") If FrmSetupUI IsNot Nothing Then FrmSetupUI.CardSwitch.Title = If(HiddenForceShow, "功能隐藏(已暂时关闭,按 F12 以重新启用)", "功能隐藏")
Catch ex As Exception Catch ex As Exception
@@ -162,6 +162,7 @@
</Reference> </Reference>
<Reference Include="NAudio, Version=1.7.3.0, Culture=neutral, processorArchitecture=MSIL"> <Reference Include="NAudio, Version=1.7.3.0, Culture=neutral, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion> <SpecificVersion>False</SpecificVersion>
<HintPath>Resources\NAudio.dll</HintPath>
<Private>False</Private> <Private>False</Private>
</Reference> </Reference>
<Reference Include="Newtonsoft.Json, Version=13.0.0.0, Culture=neutral, PublicKeyToken=30ad4fe6b2a6aeed, processorArchitecture=MSIL"> <Reference Include="Newtonsoft.Json, Version=13.0.0.0, Culture=neutral, PublicKeyToken=30ad4fe6b2a6aeed, processorArchitecture=MSIL">
@@ -189,6 +190,10 @@
<Reference Include="System.Numerics" /> <Reference Include="System.Numerics" />
<Reference Include="System.Runtime.Caching" /> <Reference Include="System.Runtime.Caching" />
<Reference Include="System.ServiceModel" /> <Reference Include="System.ServiceModel" />
<Reference Include="System.ValueTuple, Version=4.0.5.0, Culture=neutral, PublicKeyToken=cc7b13ffcd2ddd51, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>Resources\System.ValueTuple.dll</HintPath>
</Reference>
<Reference Include="System.Windows.Forms" /> <Reference Include="System.Windows.Forms" />
<Reference Include="System.Xml.Linq" /> <Reference Include="System.Xml.Linq" />
<Reference Include="System" /> <Reference Include="System" />
@@ -207,6 +212,7 @@
</ApplicationDefinition> </ApplicationDefinition>
<Compile Include="Controls\Behaviors\ClipboardInterceptor.vb" /> <Compile Include="Controls\Behaviors\ClipboardInterceptor.vb" />
<Compile Include="Controls\Behaviors\Interfaces.vb" /> <Compile Include="Controls\Behaviors\Interfaces.vb" />
<Compile Include="Controls\Behaviors\LazyLoadBehavior.vb" />
<Compile Include="Controls\MyComboBox.vb" /> <Compile Include="Controls\MyComboBox.vb" />
<Compile Include="Controls\MyComboBoxItem.vb" /> <Compile Include="Controls\MyComboBoxItem.vb" />
<Compile Include="Controls\MyCard.vb" /> <Compile Include="Controls\MyCard.vb" />
@@ -222,12 +228,13 @@
<Compile Include="Controls\MyVirtualizingElement.vb" />
<Compile Include="Modules\Minecraft\ModComp.vb" /> <Compile Include="Modules\Minecraft\ModComp.vb" />
<Compile Include="Modules\Minecraft\ModJava.vb" /> <Compile Include="Modules\Minecraft\ModJava.vb" />
<Compile Include="Modules\Minecraft\ModMod.vb" /> <Compile Include="Modules\Minecraft\ModMod.vb" />
<Compile Include="Modules\Minecraft\ModModpack.vb" /> <Compile Include="Modules\Minecraft\ModModpack.vb" />
<Compile Include="Modules\ThirdParty\DragHelper.vb" /> <Compile Include="Modules\ThirdParty\DragHelper.vb" />
<Compile Include="Pages\PageVersion\MyLocalModItem.xaml.vb"> <Compile Include="Pages\PageInstance\MyLocalModItem.xaml.vb">
<DependentUpon>MyLocalModItem.xaml</DependentUpon> <DependentUpon>MyLocalModItem.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Modules\ModEvent.vb" /> <Compile Include="Modules\ModEvent.vb" />
@@ -312,23 +319,23 @@
<Compile Include="Pages\PageOther\PageOtherHelpDetail.xaml.vb"> <Compile Include="Pages\PageOther\PageOtherHelpDetail.xaml.vb">
<DependentUpon>PageOtherHelpDetail.xaml</DependentUpon> <DependentUpon>PageOtherHelpDetail.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Pages\PageVersion\PageVersionExport.xaml.vb"> <Compile Include="Pages\PageInstance\PageInstanceExport.xaml.vb">
<DependentUpon>PageVersionExport.xaml</DependentUpon> <DependentUpon>PageInstanceExport.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Pages\PageVersion\PageVersionLeft.xaml.vb"> <Compile Include="Pages\PageInstance\PageInstanceLeft.xaml.vb">
<DependentUpon>PageVersionLeft.xaml</DependentUpon> <DependentUpon>PageInstanceLeft.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Pages\PageVersion\PageVersionMod.xaml.vb"> <Compile Include="Pages\PageInstance\PageInstanceMod.xaml.vb">
<DependentUpon>PageVersionMod.xaml</DependentUpon> <DependentUpon>PageInstanceMod.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Pages\PageVersion\PageVersionModDisabled.xaml.vb"> <Compile Include="Pages\PageInstance\PageInstanceModDisabled.xaml.vb">
<DependentUpon>PageVersionModDisabled.xaml</DependentUpon> <DependentUpon>PageInstanceModDisabled.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Pages\PageVersion\PageVersionOverall.xaml.vb"> <Compile Include="Pages\PageInstance\PageInstanceOverall.xaml.vb">
<DependentUpon>PageVersionOverall.xaml</DependentUpon> <DependentUpon>PageInstanceOverall.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Pages\PageVersion\PageVersionSetup.xaml.vb"> <Compile Include="Pages\PageInstance\PageInstanceSetup.xaml.vb">
<DependentUpon>PageVersionSetup.xaml</DependentUpon> <DependentUpon>PageInstanceSetup.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Controls\MyDropShadow.vb" /> <Compile Include="Controls\MyDropShadow.vb" />
<Compile Include="Modules\Base\ModLoader.vb" /> <Compile Include="Modules\Base\ModLoader.vb" />
@@ -497,7 +504,7 @@
<SubType>Code</SubType> <SubType>Code</SubType>
</Compile> </Compile>
<Page Include="Pages\PageVersion\MyLocalModItem.xaml"> <Page Include="Pages\PageInstance\MyLocalModItem.xaml">
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType> <SubType>Designer</SubType>
</Page> </Page>
@@ -574,7 +581,7 @@
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
</Page> </Page>
<Page Include="Pages\PageVersion\PageVersionExport.xaml"> <Page Include="Pages\PageInstance\PageInstanceExport.xaml">
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
</Page> </Page>
@@ -654,23 +661,23 @@
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
</Page> </Page>
<Page Include="Pages\PageVersion\PageVersionLeft.xaml"> <Page Include="Pages\PageInstance\PageInstanceLeft.xaml">
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
</Page> </Page>
<Page Include="Pages\PageVersion\PageVersionMod.xaml"> <Page Include="Pages\PageInstance\PageInstanceMod.xaml">
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
</Page> </Page>
<Page Include="Pages\PageVersion\PageVersionModDisabled.xaml"> <Page Include="Pages\PageInstance\PageInstanceModDisabled.xaml">
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
</Page> </Page>
<Page Include="Pages\PageVersion\PageVersionOverall.xaml"> <Page Include="Pages\PageInstance\PageInstanceOverall.xaml">
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
</Page> </Page>
<Page Include="Pages\PageVersion\PageVersionSetup.xaml"> <Page Include="Pages\PageInstance\PageInstanceSetup.xaml">
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
</Page> </Page>
@@ -801,28 +808,6 @@
<ItemGroup> <ItemGroup>
<Resource Include="Images\Themes\10.png" /> <Resource Include="Images\Themes\10.png" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<PublishFile Include="NAudio">
<Visible>False</Visible>
<Group>
</Group>
<TargetPath>
</TargetPath>
<PublishState>Exclude</PublishState>
<IncludeHash>True</IncludeHash>
<FileType>Assembly</FileType>
</PublishFile>
<PublishFile Include="Newtonsoft.Json">
<Visible>False</Visible>
<Group>
</Group>
<TargetPath>
</TargetPath>
<PublishState>Exclude</PublishState>
<IncludeHash>True</IncludeHash>
<FileType>Assembly</FileType>
</PublishFile>
</ItemGroup>
<ItemGroup> <ItemGroup>
<Resource Include="Images\Heads\Patrick.png" /> <Resource Include="Images\Heads\Patrick.png" />
</ItemGroup> </ItemGroup>
@@ -936,5 +921,8 @@
<ItemGroup> <ItemGroup>
<Resource Include="Images\Heads\EasyTier.png" /> <Resource Include="Images\Heads\EasyTier.png" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<Content Include="Resources\System.ValueTuple.dll" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" /> <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project> </Project>
Binary file not shown.
File diff suppressed because it is too large Load Diff
Binary file not shown.