diff --git a/Plain Craft Launcher 2/Application.xaml.vb b/Plain Craft Launcher 2/Application.xaml.vb index 4080d52..db86a37 100644 --- a/Plain Craft Launcher 2/Application.xaml.vb +++ b/Plain Craft Launcher 2/Application.xaml.vb @@ -19,6 +19,9 @@ Public Class Application '开始 Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup Try + '动态 DLL 调用（必须尽量在前面，否则模块加载 CacheCow 等 DLL 就可能导致崩溃） + AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve + '开始 SecretOnApplicationStart() '检查参数调用 If e.Args.Length > 0 Then @@ -116,8 +119,6 @@ WaitRetry: FrmStart = New SplashScreen("Images\icon.ico") FrmStart.Show(False, True) End If - '动态 DLL 调用 - AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve '日志初始化 LogStart() '添加日志 diff --git a/Plain Craft Launcher 2/Controls/MyImage.vb b/Plain Craft Launcher 2/Controls/MyImage.vb index 1fa2d79..8f6de5b 100644 --- a/Plain Craft Launcher 2/Controls/MyImage.vb +++ b/Plain Craft Launcher 2/Controls/MyImage.vb @@ -121,7 +121,6 @@ RunInNewThread( Sub() Try -RetryStart: '下载 ActualSource = LoadingSource '显示加载中的占位图片 NetDownloadByLoader( diff --git a/Plain Craft Launcher 2/FormMain.xaml.vb b/Plain Craft Launcher 2/FormMain.xaml.vb index 270da2e..7799e8f 100644 --- a/Plain Craft Launcher 2/FormMain.xaml.vb +++ b/Plain Craft Launcher 2/FormMain.xaml.vb @@ -11,6 +11,14 @@ Public Class FormMain Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) '统计更新日志条目 #If BETA Then + If LastVersion < 369 Then 'Release 2.10.8 + FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增：允许在版本设置中设置禁止更新 Mod，以防整合包玩家误操作")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：网络与下载稳定性优化")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化：若整合包需要 PCL 不兼容的加载器，允许选择跳过它的安装")) + FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "删除：由于已不再需要，删除手动安装包下载功能")) + FeatureCount += 21 + BugCount += 32 + End If 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, "修复：正版登录出错时无法给出正确的错误信息")) @@ -96,6 +104,11 @@ Public Class FormMain '3：BUG+ IMP* FEAT- '2：BUG* IMP- '1：BUG- + If LastVersion < 370 Then 'Snapshot 2.10.8 + If LastVersion >= 368 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：网络与下载稳定性优化")) + FeatureCount += 3 + BugCount += 4 + End If If LastVersion < 368 Then 'Snapshot 2.10.7 FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "新增：允许在版本设置中设置禁止更新 Mod，以防整合包玩家误操作")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化：网络与下载稳定性优化")) @@ -590,7 +603,7 @@ Public Class FormMain FeedbackInfo() Log("请在 https://github.com/Meloong-Git/PCL/issues 提交错误报告，以便于作者解决此问题！") IsLogShown = True - ShellOnly(Path & "PCL\Log1.txt") + StartProcess(Path & "PCL\Log1.txt") End If Thread.Sleep(500) '防止 PCL 在记事本打开前就被掐掉 End If diff --git a/Plain Craft Launcher 2/Modules/Base/ModBase.vb b/Plain Craft Launcher 2/Modules/Base/ModBase.vb index ad918bf..8d026e1 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModBase.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModBase.vb @@ -13,13 +13,13 @@ Public Module ModBase #Region "声明" '下列版本信息由更新器自动修改 - Public Const VersionBaseName As String = "2.10.7" '不含分支前缀的显示用版本名 - Public Const VersionStandardCode As String = "2.10.7." & VersionBranchCode '标准格式的四段式版本号 + Public Const VersionBaseName As String = "2.10.8" '不含分支前缀的显示用版本名 + Public Const VersionStandardCode As String = "2.10.8." & VersionBranchCode '标准格式的四段式版本号 Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换 #If BETA Then Public Const VersionCode As Integer = 367 'Release #Else - Public Const VersionCode As Integer = 368 'Snapshot + Public Const VersionCode As Integer = 370 'Snapshot #End If '自动生成的版本信息 Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName @@ -765,17 +765,6 @@ Public Module ModBase Return FilePath End Function ''' - ''' 从文件路径或者 Url 获取不包含路径与扩展名的文件名。不包含文件名将会抛出异常。 - ''' - Public Function GetFileNameWithoutExtentionFromPath(FilePath As String) As String - Dim Name As String = GetFileNameFromPath(FilePath) - If Name.Contains(".") Then - Return Name.Substring(0, Name.LastIndexOfF(".")) - Else - Return Name - End If - End Function - ''' ''' 从文件夹路径获取文件夹名。 ''' Public Function GetFolderNameFromPath(FolderPath As String) As String @@ -791,8 +780,8 @@ Public Module ModBase Public Sub CopyFile(FromPath As String, ToPath As String) Try '还原文件路径 - FromPath = ShortenPath(If(FromPath.Contains(":\"), FromPath, Path & FromPath)) - ToPath = ShortenPath(If(ToPath.Contains(":\"), ToPath, Path & ToPath)) + FromPath = If(FromPath.Contains(":\"), FromPath, Path & FromPath) + ToPath = If(ToPath.Contains(":\"), ToPath, Path & ToPath) '如果复制同一个文件则跳过 If FromPath = ToPath Then Return '确保目录存在 @@ -861,7 +850,7 @@ Public Module ModBase ''' 是否将文件内容追加到当前文件，而不是覆盖它。 Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing) '处理相对路径 - FilePath = ShortenPath(If(FilePath.Contains(":\"), FilePath, Path & FilePath)) + FilePath = If(FilePath.Contains(":\"), FilePath, Path & FilePath) '确保目录存在 Directory.CreateDirectory(GetPathFromFullPath(FilePath)) '写入文件 @@ -886,7 +875,7 @@ Public Module ModBase ''' 是否将文件内容追加到当前文件，而不是覆盖它。 Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False) '处理相对路径 - FilePath = ShortenPath(If(FilePath.Contains(":\"), FilePath, Path & FilePath)) + FilePath = If(FilePath.Contains(":\"), FilePath, Path & FilePath) '确保目录存在 Directory.CreateDirectory(GetPathFromFullPath(FilePath)) '写入文件 @@ -1294,11 +1283,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(ShortenPath(DestDirectory)) + Directory.CreateDirectory(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(ShortenPath(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", "")), FileMode.OpenOrCreate, FileAccess.Write) + Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write) Dim data As Integer = stream.ReadByte() While data <> -1 decompressedFile.WriteByte(data) @@ -1312,13 +1301,10 @@ Re: Dim TotalCount As Long = Archive.Entries.Count For Each Entry As ZipArchiveEntry In Archive.Entries 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 - Directory.CreateDirectory(GetPathFromFullPath(DestinationPath)) - Entry.ExtractToFile(DestinationPath, True) - End If + Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName) + If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then Continue For '不创建空文件夹 + Directory.CreateDirectory(GetPathFromFullPath(DestinationPath)) + Entry.ExtractToFile(DestinationPath, True) Next End Using End If @@ -1342,6 +1328,7 @@ Re: Try Files = Directory.GetFiles(Path) Catch ex As DirectoryNotFoundException '#4549 + If Not Directory.Exists(Path) Then Return 0 '可能已被其他线程删除 Log(ex, $"疑似为孤立符号链接，尝试直接删除（{Path}）", LogLevel.Developer) Directory.Delete(Path) Return 0 @@ -1406,7 +1393,7 @@ RetryDir: ''' 遍历文件夹中的所有文件。 ''' Public Function EnumerateFiles(Directory As String) As IEnumerable(Of FileInfo) - Dim Info As New DirectoryInfo(ShortenPath(Directory)) + Dim Info As New DirectoryInfo(Directory) If Not Info.Exists Then Return New List(Of FileInfo) Return Info.EnumerateFiles("*", SearchOption.AllDirectories) End Function @@ -1414,13 +1401,15 @@ RetryDir: ''' ''' 若路径长度大于指定值，则将长路径转换为短路径。 ''' - Public Function ShortenPath(LongPath As String, Optional ShortenThreshold As Integer = 247) As String - If LongPath.Length <= ShortenThreshold Then Return LongPath + Public Function ShortenPath(LongPath As String) As String + If LongPath.Length <= 200 OrElse LongPath.StartsWithF("http", True) Then Return LongPath + If Not Directory.Exists(LongPath) AndAlso Not File.Exists(LongPath) Then Return LongPath Dim ShortPath As New StringBuilder(260) GetShortPathName(LongPath, ShortPath, 260) - Return ShortPath.ToString + ShortenPath = ShortPath.ToString + If String.IsNullOrEmpty(ShortenPath) Then Return LongPath End Function - Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As StringBuilder, ByVal cchBuffer As Integer) As Integer + Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (lpszLongPath As String, lpszShortPath As StringBuilder, cchBuffer As Integer) As Integer #End Region @@ -1500,7 +1489,7 @@ RetryDir: 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 选择以管理员身份运行，或将目标从 C 盘或桌面挪到其他硬盘。" + Return "PCL 的权限不足。请尝试右键 PCL 选择以管理员身份运行。" ElseIf TypeOf InnerEx Is OutOfMemoryException Then Return "你的电脑运行内存不足，导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。" ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then @@ -2027,8 +2016,8 @@ RetryDir: '构造函数 Public Sub New() End Sub - Public Sub New(data As IEnumerable(Of KeyValuePair(Of TKey, TValue))) - For Each DataItem In data + Public Sub New(Data As IEnumerable(Of KeyValuePair(Of TKey, TValue))) + For Each DataItem In Data _Dictionary.Add(DataItem.Key, DataItem.Value) Next End Sub @@ -2184,7 +2173,7 @@ RetryDir: ''' 返回程序的返回代码，如果运行失败将抛出异常。 ''' Public Function RunAsAdmin(Argument As String) As Integer - Dim NewProcess = Process.Start(New ProcessStartInfo(PathWithName) With {.Verb = "runas", .Arguments = Argument}) + Dim NewProcess = StartProcess(New ProcessStartInfo(PathWithName) With {.Verb = "runas", .Arguments = Argument}) NewProcess.WaitForExit() Return NewProcess.ExitCode End Function @@ -2343,46 +2332,21 @@ NextElement: End Class ''' - ''' 前台运行文件。 + ''' 启动进程并返回进程实例，若失败则抛出异常。 + ''' 会自动进行长路径处理。 ''' - ''' 文件名。可以为“notepad”等缩写。 - ''' 运行参数。 - Public Sub ShellOnly(FileName As String, Optional Arguments As String = "") - Try - FileName = ShortenPath(FileName) - Using Program As New Process - Program.StartInfo.Arguments = Arguments - Program.StartInfo.FileName = FileName - Log("[System] 执行外部命令：" & FileName & " " & Arguments) - Program.Start() - End Using - Catch ex As Exception - Log(ex, "打开文件或程序失败：" & FileName, LogLevel.Msgbox) - End Try - End Sub + Public Function StartProcess(FileName As String, Optional Arguments As String = "") As Process + Return StartProcess(New ProcessStartInfo With {.FileName = FileName, .Arguments = Arguments}) + End Function ''' - ''' 前台运行文件并返回返回值。 + ''' 启动进程并返回进程实例，若失败则抛出异常。 + ''' 会自动进行长路径处理。 ''' - ''' 文件名。可以为“notepad”等缩写。 - ''' 运行参数。 - ''' 等待该程序结束的最长时间（毫秒）。超时会返回 Result.Timeout。 - Public Function ShellAndGetExitCode(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000) As ProcessReturnValues - Try - Using Program As New Process - Program.StartInfo.Arguments = Arguments - Program.StartInfo.FileName = FileName - Log("[System] 执行外部命令并等待返回码：" & FileName & " " & Arguments) - Program.Start() - If Program.WaitForExit(Timeout) Then - Return Program.ExitCode - Else - Return ProcessReturnValues.Timeout - End If - End Using - Catch ex As Exception - Log(ex, "执行命令失败：" & FileName, LogLevel.Msgbox) - Return ProcessReturnValues.Fail - End Try + Public Function StartProcess(StartInfo As ProcessStartInfo) As Process + StartInfo.FileName = ShortenPath(StartInfo.FileName) + If Not String.IsNullOrEmpty(StartInfo.WorkingDirectory) Then StartInfo.WorkingDirectory = ShortenPath(StartInfo.WorkingDirectory) + Log("[System] 启动进程：" & StartInfo.FileName & " " & StartInfo.Arguments) + Return Process.Start(StartInfo) End Function ''' ''' 静默运行文件并返回输出流字符串。执行失败会抛出异常。 @@ -2390,10 +2354,11 @@ NextElement: ''' 文件名。可以为“notepad”等缩写。 ''' 运行参数。 ''' 等待该程序结束的最长时间（毫秒）。超时会抛出错误。 - Public Function ShellAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000, Optional WorkingDirectory As String = Nothing) As String + Public Function StartProcessAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000, + Optional WorkingDirectory As String = Nothing) As String Dim Info = New ProcessStartInfo With { .Arguments = Arguments, - .FileName = FileName, + .FileName = ShortenPath(FileName), .UseShellExecute = False, .CreateNoWindow = True, .RedirectStandardError = True, @@ -2408,7 +2373,7 @@ NextElement: End If End If Log("[System] 执行外部命令并等待返回结果：" & FileName & " " & Arguments) - Using Program As New Process() With {.StartInfo = Info} + Using Program As New Process With {.StartInfo = Info} Program.Start() Dim Result As String = Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd Program.WaitForExit(Timeout) @@ -2510,17 +2475,14 @@ NextElement: ''' ''' 尝试从字典中获取某项，如果该项不存在，则返回默认值。 ''' - Public Function GetOrDefault(Of TKey, TValue)(Dict As Dictionary(Of TKey, TValue), Key As TKey, Optional DefaultValue As TValue = Nothing) As TValue - If Dict.ContainsKey(Key) Then - Return Dict(Key) - Else - Return DefaultValue - End If + Public Function GetOrDefault(Of TKey, TValue)(Dict As IDictionary(Of TKey, TValue), Key As TKey, Optional DefaultValue As TValue = Nothing) As TValue + Dim Result As TValue + Return If(Dict.TryGetValue(Key, Result), Result, DefaultValue) End Function ''' ''' 将某项添加到以列表作为值的字典中。 ''' - Public Sub AddToList(Of TKey, TValue)(Dict As Dictionary(Of TKey, List(Of TValue)), Key As TKey, Value As TValue) + Public Sub AddToList(Of TKey, TValue)(Dict As IDictionary(Of TKey, List(Of TValue)), Key As TKey, Value As TValue) If Dict.ContainsKey(Key) Then Dict(Key).Add(Value) Else @@ -2568,7 +2530,7 @@ NextElement: Throw New Exception(Url & " 不是一个有效的网址，它必须以 http 开头！") End If Log("[System] 正在打开网页：" & Url) - Process.Start(Url) + StartProcess(Url) Catch ex As Exception Log(ex, "无法打开网页（" & Url & "）") ClipboardSet(Url, False) @@ -2582,12 +2544,12 @@ NextElement: ''' Public Sub OpenExplorer(Location As String) Try - Location = ShortenPath(Location.Replace("/", "\").Trim(" "c, """"c)) + Location = Location.Replace("/", "\").Trim(" "c, """"c) Log("[System] 正在打开资源管理器：" & Location) If Location.EndsWith("\") Then - ShellOnly(Location) + StartProcess(Location) Else - ShellOnly("explorer", $"/select,""{Location}""") + StartProcess("explorer", $"/select,""{Location}""") End If Catch ex As Exception Log(ex, "打开资源管理器失败，请尝试关闭安全软件（如 360 安全卫士）", LogLevel.Msgbox) diff --git a/Plain Craft Launcher 2/Modules/Base/ModNet.vb b/Plain Craft Launcher 2/Modules/Base/ModNet.vb index dc065af..806da0b 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModNet.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModNet.vb @@ -1,9 +1,7 @@ Imports System.Net.Http.Headers Imports System.Net.Sockets Imports System.Runtime.CompilerServices -Imports System.Security.Policy Imports System.Threading.Tasks -Imports CacheCow.Client Public Module ModNet @@ -75,6 +73,11 @@ Retry: Catch ex As ThreadInterruptedException Throw Catch ex As Exception + If TypeOf ex Is ResponsedWebException Then + If CType(ex, ResponsedWebException).StatusCode = HttpStatusCode.Forbidden Then Throw + If CType(ex, ResponsedWebException).StatusCode = 429 Then Thread.Sleep(10000) 'Too Many Requests + End If + '重试 Select Case RetryCount Case 0 RetryException = ex @@ -245,8 +248,20 @@ RequestFinished: SecretHeadersSign(Url, Request, SimulateBrowserHeaders) 'DNS 解析 CancelToken = New CancellationTokenSource(Timeout) - HostIp = DnsLookup(Request, CancelToken) + HostIp = DNSLookup(Request, CancelToken) + If HostIp IsNot Nothing AndAlso Not IPReliability.ContainsKey(HostIp) Then + IPReliability(HostIp) = -0.01 '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率 + End If '发送请求 + SyncLock RequestClientLock + '延迟初始化，以避免在程序启动前加载 CacheCow 导致 DLL 加载失败 + If RequestClient Is Nothing Then + RequestClient = CacheCow.Client.ClientExtensions.CreateClient(New CacheCow.Client.FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With { + .AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None, + .UseCookies = False '不设为 False 就不能从 Header 手动传入 Cookies + }) + End If + End SyncLock Response = RequestClient.SendAsync(Request, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult() Dim ResponseStream = Response.Content.ReadAsStreamAsync().GetAwaiter().GetResult() Dim ResponseBytes As Byte() @@ -263,18 +278,18 @@ RequestFinished: Dim ResponseMessage = If(Encoding, Encoding.UTF8).GetString(ResponseBytes) Throw New ResponsedWebException( $"错误码 {Response.StatusCode} ({CInt(Response.StatusCode)})，{Method}，{Url}，{HostIp}" & - If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), ResponseMessage) + If(String.IsNullOrEmpty(ResponseMessage), "", vbCrLf & ResponseMessage), Response.StatusCode, ResponseMessage) End If Catch ex As ThreadInterruptedException Throw Catch ex As ResponsedWebException Throw - Catch ex As DnsLookupException - Throw Catch ex As Exception RecordIPReliability(HostIp, -1) If TypeOf ex Is OperationCanceledException Then 'CancellationToken 超时 - Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，{HostIp}）", WebExceptionStatus.Timeout) + Throw New WebException($"连接服务器超时，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout) + ElseIf ex.IsNetworkRelated Then + Throw New WebException($"网络请求失败，请稍后再试，或使用 VPN 改善网络环境（{Method}, {Url}，IP：{HostIp}）", WebExceptionStatus.Timeout) Else Throw New Exception($"网络请求出现意外异常（{Method}, {Url}，{HostIp}）", ex) End If @@ -284,17 +299,15 @@ RequestFinished: Response?.Dispose() End Try End Function - Private RequestClient As HttpClient = ClientExtensions.CreateClient(New FileCacheStore.FileStore(PathTemp & "Cache/Http/"), New HttpClientHandler With { - .AutomaticDecompression = DecompressionMethods.Deflate Or DecompressionMethods.GZip Or DecompressionMethods.None, - .UseCookies = False '不设为 False 就不能从 Header 手动传入 Cookies - }) + Private RequestClient As HttpClient = Nothing + Private RequestClientLock As New Object ''' ''' 进行 DNS 解析。它仅在选择的 IP 与系统默认的不一致时才对 URL 中的 Host 进行替换。 ''' 返回请求时应使用的 IP；若为 IPv6，则加上了方括号。 + ''' 若解析失败，则返回 Nothing。 ''' - ''' - Private Function DnsLookup(Request As HttpRequestMessage, CancelToken As CancellationTokenSource) As String + Private Function DNSLookup(Request As HttpRequestMessage, CancelToken As CancellationTokenSource) As String Dim GetIPReliability = Function(Key) IPReliability.GetOrDefault(Key.ToString, 0) '初步 DNS 解析 Dim Host = Request.RequestUri.Host @@ -303,10 +316,14 @@ RequestFinished: DnsTask = Dns.GetHostAddressesAsync(Host) DnsTask.Wait(CancelToken.Token) Catch ex As Exception - Throw New DnsLookupException($"DNS 解析失败，请检查你的网络连接（{Host}）", ex) + Log(ex, $"DNS 解析失败（{Host}）") + Return Nothing End Try Dim Candidates As IPAddress() = DnsTask.Result.ToArray - If Not Candidates.Any Then Throw New DnsLookupException($"DNS 解析无结果，请检查你的网络连接（{Host}）") + If Not Candidates.Any Then + Log($"[Net] DNS 解析无结果（{Host}）") + Return Nothing + End If '若同时存在 IPv4 和 IPv6 地址，仅选择其中一类（因为 GFW 可能只屏蔽了 IPv4 或 IPv6） Dim IPv4Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetwork).ToArray Dim IPv6Targets = Candidates.Where(Function(i) i.AddressFamily = AddressFamily.InterNetworkV6).ToArray @@ -322,20 +339,19 @@ RequestFinished: Dim TargetIp As String = If(Target.AddressFamily = AddressFamily.InterNetworkV6, $"[{Target}]", Target.ToString) If Target IsNot Candidates.First Then '优选结果与系统默认 IP 不一致，替换域名并设置 Host 头 - If ModeDebug Then Log($"[Net] DNS 结果：{Host} → {Target}，所有可能的 IP 与可靠度：{DnsTask.Result.Select(Function(i) $"{i} → {GetIPReliability(i):0.000}").Join("；")}") + If ModeDebug Then Log($"[Net] DNS 解析结果：{Host} → {Target}，所有可能的 IP 与可靠度：{DnsTask.Result.Select(Function(i) $"{i} → {GetIPReliability(i):0.000}").Join("；")}") Request.Headers.Host = Host Dim Builder As New UriBuilder(Request.RequestUri) Builder.Host = TargetIp Request.RequestUri = Builder.Uri End If - If Not IPReliability.ContainsKey(TargetIp) Then IPReliability(TargetIp) = -0.01 '预先降低一点，这样快速的重复请求会使用不同的 IP 以提高成功率 Return TargetIp End Function ''' ''' 记录每个 IP 地址的请求可靠度。 ''' 通常取值 -1 ~ +0.5，越高越好。未尝试过的 IP 应视为 0。 ''' - Private IPReliability As New Dictionary(Of String, Double) + Private IPReliability As New SafeDictionary(Of String, Double) ''' ''' 根据请求结果，记录 IP 地址的可靠度。 ''' @@ -346,29 +362,22 @@ RequestFinished: End Sub ''' - ''' DNS 解析失败引发的异常。 - ''' - Private Class DnsLookupException - Inherits Exception - Public Sub New(Message As String, Optional InnerException As Exception = Nothing) - MyBase.New(Message, InnerException) - End Sub - Public Sub New(Message As String) - MyBase.New(Message) - End Sub - End Class - ''' - ''' 当网络请求失败时引发的异常。 - ''' 附带 Response 属性，可用于获取远程服务器给予的回复。 + ''' 当 HTTP 状态码不指示成功时引发的异常。 + ''' 附带额外属性，可用于获取远程服务器给予的回复以及 HTTP 状态码。 ''' Public Class ResponsedWebException Inherits WebException ''' + ''' HTTP 状态码。 + ''' + Public StatusCode As HttpStatusCode + ''' ''' 远程服务器给予的回复。 ''' Public Overloads Property Response As String - Public Sub New(Message As String, Response As String) + Public Sub New(Message As String, StatusCode As HttpStatusCode, Response As String) MyBase.New(Message) + Me.StatusCode = StatusCode Me.Response = Response End Sub End Class @@ -750,7 +759,7 @@ RequestFinished: ''' Public Check As FileChecker ''' - ''' 下载时是否添加浏览器 UA。 + ''' 是否模拟浏览器的 UserAgent 和 Referer。 ''' Public SimulateBrowserHeaders As Boolean @@ -969,7 +978,7 @@ StartThread: If ModeDebug OrElse Th.DownloadStart = 0 Then Log($"[Download] {LocalName}：开始，起始点 {Th.DownloadStart}，{Th.Source.Url}") Dim ResultStream As Stream = Nothing, HttpRequest As HttpRequestMessage = Nothing, Response As HttpResponseMessage = Nothing, ResponseStream As Stream = Nothing, - CancelToken As CancellationTokenSource = Nothing, HostIp As String = "" + CancelToken As CancellationTokenSource = Nothing, HostIp As String = Nothing '部分下载源真的特别慢，并且只需要一个请求，例如 Ping 为 20s，如果增长太慢，就会造成类似 2.5s 5s 7.5s 10s 12.5s... 的极大延迟 '延迟过长会导致某些特别慢的链接迟迟不被掐死 Dim Timeout As Integer = Math.Min(Math.Max(ConnectAverage, 6000) * (1 + Th.Source.FailCount), 30000) @@ -980,7 +989,7 @@ StartThread: HttpRequest = New HttpRequestMessage(HttpMethod.Get, Th.Source.Url) SecretHeadersSign(Th.Source.Url, HttpRequest, SimulateBrowserHeaders) CancelToken = New CancellationTokenSource(Timeout) - HostIp = DnsLookup(HttpRequest, CancelToken) 'DNS 预解析 + HostIp = DNSLookup(HttpRequest, CancelToken) 'DNS 预解析 If Not Th.IsFirstThread Then HttpRequest.Headers.Range = New RangeHeaderValue(Th.DownloadStart, Nothing) Dim ContentLength As Long = 0 Response = ThreadClient.SendAsync(HttpRequest, HttpCompletionOption.ResponseHeadersRead, CancelToken.Token).GetAwaiter().GetResult() @@ -1126,7 +1135,7 @@ SourceBreak: RecordIPReliability(HostIp, 0.5) End If Catch ex As Exception - Log($"[Download] {LocalName}：出错，{If(TypeOf ex Is OperationCanceledException, $"已超时（{Timeout}ms）", ex.GetDetail())}，{HostIp}") + Log($"[Download] {LocalName}：出错，{If(TypeOf ex Is OperationCanceledException, $"已超时（{Timeout}ms）", ex.GetDetail())}，IP：{HostIp}") RecordIPReliability(HostIp, -0.7) SourceFail(Th, ex, False) Finally @@ -1864,7 +1873,7 @@ Retry: End Sub Private IsManagerStarted As Boolean = False - 'Public FileRemainList As New List(Of String) + Private DownloadCacheLock As New Object Private IsDownloadCacheCleared As Boolean = False ''' ''' 开始一个下载任务。 @@ -1872,15 +1881,19 @@ Retry: Public Sub Start(Task As LoaderDownload) StartManager() '清理缓存 - If Not IsDownloadCacheCleared Then - Try - DeleteDirectory(PathTemp & "Download") - Catch ex As Exception - Log(ex, "清理下载缓存失败") - End Try + SyncLock DownloadCacheLock '防止同时开启多个下载任务时重复清理 + If Not IsDownloadCacheCleared Then + Try + Log("[Net] 开始清理下载缓存") + DeleteDirectory(PathTemp & "Download") + Log("[Net] 下载缓存已清理") + Catch ex As Exception + Log(ex, "清理下载缓存失败") + End Try + Directory.CreateDirectory(PathTemp & "Download") + End If IsDownloadCacheCleared = True - End If - Directory.CreateDirectory(PathTemp & "Download") + End SyncLock '文件处理 SyncLock LockFiles '添加每个文件 @@ -1959,11 +1972,12 @@ Retry: ''' 判断某个 Exception 是否为网络问题所导致。 ''' Public Function IsNetworkRelated(Ex As Exception) As Boolean - If TypeOf Ex Is DnsLookupException Then Return True Dim Detail = Ex.GetDetail() If Detail.Contains("(403)") Then Return False - Return {"(408)", "超时", "timeout", "网络请求失败", "连接尝试失败", "远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝"}. - Any(Function(k) Detail.ContainsF(k, True)) + Return { + "(408)", "超时", "timeout", "网络请求失败", "连接尝试失败", "远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", + "由于目标计算机积极拒绝", "基础连接已经关闭" + }.Any(Function(k) Detail.ContainsF(k, True)) End Function End Module diff --git a/Plain Craft Launcher 2/Modules/Base/ModValidate.vb b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb index b8181e8..54e9859 100644 --- a/Plain Craft Launcher 2/Modules/Base/ModValidate.vb +++ b/Plain Craft Launcher 2/Modules/Base/ModValidate.vb @@ -148,7 +148,7 @@ End Class ''' Public Class ValidateExcept Inherits Validate - Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String) + Public Property Excepts As New ObjectModel.Collection(Of String) Public Property ErrorMessage As String Public Sub New() ErrorMessage = "输入内容不能包含 %" @@ -157,12 +157,15 @@ Public Class ValidateExcept Me.Excepts = Excepts Me.ErrorMessage = ErrorMessage End Sub - Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能包含 %") - Me.Excepts = New ObjectModel.Collection(Of String) - Me.ErrorMessage = ErrorMessage - For Each Data As String In Excepts - Me.Excepts.Add(Data) - Next + Public Sub New(Excepts As IEnumerable(Of String), Optional ErrorMessage As String = "输入内容不能包含 %") + Me.New( + New ObjectModel.Collection(Of String)(New List(Of String)(Excepts)), + ErrorMessage) + End Sub + Public Sub New(Excepts As IEnumerable(Of Char), Optional ErrorMessage As String = "输入内容不能包含 %") + Me.New( + New ObjectModel.Collection(Of String)(Excepts.Select(Function(c) c.ToString).ToList), + ErrorMessage) End Sub Public Overrides Function Validate(Str As String) As String For Each Ch As String In Excepts @@ -181,7 +184,7 @@ End Class ''' Public Class ValidateExceptSame Inherits Validate - Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String) + Public Property Excepts As New ObjectModel.Collection(Of String) Public Property ErrorMessage As String Public Property IgnoreCase As Boolean = False Public Sub New() @@ -192,17 +195,14 @@ Public Class ValidateExceptSame Me.IgnoreCase = IgnoreCase End Sub Public Sub New(Excepts As IEnumerable(Of String), Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False) - Me.Excepts = New ObjectModel.Collection(Of String) - For Each Data As String In Excepts - Me.Excepts.Add(Data) - Next - Me.ErrorMessage = ErrorMessage - Me.IgnoreCase = IgnoreCase + Me.New( + New ObjectModel.Collection(Of String)(New List(Of String)(Excepts)), + ErrorMessage, IgnoreCase) End Sub Public Sub New(Except As String, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False) - Me.Excepts = New ObjectModel.Collection(Of String) From {Except} - Me.ErrorMessage = ErrorMessage - Me.IgnoreCase = IgnoreCase + Me.New( + New ObjectModel.Collection(Of String) From {Except}, + ErrorMessage, IgnoreCase) End Sub Public Overrides Function Validate(Str As String) As String If Str Is Nothing Then Return ErrorMessage.Replace("%", "null") diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb index 0ce9566..bc11865 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb @@ -871,11 +871,11 @@ NextStack: Sub() '弹窗选择：查看日志 If File.Exists(DirectFile.Value.Key) Then - ShellOnly(DirectFile.Value.Key) + StartProcess(DirectFile.Value.Key) Else Dim FilePath As String = PathTemp & "Crash.txt" WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf)) - ShellOnly(FilePath) + StartProcess(FilePath) End If End Sub)) Case 3 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb index d85c884..d84592b 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb @@ -98,7 +98,7 @@ If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326 IsJre = Not File.Exists(PathFolder & "javac.exe") '运行 -version - Output = ShellAndGetOutput(PathJava, "-version", 15000).ToLower + Output = StartProcessAndGetOutput(PathJava, "-version", 15000).ToLower If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败") If ModeDebug Then Log("[Java] Java 检查输出：" & PathJava & vbCrLf & Output) If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java，请在删除 Java 文件夹中的 /lib/ext 文件夹后再试") @@ -445,8 +445,8 @@ NoUserJava: ''' 将 Java 按照适用性排序。 ''' Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean - Dim PathInfo As New DirectoryInfo(ShortenPath(Path)) - Dim PathMcInfo As New DirectoryInfo(ShortenPath(PathMcFolder)) + Dim PathInfo As New DirectoryInfo(Path) + Dim PathMcInfo As New DirectoryInfo(PathMcFolder) '1. 尽量在当前文件夹或当前 Minecraft 文件夹 Dim ProgramPathParent As String, MinecraftPathParent As String = "" ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName @@ -646,7 +646,7 @@ Wait: Private Sub JavaSearchFolder(OriginalPath As String, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False) Try Log("[Java] 开始" & If(IsFullSearch, "完全", "部分") & "遍历查找：" & OriginalPath) - JavaSearchFolder(New DirectoryInfo(ShortenPath(OriginalPath)), Results, Source, IsFullSearch) + JavaSearchFolder(New DirectoryInfo(OriginalPath), Results, Source, IsFullSearch) Catch ex As UnauthorizedAccessException Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹：" & OriginalPath) Catch ex As Exception diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb index 644ce97..ccaddd1 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb @@ -695,7 +695,7 @@ LoginFinish: '发送登录请求 Dim RequestData As New JObject( New JProperty("accessToken", AccessToken), New JProperty("clientToken", ClientToken), New JProperty("requestUser", True)) - NetRequestByClient( + NetRequestByClientRetry( Data.Input.BaseUrl & "/validate", HttpMethod.Post, Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None), Headers:={{"Accept-Language", "zh-CN"}}, @@ -1827,9 +1827,9 @@ NextVersion: ''' Private Function GetNativesFolder() As String Dim Result As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives" - If IsGBKEncoding OrElse Result.IsASCII() Then Return Result + If IsGBKEncoding OrElse Result.IsASCII() Then Return ShortenPath(Result) Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives" - If Result.IsASCII() Then Return Result + If Result.IsASCII() Then Return ShortenPath(Result) Return OsDrive & "ProgramData\PCL\natives" End Function @@ -2159,14 +2159,15 @@ IgnoreCustomSkin: '执行自定义命令 If CustomCommandGlobal <> "" Then McLaunchLog("正在执行全局自定义命令：" & CustomCommandGlobal) - Dim CustomProcess As New Process + Dim CustomProcess As Process = Nothing Try - CustomProcess.StartInfo.FileName = "cmd.exe" - CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandGlobal & """" - CustomProcess.StartInfo.WorkingDirectory = ShortenPath(PathMcFolder) - CustomProcess.StartInfo.UseShellExecute = False - CustomProcess.StartInfo.CreateNoWindow = True - CustomProcess.Start() + CustomProcess = StartProcess(New ProcessStartInfo With { + .FileName = "cmd.exe", + .Arguments = $"/c ""{CustomCommandGlobal}""", + .WorkingDirectory = PathMcFolder, + .UseShellExecute = False, + .CreateNoWindow = True + }) If Setup.Get("LaunchAdvanceRunWait") Then Do Until CustomProcess.HasExited OrElse Loader.IsAborted Thread.Sleep(10) @@ -2175,7 +2176,7 @@ IgnoreCustomSkin: Catch ex As Exception Log(ex, "执行全局自定义命令失败", LogLevel.Hint) Finally - If Not CustomProcess.HasExited AndAlso Loader.IsAborted Then + If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsAborted Then McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183 CustomProcess.Kill() End If @@ -2183,14 +2184,15 @@ IgnoreCustomSkin: End If If CustomCommandVersion <> "" Then McLaunchLog("正在执行版本自定义命令：" & CustomCommandVersion) - Dim CustomProcess As New Process + Dim CustomProcess As Process = Nothing Try - CustomProcess.StartInfo.FileName = "cmd.exe" - CustomProcess.StartInfo.Arguments = "/c """ & CustomCommandVersion & """" - CustomProcess.StartInfo.WorkingDirectory = ShortenPath(PathMcFolder) - CustomProcess.StartInfo.UseShellExecute = False - CustomProcess.StartInfo.CreateNoWindow = True - CustomProcess.Start() + CustomProcess = StartProcess(New ProcessStartInfo With { + .FileName = "cmd.exe", + .Arguments = $"/c ""{CustomCommandVersion}""", + .WorkingDirectory = PathMcFolder, + .UseShellExecute = False, + .CreateNoWindow = True + }) If Setup.Get("VersionAdvanceRunWait", Version:=McVersionCurrent) Then Do Until CustomProcess.HasExited OrElse Loader.IsAborted Thread.Sleep(10) @@ -2199,7 +2201,7 @@ IgnoreCustomSkin: Catch ex As Exception Log(ex, "执行版本自定义命令失败", LogLevel.Hint) Finally - If Not CustomProcess.HasExited AndAlso Loader.IsAborted Then + If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsAborted Then McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183 CustomProcess.Kill() End If @@ -2210,7 +2212,6 @@ IgnoreCustomSkin: Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process)) '启动信息 - Dim GameProcess = New Process() Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJava) '使用 javaw.exe 会导致 #6263 '设置环境变量 @@ -2220,16 +2221,15 @@ IgnoreCustomSkin: StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder) '设置其他参数 - StartInfo.WorkingDirectory = ShortenPath(McVersionCurrent.PathIndie) + StartInfo.WorkingDirectory = McVersionCurrent.PathIndie StartInfo.UseShellExecute = False StartInfo.RedirectStandardOutput = True StartInfo.RedirectStandardError = True StartInfo.CreateNoWindow = True StartInfo.Arguments = McLaunchArgument - GameProcess.StartInfo = StartInfo '开始进程 - GameProcess.Start() + Dim GameProcess = StartProcess(StartInfo) McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.PathJava) If Loader.IsAborted Then McLaunchLog("由于取消启动，已强制结束游戏进程") '#1631 diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb index db5e47a..764bafb 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb @@ -73,7 +73,7 @@ Public Module ModMod Get If _Name Is Nothing Then Load() If _Name Is Nothing Then _Name = _ModId - If _Name Is Nothing Then _Name = GetFileNameWithoutExtentionFromPath(Path) + If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path) Return _Name End Get Set(value As String) diff --git a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb index 29271c5..a2d7783 100644 --- a/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb +++ b/Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb @@ -335,7 +335,7 @@ Retry: File.Delete(Target) End If Next - If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then + If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then Log("[ModPack] 删除安装整合包文件：" & FileAddress) File.Delete(FileAddress) End If @@ -476,7 +476,7 @@ Retry: File.Delete(Target) End If Next - If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then + If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then Log("[ModPack] 删除安装整合包文件：" & FileAddress) File.Delete(FileAddress) End If @@ -795,7 +795,7 @@ Retry: Log("[Modpack] 找到压缩包中附带的启动器：" & Launcher) If MyMsgBox($"整合包里似乎自带了启动器，是否换用它继续安装？{vbCrLf}即将打开：{Launcher}", "换用整合包启动器？", "换用", "不换用") = 1 Then OpenExplorer(TargetFolder) - ShellOnly(Launcher, "--wait") '要求等待已有的 PCL 退出 + StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出 Log("[Modpack] 为换用整合包中的启动器启动，强制结束程序") FrmMain.EndProgram(False) Return diff --git a/Plain Craft Launcher 2/Modules/ModEvent.vb b/Plain Craft Launcher 2/Modules/ModEvent.vb index 87e9bf5..f566cbc 100644 --- a/Plain Craft Launcher 2/Modules/ModEvent.vb +++ b/Plain Craft Launcher 2/Modules/ModEvent.vb @@ -45,9 +45,9 @@ Dim Info As New ProcessStartInfo With { .Arguments = If(Data.Length >= 2, Data(1), ""), .FileName = Location, - .WorkingDirectory = ShortenPath(WorkingDir) + .WorkingDirectory = WorkingDir } - Process.Start(Info) + StartProcess(Info) End If Catch ex As Exception Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox) diff --git a/Plain Craft Launcher 2/Modules/ModMusic.vb b/Plain Craft Launcher 2/Modules/ModMusic.vb index dc129ec..0476e89 100644 --- a/Plain Craft Launcher 2/Modules/ModMusic.vb +++ b/Plain Craft Launcher 2/Modules/ModMusic.vb @@ -79,7 +79,7 @@ If MusicState = MusicStates.Pause Then FrmMain.BtnExtraMusic.Logo = Logo.IconPlay FrmMain.BtnExtraMusic.LogoScale = 0.8 - ToolTipText = "已暂停：" & GetFileNameWithoutExtentionFromPath(MusicCurrent) + ToolTipText = "已暂停：" & IO.Path.GetFileNameWithoutExtension(MusicCurrent) If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。" Else @@ -88,7 +88,7 @@ Else FrmMain.BtnExtraMusic.Logo = Logo.IconMusic FrmMain.BtnExtraMusic.LogoScale = 1 - ToolTipText = "正在播放：" & GetFileNameWithoutExtentionFromPath(MusicCurrent) + ToolTipText = "正在播放：" & IO.Path.GetFileNameWithoutExtension(MusicCurrent) If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。" Else diff --git a/Plain Craft Launcher 2/Modules/ModSecret.vb b/Plain Craft Launcher 2/Modules/ModSecret.vb index f0d622f..672ea2a 100644 --- a/Plain Craft Launcher 2/Modules/ModSecret.vb +++ b/Plain Craft Launcher 2/Modules/ModSecret.vb @@ -81,13 +81,14 @@ Friend Module ModSecret ''' 设置 Headers 的 UA、Referer。 ''' Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional SimulateBrowserHeaders As Boolean = False) - If Req.Headers.UserAgent.Any Then Return - If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then - Req.Headers.Add("User-Agent", "LogStatistic") '#4951 - ElseIf SimulateBrowserHeaders Then - Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36") - Else - Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode}") + If Not Req.Headers.UserAgent.Any Then + If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then + Req.Headers.Add("User-Agent", "LogStatistic") '#4951 + ElseIf SimulateBrowserHeaders Then + Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36") + Else + Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode}") + End If End If If Not SimulateBrowserHeaders Then Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/") If Url.Contains("api.curseforge.com") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey) diff --git a/Plain Craft Launcher 2/My Project/AssemblyInfo.vb b/Plain Craft Launcher 2/My Project/AssemblyInfo.vb index d781a20..ac15996 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/PageDownload/Comp/PageDownloadCompDetail.xaml.vb b/Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml.vb index 63125e2..9d2dae5 100644 --- a/Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageDownload/Comp/PageDownloadCompDetail.xaml.vb @@ -424,7 +424,7 @@ If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder) If Not Target.Contains("\") Then Return '构造步骤加载器 - Dim LoaderName As String = Desc & "下载：" & GetFileNameWithoutExtentionFromPath(Target) & " " + Dim LoaderName As String = Desc & "下载：" & IO.Path.GetFileNameWithoutExtension(Target) & " " If Target <> DefaultFolder Then CachedFolder(Project.Type) = GetPathFromFullPath(Target) Dim Loaders As New List(Of LoaderBase) Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True}) diff --git a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml index 38f1c20..0f8afa1 100644 --- a/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml +++ b/Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml @@ -171,6 +171,7 @@ + diff --git a/Plain Craft Launcher 2/Pages/PageVersion/MyLocalModItem.xaml.vb b/Plain Craft Launcher 2/Pages/PageVersion/MyLocalModItem.xaml.vb index 4ab3662..4c9632c 100644 --- a/Plain Craft Launcher 2/Pages/PageVersion/MyLocalModItem.xaml.vb +++ b/Plain Craft Launcher 2/Pages/PageVersion/MyLocalModItem.xaml.vb @@ -344,14 +344,11 @@ Public Class MyLocalModItem End If '标题与描述 Dim DescFileName As String - Select Case Entry.State - Case McMod.McModState.Fine - DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path) - Case McMod.McModState.Disabled - DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", "")) - Case Else 'McMod.McModState.Unavailable - DescFileName = GetFileNameFromPath(Entry.Path) - End Select + If Entry.State = McMod.McModState.Fine OrElse Entry.State = McMod.McModState.Disabled Then + DescFileName = IO.Path.GetFileNameWithoutExtension(Entry.Path) + Else + DescFileName = GetFileNameFromPath(Entry.Path) + End If Dim NewDescription As String If Setup.Get("ToolModLocalNameStyle") = 1 Then '标题显示文件名，详情显示译名