This commit is contained in:
龙腾猫跃
2025-09-12 23:40:01 +08:00
parent 2210da6fda
commit 6f6744dfd2
18 changed files with 200 additions and 212 deletions
+3 -2
View File
@@ -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()
'添加日志
@@ -121,7 +121,6 @@
RunInNewThread(
Sub()
Try
RetryStart:
'下载
ActualSource = LoadingSource '显示加载中的占位图片
NetDownloadByLoader(
+14 -1
View File
@@ -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
+47 -85
View File
@@ -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
''' <summary>
''' 从文件路径或者 Url 获取不包含路径与扩展名的文件名。不包含文件名将会抛出异常。
''' </summary>
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
''' <summary>
''' 从文件夹路径获取文件夹名。
''' </summary>
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
''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
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
''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
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:
''' </summary>
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
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)
End If
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:
''' 遍历文件夹中的所有文件。
''' </summary>
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:
''' <summary>
''' 若路径长度大于指定值,则将长路径转换为短路径。
''' </summary>
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:
''' 返回程序的返回代码,如果运行失败将抛出异常。
''' </summary>
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
''' <summary>
''' 前台运行文件。
''' 启动进程并返回进程实例,若失败则抛出异常。
''' 会自动进行长路径处理。
''' </summary>
''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
''' <param name="Arguments">运行参数。</param>
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
''' <summary>
''' 前台运行文件并返回返回值。
''' 启动进程并返回进程实例,若失败则抛出异常。
''' 会自动进行长路径处理。
''' </summary>
''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
''' <param name="Arguments">运行参数。</param>
''' <param name="Timeout">等待该程序结束的最长时间(毫秒)。超时会返回 Result.Timeout。</param>
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
''' <summary>
''' 静默运行文件并返回输出流字符串。执行失败会抛出异常。
@@ -2390,10 +2354,11 @@ NextElement:
''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
''' <param name="Arguments">运行参数。</param>
''' <param name="Timeout">等待该程序结束的最长时间(毫秒)。超时会抛出错误。</param>
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:
''' <summary>
''' 尝试从字典中获取某项,如果该项不存在,则返回默认值。
''' </summary>
<Extension> 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
<Extension> 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
''' <summary>
''' 将某项添加到以列表作为值的字典中。
''' </summary>
<Extension> Public Sub AddToList(Of TKey, TValue)(Dict As Dictionary(Of TKey, List(Of TValue)), Key As TKey, Value As TValue)
<Extension> 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:
''' </summary>
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)
+57 -43
View File
@@ -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
''' <summary>
''' 进行 DNS 解析。它仅在选择的 IP 与系统默认的不一致时才对 URL 中的 Host 进行替换。
''' 返回请求时应使用的 IP;若为 IPv6,则加上了方括号。
''' 若解析失败,则返回 Nothing。
''' </summary>
''' <exception cref="DnsLookupException"></exception>
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
''' <summary>
''' 记录每个 IP 地址的请求可靠度。
''' 通常取值 -1 ~ +0.5,越高越好。未尝试过的 IP 应视为 0。
''' </summary>
Private IPReliability As New Dictionary(Of String, Double)
Private IPReliability As New SafeDictionary(Of String, Double)
''' <summary>
''' 根据请求结果,记录 IP 地址的可靠度。
''' </summary>
@@ -346,29 +362,22 @@ RequestFinished:
End Sub
''' <summary>
''' DNS 解析失败引发的异常。
''' </summary>
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
''' <summary>
''' 当网络请求失败时引发的异常。
''' 附带 Response 属性,可用于获取远程服务器给予的回复。
''' 当 HTTP 状态码不指示成功时引发的异常。
''' 附带额外属性,可用于获取远程服务器给予的回复以及 HTTP 状态码。
''' </summary>
Public Class ResponsedWebException
Inherits WebException
''' <summary>
''' HTTP 状态码。
''' </summary>
Public StatusCode As HttpStatusCode
''' <summary>
''' 远程服务器给予的回复。
''' </summary>
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:
''' </summary>
Public Check As FileChecker
''' <summary>
''' 下载时是否添加浏览器 UA。
''' 是否模拟浏览器的 UserAgent 和 Referer。
''' </summary>
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
''' <summary>
''' 开始一个下载任务。
@@ -1872,15 +1881,19 @@ Retry:
Public Sub Start(Task As LoaderDownload)
StartManager()
'清理缓存
SyncLock DownloadCacheLock '防止同时开启多个下载任务时重复清理
If Not IsDownloadCacheCleared Then
Try
Log("[Net] 开始清理下载缓存")
DeleteDirectory(PathTemp & "Download")
Log("[Net] 下载缓存已清理")
Catch ex As Exception
Log(ex, "清理下载缓存失败")
End Try
IsDownloadCacheCleared = True
End If
Directory.CreateDirectory(PathTemp & "Download")
End If
IsDownloadCacheCleared = True
End SyncLock
'文件处理
SyncLock LockFiles
'添加每个文件
@@ -1959,11 +1972,12 @@ Retry:
''' 判断某个 Exception 是否为网络问题所导致。
''' </summary>
<Extension> 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
@@ -148,7 +148,7 @@ End Class
''' </summary>
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
''' </summary>
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")
@@ -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
@@ -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 按照适用性排序。
''' </summary>
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
@@ -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:
''' </summary>
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
@@ -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)
@@ -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
+2 -2
View File
@@ -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)
+2 -2
View File
@@ -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
+2 -1
View File
@@ -81,7 +81,7 @@ Friend Module ModSecret
''' 设置 Headers 的 UA、Referer。
''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional SimulateBrowserHeaders As Boolean = False)
If Req.Headers.UserAgent.Any Then Return
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
@@ -89,6 +89,7 @@ Friend Module ModSecret
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)
End Sub
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.10.7.0")>
<Assembly: AssemblyFileVersion("2.10.7.0")>
<Assembly: AssemblyVersion("2.10.8.0")>
<Assembly: AssemblyFileVersion("2.10.8.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -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})
@@ -171,6 +171,7 @@
<TextBlock Width="120" Margin="0,1.5" Text="Ciallo~(∠?ω" />
<TextBlock Width="120" Margin="0,1.5" Text="九十九" />
<TextBlock Width="120" Margin="0,1.5" Text="Guuzen" />
<TextBlock Width="120" Margin="0,1.5" Text="极光" />
<TextBlock Width="120" Margin="0,1.5" Text="9331" />
<TextBlock Width="120" Margin="0,1.5" Text="钱程" />
<TextBlock Width="120" Margin="0,1.5" Text="杏坂和人" />
@@ -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
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 Select
End If
Dim NewDescription As String
If Setup.Get("ToolModLocalNameStyle") = 1 Then
'标题显示文件名,详情显示译名