diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index f2c4927c..fa9c3a7b 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -1,5 +1,4 @@ name: Build - on: push: paths: @@ -12,37 +11,35 @@ on: workflow_dispatch: jobs: - build: - - strategy: - matrix: - configuration: [Debug, Release, Snapshot, BETA, ReleaseUpdate] - + name: Build runs-on: windows-latest - + strategy: + matrix: + configuration: [Debug, Release] steps: - name: Checkout uses: actions/checkout@v4 with: fetch-depth: 0 - - name: Set Describe shell: bash run: | - Describe=`git describe --tags --always` - echo "Describe=$Describe" >> $GITHUB_ENV - + describe=`git describe --tags --always` + echo "describe=$describe" >> $GITHUB_ENV - name: Setup MSBuild.exe uses: microsoft/setup-msbuild@v2 with: msbuild-architecture: x64 - + - name: Replace + run: | + (gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const OAuthClientId As String = ""', 'Public Const OAuthClientId As String = "${{ secrets.CLIENT_ID }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb" + (gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const CurseForgeAPIKey As String = ""', 'Public Const CurseForgeAPIKey As String = "${{ secrets.CURSEFORGE_API_KEY }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb" + (gc "Plain Craft Launcher 2\Modules\Base\ModBase.vb") -replace 'Public Const CommitHash As String = ""', 'Public Const CommitHash As String = "${{ github.sha }}"' | Out-File "Plain Craft Launcher 2\Modules\Base\ModBase.vb" - name: Build run: msbuild "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj" -p:Configuration=${{ matrix.configuration }} - - name: Upload a Build Artifact uses: actions/upload-artifact@v4 with: - name: ${{ matrix.configuration }} ${{ env.Describe }} + name: ${{ matrix.configuration }} ${{ env.describe }} path: Plain Craft Launcher 2\obj\${{ matrix.configuration }}\Plain Craft Launcher 2.exe diff --git a/Plain Craft Launcher 2/Application.xaml.vb b/Plain Craft Launcher 2/Application.xaml.vb index 2ee8be9e..cb4d0301 100644 --- a/Plain Craft Launcher 2/Application.xaml.vb +++ b/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})") + 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 diff --git a/Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb b/Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb index 48a3f1b8..a0940290 100644 --- a/Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb +++ b/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)) '点击事件 diff --git a/Plain Craft Launcher 2/FormMain.xaml b/Plain Craft Launcher 2/FormMain.xaml index 2dd9671a..edebd06e 100644 --- a/Plain Craft Launcher 2/FormMain.xaml +++ b/Plain Craft Launcher 2/FormMain.xaml @@ -166,7 +166,7 @@ - + diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb index e57bc968..a1f9b156 100644 --- a/Plain Craft Launcher 2/FormMain.xaml.vb +++ b/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: ''' 把当前窗口拖到最前面。 ''' 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 diff --git a/Plain Craft Launcher 2/Images/Icons/Unavaliable.png b/Plain Craft Launcher 2/Images/Icons/Unavailable.png similarity index 100% rename from Plain Craft Launcher 2/Images/Icons/Unavaliable.png rename to Plain Craft Launcher 2/Images/Icons/Unavailable.png diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb index b57f3a45..74cba6a0 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb +++ b/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,12 +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 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 @@ -64,7 +66,7 @@ Public Module ModBase ''' Public ApplicationOpenTime As Date = Date.Now ''' - ''' 设备唯一标识符。 + ''' 识别码。 ''' Public UniqueAddress As String = SecretGetUniqueAddress() ''' @@ -1240,9 +1242,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 @@ -1261,8 +1269,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 @@ -1444,14 +1451,14 @@ RetryDir: End Function ''' - ''' 获取 Json 对象。 + ''' 获取 JSON 对象。 ''' 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 @@ -1855,6 +1862,13 @@ RetryDir: Return NewProcess.ExitCode End Function + ''' + ''' 判断当前系统语言是否为中文。 + ''' + 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 ''' @@ -2660,7 +2674,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 diff --git a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb b/Plain Craft Launcher 2/Modules/Base/ModLoader.vb index 05596a29..0e71e588 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModLoader.vb +++ b/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 diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb index b2775a38..9fa91361 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModNet.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb @@ -329,7 +329,7 @@ Retry: ''' ''' 同时发送多个网络请求并要求返回内容。 ''' - 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: ''' 是否有正在进行中、需要在下载管理页面显示的下载任务？ ''' 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 diff --git a/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb b/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb index 0b074e6d..e60d27a8 100644 --- a/Plain Craft Launcher 2/Modules/Base/MyBitmap.vb +++ b/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 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb index 591f6746..73614ed2 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb +++ b/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 列表 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb index 867b417b..50f77a3e 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb +++ b/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 @@ ''' ''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。 ''' - 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 @@ ''' ''' 对可能涉及 Mod 镜像源的请求进行处理，返回字符串或 JObject。 - ''' 调用 NetGetCodeByRequestOnce。 + ''' 调用 NetGetCodeByRequest。 ''' 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 @@ ''' ''' 对可能涉及 Mod 镜像源的请求进行处理。 - ''' 调用 NetRequestOnce。 + ''' 调用 NetRequest。 ''' - 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 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb index 26cd470a..452816c8 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb @@ -4,6 +4,7 @@ Public Module ModLaunch #Region "开始" + Public CurrentLaunchOptions As McLaunchOptions = Nothing Public Class McLaunchOptions ''' ''' 强制指定在启动后进入的服务器 IP。 @@ -20,32 +21,34 @@ Public Module ModLaunch ''' 默认值：Nothing。使用 McVersionCurrent。 ''' Public Version As McVersion = Nothing + ''' + ''' 额外的启动参数。 + ''' + Public ExtraArgs As New List(Of String) End Class ''' ''' 尝试启动 Minecraft。必须在 UI 线程调用。 ''' 返回是否实际开始了启动（如果没有，则一定弹出了错误提示）。 ''' 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 '执行自定义命令 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb index abc4a6bd..957e2e2d 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb @@ -475,22 +475,27 @@ VersionSearchFinish: ''' 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 ''' ''' 将 McLibToken 列表转换为 NetFile。无需下载的文件会被自动过滤。 ''' - 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: ''' Public Size As Long ''' - ''' 是否为 Virtual 资源文件。 - ''' - Public IsVirtual As Boolean - ''' ''' 文件的 Hash 校验码。 ''' 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 ''' ''' 获取 Minecraft 的资源文件列表。失败会抛出异常。 ''' - ''' 版本的资源名称，如“1.13.1”。 - 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: ''' ''' 获取版本缺失的资源文件所对应的 NetTaskFile。 ''' - 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 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb index 0c3ea340..1eb713b2 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb +++ b/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))) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb index 9d16fd27..ce900eae 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb +++ b/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 '强制关闭 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb b/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb index ee52b361..f1fce69b 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb +++ b/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() diff --git a/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml index a64f249c..ce687e89 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml +++ b/Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml @@ -27,27 +27,24 @@ - + + + + + + + - - - - +