This commit is contained in:
龙腾猫跃
2024-05-25 17:42:12 +08:00
parent 0bdef8648f
commit e1268cefdb
34 changed files with 768 additions and 526 deletions
@@ -213,6 +213,7 @@ Public Class Application
Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson")) Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson"))
MsJson.Remove(sender.Tag) MsJson.Remove(sender.Tag)
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None)) Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0
FrmLoginMs.ComboAccounts.Items.Remove(sender.Parent) FrmLoginMs.ComboAccounts.Items.Remove(sender.Parent)
Case McLoginType.Legacy Case McLoginType.Legacy
'离线 '离线
+24 -6
View File
@@ -13,8 +13,26 @@
MainBorder.Child = value MainBorder.Child = value
End Set End Set
End Property End Property
Public MainTextBlock As TextBlock Private _MainTextBlock As TextBlock
Public MainSwap As Shapes.Path Public Property MainTextBlock As TextBlock
Get
Init() '当父级触发 Loaded 时,本卡片可能尚未触发 Loaded(该事件从父级向子级调用),因此这会是 null。手动触发以确保控件已加载。
Return _MainTextBlock
End Get
Set(value As TextBlock)
_MainTextBlock = value
End Set
End Property
Private _MainSwap As Shapes.Path
Public Property MainSwap As Shapes.Path
Get
Init()
Return _MainSwap
End Get
Set(value As Shapes.Path)
_MainSwap = value
End Set
End Property
'属性 '属性
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
@@ -24,7 +42,7 @@
End Get End Get
Set(value As String) Set(value As String)
SetValue(TitleProperty, value) SetValue(TitleProperty, value)
If MainTextBlock IsNot Nothing Then MainTextBlock.Text = value If _MainTextBlock IsNot Nothing Then MainTextBlock.Text = value
End Set End Set
End Property End Property
Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyCard), New PropertyMetadata("")) Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyCard), New PropertyMetadata(""))
@@ -40,10 +58,11 @@
Children.Add(MainGrid) Children.Add(MainGrid)
End Sub End Sub
Private IsLoad As Boolean = False Private IsLoad As Boolean = False
Private Sub MyCard_Loaded() Handles Me.Loaded Private Sub Init() Handles Me.Loaded
If IsLoad Then Exit Sub If IsLoad Then Exit Sub
IsLoad = True
'初次加载限定 '初次加载限定
If Not Title = "" AndAlso IsNothing(MainTextBlock) Then If Title <> "" AndAlso MainTextBlock Is Nothing Then
MainTextBlock = New TextBlock With {.HorizontalAlignment = HorizontalAlignment.Left, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(15, 12, 0, 0), .FontWeight = FontWeights.Bold, .FontSize = 13, .IsHitTestVisible = False} MainTextBlock = New TextBlock With {.HorizontalAlignment = HorizontalAlignment.Left, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(15, 12, 0, 0), .FontWeight = FontWeights.Bold, .FontSize = 13, .IsHitTestVisible = False}
MainTextBlock.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush1") MainTextBlock.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush1")
MainTextBlock.SetBinding(TextBlock.TextProperty, New Binding("Title") With {.Source = Me, .Mode = BindingMode.OneWay}) MainTextBlock.SetBinding(TextBlock.TextProperty, New Binding("Title") With {.Source = Me, .Mode = BindingMode.OneWay})
@@ -55,7 +74,6 @@
MainSwap.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush1") MainSwap.SetResourceReference(Shapes.Path.FillProperty, "ColorBrush1")
MainGrid.Children.Add(MainSwap) MainGrid.Children.Add(MainSwap)
End If End If
IsLoad = True
'改变默认的折叠 '改变默认的折叠
If IsSwaped AndAlso SwapControl IsNot Nothing Then If IsSwaped AndAlso SwapControl IsNot Nothing Then
MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0)) MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
@@ -656,9 +656,9 @@
SetResourceReference(ForegroundProperty, "ColorBrush1") SetResourceReference(ForegroundProperty, "ColorBrush1")
End If End If
ColumnPaddingRight.Width = New GridLength(MinPaddingRight) ColumnPaddingRight.Width = New GridLength(MinPaddingRight)
If EventType = "打开帮助" Then If EventType = "打开帮助" AndAlso Not (Title <> "" AndAlso Info <> "") Then '#3266
Try Try
Dim NewElem = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me) Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me)
Catch ex As Exception Catch ex As Exception
Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox) Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox)
End Try End Try
+19 -8
View File
@@ -108,13 +108,19 @@ Public Class FormMain
'3:BUG+ IMP* FEAT- '3:BUG+ IMP* FEAT-
'2:BUG* IMP- '2:BUG* IMP-
'1:BUG- '1:BUG-
If LastVersion < 325 Then 'Snapshot 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复正版登录时弹出脚本错误提示的 Bug"))
FeatureCount += 17
BugCount += 19
End If
If LastVersion < 324 Then 'Snapshot 2.7.3 If LastVersion < 324 Then 'Snapshot 2.7.3
FeatureCount += 4 FeatureCount += 4
BugCount += 3 BugCount += 3
End If End If
If LastVersion < 322 Then 'Snapshot 2.7.2 If LastVersion < 322 Then 'Snapshot 2.7.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug"))
FeatureCount += 18 FeatureCount += 18
@@ -376,7 +382,8 @@ Public Class FormMain
AaOpacity(Me, Setup.Get("UiLauncherTransparent") / 1000 + 0.4, 250, 100), AaOpacity(Me, Setup.Get("UiLauncherTransparent") / 1000 + 0.4, 250, 100),
AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 600, 100, New AniEaseOutBack(AniEasePower.Weak)), AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 600, 100, New AniEaseOutBack(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)), AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 500, 100, New AniEaseOutBack(AniEasePower.Weak)),
AaCode(Sub() AaCode(
Sub()
PanBack.RenderTransform = Nothing PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True IsWindowLoadFinished = True
Log($"[System] DPI:{DPI},系统版本:{OsVersion},PCL 位置:{PathWithName}") Log($"[System] DPI:{DPI},系统版本:{OsVersion},PCL 位置:{PathWithName}")
@@ -386,7 +393,8 @@ Public Class FormMain
AniStart() AniStart()
TimerMainStart() TimerMainStart()
'加载池 '加载池
RunInNewThread(Sub() RunInNewThread(
Sub()
'EULA 提示 'EULA 提示
If Not Setup.Get("SystemEula") Then If Not Setup.Get("SystemEula") Then
Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明", Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
@@ -521,7 +529,8 @@ Public Class FormMain
If SendWarning AndAlso HasDownloadingTask() Then If SendWarning AndAlso HasDownloadingTask() Then
If MyMsgBox("还有下载任务尚未完成,是否确定退出?", "提示", "确定", "取消") = 1 Then If MyMsgBox("还有下载任务尚未完成,是否确定退出?", "提示", "确定", "取消") = 1 Then
'强行结束下载任务 '强行结束下载任务
RunInNewThread(Sub() RunInNewThread(
Sub()
Log("[System] 正在强行停止任务") Log("[System] 正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToArray For Each Task As LoaderBase In LoaderTaskbar.ToArray
Task.Abort() Task.Abort()
@@ -542,13 +551,15 @@ Public Class FormMain
PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})} PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})}
AniStart({ AniStart({
AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)), AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)),
AaDouble(Sub(i) AaDouble(
Sub(i)
TransformScale.ScaleX += i TransformScale.ScaleX += i
TransformScale.ScaleY += i TransformScale.ScaleY += i
End Sub, 0.88 - TransformScale.ScaleX, 180), End Sub, 0.88 - TransformScale.ScaleX, 180),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)), AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)), AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)),
AaCode(Sub() AaCode(
Sub()
IsHitTestVisible = False IsHitTestVisible = False
Top = -10000 Top = -10000
ShowInTaskbar = False ShowInTaskbar = False
@@ -800,14 +811,14 @@ Public Class FormMain
If FilePathList.Count > 1 Then If FilePathList.Count > 1 Then
'必须要求全部为 jar 文件 '必须要求全部为 jar 文件
For Each File In FilePathList For Each File In FilePathList
If Not {"jar", "litemod", "disabled", "old"}.Contains(File.Split(".").Last.ToLower) Then If Not {"jar", "litemod", "disabled", "old"}.Contains(File.After(".").ToLower) Then
Hint("一次请只拖入一个文件!", HintType.Critical) Hint("一次请只拖入一个文件!", HintType.Critical)
Exit Sub Exit Sub
End If End If
Next Next
End If End If
'自定义主页 '自定义主页
Dim Extension As String = FilePath.Split(".").Last.ToLower Dim Extension As String = FilePath.After(".").ToLower
If Extension = "xaml" Then If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML,作为自定义主页加载") Log("[System] 文件后缀为 XAML,作为自定义主页加载")
If File.Exists(Path & "PCL\Custom.xaml") Then If File.Exists(Path & "PCL\Custom.xaml") Then
+64 -4
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.7.3" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.7.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.7.3." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.7.4." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 323 'Release Public Const VersionCode As Integer = 323 'Release
#Else #Else
Public Const VersionCode As Integer = 324 'Snapshot Public Const VersionCode As Integer = 325 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -1451,7 +1451,8 @@ Re:
Try Try
Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local}) Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
Catch ex As Exception Catch ex As Exception
Throw New Exception("格式化 json 对象失败:" & If(If(Data, "").Length > 10000, Data.Substring(0, 100) & "...", Data)) Dim Length As Integer = If(Data, "").Length
Throw New Exception("格式化 json 对象失败:" & If(Length > 10000, Data.Substring(0, 100) & $"...(全长 {Length} 个字符)..." & Right(Data, 100), Data))
End Try End Try
End Function End Function
@@ -1544,6 +1545,51 @@ Re:
Return Input.All(Function(c) AscW(c) < 128) Return Input.All(Function(c) AscW(c) < 128)
End Function End Function
''' <summary>
''' 获取在子字符串之前的部分。
''' 会裁切尽可能多的内容,但如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function Before(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase))
If Pos >= 0 Then
Return Str.Substring(0, Pos)
Else
Return Str
End If
End Function
''' <summary>
''' 获取在子字符串之后的部分。
''' 会裁切尽可能多的内容,但如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function After(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase))
If Pos >= 0 Then
Return Str.Substring(Pos + Text.Length)
Else
Return Str
End If
End Function
''' <summary>
''' 获取处于两个子字符串之间的部分。
''' 会裁切尽可能多的内容:匹配开始使用 LastIndexOf,匹配结束使用 IndexOf,但如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function Between(Str As String, Before As String, After As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.LastIndexOfF(Before, IgnoreCase))
If StartPos >= 0 Then
StartPos += Before.Length
Else
StartPos = 0
End If
Dim EndPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.IndexOfF(After, StartPos, IgnoreCase))
If EndPos >= 0 Then
Return Str.Substring(StartPos, EndPos - StartPos)
ElseIf StartPos > 0 Then
Return Str.Substring(StartPos)
Else
Return Str
End If
End Function
''' <summary> ''' <summary>
''' 高速的 StartsWith。 ''' 高速的 StartsWith。
''' </summary> ''' </summary>
@@ -1573,12 +1619,26 @@ Re:
Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function End Function
''' <summary> ''' <summary>
''' 高速的 IndexOf。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function IndexOfF(Str As String, SubStr As String, StartIndex As Integer, Optional IgnoreCase As Boolean = False) As Integer
Return Str.IndexOf(SubStr, StartIndex, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 高速的 LastIndexOf。 ''' 高速的 LastIndexOf。
''' </summary> ''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)> <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function LastIndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer Public Function LastIndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
Return Str.LastIndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) Return Str.LastIndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function End Function
''' <summary>
''' 高速的 LastIndexOf。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function LastIndexOfF(Str As String, SubStr As String, StartIndex As Integer, Optional IgnoreCase As Boolean = False) As Integer
Return Str.LastIndexOf(SubStr, StartIndex, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary> ''' <summary>
''' 输入 And 字符不会报错的 Val。 ''' 输入 And 字符不会报错的 Val。
@@ -266,7 +266,7 @@
Public Output As OutputType = Nothing Public Output As OutputType = Nothing
'获取输入 '获取输入
Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType Public Function StartGetInput(Optional Input As InputType = Nothing, Optional InputDelegate As Func(Of Object) = Nothing) As InputType 'InputDelegate 参数存在匿名调用
If InputDelegate Is Nothing Then InputDelegate = Me.InputDelegate If InputDelegate Is Nothing Then InputDelegate = Me.InputDelegate
Dim NewInput As InputType = Nothing '若 InputType 不能为 Nothing,则会导致 Input Is Nothing 永远失败,因此需要额外判断 Dim NewInput As InputType = Nothing '若 InputType 不能为 Nothing,则会导致 Input Is Nothing 永远失败,因此需要额外判断
If (Input Is Nothing OrElse (NewInput IsNot Nothing AndAlso Input.Equals(NewInput))) AndAlso InputDelegate IsNot Nothing Then If (Input Is Nothing OrElse (NewInput IsNot Nothing AndAlso Input.Equals(NewInput))) AndAlso InputDelegate IsNot Nothing Then
+12 -4
View File
@@ -781,7 +781,7 @@ RequestFinished:
''' <summary> ''' <summary>
''' 为不需要分割的小文件进行临时存储。 ''' 为不需要分割的小文件进行临时存储。
''' </summary> ''' </summary>
Private SmailFileCache As List(Of Byte) Private SmailFileCache As Queue(Of Byte)
''' <summary> ''' <summary>
''' 文件的已下载大小。 ''' 文件的已下载大小。
@@ -1101,7 +1101,7 @@ NotSupportRange:
'创建缓存文件 '创建缓存文件
If IsNoSplit Then If IsNoSplit Then
Info.Temp = Nothing Info.Temp = Nothing
SmailFileCache = New List(Of Byte) SmailFileCache = New Queue(Of Byte)
Else Else
Info.Temp = PathTemp & "Download\" & Uuid & "_" & Info.Uuid & "_" & RandomInteger(0, 999999) & ".tmp" Info.Temp = PathTemp & "Download\" & Uuid & "_" & Info.Uuid & "_" & RandomInteger(0, 999999) & ".tmp"
ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read) ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
@@ -1152,9 +1152,15 @@ NotSupportRange:
Info.DownloadDone += RealDataCount Info.DownloadDone += RealDataCount
If IsNoSplit Then If IsNoSplit Then
If HttpData.Count = RealDataCount Then If HttpData.Count = RealDataCount Then
SmailFileCache.AddRange(HttpData) 'SmailFileCache.AddRange(HttpData)
For Each B In HttpData
SmailFileCache.Enqueue(B)
Next
Else Else
SmailFileCache.AddRange(HttpData.ToList.GetRange(0, RealDataCount)) 'SmailFileCache.AddRange(HttpData.ToList.GetRange(0, RealDataCount))
For i = 0 To RealDataCount - 1
SmailFileCache.Enqueue(HttpData(i))
Next
End If End If
Else Else
ResultStream.Write(HttpData, 0, RealDataCount) ResultStream.Write(HttpData, 0, RealDataCount)
@@ -1456,7 +1462,9 @@ Retry:
Public Overrides Property Progress As Double Public Overrides Property Progress As Double
Get Get
If State >= LoadState.Finished Then Return 1 If State >= LoadState.Finished Then Return 1
SyncLock FilesLock
If Not Files.Any() Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了 If Not Files.Any() Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了
End SyncLock
Return _Progress Return _Progress
End Get End Get
Set(value As Double) Set(value As Double)
@@ -149,7 +149,7 @@ Public Class ValidateExcept
End Sub End Sub
Public Overrides Function Validate(Str As String) As String Public Overrides Function Validate(Str As String) As String
For Each Ch As String In Excepts For Each Ch As String In Excepts
If Str.IndexOfF(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then If Str.IndexOfF(Ch, True) >= 0 Then
If IsNothing(ErrorMessage) Then ErrorMessage = "" If IsNothing(ErrorMessage) Then ErrorMessage = ""
Return ErrorMessage.Replace("%", Ch) Return ErrorMessage.Replace("%", Ch)
End If End If
@@ -265,7 +265,7 @@
Next Next
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")). GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")).
Select(Function(v) CInt(Val(v.Split(".")(1).Split("-").First))).Where(Function(v) v > 0). Select(Function(v) CInt(Val(v.Split(".")(1).Before("-")))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList Distinct.OrderByDescending(Function(v) v).ToList
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Type 'Type
@@ -342,7 +342,7 @@
'搜索结果的键为 versions,获取特定工程的键为 game_versions '搜索结果的键为 versions,获取特定工程的键为 game_versions
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray). GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")). Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")).
Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0). Select(Of Integer)(Function(v) Val(v.Split(".")(1).Before("-"))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList Distinct.OrderByDescending(Function(v) v).ToList
'Type 'Type
Select Case Data("project_type").ToString Select Case Data("project_type").ToString
@@ -576,9 +576,9 @@
'有中文翻译 '有中文翻译
'尝试将文本分为三段:Title (EnglishName) - Suffix '尝试将文本分为三段:Title (EnglishName) - Suffix
'检查时注意 Carpet:它没有中文译名,但有 Suffix '检查时注意 Carpet:它没有中文译名,但有 Suffix
Title = TranslatedName.Split(" (").First.Split(" - ").First Title = TranslatedName.Before(" (").Before(" - ")
Dim Suffix As String = "" Dim Suffix As String = ""
If TranslatedName.Split(")").Last.Contains(" - ") Then Suffix = TranslatedName.Split(")").Last.Split(" - ").Last If TranslatedName.After(")").Contains(" - ") Then Suffix = TranslatedName.After(")").After(" - ")
Dim EnglishName As String = TranslatedName Dim EnglishName As String = TranslatedName
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "") If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c) EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
@@ -751,7 +751,7 @@ NoSubtitle:
Case CompType.ResourcePack Case CompType.ResourcePack
'FUTURE: Res 'FUTURE: Res
End Select End Select
Address += "&categoryId=" & If(Tag = "", "0", Tag.Split("/").First) Address += "&categoryId=" & If(Tag = "", "0", Tag.Before("/"))
If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer) If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText) If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
@@ -772,7 +772,7 @@ NoSubtitle:
'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]] 'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
Dim Facets As New List(Of String) Dim Facets As New List(Of String)
Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]") Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]")
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.Split("/").Last}'""]") If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.After("/")}'""]")
If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]") If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]")
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]") If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
Address += "&facets=[" & String.Join(",", Facets) & "]" Address += "&facets=[" & String.Join(",", Facets) & "]"
@@ -880,7 +880,7 @@ NoSubtitle:
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度 If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " " If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " "
If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " " If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " "
SearchResult += SearchResults(i).Item.ChineseName.Split(" (").Last.TrimEnd(") ").Split(" - ").First. SearchResult += SearchResults(i).Item.ChineseName.After(" (").TrimEnd(") ").Before(" - ").
Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " " Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " "
Next Next
Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer) Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer)
@@ -1133,7 +1133,7 @@ Retry:
'描述性信息 '描述性信息
''' <summary> ''' <summary>
''' 文件描述名(并非文件名,是自定义的字段)。 ''' 文件描述名(并非文件名,是自定义的字段)。对很多 Mod,这会给出 Mod 版本号。
''' </summary> ''' </summary>
Public DisplayName As String Public DisplayName As String
''' <summary> ''' <summary>
@@ -1305,7 +1305,7 @@ Retry:
'GameVersions 'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")). GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList Select(Function(v) If(v.Contains("-"), v.Before("-") & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
@@ -1403,7 +1403,7 @@ Retry:
'辅助函数 '辅助函数
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Return $"{Id}: {DisplayName}" Return $"{Id}: {FileName}"
End Function End Function
End Class End Class
@@ -312,16 +312,30 @@ Extracted:
End Function End Function
''' <summary> ''' <summary>
''' 输出字符串的前后某些行,并统一行尾为 vbLf (\r)、删除空行。 ''' 输出字符串的前后某些行,并统一行尾为 vbLf (正则 \n)、删除空行和重复行。
''' </summary> ''' </summary>
Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String
If Raw.Length <= HeadLines + TailLines Then Return Join(Raw, vbLf) If Raw.Length <= HeadLines + TailLines Then Return Join(Raw.Distinct, vbLf)
Dim Lines As New List(Of String)
Dim RealHeadLines As Integer = 0, ViewedLines As Integer
For ViewedLines = 0 To Raw.Length - 1
If Lines.Contains(Raw(ViewedLines)) Then Continue For
RealHeadLines += 1
Lines.Add(Raw(ViewedLines))
If RealHeadLines >= HeadLines Then Exit For
Next
Dim RealTailLines = 0
For i = Raw.Length - 1 To ViewedLines Step -1
If Lines.Contains(Raw(i)) Then Continue For
RealTailLines += 1
Lines.Insert(RealHeadLines, Raw(i))
If RealTailLines >= TailLines Then Exit For
Next
Dim Result As New StringBuilder Dim Result As New StringBuilder
For i = 0 To Raw.Count - 1 For Each Line In Lines
If i < HeadLines OrElse Raw.Count - i < TailLines Then If Line = "" Then Continue For
If Raw(i) = "" Then Continue For Result.Append(Line)
Result.Append(Raw(i) & vbLf) Result.Append(vbLf)
End If
Next Next
Return Result.ToString Return Result.ToString
End Function End Function
@@ -353,6 +367,7 @@ Extracted:
光影或资源包导致OpenGL1282错误 光影或资源包导致OpenGL1282错误
文件或内容校验失败 文件或内容校验失败
确定Mod导致游戏崩溃 确定Mod导致游戏崩溃
怀疑Mod导致游戏崩溃
Mod配置文件导致游戏崩溃 Mod配置文件导致游戏崩溃
ModMixin失败 ModMixin失败
Mod加载器报错 Mod加载器报错
@@ -398,23 +413,21 @@ Extracted:
'崩溃日志 '崩溃日志
If LogCrash IsNot Nothing Then If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析") Log("[Crash] 开始进行崩溃日志堆栈分析")
Dim StackLogs As String = LogCrash.Split("System Details").First Keywords.AddRange(AnalyzeStackKeyword(LogCrash.Before("System Details")))
Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
End If End If
'Minecraft 日志 'Minecraft 日志
If LogMc IsNot Nothing Then If LogMc IsNot Nothing Then
Dim Fatals = RegexSearch(LogMc, "/FATAL] [\w\W]+?(?=[\n]+\[)") Dim Fatals As List(Of String) = RegexSearch(LogMc, "/FATAL] .+?(?=[\n]+\[)")
If LogMc.Contains("Unreported exception thrown!") Then Fatals.Add(LogMc.Between("Unreported exception thrown!", "at oolloo.jlw.Wrapper"))
Log("[Crash] 开始进行 Minecraft 日志堆栈分析,发现 " & Fatals.Count & " 个报错项") Log("[Crash] 开始进行 Minecraft 日志堆栈分析,发现 " & Fatals.Count & " 个报错项")
If Fatals.Any Then
For Each Fatal In Fatals For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal)) Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next Next
End If End If
End If
'虚拟机日志 '虚拟机日志
If LogHs IsNot Nothing Then If LogHs IsNot Nothing Then
Log("[Crash] 开始进行虚拟机堆栈分析") Log("[Crash] 开始进行虚拟机堆栈分析")
Dim StackLogs As String = LogHs.Split("Registers:").First.Split("T H R E A D").Last Dim StackLogs As String = LogHs.Between("T H R E A D", "Registers:")
Keywords.AddRange(AnalyzeStackKeyword(StackLogs)) Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
End If End If
'Mod 名称分析 'Mod 名称分析
@@ -502,7 +515,7 @@ Done:
If LogMc.Contains("Extracted mod jars found, loading will NOT continue") Then AppendReason(CrashReason.Mod文件被解压) If LogMc.Contains("Extracted mod jars found, loading will NOT continue") Then AppendReason(CrashReason.Mod文件被解压)
If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失) If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失)
If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式) If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogMc.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足) If LogMc.Contains("java.lang.OutOfMemoryError") OrElse LogMc.Contains("an out of memory error") Then AppendReason(CrashReason.内存不足)
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与Optifine同时安装) If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与Optifine同时安装)
If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容) If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容)
If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误) If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误)
@@ -530,6 +543,7 @@ Done:
'Mod 重复安装 'Mod 重复安装
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("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)) If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
'Mod 缺少前置 'Mod 缺少前置
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
@@ -556,10 +570,10 @@ Done:
If LogCrash.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足) If LogCrash.Contains("java.lang.OutOfMemoryError") Then AppendReason(CrashReason.内存不足)
If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式) If LogCrash.Contains("Pixel format not accelerated") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃) If LogCrash.Contains("Manually triggered debug crash") Then AppendReason(CrashReason.玩家手动触发调试崩溃)
If LogCrash.Contains("has mods that were not found") AndAlso RegexCheck(LogCrash, "The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
'Mod 导致的崩溃 'Mod 导致的崩溃
If LogCrash.Contains("-- MOD ") Then If LogCrash.Contains("-- MOD ") Then
Dim LogLeft = LogCrash.Split("-- MOD").Last If LogCrash.Between("-- MOD ", "Failure message:").ContainsF(".jar", True) Then
If LogLeft.Contains("Failure message: MISSING") Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrash, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray)) AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrash, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Else Else
AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray)) AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
@@ -584,19 +598,9 @@ Done:
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
End If
End Sub
''' <summary>
''' 进行精准日志匹配。匹配优先级低于堆栈分析的崩溃。
''' </summary>
Private Sub AnalyzeCrit3()
'游戏日志分析
If LogMc IsNot Nothing Then
'Mixin 崩溃 'Mixin 崩溃
If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("MixinApplyError") OrElse If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("MixinApplyError") OrElse
LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".mixins.json] FAILED during )") Then LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".json] FAILED during )") Then
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)") Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)") If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)") If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
@@ -614,6 +618,24 @@ Done:
'在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败 '在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If End If
End If
'崩溃报告分析
If LogCrash IsNot Nothing Then
If LogCrash.Contains("Suspected Mod") Then
Dim Suspects = RegexSearch(LogCrash.Between("Suspected Mod", "Stacktrace"), "(?<=\n\t[^(\t]+\()[^)\n]+")
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
End If
End If
End Sub
''' <summary>
''' 进行精准日志匹配。匹配优先级低于堆栈分析的崩溃。
''' </summary>
Private Sub AnalyzeCrit3()
'游戏日志分析
If LogMc IsNot Nothing Then
'极短的程序输出 '极短的程序输出
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
AppendReason(CrashReason.极短的程序输出, LogMc) AppendReason(CrashReason.极短的程序输出, LogMc)
@@ -634,9 +656,13 @@ Done:
''' 从堆栈中提取 Mod ID 关键字。若失败则返回空列表。 ''' 从堆栈中提取 Mod ID 关键字。若失败则返回空列表。
''' </summary> ''' </summary>
Private Function AnalyzeStackKeyword(ErrorStack As String) As List(Of String) Private Function AnalyzeStackKeyword(ErrorStack As String) As List(Of String)
ErrorStack = vbLf & If(ErrorStack, "") & vbLf
'进行正则匹配 '进行正则匹配
Dim StackSearchResults As List(Of String) = RegexSearch(If(ErrorStack, "") & vbCrLf, "(?<=\n[^{]+)[a-zA-Z]+\w+\.[a-zA-Z]+[\w\.]+(?=\.[\w\.$]+\.)") Dim StackSearchResults As New List(Of String)
StackSearchResults.AddRange(RegexSearch(ErrorStack, "(?<=\n[^{]+)[a-zA-Z_]+\w+\.[a-zA-Z_]+[\w\.]+(?=\.[\w\.$]+\.)"))
StackSearchResults.AddRange(RegexSearch(ErrorStack, "(?<=at [^(]+?\.\w+\$\w+\$)[\w\$]+?(?=\$\w+\()").Select(Function(s) s.Replace("$", "."))) 'Mixin 堆栈:xxx.xxx.xxxx$xxxx$xxx
StackSearchResults = StackSearchResults.Distinct.ToList
'检查堆栈开头 '检查堆栈开头
Dim PossibleStacks As New List(Of String) Dim PossibleStacks As New List(Of String)
@@ -649,7 +675,7 @@ Done:
"MojangTricksIntelDriversForPerformance_javaw"} "MojangTricksIntelDriversForPerformance_javaw"}
If Stack.StartsWithF(IgnoreStack) Then GoTo NextStack If Stack.StartsWithF(IgnoreStack) Then GoTo NextStack
Next Next
PossibleStacks.Add(Stack.Trim) '.Split("$").First) PossibleStacks.Add(Stack.Trim)
NextStack: NextStack:
Next Next
PossibleStacks = PossibleStacks.Distinct.ToList PossibleStacks = PossibleStacks.Distinct.ToList
@@ -666,13 +692,13 @@ NextStack:
For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节 For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
Dim Word As String = Splited(i) Dim Word As String = Splited(i)
If Word.Length <= 2 OrElse Word.StartsWithF("func_") Then Continue For If Word.Length <= 2 OrElse Word.StartsWithF("func_") Then Continue For
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", "impl", "data", "pool", "task",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world",
"gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service",
"fastutil", "optifine", "internal", "platform", "override", "fastutil", "optifine", "internal", "platform", "override", "fabricmc",
"listeners", "scheduler", "minecraft", "transformers", "universal", "multipart", "minecraftforge", "blockentity" "injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill"
}.Contains(Word.ToLower) Then Continue For }.Contains(Word.ToLower) Then Continue For
PossibleWords.Add(Word.Trim) PossibleWords.Add(Word.Trim)
Next Next
@@ -712,7 +738,7 @@ NextStack:
Details = Details.Replace("Fabric Mods", "¨") Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式") Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式")
End If End If
Details = Details.Split("¨").Last Details = Details.After("¨")
'[Forge] 获取所有包含 .jar 的行 '[Forge] 获取所有包含 .jar 的行
'[Fabric] 获取所有包含 Mod 信息的行 '[Fabric] 获取所有包含 Mod 信息的行
@@ -795,13 +821,20 @@ NextStack:
End If End If
End Function End Function
''' <summary> ''' <summary>
''' 尝试获取 Mod 名称,若失败则返回原关键字。 ''' 尝试从关键字获取 Mod 名称,若失败则返回原关键字。
''' </summary> ''' </summary>
Private Function TryAnalyzeModName(Keywords As String) As List(Of String) Private Function TryAnalyzeModName(Keyword As String) As List(Of String)
Dim RawList As New List(Of String) From {If(Keywords, "")} Dim RawList As New List(Of String) From {If(Keyword, "")}
If String.IsNullOrEmpty(Keywords) Then Return RawList If String.IsNullOrEmpty(Keyword) Then Return RawList
Return If(AnalyzeModName(RawList), RawList) Return If(AnalyzeModName(RawList), RawList)
End Function End Function
''' <summary>
''' 尝试从关键字获取 Mod 名称,若失败则返回原关键字。
''' </summary>
Private Function TryAnalyzeModName(Keywords As List(Of String)) As List(Of String)
If Not Keywords.Any Then Return Keywords
Return If(AnalyzeModName(Keywords), Keywords)
End Function
'4:根据原因输出信息 '4:根据原因输出信息
Private OutputFiles As New List(Of String) Private OutputFiles As New List(Of String)
@@ -814,7 +847,7 @@ NextStack:
Dim ShowLog As Action = Dim ShowLog As Action =
Sub() Sub()
If File.Exists(DirectFile.Value.Key) Then If File.Exists(DirectFile.Value.Key) Then
ShellOnly(DirectFile.Value.Key) ShellOnly("notepad", DirectFile.Value.Key)
Else Else
Dim FilePath As String = PathTemp & "Crash.txt" Dim FilePath As String = PathTemp & "Crash.txt"
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf)) WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
@@ -911,39 +944,39 @@ NextStack:
End If End If
Case CrashReason.堆栈分析发现关键字 Case CrashReason.堆栈分析发现关键字
If Additional.Count = 1 Then If Additional.Count = 1 Then
Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道它对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h") Results.Add("你的游戏遇到了一些问题,PCL 为此找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
Else Else
Results.Add("你的游戏遇到了一些问题,这可能是某些 Mod 所引起的,PCL 找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道这些关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h") Results.Add("你的游戏遇到了一些问题,PCL 为此找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
End If End If
Case CrashReason.堆栈分析发现Mod名称 Case CrashReason.堆栈分析发现Mod名称, CrashReason.怀疑Mod导致游戏崩溃
If Additional.Count = 1 Then If Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 可能导致了游戏出错。\n\e\h") Results.Add("PCL 怀疑名为 " & Additional.First & " 的 Mod 导致了游戏出错,但不能完全确定。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("可能是以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h") Results.Add("PCL 怀疑以下 Mod 导致了游戏出错,但不能完全确定:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.确定Mod导致游戏崩溃 Case CrashReason.确定Mod导致游戏崩溃
If Additional.Count = 1 Then If Additional.Count = 1 Then
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h") Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\e\h") Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.ModMixin失败 Case CrashReason.ModMixin失败
If Additional.Count = 1 Then If Additional.Count = 1 Then
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着该 Mod 存在 Bug,或与当前环境不兼容。\n\e\h") Results.Add("名为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着这些 Mod 存在 Bug,或与当前环境不兼容。\n\e\h") Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.Mod配置文件导致游戏崩溃 Case CrashReason.Mod配置文件导致游戏崩溃
If Additional(1) Is Nothing Then If Additional(1) Is Nothing Then
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h") Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错。\n\e\h")
Else Else
Results.Add("名称或 ID 为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。") Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。")
End If End If
Case CrashReason.Mod初始化失败 Case CrashReason.Mod初始化失败
If Additional.Count = 1 Then If Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n\e\h") Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("以下 Mod 初始化失败,导致游戏无法继续加载:\n - " & Join(Additional, "\n - ") & "\n\e\h") Results.Add("以下 Mod 初始化失败,导致游戏无法继续加载:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.特定方块导致崩溃 Case CrashReason.特定方块导致崩溃
If Additional.Count = 1 Then If Additional.Count = 1 Then
@@ -1028,8 +1061,6 @@ NextStack:
End Select End Select
Next Next
'整理多个原因
IsHandAnalyze = False
Return Join(Results, "\n\n此外,"). Return Join(Results, "\n\n此外,").
Replace("\n", vbCrLf). Replace("\n", vbCrLf).
Replace("\h", ""). Replace("\h", "").
@@ -1039,7 +1070,7 @@ NextStack:
If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "", If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" & vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" &
If(If(PageSetupSystem.IsLauncherNewest(), True), "", If(If(PageSetupSystem.IsLauncherNewest(), True), "",
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新到最新版可能会修复这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。")) vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
End Function End Function
End Class End Class
@@ -1,5 +1,5 @@
Public Module ModJava Public Module ModJava
Public JavaListCacheVersion As Integer = 5 Public JavaListCacheVersion As Integer = 6
''' <summary> ''' <summary>
''' 目前所有可用的 Java。 ''' 目前所有可用的 Java。
@@ -131,7 +131,9 @@
Version = New Version(1, Version.Major, Version.Build, Version.Revision) Version = New Version(1, Version.Major, Version.Build, Version.Revision)
End If End If
Is64Bit = Output.Contains("64-bit") Is64Bit = Output.Contains("64-bit")
If Version.Minor <= 4 OrElse Version.Minor >= 25 Then Throw New Exception("分析详细信息失败,获取的版本为 " & Version.ToString) If Version.Minor <= 4 OrElse Version.Minor >= 25 Then Throw New ApplicationException("分析详细信息失败,获取的版本为 " & Version.ToString)
'基于 #3649,在 64 位系统上禁用 32 位 Java
If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本,请安装 64 位的 Java")
'基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败,干脆禁用更多版本的 JRE '基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败,干脆禁用更多版本的 JRE
If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差,因此不再允许使用。你可以使用对应版本的 JDK,而非 JRE!") If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差,因此不再允许使用。你可以使用对应版本的 JDK,而非 JRE!")
Catch ex As ApplicationException Catch ex As ApplicationException
@@ -197,10 +199,15 @@
Setup.Set("LaunchArgumentJavaAll", "[]") Setup.Set("LaunchArgumentJavaAll", "[]")
End Try End Try
End Sub End Sub
''' <summary>
''' 防止多个需要 Java 的部分同时要求下载 Java(#3797)。
''' </summary>
Public JavaLock As New Object
''' <summary> ''' <summary>
''' 根据要求返回最适合的 Java,若找不到则返回 Nothing。 ''' 根据要求返回最适合的 Java,若找不到则返回 Nothing。
''' 最小与最大版本在与输入相同时也会通过。 ''' 最小与最大版本在与输入相同时也会通过。
''' 必须在工作线程调用。 ''' 必须在工作线程调用,且必须包括 SyncLock JavaLock。
''' </summary> ''' </summary>
Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing, Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing,
Optional RelatedVersion As McVersion = Nothing) As JavaEntry Optional RelatedVersion As McVersion = Nothing) As JavaEntry
@@ -460,8 +467,8 @@ NoUserJava:
If Not Left.IsJre AndAlso Right.IsJre Then Return False If Not Left.IsJre AndAlso Right.IsJre Then Return False
'4. Java 大版本 '4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then If Left.VersionCode <> Right.VersionCode Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21... ' 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, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28} 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.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
End If End If
'5. 最次级版本号更接近 51 '5. 最次级版本号更接近 51
@@ -601,7 +608,8 @@ NoUserJava:
'启动检查线程 '启动检查线程
Dim CheckThreads As New List(Of Thread) Dim CheckThreads As New List(Of Thread)
For Each Entry In JavaEntries For Each Entry In JavaEntries
Dim CheckThread As New Thread(Sub() Dim CheckThread As New Thread(
Sub()
Try Try
Entry.Check() Entry.Check()
If ModeDebug Then Log("[Java] - " & Entry.ToString) If ModeDebug Then Log("[Java] - " & Entry.ToString)
@@ -358,7 +358,7 @@ NextInner:
Case McLoginType.Ms Case McLoginType.Ms
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName") If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
Case McLoginType.Legacy Case McLoginType.Legacy
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Split("¨")(0) If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
Case McLoginType.Nide Case McLoginType.Nide
If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName") If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
Case McLoginType.Auth Case McLoginType.Auth
@@ -368,7 +368,7 @@ NextInner:
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName") If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName") If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName") If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Split("¨")(0) If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
Return Nothing Return Nothing
End Function End Function
''' <summary> ''' <summary>
@@ -524,7 +524,10 @@ Relogin:
Dim AccessToken As String = MsLoginStep5(Tokens) Dim AccessToken As String = MsLoginStep5(Tokens)
Data.Progress = 0.8 Data.Progress = 0.8
If Data.IsAborted Then Throw New ThreadInterruptedException If Data.IsAborted Then Throw New ThreadInterruptedException
Dim Result = MsLoginStep6(AccessToken) MsLoginStep6(AccessToken)
Data.Progress = 0.9
If Data.IsAborted Then Throw New ThreadInterruptedException
Dim Result = MsLoginStep7(AccessToken)
'输出登录结果 '输出登录结果
Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken) Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken)
Setup.Set("CacheMsAccess", AccessToken) Setup.Set("CacheMsAccess", AccessToken)
@@ -540,7 +543,7 @@ Relogin:
SkipLogin: SkipLogin:
McLaunchLog("微软登录完成") McLaunchLog("微软登录完成")
Setup.Set("HintBuy", True) '关闭正版购买提示 Setup.Set("HintBuy", True) '关闭正版购买提示
Data.Progress = 0.95 Data.Progress = 0.98
If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持!" & vbCrLf & "隐藏主题 跳票红 已解锁!", "提示") If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持!" & vbCrLf & "隐藏主题 跳票红 已解锁!", "提示")
End Sub End Sub
Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult)) Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
@@ -797,14 +800,14 @@ LoginFinish:
'微软登录步骤 1:打开网页认证,获取 OAuth Code '微软登录步骤 1:打开网页认证,获取 OAuth Code
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
McLaunchLog("开始微软登录步骤 1") McLaunchLog("开始微软登录步骤 1")
If OsVersion <= New Version(10, 0, 17763, 0) Then If True OrElse OsVersion <= New Version(10, 0, 17763, 0) Then '由于 #3849,WebBrowser 已经无法正常加载微软登录网页了
SystemBrowser: SystemBrowser:
'Windows 7 或老版 Windows 10 登录 'Windows 7 或老版 Windows 10 登录
OpenWebsite(FormLoginOAuth.LoginUrl1) OpenWebsite(FormLoginOAuth.LoginUrl1)
Dim Result As String = Dim Result As String =
MyMsgBoxInput("等待网页登录", MyMsgBoxInput("等待网页登录",
"在登录成功后,网页会变成一片空白,请将该空白页面的网址复制到下面的框中。" & vbCrLf & "登录完成后,网页会变得完全空白,把那个空白网页的网址复制到下面的框中就行了!" & vbCrLf &
"如果网络环境不佳,登录网页可能一直加载不出来,此时请尝试使用 VPN 或加速器,然后再试。", "如果网络环境不佳,它可能一直加载不出来,那就只能试试用 VPN 或加速器了。",
ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")}, ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")},
HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX") HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX")
If Result Is Nothing Then If Result Is Nothing Then
@@ -813,7 +816,7 @@ SystemBrowser:
Else Else
Return RegexSeek(Result, "(?<=code\=)[^&]+") Return RegexSeek(Result, "(?<=code\=)[^&]+")
End If End If
Hint("网页登录已完成,你现在可以关闭浏览器上的那个网页了", HintType.Finish) Hint("网页登录成功,你可以关闭浏览器啦!", HintType.Finish)
Else Else
'Windows 10 登录 'Windows 10 登录
Dim ReturnCode As String = Nothing Dim ReturnCode As String = Nothing
@@ -926,12 +929,18 @@ SystemBrowser:
Try Try
Result = NetRequestMulty("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3) Result = NetRequestMulty("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
Catch ex As Net.WebException Catch ex As Net.WebException
If ex.Message.Contains("2148916233") Then '参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
If MyMsgBox("该微软账号尚未购买 Minecraft Java 版,或尚未注册 Xbox 账户。" & vbCrLf & If ex.Message.Contains("2148916227") Then
"如果你确定该账号完成了上述步骤,请先在游戏官网登录一次,然后再在启动器登录。", "登录提示", "打开游戏官网", "取消") = 1 Then MyMsgBox("该账号似乎已被微软封禁,无法登录。", "登录失败", "我知道了", IsWarn:=True)
OpenWebsite("https://www.minecraft.net/") Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916233") Then
If MyMsgBox("你尚未注册 Xbox 账户,请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then
OpenWebsite("https://signup.live.com/signup")
End If End If
Throw New Exception("$$") Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916235") Then
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请尝试使用加速器或 VPN。", "登录失败", "我知道了")
Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916238") Then ElseIf ex.Message.Contains("2148916238") Then
If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf & If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf &
"该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then "该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
@@ -979,28 +988,44 @@ SystemBrowser:
Dim AccessToken As String = ResultJson("access_token").ToString Dim AccessToken As String = ResultJson("access_token").ToString
Return AccessToken Return AccessToken
End Function End Function
'微软登录步骤 6:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson} '微软登录步骤 6:验证微软账号是否持有 MC,这也会刷新 XGP
Private Function MsLoginStep6(AccessToken As String) As String() Private Sub MsLoginStep6(AccessToken As String)
McLaunchLog("开始微软登录步骤 6") McLaunchLog("开始微软登录步骤 6")
Dim Result As String = NetRequestMulty("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Try
Dim ResultJson As JObject = GetJson(Result)
If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
Select Case MyMsgBox("你尚未购买正版 Minecraft,或者 Xbox Game Pass 已到期。", "登录失败", "购买 Minecraft", "取消")
Case 1
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End Select
Throw New Exception("$$")
End If
Catch ex As Exception
Log(ex, "微软登录第 6 步异常:" & Result)
Throw
End Try
End Sub
'微软登录步骤 7:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
Private Function MsLoginStep7(AccessToken As String) As String()
McLaunchLog("开始微软登录步骤 7")
Dim Result As String Dim Result As String
Try Try
NetRequestMulty("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Result = NetRequestMulty("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}}) Result = NetRequestMulty("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Catch ex As Net.WebException Catch ex As Net.WebException
Dim Message As String = GetExceptionSummary(ex) Dim Message As String = GetExceptionSummary(ex)
If Message.Contains("(429)") Then If Message.Contains("(429)") Then
Log(ex, "微软登录第 6 步汇报 429") Log(ex, "微软登录第 7 步汇报 429")
Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!") Throw New Exception("$登录尝试太过频繁,请等待几分钟后再试!")
ElseIf Message.Contains("(404)") Then ElseIf Message.Contains("(404)") Then
Log(ex, "微软登录第 6 步汇报 404") Log(ex, "微软登录第 7 步汇报 404")
RunInNewThread(Sub() RunInNewThread(
Select Case MyMsgBox("你可能没有创建 Minecraft 玩家档案、Xbox Game Pass 已到期,或者还没有购买 Minecraft。" & vbCrLf & Sub()
"如果您确认您已购买 Minecraft 或您的 Xbox Game Pass 未过期,请创建档案,之后即可使用 PCL 登录。", "登录失败", "创建档案", "购买 Minecraft", "取消") Select Case MyMsgBox("请先创建 Minecraft 玩家档案,然后再重新登录。", "登录失败", "创建档案", "取消")
Case 1 Case 1
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile") OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
Case 2
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End Select End Select
End Sub, "Login Failed: Create Profile") End Sub, "Login Failed: Create Profile")
Throw New Exception("$$") Throw New Exception("$$")
@@ -1169,6 +1194,8 @@ SystemBrowser:
MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer) MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer)
End If End If
SyncLock JavaLock
'选择 Java '选择 Java
McLaunchLog("Java 版本需求:最低 " & MinVer.ToString & ",最高 " & MaxVer.ToString) McLaunchLog("Java 版本需求:最低 " & MinVer.ToString & ",最高 " & MaxVer.ToString)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent) McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
@@ -1190,7 +1217,7 @@ SystemBrowser:
If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 0) Then ElseIf MaxVer < New Version(1, 8, 0, 0) Then
JavaCode = 7 JavaCode = 7
If Not JavaDownloadConfirm("Java 7") Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u101" JavaCode = "8u101"
If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$")
@@ -1228,6 +1255,7 @@ SystemBrowser:
Throw New Exception("$$") Throw New Exception("$$")
End If End If
End SyncLock
End Sub End Sub
#End Region #End Region
@@ -1342,7 +1370,7 @@ SystemBrowser:
If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true" If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理 ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理
DataList.Insert(0, ArgumentJvm) '可变 JVM 参数 DataList.Insert(0, ArgumentJvm) '可变 JVM 参数
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.5) & "m") 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("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """") DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """")
DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表 DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表
@@ -1610,7 +1638,8 @@ NextVersion:
GameSize = New Size(875 - 2, 540 - 2) GameSize = New Size(875 - 2, 540 - 2)
End Select End Select
GameSize.Height -= 29.5 * DPI / 96 '标题栏高度 GameSize.Height -= 29.5 * DPI / 96 '标题栏高度
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 Then '修复 #3463:1.12.2-,JRE 8 下窗口大小为设置大小的 DPI% 倍 If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 AndAlso
Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then '修复 #3463:1.12.2-,JRE 8 下窗口大小为设置大小的 DPI% 倍
GameSize.Width /= DPI / 96 GameSize.Width /= DPI / 96
GameSize.Height /= DPI / 96 GameSize.Height /= DPI / 96
End If End If
@@ -1809,13 +1838,14 @@ NextVersion:
'1.11 ~ 12:zh_cn 时正常,zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文 '1.11 ~ 12:zh_cn 时正常,zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文
'1.13+ :zh_cn 时正常,zh_CN 时自动切换为英文 '1.13+ :zh_cn 时正常,zh_CN 时自动切换为英文
Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none") Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none")
Dim RequiredLang As String = If(CurrentLang = "none", If(Setup.Get("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.ToLower) Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves"), '#3844,整合包可能已经自带了 options.txt
If(Setup.Get("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.ToLower)
If McVersionCurrent.Version.McCodeMain < 12 Then '注意老版本(包含 MC 1.1)的 McCodeMain 可能为 -1 If McVersionCurrent.Version.McCodeMain < 12 Then '注意老版本(包含 MC 1.1)的 McCodeMain 可能为 -1
'将最后两位改为大写,前面的部分保留 '将最后两位改为大写,前面的部分保留
RequiredLang = RequiredLang.Substring(0, RequiredLang.Length - 2) & RequiredLang.Substring(RequiredLang.Length - 2).ToUpper RequiredLang = RequiredLang.Substring(0, RequiredLang.Length - 2) & RequiredLang.Substring(RequiredLang.Length - 2).ToUpper
End If End If
If CurrentLang = RequiredLang Then If CurrentLang = RequiredLang Then
McLaunchLog($"当前语言为 {CurrentLang},无需修改") McLaunchLog($"需要的语言为 {RequiredLang},当前语言为 {CurrentLang},无需修改")
Else Else
WriteIni(SetupFileAddress, "lang", "-") '触发缓存更改,避免删除后重新下载残留缓存 WriteIni(SetupFileAddress, "lang", "-") '触发缓存更改,避免删除后重新下载残留缓存
WriteIni(SetupFileAddress, "lang", RequiredLang) WriteIni(SetupFileAddress, "lang", RequiredLang)
@@ -1,4 +1,6 @@
Public Module ModMinecraft Imports System.IO.Compression
Public Module ModMinecraft
#Region "文件夹" #Region "文件夹"
@@ -149,7 +151,7 @@
#Region "版本处理" #Region "版本处理"
Public Const McVersionCacheVersion As Integer = 27 Public Const McVersionCacheVersion As Integer = 29
Private _McVersionCurrent As McVersion Private _McVersionCurrent As McVersion
Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化 Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化
@@ -391,6 +393,29 @@
_Version.McName = JsonObject("jar").ToString _Version.McName = JsonObject("jar").ToString
GoTo VersionSearchFinish GoTo VersionSearchFinish
End If End If
'从 jar 文件的 version.json 中获取版本号
If File.Exists(Path & Name & ".jar") Then
Try
Using JarArchive As New ZipArchive(New FileStream(Path & Name & ".jar", FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json")
If VersionJson IsNot Nothing Then
Using VersionJsonStream As New StreamReader(VersionJson.Open)
Dim VersionJsonObj As JObject = GetJson(VersionJsonStream.ReadToEnd)
If VersionJsonObj("id") IsNot Nothing Then
Dim VersionId As String = VersionJsonObj("id").ToString
If VersionId.Length < 32 Then '因为 wiki 说这玩意儿可能是个 hash,虽然我没发现
_Version.McName = VersionId
Log("[Minecraft] 从版本 jar 中的 version.json 获取到版本号:" & VersionId)
GoTo VersionSearchFinish
End If
End If
End Using
End If
End Using
Catch ex As Exception
Log(ex, "从版本 jar 中的 version.json 获取版本号失败")
End Try
End If
'非准确的版本判断警告 '非准确的版本判断警告
Log("[Minecraft] 无法完全确认 MC 版本号的版本:" & Name) Log("[Minecraft] 无法完全确认 MC 版本号的版本:" & Name)
'从文件夹名中获取 '从文件夹名中获取
@@ -1034,7 +1059,7 @@ ExitDataLoad:
Dim Path As String = Loader.Input Dim Path As String = Loader.Input
Try Try
'初始化 '初始化
McVersionList.Clear() McVersionList = New Dictionary(Of McVersionCardType, List(Of McVersion))
'检测缓存是否需要更新 '检测缓存是否需要更新
Dim FolderList As New List(Of String) Dim FolderList As New List(Of String)
@@ -1075,10 +1100,10 @@ Reload:
'改变当前选择的版本 '改变当前选择的版本
OnLoaded: OnLoaded:
If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then '不能判断 Count = 0,这在只有错误版本时导致了误判 If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then
'尝试读取已储存的选择 '尝试读取已储存的选择
Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version") Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version")
If Not SavedSelection = "" Then If SavedSelection <> "" Then
For Each Card As KeyValuePair(Of McVersionCardType, List(Of McVersion)) In McVersionList For Each Card As KeyValuePair(Of McVersionCardType, List(Of McVersion)) In McVersionList
For Each Version As McVersion In Card.Value For Each Version As McVersion In Card.Value
If Version.Name = SavedSelection AndAlso Not Version.State = McVersionState.Error Then If Version.Name = SavedSelection AndAlso Not Version.State = McVersionState.Error Then
@@ -1190,7 +1215,7 @@ OnLoaded:
End Try End Try
Next Next
ResultVersionList.Add(CardType, VersionList) If VersionList.Any Then ResultVersionList.Add(CardType, VersionList)
Next Next
Return ResultVersionList Return ResultVersionList
Catch ex As Exception Catch ex As Exception
@@ -1200,10 +1225,14 @@ OnLoaded:
End Function End Function
Private Function McVersionListLoadNoCache(Path As String) As Dictionary(Of McVersionCardType, List(Of McVersion)) Private Function McVersionListLoadNoCache(Path As String) As Dictionary(Of McVersionCardType, List(Of McVersion))
Dim VersionList As New List(Of McVersion) Dim VersionList As New List(Of McVersion)
Dim ResultVersionList As New Dictionary(Of McVersionCardType, List(Of McVersion))
#Region "循环加载每个版本的信息" #Region "循环加载每个版本的信息"
Dim Dirs As DirectoryInfo() = New DirectoryInfo(Path & "versions").GetDirectories Dim Dirs As DirectoryInfo() = New DirectoryInfo(Path & "versions").GetDirectories
For Each Folder As DirectoryInfo In Dirs For Each Folder As DirectoryInfo In Dirs
If Not Folder.EnumerateFiles.Any Then
Log("[Minecraft] 跳过空文件夹:" & Folder.FullName)
Continue For
End If
If (Folder.Name = "cache" OrElse Folder.Name = "BLClient" OrElse Folder.Name = "PCL") AndAlso Not File.Exists(Folder.FullName & "\" & Folder.Name & ".json") Then If (Folder.Name = "cache" OrElse Folder.Name = "BLClient" OrElse Folder.Name = "PCL") AndAlso Not File.Exists(Folder.FullName & "\" & Folder.Name & ".json") Then
Log("[Minecraft] 跳过可能不是版本文件夹的项目:" & Folder.FullName) Log("[Minecraft] 跳过可能不是版本文件夹的项目:" & Folder.FullName)
Continue For Continue For
@@ -1223,6 +1252,9 @@ OnLoaded:
Version.Load() Version.Load()
Next Next
#End Region #End Region
Dim ResultVersionList As New Dictionary(Of McVersionCardType, List(Of McVersion))
#Region "将版本分类到各个卡片" #Region "将版本分类到各个卡片"
Try Try
@@ -1236,7 +1268,7 @@ OnLoaded:
Next Next
If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions) If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions)
'预先筛选出愚人节的版本 '预先筛选出愚人节和错误的版本
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Error}, McVersionCardType.Error) McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Error}, McVersionCardType.Error)
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Fool}, McVersionCardType.Fool) McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Fool}, McVersionCardType.Fool)
@@ -1347,9 +1379,7 @@ OnLoaded:
Next Next
If Not IsNothing(Snapshot) Then OldList.Remove(Snapshot) If Not IsNothing(Snapshot) Then OldList.Remove(Snapshot)
'按版本号排序 '按版本号排序
Dim NewList As List(Of McVersion) = Sort(OldList, Function(Left As McVersion, Right As McVersion) Dim NewList As List(Of McVersion) = Sort(OldList, Function(Left, Right) Left.Version.McCodeMain > Right.Version.McCodeMain)
Return Left.Version.McCodeMain > Right.Version.McCodeMain
End Function)
'回设 '回设
If Not IsNothing(Snapshot) Then NewList.Insert(0, Snapshot) If Not IsNothing(Snapshot) Then NewList.Insert(0, Snapshot)
ResultVersionList(McVersionCardType.OriginalLike) = NewList ResultVersionList(McVersionCardType.OriginalLike) = NewList
@@ -1357,7 +1387,8 @@ OnLoaded:
'不常用版本:按发布时间新旧排序,如果不可用则按名称排序 '不常用版本:按发布时间新旧排序,如果不可用则按名称排序
If ResultVersionList.ContainsKey(McVersionCardType.Rubbish) Then If ResultVersionList.ContainsKey(McVersionCardType.Rubbish) Then
ResultVersionList(McVersionCardType.Rubbish) = Sort(ResultVersionList(McVersionCardType.Rubbish), Function(Left As McVersion, Right As McVersion) ResultVersionList(McVersionCardType.Rubbish) = Sort(ResultVersionList(McVersionCardType.Rubbish),
Function(Left As McVersion, Right As McVersion)
Dim LeftYear As Integer = Left.ReleaseTime.Year '+ If(Left.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0) Dim LeftYear As Integer = Left.ReleaseTime.Year '+ If(Left.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0)
Dim RightYear As Integer = Right.ReleaseTime.Year '+ If(Right.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0) Dim RightYear As Integer = Right.ReleaseTime.Year '+ If(Right.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0)
If LeftYear > 2000 AndAlso RightYear > 2000 Then If LeftYear > 2000 AndAlso RightYear > 2000 Then
@@ -1378,7 +1409,8 @@ OnLoaded:
'API 版本:优先按版本排序,此后【先放 Fabric,再放 Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】 'API 版本:优先按版本排序,此后【先放 Fabric,再放 Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】
If ResultVersionList.ContainsKey(McVersionCardType.API) Then If ResultVersionList.ContainsKey(McVersionCardType.API) Then
ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API), Function(Left As McVersion, Right As McVersion) ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API),
Function(Left As McVersion, Right As McVersion)
Dim Basic = VersionSortInteger(Left.Version.McName, Right.Version.McName) Dim Basic = VersionSortInteger(Left.Version.McName, Right.Version.McName)
If Basic <> 0 Then If Basic <> 0 Then
Return Basic > 0 Return Basic > 0
@@ -1417,17 +1449,7 @@ OnLoaded:
''' <param name="Formula">需要筛选出的版本类型。-2 代表隐藏的版本。</param> ''' <param name="Formula">需要筛选出的版本类型。-2 代表隐藏的版本。</param>
''' <param name="CardType">卡片的名称。</param> ''' <param name="CardType">卡片的名称。</param>
Private Sub McVersionFilter(ByRef VersionList As List(Of McVersion), ByRef Target As Dictionary(Of McVersionCardType, List(Of McVersion)), Formula As McVersionState(), CardType As McVersionCardType) Private Sub McVersionFilter(ByRef VersionList As List(Of McVersion), ByRef Target As Dictionary(Of McVersionCardType, List(Of McVersion)), Formula As McVersionState(), CardType As McVersionCardType)
'将某种版本筛选出来 Dim KeepList = VersionList.Where(Function(v) Formula.Contains(v.State)).ToList
Dim KeepList As New List(Of McVersion)
For Each Version As McVersion In VersionList
For Each Type As Integer In Formula
If Type = Version.State Then
KeepList.Add(Version)
GoTo NextVersion
End If
Next
NextVersion:
Next
'加入版本列表,并从剩余中删除 '加入版本列表,并从剩余中删除
If KeepList.Any Then If KeepList.Any Then
Target.Add(CardType, KeepList) Target.Add(CardType, KeepList)
@@ -1443,13 +1465,8 @@ NextVersion:
''' <param name="Formula">需要筛选出的版本类型。-2 代表隐藏的版本。</param> ''' <param name="Formula">需要筛选出的版本类型。-2 代表隐藏的版本。</param>
''' <param name="KeepList">传入需要增加入的列表。</param> ''' <param name="KeepList">传入需要增加入的列表。</param>
Private Sub McVersionFilter(ByRef VersionList As List(Of McVersion), Formula As McVersionState(), ByRef KeepList As List(Of McVersion)) Private Sub McVersionFilter(ByRef VersionList As List(Of McVersion), Formula As McVersionState(), ByRef KeepList As List(Of McVersion))
For Each Version As McVersion In VersionList KeepList.AddRange(VersionList.Where(Function(v) Formula.Contains(v.State)))
For Each Type As McVersionState In Formula '加入版本列表,并从剩余中删除
If Type <> Version.State Then Continue For
KeepList.Add(Version) : Exit For
Next
NextVersion:
Next
If KeepList.Any Then If KeepList.Any Then
For Each Version As McVersion In KeepList For Each Version As McVersion In KeepList
VersionList.Remove(Version) VersionList.Remove(Version)
@@ -887,11 +887,11 @@ Finished:
ModList.Add(ModEntry) ModList.Add(ModEntry)
'读取 Comp 缓存 '读取 Comp 缓存
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
Dim Hash = ModEntry.ModrinthHash Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName
If Cache.ContainsKey(Hash) Then If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(Hash)) ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取 '如果缓存中的信息在 6 小时以内更新过,则无需重新获取
If ModEntry.CompLoaded AndAlso Date.Now - Cache(Hash)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If End If
ModUpdateList.Add(ModEntry) ModUpdateList.Add(ModEntry)
Next Next
@@ -925,7 +925,7 @@ Finished:
End Sub End Sub
'联网加载 Mod 详情 '联网加载 Mod 详情
Private Const LocalModCacheVersion As Integer = 3 Private Const LocalModCacheVersion As Integer = 4
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad) Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)) Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key Dim Mods As List(Of McMod) = Loader.Input.Key
@@ -937,7 +937,7 @@ Finished:
If TargetMcVersion.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric) If TargetMcVersion.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader) If TargetMcVersion.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt}) If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Dim McVersions As New List(Of String) From {TargetMcVersion.McName} Dim McVersion = TargetMcVersion.McName
'暂不向下扩展检查的 MC 小版本 '暂不向下扩展检查的 MC 小版本
'例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2 '例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
'If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then 'If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
@@ -948,7 +948,7 @@ Finished:
'End If 'End If
'McVersions = McVersions.Distinct().ToList() 'McVersions = McVersions.Distinct().ToList()
'开始网络获取 '开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersions.Join("/")}") Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}")
Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0 Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0
Dim MainThread As Thread = Thread.CurrentThread Dim MainThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息 '从 Modrinth 获取信息
@@ -991,8 +991,8 @@ Finished:
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息") Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息 '步骤 4:获取更新信息
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST", Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1"", $"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersions.Join(""",""")}""]}}", "application/json")), JObject) ""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject)
For Each Entry In Mods For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod) Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
@@ -1001,11 +1001,11 @@ Finished:
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件 '设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并 If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}") Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}")
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源 UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件 Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换 ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}"} Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}"}
Entry.UpdateFile = UpdateFile Entry.UpdateFile = UpdateFile
End If End If
Next Next
@@ -1073,7 +1073,7 @@ Finished:
For Each IndexEntry In ProjectJson("latestFilesIndexes") For Each IndexEntry In ProjectJson("latestFilesIndexes")
If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配 If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion") Dim IndexVersion As String = IndexEntry("gameVersion")
If Not McVersions.Contains(IndexVersion) Then Continue For 'MC 版本匹配 If McVersion <> IndexVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件 '由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本 If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then If NewestVersion <> IndexVersion Then
@@ -1136,7 +1136,7 @@ Finished:
If Not Mods.Any() Then Exit Sub If Not Mods.Any() Then Exit Sub
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳 For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
Entry.CompLoaded = SucceedThreadCount = 2 Entry.CompLoaded = SucceedThreadCount = 2
Cache(Entry.ModrinthHash) = Entry.ToJson() Cache(Entry.ModrinthHash & McVersion) = Entry.ToJson()
Next Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
End Sub End Sub
@@ -348,6 +348,7 @@
'崩溃分析 '崩溃分析
WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析") WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
Hint("检测到 Minecraft 出现错误,错误分析已开始……") Hint("检测到 Minecraft 出现错误,错误分析已开始……")
FeedbackInfo()
RunInNewThread(Sub() RunInNewThread(Sub()
Try Try
Thread.Sleep(2000) Thread.Sleep(2000)
@@ -195,6 +195,7 @@ RetryStart:
Private Shared Swiping As Boolean = False Private Shared Swiping As Boolean = False
Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值 Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值
Private Sub Button_MouseSwipeStart(sender As Object, e As Object) Handles Me.MouseLeftButtonDown Private Sub Button_MouseSwipeStart(sender As Object, e As Object) Handles Me.MouseLeftButtonDown
If Parent Is Nothing Then Exit Sub 'Mod 可能已被删除(#3824)
'开始滑动 '开始滑动
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me) Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
SwipeStart = Index SwipeStart = Index
@@ -204,6 +205,7 @@ RetryStart:
FrmVersionMod.CardSelect.IsHitTestVisible = False '暂时禁用下边栏 FrmVersionMod.CardSelect.IsHitTestVisible = False '暂时禁用下边栏
End Sub End Sub
Private Sub Button_MouseSwipe(sender As Object, e As Object) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonUp Private Sub Button_MouseSwipe(sender As Object, e As Object) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonUp
If Parent Is Nothing Then Exit Sub 'Mod 可能已被删除(#3824)
'结束滑动 '结束滑动
If Mouse.LeftButton <> MouseButtonState.Pressed OrElse Not Swiping Then If Mouse.LeftButton <> MouseButtonState.Pressed OrElse Not Swiping Then
Swiping = False Swiping = False
+3 -4
View File
@@ -73,8 +73,8 @@
Case "切换页面" Case "切换页面"
FrmMain.PageChange(Val(Data(0)), Val(Data(1))) FrmMain.PageChange(Val(Data(0)), Val(Data(1)))
Case "导入整合包" Case "导入整合包", "安装整合包"
RunInThread(Sub() ModpackInstall()) RunInUi(Sub() ModpackInstall())
Case "下载文件" Case "下载文件"
Data(0) = Data(0).Replace("\", "/") Data(0) = Data(0).Replace("\", "/")
@@ -101,8 +101,7 @@
'网页确认 '网页确认
If RelativeUrl.StartsWithF("http", True) Then If RelativeUrl.StartsWithF("http", True) Then
If RunInUi() Then If RunInUi() Then
Throw New Exception("MyListItem 在界面初始化时就需要获取帮助标题等信息,这会导致程序在网络请求时卡死。" & vbCrLf & Throw New Exception("能打开联网帮助页面的 MyListItem 必须手动设置 Title、Info 属性!")
"因此,请换用 MyListItem 以外的控件(例如 MyButton)作为联网帮助页面的入口!")
End If End If
'获取文件名 '获取文件名
Dim RawFileName As String Dim RawFileName As String
+11 -9
View File
@@ -1,6 +1,4 @@
Imports System.Security.Cryptography Public Module ModMusic
Public Module ModMusic
#Region "播放列表" #Region "播放列表"
@@ -199,13 +197,15 @@ Public Module ModMusic
''' </summary> ''' </summary>
Public Function MusicPause() As Boolean Public Function MusicPause() As Boolean
If MusicState = MusicStates.Play Then If MusicState = MusicStates.Play Then
RunInThread(Sub() RunInThread(
MusicNAudio.Pause() Sub()
MusicRefreshUI()
Log("[Music] 已暂停播放") Log("[Music] 已暂停播放")
MusicNAudio?.Pause()
MusicRefreshUI()
End Sub) End Sub)
Return True Return True
Else Else
Log($"[Music] 无需暂停播放,当前状态为 {MusicState}")
Return False Return False
End If End If
End Function End Function
@@ -214,12 +214,14 @@ Public Module ModMusic
''' </summary> ''' </summary>
Public Function MusicResume() As Boolean Public Function MusicResume() As Boolean
If MusicState = MusicStates.Play OrElse Not MusicAllList.Any() Then If MusicState = MusicStates.Play OrElse Not MusicAllList.Any() Then
Log($"[Music] 无需继续播放,当前状态为 {MusicState}")
Return False Return False
Else Else
RunInThread(Sub() RunInThread(
MusicNAudio.Play() Sub()
MusicRefreshUI()
Log("[Music] 已恢复播放") Log("[Music] 已恢复播放")
MusicNAudio?.Play()
MusicRefreshUI()
End Sub) End Sub)
Return True Return True
End If End If
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.7.3.0")> <Assembly: AssemblyVersion("2.7.4.0")>
<Assembly: AssemblyFileVersion("2.7.3.0")> <Assembly: AssemblyFileVersion("2.7.4.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
@@ -384,7 +384,9 @@ Public Module ModDownloadLib
End Sub End Sub
Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean), UseJavaWrapper As Boolean) Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean), UseJavaWrapper As Boolean)
'选择 Java '选择 Java
Dim Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0)) Dim Java As JavaEntry
SyncLock JavaLock
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 0))
If Java Is Nothing Then If Java Is Nothing Then
If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java,已取消安装。") If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java,已取消安装。")
'开始自动下载 '开始自动下载
@@ -402,6 +404,7 @@ Public Module ModDownloadLib
If Task.IsAborted Then Exit Sub If Task.IsAborted Then Exit Sub
If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。") If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。")
End If End If
End SyncLock
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
Dim Arguments As String Dim Arguments As String
If UseJavaWrapper Then If UseJavaWrapper Then
@@ -1111,7 +1114,9 @@ Retry:
Private Sub ForgeInjector(Target As String, Task As LoaderTask(Of Boolean, Boolean), McFolder As String, UseJavaWrapper As Boolean) Private Sub ForgeInjector(Target As String, Task As LoaderTask(Of Boolean, Boolean), McFolder As String, UseJavaWrapper As Boolean)
'选择 Java '选择 Java
Dim Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60)) Dim Java As JavaEntry
SyncLock JavaLock
Java = JavaSelect("已取消安装。", New Version(1, 8, 0, 60))
If Java Is Nothing Then If Java Is Nothing Then
If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java,已取消安装。") If Not JavaDownloadConfirm("Java 8 或更高版本") Then Throw New Exception("由于未找到 Java,已取消安装。")
'开始自动下载 '开始自动下载
@@ -1129,6 +1134,7 @@ Retry:
If Task.IsAborted Then Exit Sub If Task.IsAborted Then Exit Sub
If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。") If Java Is Nothing Then Throw New Exception("由于未找到 Java,已取消安装。")
End If End If
End SyncLock
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
Dim Arguments As String Dim Arguments As String
If UseJavaWrapper Then If UseJavaWrapper Then
@@ -1275,8 +1281,8 @@ Retry:
McFolder = If(McFolder, PathMcFolder) McFolder = If(McFolder, PathMcFolder)
If Version.StartsWithF("1.") AndAlso Version.Contains("-") Then If Version.StartsWithF("1.") AndAlso Version.Contains("-") Then
'类似 1.19.3-41.2.8 格式,优先使用 Version 中要求的版本而非 Inherit(例如 1.19.3 却使用了 1.19 的 Forge) '类似 1.19.3-41.2.8 格式,优先使用 Version 中要求的版本而非 Inherit(例如 1.19.3 却使用了 1.19 的 Forge)
Inherit = Version.Split("-").First Inherit = Version.Before("-")
Version = Version.Split("-").Last Version = Version.After("-")
End If End If
Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder
Dim Id As String = Inherit & "-forge-" & Version Dim Id As String = Inherit & "-forge-" & Version
@@ -1322,7 +1328,7 @@ Retry:
Loaders.Add(New LoaderDownload("下载 Mod 加载器主文件", New List(Of NetFile)) With {.ProgressWeight = 9}) Loaders.Add(New LoaderDownload("下载 Mod 加载器主文件", New List(Of NetFile)) With {.ProgressWeight = 9})
'安装(仅在新版安装时需要原版 Jar) '安装(仅在新版安装时需要原版 Jar)
If Version.Split(".")(0) >= 20 Then If Version.Before(".") >= 20 Then
Log("[Download] 检测为新版 Forge:" & Version) Log("[Download] 检测为新版 Forge:" & Version)
Dim Libs As List(Of McLibToken) = Nothing Dim Libs As List(Of McLibToken) = Nothing
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Mod 加载器支持库文件",
@@ -1344,7 +1350,7 @@ Retry:
Task.Progress = 0.4 Task.Progress = 0.4
Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True)) Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg] '[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(0) Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Before("@")
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1)) Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName, Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")}) .Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")})
@@ -1788,7 +1794,7 @@ Retry:
Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
'建立控件 '建立控件
Dim NewItem As New MyListItem With { Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Before("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"), .Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Logo = PathImage & "Blocks/Fabric.png" .Logo = PathImage & "Blocks/Fabric.png"
} }
@@ -1978,7 +1984,7 @@ Retry:
If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder) If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder)
Dim OptiFineFolder As String = Nothing Dim OptiFineFolder As String = Nothing
If Request.OptiFineVersion IsNot Nothing Then If Request.OptiFineVersion IsNot Nothing Then
If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.Split("_HD_U_").Last '#735 If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.After("_HD_U_") '#735
Request.OptiFineEntry = New DlOptiFineListEntry With { Request.OptiFineEntry = New DlOptiFineListEntry With {
.NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"), .NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"),
.Inherit = Request.MinecraftName, .Inherit = Request.MinecraftName,
@@ -2062,7 +2068,7 @@ Retry:
End Sub) With {.ProgressWeight = 2, .Block = True}) End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件 '补全文件
If Not DontFixLibraries AndAlso If Not DontFixLibraries AndAlso
(Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.Split(".")(0) >= 20) OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then (Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.Before(".") >= 20) OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(OutputFolder))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(OutputFolder))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False}) LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
@@ -275,7 +275,7 @@
If Project.TranslatedName = Project.RawName Then If Project.TranslatedName = Project.RawName Then
FileName = File.FileName FileName = File.FileName
Else Else
Dim ChineseName As String = Project.TranslatedName.Split(" (").First.Split(" - ").First. Dim ChineseName As String = Project.TranslatedName.Before(" (").Before(" - ").
Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":") Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
Select Case Setup.Get("ToolDownloadTranslate") Select Case Setup.Get("ToolDownloadTranslate")
Case 0 Case 0
@@ -299,7 +299,7 @@
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder) If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Exit Sub If Not Target.Contains("\") Then Exit Sub
'构造步骤加载器 '构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & File.DisplayName & " " Dim LoaderName As String = Desc & "下载:" & GetFileNameWithoutExtentionFromPath(Target) & " "
If Target <> DefaultFolder AndAlso Project.Type = CompType.Mod Then CachedFolder = GetPathFromFullPath(Target) If Target <> DefaultFolder AndAlso Project.Type = CompType.Mod Then CachedFolder = GetPathFromFullPath(Target)
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True}) Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
@@ -20,6 +20,7 @@
<StackPanel Margin="25,37,25,15"> <StackPanel Margin="25,37,25,15">
<local:MyHint Text="你尚未选择安装 Fabric API,这会导致大多数 Mod 无法使用!" Margin="0,1,0,7" x:Name="HintFabricAPI" IsWarn="True" /> <local:MyHint Text="你尚未选择安装 Fabric API,这会导致大多数 Mod 无法使用!" Margin="0,1,0,7" x:Name="HintFabricAPI" IsWarn="True" />
<local:MyHint Text="你尚未选择安装 OptiFabric,这会导致 OptiFine 无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabric" IsWarn="True" /> <local:MyHint Text="你尚未选择安装 OptiFabric,这会导致 OptiFine 无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabric" IsWarn="True" />
<local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,1,0,7" x:Name="HintModOptiFine" IsWarn="False" />
<Grid Margin="0,0,0,11"> <Grid Margin="0,0,0,11">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" /> <ColumnDefinition Width="1*" />
@@ -60,26 +61,6 @@
<TextBlock VerticalAlignment="Center" Text="返回" Grid.Column="3" Foreground="{StaticResource ColorBrushGray4}" /> <TextBlock VerticalAlignment="Center" Text="返回" Grid.Column="3" Foreground="{StaticResource ColorBrushGray4}" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard Title="OptiFine" Height="40" Margin="0,15,0,0" x:Name="CardOptiFine" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top">
<StackPanel Name="PanOptiFine" />
</StackPanel>
<Grid x:Name="PanOptiFineInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform>
<TranslateTransform />
</Grid.RenderTransform>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Image x:Name="ImgOptiFine" Margin="0,0,7,0" SnapsToDevicePixels="True" Height="18" RenderOptions.BitmapScalingMode="Linear" Source="pack://application:,,,/images/Blocks/GrassPath.png" />
<TextBlock x:Name="LabOptiFine" VerticalAlignment="Center" TextTrimming="CharacterEllipsis" Grid.Column="1" />
</Grid>
<Grid x:Name="BtnOptiFineClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnOptiFineClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid>
</local:MyCard>
<local:MyCard Title="Forge" Height="40" Margin="0,15,0,0" x:Name="CardForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True"> <local:MyCard Title="Forge" Height="40" Margin="0,15,0,0" x:Name="CardForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanForge" /> <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanForge" />
<Grid x:Name="PanForgeInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True"> <Grid x:Name="PanForgeInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
@@ -134,6 +115,26 @@
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard Title="OptiFine" Height="40" Margin="0,15,0,0" x:Name="CardOptiFine" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top">
<StackPanel Name="PanOptiFine" />
</StackPanel>
<Grid x:Name="PanOptiFineInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform>
<TranslateTransform />
</Grid.RenderTransform>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Image x:Name="ImgOptiFine" Margin="0,0,7,0" SnapsToDevicePixels="True" Height="18" RenderOptions.BitmapScalingMode="Linear" Source="pack://application:,,,/images/Blocks/GrassPath.png" />
<TextBlock x:Name="LabOptiFine" VerticalAlignment="Center" TextTrimming="CharacterEllipsis" Grid.Column="1" />
</Grid>
<Grid x:Name="BtnOptiFineClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnOptiFineClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid>
</local:MyCard>
<local:MyCard Title="OptiFabric" Height="40" Margin="0,15,0,0" x:Name="CardOptiFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True"> <local:MyCard Title="OptiFabric" Height="40" Margin="0,15,0,0" x:Name="CardOptiFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanOptiFabric" /> <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanOptiFabric" />
<Grid x:Name="PanOptiFabricInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True"> <Grid x:Name="PanOptiFabricInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True">
@@ -305,6 +305,10 @@
LabOptiFine.Foreground = ColorGray1 LabOptiFine.Foreground = ColorGray1
End If End If
'LiteLoader 'LiteLoader
If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then
CardLiteLoader.Visibility = Visibility.Collapsed
Else
CardLiteLoader.Visibility = Visibility.Visible
Dim LiteLoaderError As String = LoadLiteLoaderGetError() Dim LiteLoaderError As String = LoadLiteLoaderGetError()
CardLiteLoader.MainSwap.Visibility = If(LiteLoaderError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardLiteLoader.MainSwap.Visibility = If(LiteLoaderError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If LiteLoaderError IsNot Nothing Then CardLiteLoader.IsSwaped = True '例如在同时展开卡片时选择了不兼容项则强制折叠 If LiteLoaderError IsNot Nothing Then CardLiteLoader.IsSwaped = True '例如在同时展开卡片时选择了不兼容项则强制折叠
@@ -320,6 +324,7 @@
LabLiteLoader.Text = SelectedLiteLoader.Inherit LabLiteLoader.Text = SelectedLiteLoader.Inherit
LabLiteLoader.Foreground = ColorGray1 LabLiteLoader.Foreground = ColorGray1
End If End If
End If
'Forge 'Forge
Dim ForgeError As String = LoadForgeGetError() Dim ForgeError As String = LoadForgeGetError()
CardForge.MainSwap.Visibility = If(ForgeError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardForge.MainSwap.Visibility = If(ForgeError Is Nothing, Visibility.Visible, Visibility.Collapsed)
@@ -337,6 +342,10 @@
LabForge.Foreground = ColorGray1 LabForge.Foreground = ColorGray1
End If End If
'Fabric 'Fabric
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) <= 13 Then
CardFabric.Visibility = Visibility.Collapsed
Else
CardFabric.Visibility = Visibility.Visible
Dim FabricError As String = LoadFabricGetError() Dim FabricError As String = LoadFabricGetError()
CardFabric.MainSwap.Visibility = If(FabricError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardFabric.MainSwap.Visibility = If(FabricError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If FabricError IsNot Nothing Then CardFabric.IsSwaped = True If FabricError IsNot Nothing Then CardFabric.IsSwaped = True
@@ -352,7 +361,12 @@
LabFabric.Text = SelectedFabric.Replace("+build", "") LabFabric.Text = SelectedFabric.Replace("+build", "")
LabFabric.Foreground = ColorGray1 LabFabric.Foreground = ColorGray1
End If End If
End If
'FabricApi 'FabricApi
If SelectedFabric Is Nothing Then
CardFabricApi.Visibility = Visibility.Collapsed
Else
CardFabricApi.Visibility = Visibility.Visible
Dim FabricApiError As String = LoadFabricApiGetError() Dim FabricApiError As String = LoadFabricApiGetError()
CardFabricApi.MainSwap.Visibility = If(FabricApiError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardFabricApi.MainSwap.Visibility = If(FabricApiError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If FabricApiError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardFabricApi.IsSwaped = True If FabricApiError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardFabricApi.IsSwaped = True
@@ -368,7 +382,12 @@
LabFabricApi.Text = SelectedFabricApi.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim LabFabricApi.Text = SelectedFabricApi.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Split("+").First.Trim
LabFabricApi.Foreground = ColorGray1 LabFabricApi.Foreground = ColorGray1
End If End If
End If
'OptiFabric 'OptiFabric
If SelectedFabric Is Nothing OrElse SelectedOptiFine Is Nothing Then
CardOptiFabric.Visibility = Visibility.Collapsed
Else
CardOptiFabric.Visibility = Visibility.Visible
Dim OptiFabricError As String = LoadOptiFabricGetError() Dim OptiFabricError As String = LoadOptiFabricGetError()
CardOptiFabric.MainSwap.Visibility = If(OptiFabricError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardOptiFabric.MainSwap.Visibility = If(OptiFabricError Is Nothing, Visibility.Visible, Visibility.Collapsed)
If OptiFabricError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardOptiFabric.IsSwaped = True If OptiFabricError IsNot Nothing OrElse SelectedFabric Is Nothing Then CardOptiFabric.IsSwaped = True
@@ -384,13 +403,24 @@
LabOptiFabric.Text = SelectedOptiFabric.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v") LabOptiFabric.Text = SelectedOptiFabric.DisplayName.ToLower.Replace("optifabric-", "").Replace(".jar", "").Trim.TrimStart("v")
LabOptiFabric.Foreground = ColorGray1 LabOptiFabric.Foreground = ColorGray1
End If End If
End If
'主警告 '主警告
HintFabricAPI.Visibility = If(SelectedFabric IsNot Nothing AndAlso SelectedFabricApi Is Nothing, Visibility.Visible, Visibility.Collapsed) If SelectedFabric IsNot Nothing AndAlso SelectedFabricApi Is Nothing Then
HintFabricAPI.Visibility = Visibility.Visible
Else
HintFabricAPI.Visibility = Visibility.Collapsed
End If
If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then
HintOptiFabric.Visibility = Visibility.Visible HintOptiFabric.Visibility = Visibility.Visible
Else Else
HintOptiFabric.Visibility = Visibility.Collapsed HintOptiFabric.Visibility = Visibility.Collapsed
End If End If
If SelectedMinecraftId.Contains("1.") AndAlso Val(SelectedMinecraftId.Split(".")(1)) >= 16 AndAlso SelectedOptiFine IsNot Nothing AndAlso
(SelectedForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) Then
HintModOptiFine.Visibility = Visibility.Visible
Else
HintModOptiFine.Visibility = Visibility.Collapsed
End If
'结束 '结束
IsReloading = False IsReloading = False
End Sub End Sub
@@ -632,7 +662,7 @@
Return (OptiFine.RequiredForgeVersion.Contains(".") AndAlso 'XX.X.XXX Return (OptiFine.RequiredForgeVersion.Contains(".") AndAlso 'XX.X.XXX
VersionSortInteger(Forge.Version, OptiFine.RequiredForgeVersion) >= 0) OrElse VersionSortInteger(Forge.Version, OptiFine.RequiredForgeVersion) >= 0) OrElse
(Not OptiFine.RequiredForgeVersion.Contains(".") AndAlso '#XXXX (Not OptiFine.RequiredForgeVersion.Contains(".") AndAlso '#XXXX
VersionSortInteger(Forge.Version.Split(".").Last, OptiFine.RequiredForgeVersion) >= 0) Forge.Version.After(".") >= OptiFine.RequiredForgeVersion)
End Function End Function
'限制展开 '限制展开
@@ -909,12 +939,12 @@
If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True
If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False
'直接的判断(例如 1.18.1/22w03a) '直接的判断(例如 1.18.1/22w03a)
For Each Part As String In DisplayName.Split("]")(0).TrimStart("[").Split("/") For Each Part As String In DisplayName.Before("]").TrimStart("[").Split("/")
If Part = MinecraftVersion Then Return True If Part = MinecraftVersion Then Return True
Next Next
'将版本名分割语素(例如 1.16.4/5) '将版本名分割语素(例如 1.16.4/5)
Dim Lefts = RegexSearch(DisplayName.Split("]")(0), "[a-z/]+|[0-9/]+") Dim Lefts = RegexSearch(DisplayName.Before("]"), "[a-z/]+|[0-9/]+")
Dim Rights = RegexSearch(MinecraftVersion.Split("]")(0), "[a-z/]+|[0-9/]+") Dim Rights = RegexSearch(MinecraftVersion.Before("]"), "[a-z/]+|[0-9/]+")
'对每段进行判断 '对每段进行判断
Dim i As Integer = 0 Dim i As Integer = 0
While True While True
@@ -93,7 +93,7 @@ Public Class FormLoginOAuth
If Not IsLoginSuccessed Then RaiseEvent OnLoginCanceled(IsSwitch) If Not IsLoginSuccessed Then RaiseEvent OnLoginCanceled(IsSwitch)
FrmMain.Focus() FrmMain.Focus()
End Sub End Sub
Private Sub HintSwitch_Click(sender As Object, e As EventArgs) Handles HintSwitch.Click Private Sub HintSwitch_Click() Handles HintSwitch.Click
IsSwitch = True IsSwitch = True
Close() Close()
End Sub End Sub
@@ -400,7 +400,7 @@ Finish:
ElseIf Setup.Get("LoginLegacyName") = "" Then ElseIf Setup.Get("LoginLegacyName") = "" Then
Return New EqualableList(Of String) From {0, ""} Return New EqualableList(Of String) From {0, ""}
Else Else
Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.Split("¨")(0), "")} Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.Before("¨"), "")}
End If End If
Case 3 Case 3
Return New EqualableList(Of String) From {3, Setup.Get("LaunchSkinID")} Return New EqualableList(Of String) From {3, Setup.Get("LaunchSkinID")}
@@ -97,6 +97,10 @@ Download:
Log("[Page] 主页预设:每日整合包推荐") Log("[Page] 主页预设:每日整合包推荐")
Url = "https://pclsub.sodamc.com/" Url = "https://pclsub.sodamc.com/"
GoTo Download GoTo Download
Case 5
Log("[Page] 主页预设:Minecraft 皮肤推荐")
Url = "https://forgepixel.com/pcl_sub_file"
GoTo Download
End Select End Select
End Select End Select
RunInUi(Sub() LoadContent(Content)) RunInUi(Sub() LoadContent(Content))
@@ -106,16 +110,17 @@ Download:
'联网获取自定义主页文件 '联网获取自定义主页文件
Private OnlineLoader As New LoaderTask(Of String, Integer)("自定义主页获取", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000} Private OnlineLoader As New LoaderTask(Of String, Integer)("自定义主页获取", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
Private Sub OnlineLoaderSub(Task As LoaderTask(Of String, Integer)) Private Sub OnlineLoaderSub(Task As LoaderTask(Of String, Integer))
Dim Address As String = Task.Input '#3721 中连续触发两次导致内容变化
Try Try
'获取版本校验地址 '获取版本校验地址
Dim VersionAddress As String Dim VersionAddress As String
If Task.Input.Contains(".xaml") Then If Address.Contains(".xaml") Then
VersionAddress = Task.Input.Replace(".xaml", ".xaml.ini") VersionAddress = Address.Replace(".xaml", ".xaml.ini")
Else Else
VersionAddress = Task.Input.Split("?").First VersionAddress = Address.Before("?")
If Not VersionAddress.EndsWith("/") Then VersionAddress += "/" If Not VersionAddress.EndsWith("/") Then VersionAddress += "/"
VersionAddress += "version" VersionAddress += "version"
If Task.Input.Contains("?") Then VersionAddress += Task.Input.Split("?").Last If Address.Contains("?") Then VersionAddress += Address.After("?")
End If End If
'校验版本 '校验版本
Dim Version As String = "" Dim Version As String = ""
@@ -136,9 +141,9 @@ Download:
End Try End Try
'实际下载 '实际下载
If NeedDownload Then If NeedDownload Then
Dim FileContent As String = NetGetCodeByRequestRetry(Task.Input) Dim FileContent As String = NetGetCodeByRequestRetry(Address)
Log($"[Page] 已联网下载自定义主页,内容长度:{FileContent.Length},来源:{Task.Input}") Log($"[Page] 已联网下载自定义主页,内容长度:{FileContent.Length},来源:{Address}")
Setup.Set("CacheSavedPageUrl", Task.Input) Setup.Set("CacheSavedPageUrl", Address)
Setup.Set("CacheSavedPageVersion", Version) Setup.Set("CacheSavedPageVersion", Version)
WriteFile(PathTemp & "Cache\Custom.xaml", FileContent) WriteFile(PathTemp & "Cache\Custom.xaml", FileContent)
End If End If
@@ -146,11 +151,11 @@ Download:
Refresh() Refresh()
Catch ex As Exception Catch ex As Exception
If Setup.Get("CacheSavedPageVersion") = "" Then If Setup.Get("CacheSavedPageVersion") = "" Then
Log(ex, $"联网下载自定义主页失败({Task.Input})", LogLevel.Msgbox) Log(ex, $"联网下载自定义主页失败({Address})", LogLevel.Msgbox)
Else Else
Log(ex, $"联网下载自定义主页失败({Task.Input})") Log(ex, $"联网下载自定义主页失败({Address})")
End If End If
Task.Input = "" Address = ""
End Try End Try
End Sub End Sub
@@ -208,6 +213,7 @@ Download:
GoTo Refresh '防止 SyncLock 死锁 GoTo Refresh '防止 SyncLock 死锁
End If End If
End Try End Try
Log($"[Page] 实例化:加载自定义主页 UI 完成")
End SyncLock End SyncLock
Return Return
Refresh: Refresh:
@@ -17,8 +17,8 @@
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Setup.Get("LoginAuthEmail").ToString.Split("¨") ComboName.ItemsSource = Setup.Get("LoginAuthEmail").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginAuthEmail").ToString.Split("¨")(0) ComboName.Text = Setup.Get("LoginAuthEmail").ToString.Before("¨")
If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.Split("¨")(0).Trim If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.Before("¨").Trim
End If End If
End If End If
IsFirstLoad = False IsFirstLoad = False
@@ -26,7 +26,7 @@ Public Class PageLoginLegacy
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Setup.Get("LoginLegacyName").ToString.Split("¨") ComboName.ItemsSource = Setup.Get("LoginLegacyName").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginLegacyName").ToString.Split("¨")(0).Trim ComboName.Text = Setup.Get("LoginLegacyName").ToString.Before("¨").Trim
End If End If
End If End If
IsReloaded = True IsReloaded = True
@@ -67,7 +67,8 @@
ComboAccounts.IsEnabled = False ComboAccounts.IsEnabled = False
BtnLogin.IsEnabled = False BtnLogin.IsEnabled = False
BtnLogin.Text = "0%" BtnLogin.Text = "0%"
RunInNewThread(Sub() RunInNewThread(
Sub()
Try Try
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True) McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
Do While McLoginMsLoader.State = LoadState.Loading Do While McLoginMsLoader.State = LoadState.Loading
@@ -89,11 +90,14 @@
If ex.Message = "$$" Then If ex.Message = "$$" Then
ElseIf ex.Message.StartsWith("$") Then ElseIf ex.Message.StartsWith("$") Then
Hint(ex.Message.TrimStart("$"), HintType.Critical) Hint(ex.Message.TrimStart("$"), HintType.Critical)
ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.ContainsF("SSL/TLS") Then
Log(ex, "正版登录验证失败,请尝试在 [设置 → 启动器] 中关闭 [验证 SSL 证书] 然后再试。" & vbCrLf & vbCrLf & "原始错误信息:", LogLevel.Msgbox)
Else Else
Log(ex, "微软登录尝试失败", LogLevel.Msgbox) Log(ex, "正版登录尝试失败", LogLevel.Msgbox)
End If End If
Finally Finally
RunInUi(Sub() RunInUi(
Sub()
ComboAccounts.IsEnabled = True ComboAccounts.IsEnabled = True
BtnLogin.IsEnabled = True BtnLogin.IsEnabled = True
BtnLogin.Text = "登录" BtnLogin.Text = "登录"
@@ -17,8 +17,8 @@
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Setup.Get("LoginNideEmail").ToString.Split("¨") ComboName.ItemsSource = Setup.Get("LoginNideEmail").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginNideEmail").ToString.Split("¨")(0) ComboName.Text = Setup.Get("LoginNideEmail").ToString.Before("¨")
If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.Split("¨")(0).Trim If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.Before("¨").Trim
End If End If
End If End If
IsFirstLoad = False IsFirstLoad = False
@@ -295,7 +295,7 @@
For i = 0 To Folders.Count - 1 For i = 0 To Folders.Count - 1
If Folders(i) = "" Then Exit For If Folders(i) = "" Then Exit For
If Folders(i).ToString.EndsWith(Folder.Path) Then If Folders(i).ToString.EndsWith(Folder.Path) Then
Name = Folders(i).ToString.Split(">")(0) Name = Folders(i).ToString.Before(">")
Folders.RemoveAt(i) Folders.RemoveAt(i)
Exit For Exit For
End If End If
@@ -320,7 +320,7 @@
For i = 0 To Folders.Count - 1 For i = 0 To Folders.Count - 1
If Folders(i) = "" Then Exit For If Folders(i) = "" Then Exit For
If Folders(i).ToString.EndsWith(Folder.Path) Then If Folders(i).ToString.EndsWith(Folder.Path) Then
'Name = Folders(i).ToString.Split(">")(0) 'Name = Folders(i).ToString.Before(">")
Folders.RemoveAt(i) Folders.RemoveAt(i)
Exit For Exit For
End If End If
@@ -81,7 +81,7 @@
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏窗口标题" Margin="0,0,25,0" /> <TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏窗口标题" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则不进行更改。&#xa;支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号" HintText="默认" MaxLength="100" /> <local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则不进行更改。&#xa;支持以下替换标记:&#xa; · {user}:玩家名字&#xa; · {login}:玩家的登录方式&#xa; · {name}:游戏版本名&#xa; · {date}、{time}:当前的系统时间&#xa; · {version}:游戏对应的原版版本号" HintText="默认" MaxLength="100" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" /> <TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchArgumentInfo" Text="Plain Craft Launcher 2" Grid.Column="1" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角"> <local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchArgumentInfo" Text="PCL" Grid.Column="1" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角">
<local:MyTextBox.ValidateRules> <local:MyTextBox.ValidateRules>
<local:ValidateExcept> <local:ValidateExcept>
<local:ValidateExcept.Excepts> <local:ValidateExcept.Excepts>
@@ -58,7 +58,7 @@
ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" /> ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" />
<local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="9" Height="22" Grid.ColumnSpan="2" <local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="9" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadCert" Tag="ToolDownloadCert" x:Name="CheckDownloadCert" Tag="ToolDownloadCert"
ToolTip="在进行连接时,检查 SSL 证书是否正常。&#xa;进行验证会提高安全性,但疑似会导致少部分玩家的微软登录失败。" /> ToolTip="验证证书会提高安全性,但疑似有概率导致正版登录失败(#3018)。&#xa;如果在正版登录时因为 [根据验证过程,远程证书无效] 失败,可以尝试关闭此项。" />
</Grid> </Grid>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
@@ -1,4 +1,6 @@
Public Class PageSpeedLeft Imports System.Threading.Tasks
Public Class PageSpeedLeft
Private Const WatcherInterval As Integer = 300 Private Const WatcherInterval As Integer = 300
'初始化 '初始化
@@ -59,8 +61,8 @@
If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub
Try Try
SyncLock LoaderTaskbarLock SyncLock LoaderTaskbarLock
For i = 0 To LoaderTaskbar.Count - 1 For Each Loader In LoaderTaskbar.ToList
TaskRefresh(LoaderTaskbar(i)) TaskRefresh(Loader)
Next Next
End SyncLock End SyncLock
Catch ex As Exception Catch ex As Exception
@@ -110,7 +112,7 @@
#Region "进度不同,更新卡片" #Region "进度不同,更新卡片"
Try Try
If Card.Children.Count < LoaderList.Count * 2 Then If Card.Children.Count < LoaderList.Count * 2 Then
Log("刷新下载管理卡片失败:卡片中仅有 " & Card.Children.Count & " 个子项", LogLevel.Debug) Log($"[Watcher] 刷新下载管理卡片 {Loader.Name} 失败:卡片中仅有 {Card.Children.Count} 个子项,要求至少有 {LoaderList.Count * 2} 个子项", LogLevel.Debug)
Exit Try Exit Try
End If End If
Dim Row As Integer = 0 Dim Row As Integer = 0
@@ -137,7 +139,7 @@
Row += 1 Row += 1
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新下载管理卡片失败", LogLevel.Feedback) Log(ex, $"刷新下载管理卡片 {Loader.Name} 失败", LogLevel.Feedback)
End Try End Try
#End Region #End Region
End Select End Select
@@ -191,10 +193,15 @@
'添加取消按钮 '添加取消按钮
Dim Cancel As New MyIconButton With {.Name = "BtnCancel", .Logo = "F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z", .Height = 20, .Margin = New Thickness(0, 10, 10, 0), .LogoScale = 1.1, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Top} Dim Cancel As New MyIconButton With {.Name = "BtnCancel", .Logo = "F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z", .Height = 20, .Margin = New Thickness(0, 10, 10, 0), .LogoScale = 1.1, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Top}
Card.Children.Add(Cancel) Card.Children.Add(Cancel)
AddHandler Cancel.Click, Sub(sender As MyIconButton, e As EventArgs) AddHandler Cancel.Click,
Sub(sender As MyIconButton, e As EventArgs)
AniDispose(sender, False) AniDispose(sender, False)
AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack()) AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack())
RightCards.Remove(Loader.Name) RightCards.Remove(Loader.Name)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Remove(Loader)
Log($"[Taskbar] 由于下载管理卡片关闭,{Loader.Name} 已移出任务列表")
End SyncLock
Log($"[Watcher] 关闭下载管理卡片:{Loader.Name}") Log($"[Watcher] 关闭下载管理卡片:{Loader.Name}")
RunInThread(Sub() Loader.Abort()) RunInThread(Sub() Loader.Abort())
End Sub End Sub