diff --git a/Plain Craft Launcher 2/Application.xaml b/Plain Craft Launcher 2/Application.xaml index 8f98867..3d5488f 100644 --- a/Plain Craft Launcher 2/Application.xaml +++ b/Plain Craft Launcher 2/Application.xaml @@ -1,9 +1,9 @@  @@ -345,6 +345,7 @@ + diff --git a/Plain Craft Launcher 2/Application.xaml.vb b/Plain Craft Launcher 2/Application.xaml.vb index 5ef002b..b527334 100644 --- a/Plain Craft Launcher 2/Application.xaml.vb +++ b/Plain Craft Launcher 2/Application.xaml.vb @@ -140,6 +140,7 @@ WaitRetry: ServicePointManager.Expect100Continue = True ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 ServicePointManager.DefaultConnectionLimit = 1024 + ServicePointManager.UseNagleAlgorithm = False '计时 Log("[Start] 第一阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms") ApplicationStartTick = GetTimeTick() diff --git a/Plain Craft Launcher 2/Controls/MyCard.vb b/Plain Craft Launcher 2/Controls/MyCard.vb index 47652d9..b2af717 100644 --- a/Plain Craft Launcher 2/Controls/MyCard.vb +++ b/Plain Craft Launcher 2/Controls/MyCard.vb @@ -320,11 +320,10 @@ End Set End Property Private _IsSwapped As Boolean = False - ''' ''' 是否已被折叠。(已过时，请使用 IsSwapped) ''' - + Public Property IsSwaped As Boolean Get Return IsSwapped diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb index 93abb67..f1befdc 100644 --- a/Plain Craft Launcher 2/FormMain.xaml.vb +++ b/Plain Craft Launcher 2/FormMain.xaml.vb @@ -11,6 +11,19 @@ Public Class FormMain Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) '统计更新日志条目 #If BETA Then + If LastVersion < 367 Then 'Release 2.10.6 + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：启用 MCIM 社区资源镜像源，以缓解社区资源难以下载的问题")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：正版登录出错时无法给出正确的错误信息")) + FeatureCount += 9 + BugCount += 9 + End If + If LastVersion < 365 Then 'Release 2.10.5 + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：下载资源时，会单独记忆每种资源上次下载到的文件夹，以防混淆")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化：网络底层框架与下载稳定性")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法启动一部分 LabyMod 和 GTNH 客户端")) + FeatureCount += 22 + BugCount += 26 + End If If LastVersion < 361 Then 'Release 2.10.3 FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复：无法安装部分使用老版本 PCL 导出的整合包")) End If @@ -83,6 +96,12 @@ Public Class FormMain '3：BUG+ IMP* FEAT- '2：BUG* IMP- '1：BUG- + If LastVersion < 366 Then 'Snapshot 2.10.6 + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：启用 MCIM 社区资源镜像源，以缓解社区资源难以下载的问题")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：正版登录出错时无法给出正确的错误信息")) + FeatureCount += 9 + BugCount += 9 + End If If LastVersion < 364 Then 'Snapshot 2.10.5 If LastVersion >= 363 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复：无法添加新的正版账号")) @@ -268,11 +287,6 @@ Public Class FormMain AddHandler Closing, Sub() Helper.RemoveDragHook() AddHandler Helper.DragDrop, Sub() FileDrag(Helper.DropFilePaths) End If - 'If IsAdmin() Then '下列代码没用（#2531） - ' ChangeWindowMessageFilter(&H233, 1) - ' ChangeWindowMessageFilter(&H4A, 1) - ' ChangeWindowMessageFilter(&H49, 1) - 'End If '切换到首页 If Not IsNothing(FrmLaunchLeft.Parent) Then FrmLaunchLeft.SetValue(ContentPresenter.ContentProperty, Nothing) If Not IsNothing(FrmLaunchRight.Parent) Then FrmLaunchRight.SetValue(ContentPresenter.ContentProperty, Nothing) @@ -389,6 +403,8 @@ Public Class FormMain Catch ex As Exception Log(ex, "清理自动更新文件失败") End Try + '上报 + Telemetry("启动") End Sub, "初始化", ThreadPriority.Lowest) Log("[Start] 第三阶段加载用时：" & GetTimeTick() - ApplicationStartTick & " ms") @@ -874,7 +890,7 @@ Public Class FormMain '错误报告分析 Try Log("[System] 尝试进行错误报告分析") - Dim Analyzer As New CrashAnalyzer(GetUuid()) + Dim Analyzer As New CrashAnalyzer Analyzer.Import(FilePath) If Not Analyzer.Prepare() Then Exit Try Analyzer.Analyze() diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb index edc5b95..b4ef294 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb @@ -1,6 +1,6 @@ Imports System.Globalization Imports System.IO.Compression -Imports System.Reflection +Imports System.Net.Sockets Imports System.Runtime.CompilerServices Imports System.Security.Cryptography Imports System.Security.Principal @@ -13,13 +13,13 @@ Public Module ModBase #Region "声明" '下列版本信息由更新器自动修改 - Public Const VersionBaseName As String = "2.10.5" '不含分支前缀的显示用版本名 - Public Const VersionStandardCode As String = "2.10.5." & VersionBranchCode '标准格式的四段式版本号 + Public Const VersionBaseName As String = "2.10.6" '不含分支前缀的显示用版本名 + Public Const VersionStandardCode As String = "2.10.6." & VersionBranchCode '标准格式的四段式版本号 Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换 #If BETA Then - Public Const VersionCode As Integer = 361 'Release + Public Const VersionCode As Integer = 367 'Release #Else - Public Const VersionCode As Integer = 364 'Snapshot + Public Const VersionCode As Integer = 366 'Snapshot #End If '自动生成的版本信息 Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName @@ -791,8 +791,8 @@ Public Module ModBase Public Sub CopyFile(FromPath As String, ToPath As String) Try '还原文件路径 - If Not FromPath.Contains(":\") Then FromPath = Path & FromPath - If Not ToPath.Contains(":\") Then ToPath = Path & ToPath + FromPath = ShortenPath(If(FromPath.Contains(":\"), FromPath, Path & FromPath)) + ToPath = ShortenPath(If(ToPath.Contains(":\"), ToPath, Path & ToPath)) '如果复制同一个文件则跳过 If FromPath = ToPath Then Return '确保目录存在 @@ -861,7 +861,7 @@ Public Module ModBase ''' 是否将文件内容追加到当前文件，而不是覆盖它。 Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing) '处理相对路径 - If Not FilePath.Contains(":\") Then FilePath = Path & FilePath + FilePath = ShortenPath(If(FilePath.Contains(":\"), FilePath, Path & FilePath)) '确保目录存在 Directory.CreateDirectory(GetPathFromFullPath(FilePath)) '写入文件 @@ -886,7 +886,7 @@ Public Module ModBase ''' 是否将文件内容追加到当前文件，而不是覆盖它。 Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False) '处理相对路径 - If Not FilePath.Contains(":\") Then FilePath = Path & FilePath + FilePath = ShortenPath(If(FilePath.Contains(":\"), FilePath, Path & FilePath)) '确保目录存在 Directory.CreateDirectory(GetPathFromFullPath(FilePath)) '写入文件 @@ -1294,11 +1294,11 @@ Re: ''' Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing, Optional ProgressIncrementHandler As Action(Of Double) = Nothing) - Directory.CreateDirectory(DestDirectory) + Directory.CreateDirectory(ShortenPath(DestDirectory)) If CompressFilePath.EndsWithF(".gz", True) Then '以 gz 方式解压 Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress) - Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write) + Dim decompressedFile As New FileStream(ShortenPath(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", "")), FileMode.OpenOrCreate, FileAccess.Write) Dim data As Integer = stream.ReadByte() While data <> -1 decompressedFile.WriteByte(data) @@ -1309,10 +1309,10 @@ Re: Else '以 zip 方式解压 Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030"))) - Dim TotalCount As Integer = Archive.Entries.Count + Dim TotalCount As Long = Archive.Entries.Count For Each Entry As ZipArchiveEntry In Archive.Entries - If ProgressIncrementHandler IsNot Nothing Then ProgressIncrementHandler(1 / TotalCount) - Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName) + If ProgressIncrementHandler IsNot Nothing AndAlso TotalCount > 0 Then ProgressIncrementHandler(1 / TotalCount) + Dim DestinationPath As String = ShortenPath(IO.Path.Combine(DestDirectory, Entry.FullName)) If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then Continue For '不创建空文件夹 Else @@ -1387,10 +1387,10 @@ RetryDir: ToPath = ToPath.Replace("/", "\") If Not ToPath.EndsWithF("\") Then ToPath &= "\" Dim AllFiles = EnumerateFiles(FromPath).ToList - Dim FileCount As Integer = AllFiles.Count + Dim FileCount As Long = AllFiles.Count For Each File In AllFiles CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath)) - If ProgressIncrementHandler IsNot Nothing Then ProgressIncrementHandler(1 / FileCount) + If ProgressIncrementHandler IsNot Nothing AndAlso FileCount > 0 Then ProgressIncrementHandler(1 / FileCount) Next End Sub ''' @@ -1449,22 +1449,8 @@ RetryDir: IsInner = True Loop - '常见错误（记得同时修改下面的） - Dim CommonReason As String = Nothing - If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then - CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装，请先卸载较新版本的 .NET Framework，然后再尝试安装。" - ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then - CommonReason = "PCL 的权限不足。请尝试右键 PCL，选择以管理员身份运行。" - ElseIf TypeOf InnerEx Is OutOfMemoryException Then - CommonReason = "你的电脑运行内存不足，导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。" - ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then - CommonReason = "由于操作系统或显卡存在问题，导致出现错误。请尝试重启 PCL。" - ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝", - "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) DescList.Any(Function(l) l.Contains(s))) Then - CommonReason = "你的网络环境不佳，导致难以连接到服务器。请稍后重试，或使用 VPN 以改善网络环境。" - End If - '构造输出信息 + Dim CommonReason As String = AnalyzeCommonReason(InnerEx, DescList) If CommonReason Is Nothing Then Return DescList.Join(vbCrLf) Else @@ -1492,22 +1478,8 @@ RetryDir: DescList = DescList.Distinct.ToList Dim Desc As String = Join(DescList, vbCrLf & "→ ") - '常见错误（记得同时修改上面的） - Dim CommonReason As String = Nothing - If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then - CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装，请先卸载较新版本的 .NET Framework，然后再尝试安装。" - ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then - CommonReason = "PCL 的权限不足。请尝试右键 PCL，选择以管理员身份运行。" - ElseIf TypeOf InnerEx Is OutOfMemoryException Then - CommonReason = "你的电脑运行内存不足，导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。" - ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then - CommonReason = "由于操作系统或显卡存在问题，导致出现错误。请尝试重启 PCL。" - ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝", - "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) Desc.Contains(s)) Then - CommonReason = "你的网络环境不佳，导致难以连接到服务器。请稍后重试，或使用 VPN 以改善网络环境。" - End If - '构造输出信息 + Dim CommonReason As String = AnalyzeCommonReason(InnerEx, DescList) If CommonReason IsNot Nothing Then Return CommonReason & "详细错误：" & DescList.First Else @@ -1515,6 +1487,24 @@ RetryDir: Return Join(DescList, " ← ") End If End Function + Private Function AnalyzeCommonReason(InnerEx As Exception, DescList As List(Of String)) As String + If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then + Return "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装，请先卸载较新版本的 .NET Framework，然后再尝试安装。" + ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then + Return "PCL 的权限不足。请尝试右键 PCL，选择以管理员身份运行。" + ElseIf TypeOf InnerEx Is OutOfMemoryException Then + Return "你的电脑运行内存不足，导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。" + ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then + Return "由于操作系统或显卡存在问题，导致出现错误。请尝试重启 PCL。" + ElseIf TypeOf InnerEx Is SocketException AndAlso DescList.Any(Function(l) l.Contains("WSAStartup")) Then + Return "请尝试卸载中国移动云盘，然后再试。" + ElseIf {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝", + "操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) DescList.Any(Function(l) l.Contains(s))) Then + Return "你的网络环境不佳，导致难以连接到服务器。请稍后重试，或使用 VPN 以改善网络环境。" + Else + Return Nothing + End If + End Function ''' ''' 返回一个枚举对应的字符串。 @@ -1556,7 +1546,7 @@ RetryDir: 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 > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data)) + Throw New Exception("格式化 JSON 失败：" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data), ex) End Try End Function @@ -2641,10 +2631,6 @@ Retry: ''' 相对增减控件的左边距。 ''' Public Sub DeltaLeft(control As FrameworkElement, newValue As Double) - '安全性检查 - DebugAssert(Not Double.IsNaN(newValue)) - DebugAssert(Not Double.IsInfinity(newValue)) - If TypeOf control Is Window Then '窗口改变 CType(control, Window).Left += newValue @@ -2656,8 +2642,6 @@ Retry: Case HorizontalAlignment.Right control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right - newValue, control.Margin.Bottom) 'control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, CType(control.Parent, Object).ActualWidth - control.ActualWidth - newValue, control.Margin.Bottom) - Case Else - DebugAssert(False) End Select End If End Sub @@ -2665,17 +2649,12 @@ Retry: ''' 设置控件的左边距。（仅针对置左控件） ''' Public Sub SetLeft(control As FrameworkElement, newValue As Double) - DebugAssert(control.HorizontalAlignment = HorizontalAlignment.Left) control.Margin = New Thickness(newValue, control.Margin.Top, control.Margin.Right, control.Margin.Bottom) End Sub ''' ''' 相对增减控件的上边距。 ''' Public Sub DeltaTop(control As FrameworkElement, newValue As Double) - '安全性检查 - DebugAssert(Not Double.IsNaN(newValue)) - DebugAssert(Not Double.IsInfinity(newValue)) - If TypeOf control Is Window Then '窗口改变 CType(control, Window).Top += newValue @@ -2687,11 +2666,8 @@ Retry: Case VerticalAlignment.Bottom control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right, control.Margin.Bottom - newValue) 'control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, CType(control.Parent, Object).ActualWidth - control.ActualWidth - newValue, control.Margin.Bottom) - Case Else - DebugAssert(False) End Select End If - 'If Double.IsNaN(newValue) OrElse Double.IsInfinity(newValue) Then Return '安全性检查 'Select Case control.VerticalAlignment ' Case VerticalAlignment.Top, VerticalAlignment.Stretch, VerticalAlignment.Center @@ -2705,7 +2681,6 @@ Retry: ''' 设置控件的顶边距。（仅针对置上控件） ''' Public Sub SetTop(control As FrameworkElement, newValue As Double) - DebugAssert(control.VerticalAlignment = VerticalAlignment.Top) control.Margin = New Thickness(control.Margin.Left, newValue, control.Margin.Right, control.Margin.Bottom) End Sub @@ -2989,6 +2964,13 @@ Retry: End If End Select + '上报 + If Level >= LogLevel.Hint Then + Telemetry("PCL 错误", + "Level", GetStringFromEnum(Level), + "Title", FilterUserName(FilterAccessToken(Title, "*"), "*"), + "Exception", FilterUserName(FilterAccessToken(Text, "*"), "*")) + End If End Sub ''' ''' 输出错误信息。 @@ -3055,6 +3037,13 @@ Retry: End If End Select + '上报 + If Level >= LogLevel.Hint Then + Telemetry("PCL 异常", + "Level", GetStringFromEnum(Level), + "Title", FilterUserName(FilterAccessToken(Title, "*"), "*"), + "Exception", FilterUserName(FilterAccessToken(ExFull, "*"), "*")) + End If End Sub '反馈 @@ -3091,9 +3080,23 @@ Retry: "文件位置：" & Path) End Sub - '断言 - Public Sub DebugAssert(Exp As Boolean) - If Not Exp Then Throw New Exception("断言命中") + '遥测 + Public Sub Telemetry([Event] As String, ParamArray Datas As String()) + If Not Setup.Get("SystemSystemTelemetry") Then Return '用户关闭了遥测 + If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址 + RunInNewThread( + Sub() + Try + Log($"[System] 匿名数据上报：{[Event]}") + Dim Url As String = $"{ClsBaseUrl}&Event={WebUtility.UrlEncode([Event])}" + For i = 0 To Datas.Length - 1 Step 2 + Url &= "&" & WebUtility.UrlEncode(Datas(i)) & "=" & WebUtility.UrlEncode(Datas(i + 1).Replace(vbCrLf, vbLf)) + Next + NetRequestByClient(Url, MakeLog:=False) + Catch + Log("[System] 匿名数据上报失败", LogLevel.Debug) + End Try + End Sub, "Telemetry", ThreadPriority.Lowest) End Sub '获取当前的堆栈信息 diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb index a3dc0e8..6539356 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModNet.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb @@ -22,9 +22,6 @@ Public Module ModNet Return If(Encoding, Encoding.UTF8).GetString(SendRequest(Url, Method, Content, HeaderDictionary, Timeout:=Timeout, Encoding:=Encoding, UseBrowserUserAgent:=UseBrowserUserAgent)) Catch ex As ThreadInterruptedException Throw - Catch ex As ResponsedWebException - If MakeLog Then Log(ex, "网络请求失败，返回内容为：" & vbCrLf & ex.Response, LogLevel.Developer) - Throw Catch ex As Exception If MakeLog Then Log(ex, "网络请求失败", LogLevel.Developer) Throw @@ -244,7 +241,10 @@ RequestFinished: If Response.IsSuccessStatusCode Then Return ResponseBytes Else - Throw New ResponsedWebException($"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Method}，{Url}", If(Encoding, Encoding.UTF8).GetString(ResponseBytes)) + Dim ResponseMessage = If(Encoding, Encoding.UTF8).GetString(ResponseBytes) + Throw New ResponsedWebException( + $"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Method}，{Url}" & + If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), ResponseMessage) End If Catch ex As ThreadInterruptedException Throw @@ -807,7 +807,7 @@ StartSingleThreadDownload: '是否禁用多线程，以及规定碎片大小 Dim TargetUrl As String = GetSource().Url If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("bmclapi") OrElse TargetUrl.Contains("github.com") OrElse - TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("modrinth") Then Return Nothing + TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("modrinth") OrElse TargetUrl.Contains("momot.rs") Then Return Nothing '寻找最大碎片 'FUTURE: 下载引擎重做，计算下载源平均链接时间和线程下载速度，按最高时间节省来开启多线程 Dim FilePieceMax As NetThread = Threads @@ -990,7 +990,8 @@ NotSupportRange: Th.DownloadDone += RealDataCount ResultStream.Write(ResponseBytes, 0, RealDataCount) '检查速度是否过慢 - If DeltaTime > 1500 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1.5s，且速度小于 1.5K/s + If DeltaTime > 1500 AndAlso DeltaTime > RealDataCount AndAlso '数据包间隔大于 1.5s，且速度小于 1.5K/s + Th.Source.SingleThread Is Nothing Then '并非单线程下载 Throw New TimeoutException("由于速度过慢断开链接，下载 " & RealDataCount & " B，消耗 " & DeltaTime & " ms。") End If Th.LastReceiveTime = GetTimeTick() @@ -1027,7 +1028,8 @@ SourceBreak: End SyncLock '合并 If Not IsNoSplit Then ResultStream?.Dispose() - If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge(Th) + If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso + State < NetState.Merge AndAlso Th.State <> NetState.Error Then Merge(Th) End Try End Sub Private Sub SourceFail(Th As NetThread, ex As Exception, IsMergeFailure As Boolean) @@ -1069,7 +1071,7 @@ SourceBreak: '当前源失败，但还有下载源：正常地继续执行 ElseIf Not Retried AndAlso Sources.Count > 1 Then '合并失败或首次下载失败，未重试：将所有下载源重新标记为不允许断点续传的下载源，逐个重新尝试下载 - Log($"[Download] {LocalName}：文件下载失败，正在自动重试……", If(ModeDebug, LogLevel.Hint, LogLevel.Debug)) '在调试模式下给出红色提示 + Hint($"{LocalName}：文件下载失败，正在自动重试……", If(ModeDebug, HintType.Critical, HintType.Info)) '在调试模式下给出红色提示 Retried = True SyncLock LockSource SourcesOnce.Clear() @@ -1525,10 +1527,14 @@ Retry: '获取实际失败的文件 For Each File In Files If File.State <> NetState.Error Then Continue For + Dim Detail As String = Join(File.Sources.Select(Function(s) $"{If(s.Ex?.Message, "无错误信息。"）}（{s.Url}）"), vbCrLf) [Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf & - "各下载源的错误如下：" & vbCrLf & - Join(File.Sources.Select(Function(s) $"{If(s.Ex?.Message, "无错误信息。"）}（{s.Url}）"), vbCrLf), + "各下载源的错误如下：" & vbCrLf & Detail, [Error]) + '上报 + Telemetry("文件下载失败", + "FileName", File.LocalName, + "Exception", Detail) Exit For Next '在设置 Error 对象后再更改为失败，避免 WaitForExit 无法捕获错误 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb index 2ed1744..9a5dd9a 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb @@ -2,7 +2,9 @@ '构造函数 Private TempFolder As String - Public Sub New(UUID As Integer) + Private TargetVersion As McVersion + Public Sub New(Optional TargetVersion As McVersion = Nothing) + Me.TargetVersion = TargetVersion '构建文件结构 TempFolder = RequestTaskTempFolder() Directory.CreateDirectory(TempFolder & "Temp\") @@ -508,7 +510,7 @@ Done: If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式) If LogMc.Contains("java.lang.OutOfMemoryError") OrElse LogMc.Contains("an out of memory error") Then AppendReason(CrashReason.内存不足) If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与OptiFine同时安装) - If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容) + If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") OrElse LogMc.Contains("java.lang.NoSuchMethodError: 'void sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容) If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误) If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf)) If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足) @@ -856,12 +858,13 @@ NextStack: ''' ''' 弹出崩溃弹窗，并指导导出崩溃报告。 ''' - Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing) + Public Sub Output(IsManualAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing) '弹窗提示 FrmMain.ShowWindowToTop() - Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"), - "确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"), - Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, + Dim Detail As String = GetAnalyzeResult(IsManualAnalyze) + Select Case MyMsgBox(Detail, If(IsManualAnalyze, "错误报告分析结果", "Minecraft 出现错误"), + "确定", If(IsManualAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsManualAnalyze, "", "导出错误报告"), + Button2Action:=If(IsManualAnalyze OrElse DirectFile Is Nothing, Nothing, Sub() '弹窗选择：查看日志 If File.Exists(DirectFile.Value.Key) Then @@ -918,6 +921,11 @@ NextStack: End Try OpenExplorer(FileAddress) End Select + '上报 + If IsManualAnalyze Then Return + Telemetry("Minecraft 崩溃", + "Version", If(TargetVersion Is Nothing, "null", TargetVersion.Version.ToString), + "Detail", FilterUserName(Detail, "*")) End Sub ''' ''' 获取崩溃分析的结果描述。 @@ -1102,7 +1110,7 @@ NextStack: If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "", vbCrLf & "如果要寻求帮助，请把错误报告文件发给对方，而不是发送这个窗口的照片或者截图。" & If(If(PageSetupSystem.IsLauncherNewest(), True), "", - vbCrLf & vbCrLf & "此外，你正在使用老版本 PCL，更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。")) + vbCrLf & vbCrLf & "此外，你正在使用老版本 PCL，更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 [设置 → 其他 → 启动器 → 检查更新] 更新 PCL。")) End Function End Class diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb index f2f9923..e6d517e 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb @@ -594,7 +594,7 @@ VersionName = Version Me.Version = New Version(Version) Me.Inherit = Inherit - FileVersion = Version & If(Branch Is Nothing, ""， "-" & Branch) + FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch) End Sub End Class @@ -1106,26 +1106,27 @@ Public Function DlModRequest(Url As String, Optional Method As HttpMethod = Nothing, Optional Content As String = Nothing, Optional ContentType As String = Nothing) As JToken Dim Urls As New List(Of KeyValuePair(Of String, Integer)) - Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10)) '至少 10s，要不然有时候远端服务器来不及完成 - Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) - 'Dim McimUrl As String = DlSourceModGet(Url) - 'If McimUrl <> Url Then - ' Select Case Setup.Get("ToolDownloadMod") - ' Case 0 - ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) - ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) - ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) - ' Case 1 - ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10)) - ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) - ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) - ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) - ' Case Else - ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10)) - ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) - ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) - ' End Select - 'End If + Dim McimUrl As String = DlSourceModGet(Url) + If McimUrl <> Url Then + Select Case Setup.Get("ToolDownloadMod") + Case 0 + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) + Case 1 + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10)) '至少 10s，要不然有时候远端服务器来不及完成 + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) + Case Else + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) + Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) + End Select + Else + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 10)) + Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30)) + End If Dim Exs As String = "" For Each Source In Urls Try @@ -1232,7 +1233,14 @@ 'Mod 下载源 Public Function DlSourceModGet(Original As String) As String - Return Original + Return Original. + Replace("api.modrinth.com", "mod.mcimirror.top/modrinth"). + Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth"). + Replace("cdn.modrinth.com", "mod.mcimirror.top"). + Replace("api.curseforge.com", "mod.mcimirror.top/curseforge"). + Replace("edge.forgecdn.net", "mod.mcimirror.top"). + Replace("mediafilez.forgecdn.net", "mod.mcimirror.top"). + Replace("media.forgecdn.net", "mod.mcimirror.top") End Function 'Loader 自动切换 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb index f682f62..f9cbe79 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb @@ -66,7 +66,7 @@ Public Module ModLaunch ''' Public Sub McLaunchLog(Text As String) Text = FilterUserName(FilterAccessToken(Text, "*"), "*") - RunInUi(Sub() FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text) + RunInUi(Sub() FrmLaunchRight.LabLog.Text += $"{vbCrLf}[{GetTimeNow()}] {Text}") Log("[Launch] " & Text) End Sub @@ -101,6 +101,8 @@ Public Module ModLaunch If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Critical) Throw End Try + Dim IsSavingBatch As Boolean = CurrentLaunchOptions?.SaveBatch IsNot Nothing + '正式加载 Try '构造主加载器 @@ -145,9 +147,15 @@ Public Module ModLaunch Select Case LaunchLoader.State Case LoadState.Finished Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish) + '上报 + If Not IsSavingBatch Then + Telemetry("Minecraft 启动成功", + "Version", McVersionCurrent.Version.ToString, + "LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType))) + End If Case LoadState.Aborted If AbortHint Is Nothing Then - Hint(If(CurrentLaunchOptions?.SaveBatch Is Nothing, "已取消启动！", "已取消导出启动脚本！"), HintType.Info) + Hint(If(IsSavingBatch, "已取消导出启动脚本！", "已取消启动！"), HintType.Info) Else Hint(AbortHint, HintType.Finish) End If @@ -162,7 +170,7 @@ NextInner: If CurrentEx.Message.StartsWithF("$") Then '若有以 $ 开头的错误信息，则以此为准显示提示 '若错误信息为 $$，则不提示 - If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败")) + If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(IsSavingBatch, "导出启动脚本失败", "启动失败")) Throw ElseIf CurrentEx.InnerException IsNot Nothing Then '检查下一级错误 @@ -172,8 +180,15 @@ NextInner: '没有特殊处理过的错误信息 McLaunchLog("错误：" & GetExceptionDetail(ex)) Log(ex, - If(CurrentLaunchOptions?.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox, - If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败")) + If(IsSavingBatch, "导出启动脚本失败", "Minecraft 启动失败"), LogLevel.Msgbox, + If(IsSavingBatch, "导出启动脚本失败", "启动失败")) + '上报 + If Not IsSavingBatch Then + Telemetry("Minecraft 启动失败", + "Version", McVersionCurrent.Version.ToString, + "LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType)), + "Exception", FilterUserName(FilterAccessToken(GetExceptionDetail(ex), "*"), "*")) + End If Throw End If End Try @@ -891,9 +906,9 @@ Retry: ContentType:="application/x-www-form-urlencoded", Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}}, ThreadCount:=2) - Catch ex As Exception - If ex.Message.ContainsF("must sign in again", True) OrElse ex.Message.ContainsF("password expired", True) OrElse - (ex.Message.Contains("refresh_token") AndAlso ex.Message.Contains("is not valid")) Then '#269 + Catch ex As ResponsedWebException + If ex.Response.ContainsF("must sign in again", True) OrElse ex.Response.ContainsF("password expired", True) OrElse + (ex.Response.Contains("refresh_token") AndAlso ex.Response.Contains("is not valid")) Then '#269 Return {"Relogin", ""} Else Throw @@ -942,20 +957,20 @@ Retry: Try Result = NetRequestByClientMultiple("https://xsts.auth.xboxlive.com/xsts/authorize", HttpMethod.Post, Content:=Request, ContentType:="application/json") - Catch ex As Net.WebException + Catch ex As ResponsedWebException '参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js - If ex.Message.Contains("2148916227") Then + If ex.Response.Contains("2148916227") Then MyMsgBox("该账号似乎已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True) Throw New Exception("$$") - ElseIf ex.Message.Contains("2148916233") Then + ElseIf ex.Response.Contains("2148916233") Then If MyMsgBox("你尚未注册 Xbox 账户，请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then OpenWebsite("https://signup.live.com/signup") End If Throw New Exception("$$") - ElseIf ex.Message.Contains("2148916235") Then + ElseIf ex.Response.Contains("2148916235") Then MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN。", "登录失败", "我知道了") Throw New Exception("$$") - ElseIf ex.Message.Contains("2148916238") Then + ElseIf ex.Response.Contains("2148916238") Then If MyMsgBox("该账号年龄不足，你需要先修改出生日期，然后才能登录。" & vbCrLf & "该账号目前填写的年龄是否在 13 岁以上？", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then OpenWebsite("https://account.live.com/editprof.aspx") @@ -1364,13 +1379,13 @@ Retry: McLaunchLog("新版 Game 参数获取成功") End If '编码参数（#4700、#5892、#5909） + If McLaunchJavaSelected.VersionCode >= 18 Then 'Dfile.encoding 需要放在 Dstdout.encoding 后面（#6934） + If Not Arguments.Contains("-Dfile.encoding=") Then Arguments = "-Dfile.encoding=COMPAT " & Arguments + End If If McLaunchJavaSelected.VersionCode > 8 Then If Not Arguments.Contains("-Dstdout.encoding=") Then Arguments = "-Dstdout.encoding=UTF-8 " & Arguments If Not Arguments.Contains("-Dstderr.encoding=") Then Arguments = "-Dstderr.encoding=UTF-8 " & Arguments End If - If McLaunchJavaSelected.VersionCode >= 18 Then - If Not Arguments.Contains("-Dfile.encoding=") Then Arguments = "-Dfile.encoding=COMPAT " & Arguments - End If 'MJSB Arguments = Arguments.Replace(" -Dos.name=Windows 10", " -Dos.name=""Windows 10""") '全屏 @@ -1692,7 +1707,7 @@ NextVersion: GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken) GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken) GameArguments.Add("${user_type}", "msa") '#1221 - GameArguments.Add("${primary_jar}", Version.Path & Version.Name & ".jar") + GameArguments.Add("${primary_jar}", Version.Path & Version.Name & ".jar") '#6942 '窗口尺寸参数 Dim GameSize As Size diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb index 422cf67..6c11868 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb @@ -989,7 +989,7 @@ ExitDataLoad: If ToString = "" Then Return "原版 " & McName Else - Return McName & ToString & If(ModeDebug, " (" & SortCode & "#)", "") + Return McName & ToString End If End Function @@ -2415,7 +2415,7 @@ NextEntry: Public Function FilterUserName(Raw As String, FilterChar As Char) As String If Raw.Contains(":\Users\") Then For Each Token In RegexSearch(Raw, "(?<=:\\Users\\)[^\\]+") - Raw = Raw.Replace(Token, New String(FilterChar, Token.Count)) + Raw = Raw.Replace("\" & Token, "\" & New String(FilterChar, Token.Count)) Next End If Return Raw diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb index 54ce14b..c4f08a4 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb @@ -349,14 +349,14 @@ State = MinecraftState.Crashed '崩溃分析 WatcherLog("Minecraft 已崩溃，将在 2 秒后开始崩溃分析") - Hint("检测到 Minecraft 出现错误，错误分析已开始……") + Hint("检测到 Minecraft 出现错误，错误分析已开始……", HintType.Critical) FeedbackInfo() RunInNewThread( Sub() Try Thread.Sleep(2000) WatcherLog("崩溃分析开始") - Dim Analyzer As New CrashAnalyzer(PID) + Dim Analyzer As New CrashAnalyzer(Version) Analyzer.Collect(Version.PathIndie, LatestLog.ToList) Analyzer.Prepare() Analyzer.Analyze(Version) diff --git a/Plain Craft Launcher 2/Modules/ModEvent.vb b/Plain Craft Launcher 2/Modules/ModEvent.vb index e6bd0ec..87e9bf5 100644 --- a/Plain Craft Launcher 2/Modules/ModEvent.vb +++ b/Plain Craft Launcher 2/Modules/ModEvent.vb @@ -116,11 +116,8 @@ End Try Case "修改设置" - If Setup.IsEncoded(Data(0)) Then - Throw New Exception($"无法修改受加密保护的设置：{Data(0)}") - End If Setup.Set(Data(0), Data(1)) - Hint("已修改设置！", HintType.Finish) + Hint($"已写入设置：{Data(0)} → {Data(1)}", HintType.Finish) Case Else MyMsgBox("未知的事件类型：" & Type & vbCrLf & "请检查事件类型填写是否正确，或者 PCL 是否为最新版本。", "事件执行失败") diff --git a/Plain Craft Launcher 2/Modules/ModSecret.vb b/Plain Craft Launcher 2/Modules/ModSecret.vb index c690527..00635bb 100644 --- a/Plain Craft Launcher 2/Modules/ModSecret.vb +++ b/Plain Craft Launcher 2/Modules/ModSecret.vb @@ -12,6 +12,8 @@ Friend Module ModSecret Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "") 'CurseForge API Key Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "") + '用于匿名数据收集的腾讯云日志服务上报 URL，形如 https://{region}.cls.tencentcs.com/track?topic_id={topic_id} + Public Const ClsBaseUrl As String = "" Friend Sub SecretOnApplicationStart() '提升 UI 线程优先级 diff --git a/Plain Craft Launcher 2/Modules/ThirdParty/DragHelper.vb b/Plain Craft Launcher 2/Modules/ThirdParty/DragHelper.vb index ff950c4..e2d79e7 100644 --- a/Plain Craft Launcher 2/Modules/ThirdParty/DragHelper.vb +++ b/Plain Craft Launcher 2/Modules/ThirdParty/DragHelper.vb @@ -137,7 +137,7 @@ Public Class DragHelper Dim fileCount As UInteger = DragQueryFile(wParam, UInteger.MaxValue, Nothing, 0) ReDim dropFilePaths(CInt(fileCount) - 1) - For i As UInteger = 0 To fileCount - 1 + For i As UInteger = 0 To CInt(fileCount) - 1 Dim sb As New StringBuilder(MAX_PATH) Dim result As UInteger = DragQueryFile(wParam, i, sb, sb.Capacity) If result > 0 Then dropFilePaths(i) = sb.ToString() diff --git a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb index 407176a..c257a02 100644 --- a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb +++ b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb @@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices ' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号 ' 方法是按如下所示使用“*” - - + + diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb index 3ab15d6..f22dcc2 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb @@ -243,19 +243,21 @@ If Not IsNothing(PageNew) AndAlso Not IsNothing(PageNew.Parent) Then PageNew.SetValue(ContentPresenter.ContentProperty, Nothing) If Anim Then '动画 - Dispatcher.Invoke(Sub() - '执行动画 - AniStart({ - AaOpacity(PanLogin, -PanLogin.Opacity, 100,, New AniEaseOutFluent), - AaCode(Sub() - AniControlEnabled += 1 - PanLogin.Children.Clear() - PanLogin.Children.Add(PageNew) - AniControlEnabled -= 1 - End Sub, 100), - AaOpacity(PanLogin, 1, 100, 120, New AniEaseInFluent) - }, "FrmLogin PageChange") - End Sub, Threading.DispatcherPriority.Render) + Dispatcher.Invoke( + Sub() + '执行动画 + AniStart({ + AaOpacity(PanLogin, -PanLogin.Opacity, 100,, New AniEaseOutFluent), + AaCode( + Sub() + AniControlEnabled += 1 + PanLogin.Children.Clear() + PanLogin.Children.Add(PageNew) + AniControlEnabled -= 1 + End Sub, 100), + AaOpacity(PanLogin, 1, 100, 120, New AniEaseInFluent) + }, "FrmLogin PageChange") + End Sub, Threading.DispatcherPriority.Render) Else '无动画 AniControlEnabled += 1 diff --git a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb index 4591213..b3323fe 100644 --- a/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb @@ -93,7 +93,7 @@ Download: GoTo Download Case 3 Log("[Page] 主页预设：简单主页") - Url = "https://raw.gitcode.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml" + Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/MFn233/Custom.xaml" GoTo Download Case 4 Log("[Page] 主页预设：每日整合包推荐") @@ -129,7 +129,7 @@ Download: GoTo Download Case 12 Log("[Page] 主页预设：PCL GitHub 仪表盘") - Url = "https://raw.gitcode.com/Deep-Dark-Forest/PCL2-GitHub-Dashboard-Homepage/raw/main/custom.xaml" + Url = "https://ddf.pcl-community.org/Custom.xaml" GoTo Download End Select End Select diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml index f872639..784edbf 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml @@ -1,492 +1,451 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml.vb b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml.vb index 10c4f07..13e7a3f 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml.vb @@ -18,12 +18,6 @@ End Sub - Private Sub BtnAboutBmclapi_Click(sender As Object, e As EventArgs) Handles BtnAboutBmclapi.Click - OpenWebsite("https://afdian.com/a/bangbang93") - End Sub - Private Sub BtnAboutWiki_Click(sender As Object, e As EventArgs) Handles BtnAboutWiki.Click - OpenWebsite("https://www.mcmod.cn") - End Sub Public Shared Sub CopyUniqueAddress() Handles BtnDonateCopy.Click ClipboardSet(UniqueAddress) End Sub diff --git a/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb b/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb index 39fd0a3..7e28d54 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/ModSetup.vb @@ -41,6 +41,7 @@ {"SystemSystemCache", New SetupEntry("", Source:=SetupSource.Registry)}, {"SystemSystemUpdate", New SetupEntry(0)}, {"SystemSystemActivity", New SetupEntry(0)}, + {"SystemSystemTelemetry", New SetupEntry(True, Source:=SetupSource.Registry)}, {"CacheExportConfig", New SetupEntry("", Source:=SetupSource.Registry)}, {"CacheSavedPageUrl", New SetupEntry("", Source:=SetupSource.Registry)}, {"CacheSavedPageVersion", New SetupEntry("", Source:=SetupSource.Registry)}, @@ -123,7 +124,7 @@ {"ToolDownloadTranslateV2", New SetupEntry(1, Source:=SetupSource.Registry)}, {"ToolDownloadIgnoreQuilt", New SetupEntry(True, Source:=SetupSource.Registry)}, {"ToolDownloadCert", New SetupEntry(False, Source:=SetupSource.Registry)}, - {"ToolDownloadMod", New SetupEntry(1, Source:=SetupSource.Registry)}, + {"ToolDownloadMod", New SetupEntry(2, Source:=SetupSource.Registry)}, {"ToolModLocalNameStyle", New SetupEntry(0, Source:=SetupSource.Registry)}, {"ToolUpdateAlpha", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)}, {"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)}, @@ -356,13 +357,6 @@ Return Not HasIniKey(Version.Path & "PCL\Setup.ini", Key) End Select End Function - ''' - ''' 某个设置项是否加密。 - ''' - Public Function IsEncoded(Key As String) As Boolean - If Not SetupDict.ContainsKey(Key) Then Throw New KeyNotFoundException("未找到设置项：" & Key) With {.Source = Key} - Return SetupDict(Key).Encoded - End Function ''' ''' 读取设置。 diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml index 4bbbd5e..82c7e31 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml @@ -242,7 +242,7 @@ - + + + - - - + + @@ -79,13 +81,13 @@ - - + - @@ -109,7 +111,7 @@ - + @@ -124,6 +126,7 @@ + @@ -145,7 +148,10 @@ - + + @@ -155,7 +161,7 @@ - + diff --git a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb index 76776f3..7ead8ef 100644 --- a/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb @@ -35,7 +35,7 @@ 'Mod 与整合包 ComboDownloadTranslateV2.SelectedIndex = Setup.Get("ToolDownloadTranslateV2") - 'ComboDownloadMod.SelectedIndex = Setup.Get("ToolDownloadMod") + ComboDownloadMod.SelectedIndex = Setup.Get("ToolDownloadMod") ComboModLocalNameStyle.SelectedIndex = Setup.Get("ToolModLocalNameStyle") CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt") @@ -50,6 +50,7 @@ ComboSystemUpdate.SelectedIndex = Setup.Get("SystemSystemUpdate") ComboSystemActivity.SelectedIndex = Setup.Get("SystemSystemActivity") TextSystemCache.Text = Setup.Get("SystemSystemCache") + CheckSystemTelemetry.Checked = Setup.Get("SystemSystemTelemetry") '调试选项 CheckDebugMode.Checked = Setup.Get("SystemDebugMode") @@ -81,6 +82,7 @@ Setup.Reset("SystemSystemCache") Setup.Reset("SystemSystemUpdate") Setup.Reset("SystemSystemActivity") + Setup.Reset("SystemSystemTelemetry") Log("[Setup] 已初始化启动器页设置") Hint("已初始化启动器页设置！", HintType.Finish, False) @@ -92,13 +94,13 @@ End Sub '将控件改变路由到设置改变 - Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckDebugMode.Change, CheckDebugDelay.Change, CheckDebugSkipCopy.Change, CheckUpdateRelease.Change, CheckUpdateSnapshot.Change, CheckHelpChinese.Change, CheckDownloadIgnoreQuilt.Change, CheckDownloadCert.Change + Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckDebugMode.Change, CheckDebugDelay.Change, CheckDebugSkipCopy.Change, CheckUpdateRelease.Change, CheckUpdateSnapshot.Change, CheckHelpChinese.Change, CheckDownloadIgnoreQuilt.Change, CheckDownloadCert.Change, CheckSystemTelemetry.Change If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked) End Sub Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value) End Sub - Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboModLocalNameStyle.SelectionChanged, ComboDownloadTranslateV2.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged, ComboDownloadSource.SelectionChanged + Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboModLocalNameStyle.SelectionChanged, ComboDownloadTranslateV2.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged, ComboDownloadSource.SelectionChanged, ComboDownloadMod.SelectionChanged If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) End Sub Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml index 67171b6..977fdcf 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml @@ -211,7 +211,7 @@ - + - + \ No newline at end of file diff --git a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb index 6b07ace..6beeaf3 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb @@ -355,6 +355,15 @@ PreFin: #Region "服务器" + '自动替换标点 + Private Sub TextServerEnter_Change() Handles TextServerEnter.TextChanged + Dim NewText = TextServerEnter.Text.Replace("：", ":").Replace("。", ".") + If NewText = TextServerEnter.Text Then Return + Dim CurrentPosition = TextServerEnter.SelectionStart '重设焦点 + TextServerEnter.Text = NewText + TextServerEnter.SelectionStart = CurrentPosition + End Sub + '全局 Private ComboServerLoginLast As Integer Private Sub ComboServerLogin_Changed() Handles ComboServerLogin.SelectionChanged, TextServerNide.ValidatedTextChanged, TextServerAuthServer.ValidatedTextChanged, TextServerAuthRegister.ValidatedTextChanged @@ -399,9 +408,6 @@ PreFin: TextServerAuthName.Text = "LittleSkin 登录" End Sub - Private Shared Sub TextServerEnter_Change(sender As MyTextBox, e As Object) Handles TextServerEnter.LostFocus - sender.Text = sender.Text.Replace("：", ":") - End Sub #End Region #Region "Java 选择" diff --git a/Plain Craft Launcher 2/Resources/Custom.xaml b/Plain Craft Launcher 2/Resources/Custom.xaml index a2459db..c171293 100644 --- a/Plain Craft Launcher 2/Resources/Custom.xaml +++ b/Plain Craft Launcher 2/Resources/Custom.xaml @@ -138,6 +138,10 @@ Text="· 下载版本：切换到 EventData 对应的 Minecraft 下载页面"/> + + diff --git a/Plain Craft Launcher 2/Resources/Help.zip b/Plain Craft Launcher 2/Resources/Help.zip index 8936ebe..224f7d5 100644 Binary files a/Plain Craft Launcher 2/Resources/Help.zip and b/Plain Craft Launcher 2/Resources/Help.zip differ