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

2.12.2

Browse Source
This commit is contained in:
龙腾猫跃
2026-01-15 03:20:43 +08:00
parent 87f5cc2ea9
commit 52b4c87fbc
24 changed files with 530 additions and 2212 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Application.xaml.vb
+7 -3
View File
@@ -145,8 +145,8 @@ WaitRetry:
Setup.Load("ToolDownloadCert") Setup.Load("ToolDownloadCert")
Setup.Load("ToolDownloadSpeed") Setup.Load("ToolDownloadSpeed")
'计时 '计时
Log("[Start] 第一阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms") Log("[Start] 第一阶段加载用时：" & GetTimeMs() - ApplicationStartTick & " ms")
ApplicationStartTick = GetTimeTick() ApplicationStartTick = GetTimeMs()
'执行测试 '执行测试
#If DEBUG Then #If DEBUG Then
Test() Test()
@@ -213,7 +213,11 @@ WaitRetry:
'WebP 特判 'WebP 特判
If Prefix = "Imazen.WebP" Then If Prefix = "Imazen.WebP" Then
SetDllDirectory(PathPure.TrimEnd("\"c)) SetDllDirectory(PathPure.TrimEnd("\"c))
WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64")) Try
WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64"))
Catch ex As Exception
Log(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时，同时写入文件导致文件占用，进而导致崩溃
End Try
End If End If
End If End If
Return LoadedAssembly(Prefix) Return LoadedAssembly(Prefix)
Plain Craft Launcher 2/FormMain.xaml.vb
+20 -5
View File
@@ -11,8 +11,18 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目 '统计更新日志条目
#If BETA Then #If BETA Then
If LastVersion < 379 Then 'Release 2.12.1
If LastVersion >= 376 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "删除：暂时隐藏联机入口……不过只是暂时关闭，它还会回来的！"))
End If
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增：适配新的 Minecraft 版本号系统与 Unobfuscated 版本"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：巨幅优化各个下载页面和 Mod 管理页面的性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化：更换披风时会显示当前使用的披风"))
FeatureCount += 33
BugCount += 29
End If
If LastVersion < 376 Then 'Release 2.11.2 If LastVersion < 376 Then 'Release 2.11.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增：联机功能！")) 'FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增：联机功能！"))
FeatureCount += 32 FeatureCount += 32
BugCount += 21 BugCount += 21
End If End If
@@ -118,6 +128,11 @@ Public Class FormMain
'3：BUG+ IMP* FEAT- '3：BUG+ IMP* FEAT-
'2：BUG* IMP- '2：BUG* IMP-
'1：BUG- '1：BUG-
If LastVersion < 380 Then 'Snapshot 2.12.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法搜索 CurseForge 上的社区资源"))
FeatureCount += 3
BugCount += 13
End If
If LastVersion < 378 Then 'Snapshot 2.12.1 If LastVersion < 378 Then 'Snapshot 2.12.1
If LastVersion >= 377 Then If LastVersion >= 377 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：在版本列表中存在 OptiFine 时可能无法加载版本列表")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：在版本列表中存在 OptiFine 时可能无法加载版本列表"))
@@ -323,7 +338,7 @@ Public Class FormMain
'窗口加载 '窗口加载
Private IsWindowLoadFinished As Boolean = False Private IsWindowLoadFinished As Boolean = False
Public Sub New() Public Sub New()
ApplicationStartTick = GetTimeTick() ApplicationStartTick = GetTimeMs()
'窗体参数初始化 '窗体参数初始化
FrmMain = Me FrmMain = Me
FrmLaunchLeft = New PageLaunchLeft FrmLaunchLeft = New PageLaunchLeft
@@ -387,10 +402,10 @@ Public Class FormMain
'尽早执行的加载池 '尽早执行的加载池
McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行，必须跑一次；为了让启动按钮尽快可用，需要尽早执行；为了与 PageLaunchLeft 联动，需要为 0 而不是 GetUuid McFolderListLoader.Start(0) '为了让下载已存在文件检测可以正常运行，必须跑一次；为了让启动按钮尽快可用，需要尽早执行；为了与 PageLaunchLeft 联动，需要为 0 而不是 GetUuid
Log("[Start] 第二阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms") Log("[Start] 第二阶段加载用时：" & GetTimeMs() - ApplicationStartTick & " ms")
End Sub End Sub
Private Sub FormMain_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub FormMain_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
ApplicationStartTick = GetTimeTick() ApplicationStartTick = GetTimeMs()
Handle = New Interop.WindowInteropHelper(Me).Handle Handle = New Interop.WindowInteropHelper(Me).Handle
'读取设置 '读取设置
Setup.Load("UiBackgroundOpacity") Setup.Load("UiBackgroundOpacity")
@@ -496,7 +511,7 @@ Public Class FormMain
Telemetry("启动") Telemetry("启动")
End Sub, "初始化", ThreadPriority.Lowest) End Sub, "初始化", ThreadPriority.Lowest)
Log("[Start] 第三阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms") Log("[Start] 第三阶段加载用时：" & GetTimeMs() - ApplicationStartTick & " ms")
End Sub End Sub
'根据打开次数触发的事件 '根据打开次数触发的事件
Private Sub RunCountSub() Private Sub RunCountSub()
Plain Craft Launcher 2/Modules/Base/ModAnimation.vb
+5 -5
View File
@@ -743,9 +743,9 @@ Public Module ModAnimation
''' <param name="AniGroup">由 Aa 开头的函数初始化的 AniData 对象集合。</param> ''' <param name="AniGroup">由 Aa 开头的函数初始化的 AniData 对象集合。</param>
''' <param name="Name">动画组的名称。如果重复会直接停止同名动画组。</param> ''' <param name="Name">动画组的名称。如果重复会直接停止同名动画组。</param>
Public Sub AniStart(AniGroup As IList, Optional Name As String = "", Optional RefreshTime As Boolean = False) Public Sub AniStart(AniGroup As IList, Optional Name As String = "", Optional RefreshTime As Boolean = False)
If RefreshTime Then AniLastTick = GetTimeTick() '避免处理动画时已经造成了极大的延迟，导致动画突然结束 If RefreshTime Then AniLastTick = GetTimeMs() '避免处理动画时已经造成了极大的延迟，导致动画突然结束
'添加到正在执行的动画组 '添加到正在执行的动画组
Dim NewEntry As New AniGroupEntry With {.Data = GetFullList(Of AniData)(AniGroup), .StartTick = GetTimeTick()} Dim NewEntry As New AniGroupEntry With {.Data = GetFullList(Of AniData)(AniGroup), .StartTick = GetTimeMs()}
If Name = "" Then If Name = "" Then
Name = NewEntry.Uuid Name = NewEntry.Uuid
Else Else
@@ -788,7 +788,7 @@ Public Module ModAnimation
''' </summary> ''' </summary>
Public Sub AniStart() Public Sub AniStart()
'初始化计时器 '初始化计时器
AniLastTick = GetTimeTick() AniLastTick = GetTimeMs()
AniFPSTimer = AniLastTick AniFPSTimer = AniLastTick
AniRunning = True '标记动画执行开始 AniRunning = True '标记动画执行开始
@@ -798,9 +798,9 @@ Public Module ModAnimation
Log("[Animation] 动画线程开始") Log("[Animation] 动画线程开始")
Do While True Do While True
'两帧之间的间隔时间 '两帧之间的间隔时间
Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000) Dim DeltaTime As Long = MathClamp(GetTimeMs() - AniLastTick, 0, 100000)
If DeltaTime < 3 Then GoTo Sleeper If DeltaTime < 3 Then GoTo Sleeper
AniLastTick = GetTimeTick() AniLastTick = GetTimeMs()
'记录 FPS '记录 FPS
If ModeDebug Then If ModeDebug Then
If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+42 -27
View File
@@ -14,13 +14,13 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.12.1" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.12.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.12.1." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.12.2." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换 Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 372 'Release Public Const VersionCode As Integer = 379 'Release
#Else #Else
Public Const VersionCode As Integer = 378 'Snapshot Public Const VersionCode As Integer = 380 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -62,7 +62,7 @@ Public Module ModBase
''' <summary> ''' <summary>
''' 程序的打开计时。 ''' 程序的打开计时。
''' </summary> ''' </summary>
Public ApplicationStartTick As Long = GetTimeTick() Public ApplicationStartTick As Long = GetTimeMs()
''' <summary> ''' <summary>
''' 程序打开时的时间。 ''' 程序打开时的时间。
''' </summary> ''' </summary>
@@ -1284,27 +1284,31 @@ Re:
''' <summary> ''' <summary>
''' 尝试根据后缀名判断文件种类并解压文件，支持 gz 与 zip，会尝试将 jar 以 zip 方式解压。 ''' 尝试根据后缀名判断文件种类并解压文件，支持 gz 与 zip，会尝试将 jar 以 zip 方式解压。
''' 会尝试创建，但不会清空目标文件夹。 ''' 会尝试创建，但不会清空目标文件夹。
''' 会先使用 UTF-8 解压，失败后换用 GB18030 解压。
''' </summary> ''' </summary>
Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing, Public Sub ExtractCompressedFile(CompressFilePath As String, DestDirectory As String, Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
Directory.CreateDirectory(DestDirectory) Directory.CreateDirectory(DestDirectory)
'解压 gz（gz 不需要考虑编码）
If CompressFilePath.EndsWithF(".gz", True) Then If CompressFilePath.EndsWithF(".gz", True) Then
'以 gz 方式解压 Using stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.Read, FileShare.Read), CompressionMode.Decompress)
Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress) Using decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""),
Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write) FileMode.OpenOrCreate, FileAccess.Write)
Dim data As Integer = stream.ReadByte() Dim data As Integer = stream.ReadByte()
While data <> -1 While data <> -1
decompressedFile.WriteByte(data) decompressedFile.WriteByte(data)
data = stream.ReadByte() data = stream.ReadByte()
End While End While
decompressedFile.Close() End Using
stream.Close() End Using
Else Return
'以 zip 方式解压 End If
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030"))) '解压 zip
Dim TotalCount As Long = Archive.Entries.Count Dim TryExtractZip =
For Each Entry As ZipArchiveEntry In Archive.Entries Sub(Encoding As Encoding)
If ProgressIncrementHandler IsNot Nothing AndAlso TotalCount > 0 Then ProgressIncrementHandler(1 / TotalCount) Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, Encoding)
Dim EntryCount = Archive.Entries.Count
For Each Entry In Archive.Entries
If ProgressIncrementHandler IsNot Nothing AndAlso EntryCount > 0 Then ProgressIncrementHandler(1 / EntryCount)
Dim DestinationFullPath As String = IO.Path.Combine(DestDirectory, Entry.FullName) Dim DestinationFullPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If Not IO.Path.GetFullPath(DestinationFullPath).StartsWithF(IO.Path.GetFullPath(DestDirectory), True) Then Continue For 'ZipSlip 漏洞修复 If Not IO.Path.GetFullPath(DestinationFullPath).StartsWithF(IO.Path.GetFullPath(DestDirectory), True) Then Continue For 'ZipSlip 漏洞修复
If DestinationFullPath.EndsWithF("\") OrElse DestinationFullPath.EndsWithF("/") Then Continue For '不创建空文件夹 If DestinationFullPath.EndsWithF("\") OrElse DestinationFullPath.EndsWithF("/") Then Continue For '不创建空文件夹
@@ -1313,7 +1317,17 @@ Re:
Entry.ExtractToFile(DestinationFullPath.Replace(DestinationDirectory, ShortenPath(DestinationDirectory)), True) '#7329 Entry.ExtractToFile(DestinationFullPath.Replace(DestinationDirectory, ShortenPath(DestinationDirectory)), True) '#7329
Next Next
End Using End Using
End If End Sub
Try
TryExtractZip(Encoding.UTF8)
Catch ex As Exception
Log(ex, $"首次解压尝试失败，将更换编码并重试（{CompressFilePath} → {DestDirectory}）")
Try
TryExtractZip(Encoding.GetEncoding("GB18030"))
Catch
Throw
End Try
End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -1609,6 +1623,7 @@ RetryDir:
End Function End Function
''' <summary> ''' <summary>
''' 分割字符串。 ''' 分割字符串。
''' 若原始字符串为空，则返回 {""}。
''' </summary> ''' </summary>
<Extension> Public Function Split(FullStr As String, SplitStr As String) As String() <Extension> Public Function Split(FullStr As String, SplitStr As String) As String()
If SplitStr.Length = 1 Then If SplitStr.Length = 1 Then
@@ -2297,10 +2312,10 @@ NextElement:
Return Date.Now.ToString("HH':'mm':'ss'.'fff") Return Date.Now.ToString("HH':'mm':'ss'.'fff")
End Function End Function
''' <summary> ''' <summary>
''' 获取系统运行时间（毫秒），保证为正 Long 且大于 1，但可能突变减小。 ''' 获取一个单调递增时间值（毫秒）。
''' </summary> ''' </summary>
Public Function GetTimeTick() As Long Public Function GetTimeMs() As Long
Return My.Computer.Clock.TickCount + 2147483651L Return Stopwatch.GetTimestamp() \ (Stopwatch.Frequency \ 1000L)
End Function End Function
''' <summary> ''' <summary>
''' 将时间间隔转换为类似“5 分 10 秒前”的易于阅读的形式。 ''' 将时间间隔转换为类似“5 分 10 秒前”的易于阅读的形式。
Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+2 -2
View File
@@ -295,7 +295,7 @@
If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束… If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束…
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse (IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse
LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '…且没有超时… LastFinishedTime = 0 OrElse GetTimeMs() - LastFinishedTime < ReloadTimeout) Then '…且没有超时…
Return False '…则不重试 Return False '…则不重试
Else Else
Return True '否则需要重启 Return True '否则需要重启
@@ -328,7 +328,7 @@
If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成") If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
RaisePreviewFinish() RaisePreviewFinish()
State = LoadState.Finished State = LoadState.Finished
LastFinishedTime = GetTimeTick() '未中断，本次输出有效 LastFinishedTime = GetTimeMs() '未中断，本次输出有效
Catch ex As CancelledException Catch ex As CancelledException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断，已完成 {Math.Round(Progress * 100)}%") If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断，已完成 {Math.Round(Progress * 100)}%")
If Not IsAborted Then State = LoadState.Aborted If Not IsAborted Then State = LoadState.Aborted
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+32 -32
View File
@@ -52,7 +52,7 @@ Public Module ModNet
Optional Encoding As Encoding = Nothing, Optional SimulateBrowserHeaders As Boolean = False) As String Optional Encoding As Encoding = Nothing, Optional SimulateBrowserHeaders As Boolean = False) As String
Dim RetryCount As Integer = 0 Dim RetryCount As Integer = 0
Dim RetryException As Exception = Nothing Dim RetryException As Exception = Nothing
Dim StartTime As Long = GetTimeTick() Dim StartTime As Long = GetTimeMs()
Try Try
Retry: Retry:
Select Case RetryCount Select Case RetryCount
@@ -62,7 +62,7 @@ Retry:
Thread.Sleep(500) Thread.Sleep(500)
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 30000, Headers, RequireJson, Encoding, SimulateBrowserHeaders) Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 30000, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
Case Else '快速重试 Case Else '快速重试
If GetTimeTick() - StartTime > 5500 Then If GetTimeMs() - StartTime > 5500 Then
'若前两次加载耗费 5 秒以上，才进行重试 '若前两次加载耗费 5 秒以上，才进行重试
Thread.Sleep(500) Thread.Sleep(500)
Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 4000, Headers, RequireJson, Encoding, SimulateBrowserHeaders) Return NetRequestByClient(Url, Method, Content, ContentType, Accept, 4000, Headers, RequireJson, Encoding, SimulateBrowserHeaders)
@@ -586,7 +586,7 @@ RequestFinished:
''' <summary> ''' <summary>
''' 上次记速时的时间。 ''' 上次记速时的时间。
''' </summary> ''' </summary>
Private SpeedLastTime As Long = GetTimeTick() Private SpeedLastTime As Long = GetTimeMs()
''' <summary> ''' <summary>
''' 上次记速时的已下载大小。 ''' 上次记速时的已下载大小。
''' </summary> ''' </summary>
@@ -596,8 +596,8 @@ RequestFinished:
''' </summary> ''' </summary>
Public ReadOnly Property Speed As Long Public ReadOnly Property Speed As Long
Get Get
If GetTimeTick() - SpeedLastTime > 200 Then If GetTimeMs() - SpeedLastTime > 200 Then
Dim DeltaTime As Long = GetTimeTick() - SpeedLastTime Dim DeltaTime As Long = GetTimeMs() - SpeedLastTime
_Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000) _Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000)
SpeedLastDone = DownloadDone SpeedLastDone = DownloadDone
SpeedLastTime += DeltaTime SpeedLastTime += DeltaTime
@@ -610,7 +610,7 @@ RequestFinished:
''' <summary> ''' <summary>
''' 线程初始化时的时间。 ''' 线程初始化时的时间。
''' </summary> ''' </summary>
Public InitTime As Long = GetTimeTick() Public InitTime As Long = GetTimeMs()
''' <summary> ''' <summary>
''' 上次接受到有效数据的时间，-1 表示尚未有有效数据。 ''' 上次接受到有效数据的时间，-1 表示尚未有有效数据。
''' </summary> ''' </summary>
@@ -773,7 +773,7 @@ RequestFinished:
''' <summary> ''' <summary>
''' 上次记速时的时间。 ''' 上次记速时的时间。
''' </summary> ''' </summary>
Private SpeedLastTime As Long = GetTimeTick() Private SpeedLastTime As Long = GetTimeMs()
''' <summary> ''' <summary>
''' 上次记速时的已下载大小。 ''' 上次记速时的已下载大小。
''' </summary> ''' </summary>
@@ -783,8 +783,8 @@ RequestFinished:
''' </summary> ''' </summary>
Public ReadOnly Property Speed As Long Public ReadOnly Property Speed As Long
Get Get
If GetTimeTick() - SpeedLastTime > 200 Then If GetTimeMs() - SpeedLastTime > 200 Then
Dim DeltaTime As Long = GetTimeTick() - SpeedLastTime Dim DeltaTime As Long = GetTimeMs() - SpeedLastTime
_Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000) _Speed = (DownloadDone - SpeedLastDone) / (DeltaTime / 1000)
SpeedLastDone = DownloadDone SpeedLastDone = DownloadDone
SpeedLastTime += DeltaTime SpeedLastTime += DeltaTime
@@ -1079,7 +1079,7 @@ NotSupportRange:
SyncLock NetTaskSpeedLimitLeftLock SyncLock NetTaskSpeedLimitLeftLock
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
End SyncLock End SyncLock
Dim DeltaTime = GetTimeTick() - Th.LastReceiveTime Dim DeltaTime = GetTimeMs() - Th.LastReceiveTime
If DeltaTime > 1000000 Then DeltaTime = 1 '避免时间刻反转导致出现极大值 If DeltaTime > 1000000 Then DeltaTime = 1 '避免时间刻反转导致出现极大值
If RealDataCount > 0 Then If RealDataCount > 0 Then
'有数据 '有数据
@@ -1091,7 +1091,7 @@ NotSupportRange:
End SyncLock End SyncLock
SyncLock LockCount SyncLock LockCount
ConnectCount += 1 ConnectCount += 1
ConnectTime += GetTimeTick() - Th.InitTime ConnectTime += GetTimeMs() - Th.InitTime
End SyncLock End SyncLock
End If End If
SyncLock LockCount SyncLock LockCount
@@ -1113,7 +1113,7 @@ NotSupportRange:
Th.Source.SingleThread Is Nothing Then '且并非单线程下载 Th.Source.SingleThread Is Nothing Then '且并非单线程下载
Throw New TimeoutException("由于速度过慢断开链接，下载 " & RealDataCount & " B，消耗 " & DeltaTime & " ms。") Throw New TimeoutException("由于速度过慢断开链接，下载 " & RealDataCount & " B，消耗 " & DeltaTime & " ms。")
End If End If
Th.LastReceiveTime = GetTimeTick() Th.LastReceiveTime = GetTimeMs()
ElseIf Th.LastReceiveTime > 0 AndAlso DeltaTime > Timeout Then ElseIf Th.LastReceiveTime > 0 AndAlso DeltaTime > Timeout Then
'无数据，且已超时 '无数据，且已超时
Throw New TimeoutException("操作超时，无数据。") Throw New TimeoutException("操作超时，无数据。")
@@ -1346,6 +1346,7 @@ Retry:
If State >= NetState.Finished Then Return If State >= NetState.Finished Then Return
If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx) If RaiseEx IsNot Nothing Then Ex.Add(RaiseEx)
'凉凉 '凉凉
Log($"[Download] {LocalName}：已失败，当前状态 {State}")
State = NetState.Interrupted State = NetState.Interrupted
End SyncLock End SyncLock
AbortInternal() AbortInternal()
@@ -1363,6 +1364,7 @@ Retry:
'确认中断 '确认中断
SyncLock LockState SyncLock LockState
If State >= NetState.Finished Then Return If State >= NetState.Finished Then Return
Log($"[Download] {LocalName}：已中断，当前状态 {State}")
State = NetState.Interrupted State = NetState.Interrupted
End SyncLock End SyncLock
AbortInternal() AbortInternal()
@@ -1373,7 +1375,6 @@ Retry:
SyncLock NetManager.LockRemain SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1 NetManager.FileRemain -= 1
End SyncLock End SyncLock
Log($"[Download] {LocalName}：已终止，当前状态 {State}")
End Sub End Sub
'状态改变接口 '状态改变接口
@@ -1584,14 +1585,8 @@ FinishExCatch:
For Each File As NetFile In Files For Each File As NetFile In Files
Dim Target As String = CheckExistingFile(FolderList, VersionFolders, File) Dim Target As String = CheckExistingFile(FolderList, VersionFolders, File)
If File.State >= NetState.WaitingToDownload Then Return '中断 If File.State >= NetState.WaitingToDownload Then Return '中断
If Target Is Nothing Then '已找到相同文件
'未找到相同文件 If Target IsNot Nothing Then
SyncLock LockState
File.State = NetState.WaitingToDownload
File.IsCopy = False
End SyncLock
Else
'已找到相同文件
File.IsCopy = True File.IsCopy = True
Dim RetryCount As Integer = 0 Dim RetryCount As Integer = 0
Retry: Retry:
@@ -1601,20 +1596,21 @@ Retry:
CopyFile(Target, File.LocalPath) CopyFile(Target, File.LocalPath)
End If End If
File.Finish(False) File.Finish(False)
Continue For
Catch ex As Exception Catch ex As Exception
RetryCount += 1 RetryCount += 1
Log(ex, $"复制已存在的文件失败，第 {RetryCount} 次重试（{Target} → {File.LocalPath}）") Log(ex, $"复制已存在的文件失败，第 {RetryCount} 次重试（{Target} → {File.LocalPath}）")
If RetryCount < 3 Then If RetryCount < 3 Then
Thread.Sleep(200) Thread.Sleep(2000)
GoTo Retry GoTo Retry
End If End If
'失败，回退到下载
SyncLock LockState
File.State = NetState.WaitingToDownload
File.IsCopy = False
End SyncLock
End Try End Try
End If End If
'回退到下载
SyncLock LockState
File.State = NetState.WaitingToDownload
File.IsCopy = False
End SyncLock
Next Next
Catch ex As Exception Catch ex As Exception
OnFail(New List(Of Exception) From {New Exception("下载已存在文件查找失败", ex)}) OnFail(New List(Of Exception) From {New Exception("下载已存在文件查找失败", ex)})
@@ -1639,6 +1635,7 @@ Retry:
End If End If
Dim Type = TypeIndexes.MaxOf(Function(kv) kv.Item2).FolderName.TrimStart("\"c) Dim Type = TypeIndexes.MaxOf(Function(kv) kv.Item2).FolderName.TrimStart("\"c)
'根据类别进行查找 '根据类别进行查找
Static Sizes As New SafeDictionary(Of String, Long)
Select Case Type Select Case Type
Case "assets\", "libraries\" Case "assets\", "libraries\"
'assets/libraries：查找 MC 文件夹下的相同路径 'assets/libraries：查找 MC 文件夹下的相同路径
@@ -1651,6 +1648,10 @@ Retry:
For Each VersionFolder In VersionFolders For Each VersionFolder In VersionFolders
For Each Candidate In Directory.GetFiles(VersionFolder, For Each Candidate In Directory.GetFiles(VersionFolder,
"*." & GetFileNameFromPath(File.LocalPath).AfterLast(".").ToLower, SearchOption.TopDirectoryOnly) "*." & GetFileNameFromPath(File.LocalPath).AfterLast(".").ToLower, SearchOption.TopDirectoryOnly)
'快速进行大小校验
If Not Sizes.ContainsKey(Candidate) Then Sizes(Candidate) = New FileInfo(Candidate).Length
If File.Check.ActualSize <> Sizes(Candidate) Then Continue For
'Hash 校验
If File.Check.Check(Candidate) Is Nothing Then Return Candidate If File.Check.Check(Candidate) Is Nothing Then Return Candidate
Next Next
Next Next
@@ -1662,7 +1663,6 @@ Retry:
If Not Directory.Exists(TargetFolder) Then Continue For If Not Directory.Exists(TargetFolder) Then Continue For
For Each Candidate In Directory.GetFiles(TargetFolder) For Each Candidate In Directory.GetFiles(TargetFolder)
'快速进行大小校验 '快速进行大小校验
Static Sizes As New SafeDictionary(Of String, Long)
If Not Sizes.ContainsKey(Candidate) Then Sizes(Candidate) = New FileInfo(Candidate).Length If Not Sizes.ContainsKey(Candidate) Then Sizes(Candidate) = New FileInfo(Candidate).Length
If File.Check.ActualSize <> Sizes(Candidate) Then Continue For If File.Check.ActualSize <> Sizes(Candidate) Then Continue For
'Hash 校验 'Hash 校验
@@ -1803,7 +1803,7 @@ Retry:
''' </summary> ''' </summary>
Private Sub RefreshStat() Private Sub RefreshStat()
Try Try
Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast Dim DeltaTime As Long = GetTimeMs() - RefreshStatLast
If DeltaTime = 0 Then Return If DeltaTime = 0 Then Return
RefreshStatLast += DeltaTime RefreshStatLast += DeltaTime
#Region "刷新整体速度" #Region "刷新整体速度"
@@ -1905,7 +1905,7 @@ Retry:
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
Dim NextTick As Long = GetTimeTick() Dim NextTick As Long = GetTimeMs()
While True While True
'增加限速余量 '增加限速余量
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 10 If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft = NetTaskSpeedLimitHigh / 10
@@ -1913,11 +1913,11 @@ Retry:
RefreshStat() RefreshStat()
'等待 100 ms '等待 100 ms
NextTick += 100 NextTick += 100
Dim SleepTime = NextTick - GetTimeTick() Dim SleepTime = NextTick - GetTimeMs()
If SleepTime > 0 Then If SleepTime > 0 Then
Thread.Sleep(SleepTime) Thread.Sleep(SleepTime)
Else Else
NextTick = GetTimeTick() '超时，直接追帧，不等待 NextTick = GetTimeMs() '超时，直接追帧，不等待
End If End If
End While End While
Catch ex As Exception Catch ex As Exception
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
+1 -1
View File
@@ -72,7 +72,7 @@ Public Class MyBitmap
End If End If
Else Else
'使用这种自己接管 FileStream 的方法加载才能解除文件占用 '使用这种自己接管 FileStream 的方法加载才能解除文件占用
Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open) Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open, FileAccess.Read, FileShare.Read)
'判断是否为 WebP 文件头 '判断是否为 WebP 文件头
Dim Header(1) As Byte Dim Header(1) As Byte
InputStream.Read(Header, 0, 2) InputStream.Read(Header, 0, 2)
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+11 -3
View File
@@ -48,9 +48,9 @@
#Region "CompDatabase | Mod 数据库" #Region "CompDatabase | Mod 数据库"
Private _CompDatabase As List(Of CompDatabaseEntry) = Nothing
Private ReadOnly Property CompDatabase As List(Of CompDatabaseEntry) Private ReadOnly Property CompDatabase As List(Of CompDatabaseEntry)
Get Get
Static _CompDatabase As List(Of CompDatabaseEntry) = Nothing
If _CompDatabase IsNot Nothing Then Return _CompDatabase If _CompDatabase IsNot Nothing Then Return _CompDatabase
'初始化数据库 '初始化数据库
_CompDatabase = New List(Of CompDatabaseEntry) _CompDatabase = New List(Of CompDatabaseEntry)
@@ -881,7 +881,7 @@ NoSubtitle:
Case CompType.ResourcePack Case CompType.ResourcePack
Address += "&classId=12" Address += "&classId=12"
End Select End Select
Address += "&categoryId=" & If(Tag = "", "0", Tag.BeforeFirst("/")) If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/")
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)
@@ -1355,6 +1355,10 @@ Retry:
''' </summary> ''' </summary>
Public ReadOnly Hash As String = Nothing Public ReadOnly Hash As String = Nothing
''' <summary> ''' <summary>
''' 文件大小。不可用时为 -1。
''' </summary>
Public ReadOnly Size As Integer = -1
''' <summary>
''' 该文件的所有依赖工程的原始 ID。 ''' 该文件的所有依赖工程的原始 ID。
''' 这些 ID 可能没有加载，在加载后会添加到 Dependencies 中（主要是因为 Modrinth 返回的是字符串 ID 而非 Slug，导致 Project.Id 查询不到）。 ''' 这些 ID 可能没有加载，在加载后会添加到 Dependencies 中（主要是因为 Modrinth 返回的是字符串 ID 而非 Slug，导致 Project.Id 查询不到）。
''' </summary> ''' </summary>
@@ -1368,7 +1372,7 @@ Retry:
''' </summary> ''' </summary>
''' <param name="LocalAddress">目标本地文件夹，或完整的文件路径。会自动判断类型。</param> ''' <param name="LocalAddress">目标本地文件夹，或完整的文件路径。会自动判断类型。</param>
Public Function ToNetFile(LocalAddress As String) As NetFile Public Function ToNetFile(LocalAddress As String) As NetFile
Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), SimulateBrowserHeaders:=True) Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash, ActualSize:=Size), SimulateBrowserHeaders:=True)
End Function End Function
'实例化 '实例化
@@ -1390,6 +1394,7 @@ Retry:
If Data.ContainsKey("FileName") Then FileName = Data("FileName").ToString If Data.ContainsKey("FileName") Then FileName = Data("FileName").ToString
If Data.ContainsKey("DownloadUrls") Then DownloadUrls = Data("DownloadUrls").ToObject(Of List(Of String)) If Data.ContainsKey("DownloadUrls") Then DownloadUrls = Data("DownloadUrls").ToObject(Of List(Of String))
If Data.ContainsKey("ModLoaders") Then ModLoaders = Data("ModLoaders").ToObject(Of List(Of CompModLoaderType)) If Data.ContainsKey("ModLoaders") Then ModLoaders = Data("ModLoaders").ToObject(Of List(Of CompModLoaderType))
If Data.ContainsKey("Size") Then Size = Data("Size").ToObject(Of Integer)
If Data.ContainsKey("Hash") Then Hash = Data("Hash").ToString If Data.ContainsKey("Hash") Then Hash = Data("Hash").ToString
If Data.ContainsKey("GameVersions") Then GameVersions = Data("GameVersions").ToObject(Of List(Of String)) If Data.ContainsKey("GameVersions") Then GameVersions = Data("GameVersions").ToObject(Of List(Of String))
If Data.ContainsKey("RawDependencies") Then RawDependencies = Data("RawDependencies").ToObject(Of List(Of String)) If Data.ContainsKey("RawDependencies") Then RawDependencies = Data("RawDependencies").ToObject(Of List(Of String))
@@ -1407,6 +1412,7 @@ Retry:
Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus) Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
DownloadCount = Data("downloadCount") DownloadCount = Data("downloadCount")
FileName = Data("fileName") FileName = Data("fileName")
Size = Data("fileLength")
Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 1)?("value") Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 1)?("value")
If Hash Is Nothing Then Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value") If Hash Is Nothing Then Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
'DownloadAddress 'DownloadAddress
@@ -1453,6 +1459,7 @@ Retry:
Dim File As JToken = Data("files")(0) Dim File As JToken = Data("files")(0)
FileName = File("filename") FileName = File("filename")
DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源 DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
Size = File("size")
Hash = File("hashes")("sha1") Hash = File("hashes")("sha1")
End If End If
'ModLoaders 'ModLoaders
@@ -1531,6 +1538,7 @@ Retry:
If FileName IsNot Nothing Then Json.Add("FileName", FileName) If FileName IsNot Nothing Then Json.Add("FileName", FileName)
If DownloadUrls IsNot Nothing Then Json.Add("DownloadUrls", New JArray(DownloadUrls)) If DownloadUrls IsNot Nothing Then Json.Add("DownloadUrls", New JArray(DownloadUrls))
If Hash IsNot Nothing Then Json.Add("Hash", Hash) If Hash IsNot Nothing Then Json.Add("Hash", Hash)
If Size >= 0 Then Json.Add("Size", Size)
Json.Add("RawDependencies", New JArray(RawDependencies)) Json.Add("RawDependencies", New JArray(RawDependencies))
Json.Add("Dependencies", New JArray(Dependencies)) Json.Add("Dependencies", New JArray(Dependencies))
Return Json Return Json
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+6 -6
View File
@@ -98,7 +98,7 @@
Try Try
Dim Info As New FileInfo(FilePath) Dim Info As New FileInfo(FilePath)
If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then
ExtractFile(FilePath, TempFolder & "Temp\") ExtractCompressedFile(FilePath, TempFolder & "Temp\")
Log("[Crash] 已解压导入的日志文件：" & FilePath) Log("[Crash] 已解压导入的日志文件：" & FilePath)
GoTo Extracted GoTo Extracted
End If End If
@@ -712,11 +712,11 @@ NextStack:
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", "mcp", 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", "impl", "data", "pool", "task", "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "fake", "oshi", "impl", "data", "pool", "task",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", "lwjgl", "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", "lwjgl", "fakes",
"gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events", "gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "script", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service", "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service", "scripts", "network",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge", "fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge", "external",
"injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft", "injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft",
"transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill", "concurrent" "transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill", "concurrent"
}.Contains(Word.ToLower) Then Continue For }.Contains(Word.ToLower) Then Continue For
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+3 -3
View File
@@ -222,14 +222,14 @@
''' </summary> ''' </summary>
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain) Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult)) Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim StartTime As Long = GetTimeTick() Dim StartTime As Long = GetTimeMs()
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True)) Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
Try Try
Dim Versions As JArray = Json("versions") Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）") If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
'确定官方源是否可用 '确定官方源是否可用
If Not DlPreferMojang Then If Not DlPreferMojang Then
Dim DeltaTime = GetTimeTick() - StartTime Dim DeltaTime = GetTimeMs() - StartTime
DlPreferMojang = DeltaTime < 4000 DlPreferMojang = DeltaTime < 4000
Log($"[Download] Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}") Log($"[Download] Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
End If End If
@@ -844,7 +844,7 @@
Public Sub New(ApiName As String) Public Sub New(ApiName As String)
IsNeoForge = True IsNeoForge = True
Me.ApiName = ApiName Me.ApiName = ApiName
IsBeta = ApiName.Contains("beta") OrElse ApiName.Contains("alpha") IsBeta = ApiName.ContainsF("beta", True) OrElse ApiName.ContainsF("alpha", True)
If ApiName.Contains("1.20.1") Then '1.20.1-47.1.99 If ApiName.Contains("1.20.1") Then '1.20.1-47.1.99
VersionName = ApiName.Replace("1.20.1-", "") VersionName = ApiName.Replace("1.20.1-", "")
Version = New Version("19." & VersionName) Version = New Version("19." & VersionName)
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+4 -3
View File
@@ -465,9 +465,10 @@ 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.MajorVersion <> Right.MajorVersion Then If Left.MajorVersion <> Right.MajorVersion Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23... ' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18} Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17} '更高的版本指定为 20，且越低越好
Return Weight.ElementAtOrDefault(Left.MajorVersion) >= Weight.ElementAtOrDefault(Right.MajorVersion) Return If(Left.MajorVersion > 20, 20 - Left.MajorVersion * 0.0001, Weight.ElementAtOrDefault(Left.MajorVersion)) >=
If(Right.MajorVersion > 20, 20 - Right.MajorVersion * 0.0001, Weight.ElementAtOrDefault(Right.MajorVersion))
End If End If
'5. 最次级版本号更接近 51 '5. 最次级版本号更接近 51
Return Math.Abs(Left.Version.Revision - 51) <= Math.Abs(Right.Version.Revision - 51) Return Math.Abs(Left.Version.Revision - 51) <= Math.Abs(Right.Version.Revision - 51)
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+3 -3
View File
@@ -544,7 +544,7 @@ NextInner:
'检查是否已经登录完成 '检查是否已经登录完成
If Not Data.IsForceRestarting AndAlso '不要求强行重启 If Not Data.IsForceRestarting AndAlso '不要求强行重启
Input.AccessToken <> "" AndAlso '已经登录过了 Input.AccessToken <> "" AndAlso '已经登录过了
(McLoginMsRefreshTime > 0 AndAlso GetTimeTick() - McLoginMsRefreshTime < 1000 * 60 * 10) Then '完成时间在 10 分钟内 (McLoginMsRefreshTime > 0 AndAlso GetTimeMs() - McLoginMsRefreshTime < 1000 * 60 * 10) Then '完成时间在 10 分钟内
Data.Output = New McLoginResult With Data.Output = New McLoginResult With
{.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid, .ProfileJson = Input.ProfileJson} {.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid, .ProfileJson = Input.ProfileJson}
GoTo SkipLogin GoTo SkipLogin
@@ -591,7 +591,7 @@ Relogin:
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None)) Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
Data.Output = New McLoginResult With {.AccessToken = AccessToken, .Name = Result(1), .Uuid = Result(0), .Type = "Microsoft", .ClientToken = Result(0), .ProfileJson = Result(2)} Data.Output = New McLoginResult With {.AccessToken = AccessToken, .Name = Result(1), .Uuid = Result(0), .Type = "Microsoft", .ClientToken = Result(0), .ProfileJson = Result(2)}
'结束 '结束
McLoginMsRefreshTime = GetTimeTick() McLoginMsRefreshTime = GetTimeMs()
McLaunchLog("微软登录完成") McLaunchLog("微软登录完成")
SkipLogin: SkipLogin:
Setup.Set("HintBuy", True) '关闭正版购买提示 Setup.Set("HintBuy", True) '关闭正版购买提示
@@ -1771,7 +1771,7 @@ NextInstance:
If Not Native.IsNatives Then Continue For If Not Native.IsNatives Then Continue For
Dim Zip As ZipArchive Dim Zip As ZipArchive
Try Try
Zip = New ZipArchive(New FileStream(Native.LocalPath, FileMode.Open)) Zip = New ZipArchive(New FileStream(Native.LocalPath, FileMode.Open, FileAccess.Read, FileShare.Read))
Catch ex As InvalidDataException Catch ex As InvalidDataException
Log(ex, "打开 Natives 文件失败（" & Native.LocalPath & "）") Log(ex, "打开 Natives 文件失败（" & Native.LocalPath & "）")
File.Delete(Native.LocalPath) File.Delete(Native.LocalPath)
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+1 -1
View File
@@ -426,8 +426,8 @@ Public Module ModMinecraft
End Try End Try
#End Region #End Region
VersionSearchFinish: VersionSearchFinish:
_Version.VanillaName = _Version.VanillaName.Replace("_unobfuscated", "").Replace(" Unobfuscated", "")
'获取版本号 '获取版本号
_Version.VanillaName = _Version.VanillaName.Replace("_unobfuscated", "").Replace(" Unobfuscated", "")
If _Version.VanillaName.StartsWithF("1.") Then If _Version.VanillaName.StartsWithF("1.") Then
Dim Segments = _Version.VanillaName.Split(" _-.".ToCharArray) Dim Segments = _Version.VanillaName.Split(" _-.".ToCharArray)
_Version.Vanilla = New Version( _Version.Vanilla = New Version(
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
+5 -8
View File
@@ -1,7 +1,7 @@
Imports System.IO.Compression Imports System.IO.Compression
Public Module ModMod Public Module ModMod
Private Const LocalModCacheVersion As Integer = 10 Private Const LocalModCacheVersion As Integer = 11
Public Class McMod Public Class McMod
@@ -137,7 +137,7 @@ Public Module ModMod
'基础可用性检查、打开 Jar 文件 '基础可用性检查、打开 Jar 文件
If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径（" & If(Path, "null") & "）") If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径（" & If(Path, "null") & "）")
If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件（" & Path & "）") If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件（" & Path & "）")
Jar = New ZipArchive(New FileStream(Path, FileMode.Open)) Jar = New ZipArchive(New FileStream(Path, FileMode.Open, FileAccess.Read, FileShare.Read))
'信息获取 '信息获取
LoadMetadataFromJar(Jar) LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException Catch ex As UnauthorizedAccessException
@@ -424,7 +424,7 @@ Finished:
''' </summary> ''' </summary>
Public ReadOnly Property CanUpdate As Boolean Public ReadOnly Property CanUpdate As Boolean
Get Get
Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso Not Setup.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso ChangelogUrls.Any() Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso Not Setup.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
End Get End Get
End Property End Property
@@ -604,7 +604,7 @@ Finished:
For Each ModFile As FileInfo In ModFileList For Each ModFile As FileInfo In ModFileList
If Loader.IsAborted Then Return If Loader.IsAborted Then Return
Dim ModEntry As New McMod(ModFile.FullName) Dim ModEntry As New McMod(ModFile.FullName)
Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName) Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName) '存在两个文件，名称相同，但一个启用一个禁用
If DumpMod IsNot Nothing Then If DumpMod IsNot Nothing Then
Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry) Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry)
Log($"[Mod] 重复的 Mod 文件：{DumpMod.FileName} 与 {ModEntry.FileName}，已忽略 {DisabledMod.FileName}", LogLevel.Debug) Log($"[Mod] 重复的 Mod 文件：{DumpMod.FileName} 与 {ModEntry.FileName}，已忽略 {DisabledMod.FileName}", LogLevel.Debug)
@@ -619,10 +619,7 @@ Finished:
Log($"[Mod] 共发现 {ModList.Count} 个 Mod") Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
'排序 '排序
ModList = ModList.SortByComparison( ModList = ModList.OrderBy(Function(m) m.FileName).ToList
Function(Left, Right) As Boolean
Return Not Right.FileName.CompareTo(Left.FileName)
End Function)
'回设 '回设
If Loader.IsAborted Then Return If Loader.IsAborted Then Return
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+1 -6
View File
@@ -112,19 +112,14 @@ Public Module ModModpack
Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, ProgressIncrement As Double) Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, ProgressIncrement As Double)
'解压文件 '解压文件
Dim RetryCount As Integer = 1 Dim RetryCount As Integer = 1
Dim Encode = Encoding.GetEncoding("GB18030")
Dim InitialProgress = Loader.Progress Dim InitialProgress = Loader.Progress
Try Try
Retry: Retry:
Loader.Progress = InitialProgress Loader.Progress = InitialProgress
DeleteDirectory(InstallTemp) DeleteDirectory(InstallTemp)
ExtractFile(FileAddress, InstallTemp, Encode, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * ProgressIncrement) ExtractCompressedFile(FileAddress, InstallTemp, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * ProgressIncrement)
Catch ex As Exception Catch ex As Exception
Log(ex, "第 " & RetryCount & " 次解压尝试失败") Log(ex, "第 " & RetryCount & " 次解压尝试失败")
If TypeOf ex Is ArgumentException Then
Encode = Encoding.UTF8
Log("[ModPack] 已切换压缩包解压编码为 UTF8")
End If
'完全不知道为啥会出现文件正在被另一进程使用的问题，总之加个重试 '完全不知道为啥会出现文件正在被另一进程使用的问题，总之加个重试
If RetryCount < 5 Then If RetryCount < 5 Then
Thread.Sleep(RetryCount * 2000) Thread.Sleep(RetryCount * 2000)
Plain Craft Launcher 2/Modules/ModMain.vb
+1 -1
View File
@@ -647,7 +647,7 @@ NextFile:
DeleteDirectory(PathTemp & "Help") DeleteDirectory(PathTemp & "Help")
Directory.CreateDirectory(PathTemp & "Help") Directory.CreateDirectory(PathTemp & "Help")
WriteFile(PathTemp & "Cache\Help.zip", GetResources("Help")) WriteFile(PathTemp & "Cache\Help.zip", GetResources("Help"))
ExtractFile(PathTemp & "Cache\Help.zip", PathTemp & "Help", Encoding.UTF8) ExtractCompressedFile(PathTemp & "Cache\Help.zip", PathTemp & "Help")
Setup.Set("SystemHelpVersion", VersionCode) Setup.Set("SystemHelpVersion", VersionCode)
Log("[Help] 已解压内置帮助文件，目前状态：" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug) Log("[Help] 已解压内置帮助文件，目前状态：" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug)
End If End If
Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+2 -2
View File
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.12.1.0")> <Assembly: AssemblyVersion("2.12.2.0")>
<Assembly: AssemblyFileVersion("2.12.1.0")> <Assembly: AssemblyFileVersion("2.12.2.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+4 -4
View File
@@ -1329,7 +1329,7 @@ Retry:
Dim Installer As ZipArchive = Nothing Dim Installer As ZipArchive = Nothing
Try Try
'解压并获取、合并两个 Json 的信息 '解压并获取、合并两个 Json 的信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Task.Progress = 0.2 Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open)) Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open))
@@ -1417,7 +1417,7 @@ Retry:
'记录当前文件夹列表（在新建目标文件夹之前） '记录当前文件夹列表（在新建目标文件夹之前）
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(i) i.FullName).ToList() Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(i) i.FullName).ToList()
'解压并获取信息 '解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
'新建目标版本文件夹 '新建目标版本文件夹
Directory.CreateDirectory(VersionFolder) Directory.CreateDirectory(VersionFolder)
@@ -1484,7 +1484,7 @@ Retry:
Dim Installer As ZipArchive = Nothing Dim Installer As ZipArchive = Nothing
Try Try
'解压并获取信息 '解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Task.Progress = 0.2 Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Task.Progress = 0.4 Task.Progress = 0.4
@@ -1501,7 +1501,7 @@ Retry:
Task.Progress = 0.6 Task.Progress = 0.6
'解压支持库文件 '解压支持库文件
Installer.Dispose() Installer.Dispose()
ExtractFile(InstallerAddress, InstallerAddress & "_unrar\") ExtractCompressedFile(InstallerAddress, InstallerAddress & "_unrar\")
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\") CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DeleteDirectory(InstallerAddress & "_unrar\") DeleteDirectory(InstallerAddress & "_unrar\")
Else Else
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceExport.xaml
+9 -1
View File
@@ -94,7 +94,7 @@
<local:ExportOption <local:ExportOption
Title="整合包重要数据" Title="整合包重要数据"
Description="脚本文件、内置资源包、数据包等" Description="脚本文件、内置资源包、数据包等"
Rules="addons/|multiblocked/|modpack-update-checker/|global_packs/|global_resource_packs/|global_data_packs/|optional_data_packs/|maps/|icon.png|mods-resourcepacks/|matmos/|resource_assorts/|resource_assorts.json|patchouli_books/|datapacks/|kubejs*/|!kubejs*/probe/|!kubejs*/exported/|!kubejs*/jsconfig.json|!kubejs*/README.txt|openloader/|worldshape/|resources/|scripts/|structures/|fontfiles/|oresources/|packmenu/|craftpresence/|pointblanks/|template*/|!template*/playerdata/|!template*/stats/" Rules="addons/|multiblocked/|modpack-update-checker/|global_packs/|global_resource_packs/|global_data_packs/|optional_data_packs/|moonlight-global-datapacks/|maps/|icon.png|mods-resourcepacks/|matmos/|resource_assorts/|resource_assorts.json|patchouli_books/|datapacks/|kubejs*/|!kubejs*/probe/|!kubejs*/exported/|!kubejs*/jsconfig.json|!kubejs*/README.txt|openloader/|worldshape/|resources/|scripts/|structures/|fontfiles/|oresources/|packmenu/|craftpresence/|pointblanks/|template*/|!template*/playerdata/|!template*/stats/"
DefaultChecked="True" /> DefaultChecked="True" />
</local:MyCheckBox.Tag> </local:MyCheckBox.Tag>
</local:MyCheckBox> </local:MyCheckBox>
@@ -114,6 +114,14 @@
DefaultChecked="True" /> DefaultChecked="True" />
</local:MyCheckBox.Tag> </local:MyCheckBox.Tag>
</local:MyCheckBox> </local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="已上传的沉浸画"
Rules="immersive_paintings/"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox> <local:MyCheckBox>
<local:MyCheckBox.Tag> <local:MyCheckBox.Tag>
<local:ExportOption <local:ExportOption
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceExport.xaml.vb
+1 -1
View File
@@ -424,7 +424,7 @@ Public Class PageInstanceExport
End If End If
If PackPath Is Nothing Then If PackPath Is Nothing Then
Dim Extensions As New List(Of String) Dim Extensions As New List(Of String)
If Not CheckAdvancedModrinth.Checked Then Extensions.Add("压缩文件(*.zip)|*.zip") Extensions.Add("压缩文件(*.zip)|*.zip")
If Not CheckOptionsPcl.Checked Then Extensions.Add("Modrinth 整合包文件(*.mrpack)|*.mrpack") If Not CheckOptionsPcl.Checked Then Extensions.Add("Modrinth 整合包文件(*.mrpack)|*.mrpack")
PackPath = SelectSaveFile("选择导出位置", PackPath = SelectSaveFile("选择导出位置",
PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), Extensions.Join("|")) PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), Extensions.Join("|"))
Plain Craft Launcher 2/Pages/PageInstance/PageInstanceMod.xaml.vb
+16 -11
View File
@@ -71,7 +71,7 @@
''' <summary> ''' <summary>
''' 已加载的 Mod UI 缓存，不确保按显示顺序排列。Key 为 Mod 的 RawFileName。 ''' 已加载的 Mod UI 缓存，不确保按显示顺序排列。Key 为 Mod 的 RawFileName。
''' </summary> ''' </summary>
Public ModItems As New Dictionary(Of String, MyLocalModItem) Public ModItems As New SafeDictionary(Of String, MyLocalModItem)
''' <summary> ''' <summary>
''' 将加载器结果的 Mod 列表加载为 UI。 ''' 将加载器结果的 Mod 列表加载为 UI。
''' </summary> ''' </summary>
@@ -87,10 +87,12 @@
Return Return
End If End If
'修改缓存 '修改缓存
ModItems.Clear() SyncLock ModItems.SyncRoot
For Each ModEntity As McMod In McModLoader.Output ModItems.Clear()
ModItems(ModEntity.RawFileName) = McModListItem(ModEntity) For Each ModEntity As McMod In McModLoader.Output
Next ModItems(ModEntity.RawFileName) = McModListItem(ModEntity)
Next
End SyncLock
'显示结果 '显示结果
Filter = FilterType.All Filter = FilterType.All
SearchBox.Text = "" '这会触发结果刷新，所以需要在 ModItems 更新之后，详见 #3124 的视频 SearchBox.Text = "" '这会触发结果刷新，所以需要在 ModItems 更新之后，详见 #3124 的视频
@@ -151,11 +153,13 @@
If ShowingMods.Any() Then If ShowingMods.Any() Then
PanList.Visibility = Visibility.Visible PanList.Visibility = Visibility.Visible
PanList.Children.Clear() PanList.Children.Clear()
For Each TargetMod In ShowingMods SyncLock ModItems.SyncRoot
Dim Item As MyLocalModItem = ModItems(TargetMod.RawFileName) For Each TargetMod In ShowingMods
Item.Checked = SelectedMods.Contains(TargetMod.RawFileName) '更新选中状态 Dim Item As MyLocalModItem = ModItems(TargetMod.RawFileName)
PanList.Children.Add(Item) Item.Checked = SelectedMods.Contains(TargetMod.RawFileName) '更新选中状态
Next PanList.Children.Add(Item)
Next
End SyncLock
Else Else
PanList.Visibility = Visibility.Collapsed PanList.Visibility = Visibility.Collapsed
End If End If
@@ -528,6 +532,7 @@ Install:
If IndexOfUi = -1 Then Continue For '因为未知原因 Mod 的状态已经切换完了 If IndexOfUi = -1 Then Continue For '因为未知原因 Mod 的状态已经切换完了
PanList.Children.RemoveAt(IndexOfUi) PanList.Children.RemoveAt(IndexOfUi)
PanList.Children.Insert(IndexOfUi, NewItem) PanList.Children.Insert(IndexOfUi, NewItem)
NewItem.UpdateLayout() '#7861
Next Next
If IsSuccessful Then If IsSuccessful Then
RefreshBars() RefreshBars()
@@ -591,7 +596,7 @@ Install:
NewestReplaceName = Join(NewestSegs, "-") NewestReplaceName = Join(NewestSegs, "-")
End If End If
'添加到下载列表 '添加到下载列表
Dim TempAddress As String = PathTemp & "DownloadedMods\" & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName) Dim TempAddress As String = PathTemp & "mods\" & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName) '需要下载到 mods 文件夹，以便重复文件检查时识别
Dim RealAddress As String = GetPathFromFullPath(Entry.Path) & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName) Dim RealAddress As String = GetPathFromFullPath(Entry.Path) & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName)
FileList.Add(File.ToNetFile(TempAddress)) FileList.Add(File.ToNetFile(TempAddress))
FileCopyList(TempAddress) = RealAddress FileCopyList(TempAddress) = RealAddress
Plain Craft Launcher 2/Pages/PageLaunch/MySkin.xaml.vb
+12 -16
View File
@@ -232,9 +232,7 @@ Retry:
Dim Uuid As String = McLoginMsLoader.Output.Uuid Dim Uuid As String = McLoginMsLoader.Output.Uuid
Dim SkinData As JObject = GetJson(McLoginMsLoader.Output.ProfileJson) Dim SkinData As JObject = GetJson(McLoginMsLoader.Output.ProfileJson)
'获取玩家的所有披风 '获取玩家的所有披风
Dim SelId As Integer? = Nothing Dim SelectedIndex As Integer? = Nothing
'获取玩家当前的披风
Dim CurId As Integer? = Nothing
RunInUiWait( RunInUiWait(
Sub() Sub()
Try Try
@@ -248,25 +246,23 @@ Retry:
{"Mojang Office", "Mojang 办公室披风"}, {"Home", "家园披风"}, {"Menace", "入侵披风"}, {"Yearn", "渴望披风"}, {"Mojang Office", "Mojang 办公室披风"}, {"Home", "家园披风"}, {"Menace", "入侵披风"}, {"Yearn", "渴望披风"},
{"Common", "普通披风"}, {"Pan", "薄煎饼披风"}, {"Founder's", "创始人披风"}, {"Copper", "铜披风"}, {"Zombie Horse", "僵尸马披风"} {"Common", "普通披风"}, {"Pan", "薄煎饼披风"}, {"Founder's", "创始人披风"}, {"Copper", "铜披风"}, {"Zombie Horse", "僵尸马披风"}
} }
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}} Dim SelectionControl As New List(Of IMyRadio) From {
Dim Id As Integer = 0 New MyRadioBox With {.Text = "无披风", .Checked = Not SkinData("capes").Any(Function(c) c("state")?.ToString = "ACTIVE")}}
For Each Cape In SkinData("capes") For Each Cape In SkinData("capes")
Id += 1
Dim CapeName As String = Cape("alias").ToString Dim CapeName As String = Cape("alias").ToString
If CapeNames.ContainsKey(CapeName) Then CapeName = CapeNames(CapeName) If CapeNames.ContainsKey(CapeName) Then CapeName = CapeNames(CapeName)
If Cape("state")?.ToString = "ACTIVE" Then CurId = Id
SelectionControl.Add(New MyRadioBox With {.Text = CapeName, .Checked = Cape("state")?.ToString = "ACTIVE"}) SelectionControl.Add(New MyRadioBox With {.Text = CapeName, .Checked = Cape("state")?.ToString = "ACTIVE"})
Next Next
SelId = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消") SelectedIndex = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception Catch ex As Exception
Log(ex, "获取玩家皮肤列表失败", LogLevel.Feedback) Log(ex, "获取玩家皮肤列表失败", LogLevel.Feedback)
End Try End Try
End Sub) End Sub)
If SelId Is Nothing Then Return If SelectedIndex Is Nothing Then Return
'发送请求 '发送请求
Dim Result As String = NetRequestByClientRetry("https://api.minecraftservices.com/minecraft/profile/capes/active", Dim Result As String = NetRequestByClientRetry("https://api.minecraftservices.com/minecraft/profile/capes/active",
If(SelId = 0, HttpMethod.Delete, HttpMethod.Put), If(SelectedIndex = 0, HttpMethod.Delete, HttpMethod.Put),
Content:=If(SelId = 0, "", New JObject(New JProperty("capeId", SkinData("capes")(SelId - 1)("id"))).ToString(0)), Content:=If(SelectedIndex = 0, "", New JObject(New JProperty("capeId", SkinData("capes")(SelectedIndex - 1)("id"))).ToString(0)),
ContentType:="application/json", ContentType:="application/json",
Headers:={{"Authorization", "Bearer " & AccessToken}}) Headers:={{"Authorization", "Bearer " & AccessToken}})
If Result.Contains("""errorMessage""") Then If Result.Contains("""errorMessage""") Then
@@ -274,11 +270,11 @@ Retry:
Return Return
Else Else
Hint("更改披风成功！", HintType.Green) Hint("更改披风成功！", HintType.Green)
'#7894，更换披风后需更新当前选择的披风 '更新当前选择的披风
SkinData("capes")(SelId - 1)("state") = "ACTIVE" For Each Cape In SkinData("capes")
If CurId IsNot Nothing Then Cape("state") = "INACTIVE"
SkinData("capes")(CurId - 1)("state") = "INACTIVE" Next
End If If SelectedIndex > 0 Then SkinData("capes")(SelectedIndex - 1)("state") = "ACTIVE"
McLoginMsLoader.Output.ProfileJson = SkinData.ToString() McLoginMsLoader.Output.ProfileJson = SkinData.ToString()
End If End If
Catch ex As Exception Catch ex As Exception
Plain Craft Launcher 2/Pages/PageLink/PageLinkMain.xaml.vb
+1 -1
View File
@@ -484,7 +484,7 @@ Public Class PageLinkMain
If File.Exists(PathEasyTier & "EasyTier.zip") Then If File.Exists(PathEasyTier & "EasyTier.zip") Then
'解压 '解压
Dim ExtractPath As String = RequestTaskTempFolder() Dim ExtractPath As String = RequestTaskTempFolder()
ExtractFile(PathEasyTier & "EasyTier.zip", ExtractPath, ExtractCompressedFile(PathEasyTier & "EasyTier.zip", ExtractPath,
ProgressIncrementHandler:=Sub(Progress) Task.Progress += Progress * 0.05) ProgressIncrementHandler:=Sub(Progress) Task.Progress += Progress * 0.05)
Dim ExtractedPath As String = New DirectoryInfo(ExtractPath).EnumerateDirectories.FirstOrDefault?.FullName Dim ExtractedPath As String = New DirectoryInfo(ExtractPath).EnumerateDirectories.FirstOrDefault?.FullName
Log("[Link] 联机模块解压时的临时路径：" & ExtractedPath) Log("[Link] 联机模块解压时的临时路径：" & ExtractedPath)
Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml
+341 -2067
View File
File diff suppressed because it is too large Load Diff