龙腾猫跃 vor 2 Jahren
Ursprung
Commit
b5c9736918
39 geänderte Dateien mit 924 neuen und 739 gelöschten Zeilen
  1. 15 15
      Plain Craft Launcher 2/Application.xaml.vb
  2. 4 4
      Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb
  3. 1 1
      Plain Craft Launcher 2/FormMain.xaml
  4. 25 12
      Plain Craft Launcher 2/FormMain.xaml.vb
  5. 0 0
      Plain Craft Launcher 2/Images/Icons/Unavailable.png
  6. 31 14
      Plain Craft Launcher 2/Modules/Base/ModBase.vb
  7. 15 14
      Plain Craft Launcher 2/Modules/Base/ModLoader.vb
  8. 10 7
      Plain Craft Launcher 2/Modules/Base/ModNet.vb
  9. 14 2
      Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
  10. 64 57
      Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
  11. 53 23
      Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
  12. 140 242
      Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
  13. 101 115
      Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
  14. 17 19
      Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
  15. 36 36
      Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
  16. 0 6
      Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb
  17. 13 16
      Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml
  18. 23 15
      Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb
  19. 17 12
      Plain Craft Launcher 2/Modules/ModMain.vb
  20. 1 1
      Plain Craft Launcher 2/Modules/ModSecret.vb
  21. 2 2
      Plain Craft Launcher 2/My Project/AssemblyInfo.vb
  22. 6 16
      Plain Craft Launcher 2/My Project/Resources.Designer.vb
  23. 3 6
      Plain Craft Launcher 2/My Project/Resources.resx
  24. 8 8
      Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
  25. 40 0
      Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml
  26. 139 0
      Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml.vb
  27. 2 2
      Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb
  28. 4 0
      Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb
  29. 10 0
      Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml
  30. 19 1
      Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb
  31. 14 16
      Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb
  32. 1 0
      Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml
  33. 1 1
      Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb
  34. 9 13
      Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb
  35. 17 16
      Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
  36. 10 1
      Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb
  37. 40 22
      Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb
  38. 19 24
      Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj
  39. BIN
      Plain Craft Launcher 2/Resources/libwebp32.dll

+ 15 - 15
Plain Craft Launcher 2/Application.xaml.vb

@@ -96,23 +96,20 @@ Public Class Application
             End If
             '动态 DLL 调用
             AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
-            SetDllDirectory(Path & "PCL\")
-            If Is32BitSystem Then
-                File.WriteAllBytes(Path & "PCL\libwebp.dll", GetResources("libwebp32"))
-            Else
-                File.WriteAllBytes(Path & "PCL\libwebp.dll", GetResources("libwebp64"))
-            End If
             '日志初始化
             LogStart()
             '添加日志
-            Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode}){If(CommitHash <> "", $",Commit Hash:{CommitHash}", "")}")
+            Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
             Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
             Log($"[Start] 程序路径:{PathWithName}")
             Log($"[Start] 系统编码:{Encoding.Default} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
             Log($"[Start] 管理员权限:{IsAdmin()}")
-            '检测压缩包运行
+            '检测异常环境
             If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
-                MyMsgBox("PCL 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True)
+                MyMsgBox("请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!" & vbCrLf & "程序目前在临时文件夹中运行,设置、游戏存档等可能无法保存,且部分功能将无法使用。", "环境警告", "我知道了", IsWarn:=True)
+            End If
+            If Is32BitSystem Then
+                MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True)
             End If
             '设置初始化
             Setup.Load("SystemDebugMode")
@@ -177,11 +174,12 @@ Public Class Application
     Private Shared AssemblyNAudio As Assembly
     Private Shared AssemblyJson As Assembly
     Private Shared AssemblyDialog As Assembly
-    Private Shared AssemblyWebp As Assembly
+    Private Shared AssemblyImazenWebp As Assembly
     Private Shared ReadOnly AssemblyNAudioLock As New Object
     Private Shared ReadOnly AssemblyJsonLock As New Object
     Private Shared ReadOnly AssemblyDialogLock As New Object
-    Private Shared ReadOnly AssemblyWebpLock As New Object
+    Private Shared ReadOnly AssemblyImazenWebpLock As New Object
+    Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
     Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly
         If args.Name.StartsWithF("NAudio") Then
             SyncLock AssemblyNAudioLock
@@ -208,12 +206,14 @@ Public Class Application
                 Return AssemblyDialog
             End SyncLock
         ElseIf args.Name.StartsWithF("Imazen.WebP") Then
-            SyncLock AssemblyWebpLock
-                If AssemblyWebp Is Nothing Then
+            SyncLock AssemblyImazenWebpLock
+                If AssemblyImazenWebp Is Nothing Then
                     Log("[Start] 加载 DLL:Imazen.WebP")
-                    AssemblyWebp = Assembly.Load(GetResources("WebP"))
+                    AssemblyImazenWebp = Assembly.Load(GetResources("Imazen_WebP"))
+                    SetDllDirectory(PathTemp)
+                    File.WriteAllBytes(PathTemp & "libwebp.dll", GetResources("libwebp64"))
                 End If
-                Return AssemblyWebp
+                Return AssemblyImazenWebp
             End SyncLock
         Else
             Return Nothing

+ 4 - 4
Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb

@@ -46,18 +46,18 @@
         Black
         Highlight
     End Enum
-    Private _ColorType As ColorState = ColorState.Black
     Public Property ColorType As ColorState
         Get
-            Return _ColorType
+            Return GetValue(ColorTypeProperty)
         End Get
         Set(value As ColorState)
-            _ColorType = value
+            If ColorType = value Then Return
+            SetValue(ColorTypeProperty, value)
             RefreshColor()
         End Set
     End Property '颜色类别
     Public Shared ReadOnly ColorTypeProperty As DependencyProperty =
-        DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata())
+        DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata(ColorState.Black))
 
     '点击事件
 

+ 1 - 1
Plain Craft Launcher 2/FormMain.xaml

@@ -166,7 +166,7 @@
                         </Border>
                     </Border>
                 </Grid>
-                <StackPanel x:Name="PanHint" IsHitTestVisible="False" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,25" Grid.RowSpan="2" />
+                <StackPanel x:Name="PanHint" IsHitTestVisible="False" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,20" Grid.RowSpan="2" />
                 <StackPanel HorizontalAlignment="Right" VerticalAlignment="Bottom" Grid.Row="1" Margin="15">
                     <local:MyExtraButton x:Name="BtnExtraBack" HorizontalAlignment="Right" VerticalAlignment="Center" ToolTip="返回顶部" Visibility="Collapsed"
                                        Logo="M858.496 188.9024 173.1072 188.9024c-30.2848 0-54.8352-24.5504-54.8352-54.8352L118.272 106.6496c0-30.2848 24.5504-54.8352 54.8352-54.8352l685.3888 0c30.2848 0 54.8352 24.5504 54.8352 54.8352l0 27.4176C913.3312 164.352 888.7808 188.9024 858.496 188.9024L858.496 188.9024zM150.6048 550.8608c0 0 300.0064-240.3584 303.0272-243.328 13.9776-13.5936 31.1808-21.8624 48.8192-24.7552 1.7152-0.3072 3.4304-0.5888 5.1456-0.768 2.7392-0.3072 5.4528-0.3584 8.192-0.3328 2.7392-0.0256 5.4272 0.0256 8.1664 0.3328 1.7408 0.1792 3.4304 0.4864 5.1456 0.768 17.664 2.8928 34.8672 11.1616 48.8192 24.7552 3.0464 2.944 303.0016 243.328 303.0016 243.328 32.384 31.5136 29.6192 63.9744-2.7392 95.5136-32.3328 31.5392-75.648 2.9696-108.0064-28.544l-185.8816-147.1232 0 485.8368c0 30.3104-24.5248 54.8608-54.8352 54.8608l-27.392 0c-30.2848 0-54.8352-24.5504-54.8352-54.8608L447.232 470.7072l-185.8304 147.0976c-32.3584 31.5392-75.6992 60.1344-108.032 28.5696C121.0368 614.8352 118.272 582.3744 150.6048 550.8608L150.6048 550.8608zM150.6048 550.8608" />

+ 25 - 12
Plain Craft Launcher 2/FormMain.xaml.vb

@@ -134,6 +134,14 @@ Public Class FormMain
         '3:BUG+ IMP* FEAT-
         '2:BUG* IMP-
         '1:BUG-
+        If LastVersion < 337 Then 'Snapshot 2.8.7
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "使用新的正版登录方式,以提高安全性"))
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化安装整合包、检索 Mod 的稳定性"))
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法加载部分 Mod 的图标的 Bug"))
+            FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复在 Mod 管理页面删除 Mod 导致报错的 Bug"))
+            FeatureCount += 11
+            BugCount += 21
+        End If
         If LastVersion < 335 Then 'Snapshot 2.8.6
             BugCount += 2
         End If
@@ -432,6 +440,10 @@ Public Class FormMain
             Height = MinHeight + 50
             Width = MinWidth + 50
         End Try
+#If DEBUG Then
+        MinHeight = 50
+        MinWidth = 50
+#End If
         Topmost = False
         If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed))
         '更改窗口
@@ -1011,18 +1023,19 @@ Install:
     ''' 把当前窗口拖到最前面。
     ''' </summary>
     Public Sub ShowWindowToTop()
-        RunInUi(Sub()
-                    '这一坨乱七八糟的,别改,改了指不定就炸了,自己电脑还复现不出来
-                    Visibility = Visibility.Visible
-                    ShowInTaskbar = True
-                    WindowState = WindowState.Normal
-                    Hidden = False
-                    Topmost = True '偶尔 SetForegroundWindow 失效
-                    Topmost = False
-                    SetForegroundWindow(Handle)
-                    Focus()
-                    Log("[System] 窗口已置顶,位置:(" & Left & ", " & Top & "), " & Width & " x " & Height)
-                End Sub)
+        RunInUi(
+        Sub()
+            '这一坨乱七八糟的,别改,改了指不定就炸了,自己电脑还复现不出来
+            Visibility = Visibility.Visible
+            ShowInTaskbar = True
+            WindowState = WindowState.Normal
+            Hidden = False
+            Topmost = True '偶尔 SetForegroundWindow 失效
+            Topmost = False
+            SetForegroundWindow(Handle)
+            Focus()
+            Log($"[System] 窗口已置顶,位置:({Left}, {Top}), {Width} x {Height}")
+        End Sub)
     End Sub
 
 #End Region

+ 0 - 0
Plain Craft Launcher 2/Images/Icons/Unavaliable.png → Plain Craft Launcher 2/Images/Icons/Unavailable.png


+ 31 - 14
Plain Craft Launcher 2/Modules/Base/ModBase.vb

@@ -1,4 +1,5 @@
-Imports System.IO.Compression
+Imports System.Globalization
+Imports System.IO.Compression
 Imports System.Runtime.CompilerServices
 Imports System.Security.Cryptography
 Imports System.Security.Principal
@@ -11,13 +12,13 @@ Public Module ModBase
 #Region "声明"
 
     '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.8.6" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.8.6." & VersionBranchCode '标准格式的四段式版本号
-    Public Const CommitHash As String = "" 'Commit Hash
+    Public Const VersionBaseName As String = "2.8.7" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.8.7." & VersionBranchCode '标准格式的四段式版本号
+    Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
 #If BETA Then
     Public Const VersionCode As Integer = 336 'Release
 #Else
-    Public Const VersionCode As Integer = 335 'Snapshot
+    Public Const VersionCode As Integer = 337 'Snapshot
 #End If
     '自动生成的版本信息
     Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -65,7 +66,7 @@ Public Module ModBase
     ''' </summary>
     Public ApplicationOpenTime As Date = Date.Now
     ''' <summary>
-    ''' 设备唯一标识符。
+    ''' 识别码。
     ''' </summary>
     Public UniqueAddress As String = SecretGetUniqueAddress()
     ''' <summary>
@@ -1237,9 +1238,15 @@ Re:
     Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
         If Not Directory.Exists(Path) Then Return 0
         Dim DeletedCount As Integer = 0
-        Dim Temp As String()
-        Temp = Directory.GetFiles(Path)
-        For Each FilePath As String In Temp
+        Dim Files As String()
+        Try
+            Files = Directory.GetFiles(Path)
+        Catch ex As DirectoryNotFoundException '#4549
+            Log(ex, $"疑似为孤立符号链接,尝试直接删除({Path})", LogLevel.Developer)
+            Directory.Delete(Path)
+            Return 0
+        End Try
+        For Each FilePath As String In Files
             Dim RetriedFile As Boolean = False
 RetryFile:
             Try
@@ -1258,8 +1265,7 @@ RetryFile:
                 End If
             End Try
         Next
-        Temp = Directory.GetDirectories(Path)
-        For Each str As String In Temp
+        For Each str As String In Directory.GetDirectories(Path)
             DeleteDirectory(str, IgnoreIssue)
         Next
         Dim RetriedDir As Boolean = False
@@ -1441,14 +1447,14 @@ RetryDir:
     End Function
 
     ''' <summary>
-    ''' 获取 Json 对象。
+    ''' 获取 JSON 对象。
     ''' </summary>
     Public Function GetJson(Data As String)
         Try
             Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
         Catch ex As Exception
             Dim Length As Integer = If(Data, "").Length
-            Throw New Exception("格式化 json 对象失败:" & If(Length > 10000, Data.Substring(0, 100) & $"...(全长 {Length} 个字符)..." & Right(Data, 100), Data))
+            Throw New Exception("格式化 JSON 失败:" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data))
         End Try
     End Function
 
@@ -1852,6 +1858,13 @@ RetryDir:
         Return NewProcess.ExitCode
     End Function
 
+    ''' <summary>
+    ''' 判断当前系统语言是否为中文。
+    ''' </summary>
+    Public Function IsSystemLanguageChinese() As Boolean
+        Return CultureInfo.CurrentCulture.TwoLetterISOLanguageName = "zh" OrElse CultureInfo.CurrentUICulture.TwoLetterISOLanguageName = "zh"
+    End Function
+
     Private Uuid As Integer = 1
     Private UuidLock As Object
     ''' <summary>
@@ -2657,7 +2670,11 @@ Retry:
     End Sub
     Public Function CanFeedback(ShowHint As Boolean) As Boolean
         If False.Equals(PageSetupSystem.IsLauncherNewest) Then
-            If ShowHint Then MyMsgBox("你的 PCL 不是最新版,因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈")
+            If ShowHint Then
+                If MyMsgBox($"你的 PCL 不是最新版,因此无法提交反馈。{vbCrLf}请在更新后,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
+                    UpdateCheckByButton()
+                End If
+            End If
             Return False
         Else
             Return True

+ 15 - 14
Plain Craft Launcher 2/Modules/Base/ModLoader.vb

@@ -91,17 +91,18 @@
                 _State = value
                 Log("[Loader] 加载器 " & Name & " 状态改变:" & GetStringFromEnum(value))
                 '实现 ILoadingTrigger 接口与 OnStateChanged 回调
-                RunInUi(Sub()
-                            Select Case value
-                                Case LoadState.Loading
-                                    LoadingState = MyLoading.MyLoadingState.Run
-                                Case LoadState.Failed
-                                    LoadingState = MyLoading.MyLoadingState.Error
-                                Case Else
-                                    LoadingState = MyLoading.MyLoadingState.Stop
-                            End Select
-                            RaiseEvent OnStateChangedUi(Me, value, OldState)
-                        End Sub)
+                RunInUi(
+                Sub()
+                    Select Case value
+                        Case LoadState.Loading
+                            LoadingState = MyLoading.MyLoadingState.Run
+                        Case LoadState.Failed
+                            LoadingState = MyLoading.MyLoadingState.Error
+                        Case Else
+                            LoadingState = MyLoading.MyLoadingState.Stop
+                    End Select
+                    RaiseEvent OnStateChangedUi(Me, value, OldState)
+                End Sub)
                 If HasOnStateChangedThread Then RunInThread(Sub() RaiseEvent OnStateChangedThread(Me, value, OldState))
             End Set
         End Property
@@ -566,7 +567,7 @@ Restart:
     End Class
 
     '任务栏进度条
-    Public LoaderTaskbar As New Concurrent.ConcurrentBag(Of LoaderBase)
+    Public LoaderTaskbar As New SynchronizedCollection(Of LoaderBase)
     Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
     Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
 
@@ -582,14 +583,14 @@ Restart:
             '检查任务是否完成,若完成则移除
             '外显任务是否已经全部完成
             Dim IsAllDownloadTaskCompleted As Boolean = True
-            For Each Loader In LoaderTaskbar
+            For Each Loader In LoaderTaskbar.ToList()
                 If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
             Next
             '若单个任务已中止或全部任务已完成,则刷新并移除
             For Each Task In LoaderTaskbar.ToList()
                 If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
                     If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
-                    LoaderTaskbar.TryTake(Task)
+                    LoaderTaskbar.Remove(Task)
                     Log($"[Taskbar] {Task.Name} 已移出任务列表")
                 End If
             Next

+ 10 - 7
Plain Craft Launcher 2/Modules/Base/ModNet.vb

@@ -329,7 +329,7 @@ Retry:
     ''' <summary>
     ''' 同时发送多个网络请求并要求返回内容。
     ''' </summary>
-    Public Function NetRequestMulty(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing)
+    Public Function NetRequestMulty(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True)
         Dim Threads As New List(Of Thread)
         Dim RequestResult = Nothing
         Dim RequestEx As Exception = Nothing
@@ -338,7 +338,7 @@ Retry:
             Dim th As New Thread(
             Sub()
                 Try
-                    RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
+                    RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers, MakeLog)
                 Catch ex As Exception
                     FailCount += 1
                     RequestEx = ex
@@ -1232,7 +1232,7 @@ SourceBreak:
                 '根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传)
                 If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse
                    ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse
-                   (ex.Message.Contains("(403)") AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403,所以不应因此禁用下载源
+                   ((ex.Message.Contains("(403)") OrElse ex.Message.Contains("(429)")) AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403、429,所以不应因此禁用下载源
                    (Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse
                     Info.Source.FailCount > NetTaskThreadLimit + 2 Then
                     Dim IsThisFail As Boolean = False
@@ -1344,7 +1344,7 @@ Retry:
                         If Check.ActualSize = -1 Then
                             Check.ActualSize = FileSize
                         ElseIf Check.ActualSize <> FileSize Then
-                            Throw New Exception("文件大小不一致:任务要求为 " & Check.ActualSize & " B,网络获取结果为 " & FileSize & "B")
+                            Throw New Exception($"文件大小不一致:任务要求为 {Check.ActualSize} B,网络获取结果为 {FileSize}B")
                         End If
                     End If
                     '检查文件
@@ -1654,6 +1654,9 @@ NextElement:
                 '复制已存在的文件
                 For Each FileToken In ExistFiles
                     Dim File As NetFile = FileToken.Key
+                    SyncLock LockState
+                        If File.State > NetState.WaitForCopy Then Exit Sub
+                    End SyncLock
                     Dim LocalPath As String = FileToken.Value
                     Dim RetryCount As Integer = 0
 Retry:
@@ -1882,7 +1885,7 @@ Retry:
                         For Each File As NetFile In WaitingFiles
                             If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
                             Dim NewThread = File.TryBeginThread()
-                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率,避免 Too Many Requests
+                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率,避免 Too Many Requests
                         Next
                         '为进行中的文件追加线程
                         If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够,无需新增
@@ -1902,7 +1905,7 @@ Retry:
                             '新增线程
                             If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程,不再新增
                             Dim NewThread = File.TryBeginThread()
-                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率,避免 Too Many Requests
+                            If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(70) '减少 BMCLAPI 请求频率,避免 Too Many Requests
                         Next
                     End While
                 Catch ex As Exception
@@ -2000,7 +2003,7 @@ Retry:
     ''' 是否有正在进行中、需要在下载管理页面显示的下载任务?
     ''' </summary>
     Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
-        For Each Task In LoaderTaskbar
+        For Each Task In LoaderTaskbar.ToList()
             If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
                (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
                 Return True

+ 14 - 2
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb

@@ -66,8 +66,20 @@ Public Class MyBitmap
             Else
                 '使用这种自己接管 FileStream 的方法加载才能解除文件占用
                 Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open)
-                    Pic = New System.Drawing.Bitmap(InputStream)
-                    InputStream.Dispose()
+                    '判断是否为 WebP 文件头
+                    Dim Header(1) As Byte
+                    InputStream.Read(Header, 0, 2)
+                    InputStream.Seek(0, SeekOrigin.Begin)
+                    If Header(0) = 82 AndAlso Header(1) = 73 Then
+                        '读取 WebP
+                        If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
+                        Dim FileBytes(InputStream.Length - 1) As Byte
+                        InputStream.Read(FileBytes, 0, FileBytes.Length)
+                        Dim Decoder As New Imazen.WebP.SimpleDecoder()
+                        Pic = Decoder.DecodeFromBytes(FileBytes, FileBytes.Length)
+                    Else
+                        Pic = New System.Drawing.Bitmap(InputStream)
+                    End If
                 End Using
             End If
         Catch ex As Exception

+ 64 - 57
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb

@@ -247,7 +247,13 @@
                     Website = Data("links")("websiteUrl").ToString.TrimEnd("/")
                     LastUpdate = Data("dateReleased") '#1194
                     DownloadCount = Data("downloadCount")
-                    If Data("logo").Count > 0 Then LogoUrl = Data("logo")("thumbnailUrl")
+                    If Data("logo").Count > 0 Then
+                        If Data("logo")("thumbnailUrl") Is Nothing OrElse Data("logo")("thumbnailUrl") = "" Then
+                            LogoUrl = Data("logo")("url")
+                        Else
+                            LogoUrl = Data("logo")("thumbnailUrl")
+                        End If
+                    End If
                     'FileIndexes / GameVersions / ModLoaders
                     ModLoaders = New List(Of CompModLoaderType)
                     Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
@@ -417,7 +423,7 @@
             Json("DownloadCount") = DownloadCount
             If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
             Json("Tags") = New JArray(Tags)
-            If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
+            If Not String.IsNullOrEmpty(LogoUrl) Then Json("LogoUrl") = LogoUrl
             If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions)
             Json("CacheTime") = Date.Now '用于检查缓存时间
             Return Json
@@ -536,7 +542,7 @@
             Return NewItem
         End Function
         Public Function GetControlLogo() As String
-            If LogoUrl Is Nothing Then
+            If String.IsNullOrEmpty(LogoUrl) Then
                 Return PathImage & "Icons/NoIcon.png"
             Else
                 Return LogoUrl
@@ -944,30 +950,30 @@ Retry:
             Dim CurseForgeFailed As Boolean = False
             If CurseForgeUrl IsNot Nothing Then
                 CurseForgeThread = RunInNewThread(
-                    Sub()
-                        Try
-                            '获取工程列表
-                            Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
-                            Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True)
-                            Task.Progress += 0.2
-                            Dim ProjectList As New List(Of CompProject)
-                            For Each JsonEntry As JObject In RequestResult("data")
-                                ProjectList.Add(New CompProject(JsonEntry))
-                            Next
-                            '更新结果
-                            SyncLock ResultsLock
-                                RawResults.AddRange(ProjectList)
-                            End SyncLock
-                            Storage.CurseForgeOffset += ProjectList.Count
-                            Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
-                            Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
-                        Catch ex As Exception
-                            Log(ex, "从 CurseForge 获取工程列表失败")
-                            Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
-                            [Error] = ex
-                            CurseForgeFailed = True
-                        End Try
-                    End Sub, "CurseForge Project Request")
+                Sub()
+                    Try
+                        '获取工程列表
+                        Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
+                        Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True)
+                        Task.Progress += 0.2
+                        Dim ProjectList As New List(Of CompProject)
+                        For Each JsonEntry As JObject In RequestResult("data")
+                            ProjectList.Add(New CompProject(JsonEntry))
+                        Next
+                        '更新结果
+                        SyncLock ResultsLock
+                            RawResults.AddRange(ProjectList)
+                        End SyncLock
+                        Storage.CurseForgeOffset += ProjectList.Count
+                        Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
+                        Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
+                    Catch ex As Exception
+                        Log(ex, "从 CurseForge 获取工程列表失败")
+                        Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
+                        [Error] = ex
+                        CurseForgeFailed = True
+                    End Try
+                End Sub, "CurseForge Project Request")
             End If
 
             '启动 Modrinth 线程
@@ -975,32 +981,32 @@ Retry:
             Dim ModrinthFailed As Boolean = False
             If ModrinthUrl IsNot Nothing Then
                 ModrinthThread = RunInNewThread(
-                    Sub()
-                        Try
-                            Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
-                            Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True)
-                            Task.Progress += 0.2
-                            Dim ProjectList As New List(Of CompProject)
-                            For Each JsonEntry As JObject In RequestResult("hits")
-                                ProjectList.Add(New CompProject(JsonEntry))
+                Sub()
+                    Try
+                        Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
+                        Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True)
+                        Task.Progress += 0.2
+                        Dim ProjectList As New List(Of CompProject)
+                        For Each JsonEntry As JObject In RequestResult("hits")
+                            ProjectList.Add(New CompProject(JsonEntry))
+                        Next
+                        '更新结果
+                        SyncLock ResultsLock
+                            For Each Project In ProjectList
+                                If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件(#2458)
+                                RawResults.Add(Project)
                             Next
-                            '更新结果
-                            SyncLock ResultsLock
-                                For Each Project In ProjectList
-                                    If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件(#2458)
-                                    RawResults.Add(Project)
-                                Next
-                            End SyncLock
-                            Storage.ModrinthOffset += ProjectList.Count
-                            Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
-                            Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
-                        Catch ex As Exception
-                            Log(ex, "从 Modrinth 获取工程列表失败")
-                            Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
-                            [Error] = ex
-                            ModrinthFailed = True
-                        End Try
-                    End Sub, "Modrinth Project Request")
+                        End SyncLock
+                        Storage.ModrinthOffset += ProjectList.Count
+                        Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
+                        Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
+                    Catch ex As Exception
+                        Log(ex, "从 Modrinth 获取工程列表失败")
+                        Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
+                        [Error] = ex
+                        ModrinthFailed = True
+                    End Try
+                End Sub, "Modrinth Project Request")
             End If
 
             '等待线程结束
@@ -1470,7 +1476,7 @@ Retry:
         End If
         '更新前置 Mod 信息
         If Deps.Any Then
-            For Each DepProject In Deps.Select(Function(id) CompProjectCache(id))
+            For Each DepProject In Deps.Where(Function(id) CompProjectCache.ContainsKey(id)).Select(Function(id) CompProjectCache(id))
                 For Each File In CompFilesCache(ProjectId)
                     If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
                         File.Dependencies.Add(DepProject.Id)
@@ -1490,10 +1496,11 @@ Retry:
         Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
         Deps.Sort()
         If Not Deps.Any() Then Exit Sub
-        Deps = Deps.Where(Function(dep)
-                              If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
-                              Return CompProjectCache.ContainsKey(dep)
-                          End Function).ToList
+        Deps = Deps.Where(
+        Function(dep)
+            If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
+            Return CompProjectCache.ContainsKey(dep)
+        End Function).ToList
         '添加开头间隔
         Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
         '添加前置 Mod 列表

+ 53 - 23
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb

@@ -21,12 +21,7 @@
         End If
         '检查文件
         Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1"))
-        If ReturnNothingOnFileUseable Then
-            '是否跳过
-            Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
-            If IsSetupSkip AndAlso File.Exists(Version.Path & Version.Name & ".jar") Then Return Nothing '跳过校验
-            If Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
-        End If
+        If ReturnNothingOnFileUseable AndAlso Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
         '返回下载信息
         Dim JarUrl As String = Version.JsonObject("downloads")("client")("url")
         Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker)
@@ -56,7 +51,7 @@
     ''' <summary>
     ''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
     ''' </summary>
-    Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour, SkipAssetsDownloadWhileSetupRequired As Boolean) As List(Of LoaderBase)
+    Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
         Dim Loaders As New List(Of LoaderBase)
 
 #Region "下载支持库文件"
@@ -69,9 +64,9 @@
 #End Region
 
 #Region "下载资源文件"
-        Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
-        If IsSetupSkip Then Log("[Download] 已跳过 Assets 下载")
-        If (Not SkipAssetsDownloadWhileSetupRequired) OrElse Not IsSetupSkip Then
+        If ShouldIgnoreFileCheck(Version) Then
+            Log("[Download] 已跳过所有 Assets 检查")
+        Else
             Dim LoadersAssets As New List(Of LoaderBase)
             '获取资源文件索引地址
             LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
@@ -121,7 +116,7 @@
             '获取资源文件地址
             LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
             Sub(Task As LoaderTask(Of String, List(Of NetFile)))
-                Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
+                Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task)
             End Sub) With {.ProgressWeight = 3})
             '下载资源文件
             LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
@@ -1087,29 +1082,46 @@
 
     ''' <summary>
     ''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。
-    ''' 调用 NetGetCodeByRequestOnce。
+    ''' 调用 NetGetCodeByRequest。
     ''' </summary>
     Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
         Dim McimUrl As String = DlSourceModGet(Url)
         Dim Urls As New List(Of KeyValuePair(Of String, Integer))
         If McimUrl <> Url Then
             Select Case Setup.Get("ToolDownloadMod")
+                'UNDONE: 受 #4811 影响
                 Case 0
-                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
-                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
+                    If ModeDebug Then
+                        Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
+                    Else
+                        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
+                    End If
                 Case 1
                     Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
-                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
                 Case Else
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
                     Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
                     Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
             End Select
         End If
         Dim Exs As String = ""
         For Each Source In Urls
             Try
-                Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000,
-                                               IsJson:=IsJson, UseBrowserUserAgent:=True)
+                Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000, IsJson:=IsJson, UseBrowserUserAgent:=True)
             Catch ex As Exception
                 Exs += ex.Message + vbCrLf
             End Try
@@ -1119,28 +1131,46 @@
 
     ''' <summary>
     ''' 对可能涉及 Mod 镜像源的请求进行处理。
-    ''' 调用 NetRequestOnce。
+    ''' 调用 NetRequest。
     ''' </summary>
-    Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String, Optional Headers As Dictionary(Of String, String) = Nothing) As String
+    Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String) As String
         Dim McimUrl As String = DlSourceModGet(Url)
         Dim Urls As New List(Of KeyValuePair(Of String, Integer))
         If McimUrl <> Url Then
             Select Case Setup.Get("ToolDownloadMod")
+                'UNDONE: 受 #4811 影响
                 Case 0
-                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
-                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
+                    If ModeDebug Then
+                        Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
+                    Else
+                        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
+                        Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
+                    End If
                 Case 1
                     Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
-                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
                 Case Else
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
                     Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
                     Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
+                    Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
             End Select
         End If
         Dim Exs As String = ""
         For Each Source In Urls
             Try
-                Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000, Headers:=Headers)
+                Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000)
             Catch ex As Exception
                 Exs += ex.Message + vbCrLf
             End Try

+ 140 - 242
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb

@@ -4,6 +4,7 @@ Public Module ModLaunch
 
 #Region "开始"
 
+    Public CurrentLaunchOptions As McLaunchOptions = Nothing
     Public Class McLaunchOptions
         ''' <summary>
         ''' 强制指定在启动后进入的服务器 IP。
@@ -20,32 +21,34 @@ Public Module ModLaunch
         ''' 默认值:Nothing。使用 McVersionCurrent。
         ''' </summary>
         Public Version As McVersion = Nothing
+        ''' <summary>
+        ''' 额外的启动参数。
+        ''' </summary>
+        Public ExtraArgs As New List(Of String)
     End Class
     ''' <summary>
     ''' 尝试启动 Minecraft。必须在 UI 线程调用。
     ''' 返回是否实际开始了启动(如果没有,则一定弹出了错误提示)。
     ''' </summary>
     Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean
-        Options = If(Options, New McLaunchOptions)
+        CurrentLaunchOptions = If(Options, New McLaunchOptions)
         '预检查
-        If Not RunInUi() Then
-            Throw New Exception("McLaunchStart 必须在 UI 线程调用!")
-        End If
+        If Not RunInUi() Then Throw New Exception("McLaunchStart 必须在 UI 线程调用!")
         If McLaunchLoader.State = LoadState.Loading Then
             Hint("已有游戏正在启动中!", HintType.Critical)
             Return False
         End If
         '强制切换需要启动的版本
-        If Options.Version IsNot Nothing AndAlso McVersionCurrent <> Options.Version Then
-            McLaunchLog("在启动前切换到版本 " & Options.Version.Name)
+        If CurrentLaunchOptions.Version IsNot Nothing AndAlso McVersionCurrent <> CurrentLaunchOptions.Version Then
+            McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Version.Name)
             '检查版本
-            Options.Version.Load()
-            If Options.Version.State = McVersionState.Error Then
-                Hint("无法启动 Minecraft:" & Options.Version.Info, HintType.Critical)
+            CurrentLaunchOptions.Version.Load()
+            If CurrentLaunchOptions.Version.State = McVersionState.Error Then
+                Hint("无法启动 Minecraft:" & CurrentLaunchOptions.Version.Info, HintType.Critical)
                 Return False
             End If
             '切换版本
-            McVersionCurrent = Options.Version
+            McVersionCurrent = CurrentLaunchOptions.Version
             Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
             FrmLaunchLeft.RefreshButtonsUI()
             FrmLaunchLeft.RefreshPage(False, False)
@@ -95,7 +98,7 @@ Public Module ModLaunch
             McLaunchPrecheck()
             McLaunchLog("预检测已通过")
         Catch ex As Exception
-            Hint(ex.Message, HintType.Critical)
+            If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Critical)
             Throw
         End Try
         '正式加载
@@ -104,7 +107,7 @@ Public Module ModLaunch
             Dim Loaders As New List(Of LoaderBase) From {
                 New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
                 McLoginLoader,
-                New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False},
+                New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
                 New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
                 New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
                 New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
@@ -144,7 +147,7 @@ Public Module ModLaunch
                     Hint(McVersionCurrent.Name & " 启动成功!", HintType.Finish)
                 Case LoadState.Aborted
                     If AbortHint Is Nothing Then
-                        Hint(If(Loader.Input.SaveBatch Is Nothing, "已取消启动!", "已取消导出启动脚本!"), HintType.Info)
+                        Hint(If(CurrentLaunchOptions?.SaveBatch Is Nothing, "已取消启动!", "已取消导出启动脚本!"), HintType.Info)
                     Else
                         Hint(AbortHint, HintType.Finish)
                     End If
@@ -159,7 +162,7 @@ NextInner:
             If CurrentEx.Message.StartsWithF("$") Then
                 '若有以 $ 开头的错误信息,则以此为准显示提示
                 '若错误信息为 $$,则不提示
-                If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
+                If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
                 Throw
             ElseIf CurrentEx.InnerException IsNot Nothing Then
                 '检查下一级错误
@@ -168,7 +171,9 @@ NextInner:
             Else
                 '没有特殊处理过的错误信息
                 McLaunchLog("错误:" & GetExceptionDetail(ex))
-                Log(ex, If(Loader.Input.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox, If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
+                Log(ex,
+                    If(CurrentLaunchOptions?.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox,
+                    If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
                 Throw
             End If
         End Try
@@ -211,36 +216,45 @@ NextInner:
         If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题:" & McVersionCurrent.Info)
         '检查输入信息
         Dim CheckResult As String = ""
-        RunInUiWait(Sub()
-                        Dim LoginInput As McLoginData = McLoginInput()
-                        CheckResult = McLoginAble(LoginInput)
-                    End Sub)
+        RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
         If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
 #If BETA Then
         '求赞助
-        RunInNewThread(Sub()
-                           Select Case Setup.Get("SystemLaunchCount")
-                               Case 20, 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1700, 1900, 2100, 2300, 2500
-                                   If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
-                                               "如果觉得 PCL 还算好用的话,也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
-                                               "毕竟一个人开发也不容易(悲)……",
-                                               "求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then
-                                       OpenWebsite("https://afdian.com/a/LTCat")
-                                   End If
-                           End Select
-                       End Sub, "Donate")
-#End If
-        '正版购买提示
-        If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
+        RunInNewThread(
+        Sub()
             Select Case Setup.Get("SystemLaunchCount")
-                Case 10, 35, 75, 125, 175, 225, 275, 325, 375, 425, 475, 550, 650, 750, 850, 950, 1050, 1150, 1250, 1350, 1450, 1600, 1800, 2000, 2200, 2400
-                    If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦!" & vbCrLf &
-                                "如果觉得 Minecraft 还不错,也可以考虑购买正版支持一下,毕竟开发游戏也很不容易……" & vbCrLf &
-                                "在你登录一次正版账号后,就不会再出现这个提示了。",
-                                "考虑一下正版?", "购买正版游戏", "下次一定") = 1 Then
-                        OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
+                Case 10, 20, 40, 60, 80, 100, 120, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
+                    If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
+                                "如果觉得 PCL 还算好用的话,也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
+                                "毕竟一个人开发也不容易(悲)……",
+                                "求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then
+                        OpenWebsite("https://afdian.com/a/LTCat")
                     End If
             End Select
+        End Sub, "Donate")
+#End If
+        '正版购买提示
+        If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
+            If IsSystemLanguageChinese() Then
+                Select Case Setup.Get("SystemLaunchCount")
+                    Case 2, 5, 10, 15, 20, 40, 60, 80, 100, 125, 150, 175, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
+                        If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦!" & vbCrLf &
+                                    "如果觉得 Minecraft 还不错,可以购买正版支持一下,毕竟开发游戏也真的很不容易……" & vbCrLf & vbCrLf &
+                                    "在你登录一次正版账号后,就不会再出现这个提示了!",
+                                    "考虑一下正版?", "支持正版游戏!", "下次一定") = 1 Then
+                            OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
+                        End If
+                End Select
+            ElseIf Setup.Get("LoginType") = McLoginType.Legacy Then
+                Select Case MyMsgBox("你必须先登录正版账号,才能进行离线登录!", "正版验证", "购买正版", "试玩", "返回",
+                    Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"))
+                    Case 2
+                        Hint("游戏将以试玩模式启动!", HintType.Critical)
+                        CurrentLaunchOptions.ExtraArgs.Add("--demo")
+                    Case 3
+                        Throw New Exception("$$")
+                End Select
+            End If
         End If
     End Sub
 
@@ -487,58 +501,56 @@ NextInner:
 #Region "分方式登录模块"
 
     '各个登录方式的主对象与输入构造
-    Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 300000}
+    Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart)
     Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
-    Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
-    Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
+    Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
+    Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
 
     '主加载函数,返回所有需要的登录信息
+    Private McLoginMsRefreshTime As Long = 0 '上次刷新登录的时间
     Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult))
         Dim Input As McLoginMs = Data.Input
         Dim LogUsername As String = Input.UserName
         McLaunchLog("登录方式:正版(" & If(LogUsername = "", "尚未登录", LogUsername) & ")")
         Data.Progress = 0.05
         '检查是否已经登录完成
-        If Input.AccessToken <> "" AndAlso Not Data.IsForceRestarting Then
+        If Not Data.IsForceRestarting AndAlso '不要求强行重启
+           Input.AccessToken <> "" AndAlso '已经登录过了
+           (McLoginMsRefreshTime > 0 AndAlso GetTimeTick() - McLoginMsRefreshTime < 1000 * 60 * 10) Then '完成时间在 10 分钟内
             Data.Output = New McLoginResult With
                 {.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid, .ProfileJson = Input.ProfileJson}
             GoTo SkipLogin
         End If
         '尝试登录
         Dim OAuthTokens As String()
-        Dim ClientId As String = ""
         If Input.OAuthRefreshToken = "" Then
             '无 RefreshToken
 Relogin:
-            Dim OAuthCode As String = MsLoginStep1(Data)
-            If OAuthCode = "Cancel" Then Exit Sub
-            If Data.IsAborted Then Throw New ThreadInterruptedException
-            Data.Progress = 0.2
-            OAuthTokens = MsLoginStep2(OAuthCode, False, ClientId)
+            OAuthTokens = MsLoginStep1New(Data)
         Else
             '有 RefreshToken
-            OAuthTokens = MsLoginStep2(Input.OAuthRefreshToken, True, ClientId)
+            OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken) '要求重新打开登录网页认证
+            If OAuthTokens(0) = "Relogin" Then GoTo Relogin
         End If
-        '要求重新打开登录网页认证
-        If OAuthTokens(0) = "Cancel" Then Exit Sub
-        If OAuthTokens(0) = "Relogin" Then GoTo Relogin
-        Data.Progress = 0.35
+        If Data.IsAborted Then Throw New ThreadInterruptedException
+        Data.Progress = 0.25
         If Data.IsAborted Then Throw New ThreadInterruptedException
         Dim OAuthAccessToken As String = OAuthTokens(0)
         Dim OAuthRefreshToken As String = OAuthTokens(1)
-        Dim XBLToken As String = MsLoginStep3(OAuthAccessToken)
-        Data.Progress = 0.5
+        Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
+        Data.Progress = 0.4
         If Data.IsAborted Then Throw New ThreadInterruptedException
-        Dim Tokens = MsLoginStep4(XBLToken)
-        Data.Progress = 0.65
+        Dim Tokens = MsLoginStep3(XBLToken)
+        Data.Progress = 0.55
         If Data.IsAborted Then Throw New ThreadInterruptedException
-        Dim AccessToken As String = MsLoginStep5(Tokens)
-        Data.Progress = 0.8
+        Dim AccessToken As String = MsLoginStep4(Tokens)
+        Data.Progress = 0.7
         If Data.IsAborted Then Throw New ThreadInterruptedException
-        MsLoginStep6(AccessToken)
-        Data.Progress = 0.9
+        MsLoginStep5(AccessToken)
+        Data.Progress = 0.85
         If Data.IsAborted Then Throw New ThreadInterruptedException
-        Dim Result = MsLoginStep7(AccessToken)
+        Dim Result = MsLoginStep6(AccessToken)
+        Data.Progress = 0.98
         '输出登录结果
         Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken)
         Setup.Set("CacheMsAccess", AccessToken)
@@ -550,11 +562,11 @@ Relogin:
         MsJson(Result(1)) = OAuthRefreshToken
         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)}
-        '解锁主题
-SkipLogin:
+        '结束
+        McLoginMsRefreshTime = GetTimeTick()
         McLaunchLog("微软登录完成")
+SkipLogin:
         Setup.Set("HintBuy", True) '关闭正版购买提示
-        Data.Progress = 0.98
         If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持!" & vbCrLf & "隐藏主题 跳票红 已解锁!", "提示")
     End Sub
     Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
@@ -821,179 +833,61 @@ LoginFinish:
         End Try
     End Function
 
-    '微软登录步骤 1:打开网页认证,获取 OAuth Code
-    Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
-        McLaunchLog("开始微软登录步骤 1")
-        OpenWebsite(FormLoginOAuth.LoginUrl1)
-        Dim Result As String =
-            MyMsgBoxInput("等待网页登录",
-                          "登录完成后,网页会变得完全空白。把那个空白网页的网址复制到下面的框中就行!" & vbCrLf &
-                          "如果网络环境不佳,它可能一直加载不出来,那就只能试试用 VPN 或加速器了。",
-                          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")
-        If Result Is Nothing Then
-            McLaunchLog("微软登录已在步骤 1 被取消")
-            Throw New ThreadInterruptedException("$$")
-        Else
-            Return RegexSeek(Result, "(?<=code\=)[^&]+")
-        End If
-    End Function
+    '微软登录步骤 1,原始登录:获取 DeviceCode 并开启登录网页
+    Private Function MsLoginStep1New(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String()
+        '参考:https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
+
+        '初始请求
+        McLaunchLog("开始微软登录步骤 1/6(原始登录)")
+        Dim PrepareJson As JObject = GetJson(NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
+            $"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded", 2))
+        McLaunchLog("网页登录地址:" & PrepareJson("verification_uri").ToString)
 
-    '微软登录步骤 2:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
-    Private Function MsLoginStep2(Code As String, IsRefresh As Boolean, ClientId As String, Optional ExpiresIn As String = "900") As String()
-        McLaunchLog("开始微软登录步骤 2(" & If(IsRefresh, "", "非") & "刷新登录)")
-
-        Dim Request As String
-        If IsRefresh Then
-            Request = "grant_type=refresh_token" & "&" &
-                      "client_id=" & ClientId & "&" &
-                      "device_code=" & Code & "&" &
-                      "refresh_token=" & Uri.EscapeDataString(Code) & "&" &
-                      "scope=XboxLive.signin%20offline_access"
+        '弹窗
+        Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
+        WaitingMyMsgBox.Add(Converter)
+        While Converter.Result Is Nothing
+            Thread.Sleep(100)
+        End While
+        If TypeOf Converter.Result Is Exception Then
+            Throw CType(Converter.Result, Exception)
         Else
-            Request = "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
-                      "client_id=" & ClientId & "&" &
-                      "device_code=" & Code & "&" &
-                      "scope=XboxLive.signin%20offline_access"
+            Return Converter.Result
         End If
-        Dim Result As String
-        Dim stopwatch As Stopwatch = Stopwatch.StartNew()
+    End Function
 
-        While stopwatch.Elapsed < TimeSpan.FromSeconds(ExpiresIn)
-            Try
-                Result = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", Request, "application/x-www-form-urlencoded", 2)
-            Catch ex As Exception
-                If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
-                    Return {"Relogin", ""}
-                ElseIf ex.Message.Contains("authorization_declined") Then
-                    Hint("你拒绝了 PCL2 的访问权限申请,验证过程被中断!")
-                    Return {"Cancel", ""}
-                ElseIf ex.Message.Contains("expired_token") Then
-                    Hint("Token 已过期,请尝试重新验证!")
-                    Exit While
-                ElseIf ex.Message.Contains("AADSTS70016") Then
-                    Continue While
-                Else
-                    Throw
-                End If
-            End Try
+    '微软登录步骤 1,刷新登录:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
+    Private Function MsLoginStep1Refresh(Code As String) As String()
+        McLaunchLog("开始微软登录步骤 1/6(刷新登录)")
 
-            If Result IsNot Nothing Then
-                Dim ResultJson As JObject = GetJson(Result)
-                Dim AccessToken As String = ResultJson("access_token").ToString
-                Dim RefreshToken As String = ResultJson("refresh_token").ToString
-                Return {AccessToken, RefreshToken}
+        Dim Result As String
+        Try
+            Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST",
+                $"client_id={OAuthClientId}&refresh_token={Uri.EscapeDataString(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
+                "application/x-www-form-urlencoded", 2)
+        Catch ex As Exception
+            If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
+                Return {"Relogin", ""}
+            Else
+                Throw
             End If
+        End Try
 
-            Thread.Sleep(1000)
-        End While
-
-        Hint("验证超时,请尝试重新验证!")
-        Return {"Cancel", ""}
-
+        Dim ResultJson As JObject = GetJson(Result)
+        Dim AccessToken As String = ResultJson("access_token").ToString
+        Dim RefreshToken As String = ResultJson("refresh_token").ToString
+        Return {AccessToken, RefreshToken}
     End Function
 
-    ''微软登录步骤 1:获取 DeviceCode 并显示验证提示
-    ''https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
-    'Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
-    '    McLaunchLog("开始微软登录步骤 1:获取验证信息")
-    '    Dim PrepareJson As JObject = GetJson(NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
-    '        $"client_id={OAuthClientId}&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded", 2))
-
-    '    '从这里开始直到步骤 2 结束都没有 Review
-    '    '参考:https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
-    '    If MyMsgBox("请在打开的网页里输入 PCL2 提供的设备代码(会自动复制到剪贴板)。" & vbCrLf &
-    '                            "设备代码有时效性,若操作时间过长需要重新进行登录流程。", "正版验证确认", "继续", "取消") <> 1 Then
-    '        Return "Cancel"
-    '    End If
-
-    '    Dim DeviceCode As String = PrepareJson("device_code")
-    '    Dim UserCode As String = PrepareJson("user_code")
-    '    Dim VerifyUri As String = PrepareJson("verification_uri")
-    '    'ResultJson("expires_in")
-    '    ClipboardSet(UserCode)
-    '    OpenWebsite(VerifyUri)
-
-    '    Dim MsgBoxValue As String = ""
-    '    While MsgBoxValue IsNot "1"
-    '        MsgBoxValue = MyMsgBox("本次验证的设备代码为:" & UserCode & vbCrLf & vbCrLf & "你也可以在任意设备上打开下列网址进行验证:" & vbCrLf & VerifyUri & vbCrLf & vbCrLf & "在验证完成后,你可以直接关闭这个弹窗,PCL2 会自动完成接下来的流程。", "正版验证", "关闭", "复制网址", "复制设备代码").ToString
-    '        If MsgBoxValue = "2" Then
-    '            ClipboardSet(VerifyUri)
-    '            Continue While
-    '        ElseIf MsgBoxValue = "3" Then
-    '            ClipboardSet(UserCode)
-    '            Continue While
-    '        ElseIf MsgBoxValue = "1" Then
-    '            Exit While
-    '        End If
-    '    End While
-
-    '    Return DeviceCode
-    'End Function
-
-    ''微软登录步骤 2:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
-    'Private Function MsLoginStep2(Code As String, IsRefresh As Boolean, Optional ExpiresIn As String = "900") As String()
-    '    McLaunchLog("开始微软登录步骤 2(" & If(IsRefresh, "", "非") & "刷新登录)")
-
-    '    Dim Request As String
-    '    If IsRefresh Then
-    '        Request = "grant_type=refresh_token" & "&" &
-    '                  "client_id=" & OAuthClientId & "&" &
-    '                  "device_code=" & Code & "&" &
-    '                  "refresh_token=" & Uri.EscapeDataString(Code) & "&" &
-    '                  "scope=XboxLive.signin%20offline_access"
-    '    Else
-    '        Request = "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
-    '                  "client_id=" & OAuthClientId & "&" &
-    '                  "device_code=" & Code & "&" &
-    '                  "scope=XboxLive.signin%20offline_access"
-    '    End If
-    '    Dim Result As String
-    '    Dim stopwatch As Stopwatch = Stopwatch.StartNew()
-
-    '    While stopwatch.Elapsed < TimeSpan.FromSeconds(ExpiresIn)
-    '        Try
-    '            Result = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", Request, "application/x-www-form-urlencoded", 2)
-    '        Catch ex As Exception
-    '            If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
-    '                Return {"Relogin", ""}
-    '            ElseIf ex.Message.Contains("authorization_declined") Then
-    '                Hint("你拒绝了 PCL2 的访问权限申请,验证过程被中断!")
-    '                Return {"Cancel", ""}
-    '            ElseIf ex.Message.Contains("expired_token") Then
-    '                Hint("Token 已过期,请尝试重新验证!")
-    '                Exit While
-    '            ElseIf ex.Message.Contains("AADSTS70016") Then
-    '                Continue While
-    '            Else
-    '                Throw
-    '            End If
-    '        End Try
-
-    '        If Result IsNot Nothing Then
-    '            Dim ResultJson As JObject = GetJson(Result)
-    '            Dim AccessToken As String = ResultJson("access_token").ToString
-    '            Dim RefreshToken As String = ResultJson("refresh_token").ToString
-    '            Return {AccessToken, RefreshToken}
-    '        End If
-
-    '        Thread.Sleep(1000)
-    '    End While
-
-    '    Hint("验证超时,请尝试重新验证!")
-    '    Return {"Cancel", ""}
-
-    'End Function
-
-    '微软登录步骤 3:从 OAuth AccessToken 获取 XBLToken
-    Private Function MsLoginStep3(AccessToken As String) As String
-        McLaunchLog("开始微软登录步骤 3")
+    '微软登录步骤 2:从 OAuth AccessToken 获取 XBLToken
+    Private Function MsLoginStep2(AccessToken As String) As String
+        McLaunchLog("开始微软登录步骤 2/6")
 
         Dim Request As String = "{
            ""Properties"": {
                ""AuthMethod"": ""RPS"",
                ""SiteName"": ""user.auth.xboxlive.com"",
-               ""RpsTicket"": """ & AccessToken & """
+               ""RpsTicket"": """ & If(AccessToken.StartsWithF("d="), "", "d=") & AccessToken & """
            },
            ""RelyingParty"": ""http://auth.xboxlive.com"",
            ""TokenType"": ""JWT""
@@ -1004,9 +898,9 @@ LoginFinish:
         Dim XBLToken As String = ResultJson("Token").ToString
         Return XBLToken
     End Function
-    '微软登录步骤 4:从 XBLToken 获取 {XSTSToken, UHS}
-    Private Function MsLoginStep4(XBLToken As String) As String()
-        McLaunchLog("开始微软登录步骤 4")
+    '微软登录步骤 3:从 XBLToken 获取 {XSTSToken, UHS}
+    Private Function MsLoginStep3(XBLToken As String) As String()
+        McLaunchLog("开始微软登录步骤 3/6")
 
         Dim Request As String = "{
                                     ""Properties"": {
@@ -1056,9 +950,9 @@ LoginFinish:
         Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString
         Return {XSTSToken, UHS}
     End Function
-    '微软登录步骤 5:从 {XSTSToken, UHS} 获取 Minecraft AccessToken
-    Private Function MsLoginStep5(Tokens As String()) As String
-        McLaunchLog("开始微软登录步骤 5")
+    '微软登录步骤 4:从 {XSTSToken, UHS} 获取 Minecraft AccessToken
+    Private Function MsLoginStep4(Tokens As String()) As String
+        McLaunchLog("开始微软登录步骤 4/6")
 
         Dim Request As String = New JObject(New JProperty("identityToken", $"XBL3.0 x={Tokens(1)};{Tokens(0)}")).ToString(0)
         Dim Result As String
@@ -1081,9 +975,9 @@ LoginFinish:
         Dim AccessToken As String = ResultJson("access_token").ToString
         Return AccessToken
     End Function
-    '微软登录步骤 6:验证微软账号是否持有 MC,这也会刷新 XGP
-    Private Sub MsLoginStep6(AccessToken As String)
-        McLaunchLog("开始微软登录步骤 6")
+    '微软登录步骤 5:验证微软账号是否持有 MC,这也会刷新 XGP
+    Private Sub MsLoginStep5(AccessToken As String)
+        McLaunchLog("开始微软登录步骤 5/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
@@ -1100,9 +994,9 @@ LoginFinish:
             Throw
         End Try
     End Sub
-    '微软登录步骤 7:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
-    Private Function MsLoginStep7(AccessToken As String) As String()
-        McLaunchLog("开始微软登录步骤 7")
+    '微软登录步骤 6:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
+    Private Function MsLoginStep6(AccessToken As String) As String()
+        McLaunchLog("开始微软登录步骤 6/6")
 
         Dim Result As String
         Try
@@ -1447,8 +1341,12 @@ LoginFinish:
         Arguments = Arguments.Replace(" -Dos.name=Windows 10", " -Dos.name=""Windows 10""")
         '全屏
         If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen"
+        '由 Option 传入的额外参数
+        For Each Arg In CurrentLaunchOptions.ExtraArgs
+            Arguments += " " & Arg.Trim
+        Next
         '进服
-        Dim Server As String = If(String.IsNullOrEmpty(McLaunchLoader.Input.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), McLaunchLoader.Input.ServerIp)
+        Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), CurrentLaunchOptions.ServerIp)
         If Server.Length > 0 Then
             If McVersionCurrent.ReleaseTime > New Date(2023, 4, 4) Then
                 'QuickPlay
@@ -2148,18 +2046,18 @@ IgnoreCustomSkin:
                 """" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
                 "echo 游戏已退出。" & vbCrLf &
                 "pause"
-            WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
+            WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
                       Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
-            If McLaunchLoader.Input.SaveBatch IsNot Nothing Then
+            If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
                 McLaunchLog("导出启动脚本完成,强制结束启动过程")
                 AbortHint = "导出启动脚本成功!"
-                OpenExplorer("/select,""" & McLaunchLoader.Input.SaveBatch & """")
+                OpenExplorer("/select,""" & CurrentLaunchOptions.SaveBatch & """")
                 Loader.Parent.Abort()
                 Exit Sub '导出脚本完成
             End If
         Catch ex As Exception
             Log(ex, "输出启动脚本失败")
-            If McLaunchLoader.Input.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
+            If CurrentLaunchOptions.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
         End Try
 
         '执行自定义命令

+ 101 - 115
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb

@@ -475,22 +475,27 @@ VersionSearchFinish:
         ''' </summary>
         Public Property JsonText As String
             Get
+                '快速检查 JSON 是否以 { 开头、} 结尾;忽略空白字符
+                Dim FastJsonCheck =
+                Function(Json As String) As Boolean
+                    Dim TrimedJson As String = Json.Trim()
+                    Return TrimedJson.StartsWithF("{") AndAlso TrimedJson.EndsWithF("}")
+                End Function
                 If _JsonText Is Nothing Then
-                    If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 json 文件:" & Path & Name & ".json")
+                    If Not File.Exists(Path & Name & ".json") Then Throw New Exception($"未找到版本 JSON 文件:{Path}{Name}.json")
                     _JsonText = ReadFile(Path & Name & ".json")
                     '如果 ReadFile 失败会返回空字符串;这可能是由于文件被临时占用,故延时后重试
-                    If _JsonText.Length = 0 Then
+                    If Not FastJsonCheck(_JsonText) Then
                         If RunInUi() Then
-                            Log("[Minecraft] 版本 json 文件为空或读取失败,由于代码在主线程运行,将不再进行重试", LogLevel.Debug)
-                            Throw New Exception("版本 Json 文件为空或读取失败")
+                            Log("[Minecraft] 版本 JSON 文件为空或有误,由于代码在主线程运行,将不再进行重试", LogLevel.Debug)
+                            GetJson(_JsonText) '触发异常
                         Else
-                            Log("[Minecraft] 版本 json 文件为空或读取失败,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug)
+                            Log("[Minecraft] 版本 JSON 文件为空或有误,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug)
                             Thread.Sleep(2000)
                             _JsonText = ReadFile(Path & Name & ".json")
-                            If _JsonText.Length = 0 Then Throw New Exception("版本 json 文件为空或读取失败")
+                            If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
                         End If
                     End If
-                    If _JsonText.Length < 100 Then Throw New Exception("版本 json 文件有误,内容为:" & _JsonText)
                 End If
                 Return _JsonText
             End Get
@@ -562,11 +567,10 @@ Recheck:
                                 GoTo Recheck
                             End If
                         Catch ex As Exception
-                            Log(ex, "合并版本依赖项 json 失败(" & If(InheritVersion, "null").ToString & ")")
+                            Log(ex, "合并版本依赖项 JSON 失败(" & If(InheritVersion, "null").ToString & ")")
                         End Try
                     Catch ex As Exception
-                        Log($"[Minecraft] 传入的版本 json 文件内容(共 {Text.Length} 字符,最多输出前 5000 字符):{vbCrLf}{Text.Substring(0, 5000)}")
-                        Throw New Exception("版本 json 不规范(" & If(Name, "null") & ")", ex)
+                        Throw New Exception("初始化版本 JSON 时失败(" & If(Name, "null") & ")", ex)
                     End Try
                     Try
                         '处理 JumpLoader
@@ -1030,21 +1034,21 @@ ExitDataLoad:
     Public Function GetMcFoolName(Name As String) As String
         Name = Name.ToLower
         If Name.StartsWithF("2.0") Then
-            Return "这个秘密计划了两年的更新将游戏推向了一个新高度!"
-        ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
-            Return "我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
+            Return "2013 | 这个秘密计划了两年的更新将游戏推向了一个新高度!"
         ElseIf Name = "15w14a" Then
-            Return "作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。"
+            Return "2015 | 作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。"
         ElseIf Name = "1.rv-pre1" Then
-            Return "是时候将现代科技带入 Minecraft 了!"
+            Return "2016 | 是时候将现代科技带入 Minecraft 了!"
         ElseIf Name = "3d shareware v1.34" Then
-            Return "我们从地下室的废墟里找到了这个开发于 1994 年的杰作!"
+            Return "2019 | 我们从地下室的废墟里找到了这个开发于 1994 年的杰作!"
+        ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
+            Return "2020 | 我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
         ElseIf Name = "22w13oneblockatatime" Then
-            Return "一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!"
+            Return "2022 | 一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!"
         ElseIf Name = "23w13a_or_b" Then
-            Return "研究表明:玩家喜欢作出选择——越多越好!"
+            Return "2023 | 研究表明:玩家喜欢作出选择——越多越好!"
         ElseIf Name = "24w14potato" Then
-            Return "毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
+            Return "2024 | 毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
         Else
             Return ""
         End If
@@ -1946,17 +1950,13 @@ OnLoaded:
         End Try
         If CoreJarOnly Then Return Result
 
-        '是否跳过校验
-        Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
-
         'Library 文件
-        Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\", AllowUnsameFile:=IsSetupSkip))
+        Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\"))
 
         '统一通行证文件
         If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then
             Dim TargetFile = PathAppdata & "nide8auth.jar"
-            If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then
-                Dim DownloadInfo As JObject = Nothing
+            Dim DownloadInfo As JObject = Nothing
                 '获取下载信息
                 Try
                     Log("[Minecraft] 开始获取统一通行证下载信息")
@@ -1966,14 +1966,13 @@ OnLoaded:
                 Catch ex As Exception
                     Log(ex, "获取统一通行证下载信息失败")
                 End Try
-                '校验文件
-                If DownloadInfo IsNot Nothing Then
-                    Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString)
-                    If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
-                        '开始下载
-                        Log("[Minecraft] 统一通行证需要更新:Hash - " & Checker.Hash, LogLevel.Developer)
-                        Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker))
-                    End If
+            '校验文件
+            If DownloadInfo IsNot Nothing Then
+                Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString)
+                If Checker.Check(TargetFile) IsNot Nothing Then
+                    '开始下载
+                    Log("[Minecraft] 统一通行证需要更新:Hash - " & Checker.Hash, LogLevel.Developer)
+                    Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker))
                 End If
             End If
         End If
@@ -1982,45 +1981,59 @@ OnLoaded:
         If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse
            (PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接
             Dim TargetFile = PathAppdata & "authlib-injector.jar"
-            If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then
-                Dim DownloadInfo As JObject = Nothing
-                '获取下载信息
-                Try
-                    Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
-                    DownloadInfo = GetJson(NetGetCodeByDownload({"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True))
-                Catch ex As Exception
-                    Log(ex, "获取 Authlib-Injector 下载信息失败")
-                End Try
-                '校验文件
-                If DownloadInfo IsNot Nothing Then
-                    Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
-                    If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
-                        '开始下载
-                        Dim DownloadAddress As String = DownloadInfo("download_url")
-                        Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress, LogLevel.Developer)
-                        Result.Add(New NetFile({DownloadAddress}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
-                    End If
+            Dim DownloadInfo As JObject = Nothing
+            '获取下载信息
+            Try
+                Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
+                DownloadInfo = GetJson(NetGetCodeByDownload({
+                        "https://authlib-injector.yushi.moe/artifact/latest.json",
+                        "https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"
+                    }, IsJson:=True))
+            Catch ex As Exception
+                Log(ex, "获取 Authlib-Injector 下载信息失败")
+            End Try
+            '校验文件
+            If DownloadInfo IsNot Nothing Then
+                Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
+                If Checker.Check(TargetFile) IsNot Nothing Then
+                    '开始下载
+                    Dim DownloadAddress As String = DownloadInfo("download_url").ToString.
+                            Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe")
+                    Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress, LogLevel.Developer)
+                    Result.Add(New NetFile({
+                            DownloadAddress,
+                            DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector")
+                        }, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
                 End If
             End If
         End If
 
+        '跳过校验
+        If ShouldIgnoreFileCheck(Version) Then
+            Log("[Minecraft] 用户要求尽量忽略文件检查,这可能会保留有误的文件")
+            Result = Result.Where(
+            Function(f)
+                If File.Exists(f.LocalPath) Then
+                    Log("[Minecraft] 跳过下载的支持库文件:" & f.LocalPath, LogLevel.Debug)
+                    Return False
+                Else
+                    Return True
+                End If
+            End Function).ToList
+        End If
+
         Return Result
     End Function
     ''' <summary>
     ''' 将 McLibToken 列表转换为 NetFile。无需下载的文件会被自动过滤。
     ''' </summary>
-    Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing, Optional AllowUnsameFile As Boolean = False) As List(Of NetFile)
+    Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing) As List(Of NetFile)
         CustomMcFolder = If(CustomMcFolder, PathMcFolder)
         Dim Result As New List(Of NetFile)
         '获取
         For Each Token As McLibToken In Libs
             '检查文件
-            Dim Checker As FileChecker
-            If AllowUnsameFile Then '只要文件存在则通过检查,用于放宽完整性校验的情况
-                Checker = New FileChecker(MinSize:=1)
-            Else
-                Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
-            End If
+            Dim Checker As New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
             If Checker.Check(Token.LocalPath) Is Nothing Then Continue For
             '文件不符合,添加下载
             Dim Urls As New List(Of String)
@@ -2159,77 +2172,50 @@ OnLoaded:
         ''' </summary>
         Public Size As Long
         ''' <summary>
-        ''' 是否为 Virtual 资源文件。
-        ''' </summary>
-        Public IsVirtual As Boolean
-        ''' <summary>
         ''' 文件的 Hash 校验码。
         ''' </summary>
         Public Hash As String
 
         Public Overrides Function ToString() As String
-            Return If(IsVirtual, "[Virtual] ", "") & GetString(Size) & " | " & LocalPath
+            Return GetString(Size) & " | " & LocalPath
         End Function
     End Structure
     ''' <summary>
     ''' 获取 Minecraft 的资源文件列表。失败会抛出异常。
     ''' </summary>
-    ''' <param name="Name">版本的资源名称,如“1.13.1”。</param>
-    Private Function McAssetsListGet(Name As String) As List(Of McAssetsToken)
+    Private Function McAssetsListGet(Version As McVersion) As List(Of McAssetsToken)
+        Dim IndexName = McAssetsGetIndexName(Version)
         Try
 
             '初始化
-            If Not File.Exists(PathMcFolder & "assets\indexes\" & Name & ".json") Then Throw New FileNotFoundException("Assets 索引文件未找到", PathMcFolder & "assets\indexes\" & Name & ".json")
-            McAssetsListGet = New List(Of McAssetsToken)
-            Dim Json = GetJson(ReadFile(PathMcFolder & "assets\indexes\" & Name & ".json"))
-
-            '确认 Virtual 与 Map 状态
-            Dim IsVirtual As Boolean = False
-            If Json("virtual") IsNot Nothing AndAlso Json("virtual").ToString Then IsVirtual = True
-            If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToString Then
-                IsVirtual = True
-                '刷新 resources 文件夹符号链接(#2182)
-                'Dim Info As FileSystemInfo = New FileInfo(PathMcFolder & "resources\pack.mcmeta")
-                'If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then
-                If Not File.Exists(PathMcFolder & "resources\pack.mcmeta") Then
-                    Log("[Minecraft] 尝试刷新 resources 文件夹符号链接", LogLevel.Debug)
-                    Try
-                        DeleteDirectory(PathMcFolder & "resources\", True)
-                        Directory.CreateDirectory(PathMcFolder & "assets\virtual\legacy\")
-                        Dim Result = ShellAndGetOutput("cmd", $"/C mklink /D /J ""{PathMcFolder}resources"" ""{PathMcFolder}assets\virtual\legacy""")
-                        Log($"[Minecraft] 符号链接创建结果:{Result}")
-                        If Not Result.Contains("<<===>>") Then Throw New Exception($"非预期的结果({Result})")
-                    Catch ex As Exception
-                        Log(ex, "创建资源文件夹链接失败,游戏可能会没有声音", LogLevel.Msgbox)
-                    End Try
-                End If
-            End If
+            If Not File.Exists($"{PathMcFolder}assets\indexes\{IndexName}.json") Then Throw New FileNotFoundException("未找到 Asset Index", PathMcFolder & "assets\indexes\" & IndexName & ".json")
+            Dim Result As New List(Of McAssetsToken)
+            Dim Json As JObject = GetJson(ReadFile($"{PathMcFolder}assets\indexes\{IndexName}.json"))
 
-            '加载列表
-            If IsVirtual Then
-                For Each File As JProperty In Json("objects").Children
-                    McAssetsListGet.Add(New McAssetsToken With {
-                        .IsVirtual = True,
-                        .LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\"),
-                        .SourcePath = File.Name,
-                        .Hash = File.Value("hash").ToString,
-                        .Size = File.Value("size").ToString
-                    })
-                Next
-            Else
-                For Each File As JProperty In Json("objects").Children
-                    McAssetsListGet.Add(New McAssetsToken With {
-                        .IsVirtual = False,
-                        .LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString,
-                        .SourcePath = File.Name,
-                        .Hash = File.Value("hash").ToString,
-                        .Size = File.Value("size").ToString
-                    })
-                Next
-            End If
+            '读取列表
+            For Each File As JProperty In Json("objects").Children
+                Dim LocalPath As String
+                If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToObject(Of Boolean) Then
+                    'Remap
+                    LocalPath = Version.PathIndie & "resources\" & File.Name.Replace("/", "\")
+                ElseIf Json("virtual") IsNot Nothing AndAlso Json("virtual").ToObject(Of Boolean) Then
+                    'Virtual
+                    LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\")
+                Else
+                    '正常
+                    LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString
+                End If
+                Result.Add(New McAssetsToken With {
+                    .LocalPath = LocalPath,
+                    .SourcePath = File.Name,
+                    .Hash = File.Value("hash").ToString,
+                    .Size = File.Value("size").ToString
+                })
+            Next
+            Return Result
 
         Catch ex As Exception
-            Log(ex, "获取资源文件列表失败:" & Name)
+            Log(ex, "获取资源文件列表失败:" & IndexName)
             Throw
         End Try
     End Function
@@ -2238,12 +2224,12 @@ OnLoaded:
     ''' <summary>
     ''' 获取版本缺失的资源文件所对应的 NetTaskFile。
     ''' </summary>
-    Public Function McAssetsFixList(IndexAddress As String, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile)
+    Public Function McAssetsFixList(Version As McVersion, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile)
         Dim Result As New List(Of NetFile)
 
         Dim AssetsList As List(Of McAssetsToken)
         Try
-            AssetsList = McAssetsListGet(IndexAddress)
+            AssetsList = McAssetsListGet(Version)
             Dim Token As McAssetsToken
             If ProgressFeed IsNot Nothing Then ProgressFeed.Progress = 0.04
             For i = 0 To AssetsList.Count - 1

+ 17 - 19
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb

@@ -1,6 +1,7 @@
 Imports System.IO.Compression
 
 Public Module ModMod
+    Private Const LocalModCacheVersion As Integer = 7
 
     Public Class McMod
 
@@ -47,7 +48,7 @@ Public Module ModMod
             Get
                 Load()
                 If Not IsFileAvailable Then
-                    Return McModState.Unavaliable
+                    Return McModState.Unavailable
                 ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
                     Return McModState.Disabled
                 Else
@@ -58,7 +59,7 @@ Public Module ModMod
         Public Enum McModState As Integer
             Fine = 0
             Disabled = 1
-            Unavaliable = 2
+            Unavailable = 2
         End Enum
 
 #End Region
@@ -814,7 +815,7 @@ Finished:
 
             '等待 Mod 更新完成
             If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
-                Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表")
+                Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表:" & Loader.Input)
                 Try
                     RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod")
                     Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input)
@@ -852,7 +853,7 @@ Finished:
             Dim Cache As New JObject
             Try
                 Dim CacheContent As String = ReadFile(CachePath)
-                If CacheContent <> "" Then
+                If Not String.IsNullOrWhiteSpace(CacheContent) Then
                     Cache = GetJson(CacheContent)
                     If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
                         Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug)
@@ -861,6 +862,7 @@ Finished:
                 End If
             Catch ex As Exception
                 Log(ex, "读取本地 Mod 信息缓存失败,已重置")
+                Cache = New JObject
             End Try
             Cache("version") = LocalModCacheVersion
 
@@ -886,7 +888,7 @@ Finished:
                 End If
                 ModList.Add(ModEntry)
                 '读取 Comp 缓存
-                If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
+                If ModEntry.State = McMod.McModState.Unavailable Then Continue For
                 Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
                 If Cache.ContainsKey(CacheKey) Then
                     ModEntry.FromJson(Cache(CacheKey))
@@ -901,8 +903,8 @@ Finished:
             '排序
             ModList = Sort(ModList,
             Function(Left As McMod, Right As McMod) As Boolean
-                If (Left.State = McMod.McModState.Unavaliable) <> (Right.State = McMod.McModState.Unavaliable) Then
-                    Return Left.State = McMod.McModState.Unavaliable
+                If (Left.State = McMod.McModState.Unavailable) <> (Right.State = McMod.McModState.Unavailable) Then
+                    Return Left.State = McMod.McModState.Unavailable
                 Else
                     Return Not Right.FileName.CompareTo(Left.FileName)
                 End If
@@ -924,7 +926,6 @@ Finished:
         End Try
     End Sub
     '联网加载 Mod 详情
-    Private Const LocalModCacheVersion As Integer = 6
     Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
     Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
         Dim Mods As List(Of McMod) = Loader.Input.Key
@@ -944,7 +945,7 @@ Finished:
         'McVersions = McVersions.Distinct().ToList()
         '开始网络获取
         Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}")
-        Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0
+        Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
         Dim MainThread As Thread = Thread.CurrentThread
         '从 Modrinth 获取信息
         RunInNewThread(
@@ -979,7 +980,6 @@ Finished:
                 For Each ProjectJson In ModrinthProject
                     Dim Project As New CompProject(ProjectJson)
                     For Each Entry In ModrinthMapping(Project.Id)
-                        If Entry.Comp IsNot Nothing AndAlso Entry.Comp.FromCurseForge Then Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 不是图片,如果可能,使用 CurseForge 的 Logo
                         Entry.Comp = Project
                     Next
                 Next
@@ -1005,9 +1005,9 @@ Finished:
                     End If
                 Next
                 Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
-                SucceedThreadCount += 1
             Catch ex As Exception
                 Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
+                IsFailed = True
             Finally
                 EndedThreadCount += 1
             End Try
@@ -1023,7 +1023,7 @@ Finished:
                     If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
                 Next
                 Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
-                                    $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
+                    $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
                 Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
                 '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
                 If Not CurseForgeRaw.Any() Then Exit Sub
@@ -1046,7 +1046,7 @@ Finished:
                 '步骤 3:获取工程信息
                 If Not CurseForgeMapping.Any() Then Exit Sub
                 Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST",
-                                    $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
+                    $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
                 Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
                 Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
                 For Each ProjectJson In CurseForgeProject
@@ -1055,7 +1055,6 @@ Finished:
                     Dim Project As New CompProject(ProjectJson)
                     For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
                         If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
-                            Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
                             Entry.Comp = Entry.Comp '再次触发修改事件
                             Continue For
                         End If
@@ -1066,10 +1065,9 @@ Finished:
                         Dim NewestVersion As String = Nothing
                         Dim NewestFileIds As New List(Of Integer)
                         For Each IndexEntry In ProjectJson("latestFilesIndexes")
-                            If IndexEntry("modLoader") Is Nothing OrElse Not IndexEntry("modLoader").HasValues OrElse '镜像源会返回一个值为 null 的键
-                            ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
+                            If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
                             Dim IndexVersion As String = IndexEntry("gameVersion")
-                            If McVersion <> IndexVersion Then Continue For 'MC 版本匹配
+                            If IndexVersion <> McVersion Then Continue For 'MC 版本匹配
                             '由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
                             If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
                             If NewestVersion <> IndexVersion Then
@@ -1114,9 +1112,9 @@ Finished:
                     End If
                 Next
                 Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
-                SucceedThreadCount += 1
             Catch ex As Exception
                 Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
+                IsFailed = True
             Finally
                 EndedThreadCount += 1
             End Try
@@ -1131,7 +1129,7 @@ Finished:
         Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
         If Not Mods.Any() Then Exit Sub
         For Each Entry In Mods
-            Entry.CompLoaded = SucceedThreadCount = 2
+            Entry.CompLoaded = Not IsFailed
             Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
         Next
         WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))

+ 36 - 36
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb

@@ -88,26 +88,27 @@
             AddHandler GameProcess.ErrorDataReceived, AddressOf LogReceived
 
             '初始化时钟
-            RunInNewThread(Sub()
-                               Try
-                                   Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
-                                       TimerWindow()
-                                       TimerLog()
-                                       '设置窗口标题
-                                       For i = 1 To 3
-                                           If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
-                                               Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss"))
-                                               SetWindowText(WindowHandle, RealTitle.ToCharArray)
-                                           End If
-                                           Thread.Sleep(64)
-                                       Next
-                                   Loop
-                                   WatcherLog("Minecraft 日志监控已退出")
-                               Catch ex As Exception
-                                   Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
-                                   State = MinecraftState.Ended
-                               End Try
-                           End Sub, "Minecraft Watcher PID " & PID)
+            RunInNewThread(
+            Sub()
+                Try
+                    Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
+                        TimerWindow()
+                        TimerLog()
+                        '设置窗口标题
+                        For i = 1 To 3
+                            If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
+                                Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss"))
+                                SetWindowText(WindowHandle, RealTitle.ToCharArray)
+                            End If
+                            Thread.Sleep(64)
+                        Next
+                    Loop
+                    WatcherLog("Minecraft 日志监控已退出")
+                Catch ex As Exception
+                    Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
+                    State = MinecraftState.Ended
+                End Try
+            End Sub, "Minecraft Watcher PID " & PID)
         End Sub
 
         '状态
@@ -349,22 +350,21 @@
             WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
             Hint("检测到 Minecraft 出现错误,错误分析已开始……")
             FeedbackInfo()
-            RunInNewThread(Sub()
-                               Try
-                                   Thread.Sleep(2000)
-                                   WatcherLog("崩溃分析开始")
-                                   Dim Analyzer As New CrashAnalyzer(PID)
-                                   Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
-                                   Analyzer.Prepare()
-                                   Analyzer.Analyze(Version)
-                                   Analyzer.Output(False, New List(Of String) From
-                                                           {Version.Path & Version.Name & ".json",
-                                                            Path & "PCL\Log1.txt",
-                                                            Path & "PCL\LatestLaunch.bat"})
-                               Catch ex As Exception
-                                   Log(ex, "崩溃分析失败", LogLevel.Feedback)
-                               End Try
-                           End Sub, "Crash Analyzer")
+            RunInNewThread(
+            Sub()
+                Try
+                    Thread.Sleep(2000)
+                    WatcherLog("崩溃分析开始")
+                    Dim Analyzer As New CrashAnalyzer(PID)
+                    Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
+                    Analyzer.Prepare()
+                    Analyzer.Analyze(Version)
+                    Analyzer.Output(False, New List(Of String) From
+                        {Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
+                Catch ex As Exception
+                    Log(ex, "崩溃分析失败", LogLevel.Feedback)
+                End Try
+            End Sub, "Crash Analyzer")
         End Sub
 
         '强制关闭

+ 0 - 6
Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb

@@ -55,12 +55,6 @@ RetryStart:
             End If
             '下载图片
             NetDownload(Url, LocalFileAddress & DownloadEnd, True)
-            If Url.EndsWithF("webp") Then
-                Log($"[Comp] Webp 格式转换:{LocalFileAddress}")
-                Dim dec = New Imazen.WebP.SimpleDecoder()
-                Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
-                dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
-            End If
             Dim LoadError As Exception = Nothing
             RunInUiWait(
             Sub()

+ 13 - 16
Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml

@@ -27,27 +27,24 @@
         <Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
     </Border>
     <!-- 标题 -->
-    <StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal" 
-                SnapsToDevicePixels="False" UseLayoutRounding="False">
+    <Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0"
+                SnapsToDevicePixels="False" UseLayoutRounding="False" x:Name="PanTitle">
+        <Grid.ColumnDefinitions>
+            <ColumnDefinition Width="Auto" />
+            <ColumnDefinition Width="Auto" x:Name="ColumnSubtitle" />
+            <ColumnDefinition Width="Auto" />
+            <ColumnDefinition Width="1*" x:Name="ColumnExtend" />
+        </Grid.ColumnDefinitions>
         <TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
-        <TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" IsHitTestVisible="False"
+        <TextBlock x:Name="LabSubtitle" Grid.Column="1" HorizontalAlignment="Left"
+            TextTrimming="CharacterEllipsis" FontSize="12" IsHitTestVisible="False" 
             Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
         <!-- 更新按钮 -->
-        <local:MyIconButton Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
+        <local:MyIconButton Grid.Column="2"
+            Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
             ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9" 
             Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
-    </StackPanel>
-    <!--<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
-        <Grid.ColumnDefinitions>
-            <ColumnDefinition Width="Auto" />
-            <ColumnDefinition Width="1*" />
-            <ColumnDefinition Width="Auto" />
-        </Grid.ColumnDefinitions>
-        <TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Grid.Column="0" />
-        <TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Grid.Column="1" 
-                   Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
-        <local:MyIconTextButton Grid.Column="2" Text="更新" />
-    </Grid>-->
+    </Grid>
     <!-- Tag 与 详情 -->
     <StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False">
         <!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">

+ 23 - 15
Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb

@@ -14,6 +14,7 @@ Public Class MyLocalModItem
         Set(value As String)
             If _Logo = value OrElse value Is Nothing Then Exit Property
             _Logo = value
+            If ModeDebug AndAlso Not _Logo = PathImage & "Icons/NoIcon.png" Then Log($"[LocalModItem] Mod {Title} 的图标:{value}")
             Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
             Try
                 If _Logo.StartsWithF("http", True) Then
@@ -52,17 +53,11 @@ RetryStart:
         Try
             'CurseForge 图片使用缩略图
             Dim Url As String = _Logo
-            If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
-                Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
+            If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
+                Url = Url.Replace("/256/256/", "/64/64/")
             End If
             '下载图片
             NetDownload(Url, LocalFileAddress & DownloadEnd, True)
-            If Url.EndsWithF("webp") Then
-                Log($"[Comp] Webp 格式转换:{LocalFileAddress}")
-                Dim dec = New Imazen.WebP.SimpleDecoder()
-                Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
-                dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
-            End If
             Dim LoadError As Exception = Nothing
             RunInUiWait(
             Sub()
@@ -107,7 +102,7 @@ RetryStart:
                     LabTitle.TextDecorations = Nothing
                 Case McMod.McModState.Disabled
                     LabTitle.TextDecorations = TextDecorations.Strikethrough
-                Case McMod.McModState.Unavaliable
+                Case McMod.McModState.Unavailable
                     LabTitle.TextDecorations = TextDecorations.Strikethrough
                     value &= " [错误]"
             End Select
@@ -120,12 +115,12 @@ RetryStart:
     '副标题
     Public Property SubTitle As String
         Get
-            Return If(LabTitleRaw?.Text, "")
+            Return If(LabSubtitle?.Text, "")
         End Get
         Set(value As String)
-            If LabTitleRaw.Text = value Then Exit Property
-            LabTitleRaw.Text = value
-            LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
+            If LabSubtitle.Text = value Then Exit Property
+            LabSubtitle.Text = value
+            LabSubtitle.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
         End Set
     End Property
 
@@ -430,7 +425,7 @@ RetryStart:
                     NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path)
                 Case McMod.McModState.Disabled
                     NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
-                Case Else 'McMod.McModState.Unavaliable
+                Case Else 'McMod.McModState.Unavailable
                     NewDescription = GetFileNameFromPath(Entry.Path)
             End Select
             If Entry.Comp IsNot Nothing Then
@@ -461,7 +456,7 @@ RetryStart:
                     '<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1"
                     '       Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False"
                     '       HorizontalAlignment="Right" VerticalAlignment="Bottom"
-                    '       Source="/Images/Icons/Unavaliable.png" />
+                    '       Source="/Images/Icons/Unavailable.png" />
                 End If
                 ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
             End If
@@ -538,4 +533,17 @@ RetryStart:
         FrmVersionMod.UpdateMods({Entry})
     End Sub
 
+    '自适应(#4465)
+    Private Sub PanTitle_SizeChanged(sender As Object, e As SizeChangedEventArgs) Handles PanTitle.SizeChanged
+        If ColumnExtend.Width.IsStar AndAlso ColumnExtend.ActualWidth < 0.5 Then
+            '压缩 Subtitle
+            ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star)
+            ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
+        ElseIf Not ColumnExtend.Width.IsStar AndAlso ColumnSubtitle.ActualWidth > LabSubtitle.ActualWidth + 10 Then
+            '向右展开 Subtitle
+            ColumnSubtitle.Width = GridLength.Auto
+            ColumnExtend.Width = New GridLength(1, GridUnitType.Star)
+        End If
+    End Sub
+
 End Class

+ 17 - 12
Plain Craft Launcher 2/Modules/ModMain.vb

@@ -69,14 +69,14 @@ Public Module ModMain
                 Dim Percent As Double = 0.3
                 Select Case CurrentHint.Type
                     Case HintType.Info
-                        TargetColor0 = New MyColor(37, 155, 252)
-                        TargetColor1 = New MyColor(10, 142, 252)
+                        TargetColor0 = New MyColor(215, 37, 155, 252)
+                        TargetColor1 = New MyColor(215, 10, 142, 252)
                     Case HintType.Finish
-                        TargetColor0 = New MyColor(33, 177, 33)
-                        TargetColor1 = New MyColor(29, 160, 29)
+                        TargetColor0 = New MyColor(215, 33, 177, 33)
+                        TargetColor1 = New MyColor(215, 29, 160, 29)
                     Case Else 'HintType.Critical
-                        TargetColor0 = New MyColor(255, 53, 11)
-                        TargetColor1 = New MyColor(255, 43, 0)
+                        TargetColor0 = New MyColor(215, 255, 53, 11)
+                        TargetColor1 = New MyColor(215, 255, 43, 0)
                 End Select
                 If Not IsNothing(DoubleStack) Then
                     '有重复提示,且该提示的进入动画已播放
@@ -176,15 +176,17 @@ EndHint:
         Public Title As String
         Public Text As String
         ''' <summary>
-        ''' 输入框模式:文本框的文本;选择模式:需要放进去的 List(Of MyListItem)。
+        ''' 输入模式:文本框的文本。
+        ''' 选择模式:需要放进去的 List(Of MyListItem)。
+        ''' 登录模式:登录步骤 1 中返回的 JSON。
         ''' </summary>
         Public Content As Object
         ''' <summary>
-        ''' 仅输入框模式:输入验证规则。
+        ''' 输入模式:输入验证规则。
         ''' </summary>
         Public ValidateRules As ObjectModel.Collection(Of Validate)
         ''' <summary>
-        ''' 仅输入框模式:提示文本。
+        ''' 输入模式:提示文本。
         ''' </summary>
         Public HintText As String = ""
         ''' <summary>
@@ -214,7 +216,9 @@ EndHint:
         ''' </summary>
         Public IsExited As Boolean = False
         ''' <summary>
-        ''' 点击的按钮编号或输入的文本。若输入弹窗点击了非第一个按钮,则为 Nothing。
+        ''' 输入模式:输入的文本。若点击了 非 第一个按钮,则为 Nothing。
+        ''' 选择模式:点击的按钮编号,从 1 开始。
+        ''' 登录模式:字符串数组 {AccessToken, RefreshToken} 或一个 Exception。
         ''' </summary>
         Public Result As Object
     End Class
@@ -222,6 +226,7 @@ EndHint:
         Text
         [Select]
         Input
+        Login
     End Enum
 
     ''' <summary>
@@ -352,6 +357,8 @@ EndHint:
                         FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0)))
                     Case MyMsgBoxType.Text
                         FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0)))
+                    Case MyMsgBoxType.Login
+                        FrmMain.PanMsg.Children.Add(New MyMsgLogin(WaitingMyMsgBox(0)))
                 End Select
                 WaitingMyMsgBox.RemoveAt(0)
             Else
@@ -798,8 +805,6 @@ NextFile:
     Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer
     Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean
 
-    Public Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
-
 #End Region
 
     Public DragControl = Nothing

+ 1 - 1
Plain Craft Launcher 2/Modules/ModSecret.vb

@@ -8,7 +8,7 @@ Friend Module ModSecret
 
 #Region "杂项"
 
-    '在开源内容的注册表键与普通内容的注册表键隔离
+    '在开源版的注册表与常规版的注册表隔离,以防数据冲突
     Public Const RegFolder As String = "PCLDebug"
     '用于微软登录的 ClientId
     Public Const OAuthClientId As String = ""

+ 2 - 2
Plain Craft Launcher 2/My Project/AssemblyInfo.vb

@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
 ' 方法是按如下所示使用“*”
 
-<Assembly: AssemblyVersion("2.8.6.0")>
-<Assembly: AssemblyFileVersion("2.8.6.0")>
+<Assembly: AssemblyVersion("2.8.7.0")>
+<Assembly: AssemblyFileVersion("2.8.7.0")>
 <Assembly: NeutralResourcesLanguage("")>

+ 6 - 16
Plain Craft Launcher 2/My Project/Resources.Designer.vb

@@ -103,9 +103,9 @@ Namespace My.Resources
         '''<summary>
         '''  查找 System.Byte[] 类型的本地化资源。
         '''</summary>
-        Friend ReadOnly Property JavaWrapper() As Byte()
+        Friend ReadOnly Property Imazen_WebP() As Byte()
             Get
-                Dim obj As Object = ResourceManager.GetObject("JavaWrapper", resourceCulture)
+                Dim obj As Object = ResourceManager.GetObject("Imazen_WebP", resourceCulture)
                 Return CType(obj,Byte())
             End Get
         End Property
@@ -113,9 +113,9 @@ Namespace My.Resources
         '''<summary>
         '''  查找 System.Byte[] 类型的本地化资源。
         '''</summary>
-        Friend ReadOnly Property Json() As Byte()
+        Friend ReadOnly Property JavaWrapper() As Byte()
             Get
-                Dim obj As Object = ResourceManager.GetObject("Json", resourceCulture)
+                Dim obj As Object = ResourceManager.GetObject("JavaWrapper", resourceCulture)
                 Return CType(obj,Byte())
             End Get
         End Property
@@ -123,9 +123,9 @@ Namespace My.Resources
         '''<summary>
         '''  查找 System.Byte[] 类型的本地化资源。
         '''</summary>
-        Friend ReadOnly Property libwebp32() As Byte()
+        Friend ReadOnly Property Json() As Byte()
             Get
-                Dim obj As Object = ResourceManager.GetObject("libwebp32", resourceCulture)
+                Dim obj As Object = ResourceManager.GetObject("Json", resourceCulture)
                 Return CType(obj,Byte())
             End Get
         End Property
@@ -169,15 +169,5 @@ Namespace My.Resources
                 Return CType(obj,Byte())
             End Get
         End Property
-        
-        '''<summary>
-        '''  查找 System.Byte[] 类型的本地化资源。
-        '''</summary>
-        Friend ReadOnly Property WebP() As Byte()
-            Get
-                Dim obj As Object = ResourceManager.GetObject("WebP", resourceCulture)
-                Return CType(obj,Byte())
-            End Get
-        End Property
     End Module
 End Namespace

+ 3 - 6
Plain Craft Launcher 2/My Project/Resources.resx

@@ -130,15 +130,15 @@
   <data name="Help" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\Help.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
+  <data name="Imazen_WebP" type="System.Resources.ResXFileRef, System.Windows.Forms">
+    <value>..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
+  </data>
   <data name="JavaWrapper" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\java-wrapper.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
   <data name="Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
-  <data name="libwebp32" type="System.Resources.ResXFileRef, System.Windows.Forms">
-    <value>..\Resources\libwebp32.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
-  </data>
   <data name="libwebp64" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\libwebp64.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
@@ -151,7 +151,4 @@
   <data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
   </data>
-  <data name="WebP" type="System.Resources.ResXFileRef, System.Windows.Forms">
-    <value>..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
-  </data>
 </root>

+ 8 - 8
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb

@@ -28,7 +28,7 @@ Public Module ModDownloadLib
             Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\"
 
             '重复任务检查
-            For Each OngoingLoader In LoaderTaskbar
+            For Each OngoingLoader In LoaderTaskbar.ToList()
                 If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
                 If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return OngoingLoader
                 Hint("该版本正在下载中!", HintType.Critical)
@@ -71,7 +71,7 @@ Public Module ModDownloadLib
             VersionFolder = VersionFolder & Id & "\"
 
             '重复任务检查
-            For Each OngoingLoader In LoaderTaskbar
+            For Each OngoingLoader In LoaderTaskbar.ToList()
                 If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
                 If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Exit Sub
                 Hint("该版本正在下载中!", HintType.Critical)
@@ -155,7 +155,7 @@ Public Module ModDownloadLib
         LoadersAssets.Add(New LoaderDownload("下载资源文件索引(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 3, .Show = False})
         LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析所需资源文件(副加载器)",
         Sub(Task As LoaderTask(Of String, List(Of NetFile)))
-            Task.Output = McAssetsFixList(McAssetsGetIndexName(New McVersion(VersionFolder)), True, Task)
+            Task.Output = McAssetsFixList(New McVersion(VersionFolder), True, Task)
         End Sub) With {.ProgressWeight = 3, .Show = False})
         LoadersAssets.Add(New LoaderDownload("下载资源文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 14, .Show = False})
         Loaders.Add(New LoaderCombo(Of String)("下载原版资源文件", LoadersAssets) With {.Block = False, .ProgressWeight = 21})
@@ -317,7 +317,7 @@ Public Module ModDownloadLib
             If Not Target.Contains("\") Then Exit Sub
 
             '重复任务检查
-            For Each OngoingLoader In LoaderTaskbar
+            For Each OngoingLoader In LoaderTaskbar.ToList()
                 If OngoingLoader.Name <> $"OptiFine {DownloadInfo.NameDisplay} 下载" Then Continue For
                 Hint("该版本正在下载中!", HintType.Critical)
                 Exit Sub
@@ -744,7 +744,7 @@ Retry:
             Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
 
             '重复任务检查
-            For Each OngoingLoader In LoaderTaskbar
+            For Each OngoingLoader In LoaderTaskbar.ToList()
                 If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
                 Hint("该版本正在下载中!", HintType.Critical)
                 Exit Sub
@@ -778,7 +778,7 @@ Retry:
             If Not Target.Contains("\") Then Exit Sub
 
             '重复任务检查
-            For Each OngoingLoader In LoaderTaskbar
+            For Each OngoingLoader In LoaderTaskbar.ToList()
                 If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
                 Hint("该版本正在下载中!", HintType.Critical)
                 Exit Sub
@@ -960,7 +960,7 @@ Retry:
             If Not Target.Contains("\") Then Exit Sub
 
             '重复任务检查
-            For Each OngoingLoader In LoaderTaskbar
+            For Each OngoingLoader In LoaderTaskbar.ToList()
                 If OngoingLoader.Name <> $"{DisplayName} 下载" Then Continue For
                 Hint("该版本正在下载中!", HintType.Critical)
                 Exit Sub
@@ -1714,7 +1714,7 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
             If Not Target.Contains("\") Then Exit Sub
 
             '重复任务检查
-            For Each OngoingLoader In LoaderTaskbar
+            For Each OngoingLoader In LoaderTaskbar.ToList()
                 If OngoingLoader.Name <> $"Fabric {Version} 安装器下载" Then Continue For
                 Hint("该版本正在下载中!", HintType.Critical)
                 Exit Sub

+ 40 - 0
Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml

@@ -0,0 +1,40 @@
+<Grid x:Class="MyMsgLogin"
+             xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
+             xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
+             xmlns:my="clr-namespace:PCL"
+             RenderTransformOrigin="0,0.5" UseLayoutRounding="True" SnapsToDevicePixels="True" MinWidth="400" HorizontalAlignment="Center" VerticalAlignment="Center" Margin="25">
+    <Grid.RenderTransform>
+        <TransformGroup>
+            <RotateTransform x:Name="TransformRotate" Angle="-4" />
+            <TranslateTransform x:Name="TransformPos" X="0" Y="40" />
+        </TransformGroup>
+    </Grid.RenderTransform>
+    <Border Name="PanBorder" CornerRadius="7" Background="#FBFBFB">
+        <Border.Effect>
+            <DropShadowEffect Color="{DynamicResource ColorObject1}" BlurRadius="20" ShadowDepth="4" RenderingBias="Performance" Opacity="0.8" x:Name="EffectShadow" />
+        </Border.Effect>
+        <Grid Name="PanMain" VerticalAlignment="Top" Margin="22,22,22,23">
+            <Grid.RowDefinitions>
+                <RowDefinition Height="Auto" />
+                <RowDefinition Height="2" />
+                <RowDefinition Height="13" />
+                <RowDefinition Height="1*" />
+                <RowDefinition Height="Auto" />
+            </Grid.RowDefinitions>
+            <TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
+            <Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" />
+            <my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanCaption" Margin="0,0,0,17" Padding="7,0,15,0"
+                               VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMuity="0.7">
+                <TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabCaption" FontSize="15" LineHeight="18"
+                           Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" />
+            </my:MyScrollViewer>
+            <StackPanel Grid.Row="4" Name="PanBtn" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,8,0" Orientation="Horizontal">
+                <my:MyButton ColorType="Normal" x:FieldModifier="public" Text="重新打开网页" x:Name="Btn1" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False"
+                             EventType="打开网页" />
+                <my:MyButton ColorType="Normal" x:FieldModifier="public" Text="复制代码" x:Name="Btn2" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False"
+                             EventType="复制文本" />
+                <my:MyButton ColorType="Normal" x:FieldModifier="public" Text="取消" x:Name="Btn3" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False" />
+            </StackPanel>
+        </Grid>
+    </Border>
+</Grid>

+ 139 - 0
Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml.vb

@@ -0,0 +1,139 @@
+Public Class MyMsgLogin
+    Private Data As JObject
+    Private UserCode As String '需要用户在网页上输入的设备代码
+    Private DeviceCode As String '用于轮询的设备代码
+    Private Website As String '验证网页的网址
+
+#Region "弹窗"
+
+    Private ReadOnly MyConverter As MyMsgBoxConverter
+    Private ReadOnly Uuid As Integer = GetUuid()
+
+    Public Sub New(Converter As MyMsgBoxConverter)
+        Try
+            InitializeComponent()
+            Btn1.Name = Btn1.Name & GetUuid()
+            Btn2.Name = Btn2.Name & GetUuid()
+            Btn3.Name = Btn3.Name & GetUuid()
+            MyConverter = Converter
+            ShapeLine.StrokeThickness = GetWPFSize(1)
+            Data = Converter.Content
+            Init()
+        Catch ex As Exception
+            Log(ex, "登录弹窗初始化失败", LogLevel.Hint)
+        End Try
+    End Sub
+
+    Private Sub Load(sender As Object, e As EventArgs) Handles MyBase.Loaded
+        Try
+            '动画
+            Opacity = 0
+            AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, If(MyConverter.IsWarn, New MyColor(140, 80, 0, 0), New MyColor(90, 0, 0, 0)) - FrmMain.PanMsg.Background, 200), "PanMsg Background")
+            AniStart({
+                AaOpacity(Me, 1, 120, 60),
+                AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 300, 60, New AniEaseOutBack(AniEasePower.Weak)),
+                AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
+            }, "MyMsgBox " & Uuid)
+            '记录日志
+            Log("[Control] 登录弹窗:" & LabTitle.Text & vbCrLf & LabCaption.Text)
+        Catch ex As Exception
+            Log(ex, "登录弹窗加载失败", LogLevel.Hint)
+        End Try
+    End Sub
+    Private Sub Close()
+        '动画
+        AniStart({
+            AaCode(
+            Sub()
+                If Not WaitingMyMsgBox.Any() Then
+                    AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
+                End If
+            End Sub, 30),
+            AaOpacity(Me, -Opacity, 80, 20),
+            AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
+            AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
+            AaCode(Sub() CType(Parent, Grid).Children.Remove(Me), , True)
+        }, "MyMsgBox " & Uuid)
+    End Sub
+
+    Public Sub Btn3_Click() Handles Btn3.Click
+        Finished(New ThreadInterruptedException)
+    End Sub
+
+    Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown
+        On Error Resume Next
+        If e.GetPosition(ShapeLine).Y <= 2 Then FrmMain.DragMove()
+    End Sub
+
+#End Region
+
+    Private Sub Finished(Result As Object)
+        If MyConverter.IsExited Then Return
+        MyConverter.IsExited = True
+        MyConverter.Result = Result
+        RunInUi(AddressOf Close)
+        Thread.Sleep(200)
+        FrmMain.ShowWindowToTop()
+    End Sub
+
+    Private Sub Init()
+        UserCode = Data("user_code")
+        DeviceCode = Data("device_code")
+        Website = Data("verification_uri")
+        '设置 UI
+        LabTitle.Text = "登录 Minecraft"
+        LabCaption.Text =
+            $"登录网页将自动开启,请在网页中输入 {UserCode}(已自动复制)。" & vbCrLf & vbCrLf &
+            $"如果网络环境不佳,网页可能一直加载不出来,届时请使用 VPN 并重试。" & vbCrLf &
+            $"你也可以用其他设备打开 {Website} 并输入上述代码。"
+        Btn1.EventData = Website
+        Btn2.EventData = UserCode
+        '启动工作线程
+        RunInNewThread(AddressOf WorkThread, "MyMsgLogin")
+    End Sub
+
+    Private Sub WorkThread()
+        Thread.Sleep(4000)
+        If MyConverter.IsExited Then Exit Sub
+        OpenWebsite(Website)
+        ClipboardSet(UserCode)
+        Thread.Sleep((Data("interval").ToObject(Of Integer) - 1) * 1000)
+        '轮询
+        Dim UnknownFailureCount As Integer = 0
+        Do While Not MyConverter.IsExited
+            Try
+                Dim Result = NetRequestOnce(
+                    "https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST",
+                    "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
+                    "client_id=" & OAuthClientId & "&" &
+                    "device_code=" & DeviceCode & "&" &
+                    "scope=XboxLive.signin%20offline_access",
+                    "application/x-www-form-urlencoded", 5000 + UnknownFailureCount * 5000, MakeLog:=False)
+                '获取结果
+                Dim ResultJson As JObject = GetJson(Result)
+                McLaunchLog($"令牌过期时间:{ResultJson("expires_in")} 秒")
+                Hint("网页登录成功!", HintType.Finish)
+                Finished({ResultJson("access_token").ToString, ResultJson("refresh_token").ToString})
+                Return
+            Catch ex As Exception
+                If ex.Message.Contains("authorization_declined") Then
+                    Finished(New Exception("$你拒绝了 PCL 申请的权限……"))
+                    Return
+                ElseIf ex.Message.Contains("expired_token") Then
+                    Finished(New Exception("$登录用时太长啦,重新试试吧!"))
+                    Return
+                ElseIf ex.Message.Contains("authorization_pending") Then
+                    Thread.Sleep(1000)
+                ElseIf UnknownFailureCount <= 2 Then
+                    UnknownFailureCount += 1
+                    Log(ex, $"登录轮询第 {UnknownFailureCount} 次失败")
+                    Thread.Sleep(1000)
+                Else
+                    Finished(New Exception("登录轮询失败", ex))
+                    Return
+                End If
+            End Try
+        Loop
+    End Sub
+
+End Class

+ 2 - 2
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb

@@ -130,7 +130,7 @@
         '初始化页面
         LabLaunchingName.Text = McVersionCurrent.Name
         LabLaunchingStage.Text = "初始化"
-        LabLaunchingTitle.Text = If(McLaunchLoader.Input Is Nothing OrElse McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")
+        LabLaunchingTitle.Text = If(CurrentLaunchOptions?.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")
         LabLaunchingProgress.Text = "0.00 %"
         LabLaunchingProgress.Opacity = 1
         LabLaunchingDownload.Visibility = Visibility.Visible
@@ -733,7 +733,7 @@ ExitRefresh:
             If ActualProgress <= ShowProgress Then ShowProgress = ActualProgress '原来或处理后变得比实际进度高,直接回退
             If IsLaunched Then ShowProgress = 1 '如果已经完成了,就不卖关子了
             '文本
-            LabLaunchingTitle.Text = If(IsLaunched, "已启动游戏", If(McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本"))
+            LabLaunchingTitle.Text = If(IsLaunched, "已启动游戏", If(CurrentLaunchOptions.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本"))
             LabLaunchingProgress.Text = StrFillNum(ShowProgress * 100, 2) & " %"
             Dim HasLaunchDownloader As Boolean = False
             Try

+ 4 - 0
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb

@@ -106,6 +106,10 @@ Download:
                         Log("[Page] 主页预设:OpenBMCLAPI 仪表盘 Lite")
                         Url = "https://pcl-bmcl.milulu.xyz/"
                         GoTo Download
+                    Case 7
+                        Log("[Page] 主页预设:主页市场")
+                        Url = "https://homepage-market.pages.dev/Custom.xaml"
+                        GoTo Download
                 End Select
         End Select
         RunInUi(Sub() LoadContent(Content))

+ 10 - 0
Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml

@@ -228,6 +228,8 @@
                         <RowDefinition Height="Auto" />
                         <RowDefinition Height="60" />
                         <RowDefinition Height="Auto" />
+                        <RowDefinition Height="60" />
+                        <RowDefinition Height="Auto" />
                     </Grid.RowDefinitions>
                     <TextBlock Grid.Row="0" Grid.Column="0" Text="Java Launch Wrapper" TextWrapping="Wrap" FontWeight="Bold" />
                     <TextBlock Grid.Row="0" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © 2022 00ll00&#xa;Licensed under the MIT License." TextWrapping="Wrap" />
@@ -268,6 +270,14 @@
                     <TextBlock Grid.Row="10" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © ALIMAMA MUX, powered by alimama THX." TextWrapping="Wrap" />
                     <local:MyButton Grid.Row="11" Grid.Column="2" MinWidth="140" Text="查看原网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
                                     EventType="打开网页" EventData="https://www.iconfont.cn/" />
+
+                    <TextBlock Grid.Row="12" Grid.Column="0" Text="libwebp wrapper for .NET" TextWrapping="Wrap" FontWeight="Bold" />
+                    <TextBlock Grid.Row="12" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © 2012 Imazen&#xa;Licensed under the MIT License." TextWrapping="Wrap" />
+                    <local:MyButton Grid.Row="13" Grid.Column="2" MinWidth="140" Text="查看来源网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
+                                    EventType="打开网页" EventData="https://github.com/imazen/libwebp-net" />
+                    <local:MyButton Grid.Row="13" Grid.Column="3" MinWidth="140" Text="查看许可文档" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
+                                    EventType="打开网页" EventData="https://github.com/imazen/libwebp-net/blob/master/LICENSE.txt" />
+
                 </Grid>
             </local:MyCard>
         </StackPanel>

+ 19 - 1
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb

@@ -321,6 +321,11 @@
     ''' 获取当前设置的 RAM 值。单位为 GB。
     ''' </summary>
     Public Shared Function GetRam(Version As McVersion, UseVersionJavaSetup As Boolean, Optional Is32BitJava As Boolean? = Nothing) As Double
+
+        '------------------------------------------
+        ' 修改下方代码时需要一并修改 PageVersionSetup
+        '------------------------------------------
+
         Dim RamGive As Double
         If Setup.Get("LaunchRamType") = 0 Then
             '自动配置
@@ -507,7 +512,7 @@ PreFin:
 
 #End Region
 
-#Region "启动参数"
+#Region "其他选项"
 
     Private Sub WindowTypeUIRefresh() Handles ComboArgumentWindowType.SelectionChanged
         If ComboArgumentWindowType Is Nothing Then Exit Sub
@@ -545,6 +550,19 @@ PreFin:
         End If
     End Sub
 
+    '版本隔离警告
+    Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged
+        If AniControlEnabled <> 0 Then Exit Sub
+        If MyMsgBox("调整版本隔离后,你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf &
+                    "如果修改后发现存档消失,把这项设置改回来就能恢复。" & vbCrLf &
+                    "如果你不会迁移存档,不建议修改这项设置!",
+                    "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
+            AniControlEnabled += 1
+            ComboArgumentIndie.SelectedItem = e.RemovedItems(0)
+            AniControlEnabled -= 1
+        End If
+    End Sub
+
 #End Region
 
 #Region "高级设置"

+ 14 - 16
Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb

@@ -170,26 +170,24 @@
     End Sub
 
     '自动更新
-    Private Sub ComboSystemActivity_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemActivity.SelectionChanged
+    Private Sub ComboSystemActivity_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemActivity.SelectionChanged
         If AniControlEnabled <> 0 Then Exit Sub
-        If ComboSystemActivity.SelectedIndex = 2 Then
-            If MyMsgBox("若选择此项,即使在将来出现严重问题时,你也无法获取相关通知。" & vbCrLf &
-                        "例如,如果发现某个版本游戏存在严重 Bug,你可能就会因为无法得到通知而导致无法预知的后果。" & vbCrLf & vbCrLf &
-                        "一般选择 仅在有重要通知时显示公告 就可以让你尽量不受打扰了。" & vbCrLf &
-                        "除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
-                ComboSystemActivity.SelectedItem = e.RemovedItems(0)
-            End If
+        If ComboSystemActivity.SelectedIndex <> 2 Then Exit Sub
+        If MyMsgBox("若选择此项,即使在将来出现严重问题时,你也无法获取相关通知。" & vbCrLf &
+                    "例如,如果发现某个版本游戏存在严重 Bug,你可能就会因为无法得到通知而导致无法预知的后果。" & vbCrLf & vbCrLf &
+                    "一般选择 仅在有重要通知时显示公告 就可以让你尽量不受打扰了。" & vbCrLf &
+                    "除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
+            ComboSystemActivity.SelectedItem = e.RemovedItems(0)
         End If
     End Sub
-    Private Sub ComboSystemUpdate_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemUpdate.SelectionChanged
+    Private Sub ComboSystemUpdate_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemUpdate.SelectionChanged
         If AniControlEnabled <> 0 Then Exit Sub
-        If ComboSystemUpdate.SelectedIndex = 3 Then
-            If MyMsgBox("若选择此项,即使在启动器将来出现严重问题时,你也无法获取更新并获得修复。" & vbCrLf &
-                        "例如,如果官方修改了登录方式,从而导致现有启动器无法登录,你可能就会因为无法更新而无法开始游戏。" & vbCrLf & vbCrLf &
-                        "一般选择 仅在有重大漏洞更新时显示提示 就可以让你尽量不受打扰了。" & vbCrLf &
-                        "除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
-                ComboSystemUpdate.SelectedItem = e.RemovedItems(0)
-            End If
+        If ComboSystemUpdate.SelectedIndex <> 3 Then Exit Sub
+        If MyMsgBox("若选择此项,即使在启动器将来出现严重问题时,你也无法获取更新并获得修复。" & vbCrLf &
+                    "例如,如果官方修改了登录方式,从而导致现有启动器无法登录,你可能就会因为无法更新而无法开始游戏。" & vbCrLf & vbCrLf &
+                    "一般选择 仅在有重大漏洞更新时显示提示 就可以让你尽量不受打扰了。" & vbCrLf &
+                    "除非你在制作服务器整合包,或时常手动更新启动器,否则极度不推荐选择此项!", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
+            ComboSystemUpdate.SelectedItem = e.RemovedItems(0)
         End If
     End Sub
     Private Sub BtnSystemUpdate_Click(sender As Object, e As EventArgs) Handles BtnSystemUpdate.Click

+ 1 - 0
Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml

@@ -243,6 +243,7 @@
                             <local:MyComboBoxItem Content="每日整合包推荐(作者:wkea)" />
                             <local:MyComboBoxItem Content="Minecraft 皮肤推荐(作者:wkea)" />
                             <local:MyComboBoxItem Content="OpenBMCLAPI 仪表盘 Lite(作者:Silverteal、Mxmilu666)" />
+                            <local:MyComboBoxItem Content="PCL 主页市场(作者:凌云)" />
                         </local:MyComboBox>
                     </Grid>
                 </StackPanel>

+ 1 - 1
Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb

@@ -662,7 +662,7 @@ Refresh:
 
 #End Region
 
-    '公开预览版
+    '赞助
     Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click
         OpenWebsite("https://afdian.com/a/LTCat")
     End Sub

+ 9 - 13
Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb

@@ -92,15 +92,12 @@ Public Class PageSpeedLeft
                             Card.Children.Add(GetObjectFromXML("<Path xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" Stretch=""Uniform"" Tag=""Failed"" Data=""F1 M2.5,0 L0,2.5 7.5,10 0,17.5 2.5,20 10,12.5 17.5,20 20,17.5 12.5,10 20,2.5 17.5,0 10,7.5 2.5,0Z"" Height=""15"" Width=""15"" HorizontalAlignment=""Center"" Grid.Column=""0"" Grid.Row=""0"" Fill=""{DynamicResource ColorBrush3}"" Margin=""0,1,0,0"" VerticalAlignment=""Top""/>"))
                             Dim Tb As TextBlock = GetObjectFromXML("<TextBlock xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" TextWrapping=""Wrap"" HorizontalAlignment=""Left"" ToolTip=""单击复制错误详情"" Grid.Column=""1"" Grid.Row=""0"" Margin=""0,0,0,5"" />")
                             Tb.Text = GetExceptionDetail(Loader.Error)
-                            AddHandler Tb.MouseLeftButtonDown, Sub(sender As TextBlock, e As EventArgs)
-                                                                   ClipboardSet(sender.Text, False)
-                                                                   Hint("已复制错误详情!", HintType.Finish)
-                                                               End Sub
+                            AddHandler Tb.MouseLeftButtonDown,
+                            Sub(sender As TextBlock, e As EventArgs)
+                                ClipboardSet(sender.Text, False)
+                                Hint("已复制错误详情!", HintType.Finish)
+                            End Sub
                             Card.Children.Add(Tb)
-                            ''删除取消按钮
-                            'For Each Element As FrameworkElement In CType(Card.Parent, Panel).Children
-                            '    If Element.Name = "BtnCancel" Then AniDispose(CType(Element, MyIconButton), True)
-                            'Next
 #End Region
                         Case LoadState.Finished
 #Region "完成,销毁卡片并返回"
@@ -195,11 +192,10 @@ Public Class PageSpeedLeft
                     Sub(sender As MyIconButton, e As EventArgs)
                         AniDispose(sender, False)
                         AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack())
-                        Dim LoaderName = If(Loader Is Nothing, "null", Loader.Name)
-                        RightCards.Remove(LoaderName)
-                        LoaderTaskbar.TryTake(Loader)
-                        Log($"[Taskbar] 关闭下载管理卡片:{LoaderName},且移出任务列表")
-                        RunInThread(Sub() Loader?.Abort())
+                        RightCards.Remove(Loader.Name)
+                        LoaderTaskbar.Remove(Loader)
+                        Log($"[Taskbar] 关闭下载管理卡片:{Loader.Name},且移出任务列表")
+                        RunInThread(Sub() Loader.Abort())
                     End Sub
                     '如果已经失败,再刷新一次,修改成失败的控件
                     If Loader.State = LoadState.Failed Then

+ 17 - 16
Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb

@@ -121,7 +121,7 @@
         ToolTipService.SetVerticalOffset(BtnED, 30)
         ToolTipService.SetHorizontalOffset(BtnED, 2)
         AddHandler BtnED.Click, AddressOf ED_Click
-        If sender.Entry.State = McMod.McModState.Unavaliable Then
+        If sender.Entry.State = McMod.McModState.Unavailable Then
             sender.Buttons = {BtnCont, BtnOpen, BtnDelete}
         Else
             sender.Buttons = {BtnCont, BtnOpen, BtnED, BtnDelete}
@@ -171,22 +171,18 @@
             If ModItem.CanUpdate Then UpdateCount += 1
             If ModItem.State.Equals(McMod.McModState.Fine) Then EnabledCount += 1
             If ModItem.State.Equals(McMod.McModState.Disabled) Then DisabledCount += 1
-            If ModItem.State.Equals(McMod.McModState.Unavaliable) Then UnavalialeCount += 1
+            If ModItem.State.Equals(McMod.McModState.Unavailable) Then UnavalialeCount += 1
         Next
         '显示
         BtnFilterAll.Text = If(IsSearching, "搜索结果", "全部") & $" ({AnyCount})"
         BtnFilterCanUpdate.Text = $"可更新 ({UpdateCount})"
-        BtnFilterCanUpdate.Visibility = If(Filter = FilterType.CanUpdate OrElse
-            UpdateCount > 0, Visibility.Visible, Visibility.Collapsed)
+        BtnFilterCanUpdate.Visibility = If(Filter = FilterType.CanUpdate OrElse UpdateCount > 0, Visibility.Visible, Visibility.Collapsed)
         BtnFilterEnabled.Text = $"启用 ({EnabledCount})"
-        BtnFilterEnabled.Visibility = If(Filter = FilterType.Enabled OrElse Filter = FilterType.Disabled OrElse
-            EnabledCount > 0 AndAlso EnabledCount <> AnyCount, Visibility.Visible, Visibility.Collapsed)
+        BtnFilterEnabled.Visibility = If(Filter = FilterType.Enabled OrElse (EnabledCount > 0 AndAlso EnabledCount < AnyCount), Visibility.Visible, Visibility.Collapsed)
         BtnFilterDisabled.Text = $"禁用 ({DisabledCount})"
-        BtnFilterDisabled.Visibility = If(Filter = FilterType.Enabled OrElse Filter = FilterType.Disabled OrElse
-            DisabledCount > 0, Visibility.Visible, Visibility.Collapsed)
+        BtnFilterDisabled.Visibility = If(Filter = FilterType.Disabled OrElse DisabledCount > 0, Visibility.Visible, Visibility.Collapsed)
         BtnFilterError.Text = $"错误 ({UnavalialeCount})"
-        BtnFilterError.Visibility = If(Filter = FilterType.Unavaliable OrElse
-            UnavalialeCount > 0, Visibility.Visible, Visibility.Collapsed)
+        BtnFilterError.Visibility = If(Filter = FilterType.Unavailable OrElse UnavalialeCount > 0, Visibility.Visible, Visibility.Collapsed)
 
         '-----------------
         ' 底部栏
@@ -382,7 +378,7 @@
         Enabled = 1
         Disabled = 2
         CanUpdate = 3
-        Unavaliable = 4
+        Unavailable = 4
     End Enum
 
     ''' <summary>
@@ -406,8 +402,8 @@
                 Return CheckingMod.State = McMod.McModState.Disabled
             Case FilterType.CanUpdate
                 Return CheckingMod.CanUpdate
-            Case FilterType.Unavaliable
-                Return CheckingMod.State = McMod.McModState.Unavaliable
+            Case FilterType.Unavailable
+                Return CheckingMod.State = McMod.McModState.Unavailable
             Case Else
                 Return False
         End Select
@@ -492,7 +488,10 @@
 
     '更新
     Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click
-        UpdateMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate))
+        Dim UpdateList As List(Of McMod) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate).ToList()
+        If Not UpdateList.Any() Then Return
+        UpdateMods(UpdateList)
+        ChangeAllSelected(False)
     End Sub
     ''' <summary>
     ''' 记录正在进行 Mod 更新的 mods 文件夹路径。
@@ -583,6 +582,7 @@
                     Case Else
                         Exit Sub
                 End Select
+                Log($"[Mod] 已从正在进行 Mod 更新的文件夹列表移除:{PathMods}")
                 UpdatingVersions.Remove(PathMods)
                 '清理缓存
                 RunInNewThread(
@@ -597,7 +597,7 @@
                 End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal)
             End Sub
             '启动加载器
-            Log($"[Mod] 开始更新 {ModList.Count} 个 Mod")
+            Log($"[Mod] 开始更新 {ModList.Count} 个 Mod:{PathMods}")
             UpdatingVersions.Add(PathMods)
             Loader.Start()
             LoaderTaskbarAdd(Loader)
@@ -612,6 +612,7 @@
     '删除
     Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click
         DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)))
+        ChangeAllSelected(False)
     End Sub
     Private Sub DeleteMods(ModList As IEnumerable(Of McMod))
         Try
@@ -700,7 +701,7 @@
 
             Dim ModEntry As McMod = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry
             '加载失败信息
-            If ModEntry.State = McMod.McModState.Unavaliable Then
+            If ModEntry.State = McMod.McModState.Unavailable Then
                 MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息:" & GetExceptionDetail(ModEntry.FileUnavailableReason), "Mod 读取失败")
                 Return
             End If

+ 10 - 1
Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb

@@ -283,6 +283,15 @@
     '补全文件
     Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
         Try
+            '忽略文件检查提示
+            If ShouldIgnoreFileCheck(PageVersionLeft.Version) Then
+                If Setup.Get("LaunchAdvanceAssets") Then
+                    Hint("请先关闭 [设置 → 高级启动选项 → 关闭文件校验],然后再尝试补全文件!", HintType.Info)
+                Else
+                    Hint("请先关闭 [版本设置 → 设置 → 高级启动选项 → 关闭文件校验],然后再尝试补全文件!", HintType.Info)
+                End If
+                Exit Sub
+            End If
             '重复任务检查
             For Each OngoingLoader In LoaderTaskbar
                 If OngoingLoader.Name <> PageVersionLeft.Version.Name & " 文件补全" Then Continue For
@@ -290,7 +299,7 @@
                 Exit Sub
             Next
             '启动
-            Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False))
+            Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload))
             Loader.OnStateChanged =
             Sub()
                 Select Case Loader.State

+ 40 - 22
Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb

@@ -282,6 +282,11 @@
         If Setup.Get("VersionRamType", Version:=Version) = 2 Then
             Return PageSetupLaunch.GetRam(Version, True, Is32BitJava)
         End If
+
+        '------------------------------------------
+        ' 修改下方代码时需要一并修改 PageSetupLaunch
+        '------------------------------------------
+
         '使用当前版本的设置
         Dim RamGive As Double
         If Setup.Get("VersionRamType", Version:=Version) = 0 Then
@@ -297,19 +302,19 @@
                 '可安装 Mod 的版本
                 Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\")
                 Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0)
-                RamMininum = 0.4 + ModCount / 150
-                RamTarget1 = 1.5 + ModCount / 100
-                RamTarget2 = 3 + ModCount / 60
-                RamTarget3 = 6 + ModCount / 30
+                RamMininum = 0.5 + ModCount / 150
+                RamTarget1 = 1.5 + ModCount / 90
+                RamTarget2 = 2.7 + ModCount / 50
+                RamTarget3 = 4.5 + ModCount / 25
             ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then
                 'OptiFine 版本
-                RamMininum = 0.3
+                RamMininum = 0.5
                 RamTarget1 = 1.5
                 RamTarget2 = 3
-                RamTarget3 = 6
+                RamTarget3 = 5
             Else
                 '普通版本
-                RamMininum = 0.3
+                RamMininum = 0.5
                 RamTarget1 = 1.5
                 RamTarget2 = 2.5
                 RamTarget3 = 4
@@ -317,27 +322,23 @@
             Dim RamDelta As Double
             '预分配内存,阶段一,0 ~ T1,100%
             RamDelta = RamTarget1
-            RamAvailable = Math.Max(0, RamAvailable - 0.1)
-            RamGive += Math.Min(RamAvailable * 1, RamDelta)
-            RamAvailable -= RamDelta / 1 + 0.1
+            RamGive += Math.Min(RamAvailable, RamDelta)
+            RamAvailable -= RamDelta
             If RamAvailable < 0.1 Then GoTo PreFin
-            '预分配内存,阶段二,T1 ~ T2,80%
+            '预分配内存,阶段二,T1 ~ T2,70%
             RamDelta = RamTarget2 - RamTarget1
-            RamAvailable = Math.Max(0, RamAvailable - 0.1)
-            RamGive += Math.Min(RamAvailable * 0.8, RamDelta)
-            RamAvailable -= RamDelta / 0.8 + 0.1
+            RamGive += Math.Min(RamAvailable * 0.7, RamDelta)
+            RamAvailable -= RamDelta / 0.7
             If RamAvailable < 0.1 Then GoTo PreFin
-            '预分配内存,阶段三,T2 ~ T3,60%
+            '预分配内存,阶段三,T2 ~ T3,40%
             RamDelta = RamTarget3 - RamTarget2
-            RamAvailable = Math.Max(0, RamAvailable - 0.2)
-            RamGive += Math.Min(RamAvailable * 0.6, RamDelta)
-            RamAvailable -= RamDelta / 0.6 + 0.2
+            RamGive += Math.Min(RamAvailable * 0.4, RamDelta)
+            RamAvailable -= RamDelta / 0.4
             If RamAvailable < 0.1 Then GoTo PreFin
-            '预分配内存,阶段四,T3 ~ T3 * 2,40%
+            '预分配内存,阶段四,T3 ~ T3 * 2,15%
             RamDelta = RamTarget3
-            RamAvailable = Math.Max(0, RamAvailable - 0.3)
-            RamGive += Math.Min(RamAvailable * 0.4, RamDelta)
-            RamAvailable -= RamDelta / 0.4 + 0.3
+            RamGive += Math.Min(RamAvailable * 0.15, RamDelta)
+            RamAvailable -= RamDelta / 0.15
             If RamAvailable < 0.1 Then GoTo PreFin
 PreFin:
             '不低于最低值
@@ -484,6 +485,23 @@ PreFin:
 
 #End Region
 
+#Region "其他设置"
+
+    '版本隔离警告
+    Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged
+        If AniControlEnabled <> 0 Then Exit Sub
+        If MyMsgBox("调整版本隔离后,你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf &
+                    "如果修改后发现存档消失,把这项设置改回来就能恢复。" & vbCrLf &
+                    "如果你不会迁移存档,不建议修改这项设置!",
+                    "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
+            AniControlEnabled += 1
+            ComboArgumentIndie.SelectedItem = e.RemovedItems(0)
+            AniControlEnabled -= 1
+        End If
+    End Sub
+
+#End Region
+
 #Region "高级设置"
 
     Private Sub TextAdvanceRun_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextAdvanceRun.TextChanged

+ 19 - 24
Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj

@@ -143,6 +143,7 @@
     <Reference Include="Imazen.WebP, Version=10.0.1.0, Culture=neutral, processorArchitecture=MSIL">
       <SpecificVersion>False</SpecificVersion>
       <HintPath>Resources\Imazen.WebP.dll</HintPath>
+      <Private>False</Private>
     </Reference>
     <Reference Include="NAudio, Version=1.7.3.0, Culture=neutral, processorArchitecture=MSIL">
       <SpecificVersion>False</SpecificVersion>
@@ -164,6 +165,7 @@
     <Reference Include="System.Management" />
     <Reference Include="System.Net.Http" />
     <Reference Include="System.Numerics" />
+    <Reference Include="System.ServiceModel" />
     <Reference Include="System.Windows.Forms" />
     <Reference Include="System.Xml.Linq" />
     <Reference Include="System" />
@@ -189,6 +191,9 @@
     <Compile Include="Controls\MyIconTextButton.xaml.vb">
       <DependentUpon>MyIconTextButton.xaml</DependentUpon>
     </Compile>
+
+
+
     <Compile Include="Modules\Minecraft\ModComp.vb" />
     <Compile Include="Modules\Minecraft\ModJava.vb" />
     <Compile Include="Modules\Minecraft\ModMod.vb" />
@@ -254,6 +259,9 @@
     <Compile Include="Pages\PageLaunch\FormLoginOAuth.xaml.vb">
       <DependentUpon>FormLoginOAuth.xaml</DependentUpon>
     </Compile>
+    <Compile Include="Pages\PageLaunch\MyMsgLogin.xaml.vb">
+      <DependentUpon>MyMsgLogin.xaml</DependentUpon>
+    </Compile>
     <Compile Include="Pages\PageLaunch\PageLoginAuth.xaml.vb">
       <DependentUpon>PageLoginAuth.xaml</DependentUpon>
     </Compile>
@@ -473,6 +481,7 @@
       <DependentUpon>FormMain.xaml</DependentUpon>
       <SubType>Code</SubType>
     </Compile>
+
     <Page Include="Modules\Minecraft\MyLocalModItem.xaml">
       <Generator>MSBuild:Compile</Generator>
       <SubType>Designer</SubType>
@@ -509,6 +518,10 @@
       <SubType>Designer</SubType>
       <Generator>MSBuild:Compile</Generator>
     </Page>
+    <Page Include="Pages\PageLaunch\MyMsgLogin.xaml">
+      <Generator>MSBuild:Compile</Generator>
+      <SubType>Designer</SubType>
+    </Page>
     <Page Include="Pages\PageLaunch\PageLoginAuth.xaml">
       <Generator>MSBuild:Compile</Generator>
       <SubType>Designer</SubType>
@@ -881,26 +894,6 @@
   <ItemGroup>
     <WCFMetadata Include="Connected Services\" />
   </ItemGroup>
-  <ItemGroup>
-    <COMReference Include="NATUPNPLib">
-      <Guid>{1C565858-F302-471E-B409-F180AA4ABEC6}</Guid>
-      <VersionMajor>1</VersionMajor>
-      <VersionMinor>0</VersionMinor>
-      <Lcid>0</Lcid>
-      <WrapperTool>tlbimp</WrapperTool>
-      <Isolated>False</Isolated>
-      <EmbedInteropTypes>True</EmbedInteropTypes>
-    </COMReference>
-    <COMReference Include="NetFwTypeLib">
-      <Guid>{58FBCF7C-E7A9-467C-80B3-FC65E8FCCA08}</Guid>
-      <VersionMajor>1</VersionMajor>
-      <VersionMinor>0</VersionMinor>
-      <Lcid>0</Lcid>
-      <WrapperTool>tlbimp</WrapperTool>
-      <Isolated>False</Isolated>
-      <EmbedInteropTypes>True</EmbedInteropTypes>
-    </COMReference>
-  </ItemGroup>
   <ItemGroup>
     <Resource Include="Images\Blocks\OptiFabric.png" />
   </ItemGroup>
@@ -921,15 +914,13 @@
   </ItemGroup>
   <ItemGroup>
     <Resource Include="Images\Icons\Disabled.png" />
-    <Resource Include="Images\Icons\Unavaliable.png" />
+    <Resource Include="Images\Icons\Unavailable.png" />
   </ItemGroup>
   <ItemGroup>
     <Resource Include="Images\Heads\MCBBS.png" />
   </ItemGroup>
   <ItemGroup>
-    <Content Include="Resources\Imazen.WebP.dll" />
-    <Content Include="Resources\libwebp32.dll" />
-    <Content Include="Resources\libwebp64.dll" />
+
   </ItemGroup>
   <ItemGroup>
     <Resource Include="Images\Blocks\NeoForge.png" />
@@ -937,5 +928,9 @@
   <ItemGroup>
     <Resource Include="Images\Heads\z0z0r4.png" />
   </ItemGroup>
+  <ItemGroup>
+    <None Include="Resources\Imazen.WebP.dll" />
+    <None Include="Resources\libwebp64.dll" />
+  </ItemGroup>
   <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
 </Project>

BIN
Plain Craft Launcher 2/Resources/libwebp32.dll