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

2.12.0

Browse Source
This commit is contained in:
龙腾猫跃 committed 2025-12-27 02:48:47 +08:00
1 parent d6ba445e54
commit 085af160a1
78 files changed
+8426 -4863
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

Plain Craft Launcher 2/Application.xaml.vb
+1 -1
View File
@@ -198,7 +198,7 @@ WaitRetry:
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
'缓存
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 LoadedAssembly As New Dictionary(Of String, Assembly)(StringComparer.Ordinal)
'查找对应的 DLL
Plain Craft Launcher 2/Controls/Behaviors/ClipboardInterceptor.vb
+11 -6
View File
@@ -35,7 +35,7 @@ Namespace Controls.Behaviors
End Sub
Public Shared Function GetEnableSafeClipboard(element As DependencyObject) As Boolean
Return CBool(element.GetValue(EnableSafeClipboardProperty))
Return element.GetValue(EnableSafeClipboardProperty)
End Function
Private Shared Sub OnEnableSafeClipboardChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
@@ -97,6 +97,10 @@ Namespace Controls.Behaviors
If Forms.Clipboard.ContainsText() Then
Dim pasteText = Forms.Clipboard.GetText()
'将换行符替换为空格（#7825）
If Not tb.AcceptsReturn Then pasteText = pasteText.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
Dim start = tb.SelectionStart
tb.SelectedText = pasteText
@@ -162,14 +166,15 @@ Namespace Controls.Behaviors
Dim dg = TryCast(sender, DataGrid)
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)
For Each row In rowGroups
Dim rowText = String.Join(vbTab, row.Select(Function(cell)
Dim tb = TryCast(cell.Column.GetCellContent(cell.Item), TextBlock)
Return If(tb IsNot Nothing, tb.Text, "")
End Function))
Dim rowText = String.Join(vbTab, row.Select(
Function(cell)
Dim tb = TryCast(cell.Column.GetCellContent(cell.Item), TextBlock)
Return If(tb IsNot Nothing, tb.Text, "")
End Function))
sb.AppendLine(rowText)
Next
Plain Craft Launcher 2/Controls/Behaviors/LazyLoadBehavior.vb
+47
View File
@@ -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
Plain Craft Launcher 2/Controls/MyCard.vb
+19 -26
View File
@@ -92,6 +92,7 @@
'改变默认的折叠
If IsSwapped AndAlso SwapControl IsNot Nothing Then
MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
SwapControl.Visibility = Visibility.Collapsed
'取消由于高度变化被迫触发的高度动画
Dim RawUseAnimation As Boolean = UseAnimation
UseAnimation = False
@@ -109,17 +110,21 @@
'这一部分的代码是好几年前留下的究极屎坑，当时还不知道该咋正确调用这种方法，就写了这么一坨屎
'但是现在……反正勉强能用……懒得改了就这样吧.jpg
'别骂了别骂了.jpg
If IsNothing(Stack.Tag) Then Return
If Stack.Tag Is Nothing Then Return
'排序
Dim HasDuplicates As Boolean = False
Select Case Type
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
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
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
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
'控件转换
Select Case Type
@@ -132,9 +137,7 @@
For Each Data As Object In Stack.Tag
Select Case Type
Case 0
Dim VersionItem As MyListItem = CType(Data, McVersion).ToListItem
VersionItem.ContentHandler = AddressOf PageSelectRight.McVersionListContent
Stack.Children.Add(VersionItem)
Stack.Children.Add(CType(Data, McInstance).ToListItem(AddressOf PageSelectRight.McInstanceListContent))
Case 2
Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
Case 3
@@ -145,23 +148,13 @@
'不能使用 AddressOf，这导致了 #535，原因完全不明，疑似是编译器 Bug
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
Case 8
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count Then
'存在重复的名称（#1344）
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
'若存在重复的版本名，则显示文件名而非版本名（#1344）
Stack.Children.Add(CType(Data, CompFile).ToListItem(
AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
Case 9
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count Then
'存在重复的名称（#1344）
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
'若存在重复的版本名，则显示文件名而非版本名（#1344）
Stack.Children.Add(CType(Data, CompFile).ToListItem(
AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
Case 10
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
Case 11
@@ -268,7 +261,7 @@
Height = PreviousHeight
End Sub
''' <summary>
''' 通知 MyCard，控件内容已改变，需要中断动画并更新高度。
''' 通知 MyCard，控件内容已改变，需要中断动画并瞬间更新高度。
''' </summary>
Public Sub TriggerForceResize()
Height = If(IsSwapped, SwapedHeight, Double.NaN)
@@ -282,7 +275,7 @@
'若设置了 CanSwap，或 SwapControl 不为空，则判定为会进行折叠
'这是因为不能直接在 XAML 中设置 SwapControl
Public SwapControl As Object
Public SwapControl As FrameworkElement
Public Property CanSwap As Boolean = False
''' <summary>
''' 被折叠的种类，用于控件虚拟化。
Plain Craft Launcher 2/Controls/MyHint.xaml.vb
+1 -1
View File
@@ -102,7 +102,7 @@ Public Class MyHint
If CanClose AndAlso Setup.Get(RelativeSetup) Then Visibility = Visibility.Collapsed
End Sub
Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
Setup.Set(RelativeSetup, True)
Setup.SetSafe(RelativeSetup, True)
AniDispose(Me, False)
End Sub
Plain Craft Launcher 2/Controls/MyImage.vb
+10 -18
View File
@@ -85,8 +85,8 @@
If _ActualSource = value Then Return
_ActualSource = value
Try
Dim Bitmap As MyBitmap = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取，尽量避免在 UI 线程中读取文件
RunInUiWait(Sub() MyBase.Source = Bitmap)
Dim Bitmap As ImageSource = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取，尽量避免在 UI 线程中读取文件
RunInUi(Sub() MyBase.Source = Bitmap)
Catch ex As Exception
Log(ex, $"加载图片失败（{value}）")
Try
@@ -112,29 +112,24 @@
End If
'从缓存加载网络图片
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)
If EnableCache AndAlso TempFile.Exists Then
ActualSource = TempPath
ActualSource = TempPath '显示缓存的图片
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
Else
ActualSource = LoadingSource '显示加载中图片
End If
RunInNewThread(
Sub()
Dim IsLocalFallback As Boolean = Not String.IsNullOrEmpty(FallbackSource) AndAlso Not FallbackSource.StartsWithF("http")
Try
'下载
ActualSource = LoadingSource '显示加载中的占位图片
NetDownloadByLoader(
If(FallbackSource?.StartsWithF("http"), {Source, FallbackSource}, {Source}),
If(FallbackSource?.StartsWithF("http") AndAlso Source <> FallbackSource, {Source, FallbackSource}, {Source}),
TempPath, SimulateBrowserHeaders:=True)
If EnableCache Then
'保存缓存并显示
RunInUi(Sub() ActualSource = TempPath)
Else
'直接显示
RunInUiWait(Sub() ActualSource = TempPath)
File.Delete(TempPath)
End If
ActualSource = TempPath
If Not EnableCache Then File.Delete(TempPath)
Catch ex As Exception
Try
If TempPath IsNot Nothing Then File.Delete(TempPath)
@@ -143,7 +138,7 @@
'加载本地备用图片
If IsLocalFallback Then
Try
RunInUiWait(Sub() ActualSource = FallbackSource)
ActualSource = FallbackSource
Log(ex, $"下载图片失败，使用本地备用图片（{Source}）")
Return
Catch exx As Exception
@@ -156,8 +151,5 @@
End Try
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
End Sub
Public Shared Function GetTempPath(Url As String) As String
Return $"{PathTemp}MyImage\{GetHash(Url)}.png"
End Function
End Class
Plain Craft Launcher 2/Controls/MyListItem.xaml.vb
+2 -1
View File
@@ -396,6 +396,7 @@ Public Class MyListItem
Dim CheckedCount As Integer = 0
'收集控件列表与选中个数
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
RadioboxList.Add(Control)
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
'菜单虚拟化检测
If ContentHandler IsNot Nothing Then
ContentHandler(sender, e)
ContentHandler(Me, e)
ContentHandler = Nothing
End If
'判断当前颜色
Plain Craft Launcher 2/Controls/MyMsg/MyMsgSelect.xaml.vb
+3 -1
View File
@@ -21,7 +21,9 @@
ShapeLine.StrokeThickness = GetWPFSize(1)
'添加选择控件
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)
AddHandler Selection.Check, AddressOf OnChecked
If TypeOf Selection Is MyListItem Then
Plain Craft Launcher 2/Controls/MyPageLeft.vb
+1
View File
@@ -30,6 +30,7 @@
Dim AniList As New List(Of AniData)
Dim Id As Integer = 0, Delay As Integer = 0
For Each Element As FrameworkElement In GetAllAnimControls(True)
Element = MyVirtualizingElement.TryInit(Element)
If Element.Visibility = Visibility.Collapsed Then
'还原之前的隐藏动画可能导致的改变（#2436）
Element.Opacity = 1
Plain Craft Launcher 2/Controls/MyPageRight.vb
+3 -3
View File
@@ -135,7 +135,7 @@
TriggerEnterAnimation(PanAlways, If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then
PageState = PageStates.LoaderWait
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid)
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
Else 'PageLoader.State = LoadState.Failed
PageState = PageStates.LoaderEnter
TriggerEnterAnimation(PanAlways, PanLoader)
@@ -147,7 +147,7 @@
TriggerEnterAnimation(If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then
PageState = PageStates.LoaderWait
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid)
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
Else 'PageLoader.State = LoadState.Failed
PageState = PageStates.LoaderEnter
TriggerEnterAnimation(PanLoader)
@@ -378,7 +378,7 @@
End If
'结束
AniList.Add(AaCode(Sub() PageOnEnterAnimationFinished(),, True))
AniStart(AniList, "PageRight PageChange " & PageUuid)
AniStart(AniList, "PageRight PageChange " & PageUuid, True)
End Sub
'逐个退出动画
Plain Craft Launcher 2/Controls/MyVirtualizingElement.vb
+70
View File
@@ -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
Plain Craft Launcher 2/FormMain.xaml.vb
+67 -52
View File
@@ -11,6 +11,11 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#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
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：如果版本设置了自定义描述，会在标题后面以淡灰色显示其版本号"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "新增：支持为一个控件设置多个自定义事件"))
@@ -113,27 +118,37 @@ Public Class FormMain
'3：BUG+ IMP* FEAT-
'2：BUG* IMP-
'1：BUG-
If LastVersion < 375 Then 'Snapshot 2.11.2
If LastVersion < 377 Then 'Snapshot 2.12.0
If LastVersion >= 373 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：对联机进行了各种各样的优化，以改善稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：若有加入者的网络环境比房主更好，会提示可以让那位加入者担任房主"))
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 += 31
BugCount += 27
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
BugCount += 4
End If
If LastVersion < 374 Then 'Snapshot 2.11.1
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)(2, "优化：若复制了邀请码，则可以直接快速加入房间"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：关闭 PCL 时总是会提示是否退出联机，防止在关闭 PCL 时无意地关闭或退出了房间"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增：允许自定义要连接的节点"))
End If
'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)(2, "优化：若复制了邀请码，则可以直接快速加入房间"))
' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：关闭 PCL 时总是会提示是否退出联机，防止在关闭 PCL 时无意地关闭或退出了房间"))
' FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增：允许自定义要连接的节点"))
'End If
FeatureCount += 9
BugCount += 7
End If
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
BugCount += 10
End If
@@ -725,9 +740,9 @@ Public Class FormMain
'按 ESC 返回上一级
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
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Return
End If
'更改功能隐藏可见性
@@ -772,12 +787,12 @@ Public Class FormMain
'切回窗口
Private Sub FormMain_Activated() Handles Me.Activated
Try
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
If PageCurrent = PageType.InstanceSetup AndAlso PageCurrentSub = PageSubType.InstanceMod Then
'Mod 管理自动刷新
FrmVersionMod.ReloadModList()
ElseIf PageCurrent = PageType.VersionSelect Then
FrmInstanceMod.ReloadModList()
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
Catch ex As Exception
Log(ex, "切回窗口时出错", LogLevel.Feedback)
@@ -851,36 +866,36 @@ Public Class FormMain
Hint($"输入的 Authlib 验证服务器不符合网址格式（{AuthlibServer}）！", HintType.Red)
Return
End If
Dim TargetVersion = If(PageCurrent = PageType.VersionSetup, PageVersionLeft.Version, McVersionCurrent)
If TargetVersion Is Nothing Then
Dim Target = If(PageCurrent = PageType.InstanceSetup, PageInstanceLeft.Instance, McInstanceSelected)
If Target Is Nothing Then
Hint("请先下载游戏，再设置第三方登录！", HintType.Red)
Return
End If
If AuthlibServer = "https://littleskin.cn/api/yggdrasil" Then
'LittleSkin
If MyMsgBox($"是否要在版本 {TargetVersion.Name} 中开启 LittleSkin 登录？" & vbCrLf &
If MyMsgBox($"是否要在版本 {Target.Name} 中开启 LittleSkin 登录？" & vbCrLf &
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Return
End If
Setup.Set("VersionServerLogin", 4, Version:=TargetVersion)
Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Version:=TargetVersion)
Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Version:=TargetVersion)
Setup.Set("VersionServerAuthName", "LittleSkin 登录", Version:=TargetVersion)
Setup.Set("VersionServerLogin", 4, Instance:=Target)
Setup.Set("VersionServerAuthServer", "https://littleskin.cn/api/yggdrasil", Instance:=Target)
Setup.Set("VersionServerAuthRegister", "https://littleskin.cn/auth/register", Instance:=Target)
Setup.Set("VersionServerAuthName", "LittleSkin 登录", Instance:=Target)
Else
'第三方 Authlib 服务器
If MyMsgBox($"是否要在版本 {TargetVersion.Name} 中开启第三方登录？" & vbCrLf &
If MyMsgBox($"是否要在版本 {Target.Name} 中开启第三方登录？" & vbCrLf &
$"登录服务器：{AuthlibServer}" & vbCrLf & vbCrLf &
"你可以在 版本设置 → 设置 → 服务器选项 中修改登录方式。", "第三方登录开启确认", "确定", "取消") = 2 Then
Return
End If
Setup.Set("VersionServerLogin", 4, Version:=TargetVersion)
Setup.Set("VersionServerAuthServer", AuthlibServer, Version:=TargetVersion)
Setup.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Version:=TargetVersion)
Setup.Set("VersionServerAuthName", "", Version:=TargetVersion)
Setup.Set("VersionServerLogin", 4, Instance:=Target)
Setup.Set("VersionServerAuthServer", AuthlibServer, Instance:=Target)
Setup.Set("VersionServerAuthRegister", AuthlibServer.Replace("api/yggdrasil", "auth/register"), Instance:=Target)
Setup.Set("VersionServerAuthName", "", Instance:=Target)
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
'正在主页，需要刷新左边栏
FrmLaunchLeft.RefreshPage(True, False)
@@ -953,7 +968,7 @@ Public Class FormMain
Return
End If
'安装 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，总之试一试
Log("[System] 文件为压缩包，尝试作为整合包安装")
@@ -1086,7 +1101,7 @@ Public Class FormMain
''' <summary>
''' 版本选择。这是一个副页面。
''' </summary>
VersionSelect = 5
InstanceSelect = 5
''' <summary>
''' 下载管理。这是一个副页面。
''' </summary>
@@ -1094,7 +1109,7 @@ Public Class FormMain
''' <summary>
''' 版本设置。这是一个副页面。
''' </summary>
VersionSetup = 7
InstanceSetup = 7
''' <summary>
''' 资源工程详情。这是一个副页面。
''' </summary>
@@ -1124,23 +1139,23 @@ Public Class FormMain
OtherHelp = 0
OtherAbout = 1
OtherTest = 2
VersionOverall = 0
VersionSetup = 1
VersionMod = 2
VersionModDisabled = 3
VersionExport = 4
InstanceOverall = 0
InstanceSetup = 1
InstanceMod = 2
InstanceModDisabled = 3
InstanceExport = 4
End Enum
''' <summary>
''' 获取次级页面的名称。若并非次级页面则返回空字符串，故可以以此判断是否为次级页面。
''' </summary>
Private Function PageNameGet(Stack As PageStackData) As String
Select Case Stack.Page
Case PageType.VersionSelect
Case PageType.InstanceSelect
Return "版本选择"
Case PageType.DownloadManager
Return "下载管理"
Case PageType.VersionSetup
Return "版本设置 - " & If(PageVersionLeft.Version Is Nothing, "未知版本", PageVersionLeft.Version.Name)
Case PageType.InstanceSetup
Return "版本设置 - " & If(PageInstanceLeft.Instance Is Nothing, "未知版本", PageInstanceLeft.Instance.Name)
Case PageType.CompDetail
Return "资源下载 - " & CType(Stack.Additional(0), CompProject).TranslatedName
Case PageType.HelpDetail
@@ -1186,9 +1201,9 @@ Public Class FormMain
Case PageType.Other
If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
Return FrmOtherLeft.PageID
Case PageType.VersionSetup
If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft
Return FrmVersionLeft.PageID
Case PageType.InstanceSetup
If FrmInstanceLeft Is Nothing Then FrmInstanceLeft = New PageInstanceLeft
Return FrmInstanceLeft.PageID
Case Else
Return 0 '没有子页面
End Select
@@ -1262,9 +1277,9 @@ Public Class FormMain
Else
'切换到次页面
Select Case Stack.Page
Case PageType.VersionSetup
If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft
CType(FrmVersionLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
Case PageType.InstanceSetup
If FrmInstanceLeft Is Nothing Then FrmInstanceLeft = New PageInstanceLeft
CType(FrmInstanceLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
End Select
PageChangeActual(Stack, SubType)
End If
@@ -1356,7 +1371,7 @@ Public Class FormMain
Case PageType.Other '更多
If FrmOtherLeft Is Nothing Then FrmOtherLeft = New PageOtherLeft
PageChangeAnim(FrmOtherLeft, FrmOtherLeft.PageGet(SubType))
Case PageType.VersionSelect '版本选择
Case PageType.InstanceSelect '版本选择
If FrmSelectLeft Is Nothing Then FrmSelectLeft = New PageSelectLeft
If FrmSelectRight Is Nothing Then FrmSelectRight = New PageSelectRight
PageChangeAnim(FrmSelectLeft, FrmSelectRight)
@@ -1364,9 +1379,9 @@ Public Class FormMain
If FrmSpeedLeft Is Nothing Then FrmSpeedLeft = New PageSpeedLeft
If FrmSpeedRight Is Nothing Then FrmSpeedRight = New PageSpeedRight
PageChangeAnim(FrmSpeedLeft, FrmSpeedRight)
Case PageType.VersionSetup '版本设置
If FrmVersionLeft Is Nothing Then FrmVersionLeft = New PageVersionLeft
PageChangeAnim(FrmVersionLeft, FrmVersionLeft.PageGet(SubType))
Case PageType.InstanceSetup '版本设置
If FrmInstanceLeft Is Nothing Then FrmInstanceLeft = New PageInstanceLeft
PageChangeAnim(FrmInstanceLeft, FrmInstanceLeft.PageGet(SubType))
Case PageType.CompDetail 'Mod 信息
If FrmDownloadCompDetail Is Nothing Then FrmDownloadCompDetail = New PageDownloadCompDetail
PageChangeAnim(New MyPageLeft, FrmDownloadCompDetail)
Plain Craft Launcher 2/Modules/Base/ModAnimation.vb
+1 -1
View File
@@ -840,7 +840,7 @@ Sleeper:
Public Sub AniTimer(DeltaTick As Integer)
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
'循环每个动画组
Do While i + 1 < AniGroups.Count
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+84 -24
View File
@@ -14,13 +14,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.11.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.11.2." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.12.0" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.12.0." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 372 'Release
#Else
Public Const VersionCode As Integer = 375 'Snapshot
Public Const VersionCode As Integer = 377 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -1211,14 +1211,17 @@ Re:
Public Class FileChecker
''' <summary>
''' 文件的准确大小。
''' 不检查则为 -1。
''' </summary>
Public ActualSize As Long = -1
''' <summary>
''' 文件的最小大小。
''' 不检查则为 -1。
''' </summary>
Public MinSize As Long = -1
''' <summary>
''' 文件的 MD5、SHA1 或 SHA256。会根据输入字符串的长度自动判断种类。
''' 不检查则为 Nothing。
''' </summary>
Public Hash As String = Nothing
''' <summary>
@@ -1226,7 +1229,8 @@ Re:
''' </summary>
Public CanUseExistsFile As Boolean = True
''' <summary>
''' 是否为 Json 文件。
''' 是否要求为 JSON 文件。
''' 即，开头结尾必须为 {} 或 []。
''' </summary>
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)
@@ -1429,6 +1433,7 @@ RetryDir:
If Ex Is Nothing Then Return "无可用错误信息！"
'获取最底层的异常
Dim OuterEx As Exception = Ex
Dim InnerEx As Exception = Ex
Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException
@@ -1452,7 +1457,7 @@ RetryDir:
Loop
'构造输出信息
Dim UsualReason As String = AnalyzeUsualReason(InnerEx, Ex, DescList)
Dim UsualReason As String = AnalyzeUsualReason(InnerEx, OuterEx, DescList)
If UsualReason Is Nothing Then
Return DescList.Join(vbCrLf)
Else
@@ -1466,6 +1471,7 @@ RetryDir:
If Ex Is Nothing Then Return "无可用错误信息！"
'获取最底层的异常
Dim OuterEx As Exception = Ex
Dim InnerEx As Exception = Ex
Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException
@@ -1481,7 +1487,7 @@ RetryDir:
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
Return UsualReason & "详细错误：" & DescList.First
Else
@@ -1580,16 +1586,6 @@ RetryDir:
Return Mid(Str.PadRight(Length, Code), Str.Length + 1) & Str
End Function
''' <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>
Public Function StrTrim(Str As String, Optional RemoveQuote As Boolean = True)
@@ -1964,7 +1960,7 @@ RetryDir:
Function(Source) Source.Key.Replace(" ", "").ContainsF(QueryPart, True)))
Next
'按照相似度进行排序
Entries = Entries.Sort(
Entries = Entries.SortByComparison(
Function(Left, Right) As Boolean
If Left.AbsoluteRight Xor Right.AbsoluteRight Then
Return Left.AbsoluteRight
@@ -2031,7 +2027,7 @@ RetryDir:
Implements IDictionary(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)
'构造函数
@@ -2229,6 +2225,19 @@ RetryDir:
Return CultureInfo.CurrentCulture.Name.StartsWithF("zh-") OrElse CultureInfo.CurrentUICulture.Name.StartsWithF("zh-")
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 UuidLock As Object
''' <summary>
@@ -2256,7 +2265,7 @@ RetryDir:
Next i
End Function
''' <summary>
''' 数组去重。
''' 去重。
''' </summary>
<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)
@@ -2272,6 +2281,15 @@ NextElement:
<Extension> Public Function Any(Arr As UIElementCollection) As Boolean
Return Arr?.Count > 0
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>
''' 获取格式类似于“11:08:52.037”的当前时间的字符串。
@@ -2494,10 +2512,46 @@ NextElement:
End Sub
''' <summary>
''' 按照既定的函数进行选择排序。
''' 传入两个对象，若第一个对象应该排在前面，则返回 True。
''' 选择最大值对应的对象。
''' 若没有元素则返回 Nothing。
''' </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)
While List.Any
Dim Highest = List(0)
@@ -2769,19 +2823,25 @@ Retry:
''' <summary>
''' 将 XML 转换为对应 UI 对象。
''' 注意：性能较差，不应大量使用。
''' </summary>
Public Function GetObjectFromXML(Str As XElement)
Return GetObjectFromXML(Str.ToString)
End Function
''' <summary>
''' 将 XML 转换为对应 UI 对象。
''' 注意：性能较差，不应大量使用。
''' </summary>
Public Function GetObjectFromXML(Str As String) As Object
Str = Str. '兼容旧版自定义事件写法
Replace("EventType=""", "local:CustomEventService.EventType=""").
Replace("EventData=""", "local:CustomEventService.EventData=""").
Replace("EventType='", "local:CustomEventService.EventType='").
Replace("EventData='", "local:CustomEventService.EventData='").
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 Reader As New XamlXmlReader(Stream)
@@ -3114,7 +3174,7 @@ Retry:
"操作系统：" & My.Computer.Info.OSFullName & "（32 位：" & Is32BitSystem & "）" & 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 &
"MC 文件夹：" & If(PathMcFolder, "Nothing") & vbCrLf &
"MC 文件夹：" & If(McFolderSelected, "Nothing") & vbCrLf &
"文件位置：" & Path)
End Sub
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+244 -190
View File
@@ -242,7 +242,7 @@ RequestFinished:
If Header.Key.ToLower = "content-type" Then
Request.Content?.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
Else
Request.Headers.Add(Header.Key, Header.Value)
Request.Headers.TryAddWithoutValidation(Header.Key, Header.Value)
End If
Next
SecretHeadersSign(Url, Request, SimulateBrowserHeaders)
@@ -257,7 +257,7 @@ RequestFinished:
'延迟初始化，以避免在程序启动前加载 CacheCow 导致 DLL 加载失败
If RequestClient Is Nothing Then
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
})
End If
@@ -308,15 +308,25 @@ RequestFinished:
''' 若解析失败，则返回 Nothing。
''' </summary>
Private Function DNSLookup(Request As HttpRequestMessage, CancelToken As CancellationTokenSource) As String
Dim GetIPReliability = Function(Key) IPReliability.GetOrDefault(Key.ToString, 0)
'初步 DNS 解析
'若一分钟内已失败过，则不再重复尝试解析，以减少断网时的 Exception 数量
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
Try
DnsTask = Dns.GetHostAddressesAsync(Host)
DnsTask.Wait(CancelToken.Token)
Catch ex As Exception
Log(ex, $"DNS 解析失败（{Host}）")
DNSFailureRecord(Host) = Date.Now
Return Nothing
End Try
Dim Candidates As IPAddress() = DnsTask.Result.ToArray
@@ -325,6 +335,7 @@ RequestFinished:
Return Nothing
End If
'若同时存在 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 IPv6Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetworkV6).ToArray
If IPv4Targets.Any AndAlso IPv6Targets.Any Then
@@ -347,6 +358,7 @@ RequestFinished:
End If
Return TargetIp
End Function
Private DNSFailureRecord As New SafeDictionary(Of String, Date)
''' <summary>
''' 记录每个 IP 地址的请求可靠度。
''' 通常取值 -1 ~ +0.5，越高越好。未尝试过的 IP 应视为 0。
@@ -387,7 +399,7 @@ RequestFinished:
#Region "多线程下载引擎"
Private ThreadClient As New HttpClient(New HttpClientHandler With {
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None
.AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip
})
''' <summary>
@@ -407,7 +419,6 @@ RequestFinished:
''' </summary>
Public NetTaskSpeedLimitLeft As Long = -1
Private ReadOnly NetTaskSpeedLimitLeftLock As New Object
Private NetTaskSpeedLimitLeftLast As Long
''' <summary>
''' 正在运行中的线程数。
''' </summary>
@@ -438,39 +449,35 @@ RequestFinished:
''' <summary>
''' 尚未进行已存在检查。
''' </summary>
WaitForCheck = -1
WaitingToCheck = -1
''' <summary>
''' 尚未开始。
''' </summary>
WaitForDownload = 0
WaitingToDownload = 0
''' <summary>
''' 正在连接，尚未获取文件大小。
''' </summary>
Connect = 1
Connecting = 1
''' <summary>
''' 已获取文件大小，尚未有有效下载。
''' 已连接，正在尝试接收首个下载数据包。
''' </summary>
[Get] = 2
Reading = 2
''' <summary>
''' 正在下载。
''' </summary>
Download = 3
Downloading = 3
''' <summary>
''' 正在合并文件。
''' </summary>
Merge = 4
''' <summary>
''' 不进行下载，因为已发现现存的文件。
''' </summary>
WaitForCopy = 5
Merging = 4
''' <summary>
''' 已完成。
''' </summary>
Finish = 6
Finished = 5
''' <summary>
''' 已失败或中断。
''' </summary>
[Error] = 7
Interrupted = 6
End Enum
''' <summary>
''' 预下载检查行为。
@@ -612,13 +619,13 @@ RequestFinished:
''' <summary>
''' 当前线程的状态。
''' </summary>
Public State As NetState = NetState.WaitForDownload
Public State As NetState = NetState.WaitingToDownload
''' <summary>
''' 是否已经结束。
''' </summary>
Public ReadOnly Property IsEnded As Boolean
Get
Return State = NetState.Finish OrElse State = NetState.Error
Return State = NetState.Finished OrElse State = NetState.Interrupted
End Get
End Property
@@ -716,7 +723,7 @@ RequestFinished:
''' <summary>
''' 当前的下载状态。
''' </summary>
Public State As NetState = NetState.WaitForCheck
Public State As NetState = NetState.WaitingToCheck
''' <summary>
''' 导致下载失败的原因。
''' </summary>
@@ -741,7 +748,7 @@ RequestFinished:
''' </summary>
Public ReadOnly Property IsNoSplit As Boolean
Get
Return IsUnknownSize OrElse FileSize < FilePieceLimit
Return IsUnknownSize OrElse FileSize < 1024 * 1024 '小于 1MB 的文件不分割
End Get
End Property
''' <summary>
@@ -797,24 +804,22 @@ RequestFinished:
Public ReadOnly Property Progress As Double
Get
Select Case State
Case NetState.WaitForCheck
Case NetState.WaitingToCheck
Return 0
Case NetState.WaitForCopy
Return 0.2
Case NetState.WaitForDownload
Case NetState.WaitingToDownload
Return 0.01
Case NetState.Connect
Case NetState.Connecting
Return 0.02
Case NetState.Get
Case NetState.Reading
Return 0.04
Case NetState.Download
Case NetState.Downloading
'正在下载中，对应 5% ~ 98%
Dim OriginalProgress As Double = If(IsUnknownSize, 0.5, DownloadDone / Math.Max(FileSize, 1))
OriginalProgress = 1 - (1 - OriginalProgress) ^ 0.9
Return OriginalProgress * 0.93 + 0.05
Case NetState.Merge
Case NetState.Merging
Return 0.99
Case NetState.Finish, NetState.Error
Case NetState.Finished, NetState.Interrupted
Return 1
Case Else
Throw New ArgumentOutOfRangeException("文件状态未知：" & State)
@@ -859,7 +864,7 @@ RequestFinished:
''' 新建一个需要下载的文件。
''' </summary>
''' <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 Count As Integer = 0
Urls = Urls.Distinct.ToArray
@@ -869,7 +874,7 @@ RequestFinished:
Next
Me.Sources = Sources
Me.LocalPath = LocalPath
Me.Check = Check
Me.Check = Checker
Me.SimulateBrowserHeaders = SimulateBrowserHeaders
Me.LocalName = GetFileNameFromPath(LocalPath)
End Sub
@@ -886,10 +891,10 @@ RequestFinished:
'条件检测
SyncLock LockSource
If NetTaskThreadCount >= NetTaskThreadLimit OrElse Not HasAvailableSource() OrElse
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Interrupted) Then Return Nothing
If State >= NetState.Merging OrElse State = NetState.WaitingToCheck Then Return Nothing
SyncLock LockState
If State < NetState.Connect Then State = NetState.Connect
If State < NetState.Connecting Then State = NetState.Connecting
End SyncLock
'初始化参数
'获取线程起点与下载源
@@ -897,10 +902,10 @@ RequestFinished:
If IsNoSplit Then GoTo StartSingleThreadDownload
'只剩下单线程可用点
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:
Reset()
State = NetState.Get
State = NetState.Reading
End If
End SyncLock
SyncLock LockChain
@@ -913,7 +918,7 @@ StartSingleThreadDownload:
End If
'寻找失败点
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
StartSource = GetSource(Thread.Source.Id + 1)
GoTo StartThread
@@ -942,7 +947,7 @@ StartThread:
Dim ThreadUuid As Integer = GetUuid()
If Not Tasks.Any() Then Return Nothing '由于中断，已没有可用任务
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
Threads = ThreadInfo
@@ -981,8 +986,8 @@ StartThread:
CancelToken As CancellationTokenSource = Nothing, HostIp As String = Nothing
'部分下载源真的特别慢，并且只需要一个请求，例如 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)
Th.State = NetState.Connect
Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 10000) * (1 + Th.Source.FailCount), 30000)
Th.State = NetState.Connecting
Try
Dim HttpDataCount As Integer = 0
If SourcesOnce.Contains(Th.Source) AndAlso Th <> Th.Source.SingleThread Then GoTo SourceBreak
@@ -994,7 +999,7 @@ StartThread:
Dim ContentLength As Long = 0
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 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}")
'文件大小校验
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}")
End If
'Log($"[Download] {LocalName} {Info.Uuid}#：通过大小检查，文件大小 {FileSize}，起始点 {Info.DownloadStart}，ContentLength {ContentLength}")
Th.State = NetState.Get
Th.State = NetState.Reading
SyncLock LockState
If State < NetState.Get Then State = NetState.Get
If State < NetState.Reading Then State = NetState.Reading
End SyncLock
'创建缓存文件
If IsNoSplit Then
@@ -1065,7 +1070,7 @@ NotSupportRange:
Dim ResponseBytes As Byte() = New Byte(16384) {}
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
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
Threading.Thread.Sleep(16)
@@ -1080,9 +1085,9 @@ NotSupportRange:
'有数据
If Th.DownloadDone = 0 Then
'第一次接受到数据
Th.State = NetState.Download
Th.State = NetState.Downloading
SyncLock LockState
If State < NetState.Download Then State = NetState.Download
If State < NetState.Downloading Then State = NetState.Downloading
End SyncLock
SyncLock LockCount
ConnectCount += 1
@@ -1116,16 +1121,16 @@ NotSupportRange:
HttpDataCount = ResponseStream.ReadAsync(ResponseBytes, 0, 16384, CancelToken.Token).GetResultWithTimeout(CancelToken, Timeout)
End While
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}：中断")
ElseIf HttpDataCount = 0 AndAlso Th.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
'服务器无返回数据
Throw New Exception($"返回的 ContentLength 过多：ContentLength 为 {ContentLength}，但获取到的总数据量仅为 {Th.DownloadDone}（全文件总数据量 {DownloadDone}）")
Else
'本线程完成
Th.State = NetState.Finish
Th.State = NetState.Finished
If ModeDebug Then Log($"[Download] {LocalName}：完成，已下载 {Th.DownloadDone}（{Th.DownloadStart}~{Th.DownloadEnd}）")
RecordIPReliability(HostIp, 0.5)
End If
@@ -1147,7 +1152,7 @@ SourceBreak:
End SyncLock
'合并
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 Sub
Private Sub SourceFail(Th As NetThread, ex As Exception, IsMergeFailure As Boolean)
@@ -1158,7 +1163,7 @@ SourceBreak:
Task.FailCount += 1
Next
End SyncLock
Th.State = NetState.Error
Th.State = NetState.Interrupted
Th.Source.Ex = ex
'根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传）
Dim IsRangeNotSupported As Boolean = TypeOf ex Is RangeNotSupportedException OrElse ex.Message.Contains("(416)")
@@ -1202,13 +1207,13 @@ SourceBreak:
End SyncLock
Reset()
SyncLock LockState
State = NetState.WaitForDownload
State = NetState.WaitingToDownload
End SyncLock
ElseIf HasAvailableSource() AndAlso IsMergeFailure Then
'合并失败且单个源失败：继续下一个源
Reset()
SyncLock LockState
State = NetState.WaitForDownload
State = NetState.WaitingToDownload
End SyncLock
Else
'失败
@@ -1251,8 +1256,8 @@ SourceBreak:
Private Sub Merge(Th As NetThread)
'状态判断
SyncLock LockState
If State < NetState.Merge Then
State = NetState.Merge
If State < NetState.Merging Then
State = NetState.Merging
Else
Return
End If
@@ -1323,7 +1328,11 @@ Retry:
GoTo Retry
End If
'失败，禁用当前下载源并重启下载
If File.Exists(LocalPath) Then File.Delete(LocalPath)
Try
If File.Exists(LocalPath) Then File.Delete(LocalPath)
Catch exx As Exception
Log(ex, $"删除合并失败的文件出错（{LocalPath}）")
End Try
SourceFail(Th, ex, True)
Finally
Cache?.Dispose()
@@ -1334,10 +1343,10 @@ Retry:
''' </summary>
Private Sub Fail(Optional RaiseEx As Exception = Nothing)
SyncLock LockState
If State >= NetState.Finish Then Return
If State >= NetState.Finished Then Return
If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
'凉凉
State = NetState.Error
State = NetState.Interrupted
End SyncLock
AbortInternal()
For Each Task In Tasks
@@ -1353,8 +1362,8 @@ Retry:
If Tasks.Any Then Return
'确认中断
SyncLock LockState
If State >= NetState.Finish Then Return
State = NetState.Error
If State >= NetState.Finished Then Return
State = NetState.Interrupted
End SyncLock
AbortInternal()
End Sub
@@ -1373,8 +1382,8 @@ Retry:
''' </summary>
Public Sub Finish(Optional PrintLog As Boolean = True)
SyncLock LockState
If State >= NetState.Finish Then Return
State = NetState.Finish
If State >= NetState.Finished Then Return
State = NetState.Finished
End SyncLock
SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1
@@ -1483,20 +1492,10 @@ FinishExCatch:
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)
'去重
Dim ResultArray As New SafeList(Of NetFile)
For i = 0 To Files.Count - 1
For ii = i + 1 To Files.Count - 1
If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement
Next
ResultArray.Add(Files(i))
NextElement:
Next
Files = ResultArray
Files = New SafeList(Of NetFile)(Files.Distinct(Function(a, b) a.LocalPath = b.LocalPath))
'设置剩余文件数
SyncLock FileRemainLock
For Each File In Files
If File.State <> NetState.Finish Then FileRemain += 1
Next
FileRemain += Files.Where(Function(f) f.State <> NetState.Finished).Count
End SyncLock
State = LoadState.Loading
'开始执行
@@ -1517,109 +1516,162 @@ NextElement:
End If
Next
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 File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径：" & File.LocalPath)
'文件夹检测
Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
Directory.CreateDirectory(GetPathFromFullPath(File.LocalPath)) '创建目标文件夹
Next
'接入下载管理器
NetManager.Start(Me)
'将文件分配给多个线程以进行已存在查找
Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表
Dim FoldersFinal As New List(Of String) '最终用于查找的列表
If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里
For Each Folder In McFolderList
Folders.Add(Folder.Path)
Next
Folders = 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)
'====================================
' 已存在文件查找
'====================================
'整理允许进行查找的文件
Dim FilesToCheck As New List(Of NetFile)
Dim DisabledCopy As Boolean = Setup.Get("SystemDebugSkipCopy") '在设置中禁用了复制
For Each File In Files
FilesInThread.Add(File)
If FilesInThread.Count = FilesPerThread Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "下载 文件复制 " & Uuid)
FilesInThread.Clear()
If Not DisabledCopy AndAlso File.Check?.CanUseExistsFile Then
FilesToCheck.Add(File)
Else '不允许，直接开始下载
SyncLock LockState
File.State = NetState.WaitingToDownload
File.IsCopy = False
End SyncLock
End If
Next
If FilesInThread.Any Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "下载 文件复制 " & Uuid)
FilesInThread.Clear()
If Not FilesToCheck.Any Then Return
'获取 MC 文件夹列表
Dim Folders As New List(Of String)
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里
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
Catch ex As Exception
OnFail(New List(Of Exception) From {ex})
OnFail(New List(Of Exception) From {New Exception("下载初始化失败", ex)})
End Try
End Sub, "L/下载 " & Uuid)
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
If ModeDebug Then Log($"[Download] 检查线程分配文件数：{Files.Count}，线程名：{Thread.CurrentThread.Name}")
'试图从已存在的 Minecraft 文件夹中寻找目标文件
Dim ExistFiles As New List(Of KeyValuePair(Of NetFile, String)) '{NetFile, Target As String}
For Each File As NetFile In Files
Dim ExistFilePath As String = Nothing
'判断是否有已存在的文件
If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso
File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWithF(PathMcFolder) Then
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
If ModeDebug Then Log($"[Download] 文件检查线程已启动，分配的文件数：{Files.Count}")
'列出 MC 文件夹中的各个版本文件夹
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
'若存在，则改变状态
SyncLock LockState
If ExistFilePath IsNot Nothing Then
File.State = NetState.WaitForCopy
File.IsCopy = True
ExistFiles.Add(New KeyValuePair(Of NetFile, String)(File, ExistFilePath))
Else
File.State = NetState.WaitForDownload
File.IsCopy = False
End If
End SyncLock
Next
'复制已存在的文件
For Each FileToken In ExistFiles
Dim File As NetFile = FileToken.Key
SyncLock LockState
If File.State > NetState.WaitForCopy Then Return
End SyncLock
Dim LocalPath As String = FileToken.Value
Dim RetryCount As Integer = 0
'处理每个文件
For Each File As NetFile In Files
Dim Target As String = CheckExistingFile(FolderList, VersionFolders, File)
If File.State >= NetState.WaitingToDownload Then Return '中断
If Target Is Nothing Then
'未找到相同文件
SyncLock LockState
File.State = NetState.WaitingToDownload
File.IsCopy = False
End SyncLock
Else
'已找到相同文件
File.IsCopy = True
Dim RetryCount As Integer = 0
Retry:
Try
Log("[Download] 复制已存在的文件（" & LocalPath & "）")
CopyFile(LocalPath, File.LocalPath)
File.Finish(False)
Catch ex As Exception
RetryCount += 1
Log(ex, $"复制已存在的文件失败，重试第 {RetryCount} 次（{LocalPath} -> {File.LocalPath}）")
If RetryCount < 3 Then
Thread.Sleep(200)
GoTo Retry
End If
File.State = NetState.WaitForDownload
File.IsCopy = False
End Try
Try
If Target <> File.LocalPath Then
Log($"[Download] 复制已存在的文件：{Target} → {File.LocalPath}")
CopyFile(Target, File.LocalPath)
End If
File.Finish(False)
Catch ex As Exception
RetryCount += 1
Log(ex, $"复制已存在的文件失败，第 {RetryCount} 次重试（{Target} → {File.LocalPath}）")
If RetryCount < 3 Then
Thread.Sleep(200)
GoTo Retry
End If
'失败，回退到下载
SyncLock LockState
File.State = NetState.WaitingToDownload
File.IsCopy = False
End SyncLock
End Try
End If
Next
Catch ex As Exception
Log(ex, "下载已存在文件查找失败", LogLevel.Feedback)
OnFail(New List(Of Exception) From {New Exception("下载已存在文件查找失败", ex)})
End Try
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)
'要求全部文件完成
@@ -1655,7 +1707,7 @@ Retry:
[Error] = If(UsefulExs.FirstOrDefault, ExList.FirstOrDefault)
'获取实际失败的文件
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
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 &
@@ -1736,14 +1788,6 @@ Retry:
Public FileRemain As Integer = 0
Public ReadOnly LockRemain As New Object
''' <summary>
''' 上次记速时的已下载大小。
''' </summary>
Private SpeedLastDone As Long = 0
''' <summary>
''' 至多最近 30 次下载速度的记录，较新的在前面。
''' </summary>
Private SpeedLast As New List(Of Long)
'这些属性由 RefreshStat 刷新
''' <summary>
''' 当前的全局下载速度，单位为 Byte / 秒。
@@ -1764,6 +1808,8 @@ Retry:
RefreshStatLast += DeltaTime
#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))
SpeedLast.Insert(0, ActualSpeed)
If SpeedLast.Count >= 31 Then SpeedLast.RemoveAt(30)
@@ -1799,8 +1845,9 @@ Retry:
''' 启动监控线程，用于新增下载线程。
''' </summary>
Private Sub StartManager()
If IsManagerStarted Then Return
IsManagerStarted = True
Static IsStarted As Boolean = False
If IsStarted Then Return
IsStarted = True
Dim ThreadStarter =
Sub(Id As Integer) '0 或 1
Try
@@ -1816,9 +1863,9 @@ Retry:
Dim OngoingFiles As New List(Of NetFile)
For Each File As NetFile In AllFiles
If File.Uuid Mod 2 = Id Then Continue For
If File.State = NetState.WaitForDownload Then
If File.State = NetState.WaitingToDownload Then
WaitingFiles.Add(File)
ElseIf File.State < NetState.Merge Then
ElseIf File.State < NetState.Merging Then
OngoingFiles.Add(File)
End If
Next
@@ -1826,7 +1873,7 @@ Retry:
For Each File As NetFile In WaitingFiles
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
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
'为进行中的文件追加线程
If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够，无需新增
@@ -1836,9 +1883,9 @@ Retry:
Dim PreparingCount = 0, DownloadingCount = 0
If File.Threads IsNot Nothing Then
For Each Thread As NetThread In File.Threads.ToList
If Thread.State < NetState.Download Then
If Thread.State < NetState.Downloading Then
PreparingCount += 1
ElseIf Thread.State = NetState.Download Then
ElseIf Thread.State = NetState.Downloading Then
DownloadingCount += 1
End If
Next
@@ -1846,7 +1893,7 @@ Retry:
'新增线程
If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程，不再新增
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
End While
Catch ex As Exception
@@ -1858,27 +1905,26 @@ Retry:
RunInNewThread(
Sub()
Try
Dim LastLoopTime As Long
NetTaskSpeedLimitLeftLast = GetTimeTick()
Dim NextTick As Long = GetTimeTick()
While True
Dim TimeNow = GetTimeTick()
LastLoopTime = TimeNow
'增加限速余量
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 1000 * (TimeNow - NetTaskSpeedLimitLeftLast)
NetTaskSpeedLimitLeftLast = TimeNow
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 10
'刷新公开属性
RefreshStat()
'等待直至 80 ms
Do While GetTimeTick() - LastLoopTime < 80
Thread.Sleep(10)
Loop
'等待 100 ms
NextTick += 100
Dim SleepTime = NextTick - GetTimeTick()
If SleepTime > 0 Then
Thread.Sleep(SleepTime)
Else
NextTick = GetTimeTick() '超时，直接追帧，不等待
End If
End While
Catch ex As Exception
Log(ex, "下载管理刷新线程出错", LogLevel.Critical)
End Try
End Sub, "NetManager StatRefresher")
End Sub
Private IsManagerStarted As Boolean = False
Private DownloadCacheLock As New Object
Private IsDownloadCacheCleared As Boolean = False
@@ -1907,7 +1953,7 @@ Retry:
Dim File = Task.Files(i)
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)
@@ -1915,7 +1961,7 @@ Retry:
SyncLock LockRemain
FileRemain += 1
End SyncLock
If ModeDebug Then Log($"[Download] {File.LocalName}：重新加入下载列表")
If ModeDebug Then Log($"[Download] {File.LocalName}：重新加入下载列表，目标 {File.LocalPath}")
Else
'该文件正在下载中
'将当前文件替换成下载中的文件，即两个任务指向同一个文件
@@ -1929,7 +1975,7 @@ Retry:
SyncLock LockRemain
FileRemain += 1
End SyncLock
If ModeDebug Then Log($"[Download] {File.LocalName}：已加入下载列表")
If ModeDebug Then Log($"[Download] {File.LocalName}：已加入下载列表，目标 {File.LocalPath}")
End If
Task.Files(i) = File '回设
Next
@@ -2017,7 +2063,15 @@ Retry:
''' 判断某个 Exception 是否为网络问题所导致。
''' </summary>
<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
Return {
"(408)", "超时", "timeout", "网络请求失败", "连接尝试失败", "远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称",
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
+18 -15
View File
@@ -4,11 +4,6 @@ Imports System.Drawing.Imaging
Public Class MyBitmap
''' <summary>
''' 位图缓存。
''' </summary>
Public Shared BitmapCache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
''' <summary>
''' 存储的图片
''' </summary>
@@ -30,14 +25,17 @@ Public Class MyBitmap
End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource
If Image Is Nothing Then Return Nothing
Dim Bitmap = Image.Pic
Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height)
Dim bitmapData = Bitmap.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
Dim BitmapPic As System.Drawing.Bitmap = Image.Pic
Dim rect = New System.Drawing.Rectangle(0, 0, BitmapPic.Width, BitmapPic.Height)
Dim bitmapData = BitmapPic.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
Try
Dim size = rect.Width * rect.Height * 4
Return BitmapSource.Create(Bitmap.Width, Bitmap.Height, Bitmap.HorizontalResolution, Bitmap.VerticalResolution, PixelFormats.Bgra32, Nothing, bitmapData.Scan0, size, bitmapData.Stride)
Dim Result = BitmapSource.Create(BitmapPic.Width, BitmapPic.Height, BitmapPic.HorizontalResolution, BitmapPic.VerticalResolution,
PixelFormats.Bgra32, Nothing, bitmapData.Scan0,
rect.Width * rect.Height * 4, bitmapData.Stride)
Result.Freeze()
Return Result
Finally
Bitmap.UnlockBits(bitmapData)
BitmapPic.UnlockBits(bitmapData)
End Try
End Operator
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)
If FilePathOrResourceName.StartsWithF(PathImage) Then
'使用缓存
If BitmapCache.ContainsKey(FilePathOrResourceName) Then
Pic = BitmapCache(FilePathOrResourceName).Pic
Static Cache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
If Cache.ContainsKey(FilePathOrResourceName) Then
Pic = Cache(FilePathOrResourceName).Pic
Else
Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource))
BitmapCache.TryAdd(FilePathOrResourceName, Pic)
Cache.TryAdd(FilePathOrResourceName, Pic)
End If
Else
'使用这种自己接管 FileStream 的方法加载才能解除文件占用
@@ -92,7 +91,11 @@ Public Class MyBitmap
Pic = My.Application.TryFindResource(FilePathOrResourceName)
If Pic Is Nothing Then
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
Log(ex, $"指定类型有误的 MyBitmap 加载（{FilePathOrResourceName}）", LogLevel.Developer)
Exit Try
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+164 -146
View File
@@ -177,13 +177,15 @@
''' </summary>
Public ReadOnly Tags As List(Of String)
''' <summary>
''' Logo 图片的下载地址。若为 Nothing 则没有。
''' Logo 图片的下载地址。
''' 若为 Nothing 则没有，保证不为空字符串。
''' </summary>
Public LogoUrl As String = Nothing
''' <summary>
''' 游戏大版本列表。例如：18, 16, 15……
''' 支持的 Drop 编号，从高到低排序，不为 Nothing。
''' 例如：261（26.1.x）、180（1.18.x）。
''' </summary>
Public ReadOnly GameVersions As List(Of Integer)
Public ReadOnly Drops As List(Of Integer)
'数据库信息
@@ -249,10 +251,10 @@
End If
Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList
If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl")
If Data.ContainsKey("GameVersions") Then
GameVersions = CType(Data("GameVersions"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
If Data.ContainsKey("Drops") Then
Drops = CType(Data("Drops"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
Else
GameVersions = New List(Of Integer)
Drops = New List(Of Integer)
End If
#End Region
Else
@@ -274,6 +276,7 @@
LogoUrl = Data("logo")("thumbnailUrl")
End If
End If
If LogoUrl = "" Then LogoUrl = Nothing
'Type
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
Type = CompType.Mod
@@ -288,7 +291,7 @@
Else
Type = CompType.DataPack
End If
'FileIndexes / GameVersions / ModLoaders
'FileIndexes / VanillaMajorVersions / ModLoaders
ModLoaders = New List(Of CompModLoaderType)
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
For Each File In If(Data("latestFiles"), New JArray)
@@ -296,17 +299,16 @@
If Not NewFile.Available Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders)
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))
Next
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))
Next
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")).
Select(Function(v) CInt(Val(v.Split(".")(1).BeforeFirst("-")))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
Drops = Files.SelectMany(Function(f) f.Value).
Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v > 0).Distinct.OrderByDescending(Function(v) v).ToList
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Tags
Tags = New List(Of String)
@@ -333,6 +335,8 @@
Case 424 : Tags.Add("装饰")
Case 411 : Tags.Add("生物")
Case 434 : Tags.Add("装备")
Case 6814 : Tags.Add("性能优化")
Case 9026 : Tags.Add("创造模式")
Case 423 : Tags.Add("信息显示")
Case 435 : Tags.Add("服务器")
Case 5191 : Tags.Add("改良")
@@ -399,10 +403,8 @@
Website = $"https://modrinth.com/{Data("project_type")}/{Slug}"
'GameVersions
'搜索结果的键为 versions，获取特定工程的键为 game_versions
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")).
Select(Of Integer)(Function(v) Val(v.Split(".")(1).BeforeFirst("-"))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
Drops = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v > 0).Distinct.OrderByDescending(Function(v) v).ToList
'Type
Select Case Data("project_type").ToString
Case "modpack" : Type = CompType.ModPack
@@ -523,58 +525,60 @@
Json("DownloadCount") = DownloadCount
If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
Json("Tags") = New JArray(Tags)
If Not String.IsNullOrEmpty(LogoUrl) Then Json("LogoUrl") = LogoUrl
If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If Drops.Any Then Json("Drops") = New JArray(Drops)
Json("CacheTime") = Date.Now '用于检查缓存时间
Return Json
End Function
''' <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
If GameVersions Is Nothing OrElse Not GameVersions.Any() Then
If Drops Is Nothing OrElse Not Drops.Any() Then
GameVersionDescription = "仅快照版本" '#5412
Else
Dim SpaVersions As New List(Of String)
Dim Segments As New List(Of String)
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)
If StartVersion < 10 Then '如果支持新版本，则不显示 1.9-
If SpaVersions.Any() AndAlso Not IsOld Then
Dim StartDrop As Integer = Drops(i), EndDrop As Integer = Drops(i)
If StartDrop < 100 Then '如果支持新版本，则不显示 1.9-
If Segments.Any() AndAlso Not IsOld Then
Exit For
Else
IsOld = True
End If
End If
For ii = i + 1 To GameVersions.Count - 1
If GameVersions(ii) <> EndVersion - 1 Then Exit For
EndVersion = GameVersions(ii)
For ii = i + 1 To Drops.Count - 1
If AllDrops Is Nothing OrElse AllDrops.IndexOf(Drops(ii)) <> AllDrops.IndexOf(EndDrop) + 1 Then Exit For
EndDrop = Drops(ii)
i = ii
Next
'将版本号段转为描述文本
If StartVersion = EndVersion Then
SpaVersions.Add("1." & StartVersion)
ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then
If EndVersion < 10 Then
SpaVersions.Clear()
SpaVersions.Add("全版本")
Dim StartName = McVersion.DropToVersion(StartDrop)
Dim EndName = McVersion.DropToVersion(EndDrop)
If StartDrop = EndDrop Then
Segments.Add(StartName)
ElseIf AllDrops?.Any AndAlso StartDrop >= AllDrops.First Then
If EndDrop < 100 Then
Segments.Clear()
Segments.Add("全版本")
Exit For
Else
SpaVersions.Add("1." & EndVersion & "+")
Segments.Add(EndName & "+")
End If
ElseIf EndVersion < 10 Then
SpaVersions.Add("1." & StartVersion & "-")
ElseIf EndDrop < 100 Then
Segments.Add(StartName & "-")
Exit For
ElseIf StartVersion - EndVersion = 1 Then
SpaVersions.Add("1." & StartVersion & ", 1." & EndVersion)
ElseIf AllDrops Is Nothing OrElse AllDrops.IndexOf(EndDrop) - AllDrops.IndexOf(StartDrop) = 1 Then
Segments.Add(StartName & ", " & EndName)
Else
SpaVersions.Add("1." & StartVersion & "~1." & EndVersion)
Segments.Add(StartName & "~" & EndName)
End If
Next
GameVersionDescription = SpaVersions.Join(", ")
GameVersionDescription = Segments.Join(", ")
End If
'获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
@@ -593,11 +597,11 @@
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
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
(MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso
(MaxVersion < 20 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso
(MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then
(NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso
(NewestDrop < 200 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso
(NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
Else
@@ -606,55 +610,60 @@
End If
End Select
'实例化 UI
Dim NewItem As New MyCompItem With {.Tag = Me, .Logo = GetControlLogo()}
Dim Title = GetControlTitle(True)
NewItem.Title = Title.Key
If Title.Value = "" Then
CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
Else
NewItem.SubTitle = Title.Value
End If
NewItem.Tags = Tags
NewItem.Description = Description.Replace(vbCr, "").Replace(vbLf, "")
'下边栏
If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then
'全部隐藏
CType(NewItem.PathVersion.Parent, Grid).Children.Remove(NewItem.PathVersion)
CType(NewItem.LabVersion.Parent, Grid).Children.Remove(NewItem.LabVersion)
NewItem.ColumnVersion1.Width = New GridLength(0)
NewItem.ColumnVersion2.MaxWidth = 0
NewItem.ColumnVersion3.Width = New GridLength(0)
ElseIf ShowMcVersionDesc AndAlso ShowLoaderDesc Then
'全部显示
NewItem.LabVersion.Text = If(ModLoaderDescriptionPart = "", "", ModLoaderDescriptionPart & " ") & GameVersionDescription
ElseIf ShowMcVersionDesc Then
'仅显示版本
NewItem.LabVersion.Text = GameVersionDescription
Else
'仅显示 Mod 加载器
NewItem.LabVersion.Text = ModLoaderDescriptionFull
End If
NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth")
If LastUpdate IsNot Nothing Then
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
Else
NewItem.LabTime.Visibility = Visibility.Collapsed
NewItem.ColumnTime1.Width = New GridLength(0)
NewItem.ColumnTime2.Width = New GridLength(0)
NewItem.ColumnTime3.Width = New GridLength(0)
End If
NewItem.LabDownload.Text =
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
Return NewItem
Return New MyVirtualizingElement(Of MyCompItem)(
Function()
Dim NewItem As New MyCompItem With {.Tag = Me}
ApplyLogoToMyImage(NewItem.PathLogo)
Dim Title = GetControlTitle(True)
NewItem.Title = Title.Key
If Title.Value = "" Then
CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
Else
NewItem.SubTitle = Title.Value
End If
NewItem.Tags = Tags
NewItem.Description = Description.Replace(vbCr, "").Replace(vbLf, "")
'下边栏
If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then
'全部隐藏
CType(NewItem.PathVersion.Parent, Grid).Children.Remove(NewItem.PathVersion)
CType(NewItem.LabVersion.Parent, Grid).Children.Remove(NewItem.LabVersion)
NewItem.ColumnVersion1.Width = New GridLength(0)
NewItem.ColumnVersion2.MaxWidth = 0
NewItem.ColumnVersion3.Width = New GridLength(0)
ElseIf ShowMcVersionDesc AndAlso ShowLoaderDesc Then
'全部显示
NewItem.LabVersion.Text = If(ModLoaderDescriptionPart = "", "", ModLoaderDescriptionPart & " ") & GameVersionDescription
ElseIf ShowMcVersionDesc Then
'仅显示版本
NewItem.LabVersion.Text = GameVersionDescription
Else
'仅显示 Mod 加载器
NewItem.LabVersion.Text = ModLoaderDescriptionFull
End If
NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth")
If LastUpdate IsNot Nothing Then
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
Else
NewItem.LabTime.Visibility = Visibility.Collapsed
NewItem.ColumnTime1.Width = New GridLength(0)
NewItem.ColumnTime2.Width = New GridLength(0)
NewItem.ColumnTime3.Width = New GridLength(0)
End If
NewItem.LabDownload.Text =
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
Return NewItem
End Function) With {.Height = 64}
End Function
Public Function GetControlLogo() As String
Public Sub ApplyLogoToMyImage(Img As MyImage)
If String.IsNullOrEmpty(LogoUrl) Then
Return PathImage & "Icons/NoIcon.png"
Img.Source = PathImage & "Icons/NoIcon.png"
Else
Return LogoUrl
Img.Source = LogoUrl
Img.FallbackSource = DlSourceModGet(LogoUrl)
End If
End Function
End Sub
Public Function GetControlTitle(HasModLoaderDescription As Boolean) As KeyValuePair(Of String, String)
'检查下列代码时可以参考 #1567 的测试例
Dim Title As String = RawName
@@ -755,7 +764,7 @@ NoSubtitle:
'Mod 加载器一致
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
'若不为光影，则要求 MC 版本一致
If Type <> CompType.Shader AndAlso (GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any()) Then Return False
If 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
Math.Abs((LastUpdate - Project.LastUpdate).Value.TotalDays) > 7 Then Return False
@@ -967,7 +976,7 @@ NoSubtitle:
#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)
End If
@@ -1060,7 +1069,7 @@ Retry:
'在 1.14-，部分老 Mod 没有设置支持的加载器，因此添加 Forge 筛选就会出现遗漏
'所以，在发起请求时不筛选加载器，然后在返回的结果中自行筛除不是 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
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress()
Dim ModrinthUrl As String = Request.GetModrinthAddress()
@@ -1176,9 +1185,9 @@ Retry:
#Region "提取非重复项，存储于 RealResults"
'将 Modrinth 排在 CurseForge 的前面，避免加载结束顺序不同导致排名不同
'这样做的话，去重后将优先保留 CurseForge 内容
RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList
'将 CurseForge 排在 Modrinth 的前面，避免加载结束顺序不同导致排名不同
'这样做的话，去重后将优先保留 Modrinth 的内容
RawResults = RawResults.Where(Function(x) x.FromCurseForge).Concat(RawResults.Where(Function(x) Not x.FromCurseForge)).ToList
'RawResults 去重
RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b))
'已有内容去重
@@ -1292,11 +1301,16 @@ Retry:
''' </summary>
Public ReadOnly DownloadCount As Integer
''' <summary>
''' Mod 版本号。
''' 不一定是标准格式。CurseForge 上默认为 Nothing。
''' </summary>
Public Version As String
''' <summary>
''' 支持的 Mod 加载器列表。可能为空。
''' </summary>
Public ReadOnly ModLoaders As List(Of CompModLoaderType)
''' <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>
Public ReadOnly GameVersions As List(Of String)
''' <summary>
@@ -1369,6 +1383,7 @@ Retry:
FromCurseForge = Data("FromCurseForge").ToObject(Of Boolean)
Id = Data("Id").ToString
DisplayName = Data("DisplayName").ToString
If Data.ContainsKey("Version") Then Version = Data("Version").ToString
ReleaseDate = Data("ReleaseDate").ToObject(Of Date)
DownloadCount = Data("DownloadCount").ToObject(Of Integer)
Status = CType(Data("Status").ToObject(Of Integer), CompFileStatus)
@@ -1387,6 +1402,7 @@ Retry:
'简单信息
Id = Data("id")
DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
Version = Nothing
ReleaseDate = Data("fileDate")
Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
DownloadCount = Data("downloadCount")
@@ -1408,9 +1424,9 @@ Retry:
End If
'GameVersions
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
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)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
@@ -1429,6 +1445,7 @@ Retry:
'简单信息
Id = Data("id")
DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ")
Version = Data("version_number")
ReleaseDate = Data("date_published")
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads")
@@ -1467,15 +1484,15 @@ Retry:
End If
'GameVersions
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
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)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then
'无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
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]")).ToList
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
@@ -1504,6 +1521,7 @@ Retry:
Dim Json As New JObject
Json.Add("FromCurseForge", FromCurseForge)
Json.Add("Id", Id)
If Version IsNot Nothing Then Json.Add("Version", Version)
Json.Add("DisplayName", DisplayName)
Json.Add("ReleaseDate", ReleaseDate)
Json.Add("DownloadCount", DownloadCount)
@@ -1521,56 +1539,56 @@ Retry:
''' 将当前文件信息实例化为控件。
''' </summary>
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 Info As New List(Of String)
If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast("."))
If Dependencies.Any Then Info.Add(Dependencies.Count & " 项前置")
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
Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
End If
Info.Add("更新于 " & GetTimeSpanString(ReleaseDate - Date.Now, False))
If Status <> CompFileStatus.Release Then Info.Add(StatusDescription)
'获取描述信息
Dim Title As String = If(BadDisplayName, FileName, DisplayName)
Dim Info As New List(Of String)
If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast("."))
If Dependencies.Any Then Info.Add(Dependencies.Count & " 项前置")
If GameVersions.All(Function(v) Not IsVersionNameLikeRelease(v)) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
End If
Info.Add("更新于 " & GetTimeSpanString(ReleaseDate - Date.Now, False))
If Status <> CompFileStatus.Release Then Info.Add(StatusDescription)
'建立控件
Dim NewItem As New MyListItem With {
.Title = Title,
.SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
.Info = Info.Join("，")
}
Select Case Status
Case CompFileStatus.Release
NewItem.Logo = PathImage & "Icons/R.png"
Case CompFileStatus.Beta
NewItem.Logo = PathImage & "Icons/B.png"
Case Else 'Alpha
NewItem.Logo = PathImage & "Icons/A.png"
End Select
AddHandler NewItem.Click, OnClick
'建立控件
Dim NewItem As New MyListItem With {
.Title = Title,
.SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
.Info = Info.Join("，")
}
Select Case Status
Case CompFileStatus.Release
NewItem.Logo = PathImage & "Icons/R.png"
Case CompFileStatus.Beta
NewItem.Logo = PathImage & "Icons/B.png"
Case Else 'Alpha
NewItem.Logo = PathImage & "Icons/A.png"
End Select
AddHandler NewItem.Click, OnClick
'建立另存为按钮
If OnSaveClick IsNot Nothing Then
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnSave, 30)
ToolTipService.SetHorizontalOffset(BtnSave, 2)
AddHandler BtnSave.Click, OnSaveClick
NewItem.Buttons = {BtnSave}
End If
'结束
Return NewItem
'建立另存为按钮
If OnSaveClick IsNot Nothing Then
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnSave, 30)
ToolTipService.SetHorizontalOffset(BtnSave, 2)
AddHandler BtnSave.Click, OnSaveClick
NewItem.Buttons = {BtnSave}
End If
Return NewItem
End Function) With {.Height = 42}
End Function
'辅助函数
Public Overrides Function ToString() As String
Return $"{Id}: {FileName}"
End Function
End Class
'获取
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+7 -7
View File
@@ -2,9 +2,9 @@
'构造函数
Private TempFolder As String
Private TargetVersion As McVersion
Public Sub New(Optional TargetVersion As McVersion = Nothing)
Me.TargetVersion = TargetVersion
Private TargetInstance As McInstance
Public Sub New(Optional TargetInstance As McInstance = Nothing)
Me.TargetInstance = TargetInstance
'构建文件结构
TempFolder = RequestTaskTempFolder()
Directory.CreateDirectory(TempFolder & "Temp\")
@@ -391,7 +391,7 @@ Extracted:
''' <summary>
''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。
''' </summary>
Public Sub Analyze(Optional Version As McVersion = Nothing)
Public Sub Analyze()
Log("[Crash] 步骤 3：分析崩溃原因")
LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "")
@@ -538,7 +538,7 @@ Done:
'确定的 Mod 导致崩溃
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'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 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))
@@ -607,7 +607,7 @@ Done:
Return True
End If
'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失败,
TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
Return True
@@ -926,7 +926,7 @@ NextStack:
'上报
If IsManualAnalyze Then Return
Telemetry("Minecraft 崩溃",
"Version", If(TargetVersion Is Nothing, "null", TargetVersion.Version.ToString),
"Version", If(TargetInstance Is Nothing, "null", TargetInstance.VersionDisplayName),
"Detail", FilterUserName(Detail, "*"))
End Sub
''' <summary>
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+159 -120
View File
@@ -6,40 +6,40 @@
''' 返回某 Minecraft 版本对应的原版主 Jar 文件的下载信息，要求对应依赖版本已存在。
''' 失败则抛出异常，不需要下载则返回 Nothing。
''' </summary>
Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile
Public Function DlClientJarGet(Instance As McInstance, ReturnNothingOnFileUseable As Boolean) As NetFile
'获取底层继承版本
Try
Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Version = New McVersion(Version.InheritVersion)
Do While Not String.IsNullOrEmpty(Instance.InheritName)
Instance = New McInstance(Instance.InheritName)
Loop
Catch ex As Exception
Log(ex, "获取底层继承版本失败")
End Try
'检查 Json 是否标准
If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then
Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息")
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("底层版本 " & Instance.Name & " 中无 jar 文件下载信息")
End If
'检查文件
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1"))
If ReturnNothingOnFileUseable AndAlso Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
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(Instance.PathVersion & Instance.Name & ".jar") Is Nothing Then Return Nothing '通过校验
'返回下载信息
Dim JarUrl As String = Version.JsonObject("downloads")("client")("url")
Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker)
Dim JarUrl As String = Instance.JsonObject("downloads")("client")("url")
Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Instance.PathVersion & Instance.Name & ".jar", Checker)
End Function
''' <summary>
''' 返回某 Minecraft 版本对应的原版主 AssetIndex 文件的下载信息，要求对应依赖版本已存在。
''' 若未找到，则会返回 Legacy 资源文件或 Nothing。
''' </summary>
Public Function DlClientAssetIndexGet(Version As McVersion) As NetFile
Public Function DlClientAssetIndexGet(Instance As McInstance) As NetFile
'获取底层继承版本
Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Version = New McVersion(Version.InheritVersion)
Do While Not String.IsNullOrEmpty(Instance.InheritName)
Instance = New McInstance(Instance.InheritName)
Loop
'获取信息
Dim IndexInfo = McAssetsGetIndex(Version, True, True)
Dim IndexAddress As String = PathMcFolder & "assets\indexes\" & IndexInfo("id").ToString & ".json"
Log("[Download] 版本 " & Version.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString)
Dim IndexInfo = McAssetsGetIndex(Instance, True, True)
Dim IndexAddress As String = McFolderSelected & "assets\indexes\" & IndexInfo("id").ToString & ".json"
Log("[Download] 版本 " & Instance.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString)
Dim IndexUrl As String = If(IndexInfo("url"), "")
If IndexUrl = "" Then
Return Nothing
@@ -51,12 +51,12 @@
''' <summary>
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
''' </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)
#Region "下载支持库文件"
Dim LoadersLib As New List(Of LoaderBase) From {
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
New 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}
}
'构造加载器
@@ -64,7 +64,7 @@
#End Region
#Region "下载资源文件"
If ShouldIgnoreFileCheck(Version) Then
If ShouldIgnoreFileCheck(Instance) Then
Log("[Download] 已跳过所有 Assets 检查")
Else
Dim LoadersAssets As New List(Of LoaderBase)
@@ -72,10 +72,10 @@
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim IndexFile = DlClientAssetIndexGet(Version)
Dim IndexFile = DlClientAssetIndexGet(Instance)
If IndexFile Is Nothing Then
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
Task.Output = New List(Of NetFile)
Else
@@ -94,9 +94,9 @@
Dim RealAddress As String = Nothing
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
If BackAssetsFile Is Nothing Then
Log("[Download] 未找到版本 " & Version.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
Task.Abort()
Throw New ThreadInterruptedException
End If
@@ -121,14 +121,12 @@
Updater.Start()
End If
'获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("获取资源文件列表",
Sub(Task) Task.Output = McAssetsFixList(Instance, CheckAssetsHash, Task)) With {.ProgressWeight = 0.01})
'下载资源文件
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 Region
@@ -153,6 +151,23 @@
#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(","c).Select(Function(d) CInt(d)).ToList()
If Not _AllDrops.Any Then _AllDrops = Nothing
Return _AllDrops
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
''' <summary>
@@ -167,10 +182,6 @@
''' 获取到的 Json 数据。
''' </summary>
Public Value As JObject
'''' <summary>
'''' 官方源的失败原因。若没有则为 Nothing。
'''' </summary>
'Public OfficialError As Exception
End Structure
''' <summary>
''' Minecraft 客户端 版本列表，主加载器。
@@ -195,6 +206,12 @@
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
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
'各个下载源的分加载器
@@ -202,8 +219,6 @@
''' Minecraft 客户端 版本列表，Mojang 官方源加载器。
''' </summary>
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private IsNewClientVersionHinted As Boolean = False
Private ReadOnly HintLock As New Object() ' 线程安全锁
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim StartTime As Long = GetTimeTick()
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
@@ -220,29 +235,25 @@
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
'解析更新提示（Release）
Dim Version As String = Json("latest")("release")
If Setup.Get("ToolUpdateRelease") AndAlso Not Setup.Get("ToolUpdateReleaseLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateReleaseLast") = Version Then
SyncLock HintLock
If Not IsNewClientVersionHinted Then ' 在锁内再次检查
McDownloadClientUpdateHint(Version, Json)
IsNewClientVersionHinted = True
End If
End SyncLock
End If
McVersionHighest = Version.Split(".")(1)
Setup.Set("ToolUpdateReleaseLast", Version)
'解析更新提示（Snapshot）
'MC 更新提示
Static IsHinted As Boolean = False
Dim Version As String
'快照版
Version = Json("latest")("snapshot")
If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = Version Then
SyncLock HintLock
If Not IsNewClientVersionHinted Then ' 在锁内再次检查
McDownloadClientUpdateHint(Version, Json)
IsNewClientVersionHinted = True
End If
End SyncLock
If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso
Setup.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json)
End If
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
Throw New Exception("Minecraft 官方源版本列表解析失败", ex)
End Try
@@ -329,15 +340,15 @@
''' <summary>
''' 显示名称，已去除 HD_U 字样，如“1.12.2 C8”。
''' </summary>
Public NameDisplay As String
Public DisplayName As String
''' <summary>
''' 原始文件名称，如“preview_OptiFine_1.11_HD_U_E1_pre.jar”。
''' </summary>
Public NameFile As String
Public FileName As String
''' <summary>
''' 对应的版本名称，如“1.13.2-OptiFine_HD_U_E6”。
''' </summary>
Public NameVersion As String
Public InstanceName As String
''' <summary>
''' 是否为测试版。
''' </summary>
@@ -409,14 +420,14 @@
For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
.DisplayName = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.FileName = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
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)
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
@@ -435,15 +446,15 @@
Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "",
.IsPreview = Token("patch").ToString.ContainsF("pre", True),
.Inherit = Token("mcversion").ToString,
.NameFile = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
}
.DisplayName = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "",
.IsPreview = Token("patch").ToString.ContainsF("pre", True),
.Inherit = Token("mcversion").ToString,
.FileName = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
}
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)
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
@@ -503,7 +514,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)
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 不会被匹配上
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）")
Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names}
@@ -514,11 +525,10 @@
''' </summary>
Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding:=Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）")
'获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?")
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）")
Dim Result As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
Encoding:=Encoding.Default, RequireJson:=True))
Dim Names As List(Of String) = Result.Select(Function(v) v.ToString).ToList
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足")
Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names}
End Sub
@@ -527,60 +537,47 @@
#Region "DlForgeVersion | Forge 版本列表"
Public MustInherit Class DlForgelikeEntry
Implements IComparable(Of DlForgelikeEntry)
Public IsNeoForge As Boolean
''' <summary>
''' 加载器名称。Forge 或 NeoForge。
''' </summary>
Public ReadOnly Property LoaderName As String
Get
Return If(IsNeoForge, "NeoForge", "Forge")
End Get
End Property
Public MustOverride ReadOnly Property LoaderName As String
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public 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
Public MustOverride ReadOnly Property FileExtension As String
''' <summary>
''' Forge：MC 版本是否小于 1.13。
''' 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>
''' 标准化后的版本号，仅可用于比较与排序。
''' 标准化后的版本号，仅可用于比较与排序，且 NeoForge 项不包含 alpha/beta 编号！
''' 格式：Major.Minor.Build.Revision
''' Forge：如 “50.1.9.0”（最后一位固定为 0）、“14.22.1.2478”（Legacy）。
''' NeoForge：如 “20.4.30.0”（最后一位固定为 0）、“19.47.1.99”（Legacy：第一位固定为 19）。
''' </summary>
Public Version As Version
''' <summary>
''' 可对玩家显示的非格式化版本名。
''' 可读的非格式化版本名。
''' Forge：如 “50.1.9”、“14.22.1.2478”（Legacy）。
''' NeoForge：如 “20.4.30-beta”、“47.1.99”（Legacy）。
''' </summary>
Public VersionName As String
''' <summary>
''' 对应的 Minecraft 版本，如“1.12.2”。
''' 对应的 Minecraft 版本，如 1.12.2、26.1-snapshot-1。
''' </summary>
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
Public Class DlForgeVersionEntry
Inherits DlForgelikeEntry
''' <summary>
''' 发布时间，格式为“yyyy/MM/dd HH:mm”。
''' </summary>
@@ -602,6 +599,23 @@
''' </summary>
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)
'司马版本的特殊处理
If Version = "11.15.1.2318" OrElse Version = "11.15.1.1902" OrElse Version = "11.15.1.1890" Then Branch = "1.8.9"
@@ -613,6 +627,7 @@
Me.Inherit = Inherit
FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
End Sub
End Class
''' <summary>
@@ -651,7 +666,7 @@
".html", SimulateBrowserHeaders:=True)
Catch ex As Exception
If ex.GetBrief().Contains("(404)") Then
Throw New Exception("不可用")
Throw New Exception("无")
Else
Throw
End If
@@ -709,7 +724,7 @@
Catch ex As Exception
Throw New Exception("Forge 官方源版本列表解析失败（" & Result & "）", ex)
End Try
If Not Versions.Any() Then Throw New Exception("不可用")
If Not Versions.Any() Then Throw New Exception("无")
Loader.Output = Versions
End Sub
@@ -718,7 +733,7 @@
''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4，#4057
Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4，#4057
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -763,7 +778,7 @@
Catch ex As Exception
Throw New Exception("Forge BMCLAPI 版本列表解析失败（" & Json.ToString & "）", ex)
End Try
If Not Versions.Any() Then Throw New Exception("不可用")
If Not Versions.Any() Then Throw New Exception("无")
Loader.Output = Versions
End Sub
@@ -788,6 +803,7 @@
Public Class DlNeoForgeListEntry
Inherits DlForgelikeEntry
''' <summary>
''' 是否是 Beta 版。
''' </summary>
@@ -801,11 +817,28 @@
''' </summary>
Public ReadOnly Property UrlBase As String
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}"
End Get
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)
IsNeoForge = True
Me.ApiName = ApiName
@@ -816,12 +849,18 @@
Inherit = "1.20.1"
ElseIf ApiName.StartsWith("0.") Then '0.25w14craftmine.3-beta
VersionName = ApiName
Version = New Version("0.0." & ApiName.BeforeFirst("-").AfterFirst(".").AfterFirst(".") & ".0") 'Minor 里有字母，但 Version 类的 Minor 是 Int 类型，只能这样写了
Inherit = ApiName.BeforeFirst("-").AfterFirst(".").BeforeFirst(".")
Else '20.4.30-beta
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
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 Sub
End Class
@@ -888,12 +927,12 @@
Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry)
Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson,
"(?<="")(?:(1\.20\.1-)?\d+\.\d+\.\d+|0\.[^.]+\.\d+)(-beta)?(?="")") '我寻思直接正则就行.jpg
"(?<="")(1\.20\.1-)?\d+\.[^\.]+\.\d+(\.\d+)?(-(beta|alpha)(\.\d+)?)?(\+snapshot-\d+)?(?="")")
Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中，但不能下载
Select(Function(name) New DlNeoForgeListEntry(name)).ToList
If Not Versions.Any() Then Throw New Exception("不可用")
Versions = Versions.OrderByDescending(Function(a) a.Version).ToList
Select(Function(name) New DlNeoForgeListEntry(name)).
OrderByDescending(Function(a) a).ToList
If Not Versions.Any() Then Throw New Exception("无")
Return Versions
End Function
@@ -1308,7 +1347,7 @@
For ii = 0 To LoaderList.Count - 1
LoaderList(ii).Key.Input = Nothing '重置输入，以免以同样的输入“重试加载”时直接失败
If LoaderList(ii).Key.Error IsNot Nothing Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("不可用") Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message = "无" Then
ErrorInfo = LoaderList(ii).Key.Error
End If
End If
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+50 -59
View File
@@ -35,7 +35,7 @@
''' <summary>
''' Java 的大版本号。
''' </summary>
Public ReadOnly Property VersionCode As Integer
Public ReadOnly Property MajorVersion As Integer
Get
Return Version.Minor
End Get
@@ -71,7 +71,7 @@
Public Overrides Function ToString() As String
Dim VersionString = Version.ToString
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
'构造
@@ -124,7 +124,7 @@
'#3649：在 64 位系统上禁用 32 位 Java
If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本，请安装 64 位的 Java")
'#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
Throw ex
Catch ex As ThreadInterruptedException
@@ -199,19 +199,19 @@
''' 必须在工作线程调用，且必须包括 SyncLock JavaLock。
''' </summary>
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
Dim AllowedJavaList As New List(Of JavaEntry)
'添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean)
If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录或 %APPDATA% 的话）
If McFolderSelected.Split("\").Count > 3 AndAlso Not McFolderSelected.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(McFolderSelected), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录或 %APPDATA% 的话）
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")).
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)
For Each Entry In JavaPreList
TargetJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
@@ -232,8 +232,8 @@
'获取版本独立设置中指定的 Java
Dim VersionSelect As String = ""
If RelatedVersion IsNot Nothing Then
VersionSelect = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
If GameInstance IsNot Nothing Then
VersionSelect = Setup.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If VersionSelect.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
@@ -242,7 +242,7 @@
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Setup.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Log(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", LogLevel.Hint)
End Try
End If
@@ -330,8 +330,8 @@ RetryGet:
Dim Right As String = MaxVersion.Minor & If(ShowRevision, "." & MaxVersion.MajorRevision & "." & MaxVersion.MinorRevision, "")
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If
Dim JavaCurrent As String = UserJava.VersionCode & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion) Then
Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If GameInstance IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", GameInstance) Then
'直接跳过弹窗
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & "，但当前版本" & Requirement & "，这可能会导致游戏崩溃！", LogLevel.Debug)
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
@@ -372,7 +372,7 @@ ExitUserJavaCheck:
UserPass:
'对适合的 Java 进行排序
AllowedJavaList = AllowedJavaList.Sort(AddressOf JavaSorter)
AllowedJavaList = AllowedJavaList.SortByComparison(AddressOf JavaSorter)
Log($"[Java] 排序后的 Java 优先顺序：")
For Each Java In AllowedJavaList
Log($"[Java] - {Java}")
@@ -408,12 +408,12 @@ UserPass:
''' <summary>
''' 是否强制指定了 64 位 Java。如果没有强制指定，返回是否安装了 64 位 Java。
''' </summary>
Public Function JavaIs64Bit(Optional RelatedVersion As McVersion = Nothing) As Boolean
Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean
Try
'检查强制指定
Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect")
If RelatedVersion IsNot Nothing Then
Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
If GameInstance IsNot Nothing Then
Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion
End If
If UserSetup <> "" Then
@@ -422,7 +422,7 @@ UserPass:
UserJava = JavaEntry.FromJson(GetJson(UserSetup))
Catch ex As Exception
Log(ex, "版本指定的 Java 信息已损坏，已重置版本设置中指定的 Java")
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=RelatedVersion)
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance)
GoTo NoUserJava
End Try
For Each Java In JavaList
@@ -446,14 +446,14 @@ NoUserJava:
''' </summary>
Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
Dim PathInfo As New DirectoryInfo(Path)
Dim PathMcInfo As New DirectoryInfo(PathMcFolder)
Dim PathMcInfo As New DirectoryInfo(McFolderSelected)
'1. 尽量在当前文件夹或当前 Minecraft 文件夹
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
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 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 Not Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return False
End If
@@ -464,10 +464,10 @@ NoUserJava:
If Left.IsJre AndAlso Not Right.IsJre Then Return True
If Not Left.IsJre AndAlso Right.IsJre Then Return False
'4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then
If Left.MajorVersion <> Right.MajorVersion Then
' 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}
Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
Return Weight.ElementAtOrDefault(Left.MajorVersion) >= Weight.ElementAtOrDefault(Right.MajorVersion)
End If
'5. 最次级版本号更接近 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})
End Sub)
End If
If FrmVersionSetup IsNot Nothing Then
If FrmInstanceSetup IsNot Nothing Then
RunInUiWait(
Sub()
FrmVersionSetup.ComboArgumentJava.Items.Clear()
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
FrmInstanceSetup.ComboArgumentJava.Items.Clear()
FrmInstanceSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
End If
@@ -525,8 +525,8 @@ NoUserJava:
'查找启动器目录中的 Java
JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
'查找所选 Minecraft 文件夹中的 Java
If Not String.IsNullOrWhiteSpace(PathMcFolder) AndAlso Path <> PathMcFolder Then
JavaSearchFolder(PathMcFolder, JavaPreList, False, IsFullSearch:=True)
If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso Path <> McFolderSelected Then
JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
End If
'若不全为符号链接，则清除符号链接的地址
@@ -579,7 +579,7 @@ NoUserJava:
For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next
NewJavaList = JavaCheckList(NewJavaList).Sort(AddressOf JavaSorter)
NewJavaList = JavaCheckList(NewJavaList).SortByComparison(AddressOf JavaSorter)
'修改设置项
Dim AllList As New JArray
@@ -596,7 +596,7 @@ NoUserJava:
Log("[Java] Java 搜索完成，发现 " & JavaList.Count & " 个 Java")
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
''' <summary>
@@ -695,28 +695,12 @@ Wait:
#Region "下载"
''' <summary>
''' 提示 Java 缺失，并弹窗确认是否自动下载。返回玩家选择是否下载。
''' 获取下载 Java 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' </summary>
Public Function JavaDownloadConfirm(VersionDescription As String, Optional ForcedManualDownload As Boolean = False) As Boolean
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)
Public Function GetJavaDownloadLoader() As LoaderCombo(Of String)
Dim JavaDownloadLoader As New LoaderDownload("下载 Java 文件", New List(Of NetFile)) With {.ProgressWeight = 10}
Dim Loader = New LoaderCombo(Of Integer)($"下载 Java {Version}", {
New LoaderTask(Of Integer, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2},
Dim Loader = New LoaderCombo(Of String)($"下载 Java", {
New LoaderTask(Of String, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2},
JavaDownloadLoader,
JavaSearchLoader
})
@@ -733,22 +717,29 @@ Wait:
Return Loader
End Function
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 下载信息")
Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder(
{"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}
), IsJson:=True)
'获取下载地址
Dim MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项（最新）
SelectMany(Function(e As JProperty) CType(e.Value, JArray).Select(Function(v) New KeyValuePair(Of String, JObject)(e.Name, v)))
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWithF(Loader.Input))
Dim Address As String = TargetEntry.Value("manifest")("url")
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}（{TargetEntry.Key}）：{Address}")
'查找要下载的目标 Java
Dim TargetEntry As JProperty = Nothing
Dim Components As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
If Components.ContainsKey(Loader.Input) Then '精确匹配
TargetEntry = Components.Property(Loader.Input)
Else '模糊匹配
TargetEntry = Components.Properties.FirstOrDefault(
Function(c) 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)
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)
For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files")
If CType(File.Value, JObject)("downloads")?("raw") Is Nothing Then Continue For
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+207 -219
View File
@@ -18,9 +18,9 @@ Public Module ModLaunch
Public SaveBatch As String = Nothing
''' <summary>
''' 强行指定启动的 MC 版本。
''' 默认值：Nothing。使用 McVersionCurrent。
''' 默认值：Nothing。使用 McInstanceCurrent。
''' </summary>
Public Version As McVersion = Nothing
Public Instance As McInstance = Nothing
''' <summary>
''' 额外的启动参数。
''' </summary>
@@ -39,23 +39,30 @@ Public Module ModLaunch
Return False
End If
'强制切换需要启动的版本
If CurrentLaunchOptions.Version IsNot Nothing AndAlso McVersionCurrent <> CurrentLaunchOptions.Version Then
McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Version.Name)
If CurrentLaunchOptions.Instance IsNot Nothing AndAlso McInstanceSelected <> CurrentLaunchOptions.Instance Then
McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Instance.Name)
'检查版本是否存在
Try
CurrentLaunchOptions.Instance.GetJsonPath()
Catch
Hint($"无法启动 {CurrentLaunchOptions.Instance.Name}：当前 Minecraft 文件夹中尚未安装该版本！", HintType.Red)
Return False
End Try
'检查版本
CurrentLaunchOptions.Version.Load()
If CurrentLaunchOptions.Version.State = McVersionState.Error Then
Hint("无法启动 Minecraft：" & CurrentLaunchOptions.Version.Info, HintType.Red)
CurrentLaunchOptions.Instance.Load()
If CurrentLaunchOptions.Instance.State = McInstanceState.Error Then
Hint($"无法启动 {CurrentLaunchOptions.Instance.Name}：{CurrentLaunchOptions.Instance.Info}", HintType.Red)
Return False
End If
'切换版本
McVersionCurrent = CurrentLaunchOptions.Version
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
McInstanceSelected = CurrentLaunchOptions.Instance
Setup.Set("LaunchVersionSelect", McInstanceSelected.Name)
FrmLaunchLeft.RefreshButtonsUI()
FrmLaunchLeft.RefreshPage(False, False)
End If
FrmMain.AprilGiveup()
'禁止进入版本选择页面（否则就可以在启动中切换 McVersionCurrent 了）
FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.VersionSelect).ToList
'禁止进入版本选择页面（否则就可以在启动中切换 McInstanceSelected 了）
FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.InstanceSelect).ToList
'实际启动加载器
McLaunchLoader.Start(Options, IsForceRestart:=True)
Return True
@@ -109,7 +116,7 @@ Public Module ModLaunch
Dim Loaders As New List(Of LoaderBase) From {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .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 List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
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}
}
'内存优化
Select Case Setup.Get("VersionRamOptimize", Version:=McVersionCurrent)
Select Case Setup.Get("VersionRamOptimize", Instance:=McInstanceSelected)
Case 0 '全局
If Setup.Get("LaunchArgumentRam") Then '使用全局设置
CType(Loaders(2), LoaderCombo(Of String)).Block = False
@@ -140,17 +147,17 @@ Public Module ModLaunch
LoaderTaskbarAdd(LaunchLoader)
Do While LaunchLoader.State = LoadState.Loading
FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
Thread.Sleep(200)
Thread.Sleep(100)
Loop
FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
'成功与失败处理
Select Case LaunchLoader.State
Case LoadState.Finished
Hint(McVersionCurrent.Name & " 启动成功！", HintType.Green)
Hint(McInstanceSelected.Name & " 启动成功！", HintType.Green)
'上报
If Not IsSavingBatch Then
Telemetry("Minecraft 启动成功",
"Version", McVersionCurrent.Version.ToString,
"Version", McInstanceSelected.VersionDisplayName,
"LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType)))
End If
Case LoadState.Aborted
@@ -185,7 +192,7 @@ NextInner:
'上报
If Not IsSavingBatch Then
Telemetry("Minecraft 启动失败",
"Version", McVersionCurrent.Version.ToString,
"Version", McInstanceSelected.VersionDisplayName,
"LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType)),
"Exception", FilterUserName(FilterAccessToken(ex.GetDetail(), "*"), "*"))
End If
@@ -223,12 +230,12 @@ NextInner:
Private Sub McLaunchPrecheck()
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 McVersionCurrent.Path.Contains("!") OrElse McVersionCurrent.Path.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.Path & "）")
If McInstanceSelected.PathIndie.Contains("!") OrElse McInstanceSelected.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McInstanceSelected.PathIndie & "）")
If McInstanceSelected.PathVersion.Contains("!") OrElse McInstanceSelected.PathVersion.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McInstanceSelected.PathVersion & "）")
'检查版本
If McVersionCurrent Is Nothing Then Throw New Exception("未选择 Minecraft 版本！")
McVersionCurrent.Load()
If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题：" & McVersionCurrent.Info)
If McInstanceSelected Is Nothing Then Throw New Exception("未选择 Minecraft 版本！")
McInstanceSelected.Load()
If McInstanceSelected.State = McInstanceState.Error Then Throw New Exception("Minecraft 存在问题：" & McInstanceSelected.Info)
'检查输入信息
Dim CheckResult As String = ""
RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
@@ -817,7 +824,7 @@ LoginFinish:
Dim ErrorMessage As String = Nothing
Try
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
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
@@ -940,24 +947,20 @@ Retry:
}"
Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
Content:=Request, ContentType:="application/json", RequireJson:=True)
Dim ResultJson As JObject = GetJson(Result)
Dim XBLToken As String = ResultJson("Token").ToString
Return XBLToken
Return GetJson(Result)("Token").ToString
End Function
'微软登录步骤 3：从 XBLToken 获取 {XSTSToken, UHS}
Private Function MsLoginStep3(XBLToken As String) As String()
McLaunchLog("开始微软登录步骤 3/6")
Dim Request As String = "{
""Properties"": {
""SandboxId"": ""RETAIL"",
""UserTokens"": [
""" & XBLToken & """
]
},
""RelyingParty"": ""rp://api.minecraftservices.com/"",
""TokenType"": ""JWT""
}"
""Properties"": {
""SandboxId"": ""RETAIL"",
""UserTokens"": [""" & XBLToken & """]
},
""RelyingParty"": ""rp://api.minecraftservices.com/"",
""TokenType"": ""JWT""
}"
Dim Result As String
Try
Result = NetRequestByClientMultiple("https://xsts.auth.xboxlive.com/xsts/authorize", HttpMethod.Post,
@@ -1098,7 +1101,7 @@ Retry:
'使用正版用户名
Try
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)
Uuid = McLoginMojangUuid(SkinName, False)
End If
@@ -1151,85 +1154,94 @@ Retry:
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)
'MC 大版本检测
If (Not McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2024, 4, 2)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 20, 5)) Then
'原版 26-：通过版本号判断
If (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2024, 4, 2)) OrElse
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla >= New Version(20, 0, 5)) Then
'1.20.5+（24w14a+）：至少 Java 21
MinVer = New Version(1, 21, 0, 0)
ElseIf (Not McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 18)) Then
ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 11, 16)) OrElse
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 18) Then
'1.18 pre2+：至少 Java 17
MinVer = New Version(1, 17, 0, 0)
ElseIf (Not McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2021, 5, 11)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 17)) Then
ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 5, 11)) OrElse
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 17) Then
'1.17+ (21w19a+)：至少 Java 16
MinVer = New Version(1, 16, 0, 0)
ElseIf McVersionCurrent.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年，太棒了
ElseIf McInstanceSelected.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年，太棒了
'1.12+：至少 Java 8
MinVer = New Version(1, 8, 0, 0)
ElseIf McVersionCurrent.ReleaseTime <= New Date(2013, 5, 1) AndAlso McVersionCurrent.ReleaseTime.Year >= 2001 Then '避免某些版本写个 1960 年
'1.5.2-：最高 Java 12
MaxVer = New Version(1, 12, 999, 999)
ElseIf McInstanceSelected.ReleaseTime <= New Date(2013, 5, 1) AndAlso McInstanceSelected.ReleaseTime.Year >= 2001 Then '避免某些版本写个 1960 年
'1.5.2-：最高 Java 8
MaxVer = New Version(1, 8, 999, 999)
End If
If McVersionCurrent.JsonVersion?("java_version") IsNot Nothing Then
Dim RecommendedJava As Integer = McVersionCurrent.JsonVersion("java_version").ToObject(Of Integer)
McLaunchLog("Mojang 推荐使用 Java " & RecommendedJava)
If RecommendedJava >= 22 Then MinVer = New Version(1, RecommendedJava, 0, 0) '潜在的向后兼容
'原版 26+：获取 Mojang 要求的 Java 版本
Dim RecommendedComponent As String = Nothing
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
'OptiFine 检测
If McVersionCurrent.Version.HasOptiFine AndAlso McVersionCurrent.Version.IsStandardVersion Then '不管非标准版本
If McVersionCurrent.Version.McVersion < New Version(1, 7) Then
If McInstanceSelected.Version.HasOptiFine AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
If McInstanceSelected.Version.Vanilla.Major < 7 Then
'<1.7：至多 Java 8
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
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
MaxVer = New Version(1, 8, 999, 999)
End If
End If
'Forge 检测
If McVersionCurrent.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.HasForge 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
MinVer = If(New Version(1, 7, 0, 0) > MinVer, New Version(1, 7, 0, 0), MinVer)
MaxVer = If(New Version(1, 7, 999, 999) < MaxVer, New Version(1, 7, 999, 999), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain <= 12 OrElse Not McVersionCurrent.Version.IsStandardVersion Then '非标准版本
ElseIf McInstanceSelected.Version.Vanilla.Major <= 12 OrElse Not McInstanceSelected.Version.Vaild Then '非标准版本
'<=1.12：Java 8
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
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)
ElseIf McVersionCurrent.Version.McCodeMain = 15 Then
ElseIf McInstanceSelected.Version.Vanilla.Major = 15 Then
'1.15：Java 8 - 15
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)
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
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
MaxVer = If(New Version(1, 18, 999, 999) < MaxVer, New Version(1, 18, 999, 999), MaxVer)
End If
End If
'Fabric 检测
If McVersionCurrent.Version.HasFabric AndAlso McVersionCurrent.Version.IsStandardVersion Then '不管非标准版本
If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 Then
If McInstanceSelected.Version.HasFabric AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
If McInstanceSelected.Version.Vanilla.Major >= 15 AndAlso McInstanceSelected.Version.Vanilla.Major <= 16 Then
'1.15 - 1.16：Java 8+
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 Then
ElseIf McInstanceSelected.Version.Vanilla.Major >= 18 Then
'1.18+：Java 17+
MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer)
End If
End If
'LiteLoader 检测
If McVersionCurrent.Version.HasLiteLoader AndAlso McVersionCurrent.Version.IsStandardVersion Then '不管非标准版本
If McInstanceSelected.Version.HasLiteLoader AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
'最高 Java 8
MaxVer = If(New Version(1, 8, 999, 999) < MaxVer, New Version(1, 8, 999, 999), MaxVer)
End If
@@ -1244,7 +1256,7 @@ Retry:
'选择 Java
McLaunchLog("Java 版本需求：最低 " & MinVer.ToString & "，最高 " & MaxVer.ToString)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
If Task.IsAborted Then Return
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
@@ -1255,40 +1267,25 @@ Retry:
If Task.IsAborted Then Return '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java
McLaunchLog("无合适的 Java，需要确认是否自动下载")
Dim JavaCode As String
If MinVer >= New Version(1, 22) Then '潜在的向后兼容
If MinVer >= New Version(1, 9) Then
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
JavaCode = 7
If McVersionCurrent.Version.HasForge Then
MyMsgBox("你需要先安装 LegacyJavaFixer Mod，或自行安装 Java 7，然后才能启动该版本。", "未找到 Java")
Else
If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
End If
MyMsgBox($"你需要安装 Java 7 才能启动该版本。{vbCrLf}请自行搜索并安装 Java 7，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.141 ~ 8.0.320", True) Then Throw New Exception("$$")
MyMsgBox($"你需要安装 Java 8u141 ~ 8u320 才能启动该版本。{vbCrLf}请自行搜索并安装，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) Then
JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.141 或更高版本的 Java 8", True) Then 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("$$")
MyMsgBox($"你需要安装 Java 8u141 或更高版本的 Java 8 才能启动该版本。{vbCrLf}请自行搜索并安装，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
Throw New Exception("$$")
Else
JavaCode = 8
If Not JavaDownloadConfirm("Java 8") Then Throw New Exception("$$")
End If
'开始自动下载
Dim JavaLoader = JavaFixLoaders(JavaCode)
Dim JavaLoader = GetJavaDownloadLoader()
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
Task.Progress = JavaLoader.Progress
Thread.Sleep(10)
@@ -1299,7 +1296,7 @@ Retry:
'检查下载结果
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 McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
@@ -1356,32 +1353,32 @@ Retry:
McLaunchLog("开始获取 Minecraft 启动参数")
'获取基准字符串与参数信息
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 参数")
Arguments = McLaunchArgumentsJvmNew(McVersionCurrent)
Arguments = McLaunchArgumentsJvmNew(McInstanceSelected)
McLaunchLog("新版 JVM 参数获取成功：")
McLaunchLog(Arguments)
Else
McLaunchLog("获取旧版 JVM 参数")
Arguments = McLaunchArgumentsJvmOld(McVersionCurrent)
Arguments = McLaunchArgumentsJvmOld(McInstanceSelected)
McLaunchLog("旧版 JVM 参数获取成功：")
McLaunchLog(Arguments)
End If
If Not String.IsNullOrEmpty(McVersionCurrent.JsonObject("minecraftArguments")) Then '有的版本是空字符串
If Not String.IsNullOrEmpty(McInstanceSelected.JsonObject("minecraftArguments")) Then '有的版本是空字符串
McLaunchLog("获取旧版 Game 参数")
Arguments += " " & McLaunchArgumentsGameOld(McVersionCurrent)
Arguments += " " & McLaunchArgumentsGameOld(McInstanceSelected)
McLaunchLog("旧版 Game 参数获取成功")
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 参数")
Arguments += " " & McLaunchArgumentsGameNew(McVersionCurrent)
Arguments += " " & McLaunchArgumentsGameNew(McInstanceSelected)
McLaunchLog("新版 Game 参数获取成功")
End If
'编码参数（#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
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("-Dstderr.encoding=") Then Arguments = "-Dstderr.encoding=UTF-8 " & Arguments
End If
@@ -1394,10 +1391,10 @@ Retry:
Arguments += " " & Arg.Trim
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))
'进行参数替换
Dim ReplaceArguments = McLaunchArgumentsReplace(McVersionCurrent, Loader)
Dim ReplaceArguments = McLaunchArgumentsReplace(McInstanceSelected, Loader)
If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then
'若自定义信息为空，则去掉该部分
Arguments = Arguments.Replace(" --versionType ${version_type}", "")
@@ -1414,11 +1411,11 @@ Retry:
FinalArguments = FinalArguments.TrimEnd
'替换 Module Path 为短路径（Forge 会在版本 JSON 硬编码这些路径）
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 McVersionCurrent.ReleaseTime > New Date(2023, 4, 4) Then
If McInstanceSelected.ReleaseTime > New Date(2023, 4, 4) Then
'QuickPlay
FinalArguments += $" --quickPlayMultiplayer ""{Server}"""
Else
@@ -1430,7 +1427,7 @@ Retry:
'不包含端口号
FinalArguments += $" --server {Server} --port 25565"
End If
If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Red)
If McInstanceSelected.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Red)
End If
End If
'输出
@@ -1440,30 +1437,30 @@ Retry:
End Sub
'Jvm 部分（第一段）
Private Function McLaunchArgumentsJvmOld(Version As McVersion) As String
Private Function McLaunchArgumentsJvmOld(Instance As McInstance) As String
'存储以空格为间隔的启动参数列表
Dim DataList As New List(Of String)
'输出固定参数
DataList.Add("-XX:HeapDumpPath=MojangTricksIntelDriversForPerformance_javaw.exe_minecraft.exe.heapdump")
Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Instance:=McInstanceSelected)
If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm")
If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理
DataList.Insert(0, ArgumentReplace(ArgumentJvm)) '可变 JVM 参数
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
DataList.Add("-Xmn" & Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """")
DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表
'统一通行证
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
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = Setup.Get("VersionServerAuthServer", McVersionCurrent)
If McLaunchJavaSelected.MajorVersion >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = Setup.Get("VersionServerAuthServer", McInstanceSelected)
Try
Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1475,17 +1472,17 @@ Retry:
End If
'添加 Java Wrapper 作为主 Jar
If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McVersionCurrent) Then
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McInstanceSelected) Then
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("-jar """ & ExtractJavaWrapper() & """")
End If
'添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then
If Instance.JsonObject("mainClass") Is Nothing Then
Throw New Exception("版本 json 中没有 mainClass 项！")
Else
DataList.Add(Version.JsonObject("mainClass"))
DataList.Add(Instance.JsonObject("mainClass"))
End If
'处理 DataList 的换行符
@@ -1493,14 +1490,14 @@ Retry:
Return Join(DataList, " ")
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)
'获取 Json 中的 DataList
Dim CurrentVersion As McVersion = Version
NextVersion:
If CurrentVersion.JsonObject("arguments") IsNot Nothing AndAlso CurrentVersion.JsonObject("arguments")("jvm") IsNot Nothing Then
For Each SubJson As JToken In CurrentVersion.JsonObject("arguments")("jvm")
Dim CurrentInstance As McInstance = Instance
NextInstance:
If CurrentInstance.JsonObject("arguments") IsNot Nothing AndAlso CurrentInstance.JsonObject("arguments")("jvm") IsNot Nothing Then
For Each SubJson As JToken In CurrentInstance.JsonObject("arguments")("jvm")
If SubJson.Type = JTokenType.String Then
'字符串类型
DataList.Add(SubJson.ToString)
@@ -1519,9 +1516,9 @@ NextVersion:
End If
Next
End If
If CurrentVersion.InheritVersion <> "" Then
CurrentVersion = New McVersion(CurrentVersion.InheritVersion)
GoTo NextVersion
If CurrentInstance.InheritName <> "" Then
CurrentInstance = New McInstance(CurrentInstance.InheritName)
GoTo NextInstance
End If
'内存、Log4j 防御参数等
@@ -1529,12 +1526,12 @@ NextVersion:
'统一通行证
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
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)
If McLaunchJavaSelected.MajorVersion >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = Setup.Get("VersionServerAuthServer", Instance:=McInstanceSelected)
Try
Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1546,8 +1543,8 @@ NextVersion:
End If
'添加 Java Wrapper 作为主 Jar
If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McVersionCurrent) Then
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McInstanceSelected) Then
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("-jar """ & ExtractJavaWrapper() & """")
End If
@@ -1575,28 +1572,28 @@ NextVersion:
Dim Result As String = DeDuplicateDataList.Distinct.Join(" ")
'添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then
If Instance.JsonObject("mainClass") Is Nothing Then
Throw New Exception("版本 json 中没有 mainClass 项！")
Else
Result += " " & Version.JsonObject("mainClass").ToString
Result += " " & Instance.JsonObject("mainClass").ToString
End If
Return Result
End Function
'Game 部分（第二段）
Private Function McLaunchArgumentsGameOld(Version As McVersion) As String
Private Function McLaunchArgumentsGameOld(Instance As McInstance) As String
Dim DataList As New List(Of String)
'本地化 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}"
DataList.Add(BasicString)
Dim Result As String = DataList.Join(" ")
'特别改变 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 放在最后，不然会导致崩溃！
If Result.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
Log("[Launch] 发现正确的 OptiFineForge TweakClass，目前参数：" & Result)
@@ -1606,7 +1603,7 @@ NextVersion:
Log("[Launch] 发现错误的 OptiFineForge TweakClass，目前参数：" & Result)
Result = Result.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try
WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
WriteFile(Instance.PathVersion & Instance.Name & ".json", ReadFile(Instance.PathVersion & Instance.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
Catch ex As Exception
Log(ex, "替换 OptiFineForge TweakClass 失败")
End Try
@@ -1615,14 +1612,14 @@ NextVersion:
Return Result
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)
'获取 Json 中的 DataList
Dim CurrentVersion As McVersion = Version
NextVersion:
If CurrentVersion.JsonObject("arguments") IsNot Nothing AndAlso CurrentVersion.JsonObject("arguments")("game") IsNot Nothing Then
For Each SubJson As JToken In CurrentVersion.JsonObject("arguments")("game")
Dim CurrentInstance As McInstance = Instance
NextInstance:
If CurrentInstance.JsonObject("arguments") IsNot Nothing AndAlso CurrentInstance.JsonObject("arguments")("game") IsNot Nothing Then
For Each SubJson As JToken In CurrentInstance.JsonObject("arguments")("game")
If SubJson.Type = JTokenType.String Then
'字符串类型
DataList.Add(SubJson.ToString)
@@ -1641,9 +1638,9 @@ NextVersion:
End If
Next
End If
If CurrentVersion.InheritVersion <> "" Then
CurrentVersion = New McVersion(CurrentVersion.InheritVersion)
GoTo NextVersion
If CurrentInstance.InheritName <> "" Then
CurrentInstance = New McInstance(CurrentInstance.InheritName)
GoTo NextInstance
End If
'将 "-XXX" 与后面 "XXX" 合并到一起
@@ -1667,7 +1664,7 @@ NextVersion:
McLaunchArgumentsGameNew = Join(DeDuplicateDataList.Distinct.ToList, " ")
'特别改变 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 放在最后，不然会导致崩溃！
If McLaunchArgumentsGameNew.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
Log("[Launch] 发现正确的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameNew)
@@ -1677,7 +1674,7 @@ NextVersion:
Log("[Launch] 发现错误的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameNew)
McLaunchArgumentsGameNew = McLaunchArgumentsGameNew.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try
WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
WriteFile(Instance.PathVersion & Instance.Name & ".json", ReadFile(Instance.PathVersion & Instance.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
Catch ex As Exception
Log(ex, "替换 OptiFineForge TweakClass 失败")
End Try
@@ -1686,21 +1683,21 @@ NextVersion:
End Function
'替换 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)
'基础参数
GameArguments.Add("${classpath_separator}", ";")
GameArguments.Add("${natives_directory}", ShortenPath(GetNativesFolder()))
GameArguments.Add("${library_directory}", ShortenPath(PathMcFolder & "libraries"))
GameArguments.Add("${libraries_directory}", ShortenPath(PathMcFolder & "libraries"))
GameArguments.Add("${library_directory}", ShortenPath(McFolderSelected & "libraries"))
GameArguments.Add("${libraries_directory}", ShortenPath(McFolderSelected & "libraries"))
GameArguments.Add("${launcher_name}", "PCL")
GameArguments.Add("${launcher_version}", VersionCode)
GameArguments.Add("${version_name}", Version.Name)
Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Version:=McVersionCurrent)
GameArguments.Add("${version_name}", Instance.Name)
Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Instance:=McInstanceSelected)
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("${assets_root}", ShortenPath(PathMcFolder & "assets"))
GameArguments.Add("${game_directory}", ShortenPath(Left(McInstanceSelected.PathIndie, McInstanceSelected.PathIndie.Count - 1)))
GameArguments.Add("${assets_root}", ShortenPath(McFolderSelected & "assets"))
GameArguments.Add("${user_properties}", "{}")
GameArguments.Add("${auth_player_name}", McLoginLoader.Output.Name)
GameArguments.Add("${auth_uuid}", McLoginLoader.Output.Uuid)
@@ -1708,7 +1705,7 @@ NextVersion:
GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken)
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
@@ -1723,10 +1720,10 @@ NextVersion:
Case Else
GameSize = New Size(854, 480)
End Select
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso
McLaunchJavaSelected.VersionCode <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then
'修复 #3463：1.12.2-，JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍
'修复 1.12.2- 下 JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍（#3463）
If McInstanceSelected.Version.Vanilla.Major <= 12 AndAlso
McLaunchJavaSelected.MajorVersion <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
Not McInstanceSelected.Version.HasOptiFine AndAlso Not McInstanceSelected.Version.HasForge Then
McLaunchLog($"已应用窗口大小过大修复（{McLaunchJavaSelected.Version.Revision}）")
GameSize.Width /= DPI / 96
GameSize.Height /= DPI / 96
@@ -1735,11 +1732,11 @@ NextVersion:
GameArguments.Add("${resolution_height}", Math.Round(GameSize.Height))
'Assets 相关参数
GameArguments.Add("${game_assets}", ShortenPath(PathMcFolder & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Version))
GameArguments.Add("${game_assets}", ShortenPath(McFolderSelected & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
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
Dim CpStrings As New List(Of String)
Dim OptiFineCp As String = Nothing
@@ -1827,7 +1824,7 @@ NextVersion:
''' 获取 Natives 文件夹路径，不以 \ 结尾。
''' </summary>
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
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
If Not Result.IsASCII() Then
@@ -1844,7 +1841,7 @@ NextVersion:
Private Sub McLaunchPrerun()
'要求 Java 使用高性能显卡
'使用高性能显卡
If Setup.Get("LaunchAdvanceGraphicCard") Then
Try
SetGPUPreference(McLaunchJavaSelected.PathJava)
@@ -1871,7 +1868,7 @@ NextVersion:
Try
'确保可用
If Not McLoginLoader.Output.Type = "Microsoft" Then Exit Try
McFolderLauncherProfilesJsonCreate(PathMcFolder)
McFolderLauncherProfilesJsonCreate(McFolderSelected)
'构建需要替换的 Json 对象
Dim ReplaceJsonString As String = "
{
@@ -1893,15 +1890,15 @@ NextVersion:
}"
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)
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")
Catch ex As Exception
Log(ex, "更新 launcher_profiles.json 失败，将在删除文件后重试")
Try
File.Delete(PathMcFolder & "launcher_profiles.json")
McFolderLauncherProfilesJsonCreate(PathMcFolder)
File.Delete(McFolderSelected & "launcher_profiles.json")
McFolderLauncherProfilesJsonCreate(McFolderSelected)
'构建需要替换的 Json 对象
Dim ReplaceJsonString As String = "
{
@@ -1923,9 +1920,9 @@ NextVersion:
}"
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)
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")
Catch exx As Exception
Log(exx, "更新 launcher_profiles.json 失败", LogLevel.Feedback)
@@ -1933,10 +1930,10 @@ NextVersion:
End Try
'更新 options.txt
Dim SetupFileAddress As String = McVersionCurrent.PathIndie & "options.txt"
Dim SetupFileAddress As String = McInstanceSelected.PathIndie & "options.txt"
If Not File.Exists(SetupFileAddress) Then
'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
McLaunchLog("将修改 Yosbr Mod 中的 options.txt")
SetupFileAddress = YosbrFileAddress
@@ -1951,9 +1948,9 @@ NextVersion:
'1.11 ~ 12：zh_cn 时正常，zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文
'1.13+ ：zh_cn 时正常，zh_CN 时自动切换为英文
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 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
End If
@@ -1965,7 +1962,7 @@ NextVersion:
McLaunchLog($"已将语言从 {CurrentLang} 修改为 {RequiredLang}")
End If
''如果是初次设置，一并修改 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")
' McLaunchLog("已开启 forceUnicodeFont")
'End If
@@ -1982,7 +1979,7 @@ NextVersion:
End Try
'离线皮肤 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 '离线登录
(Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
(Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
@@ -1991,17 +1988,17 @@ NextVersion:
'离线皮肤资源包
Try
Directory.CreateDirectory(McVersionCurrent.PathIndie & "resourcepacks\")
Dim ZipFileAddress As String = McVersionCurrent.PathIndie & "resourcepacks\PCL2 Skin.zip"
Dim NewTypeSetup As Boolean = McVersionCurrent.Version.McCodeMain >= 13 OrElse McVersionCurrent.Version.McCodeMain < 6
Directory.CreateDirectory(McInstanceSelected.PathIndie & "resourcepacks\")
Dim ZipFileAddress As String = McInstanceSelected.PathIndie & "resourcepacks\PCL2 Skin.zip"
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
Directory.CreateDirectory(PathTemp)
Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
Dim PackPicAddress As String = PathTemp & "pack.png"
Dim PackFormat As Integer
Select Case McVersionCurrent.Version.McCodeMain
Select Case McInstanceSelected.Version.Vanilla.Major
Case 0, 1, 2, 3, 4, 5
'更早的版本没有资源包；如果判断失败该值为 -1，不会跑到这
'更早的版本没有资源包
McLaunchLog("Minecraft 版本过老，尚不支持自定义离线皮肤")
GoTo IgnoreCustomSkin
Case 6, 7, 8
@@ -2019,24 +2016,24 @@ NextVersion:
Case 17
PackFormat = 7
Case 18
If McVersionCurrent.Version.McCodeSub <= 2 Then
If McInstanceSelected.Version.Vanilla.Minor <= 2 Then
PackFormat = 8
Else
PackFormat = 9
End If
Case 19
If McVersionCurrent.Version.McCodeSub <= 3 Then
If McInstanceSelected.Version.Vanilla.Minor <= 3 Then
PackFormat = 9
Else
PackFormat = 12
End If
Case 20
If McVersionCurrent.Version.McCodeSub <= 1 Then
If McInstanceSelected.Version.Vanilla.Minor <= 1 Then
PackFormat = 15
Else
PackFormat = 17
End If
Case Else '快照版是 99
Case Else '快照版是 9999
PackFormat = 17
'https://zh.minecraft.wiki/w/数据包#数据包版本
End Select
@@ -2046,7 +2043,7 @@ NextVersion:
Bit.Save(PackPicAddress)
WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
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 版本不支持双层皮肤，已进行裁剪")
Skin = Skin.Clip(0, 0, 64, 32)
End If
@@ -2057,22 +2054,13 @@ NextVersion:
ZipAr.CreateEntryFromFile(MetaFileAddress, "pack.mcmeta")
ZipAr.CreateEntryFromFile(PackPicAddress, "pack.png")
'1.19.3+ 使用复杂版本的替换
Dim IsOldType As Boolean
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
If McInstanceSelected.Version.Vanilla >= New Version(19, 0, 3) Then
For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png",
$"assets/minecraft/textures/entity/player/{If(Setup.Get("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png")
Next
Else
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Setup.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
End If
End Using
End Using
@@ -2131,24 +2119,24 @@ IgnoreCustomSkin:
'获取自定义命令
Dim CustomCommandGlobal As String = Setup.Get("LaunchAdvanceRun")
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)
'输出 bat
Try
Dim CmdString As String =
$"{If(McLaunchJavaSelected.VersionCode > 8, "chcp 65001>nul" & vbCrLf, "")}" &
$"{If(McLaunchJavaSelected.MajorVersion > 8, "chcp 65001>nul" & vbCrLf, "")}" &
"@echo off" & vbCrLf &
$"title 启动 - {McVersionCurrent.Name}" & vbCrLf &
$"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
"echo 游戏正在启动，请稍候。" & vbCrLf &
$"cd /D ""{ShortenPath(McVersionCurrent.PathIndie)}""" & vbCrLf &
$"cd /D ""{ShortenPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
CustomCommandGlobal & vbCrLf &
CustomCommandVersion & vbCrLf &
$"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
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
McLaunchLog("导出启动脚本完成，强制结束启动过程")
AbortHint = "导出启动脚本成功！"
@@ -2169,7 +2157,7 @@ IgnoreCustomSkin:
CustomProcess = StartProcess(New ProcessStartInfo With {
.FileName = "cmd.exe",
.Arguments = $"/c ""{CustomCommandGlobal}""",
.WorkingDirectory = PathMcFolder,
.WorkingDirectory = McFolderSelected,
.UseShellExecute = False,
.CreateNoWindow = True
})
@@ -2194,11 +2182,11 @@ IgnoreCustomSkin:
CustomProcess = StartProcess(New ProcessStartInfo With {
.FileName = "cmd.exe",
.Arguments = $"/c ""{CustomCommandVersion}""",
.WorkingDirectory = PathMcFolder,
.WorkingDirectory = McFolderSelected,
.UseShellExecute = False,
.CreateNoWindow = True
})
If Setup.Get("VersionAdvanceRunWait", Version:=McVersionCurrent) Then
If Setup.Get("VersionAdvanceRunWait", Instance:=McInstanceSelected) Then
Do Until CustomProcess.HasExited OrElse Loader.IsAborted
Thread.Sleep(10)
Loop
@@ -2225,10 +2213,10 @@ IgnoreCustomSkin:
If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder))
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.RedirectStandardOutput = True
StartInfo.RedirectStandardError = True
@@ -2267,14 +2255,14 @@ IgnoreCustomSkin:
McLaunchLog("")
McLaunchLog("~ 基础参数 ~")
McLaunchLog("PCL 版本：" & VersionDisplayName & " (" & VersionCode & ")")
McLaunchLog("游戏版本：" & McVersionCurrent.Version.ToString & "（识别为 1." & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & "）")
McLaunchLog("资源版本：" & McAssetsGetIndexName(McVersionCurrent))
McLaunchLog("版本继承：" & If(McVersionCurrent.InheritVersion = "", "无", McVersionCurrent.InheritVersion))
McLaunchLog("分配的内存：" & PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) & " GB（" & Math.Round(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB）")
McLaunchLog("MC 文件夹：" & PathMcFolder)
McLaunchLog("版本文件夹：" & McVersionCurrent.Path)
McLaunchLog("版本隔离：" & (McVersionCurrent.PathIndie = McVersionCurrent.Path))
McLaunchLog("HMCL 格式：" & McVersionCurrent.IsHmclFormatJson)
McLaunchLog($"游戏版本：{McInstanceSelected.VersionDisplayName}（{McInstanceSelected.Version.Vanilla}，Drop {McInstanceSelected.Version.Drop}{If(McInstanceSelected.Version.Reliable, "", "，无法完全确定")}）")
McLaunchLog("资源版本：" & McAssetsGetIndexName(McInstanceSelected))
McLaunchLog("版本继承：" & If(McInstanceSelected.InheritName = "", "无", McInstanceSelected.InheritName))
McLaunchLog("分配的内存：" & PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) & " GB（" & Math.Round(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB）")
McLaunchLog("MC 文件夹：" & McFolderSelected)
McLaunchLog("版本文件夹：" & McInstanceSelected.PathVersion)
McLaunchLog("版本隔离：" & (McInstanceSelected.PathIndie = McInstanceSelected.PathVersion))
McLaunchLog("HMCL 格式：" & McInstanceSelected.IsHmclFormatJson)
McLaunchLog("Java 信息：" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
McLaunchLog("环境变量：" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置"))
McLaunchLog("Natives 文件夹：" & GetNativesFolder())
@@ -2288,12 +2276,12 @@ IgnoreCustomSkin:
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")
WindowTitle = ArgumentReplace(WindowTitle, ReplaceTime:=False)
'初始化等待
Dim Watcher As New Watcher(Loader, McVersionCurrent, WindowTitle)
Dim Watcher As New Watcher(Loader, McInstanceSelected, WindowTitle)
McLaunchWatcher = Watcher
'等待
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+821 -834
View File
File diff suppressed because it is too large. Load diff
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
+92 -489
View File
@@ -1,7 +1,7 @@
Imports System.IO.Compression
Public Module ModMod
Private Const LocalModCacheVersion As Integer = 8
Private Const LocalModCacheVersion As Integer = 10
Public Class McMod
@@ -46,10 +46,7 @@ Public Module ModMod
''' </summary>
Public ReadOnly Property State As McModState
Get
Load()
If Not IsFileAvailable Then
Return McModState.Unavailable
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
If Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
Return McModState.Disabled
Else
Return McModState.Fine
@@ -59,7 +56,6 @@ Public Module ModMod
Public Enum McModState As Integer
Fine = 0
Disabled = 1
Unavailable = 2
End Enum
#End Region
@@ -67,12 +63,17 @@ Public Module ModMod
#Region "信息项"
''' <summary>
''' Mod 的名称。若不可用则为 ModID 或无扩展的文件名。
''' 当任何信息在初始化后更新时触发。
''' </summary>
Public Property Name As String
Public Event OnUpdate(sender As McMod)
''' <summary>
''' Mod 的可读名称。
''' 可能为无扩展的文件名，但不会是 Nothing。
''' </summary>
Public Property DisplayName As String
Get
If _Name Is Nothing Then Load()
If _Name Is Nothing Then _Name = _ModId
If _Name Is Nothing Then _Name = CompFile?.DisplayName
If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path)
Return _Name
End Get
@@ -87,12 +88,10 @@ Public Module ModMod
''' <summary>
''' Mod 的描述信息。
''' 可能为 Nothing。
''' </summary>
Public Property Description As String
Get
If _Description Is Nothing Then Load()
If _Description Is Nothing AndAlso FileUnavailableReason IsNot Nothing Then _Description = FileUnavailableReason.Message
'If _Description Is Nothing Then _Description = Path
Return _Description
End Get
Set(value As String)
@@ -106,11 +105,12 @@ Public Module ModMod
Private _Description As String = Nothing
''' <summary>
''' Mod 的版本，不保证符合版本格式规范。
''' Mod 的版本。
''' 不保证符合版本格式规范，且可能为 Nothing。
''' </summary>
Public Property Version As String
Get
If _Version Is Nothing Then Load()
If _Version Is Nothing Then _Version = CompFile?.Version
Return _Version
End Get
Set(value As String)
@@ -121,167 +121,17 @@ Public Module ModMod
End Property
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
#Region "加载步骤标记"
'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 "加载"
#Region "从 JAR 获取信息"
''' <summary>
''' 初始化所有数据。
''' 从 JAR 文件中获取 Mod 信息。
''' </summary>
Private Sub Init()
_Name = Nothing
_Description = Nothing
_Version = Nothing
_ModId = Nothing
PossibleModId = New List(Of String)
_Dependencies = New Dictionary(Of String, String)
IsLoaded = False
_FileUnavailableReason = Nothing
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()
Public Sub LoadMetadataFromJar()
Static IsLoaded As Boolean = False
If IsLoaded Then Return
IsLoaded = True
Dim Jar As ZipArchive = Nothing
Try
'基础可用性检查、打开 Jar 文件
@@ -289,24 +139,16 @@ Public Module ModMod
If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件（" & Path & "）")
Jar = New ZipArchive(New FileStream(Path, FileMode.Open))
'信息获取
LookupMetadata(Jar)
LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException
Log(ex, "Mod 文件由于无权限无法打开（" & Path & "）", LogLevel.Developer)
_FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限，请尝试右键以管理员身份运行 PCL", ex)
Catch ex As Exception
Log(ex, "Mod 文件无法打开（" & Path & "）", LogLevel.Developer)
_FileUnavailableReason = ex
Finally
If Jar IsNot Nothing Then Jar.Dispose()
End Try
'完成标记
IsLoaded = True
End Sub
''' <summary>
''' 从 jar 文件中获取 Mod 信息。
''' </summary>
Private Sub LookupMetadata(Jar As ZipArchive)
Private Sub LoadMetadataFromJar(Jar As ZipArchive)
#Region "尝试使用 mcmod.info"
Try
@@ -327,45 +169,9 @@ Public Module ModMod
InfoObject = JsonObject("modList")(0)
End If
'从文件中获取 Mod 信息项
Name = InfoObject("name")
DisplayName = InfoObject("name")
Description = InfoObject("description")
Version = InfoObject("version")
Url = InfoObject("url")
ModId = InfoObject("modid")
Dim AuthorJson As JArray = InfoObject("authorList")
If AuthorJson IsNot Nothing Then
Dim Author As New List(Of String)
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.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
Log(ex, "读取 mcmod.info 时出现未知错误（" & Path & "）", LogLevel.Developer)
End Try
@@ -383,37 +189,9 @@ Public Module ModMod
Dim FabricObject As JObject = GetJson(FabricText)
GotFabric:
'从文件中获取 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("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
Catch ex As Exception
@@ -500,22 +278,9 @@ GotFabric:
End If
Next
If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try
ModId = ModEntry("modId")
If _ModId Is Nothing Then Exit Try '设置了无效的 ModID
If ModEntry.ContainsKey("displayName") Then Name = ModEntry("displayName")
If ModEntry.ContainsKey("displayName") Then DisplayName = ModEntry("displayName")
If ModEntry.ContainsKey("description") Then Description = ModEntry("description")
If ModEntry.ContainsKey("version") Then Version = ModEntry("version")
If TomlData(0).Value.ContainsKey("displayURL") Then Url = TomlData(0).Value("displayURL")
If TomlData(0).Value.ContainsKey("authors") Then Authors = TomlData(0).Value("authors")
For Each TomlSubData In TomlData
If TomlSubData.Key.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
Catch ex As Exception
@@ -551,41 +316,16 @@ GotFabric:
Exit Try
Got:
'从文件中获取 Mod 信息项
If FmlObject.ContainsKey("useMetadata") AndAlso If(FmlObject("useMetadata")("value"), "").ToString.ToLower = "true" Then
'要求使用 mcmod.info 中的信息
Dim value As String = FmlObject("modid")("value")
If value Is Nothing Then Exit Try
value = RegexSeek(value.ToLower, "[0-9a-z_]+")
If value IsNot Nothing AndAlso value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
End If
Exit Try
End If
If FmlObject.ContainsKey("name") Then Name = FmlObject("name")("value")
If FmlObject.ContainsKey("name") Then DisplayName = FmlObject("name")("value")
If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value")
If FmlObject.ContainsKey("modid") Then ModId = FmlObject("modid")("value")
If (Not FmlObject.ContainsKey("serverSideOnly")) OrElse FmlObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
'添加 Minecraft 依赖
Dim DepMinecraft As String = If(If(FmlObject("acceptedMinecraftVersions") IsNot Nothing, FmlObject("acceptedMinecraftVersions")("value"), ""), "")
If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
'添加其他依赖
Dim Deps As String = If(If(FmlObject("dependencies") IsNot Nothing, FmlObject("dependencies")("value"), ""), "")
If Deps <> "" Then
For Each Dep In Deps.Split(";")
If Dep = "" OrElse Not Dep.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
Catch ex As Exception
Log(ex, "读取 fml_cache_annotation.json 时出现未知错误（" & Path & "）", LogLevel.Developer)
End Try
#End Region
Return '没能成功获取任何信息
Finished:
#Region "将 Version 代号转换为 META-INF 中的版本"
If _Version = "version" Then
@@ -606,6 +346,7 @@ Finished:
End If
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
#End Region
RaiseEvent OnUpdate(Me)
End Sub
@@ -613,11 +354,6 @@ Finished:
#Region "网络信息"
''' <summary>
''' 当任何网络信息更新时触发。
''' </summary>
Public Event OnCompUpdate(sender As McMod)
''' <summary>
''' 该 Mod 关联的网络项目。
''' </summary>
@@ -627,7 +363,7 @@ Finished:
End Get
Set(value As CompProject)
_Comp = value
RaiseEvent OnCompUpdate(Me)
RaiseEvent OnUpdate(Me)
End Set
End Property
Private _Comp As CompProject
@@ -646,7 +382,7 @@ Finished:
End Get
Set(value As CompFile)
_UpdateFile = value
RaiseEvent OnCompUpdate(Me)
RaiseEvent OnUpdate(Me)
End Set
End Property
Private _UpdateFile As CompFile
@@ -688,7 +424,7 @@ Finished:
''' </summary>
Public ReadOnly Property CanUpdate As Boolean
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 Property
@@ -787,10 +523,10 @@ Finished:
#End Region
''' <summary>
''' 是否可能为前置 Mod。
''' 是否可能为前置 Mod。目前非常不准确。
''' </summary>
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
''' <summary>
@@ -811,21 +547,21 @@ Finished:
Public McModLoader As New LoaderTask(Of String, List(Of McMod))("Mod List Loader", AddressOf McModLoad)
Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of McMod)))
Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = False)
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.ShowProgress = False)
'等待 Mod 更新完成
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
If PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表：" & Loader.Input)
Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod")
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input)
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
If Loader.IsAborted Then Return
Thread.Sleep(100)
Loop
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
FrmVersionMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
FrmInstanceMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
End If
'获取 Mod 文件夹下的可用文件列表
@@ -835,9 +571,9 @@ Finished:
For Each File As FileInfo In EnumerateFiles(Loader.Input)
If File.DirectoryName.ToLower & "\" <> RawName Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时，才加载该子文件夹下的 Mod
If Not (PageVersionLeft.Version IsNot Nothing AndAlso PageVersionLeft.Version.Version.HasForge AndAlso
PageVersionLeft.Version.Version.McCodeMain < 13 AndAlso
File.Directory.Name = $"1.{PageVersionLeft.Version.Version.McCodeMain}.{PageVersionLeft.Version.Version.McCodeSub}") Then
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
File.Directory.Name = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then
Continue For
End If
End If
@@ -845,10 +581,6 @@ Finished:
Next
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 Cache As New JObject
@@ -869,13 +601,9 @@ Finished:
'加载 Mod 列表
Dim ModList As New List(Of McMod)
Dim ModUpdateList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList
Loader.Progress += 0.94 / ModFileList.Count
If Loader.IsAborted Then Return
'加载 McMod 对象
Dim ModEntry As New McMod(ModFile.FullName)
ModEntry.Load()
Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName)
If DumpMod IsNot Nothing Then
Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry)
@@ -884,31 +612,16 @@ Finished:
Continue For
Else
ModList.Remove(DisabledMod)
ModUpdateList.Remove(DisabledMod)
End If
End If
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
Loader.Progress = 0.99
Log($"[Mod] 共有 {ModList.Count} 个 Mod，其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息，{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息")
Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
'排序
ModList = ModList.Sort(
Function(Left As McMod, Right As McMod) 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)
End If
ModList = ModList.SortByComparison(
Function(Left, Right) As Boolean
Return Not Right.FileName.CompareTo(Left.FileName)
End Function)
'回设
@@ -916,10 +629,8 @@ Finished:
Loader.Output = ModList
'开始联网加载
If ModUpdateList.Any() Then
'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True)
End If
'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModList, Cache), IsForceRestart:=True)
Catch ex As Exception
Log(ex, "Mod 列表加载失败", LogLevel.Debug)
@@ -929,15 +640,31 @@ Finished:
'联网加载 Mod 详情
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key
Dim Mods As New List(Of McMod)
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
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
Dim TargetMcVersion As McVersion = PageInstanceLeft.Instance.Version
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 CurrentTaskThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
@@ -961,7 +688,11 @@ Finished:
ModrinthMapping(ProjectId).Add(Entry)
'记录对应的 CompFile
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
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
@@ -979,7 +710,7 @@ Finished:
'步骤 4：获取更新信息
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"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
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.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) '合并下载源
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
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
End If
Next
@@ -1059,9 +790,9 @@ Finished:
For Each IndexEntry In ProjectJson("latestFilesIndexes")
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion")
If IndexVersion <> McVersion Then Continue For 'MC 版本匹配
If IndexVersion <> VanillaVersion Then Continue For 'MC 版本匹配
'由于 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
NewestVersion = IndexVersion
NewestFileIds.Clear()
@@ -1111,6 +842,8 @@ Finished:
EndedThreadCount += 1
End Try
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
Thread.Sleep(10)
@@ -1122,155 +855,25 @@ Finished:
If Not Mods.Any() Then Return
For Each Entry In Mods
Entry.CompLoaded = Not IsFailed
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = Entry.ToJson()
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
If Loader.IsAborted Then Return
If FrmVersionMod?.Filter = PageVersionMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmVersionMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else
RunInUi(Sub() FrmVersionMod?.RefreshBars())
RunInUi(Sub() FrmInstanceMod?.RefreshBars())
End If
End Sub
Public Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageVersionLeft.Version.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If PageVersionLeft.Version.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If PageInstanceLeft.Instance.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageInstanceLeft.Instance.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageInstanceLeft.Instance.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
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})
Return ModLoaders
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
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+74 -75
View File
@@ -24,13 +24,13 @@ Public Module ModModpack
''' 必须在工作线程执行。
''' </summary>
''' <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"))
Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = ""
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
'获取整合包种类与关键 Json
Dim PackType As Integer = -1
@@ -84,7 +84,7 @@ Public Module ModModpack
Select Case PackType
Case 0
Log("[ModPack] 整合包种类：CurseForge")
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 1
Log("[ModPack] 整合包种类：HMCL")
Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
@@ -93,10 +93,10 @@ Public Module ModModpack
Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
Case 3
Log("[ModPack] 整合包种类：MCBBS")
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName)
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, InstanceName)
Case 4
Log("[ModPack] 整合包种类：Modrinth")
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 9
Log("[ModPack] 整合包种类：带启动器的压缩包")
Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
@@ -180,7 +180,7 @@ Retry:
'CurseForge
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 文件
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 VersionName Is Nothing Then
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
If InstanceName Is Nothing Then
InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
End If
'获取 Mod API 版本信息
@@ -234,7 +234,7 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
$"{PathMcFolder}versions\{VersionName}",
$"{McFolderSelected}versions\{InstanceName}",
Task, 0.4)
End Sub) With {
.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
@@ -292,7 +292,7 @@ Retry:
Dim File As New CompFile(ModJson, Type)
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)
Next
Task.Output = FileList.Values.ToList
@@ -306,8 +306,8 @@ Retry:
'构造加载器
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("minecraft")("version").ToString,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
@@ -321,7 +321,7 @@ Retry:
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\"
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -342,7 +342,7 @@ Retry:
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
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
@@ -350,7 +350,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder)
Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -358,7 +358,7 @@ Retry:
End Function
'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 文件
Dim Json As JObject
@@ -392,12 +392,12 @@ Retry:
End Select
Next
'获取版本名
If VersionName Is Nothing Then
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
If InstanceName Is Nothing Then
InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
End If
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
@@ -407,11 +407,11 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
PathMcFolder & "versions\" & VersionName,
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "client-overrides",
PathMcFolder & "versions\" & VersionName,
McFolderSelected & "versions\" & InstanceName,
Task, 0.1)
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
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = Urls.Distinct.ToList()
Dim TargetPath As String = $"{PathMcFolder}versions\{VersionName}\{File("path")}"
If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{PathMcFolder}versions\{VersionName}\", True) Then
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！" & vbCrLf & "错误的文件：" & TargetPath, "文件路径校验失败", IsWarn:=True)
Throw New CancelledException
End If
@@ -447,8 +447,8 @@ Retry:
'构造加载器
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
@@ -462,7 +462,7 @@ Retry:
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\"
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -483,7 +483,7 @@ Retry:
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
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
@@ -491,7 +491,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder)
Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -508,11 +508,11 @@ Retry:
Throw New Exception("HMCL 整合包安装信息存在问题", ex)
End Try
'获取版本名
Dim VersionName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
Dim InstanceName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
@@ -521,14 +521,14 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "minecraft",
PathMcFolder & "versions\" & VersionName,
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造游戏本体安装加载器
If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("gameVersion").ToString
}
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)}
}
'重复任务检查
Dim LoaderName As String = "HMCL 整合包安装：" & VersionName & " "
Dim LoaderName As String = "HMCL 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder)
Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -563,21 +563,21 @@ Retry:
Throw New Exception("MMC 整合包安装信息存在问题", ex)
End Try
'获取版本名
Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
Dim InstanceName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
'解压
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)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & ".minecraft",
PathMcFolder & "versions\" & VersionName,
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
'读取 MMC 设置文件（#2655）
Try
@@ -616,7 +616,7 @@ Retry:
If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True)
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）")
End If
'JVM 参数
@@ -638,7 +638,7 @@ Retry:
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 整合包未提供游戏版本信息，无法安装！")
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")
If Not Component.ContainsKey("uid") Then Continue For
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)})
'重复任务检查
Dim LoaderName As String = "MMC 整合包安装：" & VersionName & " "
Dim LoaderName As String = "MMC 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
@@ -673,7 +673,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder)
Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -682,7 +682,7 @@ Retry:
'MCBBS
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 文件
Dim Json As JObject
Try
@@ -692,23 +692,23 @@ Retry:
Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
End Try
'获取版本名
If VersionName Is Nothing Then
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
If InstanceName Is Nothing Then
InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
End If
'解压
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)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
PathMcFolder & "versions\" & VersionName,
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
'JVM 参数
If Json("launchInfo") IsNot Nothing Then
@@ -729,8 +729,8 @@ Retry:
Throw New CancelledException
End If
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Addons("game"),
.OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), 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)})
'重复任务检查
Dim LoaderName As String = "MCBBS 整合包安装：" & VersionName & " "
Dim LoaderName As String = "MCBBS 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
@@ -753,7 +753,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
'If Archive IsNot Nothing Then Archive.Dispose() '解除占用，以免在加载器中触发 “正由另一进程使用，因此该进程无法访问此文件”
Loader.Start(Request.TargetVersionFolder)
Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -805,11 +805,11 @@ Retry:
End If
OpenExplorer(TargetFolder)
'加入文件夹列表
Dim VersionName As String = GetFolderNameFromPath(TargetFolder)
Dim InstanceName As String = GetFolderNameFromPath(TargetFolder)
Directory.CreateDirectory(TargetFolder & ".minecraft\")
PageSelectLeft.AddFolder(
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
VersionName, False)
InstanceName, False)
'调用 modpack 文件进行安装
Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
Log("[Modpack] 调用 modpack 文件继续安装：" & ModpackFile)
@@ -835,10 +835,9 @@ Retry:
Exit For
End If
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 VersionName As String = Match.Groups(1).Value
Log("[ModPack] 检测到压缩包的 .minecraft 根目录：" & ArchiveBaseFolder & "，命中的版本名：" & VersionName)
Log("[ModPack] 检测到压缩包的 .minecraft 根目录：" & ArchiveBaseFolder & "，命中的版本名：" & Match.Groups(1).Value)
'获取解压路径
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
@@ -853,7 +852,7 @@ Retry:
'加入文件夹列表
PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
Thread.Sleep(400) '避免文件争用
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.VersionSelect))
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.InstanceSelect))
End Sub)
}) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(TargetFolder)
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+9 -9
View File
@@ -58,13 +58,13 @@
'初始化
Public GameProcess As Process
Public Version As McVersion
Public Instance As McInstance
Private WindowTitle As String = ""
Private PID As Integer
Public Loader As LoaderTask(Of Process, Integer)
Public Sub New(Loader As LoaderTask(Of Process, Integer), Version As McVersion, WindowTitle As String)
Public Sub New(Loader As LoaderTask(Of Process, Integer), Instance As McInstance, WindowTitle As String)
Me.Loader = Loader
Me.Version = Version
Me.Instance = Instance
Me.WindowTitle = WindowTitle
Me.PID = Loader.Input.Id
WatcherLog("开始 Minecraft 日志监控")
@@ -97,7 +97,7 @@
'设置窗口标题
For i = 1 To 3
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)
End If
Thread.Sleep(64)
@@ -164,7 +164,7 @@
'窗口未出现
WatcherLog("Minecraft 尚未加载完成，可能已崩溃")
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 且未结束
WatcherLog("Minecraft 返回值异常，可能已崩溃")
Crashed()
@@ -356,12 +356,12 @@
Try
Thread.Sleep(2000)
WatcherLog("崩溃分析开始")
Dim Analyzer As New CrashAnalyzer(Version)
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
Dim Analyzer As New CrashAnalyzer(Instance)
Analyzer.Collect(Instance.PathIndie, LatestLog.ToList)
Analyzer.Prepare()
Analyzer.Analyze(Version)
Analyzer.Analyze()
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
Log(ex, "崩溃分析失败", LogLevel.Feedback)
End Try
Plain Craft Launcher 2/Modules/ModEvent.vb
+31 -6
View File
@@ -96,11 +96,36 @@ End Module
''' 自定义事件。
''' </summary>
Public Class CustomEvent
Inherits DependencyObject
#Region "属性与触发"
Public Property Type As EventType = EventType.None
Public Property Data As String = Nothing
Public Property Type As EventType
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()
End Sub
Public Sub New(Type As EventType, Data As String)
@@ -190,17 +215,17 @@ Public Class CustomEvent
Case EventType.启动游戏
If Args(0) = "\current" Then
If McVersionCurrent Is Nothing Then
If McInstanceSelected Is Nothing Then
Hint("请先选择一个 Minecraft 版本！", HintType.Red)
Return
Else
Args(0) = McVersionCurrent.Name
Args(0) = McInstanceSelected.Name
End If
End If
RunInUi(
Sub()
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)}……")
End If
End Sub)
@@ -276,7 +301,7 @@ Public Class CustomEvent
Case EventType.修改设置, EventType.写入设置
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)
Case EventType.修改变量, EventType.写入变量
Plain Craft Launcher 2/Modules/ModMain.vb
+17 -17
View File
@@ -410,12 +410,12 @@ EndHint:
Public FrmLoginMsSkin As PageLoginMsSkin
'版本设置页面声明
Public FrmVersionLeft As PageVersionLeft
Public FrmVersionOverall As PageVersionOverall
Public FrmVersionMod As PageVersionMod
Public FrmVersionModDisabled As PageVersionModDisabled
Public FrmVersionSetup As PageVersionSetup
Public FrmVersionExport As PageVersionExport
Public FrmInstanceLeft As PageInstanceLeft
Public FrmInstanceOverall As PageInstanceOverall
Public FrmInstanceMod As PageInstanceMod
Public FrmInstanceModDisabled As PageInstanceModDisabled
Public FrmInstanceSetup As PageInstanceSetup
Public FrmInstanceExport As PageInstanceExport
'资源信息分页声明
Public FrmDownloadCompDetail As PageDownloadCompDetail
@@ -834,20 +834,20 @@ NextFile:
Text = Text.Replace("{path_temp}", Replacer(PathTemp))
'时间
If ReplaceTime Then '在窗口标题中，时间会被后续动态替换，所以此时不应该替换
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("{date}", Replacer(Date.Now.ToString("yyyy'/'M'/'d")))
Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH':'mm':'ss")))
End If
'Minecraft
Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.PathFolder))
Text = Text.Replace("{minecraft}", Replacer(PathMcFolder))
If McVersionCurrent IsNot Nothing Then
Text = Text.Replace("{version_path}", Replacer(McVersionCurrent.Path)) : Text = Text.Replace("{verpath}", Replacer(McVersionCurrent.Path))
Text = Text.Replace("{version_indie}", Replacer(McVersionCurrent.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McVersionCurrent.PathIndie))
Text = Text.Replace("{name}", Replacer(McVersionCurrent.Name))
If {"unknown", "old", "pending"}.Contains(McVersionCurrent.Version.McName.ToLower) Then
Text = Text.Replace("{version}", Replacer(McVersionCurrent.Name))
Text = Text.Replace("{minecraft}", Replacer(McFolderSelected))
If McInstanceSelected?.IsLoaded Then
Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion))
Text = Text.Replace("{version_indie}", Replacer(McInstanceSelected.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McInstanceSelected.PathIndie))
Text = Text.Replace("{name}", Replacer(McInstanceSelected.Name))
If {"unknown", "old", "pending"}.Contains(McInstanceSelected.Version.VanillaName.ToLower) Then
Text = Text.Replace("{version}", Replacer(McInstanceSelected.Name))
Else
Text = Text.Replace("{version}", Replacer(McVersionCurrent.Version.McName))
Text = Text.Replace("{version}", Replacer(McInstanceSelected.Version.VanillaName))
End If
Else
Text = Text.Replace("{version_path}", Replacer(Nothing)) : Text = Text.Replace("{verpath}", Replacer(Nothing))
@@ -877,7 +877,7 @@ NextFile:
'高级
Text = Text.RegexReplaceEach("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
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("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Return Text
Plain Craft Launcher 2/Modules/ModSecret.vb
+3 -3
View File
@@ -63,11 +63,11 @@ Friend Module ModSecret
End Function
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", Version:=McInstanceSelected)
DataList.Insert(0, ArgumentReplace(If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom))) '可变 JVM 参数
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("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & "m")
DataList.Add("-Xmn" & Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected) * 1024 * 0.15) & "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")
End Sub
Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+2 -2
View File
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.11.2.0")>
<Assembly: AssemblyFileVersion("2.11.2.0")>
<Assembly: AssemblyVersion("2.12.0.0")>
<Assembly: AssemblyFileVersion("2.12.0.0")>
<Assembly: NeutralResourcesLanguage("")>
Plain Craft Launcher 2/My Project/Resources.Designer.vb
Generated
+10
View File
@@ -200,6 +200,16 @@ Namespace My.Resources
End Get
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>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Plain Craft Launcher 2/My Project/Resources.resx
+3
View File
@@ -160,6 +160,9 @@
<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>
</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">
<value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
Plain Craft Launcher 2/Pages/PageDownload/Comp/MyCompItem.xaml.vb
+18 -28
View File
@@ -3,16 +3,6 @@
#Region "基础属性"
Public Uuid As Integer = GetUuid()
'Logo
Public Property Logo As String
Get
Return PathLogo.Source
End Get
Set(value As String)
PathLogo.Source = value
End Set
End Property
'标题
Public Property Title As String
Get
@@ -64,17 +54,17 @@
'Tag
Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String))
Set(Tags As List(Of String))
PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value
Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
</Border>")
PanTags.Children.Add(NewTag)
PanTags.Visibility = If(Tags.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In Tags
Dim BorderTag As New Border With {
.Background = New MyColor("#11000000"), .Padding = New Thickness(3, 1, 3, 1), .CornerRadius = New CornerRadius(3),
.Margin = New Thickness(0, 0, 3, 0), .SnapsToDevicePixels = True, .UseLayoutRounding = False}
Dim LabTag As New TextBlock With {
.Text = TagText, .Foreground = New MyColor("#868686"), .FontSize = 11}
BorderTag.Child = LabTag
PanTags.Children.Add(BorderTag)
Next
End Set
End Property
@@ -208,9 +198,9 @@
Dim Ani As New List(Of AniData)
If IsMouseOver Then
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
If IsMouseDown Then
Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
Else
@@ -218,11 +208,11 @@
End If
Else
Ani.AddRange({
AaOpacity(RectBack, -RectBack.Opacity, Time),
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
AaOpacity(RectBack, -RectBack.Opacity, Time),
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrush7"), Time),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
End If
AniStart(Ani, "CompItem Color " & Uuid)
Else
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageComp.xaml
+1 -3
View File
@@ -34,16 +34,14 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.10" />
<local:MyComboBoxItem Content="1.21.11" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageComp.xaml.vb
+25 -18
View File
@@ -67,7 +67,7 @@ Public Class PageComp
''' <summary>
''' 在切换到页面时，应自动将筛选项设置为与该目标 MC 版本和加载器相同。
''' </summary>
Public Shared TargetVersion As McVersion = Nothing
Public Shared TargetInstance As McInstance = Nothing
''' <summary>
''' 在切换到该页面时自动设置的搜索框内的内容。
''' </summary>
@@ -76,13 +76,13 @@ Public Class PageComp
'在点击 MyCompItem 时会获取 Loader 的输入，以使资源详情页面可以应用相同的筛选项
Public Loader As New LoaderTask(Of CompProjectRequest, Integer)("社区资源获取：XXX", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Private IsLoaderInited As Boolean = False
Private Sub PageCompControls_Inited(sender As Object, e As EventArgs) Handles Me.Loaded
Static IsFirstLoaded As Boolean = False
'不知道从 Initialized 改成 Loaded 会不会有问题，但用 Initialized 会导致初始的筛选器修改被覆盖回默认值
If TargetVersion IsNot Nothing Then
If TargetInstance IsNot Nothing Then
'设置目标
ResetFilter() '重置筛选器
TextSearchVersion.Text = TargetVersion.Version.McName
TextSearchVersion.Text = TargetInstance.Version.VanillaName
Dim GetTargetItemByName =
Function(Name As String) As MyComboBoxItem
For Each Item As MyComboBoxItem In ComboSearchLoader.Items
@@ -90,32 +90,38 @@ Public Class PageComp
Next
Return ComboSearchLoader.Items(0)
End Function
If TargetVersion.Version.HasForge Then
If TargetInstance.Version.HasForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Forge")
ElseIf TargetVersion.Version.HasFabric Then
ElseIf TargetInstance.Version.HasFabric Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Fabric")
ElseIf TargetVersion.Version.HasNeoForge Then
ElseIf TargetInstance.Version.HasNeoForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("NeoForge")
End If
TargetVersion = Nothing
TargetInstance = Nothing
If TargetName IsNot Nothing Then
TextSearchName.Text = TargetName
TargetName = Nothing
End If
'如果已经完成请求，则重新开始
If IsLoaderInited Then StartNewSearch()
If IsFirstLoaded Then StartNewSearch()
ScrollToHome()
End If
'加载器初始化
If IsLoaderInited Then Return
IsLoaderInited = True
If IsFirstLoaded Then Return
IsFirstLoaded = True
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?.Any 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
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,
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
.SearchText = TextSearchName.Text
.GameVersion = GameVersion
@@ -132,7 +138,7 @@ Public Class PageComp
''' <summary>
''' 每页展示的结果数量。
''' </summary>
Public Const PageSize = 40
Public Const PAGE_SIZE = 40
Public Page As Integer = 0
'结果 UI 化
@@ -141,8 +147,9 @@ Public Class PageComp
Log($"[Comp] 开始可视化{TypeNameSpaced}列表，已储藏 {Storage.Results.Count} 个结果，当前在第 {Page + 1} 页")
'列表项
PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
PanProjects.Children.Add(Storage.Results(i).ToCompItem(
Dim Index As Integer = Math.Min(Page * PAGE_SIZE, Storage.Results.Count - 1)
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,
ShowLoaderDesc:=Loader.Input.ModLoader = CompModLoaderType.Any AndAlso (PageType = CompType.Mod OrElse PageType = CompType.ModPack)))
Next
@@ -156,7 +163,7 @@ Public Class PageComp
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug，读取到的 IsEnabled 可能是错误的值（#3319）
Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.Results.Count > PAGE_SIZE * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml.vb
+80 -67
View File
@@ -19,12 +19,12 @@
End Sub
Public Sub LoadTargetFromAdditional() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetInstance = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
PageType = FrmMain.PageCurrent.Additional(4)
End Sub
Private Project As CompProject
Private TargetVersion As String, TargetLoader As CompModLoaderType
Private TargetInstance As String, TargetLoader As CompModLoaderType
''' <summary>
''' 当前页面应展示的内容类别。可能为 Any。
''' </summary>
@@ -52,16 +52,16 @@
If x = Topmost Then Return -1
If y = Topmost Then Return 1
'特殊版本
Dim IsXSpecial As Boolean = x.EndsWithF("版本")
Dim IsYSpecial As Boolean = y.EndsWithF("版本")
Dim IsXSpecial As Boolean = Not x.Contains(".")
Dim IsYSpecial As Boolean = Not y.Contains(".")
If IsXSpecial AndAlso IsYSpecial Then Return x.CompareTo(y)
If IsXSpecial 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
'比较全部
Return -VersionSortInteger(x, y)
Return -CompareVersion(x, y)
End Function
Public Sub New(Optional Topmost As String = "")
Me.Topmost = If(Topmost, "")
@@ -69,7 +69,8 @@
End Class
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、服务端插件、数据包混合的列表）
Private Function GetResults() As List(Of CompFile)
Dim Results As List(Of CompFile) = CompFileLoader.Output
@@ -87,32 +88,40 @@
Dim Results = GetResults()
'初始化筛选器
Dim VersionFilters As List(Of String)
'按小版本号筛选？
IsMajorVersionFilter = False
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
'按大版本号筛选？
If VersionFilters.Count >= 9 Then
IsMajorVersionFilter = True
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
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 If
End Sub
'确定分组方式
GroupedDrop = False : GroupedOld = False
UpdateFilters()
If Filters.Count < 9 Then GoTo GroupDone
GroupedDrop = True : GroupedOld = False
UpdateFilters()
If Filters.Count < 9 Then GoTo GroupDone
GroupedDrop = False : GroupedOld = True
UpdateFilters()
If Filters.Count < 9 Then GoTo GroupDone
GroupedDrop = True : GroupedOld = True
UpdateFilters()
GroupDone:
'UI 化筛选器
PanFilter.Children.Clear()
If VersionFilters.Count < 2 Then
If Filters.Count < 2 Then
CardFilter.Visibility = Visibility.Collapsed
VersionFilter = Nothing
Else
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 {
.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,
Sub(sender As MyRadioButton, raiseByMouse As Boolean)
VersionFilter = If(sender.Text = "全部", Nothing, sender.Text)
@@ -122,10 +131,10 @@
Next
'自动选择
Dim ToCheck As MyRadioButton = Nothing
If TargetVersion <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
If TargetInstance <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetInstance))
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
If Button.Text <> TargetGroup Then Continue For
ToCheck = Button
@@ -143,24 +152,24 @@
Private Sub UpdateFilterResult()
Dim Results = GetResults()
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any,
$"所选版本：{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "")
Dim TargetCardName As String = If(TargetInstance <> "" OrElse TargetLoader <> CompModLoaderType.Any,
$"{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetInstance}（所选版本）", "")
'归类到卡片下
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)))
For Each Version As CompFile In Results
For Each GameVersion In Version.GameVersions
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
GetGroupedVersionName(GameVersion, IsMajorVersionFilter, True) <> VersionFilter Then Continue For
GetGroupedVersionName(GameVersion, GroupedDrop, GroupedOld) <> VersionFilter Then Continue For
'决定添加到哪个卡片
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
'遍历加入的加载器列表
Dim Loaders As New List(Of String)
If Project.ModLoaders.Count > 1 AndAlso '工程至少有两个加载器
Version.Type = CompType.Mod AndAlso '是 Mod
VerName.StartsWith("1.") Then '不是 “快照版本” 之类的
McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的
For Each Loader In Version.ModLoaders
If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
@@ -176,14 +185,14 @@
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))
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
'检查是否符合版本筛选器
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)
End If
Next
@@ -193,6 +202,7 @@
PanResults.Children.Clear()
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
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 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
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)})
End If
Next
@@ -220,15 +230,17 @@
Log(ex, "可视化工程下载列表出错", LogLevel.Feedback)
End Try
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
Return "其他版本"
Return "其他"
ElseIf Name.Contains("w") Then
Return "快照版本"
ElseIf Name.StartsWith("1.0") OrElse Not Name.StartsWith("1.") OrElse (FoldOldRelease AndAlso Val(Name.Split(".")(1)) < 10) Then
Return "远古版本"
Return "快照版"
ElseIf Not McVersion.IsFormatFit(Name) OrElse (FoldOld AndAlso McVersion.VersionToDrop(Name, True) < 120) Then
Return "远古版"
ElseIf GroupedByDrop Then
Return McVersion.DropToVersion(McVersion.VersionToDrop(Name, True))
Else
Return If(MajorOnly, "1." & Name.Split(".")(1).BeforeFirst(" "), Name)
Return Name
End If
End Function
@@ -250,7 +262,7 @@
'放置当前工程
If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem)
CompItem = Project.ToCompItem(True, True)
CompItem = Project.ToCompItem(True, True).Init()
CompItem.CanInteraction = False
CompItem.Margin = New Thickness(-7, -7, 0, 8)
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 Validate As New ValidateFolderName(PathMcFolder & "versions")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return
Dim InstanceName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Return
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
Dim Target As String = $"{PathMcFolder}versions\{VersionName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo)
Dim Target As String = $"{McFolderSelected}versions\{InstanceName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
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 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 =
@@ -298,7 +310,7 @@
End Select
McInstallFailedClearFolder(MyLoader)
End Sub}
Loader.Start(PathMcFolder & "versions\" & VersionName & "\")
Loader.Start(McFolderSelected & "versions\" & InstanceName & "\")
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
@@ -332,7 +344,7 @@
Case CompType.Shader : SubFolder = "shaderpacks\"
Case CompType.DataPack : SubFolder = "" '导航到版本根目录
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)
If File.ModLoaders.Any Then
@@ -342,51 +354,51 @@
End If
Log($"[Comp] {Desc}要求的加载器种类：" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
'判断某个版本是否符合资源要求
IsVersionSuitable =
Function(Version)
If Not Version.IsLoaded Then Version.Load()
IsInstanceSuitable =
Function(Instance As McInstance)
If Not Instance.IsLoaded Then Instance.Load()
'只对 Mod 和数据包进行版本检测
If File.Type = CompType.Mod OrElse File.Type = CompType.DataPack Then
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Instance.Version.VanillaName) Then Return False
End If
'加载器
If Not AllowedLoaders.Any() Then Return True '无要求
If AllowedLoaders.Contains(CompModLoaderType.Forge) AndAlso Version.Version.HasForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.Fabric) AndAlso Version.Version.HasFabric Then Return True
If AllowedLoaders.Contains(CompModLoaderType.NeoForge) AndAlso Version.Version.HasNeoForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.LiteLoader) AndAlso Version.Version.HasLiteLoader Then Return True
If AllowedLoaders.Contains(CompModLoaderType.Forge) AndAlso Instance.Version.HasForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.Fabric) AndAlso Instance.Version.HasFabric Then Return True
If AllowedLoaders.Contains(CompModLoaderType.NeoForge) AndAlso Instance.Version.HasNeoForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.LiteLoader) AndAlso Instance.Version.HasLiteLoader Then Return True
Return False
End Function
'获取常规资源默认下载位置
If CachedFolder.ContainsKey(File.Type) Then
DefaultFolder = CachedFolder(File.Type)
Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置：{DefaultFolder}")
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then
DefaultFolder = $"{McVersionCurrent.PathIndie}{SubFolder}"
ElseIf McInstanceSelected IsNot Nothing AndAlso IsInstanceSuitable(McInstanceSelected) Then
DefaultFolder = $"{McInstanceSelected.PathIndie}{SubFolder}"
Directory.CreateDirectory(DefaultFolder)
Log($"[Comp] 使用当前版本作为默认下载位置：{DefaultFolder}")
Else
'查找所有可能的版本
Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished
Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished
If NeedLoad Then
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
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}"))
If SuitableVersions.Any Then
Dim SelectedVersion = SuitableVersions.
If SuitableInstanceList.Any Then
Dim SelectedInstance = SuitableInstanceList.
OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
First()
DefaultFolder = SelectedVersion.FullName
DefaultFolder = SelectedInstance.FullName
Directory.CreateDirectory(DefaultFolder)
Log($"[Comp] 使用适合的游戏版本作为默认下载位置：{DefaultFolder}")
Else
DefaultFolder = PathMcFolder
DefaultFolder = McFolderSelected
If NeedLoad Then
Hint("当前 MC 文件夹中没有找到适合此资源的版本！")
Hint($"当前 MC 文件夹中没有找到合适的版本！")
Else
Log("[Comp] 由于当前版本不兼容，使用当前的 MC 文件夹作为默认下载位置")
End If
@@ -413,6 +425,7 @@
FileName = File.FileName
End Select
End If
If File.Type = CompType.Mod Then FileName = FileName.Replace("~", "-") '~ 会导致 Mixin 加载失败
RunInUi(
Sub()
'弹窗要求选择保存位置
Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadMod.xaml
+2 -1
View File
@@ -27,7 +27,8 @@
<local:MyComboBoxItem Content="生物" Tag="411/mobs" />
<local:MyComboBoxItem Content="实用" Tag="5191/utility" />
<local:MyComboBoxItem Content="装备与工具" Tag="434/equipment" />
<local:MyComboBoxItem Content="性能优化" Tag="/optimization" />
<local:MyComboBoxItem Content="创造模式" Tag="9026/" />
<local:MyComboBoxItem Content="性能优化" Tag="6814/optimization" />
<local:MyComboBoxItem Content="信息显示" Tag="423/" />
<local:MyComboBoxItem Content="服务器" Tag="435/social" />
<local:MyComboBoxItem Content="支持库" Tag="421/library" />
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+276 -269
View File
File diff suppressed because it is too large. Load diff
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
+222 -337
View File
File diff suppressed because it is too large. Load diff
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadLeft.xaml.vb
+1 -1
View File
@@ -11,7 +11,7 @@
''' <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
'若使用 IsLoaded，则会导致模拟点击不被执行（模拟点击切换页面时，控件的 IsLoaded 为 False）
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
Plain Craft Launcher 2/Pages/PageVersion/MyLocalModItem.xaml → Plain Craft Launcher 2/Pages/PageInstance/MyLocalModItem.xaml
View File
File renamed without changes.
Plain Craft Launcher 2/Pages/PageVersion/MyLocalModItem.xaml.vb → Plain Craft Launcher 2/Pages/PageInstance/MyLocalModItem.xaml.vb
+108 -110
View File
@@ -5,16 +5,6 @@ Public Class MyLocalModItem
#Region "基础属性"
Public Uuid As Integer = GetUuid()
'Logo
Public Property Logo As String
Get
Return PathLogo.Source
End Get
Set(value As String)
PathLogo.Source = value
End Set
End Property
'标题
Private _Title As String
Public Property Title As String
@@ -28,9 +18,6 @@ Public Class MyLocalModItem
LabTitle.TextDecorations = Nothing
Case McMod.McModState.Disabled
LabTitle.TextDecorations = TextDecorations.Strikethrough
Case McMod.McModState.Unavailable
LabTitle.TextDecorations = TextDecorations.Strikethrough
value &= " [错误]"
End Select
If LabTitle.Text = value Then Return
LabTitle.Text = value
@@ -63,17 +50,17 @@ Public Class MyLocalModItem
'Tag
Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String))
Set(Tags As List(Of String))
PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value
Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#0C000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#88000000"" FontSize=""11"" />
</Border>")
PanTags.Children.Add(NewTag)
PanTags.Visibility = If(Tags.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In Tags
Dim BorderTag As New Border With {
.Background = New MyColor("#0A000000"), .Padding = New Thickness(3, 1, 3, 1), .CornerRadius = New CornerRadius(3),
.Margin = New Thickness(0, 0, 3, 0), .SnapsToDevicePixels = True, .UseLayoutRounding = False}
Dim LabTag As New TextBlock With {
.Text = TagText, .Foreground = New MyColor("#B0B0B0"), .FontSize = 11}
BorderTag.Child = LabTag
PanTags.Children.Add(BorderTag)
Next
End Set
End Property
@@ -123,7 +110,7 @@ Public Class MyLocalModItem
End Get
Set(value As Boolean)
_Swiping = value
FrmVersionMod.CardSelect.IsHitTestVisible = Not value
FrmInstanceMod.CardSelect.IsHitTestVisible = Not value
End Set
End Property
Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值
@@ -313,11 +300,11 @@ Public Class MyLocalModItem
#End Region
Private Function GetUpdateCompareDescription() As String
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
Dim CurrentName = If(Entry.CompFile.Version, Entry.CompFile.DisplayName).Replace(".jar", "")
Dim NewestName = If(Entry.UpdateFile.Version, Entry.UpdateFile.DisplayName).Replace(".jar", "")
'简化名称对比
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
Dim NewestSegs = NewestName.Split("-"c).ToList()
Dim CurrentSegs = CurrentName.Split("-_+ ".ToCharArray).ToList()
Dim NewestSegs = NewestName.Split("-_+ ".ToCharArray).ToList()
Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For
@@ -332,92 +319,103 @@ Public Class MyLocalModItem
End If
Return $"当前版本：{CurrentName}（{GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}）{vbCrLf}最新版本：{NewestName}（{GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)}）"
End Function
Public Sub Refresh() Handles Me.Loaded
RunInUi(
Sub()
'更新
If Entry.CanUpdate Then
BtnUpdate.Visibility = Visibility.Visible
BtnUpdate.ToolTip = $"{GetUpdateCompareDescription()}{vbCrLf}点击以更新，右键查看更新日志。"
'懒加载
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
BtnUpdate.Visibility = Visibility.Visible
BtnUpdate.ToolTip = $"{GetUpdateCompareDescription()}{vbCrLf}点击以更新，右键查看更新日志。"
Else
BtnUpdate.Visibility = Visibility.Collapsed
End If
'标题与描述
Dim DescFileName As String
If Entry.State = McMod.McModState.Fine OrElse Entry.State = McMod.McModState.Disabled Then
DescFileName = IO.Path.GetFileNameWithoutExtension(Entry.Path)
Else
DescFileName = GetFileNameFromPath(Entry.Path)
End If
Dim NewDescription As String
If Setup.Get("ToolModLocalNameStyle") = 1 Then
'标题显示文件名，详情显示译名
'标题
Title = DescFileName
SubTitle = ""
'描述
If Entry.Comp Is Nothing Then
NewDescription = Entry.DisplayName
Else
BtnUpdate.Visibility = Visibility.Collapsed
Dim Titles = Entry.Comp.GetControlTitle(False)
NewDescription = Titles.Key & Titles.Value
End If
'标题与描述
Dim DescFileName As String
If Entry.State = McMod.McModState.Fine OrElse Entry.State = McMod.McModState.Disabled Then
DescFileName = IO.Path.GetFileNameWithoutExtension(Entry.Path)
NewDescription = NewDescription.Replace(" | ", " / ")
If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})"
Else
'标题显示译名，详情显示文件名
'标题
If Entry.Comp Is Nothing Then
Title = Entry.DisplayName
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
DescFileName = GetFileNameFromPath(Entry.Path)
Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
Dim NewDescription As String
If Setup.Get("ToolModLocalNameStyle") = 1 Then
'标题显示文件名，详情显示译名
'标题
Title = DescFileName
SubTitle = ""
'描述
If Entry.Comp Is Nothing Then
NewDescription = Entry.Name
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
NewDescription = Titles.Key & Titles.Value
End If
NewDescription = NewDescription.Replace(" | ", " / ")
If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})"
Else
'标题显示译名，详情显示文件名
'标题
If Entry.Comp Is Nothing Then
Title = Entry.Name
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
'描述
NewDescription = DescFileName
'描述
NewDescription = DescFileName
End If
If Entry.Comp IsNot Nothing Then
NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Entry.Description IsNot Nothing Then
NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "")
End If
Description = NewDescription
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'主 Logo
If Entry.Comp IsNot Nothing Then
Entry.Comp.ApplyLogoToMyImage(PathLogo)
Else
PathLogo.Source = PathImage & "Icons/NoIcon.png"
End If
'图标右下角的 Logo
If Entry.State = McMod.McModState.Fine Then
If ImgState IsNot Nothing Then
Children.Remove(ImgState)
ImgState = Nothing
End If
If Entry.Comp IsNot Nothing Then
NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Entry.Description IsNot Nothing Then
NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Not Entry.IsFileAvailable Then
NewDescription += ": " & "存在错误，无法获取信息"
Else
If ImgState Is Nothing Then
ImgState = New Image With {
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
}
RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
SetColumn(ImgState, 1) : SetRow(ImgState, 1) : SetRowSpan(ImgState, 2)
Children.Add(ImgState)
'<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1"
' Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False"
' HorizontalAlignment="Right" VerticalAlignment="Bottom"
' Source="/Images/Icons/Unavailable.png" />
End If
Description = NewDescription
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'主 Logo
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo())
'图标右下角的 Logo
If Entry.State = McMod.McModState.Fine Then
If ImgState IsNot Nothing Then
Children.Remove(ImgState)
ImgState = Nothing
End If
Else
If ImgState Is Nothing Then
ImgState = New Image With {
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
}
RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
SetColumn(ImgState, 1) : SetRow(ImgState, 1) : SetRowSpan(ImgState, 2)
Children.Add(ImgState)
'<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1"
' Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False"
' HorizontalAlignment="Right" VerticalAlignment="Bottom"
' Source="/Images/Icons/Unavailable.png" />
End If
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
End If
'标签
If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
End Sub)
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
End If
'标签
If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
End Sub
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
Select Case MyMsgBox($"是否要更新 {Entry.Name}？{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
Select Case MyMsgBox($"是否要更新 {Entry.DisplayName}？{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
Case 1 '更新
FrmVersionMod.UpdateMods({Entry})
FrmInstanceMod.UpdateMods({Entry})
Case 2 '查看更新日志
ShowUpdateLog()
Case 3 '取消
Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceExport.xaml
+3 -3
View File
@@ -3,7 +3,7 @@
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:System="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageVersionExport"
mc:Ignorable="d" x:Class="PageInstanceExport"
PanScroll="PanBack">
<Grid x:Name="PanAllBack">
<Grid.Resources>
@@ -249,8 +249,8 @@
Theme="Yellow" Margin="0,2,0,8" Visibility="{Binding Checked, ElementName=CheckAdvancedInclude, Converter={StaticResource BooleanToVisibilityConverter}}" />
<local:MyCheckBox Text="打包资源文件，以避免在导入时下载" x:Name="CheckAdvancedInclude"
ToolTip="将 Mod、资源包、光影包的文件直接放入整合包中，这样在导入时就无需联网下载它们。&#xa;建议仅在无法稳定连接 CurseForge 或 Modrinth 时才考虑勾选。" />
<local:MyCheckBox Text="Modrinth 上传模式" x:Name="CheckAdvancedModrinth"
ToolTip="如果你想要打包上传到 Modrinth，勾选此项会生成完全符合 Modrinth 要求的整合包文件。&#xa;由于 Modrinth 要求，只能从 CurseForge 下载的资源将无法联网下载，会被直接放入整合包中。&#xa;此外，勾选后也不能在整合包中包含 PCL 启动器文件。" />
<local:MyCheckBox Text="仅从 Modrinth 下载资源文件" x:Name="CheckAdvancedModrinth"
ToolTip="若资源未在 Modrinth 上托管，则将其原始文件直接放入整合包中。&#xa;如果你想将整合包上传到 Modrinth，这能帮助你分辨哪些文件未在 Modrinth 上托管。" />
<local:MyHint Theme="Blue" RelativeSetup="HintExportConfig" CanClose="True" Margin="0,20,0,2"
Text="配置文件中含有更多高级选项，例如精准控制导出的文件、设置整合包存放位置等。&#xa;要修改这些选项，请先点击 “保存配置”，在编辑配置文件后再导入。" />
<Grid Height="35" Margin="0,12,0,0">
Plain Craft Launcher 2/Pages/PageVersion/PageVersionExport.xaml.vb → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceExport.xaml.vb
+26 -32
View File
@@ -15,28 +15,28 @@ Public Class ExportOption
Public Property RequireModLoaderOrOptiFine As Boolean = False
End Class
Public Class PageVersionExport
Public Class PageInstanceExport
Implements IRefreshable
Private CurrentVersion As String = ""
Private Sub PageVersionExport_Loaded() Handles Me.Loaded
Private CurrentInstance As String = ""
Private Sub PageInstanceExport_Loaded() Handles Me.Loaded
AniControlEnabled += 1
If CurrentVersion <> PageVersionLeft.Version.Path Then RefreshAll() '切换到了另一个版本，重置页面
If CurrentInstance <> PageInstanceLeft.Instance.PathVersion Then RefreshAll() '切换到了另一个版本，重置页面
CustomEventService.SetEventData(BtnAdvancedHelp,
If(VersionBranchName = "Release", "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json"))
AniControlEnabled -= 1
End Sub
Public Sub RefreshAll() Implements IRefreshable.Refresh
Log($"[Export] 刷新导出页面")
HintOptiFine.Visibility = If(PageVersionLeft.Version.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
CurrentVersion = PageVersionLeft.Version.Path
HintOptiFine.Visibility = If(PageInstanceLeft.Instance.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
CurrentInstance = PageInstanceLeft.Instance.PathVersion
TextExportName.Text = ""
TextExportName.HintText = PageVersionLeft.Version.Name
TextExportName.HintText = PageInstanceLeft.Instance.Name
TextExportVersion.Text = ""
TextExportVersion.HintText = "1.0.0"
CheckAdvancedInclude.Checked = False
CheckAdvancedModrinth.Checked = False
GetExportOption(CheckOptionsBasic).Description = PageVersionLeft.Version.GetVersionDescription()
GetExportOption(CheckOptionsBasic).Description = PageInstanceLeft.Instance.VersionDisplayName()
ResetConfigOverrides()
ReloadAllSubOptions()
RefreshAllOptionsUI()
@@ -58,7 +58,7 @@ Public Class PageVersionExport
Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String())
Panel.Children.Clear()
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 AcceptCompressedFile Then
@@ -100,7 +100,7 @@ Public Class PageVersionExport
Return False
End Try
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))
For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory)
AllEntries.Add($"{SubFolder.Name}\")
@@ -112,9 +112,9 @@ Public Class PageVersionExport
Dim IsVisible =
Function(TargetOption As ExportOption) As Boolean
'检查需要 OptiFine 或 Mod 加载器
If TargetOption.RequireOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine Then Return False
If TargetOption.RequireModLoader AndAlso Not PageVersionLeft.Version.Modable Then Return False
If TargetOption.RequireModLoaderOrOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine AndAlso Not PageVersionLeft.Version.Modable Then Return False
If TargetOption.RequireOptiFine AndAlso Not PageInstanceLeft.Instance.Version.HasOptiFine Then Return False
If TargetOption.RequireModLoader AndAlso Not PageInstanceLeft.Instance.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(
Function(Rule As String)
@@ -130,9 +130,9 @@ Public Class PageVersionExport
Rule = Rule.Trim("*?".ToCharArray)
If Rule.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries).Count >= 3 Then
If Rule.EndsWithF("\") Then
Return IsValidDirectory(New DirectoryInfo(PageVersionLeft.Version.PathIndie & Rule)) '文件夹有效
Return IsValidDirectory(New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Rule)) '文件夹有效
Else
Return File.Exists(PageVersionLeft.Version.PathIndie & Rule) '文件有效
Return File.Exists(PageInstanceLeft.Instance.PathIndie & Rule) '文件有效
End If
Else
Return False
@@ -324,9 +324,9 @@ Public Class PageVersionExport
ConfigLines.Add("# 二次分发可能违反使用协议，请尽量不要公开发布包含资源文件的整合包！")
ConfigLines.Add("DontCheckHostedAssets:" & CheckAdvancedInclude.Checked)
ConfigLines.Add("")
ConfigLines.Add("# 如果你想要打包上传到 Modrinth，启用此项会生成完全符合 Modrinth 要求的整合包文件。")
ConfigLines.Add("# 由于 Modrinth 要求，只能从 CurseForge 下载的资源将无法联网下载，会被直接放入整合包中。")
ConfigLines.Add("# 此选项与 IncludeLauncher、IncludeLauncherCustom、DontCheckHostedAssets 冲突。")
ConfigLines.Add("# 若资源未在 Modrinth 上托管，则将其原始文件直接放入整合包中。")
ConfigLines.Add("# 如果你想将整合包上传到 Modrinth，这能帮助你分辨哪些文件未在 Modrinth 上托管。")
ConfigLines.Add("# 此选项与 DontCheckHostedAssets 冲突。")
ConfigLines.Add("ModrinthUploadMode:" & CheckAdvancedModrinth.Checked)
ConfigLines.Add("")
ConfigLines.Add("# 导出的文件的存放位置。")
@@ -435,7 +435,7 @@ Public Class PageVersionExport
'缓存所需参数
Dim CacheFolder = RequestTaskTempFolder()
Dim OverridesFolder = CacheFolder & "modpack\overrides\"
Dim McVersion = PageVersionLeft.Version
Dim McVersion = PageInstanceLeft.Instance
Dim PathIndie As String = McVersion.PathIndie
Dim CheckHostedAssets As Boolean = Not CheckAdvancedInclude.Checked
Dim ModrinthUploadMode As Boolean = CheckAdvancedModrinth.Checked
@@ -530,7 +530,7 @@ Public Class PageVersionExport
Next
Loader.Progress = 0.97
'复制 PCL 版本设置
CopyDirectory(McVersion.Path & "PCL\", OverridesFolder & "PCL\")
CopyDirectory(McVersion.PathVersion & "PCL\", OverridesFolder & "PCL\")
WriteIni(OverridesFolder & "PCL\Setup.ini", "IsStar", False)
#If BETA Then
'复制 PCL 本体
@@ -589,7 +589,7 @@ Public Class PageVersionExport
RunInNewThread(
Sub()
Try
If ModrinthUploadMode Then Return 'Modrinth 上传模式下，不能从 CurseForge 获取信息
If ModrinthUploadMode Then Return 'Modrinth 上传模式下，不从 CurseForge 获取信息
Dim CurseForgeHashes = Loader.Input.Select(Function(m) m.CurseForgeHash)
Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432/", HttpMethod.Post,
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
@@ -648,17 +648,17 @@ Public Class PageVersionExport
Files.Add(New JObject From {
{"path", ModFile.Path.AfterFirst(OverridesFolder).Replace("\", "/")},
{"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}
})
File.Delete(ModFile.Path)
Next
Loader.Progress = 0.2
'导出最终 JSON 文件
Dim Dependencies As New JObject From {{"minecraft", McVersion.Version.McName}}
If McVersion.Version.HasForge Then Dependencies.Add("forge", McVersion.Version.ForgeVersion)
If McVersion.Version.HasFabric Then Dependencies.Add("fabric-loader", McVersion.Version.FabricVersion)
If McVersion.Version.HasNeoForge Then Dependencies.Add("neoforge", McVersion.Version.NeoForgeVersion)
Dim Dependencies As New JObject From {{"minecraft", McVersion.Version.VanillaName}}
If McVersion.Version.HasForge Then Dependencies.Add("forge", McVersion.Version.Forge)
If McVersion.Version.HasFabric Then Dependencies.Add("fabric-loader", McVersion.Version.Fabric)
If McVersion.Version.HasNeoForge Then Dependencies.Add("neoforge", McVersion.Version.NeoForge)
Dim ResultJson As New JObject From {
{"game", "minecraft"},
{"formatVersion", 1},
@@ -711,12 +711,6 @@ Public Class PageVersionExport
End If
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 上传模式
Private Sub CheckAdvancedInclude_Change(sender As Object, user As Boolean) Handles CheckAdvancedInclude.Change
If CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = False
Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceLeft.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<local:MyPageLeft x:Class="PageVersionLeft"
<local:MyPageLeft x:Class="PageInstanceLeft"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" AnimatedControl="PanItem">
Plain Craft Launcher 2/Pages/PageVersion/PageVersionLeft.xaml.vb → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceLeft.xaml.vb
+25 -25
View File
@@ -1,13 +1,13 @@
Public Class PageVersionLeft
Public Class PageInstanceLeft
Implements IRefreshable
''' <summary>
''' 当前显示设置的 MC 版本。
''' </summary>
Public Shared Version As McVersion = Nothing
Public Shared Instance As McInstance = Nothing
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
ItemModDisabled.Visibility = Visibility.Collapsed
Else
@@ -26,7 +26,7 @@
''' <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
'若使用 IsLoaded，则会导致模拟点击不被执行（模拟点击切换页面时，控件的 IsLoaded 为 False）
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -35,21 +35,21 @@
Public Function PageGet(Optional ID As FormMain.PageSubType = -1)
If ID = -1 Then ID = PageID
Select Case ID
Case FormMain.PageSubType.VersionOverall
If FrmVersionOverall Is Nothing Then FrmVersionOverall = New PageVersionOverall
Return FrmVersionOverall
Case FormMain.PageSubType.VersionMod
If FrmVersionMod Is Nothing Then FrmVersionMod = New PageVersionMod
Return FrmVersionMod
Case FormMain.PageSubType.VersionModDisabled
If FrmVersionModDisabled Is Nothing Then FrmVersionModDisabled = New PageVersionModDisabled
Return FrmVersionModDisabled
Case FormMain.PageSubType.VersionSetup
If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup
Return FrmVersionSetup
Case FormMain.PageSubType.VersionExport
If FrmVersionExport Is Nothing Then FrmVersionExport = New PageVersionExport
Return FrmVersionExport
Case FormMain.PageSubType.InstanceOverall
If FrmInstanceOverall Is Nothing Then FrmInstanceOverall = New PageInstanceOverall
Return FrmInstanceOverall
Case FormMain.PageSubType.InstanceMod
If FrmInstanceMod Is Nothing Then FrmInstanceMod = New PageInstanceMod
Return FrmInstanceMod
Case FormMain.PageSubType.InstanceModDisabled
If FrmInstanceModDisabled Is Nothing Then FrmInstanceModDisabled = New PageInstanceModDisabled
Return FrmInstanceModDisabled
Case FormMain.PageSubType.InstanceSetup
If IsNothing(FrmInstanceSetup) Then FrmInstanceSetup = New PageInstanceSetup
Return FrmInstanceSetup
Case FormMain.PageSubType.InstanceExport
If FrmInstanceExport Is Nothing Then FrmInstanceExport = New PageInstanceExport
Return FrmInstanceExport
Case Else
Throw New Exception("未知的版本设置子页面种类：" & ID)
End Select
@@ -99,19 +99,19 @@
End Sub
Public Sub Refresh(SubType As FormMain.PageSubType)
Select Case SubType
Case FormMain.PageSubType.VersionMod
PageVersionMod.Refresh()
Case FormMain.PageSubType.InstanceMod
PageInstanceMod.Refresh()
ItemMod.Checked = True
Case FormMain.PageSubType.VersionExport
If FrmVersionExport IsNot Nothing Then FrmVersionExport.RefreshAll()
Case FormMain.PageSubType.InstanceExport
If FrmInstanceExport IsNot Nothing Then FrmInstanceExport.RefreshAll()
ItemExport.Checked = True
End Select
End Sub
Public Sub Reset(sender As Object, e As EventArgs)
If MyMsgBox("是否要初始化该版本的版本独立设置？该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then
If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup
FrmVersionSetup.Reset()
If IsNothing(FrmInstanceSetup) Then FrmInstanceSetup = New PageInstanceSetup
FrmInstanceSetup.Reset()
ItemSetup.Checked = True
End If
End Sub
Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceMod.xaml
+1 -3
View File
@@ -2,7 +2,7 @@
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageVersionMod"
mc:Ignorable="d" x:Class="PageInstanceMod"
PanScroll="PanBack">
<Grid>
<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="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="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>
</local:MyCard>
<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="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="4" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="错误" x:Name="BtnFilterError" />
</StackPanel>
<StackPanel Margin="20,48,18,22" Name="PanList" VerticalAlignment="Top" />
</local:MyCard>
Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceMod.xaml.vb
+39 -100
View File
@@ -1,4 +1,4 @@
Public Class PageVersionMod
Public Class PageInstanceMod
Implements IRefreshable
#Region "初始化"
@@ -23,28 +23,22 @@
Btn.LabText.Margin = New Thickness(-2, 0, 8, 0)
Next
#If DEBUG Then
BtnManageCheck.Visibility = Visibility.Visible
#End If
End Sub
''' <summary>
''' 刷新 Mod 列表。
''' </summary>
Public Sub ReloadModList(Optional ForceReload As Boolean = False)
If LoaderRun(If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then
Log("[System] 已刷新 Mod 列表")
Filter = FilterType.All
PanBack.ScrollToHome()
SearchBox.Text = ""
End If
If Not LoaderRun(If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then Return
Log("[System] 已刷新 Mod 列表")
Filter = FilterType.All
PanBack.ScrollToHome()
SearchBox.Text = ""
End Sub
'强制刷新
Private Sub RefreshSelf() Implements IRefreshable.Refresh
Refresh()
End Sub
Public Shared Sub Refresh()
'强制刷新
Try
CompProjectCache.Clear()
CompFilesCache.Clear()
@@ -53,8 +47,8 @@
Catch ex As Exception
Log(ex, "强制刷新时清理本地 Mod 信息缓存失败")
End Try
If FrmVersionMod IsNot Nothing Then FrmVersionMod.ReloadModList(True) '无需 Else，还没加载刷个鬼的新
FrmVersionLeft.ItemMod.Checked = True
If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.ReloadModList(True) '无需 Else，还没加载刷个鬼的新
FrmInstanceLeft.ItemMod.Checked = True
Hint("正在刷新……", Log:=False)
End Sub
@@ -67,7 +61,7 @@
End If
End Sub
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 Region
@@ -109,8 +103,7 @@
AniControlEnabled += 1
Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry,
.ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.RawFileName)}
AddHandler Entry.OnCompUpdate, AddressOf NewItem.Refresh
NewItem.Refresh()
AddHandler Entry.OnUpdate, Sub() RunInUi(AddressOf NewItem.Refresh)
AniControlEnabled -= 1
Return NewItem
End Function
@@ -144,11 +137,7 @@
ToolTipService.SetVerticalOffset(BtnED, 30)
ToolTipService.SetHorizontalOffset(BtnED, 2)
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}
End If
sender.Buttons = {BtnCont, BtnOpen, BtnED, BtnDelete}
End Sub
''' <summary>
@@ -188,13 +177,11 @@
Dim EnabledCount As Integer = 0
Dim DisabledCount 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)))
AnyCount += 1
If ModItem.CanUpdate Then UpdateCount += 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.Unavailable) Then UnavalialeCount += 1
Next
'显示
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)
BtnFilterDisabled.Text = $"禁用 ({DisabledCount})"
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>
Private Sub BtnManageOpen_Click(sender As Object, e As EventArgs) Handles BtnManageOpen.Click, BtnHintOpen.Click
Try
Directory.CreateDirectory(PageVersionLeft.Version.PathIndie & "mods\")
OpenExplorer(PageVersionLeft.Version.PathIndie & "mods\")
Directory.CreateDirectory(PageInstanceLeft.Instance.PathIndie & "mods\")
OpenExplorer(PageInstanceLeft.Instance.PathIndie & "mods\")
Catch ex As Exception
Log(ex, "打开 Mods 文件夹失败", LogLevel.Msgbox)
End Try
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>
@@ -344,14 +311,14 @@
Return True
End If
'获取并检查目标版本
Dim TargetVersion As McVersion = McVersionCurrent
If FrmMain.PageCurrent = FormMain.PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version
If FrmMain.PageCurrent = FormMain.PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Modable Then
Dim Instance As McInstance = McInstanceSelected
If FrmMain.PageCurrent = FormMain.PageType.InstanceSetup Then Instance = PageInstanceLeft.Instance
If FrmMain.PageCurrent = FormMain.PageType.InstanceSelect OrElse Instance Is Nothing OrElse Not Instance.Modable Then
'正在选择版本，或当前版本不能安装 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 管理页面
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
'处于 Mod 管理页面
Install:
@@ -359,7 +326,7 @@ Install:
For Each ModFile In FilePathList
Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "").Replace(".old", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName)
CopyFile(ModFile, Instance.PathIndie & "mods\" & NewFileName)
Next
If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}！", HintType.Green)
@@ -367,8 +334,8 @@ Install:
Hint($"已安装 {FilePathList.Count} 个 Mod！", HintType.Green)
End If
'刷新列表
If FrmMain.PageCurrent = FormMain.PageType.VersionSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.VersionMod Then
LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
If FrmMain.PageCurrent = FormMain.PageType.InstanceSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.InstanceMod Then
LoaderFolderRun(McModLoader, Instance.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
End If
Catch ex As Exception
Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox)
@@ -382,7 +349,7 @@ Install:
''' </summary>
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
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadMod)
End Sub
@@ -455,10 +422,8 @@ Install:
BtnFilterEnabled.Checked = True
Case FilterType.Disabled
BtnFilterDisabled.Checked = True
Case FilterType.CanUpdate
BtnFilterCanUpdate.Checked = True
Case Else
BtnFilterError.Checked = True
BtnFilterCanUpdate.Checked = True
End Select
RefreshUI()
End Set
@@ -468,7 +433,6 @@ Install:
Enabled = 1
Disabled = 2
CanUpdate = 3
Unavailable = 4
End Enum
''' <summary>
@@ -484,15 +448,13 @@ Install:
Return CheckingMod.State = McMod.McModState.Disabled
Case FilterType.CanUpdate
Return CheckingMod.CanUpdate
Case FilterType.Unavailable
Return CheckingMod.State = McMod.McModState.Unavailable
Case Else
Return False
End Select
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
RefreshUI()
End Sub
@@ -586,7 +548,7 @@ Install:
''' <summary>
''' 记录正在进行 Mod 更新的 mods 文件夹路径。
''' </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))
'更新前警告
If Not Setup.Get("HintUpdateMod") OrElse ModList.Count >= 15 Then
@@ -665,8 +627,8 @@ Install:
End Try
End Sub))
'结束处理
Dim Loader As New LoaderCombo(Of IEnumerable(Of McMod))("Mod 更新：" & PageVersionLeft.Version.Name, InstallLoaders)
Dim PathMods As String = PageVersionLeft.Version.PathIndie & "mods\"
Dim Loader As New LoaderCombo(Of IEnumerable(Of McMod))("Mod 更新：" & PageInstanceLeft.Instance.Name, InstallLoaders)
Dim PathMods As String = PageInstanceLeft.Instance.PathIndie & "mods\"
Loader.OnStateChanged =
Sub()
'结果提示
@@ -688,7 +650,7 @@ Install:
Return
End Select
Log($"[Mod] 已从正在进行 Mod 更新的文件夹列表移除：{PathMods}")
UpdatingVersions.Remove(PathMods)
UpdatingInstanceModFolders.Remove(PathMods)
'清理缓存
RunInNewThread(
Sub()
@@ -703,7 +665,7 @@ Install:
End Sub
'启动加载器
Log($"[Mod] 开始更新 {ModList.Count} 个 Mod：{PathMods}")
UpdatingVersions.Add(PathMods)
UpdatingInstanceModFolders.Add(PathMods)
Loader.Start()
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
@@ -807,41 +769,27 @@ Install:
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
'跳转到 Mod 下载页面
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {ModEntry.Comp, New List(Of String), PageVersionLeft.Version.Version.McName,
If(PageVersionLeft.Version.Version.HasForge, CompModLoaderType.Forge,
If(PageVersionLeft.Version.Version.HasNeoForge, CompModLoaderType.NeoForge,
If(PageVersionLeft.Version.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any))),
.Additional = {ModEntry.Comp, New List(Of String), PageInstanceLeft.Instance.Version.VanillaName,
If(PageInstanceLeft.Instance.Version.HasForge, CompModLoaderType.Forge,
If(PageInstanceLeft.Instance.Version.HasNeoForge, CompModLoaderType.NeoForge,
If(PageInstanceLeft.Instance.Version.HasFabric, CompModLoaderType.Fabric, CompModLoaderType.Any))),
CompType.Mod}})
Else
'获取信息
Dim ContentLines As New List(Of String)
If ModEntry.Description IsNot Nothing Then ContentLines.Add(ModEntry.Description & vbCrLf)
If ModEntry.Authors IsNot Nothing Then ContentLines.Add("作者：" & ModEntry.Authors)
ContentLines.Add("文件：" & ModEntry.FileName & "（" & GetString(New FileInfo(ModEntry.Path).Length) & "）")
If ModEntry.Version IsNot Nothing Then ContentLines.Add("版本：" & ModEntry.Version)
Dim DebugInfo As New List(Of String)
If ModEntry.ModId IsNot Nothing Then
DebugInfo.Add("Mod ID：" & ModEntry.ModId)
End If
If ModEntry.Dependencies.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
ContentLines.Add("")
ContentLines.AddRange(DebugInfo)
End If
'获取用于搜索的 Mod 名称
Dim ModOriginalName As String = ModEntry.Name.Replace(" ", "+")
Dim ModOriginalName As String = ModEntry.DisplayName.Replace(" ", "+")
Dim ModSearchName As String = ModOriginalName.Substring(0, 1)
For i = 1 To ModOriginalName.Count - 1
Dim IsLastLower As Boolean = ModOriginalName(i - 1).ToString.ToLower.Equals(ModOriginalName(i - 1).ToString)
@@ -853,18 +801,9 @@ Install:
ModSearchName += ModOriginalName(i)
Next
ModSearchName = ModSearchName.Replace("++", "+").Replace("pti+Fine", "ptiFine")
'显示
If ModEntry.Url Is Nothing Then
If MyMsgBox(Join(ContentLines, vbCrLf), ModEntry.Name, "百科搜索", "返回") = 1 Then
OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0")
End 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
'百科搜索链接
If MyMsgBox(Join(ContentLines, vbCrLf), ModEntry.DisplayName, "百科搜索", "返回") = 1 Then
OpenWebsite("https://www.mcmod.cn/s?key=" & ModSearchName & "&site=all&filter=0")
End If
End If
Catch ex As Exception
@@ -907,7 +846,7 @@ Install:
Dim QueryList As New List(Of SearchEntry(Of McMod))
For Each Entry As McMod In McModLoader.Output
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))
If Entry.Version IsNot Nothing Then
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))
End If
If Entry.Comp IsNot Nothing Then
If Entry.Comp.RawName <> Entry.Name Then SearchSource.Add(New KeyValuePair(Of String, Double)(Entry.Comp.RawName, 1))
If Entry.Comp.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.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))
Plain Craft Launcher 2/Pages/PageVersion/PageVersionModDisabled.xaml → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceModDisabled.xaml
+1 -1
View File
@@ -1,4 +1,4 @@
<local:MyPageRight x:Class="PageVersionModDisabled"
<local:MyPageRight x:Class="PageInstanceModDisabled"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
Plain Craft Launcher 2/Pages/PageVersion/PageVersionModDisabled.xaml.vb → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceModDisabled.xaml.vb
+2 -2
View File
@@ -1,11 +1,11 @@
Class PageVersionModDisabled
Class PageInstanceModDisabled
Private Sub BtnDownload_Click(sender As Object, e As EventArgs) Handles BtnDownload.Click
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End Sub
Private Sub BtnVersion_Click(sender As Object, e As EventArgs) Handles BtnVersion.Click
FrmMain.PageChange(FormMain.PageType.Launch) '在版本选择页面选定版本的时候只会返回一层，因此如果不先锚定 Launch，在选择版本后会回退到版本设置的这个页面
FrmMain.PageChange(FormMain.PageType.VersionSelect)
FrmMain.PageChange(FormMain.PageType.InstanceSelect)
End Sub
Public Sub BtnDownload_Loaded() Handles BtnDownload.Loaded
Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceOverall.xaml
+2 -2
View File
@@ -3,7 +3,7 @@
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:System="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageVersionOverall"
mc:Ignorable="d" x:Class="PageInstanceOverall"
PanScroll="PanBack" Grid.IsSharedSizeScope="True">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10">
@@ -25,7 +25,7 @@
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="图标" Margin="0,0,25,0" />
<local:MyComboBox Grid.Column="1" x:Name="ComboDisplayLogo">
<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/CommandBlock.png" />
<local:MyComboBoxItem Content="金块" Tag="pack://application:,,,/images/Blocks/GoldBlock.png" />
Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceOverall.xaml.vb
+76 -78
View File
@@ -1,4 +1,4 @@
Public Class PageVersionOverall
Public Class PageInstanceOverall
Private IsLoad As Boolean = False
Private Sub PageSetupLaunch_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
@@ -7,7 +7,6 @@
PanBack.ScrollToHome()
'更新设置
ItemDisplayLogoCustom.Tag = "PCL\Logo.png"
Reload()
'非重复加载部分
@@ -17,7 +16,7 @@
End Sub
Public ItemVersion As MyListItem
Public InstanceHeaderItem As MyListItem
''' <summary>
''' 确保当前页面上的信息已正确显示。
''' </summary>
@@ -25,19 +24,19 @@
AniControlEnabled += 1
'刷新设置项目
ComboDisplayType.SelectedIndex = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto)
BtnDisplayStar.Text = If(PageVersionLeft.Version.IsStar, "从收藏夹中移除", "加入收藏夹")
BtnFolderMods.Visibility = If(PageVersionLeft.Version.Modable, Visibility.Visible, Visibility.Collapsed)
ComboDisplayType.SelectedIndex = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Auto)
BtnDisplayStar.Text = If(PageInstanceLeft.Instance.IsStar, "从收藏夹中移除", "加入收藏夹")
BtnFolderMods.Visibility = If(PageInstanceLeft.Instance.Modable, Visibility.Visible, Visibility.Collapsed)
'刷新版本显示
PanDisplayItem.Children.Clear()
ItemVersion = PageVersionLeft.Version.ToListItem
ItemVersion.IsHitTestVisible = False
PanDisplayItem.Children.Add(ItemVersion)
InstanceHeaderItem = PageInstanceLeft.Instance.ToListItem().Init()
InstanceHeaderItem.IsHitTestVisible = False
PanDisplayItem.Children.Add(InstanceHeaderItem)
FrmMain.PageNameRefresh()
'刷新版本图标
ComboDisplayLogo.SelectedIndex = 0
Dim Logo As String = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "Logo", "")
Dim LogoCustom As Boolean = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "LogoCustom", "False")
Dim Logo As String = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "Logo", "")
Dim LogoCustom As Boolean = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "LogoCustom", "False")
If LogoCustom Then
For Each Selection As MyComboBoxItem In ComboDisplayLogo.Items
If Selection.Tag = Logo OrElse (Selection.Tag = "PCL\Logo.png" AndAlso Logo.EndsWith("PCL\Logo.png")) Then
@@ -59,14 +58,14 @@
'改为不隐藏
Try
'若设置分类为可安装 Mod，则显示正常的 Mod 管理页面
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", ComboDisplayType.SelectedIndex)
PageVersionLeft.Version.DisplayType = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Auto)
FrmVersionLeft.RefreshModDisabled()
WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "DisplayType", ComboDisplayType.SelectedIndex)
PageInstanceLeft.Instance.DisplayType = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Auto)
FrmInstanceLeft.RefreshModDisabled()
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '要求刷新缓存
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "修改版本分类失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Feedback)
Log(ex, "修改版本分类失败（" & PageInstanceLeft.Instance.Name & "）", LogLevel.Feedback)
End Try
Reload() '更新 “打开 Mod 文件夹” 按钮
Else
@@ -79,11 +78,11 @@
End If
Setup.Set("HintHide", True)
End If
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "DisplayType", McVersionCardType.Hidden)
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '要求刷新缓存
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "DisplayType", McInstanceCardType.Hidden)
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "隐藏版本 " & PageVersionLeft.Version.Name & " 失败", LogLevel.Feedback)
Log(ex, "隐藏版本 " & PageInstanceLeft.Instance.Name & " 失败", LogLevel.Feedback)
End Try
End If
End Sub
@@ -91,14 +90,14 @@
'更改描述
Private Sub BtnDisplayDesc_Click(sender As Object, e As EventArgs) Handles BtnDisplayDesc.Click
Try
Dim OldInfo As String = ReadIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "CustomInfo")
Dim OldInfo As String = ReadIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "CustomInfo")
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)
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load()
If NewInfo IsNot Nothing AndAlso OldInfo <> NewInfo Then WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "CustomInfo", NewInfo)
PageInstanceLeft.Instance = New McInstance(PageInstanceLeft.Instance.Name).Load()
Reload()
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "版本 " & PageVersionLeft.Version.Name & " 描述更改失败", LogLevel.Msgbox)
Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 描述更改失败", LogLevel.Msgbox)
End Try
End Sub
@@ -106,32 +105,32 @@
Private Sub BtnDisplayRename_Click(sender As Object, e As EventArgs) Handles BtnDisplayRename.Click
Try
'确认输入的新名称
Dim OldName As String = PageVersionLeft.Version.Name
Dim OldPath As String = PageVersionLeft.Version.Path
Dim OldName As String = PageInstanceLeft.Instance.Name
Dim OldPath As String = PageInstanceLeft.Instance.PathVersion
'修改此部分的同时修改快速安装的版本名检测*
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
Dim NewPath As String = PathMcFolder & "versions\" & NewName & "\"
Dim NewPath As String = McFolderSelected & "versions\" & NewName & "\"
'获取临时中间名，以防止仅修改大小写的重命名失败
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
'重新读取版本 JSON 信息，避免 JsonObject 中已被合并的项被重新存储
Dim JsonObject As JObject
Dim OldJsonPath As String = PageVersionLeft.Version.GetJsonPath()
Dim OldJsonPath As String = PageInstanceLeft.Instance.GetJsonPath()
Try
JsonObject = GetJson(ReadFile(OldJsonPath))
Catch ex As Exception
Log(ex, "在重命名读取 json 时失败")
JsonObject = PageVersionLeft.Version.JsonObject
JsonObject = PageInstanceLeft.Instance.JsonObject
End Try
'重命名主文件夹
My.Computer.FileSystem.RenameDirectory(OldPath, TempName)
My.Computer.FileSystem.RenameDirectory(TempPath, NewName)
'清理 ini 缓存
IniClearCache(PageVersionLeft.Version.PathIndie & "options.txt")
IniClearCache(PageVersionLeft.Version.Path & "PCL\Setup.ini")
IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt")
IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini")
'重命名 jar 文件与 natives 文件夹
'不能进行遍历重命名，否则在版本名很短的时候容易误伤其他文件（#6443）
If Directory.Exists($"{NewPath}{OldName}-natives") Then
@@ -157,8 +156,8 @@
WriteFile(NewPath & "PCL\Setup.ini", ReadFile(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath))
End If
'更改已选中的版本
If ReadIni(PathMcFolder & "PCL.ini", "Version") = OldName Then
WriteIni(PathMcFolder & "PCL.ini", "Version", NewName)
If ReadIni(McFolderSelected & "PCL.ini", "Version") = OldName Then
WriteIni(McFolderSelected & "PCL.ini", "Version", NewName)
End If
'更新版本 Json
Try
@@ -170,10 +169,10 @@
End Try
'刷新与提示
Hint("重命名成功！", HintType.Green)
PageVersionLeft.Version = New McVersion(NewName).Load()
If Not IsNothing(McVersionCurrent) AndAlso McVersionCurrent.Equals(PageVersionLeft.Version) Then WriteIni(PathMcFolder & "PCL.ini", "Version", NewName)
PageInstanceLeft.Instance = New McInstance(NewName).Load()
If Not IsNothing(McInstanceSelected) AndAlso McInstanceSelected.Equals(PageInstanceLeft.Instance) Then WriteIni(McFolderSelected & "PCL.ini", "Version", NewName)
Reload()
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "重命名版本失败", LogLevel.Msgbox)
End Try
@@ -190,38 +189,38 @@
Reload() '还原选项
Return
End If
CopyFile(FileName, PageVersionLeft.Version.Path & "PCL\Logo.png")
CopyFile(FileName, PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
Else
File.Delete(PageVersionLeft.Version.Path & "PCL\Logo.png")
File.Delete(PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
End If
Catch ex As Exception
Log(ex, "更改自定义版本图标失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Feedback)
Log(ex, "更改自定义版本图标失败（" & PageInstanceLeft.Instance.Name & "）", LogLevel.Feedback)
End Try
'进行更改
Try
Dim NewLogo As String = ComboDisplayLogo.SelectedItem.Tag
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "Logo", NewLogo)
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "LogoCustom", Not NewLogo = "")
WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "Logo", NewLogo)
WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "LogoCustom", Not NewLogo = "")
'刷新显示
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "") '要求刷新缓存
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load()
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
PageInstanceLeft.Instance = New McInstance(PageInstanceLeft.Instance.Name).Load()
Reload()
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "更改版本图标失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Feedback)
Log(ex, "更改版本图标失败（" & PageInstanceLeft.Instance.Name & "）", LogLevel.Feedback)
End Try
End Sub
'收藏夹
Private Sub BtnDisplayStar_Click(sender As Object, e As EventArgs) Handles BtnDisplayStar.Click
Try
WriteIni(PageVersionLeft.Version.Path & "PCL\Setup.ini", "IsStar", Not PageVersionLeft.Version.IsStar)
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load()
WriteIni(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini", "IsStar", Not PageInstanceLeft.Instance.IsStar)
PageInstanceLeft.Instance = New McInstance(PageInstanceLeft.Instance.Name).Load()
Reload()
McVersionListForceRefresh = True
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
McInstanceListForceRefresh = True
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "版本 " & PageVersionLeft.Version.Name & " 收藏状态更改失败", LogLevel.Msgbox)
Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 收藏状态更改失败", LogLevel.Msgbox)
End Try
End Sub
@@ -231,22 +230,22 @@
'版本文件夹
Private Sub BtnFolderVersion_Click() Handles BtnFolderVersion.Click
OpenVersionFolder(PageVersionLeft.Version)
OpenInstanceFolder(PageInstanceLeft.Instance)
End Sub
Public Shared Sub OpenVersionFolder(Version As McVersion)
OpenExplorer(Version.Path)
Public Shared Sub OpenInstanceFolder(Instance As McInstance)
OpenExplorer(Instance.PathVersion)
End Sub
'存档文件夹
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)
OpenExplorer(FolderPath)
End Sub
'Mod 文件夹
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)
OpenExplorer(FolderPath)
End Sub
@@ -259,7 +258,7 @@
Private Sub BtnManageScript_Click() Handles BtnManageScript.Click
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 McLaunchLoader.State = LoadState.Loading Then
@@ -267,7 +266,7 @@
Return
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
Hint("正在导出启动脚本……")
Else
@@ -275,7 +274,7 @@
End If
End If
Catch ex As Exception
Log(ex, "导出启动脚本失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Msgbox)
Log(ex, "导出启动脚本失败（" & PageInstanceLeft.Instance.Name & "）", LogLevel.Msgbox)
End Try
End Sub
@@ -283,18 +282,18 @@
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try
'忽略文件检查提示
If ShouldIgnoreFileCheck(PageVersionLeft.Version) Then
If ShouldIgnoreFileCheck(PageInstanceLeft.Instance) Then
Hint("请先关闭 [版本设置 → 设置 → 高级启动选项 → 关闭文件校验]，然后再尝试补全文件！", HintType.Blue)
Return
End If
'重复任务检查
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)
Return
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 =
Sub()
Select Case Loader.State
@@ -306,12 +305,12 @@
Hint(Loader.Name & "已取消！", HintType.Blue)
End Select
End Sub
Loader.Start(PageVersionLeft.Version.Name)
Loader.Start(PageInstanceLeft.Instance.Name)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "尝试补全文件失败（" & PageVersionLeft.Version.Name & "）", LogLevel.Msgbox)
Log(ex, "尝试补全文件失败（" & PageInstanceLeft.Instance.Name & "）", LogLevel.Msgbox)
End Try
End Sub
@@ -320,29 +319,28 @@
Private Sub BtnManageDelete_Click(sender As Object, e As EventArgs) Handles BtnManageDelete.Click
Try
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim IsHintIndie As Boolean = PageVersionLeft.Version.State <> McVersionState.Error AndAlso PageVersionLeft.Version.PathIndie <> PathMcFolder
Select Case MyMsgBox($"你确定要{If(IsShiftPressed, "永久", "")}删除版本 {PageVersionLeft.Version.Name} 吗？" &
Dim IsHintIndie As Boolean = PageInstanceLeft.Instance.State <> McInstanceState.Error AndAlso PageInstanceLeft.Instance.PathIndie <> McFolderSelected
Select Case MyMsgBox($"你确定要{If(IsShiftPressed, "永久", "")}删除版本 {PageInstanceLeft.Instance.Name} 吗？" &
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""),
"版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed)
Case 1
IniClearCache(PageVersionLeft.Version.PathIndie & "options.txt")
IniClearCache(PageVersionLeft.Version.Path & "PCL\Setup.ini")
IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt")
IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(PageVersionLeft.Version.Path)
Hint("版本 " & PageVersionLeft.Version.Name & " 已永久删除！", HintType.Green)
DeleteDirectory(PageInstanceLeft.Instance.PathVersion)
Else
FileIO.FileSystem.DeleteDirectory(PageVersionLeft.Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & PageVersionLeft.Version.Name & " 已删除到回收站！", HintType.Green)
FileIO.FileSystem.DeleteDirectory(PageInstanceLeft.Instance.PathVersion, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
Hint("已删除版本 " & PageInstanceLeft.Instance.Name & "！", HintType.Green)
Case 2
Return
End Select
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
FrmMain.PageBack()
Catch ex As OperationCanceledException
Log(ex, "删除版本 " & PageVersionLeft.Version.Name & " 被主动取消")
Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 被主动取消")
Catch ex As Exception
Log(ex, "删除版本 " & PageVersionLeft.Version.Name & " 失败", LogLevel.Msgbox)
Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 失败", LogLevel.Msgbox)
End Try
End Sub
Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceSetup.xaml
+1 -1
View File
@@ -3,7 +3,7 @@
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:System="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageVersionSetup"
mc:Ignorable="d" x:Class="PageInstanceSetup"
PanScroll="PanBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,25,25,25">
Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb → Plain Craft Launcher 2/Pages/PageInstance/PageInstanceSetup.xaml.vb
+72 -72
View File
@@ -1,4 +1,4 @@
Public Class PageVersionSetup
Public Class PageInstanceSetup
Private Shadows IsLoaded As Boolean = False
@@ -27,41 +27,41 @@
Try
'启动参数
TextArgumentTitle.Text = Setup.Get("VersionArgumentTitle", Version:=PageVersionLeft.Version)
TextArgumentInfo.Text = Setup.Get("VersionArgumentInfo", Version:=PageVersionLeft.Version)
Dim _unused = PageVersionLeft.Version.PathIndie '触发自动判定
ComboArgumentIndieV2.SelectedIndex = If(Setup.Get("VersionArgumentIndieV2", Version:=PageVersionLeft.Version), 0, 1)
TextArgumentTitle.Text = Setup.Get("VersionArgumentTitle", Instance:=PageInstanceLeft.Instance)
TextArgumentInfo.Text = Setup.Get("VersionArgumentInfo", Instance:=PageInstanceLeft.Instance)
Dim _unused = PageInstanceLeft.Instance.PathIndie '触发自动判定
ComboArgumentIndieV2.SelectedIndex = If(Setup.Get("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance), 0, 1)
RefreshJavaComboBox()
'游戏内存
CType(FindName("RadioRamType" & Setup.Load("VersionRamType", Version:=PageVersionLeft.Version)), MyRadioBox).Checked = True
SliderRamCustom.Value = Setup.Get("VersionRamCustom", Version:=PageVersionLeft.Version)
ComboRamOptimize.SelectedIndex = Setup.Get("VersionRamOptimize", Version:=PageVersionLeft.Version)
CType(FindName("RadioRamType" & Setup.Load("VersionRamType", Instance:=PageInstanceLeft.Instance)), MyRadioBox).Checked = True
SliderRamCustom.Value = Setup.Get("VersionRamCustom", Instance:=PageInstanceLeft.Instance)
ComboRamOptimize.SelectedIndex = Setup.Get("VersionRamOptimize", Instance:=PageInstanceLeft.Instance)
'服务器
TextServerEnter.Text = Setup.Get("VersionServerEnter", Version:=PageVersionLeft.Version)
ComboServerLogin.SelectedIndex = Setup.Get("VersionServerLogin", Version:=PageVersionLeft.Version)
TextServerEnter.Text = Setup.Get("VersionServerEnter", Instance:=PageInstanceLeft.Instance)
ComboServerLogin.SelectedIndex = Setup.Get("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
ComboServerLoginLast = ComboServerLogin.SelectedIndex
ServerLogin(ComboServerLogin.SelectedIndex)
TextServerNide.Text = Setup.Get("VersionServerNide", Version:=PageVersionLeft.Version)
TextServerAuthServer.Text = Setup.Get("VersionServerAuthServer", Version:=PageVersionLeft.Version)
TextServerAuthName.Text = Setup.Get("VersionServerAuthName", Version:=PageVersionLeft.Version)
TextServerAuthRegister.Text = Setup.Get("VersionServerAuthRegister", Version:=PageVersionLeft.Version)
TextServerNide.Text = Setup.Get("VersionServerNide", Instance:=PageInstanceLeft.Instance)
TextServerAuthServer.Text = Setup.Get("VersionServerAuthServer", Instance:=PageInstanceLeft.Instance)
TextServerAuthName.Text = Setup.Get("VersionServerAuthName", Instance:=PageInstanceLeft.Instance)
TextServerAuthRegister.Text = Setup.Get("VersionServerAuthRegister", Instance:=PageInstanceLeft.Instance)
'高级设置
TextAdvanceJvm.Text = Setup.Get("VersionAdvanceJvm", Version:=PageVersionLeft.Version)
TextAdvanceGame.Text = Setup.Get("VersionAdvanceGame", Version:=PageVersionLeft.Version)
TextAdvanceRun.Text = Setup.Get("VersionAdvanceRun", Version:=PageVersionLeft.Version)
CheckAdvanceRunWait.Checked = Setup.Get("VersionAdvanceRunWait", Version:=PageVersionLeft.Version)
If Setup.Get("VersionAdvanceAssets", Version:=PageVersionLeft.Version) = 2 Then
TextAdvanceJvm.Text = Setup.Get("VersionAdvanceJvm", Instance:=PageInstanceLeft.Instance)
TextAdvanceGame.Text = Setup.Get("VersionAdvanceGame", Instance:=PageInstanceLeft.Instance)
TextAdvanceRun.Text = Setup.Get("VersionAdvanceRun", Instance:=PageInstanceLeft.Instance)
CheckAdvanceRunWait.Checked = Setup.Get("VersionAdvanceRunWait", Instance:=PageInstanceLeft.Instance)
If Setup.Get("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) = 2 Then
Log("[Setup] 已迁移老版本的关闭文件校验设置")
Setup.Reset("VersionAdvanceAssets", Version:=PageVersionLeft.Version)
Setup.Set("VersionAdvanceAssetsV2", True, Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance)
Setup.Set("VersionAdvanceAssetsV2", True, Instance:=PageInstanceLeft.Instance)
End If
CheckAdvanceAssetsV2.Checked = Setup.Get("VersionAdvanceAssetsV2", Version:=PageVersionLeft.Version)
CheckAdvanceJava.Checked = Setup.Get("VersionAdvanceJava", Version:=PageVersionLeft.Version)
CheckAdvanceDisableJLW.Checked = Setup.Get("VersionAdvanceDisableJLW", Version:=PageVersionLeft.Version)
CheckAdvanceDisableModUpdate.Checked = Setup.Get("VersionAdvanceDisableModUpdate", Version:=PageVersionLeft.Version)
CheckAdvanceAssetsV2.Checked = Setup.Get("VersionAdvanceAssetsV2", Instance:=PageInstanceLeft.Instance)
CheckAdvanceJava.Checked = Setup.Get("VersionAdvanceJava", Instance:=PageInstanceLeft.Instance)
CheckAdvanceDisableJLW.Checked = Setup.Get("VersionAdvanceDisableJLW", Instance:=PageInstanceLeft.Instance)
CheckAdvanceDisableModUpdate.Checked = Setup.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance)
Catch ex As Exception
Log(ex, "重载版本独立设置时出错", LogLevel.Feedback)
@@ -72,29 +72,29 @@
Public Sub Reset()
Try
Setup.Reset("VersionServerEnter", Version:=PageVersionLeft.Version)
Setup.Reset("VersionServerLogin", Version:=PageVersionLeft.Version)
Setup.Reset("VersionServerNide", Version:=PageVersionLeft.Version)
Setup.Reset("VersionServerAuthServer", Version:=PageVersionLeft.Version)
Setup.Reset("VersionServerAuthRegister", Version:=PageVersionLeft.Version)
Setup.Reset("VersionServerAuthName", Version:=PageVersionLeft.Version)
Setup.Reset("VersionArgumentTitle", Version:=PageVersionLeft.Version)
Setup.Reset("VersionArgumentInfo", Version:=PageVersionLeft.Version)
Setup.Reset("VersionArgumentIndieV2", Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamType", Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamCustom", Version:=PageVersionLeft.Version)
Setup.Reset("VersionRamOptimize", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceJvm", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceGame", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceAssets", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceAssetsV2", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceJava", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceRun", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceRunWait", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceDisableJLW", Version:=PageVersionLeft.Version)
Setup.Reset("VersionAdvanceDisableModUpdate", Version:=PageVersionLeft.Version)
Setup.Reset("VersionServerEnter", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerNide", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerAuthServer", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerAuthRegister", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionServerAuthName", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentTitle", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentInfo", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionRamType", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionRamCustom", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionRamOptimize", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceJvm", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceGame", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceAssetsV2", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceJava", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceRun", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceRunWait", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceDisableJLW", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance)
Setup.Reset("VersionArgumentJavaSelect", Version:=PageVersionLeft.Version)
Setup.Reset("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
JavaSearchLoader.Start(IsForceRestart:=True)
Log("[Setup] 已初始化版本独立设置")
@@ -108,27 +108,27 @@
'将控件改变路由到设置改变
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
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
'#3194，不能删减 /
'Dim HandledText As String = sender.Text
'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 Sub
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderRamCustom.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value, Version:=PageVersionLeft.Version)
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value, Instance:=PageInstanceLeft.Instance)
End Sub
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
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
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
#Region "游戏内存"
@@ -142,9 +142,9 @@
''' 刷新 UI 上的 RAM 显示。
''' </summary>
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 RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024, 1)
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)", "")
LabRamUsed.Text = If(RamUsed = Math.Floor(RamUsed), RamUsed & ".0", RamUsed) & " GB"
LabRamTotal.Text = " / " & If(RamTotal = Math.Floor(RamTotal), RamTotal & ".0", RamTotal) & " GB"
LabRamWarn.Visibility = If(RamGame = 1 AndAlso Not 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
'宽度动画
AniStart({
@@ -269,10 +269,10 @@
''' <summary>
''' 获取当前设置的 RAM 值。单位为 GB。
''' </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
Return PageSetupLaunch.GetRam(Version, True, Is32BitJava)
If Setup.Get("VersionRamType", Instance:=Instance) = 2 Then
Return PageSetupLaunch.GetRam(Instance, True, Is32BitJava)
End If
'------------------------------------------
@@ -281,7 +281,7 @@
'使用当前版本的设置
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
'确定需求的内存值
@@ -289,16 +289,16 @@
Dim RamTarget1 As Double '估计能勉强带动了的内存
Dim RamTarget2 As Double '估计没啥问题了的内存
Dim RamTarget3 As Double '安装过多附加组件需要的内存
If Version IsNot Nothing AndAlso Not Version.IsLoaded Then Version.Load()
If Version IsNot Nothing AndAlso Version.Modable Then
If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load()
If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 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)
RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90
RamTarget2 = 2.7 + ModCount / 50
RamTarget3 = 4.5 + ModCount / 25
ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then
ElseIf Instance IsNot Nothing AndAlso Instance.Version.HasOptiFine Then
'OptiFine 版本
RamMininum = 0.5
RamTarget1 = 1.5
@@ -337,7 +337,7 @@ PreFin:
RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1)
Else
'手动配置
Dim Value As Integer = Setup.Get("VersionRamCustom", Version:=Version)
Dim Value As Integer = Setup.Get("VersionRamCustom", Instance:=Instance)
If Value <= 12 Then
RamGive = Value * 0.1 + 0.3
ElseIf Value <= 25 Then
@@ -349,7 +349,7 @@ PreFin:
End If
End If
'若使用 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
End Function
@@ -423,9 +423,9 @@ PreFin:
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"})
'更新列表
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
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}
ToolTipService.SetHorizontalOffset(ListItem, 400)
ComboArgumentJava.Items.Add(ListItem)
@@ -434,7 +434,7 @@ PreFin:
If JavaEntry.FromJson(GetJson(SelectedBySetup)).PathFolder = Java.PathFolder Then SelectedItem = ListItem
Next
Catch ex As Exception
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=PageVersionLeft.Version)
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log(ex, "更新版本设置 Java 下拉框失败", LogLevel.Feedback)
End Try
'更新选择项
@@ -469,15 +469,15 @@ PreFin:
Dim SelectedJava = ComboArgumentJava.SelectedItem.Tag
If "使用全局设置".Equals(SelectedJava) Then
'选择 “自动”
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=PageVersionLeft.Version)
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置：跟随全局设置")
ElseIf "自动选择".Equals(SelectedJava) Then
'选择 “自动”
Setup.Set("VersionArgumentJavaSelect", "", Version:=PageVersionLeft.Version)
Setup.Set("VersionArgumentJavaSelect", "", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置：自动选择")
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)
End If
RefreshRam(True)
Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb
+3 -3
View File
@@ -178,7 +178,7 @@
Try
'更新缓存
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}
SkinLoader.WaitForExit(IsForceRestart:=True)
@@ -244,13 +244,13 @@ Retry:
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"},
{"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}, {"Minecraft Experience", "村民救援披风"},
{"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 = "无披风"}}
For Each Cape In SkinData("capes")
Dim CapeName As String = Cape("alias").ToString
If CapeNames.ContainsKey(CapeName) Then CapeName = CapeNames(CapeName)
SelectionControl.Add(New MyRadioBox With {.Text = CapeName, .Checked = (Cape("state") = "ACTIVE")})
SelectionControl.Add(New MyRadioBox With {.Text = CapeName, .Checked = Cape("state")?.ToString = "ACTIVE"})
Next
SelId = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb
+68 -69
View File
@@ -14,7 +14,7 @@
AniControlEnabled += 1
'开始按钮
AddHandler McVersionListLoader.LoadingStateChanged, AddressOf RefreshButtonsUI
AddHandler McInstanceListLoader.LoadingStateChanged, AddressOf RefreshButtonsUI
AddHandler McFolderListLoader.LoadingStateChanged, AddressOf RefreshButtonsUI
RefreshButtonsUI()
@@ -37,18 +37,18 @@
McFolderListLoader.WaitForExit()
End If
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
McFolderSelected = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If McFolderSelected = "" OrElse Not Directory.Exists(McFolderSelected) Then
'无效的文件夹
If PathMcFolder = "" Then
If McFolderSelected = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹")
Else
Log("[Launch] Minecraft 文件夹无效，该文件夹已不存在：" & PathMcFolder, LogLevel.Debug)
Log("[Launch] Minecraft 文件夹无效，该文件夹已不存在：" & McFolderSelected, LogLevel.Debug)
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
Setup.Set("LaunchFolderSelect", McFolderList(0).Location.Replace(Path, "$"))
End If
Log("[Launch] Minecraft 文件夹：" & PathMcFolder)
Log("[Launch] Minecraft 文件夹：" & McFolderSelected)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'自动整合包安装
If PackInstallPath IsNot Nothing Then
@@ -68,24 +68,24 @@
End If
'确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion = If(Selection = "", Nothing, New McVersion(Selection))
If Version Is Nothing OrElse Not Version.Path.StartsWithF(PathMcFolder) OrElse Not Version.Check() Then
Dim Instance As McInstance = If(Selection = "", Nothing, New McInstance(Selection))
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))
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing
Log("[Launch] 当前选择的 Minecraft 版本无效：" & If(Instance Is Nothing, "null", Instance.PathVersion), If(IsNothing(Instance), LogLevel.Normal, LogLevel.Debug))
If Not McInstanceListLoader.State = LoadState.Finished Then LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McInstanceList.Any() OrElse McInstanceList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Instance = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Launch] 无可用 Minecraft 版本")
Else
Version = McVersionList.First.Value(0)
Setup.Set("LaunchVersionSelect", Version.Name)
Log("[Launch] 自动选择 Minecraft 版本：" & Version.Path)
Instance = McInstanceList.First.Value(0)
Setup.Set("LaunchVersionSelect", Instance.Name)
Log("[Launch] 自动选择 Minecraft 版本：" & Instance.PathVersion)
End If
End If
RunInUi(
Sub()
McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
McInstanceSelected = Instance '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
IsLoadFinished = True
RefreshButtonsUI()
RefreshPage(False, False) '有可能选择的版本变化了，需要重新刷新
@@ -119,7 +119,7 @@
LabLaunchingMethod.Text = "Authlib-Injector"
End Select
'初始化页面
LabLaunchingName.Text = McVersionCurrent.Name
LabLaunchingName.Text = McInstanceSelected.Name
LabLaunchingStage.Text = "初始化"
LabLaunchingTitle.Text = If(CurrentLaunchOptions?.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")
LabLaunchingProgress.Text = "0.00 %"
@@ -278,9 +278,9 @@
'获取页面的可用种类并回写缓存
Dim Type As PageType
Dim LoginPageType As Integer
If McVersionCurrent IsNot Nothing Then
LoginPageType = Setup.Get("VersionServerLogin", Version:=McVersionCurrent)
'缓存当前版本的页面种类，下一次打开 McVersionCurrent 为空时才能加载出正确的页面
If McInstanceSelected IsNot Nothing Then
LoginPageType = Setup.Get("VersionServerLogin", Instance:=McInstanceSelected)
'缓存当前版本的页面种类，下一次打开 McInstanceSelected 为空时才能加载出正确的页面
Setup.Set("LoginPageType", LoginPageType)
Else
LoginPageType = Setup.Get("LoginPageType")
@@ -344,7 +344,7 @@ UnknownType:
PanType.Visibility = Visibility.Collapsed
PanTypeOne.Visibility = Visibility.Visible
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard)
LabTypeOne.Text = If(McVersionCurrent Is Nothing, Setup.Get("CacheAuthServerName"), Setup.Get("VersionServerAuthName", Version:=McVersionCurrent))
LabTypeOne.Text = If(McInstanceSelected Is Nothing, Setup.Get("CacheAuthServerName"), Setup.Get("VersionServerAuthName", Instance:=McInstanceSelected))
If LabTypeOne.Text = "" Then LabTypeOne.Text = "第三方登录"
Case Else
Log("[Control] 未知的登录页面：" & LoginPageType, LogLevel.Hint)
@@ -591,7 +591,7 @@ Finish:
'版本选择按钮
Private Sub BtnVersion_Click(sender As Object, e As EventArgs) Handles BtnVersion.Click
If McLaunchLoader.State = LoadState.Loading Then Return
FrmMain.PageChange(FormMain.PageType.VersionSelect)
FrmMain.PageChange(FormMain.PageType.InstanceSelect)
End Sub
'启动按钮
Public Sub LaunchButtonClick() Handles BtnLaunch.Click
@@ -615,15 +615,15 @@ Finish:
End If
End Sub
Private BtnLaunchState As Integer = 0
Private BtnLaunchVersion As McVersion = Nothing
Private BtnLaunchInstance As McInstance = Nothing
Public Sub RefreshButtonsUI() Handles BtnLaunch.Loaded
If Not BtnLaunch.IsLoaded Then Return
'获取当前状态
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
Else
If McVersionCurrent Is Nothing Then
If McInstanceSelected Is Nothing Then
If Setup.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow Then
CurrentState = 1
Else
@@ -635,8 +635,8 @@ Finish:
End If
'更新状态
If CurrentState = BtnLaunchState AndAlso
If(McVersionCurrent Is Nothing, "", McVersionCurrent.Path) = If(BtnLaunchVersion Is Nothing, "", BtnLaunchVersion.Path) Then GoTo ExitRefresh
BtnLaunchVersion = McVersionCurrent
If(McInstanceSelected Is Nothing, "", McInstanceSelected.PathVersion) = If(BtnLaunchInstance Is Nothing, "", BtnLaunchInstance.PathVersion) Then GoTo ExitRefresh
BtnLaunchInstance = McInstanceSelected
BtnLaunchState = CurrentState
Select Case CurrentState
Case 0
@@ -661,11 +661,11 @@ Finish:
FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 3
Log("[Minecraft] 启动按钮：Minecraft 版本：" & McVersionCurrent.Path)
Log("[Minecraft] 启动按钮：Minecraft 版本：" & McInstanceSelected.PathVersion)
FrmLaunchLeft.BtnLaunch.Text = "启动游戏"
FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnLaunch.IsEnabled = True
FrmLaunchLeft.LabVersion.Text = McVersionCurrent.Name
FrmLaunchLeft.LabVersion.Text = McInstanceSelected.Name
'FrmLaunchLeft.BtnMore.Visibility = Visibility.Visible '由功能隐藏设置修改
End Select
ExitRefresh:
@@ -694,12 +694,12 @@ ExitRefresh:
'版本设置按钮
Private Sub BtnMore_Click(sender As Object, e As EventArgs) Handles BtnMore.Click
If McLaunchLoader.State = LoadState.Loading Then Return
McVersionCurrent.Load()
PageVersionLeft.Version = McVersionCurrent
FrmMain.PageChange(FormMain.PageType.VersionSetup, 0)
McInstanceSelected.Load()
PageInstanceLeft.Instance = McInstanceSelected
FrmMain.PageChange(FormMain.PageType.InstanceSetup, 0)
End Sub
''' <summary>
''' 每 0.2s 执行一次，刷新启动的数据 UI 显示。
''' 每 0.1s 执行一次，刷新启动的数据 UI 显示。
''' </summary>
Public Sub LaunchingRefresh()
Try
@@ -719,20 +719,27 @@ ExitRefresh:
Log(ex, "获取是否启动完成失败，可能是由于启动状态改变导致集合已修改")
Return
End Try
LabLaunchingTitle.Text = If(IsLaunched OrElse McLaunchLoaderReal.State = LoadState.Finished,
"已启动游戏",
If(CurrentLaunchOptions.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本"))
If AniIsRun("Launch State Page") Then IsLaunched = False '等待页面切换动画完成
'计算应显示的进度
'更新进度
Dim ActualProgress = McLaunchLoaderReal.Progress
If ActualProgress >= ShowProgress Then ShowProgress += (ActualProgress - ShowProgress) * 0.2 + 0.005 '向实际进度靠一点
If ActualProgress >= ShowProgress Then ShowProgress += (ActualProgress - ShowProgress) * 0.1 + 0.0025 '向实际进度靠一点
If ActualProgress <= ShowProgress Then ShowProgress = ActualProgress '原来或处理后变得比实际进度高，直接回退
If IsLaunched Then ShowProgress = 1 '如果已经完成了，就不卖关子了
'文本
LabLaunchingTitle.Text = If(IsLaunched, "已启动游戏", If(CurrentLaunchOptions.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本"))
LabLaunchingProgress.Text = StrFillNum(ShowProgress * 100, 2) & " %"
LabLaunchingProgress.Text = (ShowProgress * 100).ToString("0.00") & " %"
'更新下载速度
Dim HasLaunchDownloader As Boolean = False
Try
For Each Loader In NetManager.Tasks
If Loader.RealParent IsNot Nothing AndAlso Loader.RealParent.Name = "Minecraft 启动" AndAlso Loader.State = LoadState.Loading Then HasLaunchDownloader = True
Next
If NetManager.Speed = 0 AndAlso LabLaunchingDownload.Visibility = Visibility.Collapsed Then
'可能只是在检查文件，没有实际下载
HasLaunchDownloader = False
Else
For Each Loader In NetManager.Tasks
If Loader.RealParent IsNot Nothing AndAlso Loader.RealParent.Name = "Minecraft 启动" AndAlso Loader.State = LoadState.Loading Then HasLaunchDownloader = True
Next
End If
Catch ex As Exception
Log(ex, "获取 Minecraft 启动下载器失败，可能是因为启动被取消")
HasLaunchDownloader = False
@@ -740,41 +747,33 @@ ExitRefresh:
LabLaunchingDownload.Text = GetString(NetManager.Speed) & "/s"
'进度改变动画
Dim AnimList As New List(Of AniData) From {
AaGridLengthWidth(ProgressLaunchingFinished, ShowProgress - ProgressLaunchingFinished.Width.Value, 260,, New AniEaseOutFluent),
AaGridLengthWidth(ProgressLaunchingUnfinished, 1 - ShowProgress - ProgressLaunchingUnfinished.Width.Value, 260,, New AniEaseOutFluent)
AaGridLengthWidth(ProgressLaunchingFinished, ShowProgress - ProgressLaunchingFinished.Width.Value, 130,, New AniEaseOutFluent),
AaGridLengthWidth(ProgressLaunchingUnfinished, 1 - ShowProgress - ProgressLaunchingUnfinished.Width.Value, 130,, New AniEaseOutFluent)
}
Dim IsDownloadStateChanged As Boolean = HasLaunchDownloader = (LabLaunchingDownload.Visibility = Visibility.Collapsed)
If IsDownloadStateChanged Then
If HasLaunchDownloader = (LabLaunchingDownload.Visibility = Visibility.Collapsed) Then 'IsDownloadStateChanged
LabLaunchingDownload.Visibility = Visibility.Visible
LabLaunchingDownloadLeft.Visibility = Visibility.Visible
AnimList.AddRange({
AaOpacity(LabLaunchingDownload, If(HasLaunchDownloader, 1, 0) - LabLaunchingDownload.Opacity, 100),
AaOpacity(LabLaunchingDownloadLeft, If(HasLaunchDownloader, 0.5, 0) - LabLaunchingDownloadLeft.Opacity, 100),
AaCode(Sub()
If Not HasLaunchDownloader Then
LabLaunchingDownload.Visibility = Visibility.Collapsed
LabLaunchingDownloadLeft.Visibility = Visibility.Collapsed
End If
End Sub, 110)
})
AaOpacity(LabLaunchingDownload, If(HasLaunchDownloader, 1, 0) - LabLaunchingDownload.Opacity, 90),
AaOpacity(LabLaunchingDownloadLeft, If(HasLaunchDownloader, 0.5, 0) - LabLaunchingDownloadLeft.Opacity, 90),
AaCode(
Sub()
If Not HasLaunchDownloader Then
LabLaunchingDownload.Visibility = Visibility.Collapsed
LabLaunchingDownloadLeft.Visibility = Visibility.Collapsed
End If
End Sub, 110)
})
End If
Dim IsProgressStateChanged As Boolean = (Not IsLaunched) = (LabLaunchingProgress.Visibility = Visibility.Collapsed)
If IsProgressStateChanged Then
If (Not IsLaunched) = (LabLaunchingProgress.Visibility = Visibility.Collapsed) Then 'IsProgressStateChanged
LabLaunchingProgress.Visibility = Visibility.Visible
LabLaunchingProgressLeft.Visibility = Visibility.Visible
If IsLaunched Then
'IsWidthAnimating = True
PanLaunchingHint.Visibility = Visibility.Visible
'AniStop("Launching Info Width")
'PanLaunchingInfo.Width = 260
'ActualUsedWidth = 260
'IsWidthAnimating = False
End If
If IsLaunched Then PanLaunchingHint.Visibility = Visibility.Visible
AnimList.AddRange({
AaOpacity(LabLaunchingProgress, If(Not IsLaunched, 1, 0) - LabLaunchingProgress.Opacity, 100),
AaOpacity(LabLaunchingProgressLeft, If(Not IsLaunched, 0.5, 0) - LabLaunchingProgressLeft.Opacity, 100),
AaOpacity(PanLaunchingHint, If(IsLaunched, 1, 0) - PanLaunchingHint.Opacity, 100)
})
AaOpacity(LabLaunchingProgress, If(Not IsLaunched, 1, 0) - LabLaunchingProgress.Opacity, 90),
AaOpacity(LabLaunchingProgressLeft, If(Not IsLaunched, 0.5, 0) - LabLaunchingProgressLeft.Opacity, 90),
AaOpacity(PanLaunchingHint, If(IsLaunched, 1, 0) - PanLaunchingHint.Opacity, 90)
})
End If
AniStart(AnimList, "Launching Progress")
Catch ex As Exception
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb
+6
View File
@@ -107,6 +107,12 @@ Public Class PageLaunchRight
Case 13
Log("[Page] 主页预设：PCL 更新摘要")
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
'联网下载
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuth.xaml.vb
+4 -4
View File
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。
''' </summary>
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
Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = "", .Password = "", .Description = "Authlib-Injector", .Type = McLoginType.Auth}
Else
@@ -71,15 +71,15 @@
End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
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
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"))
End If
End Sub
'切换注册按钮可见性
Private Sub ReloadRegisterButton() Handles Me.Loaded
Dim Address As String = If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister"))
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)
End Sub
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginAuthSkin.xaml.vb
+2 -2
View File
@@ -21,7 +21,7 @@
''' 获取当前页面的登录信息。
''' </summary>
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}
End Function
@@ -78,7 +78,7 @@
End Sub
Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click
Dim Address As String = If(McVersionCurrent IsNot Nothing, Setup.Get("VersionServerAuthRegister", Version:=McVersionCurrent), Setup.Get("CacheAuthServerRegister"))
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"))
End Sub
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginLegacy.xaml.vb
+2 -2
View File
@@ -44,8 +44,8 @@ Public Class PageLoginLegacy
Public Shared Function IsVaild(LoginData As McLoginLegacy) As String
If LoginData.UserName.Trim = "" Then Return "玩家名不能为空！"
If LoginData.UserName.Contains("""") Then Return "玩家名不能包含英文引号！"
If McVersionCurrent IsNot Nothing AndAlso
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 20, 3)) AndAlso
If McInstanceSelected IsNot Nothing AndAlso
McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla >= New Version(20, 0, 3) AndAlso
LoginData.UserName.Trim.Length > 16 Then
Return "自 1.20.3 起，玩家名至多只能包含 16 个字符！"
End If
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNide.xaml.vb
+2 -2
View File
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。
''' </summary>
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
Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = "", .Password = "", .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
Else
@@ -71,7 +71,7 @@
End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then
OpenWebsite("https://login.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=McVersionCurrent) & "/register")
OpenWebsite("https://login.mc-user.com:233/" & Setup.Get("VersionServerNide", Instance:=McInstanceSelected) & "/register")
Else
OpenWebsite("https://login.mc-user.com:233/account/login")
End If
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginNideSkin.xaml.vb
+2 -2
View File
@@ -21,7 +21,7 @@
''' 获取当前页面的登录信息。
''' </summary>
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"}
End Function
@@ -54,7 +54,7 @@
End Sub
Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click
OpenWebsite("https://login.mc-user.com:233/" & If(IsNothing(McVersionCurrent), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Version:=McVersionCurrent)) & "/skin")
OpenWebsite("https://login.mc-user.com:233/" & If(IsNothing(McInstanceSelected), Setup.Get("CacheNideServer"), Setup.Get("VersionServerNide", Instance:=McInstanceSelected)) & "/skin")
End Sub
End Class
Plain Craft Launcher 2/Pages/PageLink/PageLinkMain.xaml
+1
View File
@@ -202,6 +202,7 @@
</Grid>
</Grid>
<Grid x:Name="PanAlways" HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="15" Opacity="0.5">
<local:MyTextButton Text="示例文本 www.meloong.com" Opacity="0.4" />
</Grid>
</Grid>
</local:MyPageRight>
Plain Craft Launcher 2/Pages/PageLink/PageLinkMain.xaml.vb
+2 -3
View File
@@ -430,7 +430,7 @@ Public Class PageLinkMain
If ServerConfig Is Nothing Then Throw New Exception("无法从服务器获取配置")
'检查是否已禁用联机功能
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
VersionCode < ServerConfig("Link")("MinVersionCode").ToObject(Of Integer) Then
Throw New Exception("$你的 PCL 版本太老了，请在更新 PCL 之后再联机！")
@@ -523,7 +523,7 @@ Public Class PageLinkMain
Dim ListenersPort As Integer = FreePorts(2) '它会占用【当前、当前 +1、当前 +2】共三个端口
'获取启动参数
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)
If IsServerSide Then
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
Arguments += $" -p=""{Peer}"""
Next
Arguments += " --private-mode true" '老好人模式现在莫得用：If Not Setup.Get("LinkShareMode") Then
If Setup.Get("LinkLatencyMode") = 1 Then Arguments += " --latency-first"
'启动进程
ProcessStart(Arguments)
Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml
+2515 -561
View File
File diff suppressed because it is too large. Load diff
Plain Craft Launcher 2/Pages/PageOther/PageOtherLeft.xaml.vb
+1 -1
View File
@@ -49,7 +49,7 @@
''' <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
'若使用 IsLoaded，则会导致模拟点击不被执行（模拟点击切换页面时，控件的 IsLoaded 为 False）
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb
+43 -43
View File
@@ -34,7 +34,7 @@
'添加控件
Dim ContMenu As ContextMenu = Nothing
Select Case Folder.Type
Case McFolderType.Original
Case McFolder.Types.Original
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">
<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 "/>
</ContextMenu>
)
Case McFolderType.RenamedOriginal
Case McFolder.Types.RenamedOriginal
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">
<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 "/>
</ContextMenu>
)
Case McFolderType.Custom
Case McFolder.Types.Custom
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">
<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>
)
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("Delete"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Delete_Click))
CType(ContMenu.FindName("Rename"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Rename_Click))
CType(ContMenu.FindName("Refresh"), MyMenuItem).AddHandler(MyMenuItem.ClickEvent, New RoutedEventHandler(AddressOf FrmSelectLeft.Refresh_Click))
'构建框架与图表按钮
Dim NewItem As New MyListItem With {.IsScaleAnimationEnabled = False, .Type = MyListItem.CheckType.RadioBox, .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
Dim NewIconButton As New MyIconButton With {.Logo = Logo.IconButtonSetup, .LogoScale = 1.1}
AddHandler NewIconButton.Click, Sub(sender, e)
@@ -81,7 +81,7 @@
End Sub
NewItem.Buttons = {NewIconButton}
FrmSelectLeft.PanList.Children.Add(NewItem)
Log("[Minecraft] 有效的 Minecraft 文件夹：" & Folder.Name & " > " & Folder.Path)
Log("[Minecraft] 有效的 Minecraft 文件夹：" & Folder.Name & " > " & Folder.Location)
Next
'标题文本
@@ -125,7 +125,7 @@
'确认勾选状态
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 '去掉第一个标题
Return
End If
@@ -133,14 +133,14 @@
If Not McFolderList.Any() Then
Throw New ArgumentNullException("没有可用的 Minecraft 文件夹")
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
End If
Catch ex As Exception
Log(ex, "构建 Minecraft 文件夹列表 UI 出错", LogLevel.Feedback)
Finally
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表
End Try
End Sub
Private McFolderListLast As List(Of McFolder)
@@ -232,20 +232,20 @@
Dim ModFolder As New DirectoryInfo(FolderPath & "mods\")
If Not (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count >= 3) Then Return
'2. 版本数较少，可能为整合包
Dim VersionFolder As New DirectoryInfo(FolderPath & "versions\")
If Not (VersionFolder.Exists AndAlso VersionFolder.EnumerateDirectories.Count <= 3) Then Return
Dim VersionFolderInfo As New DirectoryInfo(FolderPath & "versions\")
If Not (VersionFolderInfo.Exists AndAlso VersionFolderInfo.EnumerateDirectories.Count <= 3) Then Return
'3. 能够找到可安装 Mod 的版本
For Each VersionPath In VersionFolder.EnumerateDirectories
Dim Version As New McVersion(VersionPath.FullName)
Version.Load()
If Not Version.Modable Then Continue For
For Each VersionFolder In VersionFolderInfo.EnumerateDirectories
Dim Instance As New McInstance(VersionFolder.FullName)
Instance.Load()
If Not Instance.Modable Then Continue For
'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
'满足以上全部条件则视为根目录整合包
Setup.Set("VersionArgumentIndie", 2, Version:=Version)
Setup.Set("VersionArgumentIndieV2", False, Version:=Version)
Log("[Setup] 已自动关闭单版本隔离：" & Version.Name, LogLevel.Debug)
Setup.Set("VersionArgumentIndie", 2, Instance:=Instance)
Setup.Set("VersionArgumentIndieV2", False, Instance:=Instance)
Log("[Setup] 已自动关闭单版本隔离：" & Instance.Name, LogLevel.Debug)
Next
Catch ex As Exception
Log(ex, "向文件夹列表中添加新文件夹失败", LogLevel.Feedback)
@@ -276,14 +276,14 @@
Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
'若为 “移除”，则提醒是否删除 PCL 的配置文件
If Folder.Type = McFolderType.Custom Then
If Folder.Type = McFolder.Types.Custom Then
Select Case MyMsgBox("是否需要清理 PCL 在该文件夹中的配置文件？" & vbCrLf & "这包括各个版本的独立设置（如自定义图标、第三方登录配置）等，对游戏本身没有影响。", "配置文件清理", "删除", "保留", "取消")
Case 1
'删除配置文件
If File.Exists(Folder.Path & "PCL.ini") Then File.Delete(Folder.Path & "PCL.ini")
If Directory.Exists(Folder.Path & "versions\") Then
For Each Version In New DirectoryInfo(Folder.Path & "versions\").EnumerateDirectories
If Directory.Exists(Version.FullName & "\PCL\") Then Directory.Delete(Version.FullName & "\PCL\", True)
If File.Exists(Folder.Location & "PCL.ini") Then File.Delete(Folder.Location & "PCL.ini")
If Directory.Exists(Folder.Location & "versions\") Then
For Each InstanceInfo In New DirectoryInfo(Folder.Location & "versions\").EnumerateDirectories
If Directory.Exists(InstanceInfo.FullName & "\PCL\") Then Directory.Delete(InstanceInfo.FullName & "\PCL\", True)
Next
End If
Case 2
@@ -299,7 +299,7 @@
Dim Name As String = ""
For i = 0 To Folders.Count - 1
If Folders(i) = "" Then Exit For
If Folders(i).ToString.EndsWith(Folder.Path) Then
If Folders(i).ToString.EndsWith(Folder.Location) Then
Name = Folders(i).ToString.BeforeFirst(">")
Folders.RemoveAt(i)
Exit For
@@ -307,7 +307,7 @@
Next
'保存
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)
Catch ex As Exception
@@ -316,15 +316,15 @@
End Sub
Public Sub Delete_Click(sender As Object, e As RoutedEventArgs)
Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
Dim DeleteText As String = If((Folder.Type = McFolderType.Original OrElse Folder.Type = McFolderType.RenamedOriginal) AndAlso Folder.Path = Path & ".minecraft\" AndAlso McFolderList.Count = 1, "清空", "删除")
If MyMsgBox("你确定要" & DeleteText & "这个文件夹吗？" & vbCrLf & "目标文件夹：" & Folder.Path & vbCrLf & vbCrLf & "这会导致该文件夹中的所有存档与其他文件永久丢失，且不可恢复！", "删除警告", "取消", "确认", "取消") <> 2 Then Return
If MyMsgBox("如果你在该文件夹中存放了除 MC 以外的其他文件，这些文件也会被一同删除！" & vbCrLf & "继续删除会导致该文件夹中的所有文件永久丢失，请在仔细确认后再继续！" & vbCrLf & "目标文件夹：" & Folder.Path & vbCrLf & vbCrLf & "这是最后一次警告！", "删除警告", "确认" & DeleteText, "取消", IsWarn:=True) <> 1 Then Return
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.Location & vbCrLf & vbCrLf & "这会导致该文件夹中的所有存档与其他文件永久丢失，且不可恢复！", "删除警告", "取消", "确认", "取消") <> 2 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("|"))
For i = 0 To Folders.Count - 1
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(">")
Folders.RemoveAt(i)
Exit For
@@ -337,8 +337,8 @@
'删除文件夹
Try
Hint("正在" & DeleteText & "文件夹 " & Folder.Name & "！", HintType.Blue)
DeleteDirectory(Folder.Path)
If DeleteText = "清空" Then Directory.CreateDirectory(Folder.Path)
DeleteDirectory(Folder.Location)
If DeleteText = "清空" Then Directory.CreateDirectory(Folder.Location)
Hint("已" & DeleteText & "文件夹 " & Folder.Name & "！", HintType.Green)
Catch ex As Exception
Log(ex, DeleteText & "文件夹 " & Folder.Name & " 失败", LogLevel.Hint)
@@ -353,14 +353,14 @@
End Sub
Public Sub Refresh_Click(sender As Object, e As RoutedEventArgs)
Dim Data As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
RefreshCurrent(Data.Path)
RefreshCurrent(Data.Location)
End Sub
Public Sub RefreshCurrent() Implements IRefreshable.Refresh
RefreshCurrent(PathMcFolder)
RefreshCurrent(McFolderSelected)
End Sub
Public Shared Sub RefreshCurrent(Folder As String)
WriteIni(Folder & "PCL.ini", "VersionCache", "") '删除缓存以强制要求下一次加载时更新列表
If Folder = PathMcFolder Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
WriteIni(Folder & "PCL.ini", "InstanceCache", "") '删除缓存以强制要求下一次加载时更新列表
If Folder = McFolderSelected Then LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub
Public Sub Rename_Click(sender As Object, e As RoutedEventArgs)
Dim Folder As McFolder = CType(CType(CType(sender.Parent, ContextMenu).Parent, Primitives.Popup).PlacementTarget, MyListItem).Tag
@@ -376,19 +376,19 @@
For i = 0 To Folders.Count - 1
Dim FolderCurrent As String = Folders(i)
If FolderCurrent = "" Then Continue For
If FolderCurrent.Split(">")(1) = Folder.Path Then
If FolderCurrent.Split(">")(1) = Folder.Location Then
IsAdded = True
If FolderCurrent.Split(">")(0) = NewName Then
'名称未修改
Return
Else
Folders(i) = NewName & ">" & Folder.Path
Folders(i) = NewName & ">" & Folder.Location
End If
Exit For
End If
Next
'如果没有添加过，则添加进去（因为修改了默认项的名称）
If Not IsAdded Then Folders.Add(NewName & ">" & Folder.Path)
If Not IsAdded Then Folders.Add(NewName & ">" & Folder.Location)
Hint("文件夹名称已更新为 " & NewName & " ！", HintType.Green)
'保存
Setup.Set("LaunchFolders", Join(Folders.ToArray, "|"))
@@ -408,9 +408,9 @@
Return
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)
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表
End Sub
End Class
Plain Craft Launcher 2/Pages/PageSelectRight.xaml.vb
+56 -58
View File
@@ -2,15 +2,15 @@
'窗口基础
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()
End Sub
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
Private Sub Load_Click(sender As Object, e As MouseButtonEventArgs) Handles Load.Click
If McVersionListLoader.State = LoadState.Failed Then
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
If McInstanceListLoader.State = LoadState.Failed Then
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End If
End Sub
@@ -22,30 +22,29 @@
#Region "结果 UI 化"
Private Sub McVersionListUI(Loader As LoaderTask(Of String, Integer))
Private Sub McInstanceListUI(Loader As LoaderTask(Of String, Integer))
Try
Dim Path As String = Loader.Input
'加载 UI
PanMain.Children.Clear()
For Each Card As KeyValuePair(Of McVersionCardType, List(Of McVersion)) In McVersionList.ToArray
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 "确认卡片名称"
Dim CardName As String = ""
Select Case Card.Key
Case McVersionCardType.OriginalLike
Case McInstanceCardType.OriginalLike
CardName = "常规版本"
Case McVersionCardType.API
Case McInstanceCardType.API
Dim IsForgeExists As Boolean = False
Dim IsNeoForgeExists As Boolean = False
Dim IsFabricExists As Boolean = False
Dim IsLiteExists As Boolean = False
For Each Version As McVersion In Card.Value
If Version.Version.HasFabric Then IsFabricExists = True
If Version.Version.HasLiteLoader Then IsLiteExists = True
If Version.Version.HasForge Then IsForgeExists = True
If Version.Version.HasNeoForge Then IsNeoForgeExists = True
For Each Instance As McInstance In Card.Value
If Instance.Version.HasFabric Then IsFabricExists = True
If Instance.Version.HasLiteLoader Then IsLiteExists = True
If Instance.Version.HasForge Then IsForgeExists = True
If Instance.Version.HasNeoForge Then IsNeoForgeExists = True
Next
If If(IsLiteExists, 1, 0) + If(IsForgeExists, 1, 0) + If(IsFabricExists, 1, 0) + If(IsNeoForgeExists, 1, 0) > 1 Then
CardName = "可安装 Mod"
@@ -58,15 +57,15 @@
Else
CardName = "Fabric 版本"
End If
Case McVersionCardType.Error
Case McInstanceCardType.Error
CardName = "错误的版本"
Case McVersionCardType.Hidden
Case McInstanceCardType.Hidden
CardName = "隐藏的版本"
Case McVersionCardType.Rubbish
Case McInstanceCardType.Rubbish
CardName = "不常用版本"
Case McVersionCardType.Star
Case McInstanceCardType.Star
CardName = "收藏夹"
Case McVersionCardType.Fool
Case McInstanceCardType.Fool
CardName = "愚人节版本"
Case Else
Throw New ArgumentException("未知的卡片种类（" & Card.Key & "）")
@@ -80,7 +79,7 @@
NewCard.SwapControl = NewStack
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
Else
MyCard.StackInstall(NewStack, 0, CardTitle)
@@ -114,13 +113,13 @@
Log(ex, "将版本列表转换显示时失败", LogLevel.Feedback)
End Try
End Sub
Public Shared Sub McVersionListContent(sender As MyListItem, e As EventArgs)
Dim Version As McVersion = sender.Tag
Public Shared Sub McInstanceListContent(sender As MyListItem, e As EventArgs)
Dim Instance As McInstance = sender.Tag
'注册点击事件
AddHandler sender.Click, AddressOf Item_Click
'图标按钮
Dim BtnStar As New MyIconButton
If Version.IsStar Then
If Instance.IsStar Then
BtnStar.ToolTip = "取消收藏"
ToolTipService.SetPlacement(BtnStar, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnStar, 30)
@@ -136,17 +135,17 @@
BtnStar.Logo = Logo.IconButtonLikeLine
End If
AddHandler BtnStar.Click, Sub()
WriteIni(Version.Path & "PCL\Setup.ini", "IsStar", Not Version.IsStar)
McVersionListForceRefresh = True
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
WriteIni(Instance.PathVersion & "PCL\Setup.ini", "IsStar", Not Instance.IsStar)
McInstanceListForceRefresh = True
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub
Dim BtnDel As New MyIconButton With {.LogoScale = 1.1, .Logo = Logo.IconButtonDelete}
BtnDel.ToolTip = "删除"
ToolTipService.SetPlacement(BtnDel, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnDel, 30)
ToolTipService.SetHorizontalOffset(BtnDel, 2)
AddHandler BtnDel.Click, Sub() DeleteVersion(sender, Version)
If Version.State <> McVersionState.Error Then
AddHandler BtnDel.Click, Sub() DeleteInstance(sender, Instance)
If Instance.State <> McInstanceState.Error Then
Dim BtnCont As New MyIconButton With {.LogoScale = 1.1, .Logo = Logo.IconButtonSetup}
BtnCont.ToolTip = "设置"
ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center)
@@ -154,13 +153,13 @@
ToolTipService.SetHorizontalOffset(BtnCont, 2)
AddHandler BtnCont.Click,
Sub()
PageVersionLeft.Version = Version
FrmMain.PageChange(FormMain.PageType.VersionSetup, 0)
PageInstanceLeft.Instance = Instance
FrmMain.PageChange(FormMain.PageType.InstanceSetup, 0)
End Sub
AddHandler sender.MouseRightButtonUp,
Sub()
PageVersionLeft.Version = Version
FrmMain.PageChange(FormMain.PageType.VersionSetup, 0)
PageInstanceLeft.Instance = Instance
FrmMain.PageChange(FormMain.PageType.InstanceSetup, 0)
End Sub
sender.Buttons = {BtnStar, BtnDel, BtnCont}
Else
@@ -169,8 +168,8 @@
ToolTipService.SetPlacement(BtnCont, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnCont, 30)
ToolTipService.SetHorizontalOffset(BtnCont, 2)
AddHandler BtnCont.Click, Sub() PageVersionOverall.OpenVersionFolder(Version)
AddHandler sender.MouseRightButtonUp, Sub() PageVersionOverall.OpenVersionFolder(Version)
AddHandler BtnCont.Click, Sub() PageInstanceOverall.OpenInstanceFolder(Instance)
AddHandler sender.MouseRightButtonUp, Sub() PageInstanceOverall.OpenInstanceFolder(Instance)
sender.Buttons = {BtnStar, BtnDel, BtnCont}
End If
End Sub
@@ -181,15 +180,15 @@
'点击选项
Public Shared Sub Item_Click(sender As MyListItem, e As EventArgs)
Dim Version As McVersion = sender.Tag
If New McVersion(Version.Path).Check Then
Dim Instance As McInstance = sender.Tag
If New McInstance(Instance.PathVersion).Check Then
'正常版本
McVersionCurrent = Version
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
McInstanceSelected = Instance
Setup.Set("LaunchVersionSelect", McInstanceSelected.Name)
FrmMain.PageBack()
Else
'错误版本
PageVersionOverall.OpenVersionFolder(Version)
PageInstanceOverall.OpenInstanceFolder(Instance)
End If
End Sub
@@ -197,29 +196,28 @@
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End Sub
'修改此代码时，同时修改 PageVersionOverall 中的代码
Public Shared Sub DeleteVersion(Item As MyListItem, Version As McVersion)
'修改此代码时，同时修改 PageInstanceOverall 中的代码
Public Shared Sub DeleteInstance(Item As MyListItem, Instance As McInstance)
Try
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim IsHintIndie As Boolean = Version.State <> McVersionState.Error AndAlso Version.PathIndie <> PathMcFolder
Select Case MyMsgBox($"你确定要{If(IsShiftPressed, "永久", "")}删除版本 {Version.Name} 吗？" &
Dim IsHintIndie As Boolean = Instance.State <> McInstanceState.Error AndAlso Instance.PathIndie <> McFolderSelected
Select Case MyMsgBox($"你确定要{If(IsShiftPressed, "永久", "")}删除版本 {Instance.Name} 吗？" &
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离，删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除！", ""),
"版本删除确认", , "取消",, True)
Case 1
IniClearCache(Version.PathIndie & "options.txt")
IniClearCache(Version.Path & "PCL\Setup.ini")
IniClearCache(Instance.PathIndie & "options.txt")
IniClearCache(Instance.PathVersion & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(Version.Path)
Hint("版本 " & Version.Name & " 已永久删除！", HintType.Green)
DeleteDirectory(Instance.PathVersion)
Else
FileIO.FileSystem.DeleteDirectory(Version.Path, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
Hint("版本 " & Version.Name & " 已删除！", HintType.Green)
FileIO.FileSystem.DeleteDirectory(Instance.PathVersion, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
Hint("版本 " & Instance.Name & " 已删除！", HintType.Green)
Case 2
Return
End Select
'从 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
If Parent.Children.Count > 2 Then '当前的项目与一个占位符
@@ -227,23 +225,23 @@
Dim Card As MyCard = Parent.Parent
Card.Title = Card.Title.Replace(Parent.Children.Count - 1, Parent.Children.Count - 2) '有一个占位符
Parent.Children.Remove(Item)
If McVersionCurrent IsNot Nothing AndAlso Version.Path = McVersionCurrent.Path Then
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
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.UpdateOnly, MaxDepth:=1, ExtraPath:="versions\")
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.UpdateOnly, MaxDepth:=1, ExtraPath:="versions\")
Else
'删除后没剩了
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End If
Else
'同时出现在当前卡片与收藏夹
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End If
Catch ex As OperationCanceledException
Log(ex, "删除版本 " & Version.Name & " 被主动取消")
Log(ex, "删除版本 " & Instance.Name & " 被主动取消")
Catch ex As Exception
Log(ex, "删除版本 " & Version.Name & " 失败", LogLevel.Msgbox)
Log(ex, "删除版本 " & Instance.Name & " 失败", LogLevel.Msgbox)
End Try
End Sub
Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb
+71 -72
View File
@@ -1,9 +1,6 @@
Public Class ModSetup
Private Const VersionSetup As Integer = 1
''' <summary>
''' 设置的更新号。
''' </summary>
Public Const VersionSetup As Integer = 1
''' <summary>
''' 设置列表。
''' </summary>
@@ -43,6 +40,7 @@
{"SystemSystemUpdate", New SetupEntry(0)},
{"SystemSystemActivity", New SetupEntry(0)},
{"SystemSystemTelemetry", New SetupEntry(True, Source:=SetupSource.Registry)},
{"CacheDrops", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheConfig", New SetupEntry(0, Source:=SetupSource.Registry)},
{"CacheExportConfig", New SetupEntry("", Source:=SetupSource.Registry)},
{"CacheSavedPageUrl", New SetupEntry("", Source:=SetupSource.Registry)},
@@ -112,7 +110,6 @@
{"LaunchRamType", New SetupEntry(0)},
{"LaunchRamCustom", New SetupEntry(15)},
{"LinkLastAutoJoinInviteCode", New SetupEntry("", Source:=SetupSource.Registry)},
{"LinkShareMode", New SetupEntry(True, Source:=SetupSource.Registry)},
{"LinkLatencyMode", New SetupEntry(0, Source:=SetupSource.Registry)},
{"LinkCustomPeer", New SetupEntry("")},
{"LinkEasyTierVersion", New SetupEntry(-1, Source:=SetupSource.Registry)},
@@ -174,29 +171,29 @@
{"UiHiddenOtherVote", New SetupEntry(False)},
{"UiHiddenOtherAbout", New SetupEntry(False)},
{"UiHiddenOtherTest", New SetupEntry(False)},
{"VersionAdvanceJvm", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionAdvanceGame", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionAdvanceAssets", New SetupEntry(0, Source:=SetupSource.Version)},
{"VersionAdvanceAssetsV2", New SetupEntry(False, Source:=SetupSource.Version)},
{"VersionAdvanceJava", New SetupEntry(False, Source:=SetupSource.Version)},
{"VersionAdvanceRun", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionAdvanceRunWait", New SetupEntry(True, Source:=SetupSource.Version)},
{"VersionAdvanceDisableJLW", New SetupEntry(False, Source:=SetupSource.Version)},
{"VersionAdvanceDisableModUpdate", New SetupEntry(False, Source:=SetupSource.Version)},
{"VersionRamType", New SetupEntry(2, Source:=SetupSource.Version)},
{"VersionRamCustom", New SetupEntry(15, Source:=SetupSource.Version)},
{"VersionRamOptimize", New SetupEntry(0, Source:=SetupSource.Version)},
{"VersionArgumentTitle", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionArgumentInfo", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionArgumentIndie", New SetupEntry(-1, Source:=SetupSource.Version)},
{"VersionArgumentIndieV2", New SetupEntry(False, Source:=SetupSource.Version)},
{"VersionArgumentJavaSelect", New SetupEntry("使用全局设置", Source:=SetupSource.Version)},
{"VersionServerEnter", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionServerLogin", New SetupEntry(0, Source:=SetupSource.Version)},
{"VersionServerNide", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionServerAuthRegister", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionServerAuthName", New SetupEntry("", Source:=SetupSource.Version)},
{"VersionServerAuthServer", New SetupEntry("", Source:=SetupSource.Version)}
{"VersionAdvanceJvm", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionAdvanceGame", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionAdvanceAssets", New SetupEntry(0, Source:=SetupSource.Instance)},
{"VersionAdvanceAssetsV2", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionAdvanceJava", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionAdvanceRun", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionAdvanceRunWait", New SetupEntry(True, Source:=SetupSource.Instance)},
{"VersionAdvanceDisableJLW", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionAdvanceDisableModUpdate", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionRamType", New SetupEntry(2, Source:=SetupSource.Instance)},
{"VersionRamCustom", New SetupEntry(15, Source:=SetupSource.Instance)},
{"VersionRamOptimize", New SetupEntry(0, Source:=SetupSource.Instance)},
{"VersionArgumentTitle", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionArgumentInfo", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionArgumentIndie", New SetupEntry(-1, Source:=SetupSource.Instance)},
{"VersionArgumentIndieV2", New SetupEntry(False, Source:=SetupSource.Instance)},
{"VersionArgumentJavaSelect", New SetupEntry("使用全局设置", Source:=SetupSource.Instance)},
{"VersionServerEnter", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerLogin", New SetupEntry(0, Source:=SetupSource.Instance)},
{"VersionServerNide", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerAuthRegister", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerAuthName", New SetupEntry("", Source:=SetupSource.Instance)},
{"VersionServerAuthServer", New SetupEntry("", Source:=SetupSource.Instance)}
}
#Region "基础"
@@ -204,7 +201,7 @@
Private Enum SetupSource
Normal
Registry
Version
Instance
End Enum
Private Class SetupEntry
@@ -239,18 +236,18 @@
''' <summary>
''' 改变某个设置项的值。
''' </summary>
Public Sub [Set](Key As String, Value As Object, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing)
[Set](Key, Value, SetupDict(Key), ForceReload, Version)
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, Instance)
End Sub
''' <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)
[Set](Key, Version, ForceReload, Version)
[Set](Key, Instance, ForceReload, Instance)
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
Value = CTypeDynamic(Value, E.Type)
@@ -259,7 +256,7 @@
If E.Value = Value AndAlso Not ForceReload Then Return
Else
'如果未应用，则直接更改并应用
If E.Source <> SetupSource.Version Then E.State = 2
If E.Source <> SetupSource.Instance Then E.State = 2
End If
'设置新值
E.Value = Value
@@ -277,9 +274,9 @@
WriteIni("Setup", Key, Value)
Case SetupSource.Registry
WriteReg(Key, Value)
Case SetupSource.Version
If Version Is Nothing Then Throw New Exception($"更改版本设置 {Key} 时未提供目标版本")
WriteIni(Version.Path & "PCL\Setup.ini", Key, Value)
Case SetupSource.Instance
If Instance Is Nothing Then Throw New Exception($"更改版本设置 {Key} 时未提供目标版本")
WriteIni(Instance.PathVersion & "PCL\Setup.ini", Key, Value)
End Select
'应用
'例如 VersionServerLogin 要求在设置之后再引发事件
@@ -294,15 +291,15 @@
''' <summary>
''' 应用某个设置项的值。
''' </summary>
Public Function Load(Key As String, Optional ForceReload As Boolean = False, Optional Version As McVersion = Nothing)
Return Load(Key, SetupDict(Key), ForceReload, Version)
Public Function Load(Key As String, Optional ForceReload As Boolean = False, Optional Instance As McInstance = Nothing)
Return Load(Key, SetupDict(Key), ForceReload, Instance)
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
'读取，应用并设置状态
Read(Key, E, Version)
If E.Source <> SetupSource.Version Then E.State = 2
Read(Key, E, Instance)
If E.Source <> SetupSource.Instance Then E.State = 2
Dim Method As Reflection.MethodInfo = GetType(ModSetup).GetMethod(Key)
If Method IsNot Nothing Then Method.Invoke(Me, {E.Value})
Return E.Value
@@ -311,19 +308,19 @@
''' <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)
Return [Get](Key, SetupDict(Key), Version)
Return [Get](Key, SetupDict(Key), Instance)
End Function
''' <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)
Return [Get](Key, Version)
Return [Get](Key, Instance)
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)
If Force IsNot Nothing Then
@@ -332,8 +329,8 @@
End If
'如果尚未读取过，则读取
If E.State = 0 Then
Read(Key, E, Version)
If E.Source <> SetupSource.Version Then E.State = 1
Read(Key, E, Instance)
If E.Source <> SetupSource.Instance Then E.State = 1
End If
'返回现在的值
Return E.Value
@@ -342,17 +339,17 @@
''' <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)
[Set](Key, E.DefaultValue, E, ForceReload, Version)
[Set](Key, E.DefaultValue, E, ForceReload, Instance)
Select Case SetupDict(Key).Source
Case SetupSource.Normal
DeleteIniKey("Setup", Key)
Case SetupSource.Registry
DeleteReg(Key)
Case Else 'SetupSource.Version
If Version Is Nothing Then Throw New Exception($"重置版本设置 {Key} 时未提供目标版本")
DeleteIniKey(Version.Path & "PCL\Setup.ini", Key)
Case Else 'SetupSource.Instance
If Instance Is Nothing Then Throw New Exception($"重置版本设置 {Key} 时未提供目标版本")
DeleteIniKey(Instance.PathVersion & "PCL\Setup.ini", Key)
End Select
End Sub
''' <summary>
@@ -364,22 +361,22 @@
''' <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
Case SetupSource.Normal
Return Not HasIniKey("Setup", Key)
Case SetupSource.Registry
Return Not HasReg(Key)
Case Else 'SetupSource.Version
If Version Is Nothing Then Throw New Exception($"判断版本设置 {Key} 是否存在时未提供目标版本")
Return Not HasIniKey(Version.Path & "PCL\Setup.ini", Key)
Case Else 'SetupSource.Instance
If Instance Is Nothing Then Throw New Exception($"判断版本设置 {Key} 是否存在时未提供目标版本")
Return Not HasIniKey(Instance.PathVersion & "PCL\Setup.ini", Key)
End Select
End Function
''' <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
If Not E.State = 0 Then Return
Dim SourceValue As String = Nothing '先用 String 储存，避免类型转换
@@ -388,11 +385,11 @@
SourceValue = ReadIni("Setup", Key, E.DefaultValueEncoded)
Case SetupSource.Registry
SourceValue = ReadReg(Key, E.DefaultValueEncoded)
Case SetupSource.Version
If Version Is Nothing Then
Case SetupSource.Instance
If Instance Is Nothing Then
Throw New Exception("读取版本设置 " & Key & " 时未提供目标版本")
Else
SourceValue = ReadIni(Version.Path & "PCL\Setup.ini", Key, E.DefaultValueEncoded)
SourceValue = ReadIni(Instance.PathVersion & "PCL\Setup.ini", Key, E.DefaultValueEncoded)
End If
End Select
If E.Encoded Then
@@ -420,6 +417,8 @@
#If BETA Then
If Key = "UiLauncherTheme" Then Return "0"
#End If
If Key = "UiHiddenPageLink" Then Return True
If Key = "UiHiddenSetupLink" Then Return True
Return Nothing
End Function
@@ -430,11 +429,11 @@
'切换选择
Public Sub LaunchVersionSelect(Value As String)
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
Public Sub LaunchFolderSelect(Value As String)
Log("[Setup] 当前选择的 Minecraft 文件夹：" & Value.ToString.Replace("$", Path))
PathMcFolder = Value.ToString.Replace("$", Path)
McFolderSelected = Value.ToString.Replace("$", Path)
End Sub
'游戏内存
@@ -762,18 +761,18 @@
'游戏内存
Public Sub VersionRamType(Type As Integer)
If FrmVersionSetup Is Nothing Then Return
FrmVersionSetup.RamType(Type)
If FrmInstanceSetup Is Nothing Then Return
FrmInstanceSetup.RamType(Type)
End Sub
'服务器
Public Sub VersionServerLogin(Type As Integer)
If FrmVersionSetup Is Nothing Then Return
If FrmInstanceSetup Is Nothing Then Return
'为第三方登录清空缓存以更新描述
WriteIni(PathMcFolder & "PCL.ini", "VersionCache", "")
If PageVersionLeft.Version Is Nothing Then Return
PageVersionLeft.Version = New McVersion(PageVersionLeft.Version.Name).Load()
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "")
If PageInstanceLeft.Instance Is Nothing Then Return
PageInstanceLeft.Instance = New McInstance(PageInstanceLeft.Instance.Name).Load()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub
#End Region
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml
+2 -2
View File
@@ -252,8 +252,8 @@
<StackPanel Margin="0,12,0,4" Grid.Row="6" Grid.ColumnSpan="2" HorizontalAlignment="Left">
<local:MyCheckBox Height="28" Text="禁用 Java Launch Wrapper" x:Name="CheckAdvanceDisableJLW" Tag="LaunchAdvanceDisableJLW"
ToolTipService.Placement="Right" ToolTip="PCL 会使用 Java Launch Wrapper 来修复老版本 Java 在中文路径下无法启动的问题。&#xa;如果这被反作弊拦截，或遇到其他问题，也可以将其关闭。" />
<local:MyCheckBox Height="28" Text="要求 Java 使用高性能显卡" x:Name="CheckAdvanceGraphicCard" Tag="LaunchAdvanceGraphicCard"
ToolTipService.Placement="Right" ToolTip="自动在 Windows 设置 → 系统 → 屏幕 → 显示卡 中将 Java 改为使用高性能显卡。&#xa;如果电脑同时有集显和独显，这能确保 MC 使用独显进行渲染，以大幅提高性能。" />
<local:MyCheckBox Height="28" Text="使用高性能显卡" x:Name="CheckAdvanceGraphicCard" Tag="LaunchAdvanceGraphicCard"
ToolTipService.Placement="Right" ToolTip="自动在 Windows 设置 → 系统 → 屏幕 → 显示卡 中将 PCL 和 Java 改为使用高性能显卡。&#xa;如果同时有集成显卡和独立显卡，这能确保 MC 使用独立显卡进行渲染，以大幅提高帧率。" />
</StackPanel>
<local:MyHint Text="版本独立设置中还有更多高级选项可供调整。" Margin="0,5,0,10" Theme="Blue" Grid.Row="7" Grid.ColumnSpan="2"
CanClose="True" RelativeSetup="HintMoreAdvancedSetup" />
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb
+13 -13
View File
@@ -7,7 +7,7 @@
'重复加载部分
PanBack.ScrollToHome()
RefreshRam(False)
If McVersionCurrent Is Nothing Then
If McInstanceSelected Is Nothing Then
BtnSwitch.Visibility = Visibility.Collapsed
Else
BtnSwitch.Visibility = Visibility.Visible
@@ -197,7 +197,7 @@
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
'获取内存情况
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 RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024, 1)
Dim RamGameActual As Double = Math.Round(Math.Min(RamGame, RamAvailable), 5)
@@ -324,10 +324,10 @@
''' <summary>
''' 获取当前设置的 RAM 值。单位为 GB。
''' </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
@@ -339,16 +339,16 @@
Dim RamTarget1 As Double '估计能勉强带动了的内存
Dim RamTarget2 As Double '估计没啥问题了的内存
Dim RamTarget3 As Double '放一百万个材质和 Mod 和光影需要的内存
If Version IsNot Nothing AndAlso Not Version.IsLoaded Then Version.Load()
If Version IsNot Nothing AndAlso Version.Modable Then
If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load()
If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 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)
RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90
RamTarget2 = 2.7 + ModCount / 50
RamTarget3 = 4.5 + ModCount / 25
ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then
ElseIf Instance IsNot Nothing AndAlso Instance.Version.HasOptiFine Then
'OptiFine 版本
RamMininum = 0.5
RamTarget1 = 1.5
@@ -399,7 +399,7 @@ PreFin:
End If
End If
'若使用 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
End Function
@@ -417,7 +417,7 @@ PreFin:
Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Setup.Get("LaunchArgumentJavaSelect")
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}
ToolTipService.SetHorizontalOffset(ListItem, 400)
ComboArgumentJava.Items.Add(ListItem)
@@ -580,9 +580,9 @@ PreFin:
'切换到版本独立设置
Private Sub BtnSwitch_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSwitch.Click
McVersionCurrent.Load()
PageVersionLeft.Version = McVersionCurrent
FrmMain.PageChange(FormMain.PageType.VersionSetup, FormMain.PageSubType.VersionSetup)
McInstanceSelected.Load()
PageInstanceLeft.Instance = McInstanceSelected
FrmMain.PageChange(FormMain.PageType.InstanceSetup, FormMain.PageSubType.InstanceSetup)
End Sub
'去除参数中的回车
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLink.xaml
-2
View File
@@ -39,8 +39,6 @@
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义节点" Margin="0,0,25,0" />
<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;房主和加入者必须连接到至少一个相同节点，才能互相连上。" />
<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">
<local:MyButton MinWidth="140" Padding="13,5" Margin="0,0,20,0" HorizontalAlignment="Left"
Text=" 光荣地贡献节点！" ColorType="Highlight"
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLink.xaml.vb
-5
View File
@@ -18,7 +18,6 @@
End Sub
Public Sub Reload()
ComboLatencyMode.SelectedIndex = Setup.Get("LinkLatencyMode")
CheckShareMode.Checked = Setup.Get("LinkShareMode")
TextCustomPeer.Text = Setup.Get("LinkCustomPeer")
End Sub
@@ -26,7 +25,6 @@
Public Sub Reset()
Try
Setup.Reset("LinkLatencyMode")
Setup.Reset("LinkShareMode")
Setup.Reset("LinkCustomPeer")
Log("[Setup] 已初始化联机页设置")
@@ -42,9 +40,6 @@
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextCustomPeer.ValidatedTextChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Text)
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
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub
Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml
+5 -3
View File
@@ -248,12 +248,14 @@
<local:MyComboBoxItem Content="Minecraft 皮肤推荐（作者：wkea）" />
<local:MyComboBoxItem Content="OpenBMCLAPI 仪表盘 Lite（作者：Silverteal、Mxmilu666）" />
<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="OpenMCIM 仪表盘（作者：SALTWOOD）" Visibility="Collapsed" />
<local:MyComboBoxItem Content="杂志主页（作者：CreeperIsASpy）" />
<local:MyComboBoxItem Content="PCL GitHub 仪表盘（作者：Deep-Dark-Forest）" />
<local:MyComboBoxItem Content="Minecraft 更新摘要（作者：pynickle，部分由 AI 生成）" />
<local:MyComboBoxItem Content="今日新闻热点（作者：EYicheng，部分由 AI 生成）" />
<local:MyComboBoxItem Content="Minecraft 芝士站（作者：awaEric233，部分由 AI 生成）" />
</local:MyComboBox>
</Grid>
</StackPanel>
@@ -281,12 +283,12 @@
</Grid.RowDefinitions>
<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="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="5" Text="更多" x:Name="CheckHiddenPageOther" Tag="UiHiddenPageOther" />
<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="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="5" Text="其他" x:Name="CheckHiddenSetupSystem" Tag="UiHiddenSetupSystem" />
<TextBlock Grid.Row="3" VerticalAlignment="Center" HorizontalAlignment="Left" Text="更多 子页面" />
Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb
+5 -5
View File
@@ -523,7 +523,7 @@ Refresh:
'顶部栏未被全部隐藏
FrmMain.PanTitleSelect.Visibility = 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.BtnTitleSelect4.Visibility = If(Not HiddenForceShow AndAlso Setup.Get("UiHiddenPageOther"), Visibility.Collapsed, Visibility.Visible)
End If
@@ -536,13 +536,13 @@ Refresh:
If FrmSetupLeft IsNot Nothing Then
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.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)
'隐藏左边选择卡
Dim AvaliableCount As Integer = 0
If Not Setup.Get("UiHiddenSetupLaunch") 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
FrmSetupLeft.PanItem.Visibility = If(AvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If
@@ -574,9 +574,9 @@ Refresh:
FrmMain.BtnTitleSelect4.Text = "更多"
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.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 以重新启用）", "功能隐藏")
Catch ex As Exception
Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj
+30 -42
View File
@@ -162,6 +162,7 @@
</Reference>
<Reference Include="NAudio, Version=1.7.3.0, Culture=neutral, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>Resources\NAudio.dll</HintPath>
<Private>False</Private>
</Reference>
<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.Runtime.Caching" />
<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.Xml.Linq" />
<Reference Include="System" />
@@ -207,6 +212,7 @@
</ApplicationDefinition>
<Compile Include="Controls\Behaviors\ClipboardInterceptor.vb" />
<Compile Include="Controls\Behaviors\Interfaces.vb" />
<Compile Include="Controls\Behaviors\LazyLoadBehavior.vb" />
<Compile Include="Controls\MyComboBox.vb" />
<Compile Include="Controls\MyComboBoxItem.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\ModJava.vb" />
<Compile Include="Modules\Minecraft\ModMod.vb" />
<Compile Include="Modules\Minecraft\ModModpack.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>
</Compile>
<Compile Include="Modules\ModEvent.vb" />
@@ -312,23 +319,23 @@
<Compile Include="Pages\PageOther\PageOtherHelpDetail.xaml.vb">
<DependentUpon>PageOtherHelpDetail.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageVersion\PageVersionExport.xaml.vb">
<DependentUpon>PageVersionExport.xaml</DependentUpon>
<Compile Include="Pages\PageInstance\PageInstanceExport.xaml.vb">
<DependentUpon>PageInstanceExport.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageVersion\PageVersionLeft.xaml.vb">
<DependentUpon>PageVersionLeft.xaml</DependentUpon>
<Compile Include="Pages\PageInstance\PageInstanceLeft.xaml.vb">
<DependentUpon>PageInstanceLeft.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageVersion\PageVersionMod.xaml.vb">
<DependentUpon>PageVersionMod.xaml</DependentUpon>
<Compile Include="Pages\PageInstance\PageInstanceMod.xaml.vb">
<DependentUpon>PageInstanceMod.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageVersion\PageVersionModDisabled.xaml.vb">
<DependentUpon>PageVersionModDisabled.xaml</DependentUpon>
<Compile Include="Pages\PageInstance\PageInstanceModDisabled.xaml.vb">
<DependentUpon>PageInstanceModDisabled.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageVersion\PageVersionOverall.xaml.vb">
<DependentUpon>PageVersionOverall.xaml</DependentUpon>
<Compile Include="Pages\PageInstance\PageInstanceOverall.xaml.vb">
<DependentUpon>PageInstanceOverall.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageVersion\PageVersionSetup.xaml.vb">
<DependentUpon>PageVersionSetup.xaml</DependentUpon>
<Compile Include="Pages\PageInstance\PageInstanceSetup.xaml.vb">
<DependentUpon>PageInstanceSetup.xaml</DependentUpon>
</Compile>
<Compile Include="Controls\MyDropShadow.vb" />
<Compile Include="Modules\Base\ModLoader.vb" />
@@ -497,7 +504,7 @@
<SubType>Code</SubType>
</Compile>
<Page Include="Pages\PageVersion\MyLocalModItem.xaml">
<Page Include="Pages\PageInstance\MyLocalModItem.xaml">
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
</Page>
@@ -574,7 +581,7 @@
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageVersion\PageVersionExport.xaml">
<Page Include="Pages\PageInstance\PageInstanceExport.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
@@ -654,23 +661,23 @@
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageVersion\PageVersionLeft.xaml">
<Page Include="Pages\PageInstance\PageInstanceLeft.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageVersion\PageVersionMod.xaml">
<Page Include="Pages\PageInstance\PageInstanceMod.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageVersion\PageVersionModDisabled.xaml">
<Page Include="Pages\PageInstance\PageInstanceModDisabled.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageVersion\PageVersionOverall.xaml">
<Page Include="Pages\PageInstance\PageInstanceOverall.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
<Page Include="Pages\PageVersion\PageVersionSetup.xaml">
<Page Include="Pages\PageInstance\PageInstanceSetup.xaml">
<SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator>
</Page>
@@ -801,28 +808,6 @@
<ItemGroup>
<Resource Include="Images\Themes\10.png" />
</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>
<Resource Include="Images\Heads\Patrick.png" />
</ItemGroup>
@@ -936,5 +921,8 @@
<ItemGroup>
<Resource Include="Images\Heads\EasyTier.png" />
</ItemGroup>
<ItemGroup>
<Content Include="Resources\System.ValueTuple.dll" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>
Plain Craft Launcher 2/Resources/Help.zip
BIN
View File
Binary file not shown.
Plain Craft Launcher 2/Resources/ModData.txt
+2380 -490
View File
File diff suppressed because it is too large. Load diff
Plain Craft Launcher 2/Resources/System.ValueTuple.dll
BIN
View File
Binary file not shown.