This commit is contained in:
龙腾猫跃
2024-10-16 03:24:00 +08:00
parent fb1caf0c8f
commit c5ae532fd5
49 changed files with 1881 additions and 1401 deletions
+32 -26
View File
@@ -12,13 +12,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.8.8" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.8." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.8.9" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.9." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 340 'Release
#Else
Public Const VersionCode As Integer = 339 'Snapshot
Public Const VersionCode As Integer = 341 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -176,9 +176,9 @@ Public Module ModBase
''' </summary>
Public Const IconButtonOffline As String = "M533.293176 788.841412a60.235294 60.235294 0 1 1 85.202824 85.202823l-42.616471 42.586353c-129.355294 129.385412-339.124706 129.385412-468.510117 0-129.385412-129.385412-129.385412-339.124706 0-468.510117l42.586353-42.616471a60.235294 60.235294 0 1 1 85.202823 85.202824l-42.61647 42.586352a210.823529 210.823529 0 1 0 298.164706 298.164706l42.586352-42.61647z m255.548236-255.548236l42.61647-42.586352a210.823529 210.823529 0 1 0-298.164706-298.164706l-42.586352 42.61647a60.235294 60.235294 0 1 1-85.202824-85.202823l42.616471-42.586353c129.355294-129.385412 339.124706-129.385412 468.510117 0 129.385412 129.385412 129.385412 339.124706 0 468.510117l-42.586353 42.616471a60.235294 60.235294 0 1 1-85.202823-85.202824zM192.542118 192.542118a60.235294 60.235294 0 0 1 85.202823 0l553.712941 553.712941a60.235294 60.235294 0 0 1-85.202823 85.202823L192.542118 277.744941a60.235294 60.235294 0 0 1 0-85.202823z"
''' <summary>
''' 图标,音符,1x
''' 图标,服务端,1x
''' </summary>
Public Const IconButtonServer As String = "M640 725.333333a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334z m-256 0H256a42.666667 42.666667 0 0 0 0 85.333334h128a42.666667 42.666667 0 1 0 0-85.333334z m384 0a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334z m-128-256a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334z m-256 0H256a42.666667 42.666667 0 1 0 0 85.333334h128a42.666667 42.666667 0 1 0 0-85.333334z m384-256a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334z m0 256a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334z m170.666667-256a128 128 0 0 0-128-128H213.333333a128 128 0 0 0-128 128v85.333334a128 128 0 0 0 33.28 85.333333A128 128 0 0 0 85.333333 469.333333v85.333334a128 128 0 0 0 33.28 85.333333A128 128 0 0 0 85.333333 725.333333v85.333334a128 128 0 0 0 128 128h597.333334a128 128 0 0 0 128-128v-85.333334a128 128 0 0 0-33.28-85.333333 128 128 0 0 0 33.28-85.333333v-85.333334a128 128 0 0 0-33.28-85.333333A128 128 0 0 0 938.666667 298.666667V213.333333z m-85.333334 597.333334a42.666667 42.666667 0 0 1-42.666666 42.666666H213.333333a42.666667 42.666667 0 0 1-42.666666-42.666666v-85.333334a42.666667 42.666667 0 0 1 42.666666-42.666666h597.333334a42.666667 42.666667 0 0 1 42.666666 42.666666v85.333334z m0-256a42.666667 42.666667 0 0 1-42.666666 42.666666H213.333333a42.666667 42.666667 0 0 1-42.666666-42.666666v-85.333334a42.666667 42.666667 0 0 1 42.666666-42.666666h597.333334a42.666667 42.666667 0 0 1 42.666666 42.666666v85.333334z m0-256a42.666667 42.666667 0 0 1-42.666666 42.666666H213.333333a42.666667 42.666667 0 0 1-42.666666-42.666666V213.333333a42.666667 42.666667 0 0 1 42.666666-42.666666h597.333334a42.666667 42.666667 0 0 1 42.666666 42.666666v85.333334z m-213.333333-85.333334a42.666667 42.666667 0 1 0 0 85.333334 42.666667 42.666667 0 0 0 0-85.333334zM384 213.333333H256a42.666667 42.666667 0 1 0 0 85.333334h128a42.666667 42.666667 0 1 0 0-85.333334z"
Public Const IconButtonServer As String = "M224 160a64 64 0 0 0-64 64v576a64 64 0 0 0 64 64h576a64 64 0 0 0 64-64V224a64 64 0 0 0-64-64H224z m0 384h576v256H224v-256z m192 96v64h320v-64H416z m-128 0v64h64v-64H288zM224 224h576v256H224V224z m192 96v64h320v-64H416z m-128 0v64h64v-64H288z"
''' <summary>
''' 图标,音符,1x
''' </summary>
@@ -1348,8 +1348,8 @@ RetryDir:
'常见错误(记得同时修改下面的)
Dim CommonReason As String = Nothing
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
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
@@ -1368,7 +1368,7 @@ RetryDir:
If CommonReason Is Nothing Then
Return Desc & Stack & TypeDesc
Else
Dim Result As String = DescList.First & vbCrLf & CommonReason & vbCrLf & "————————————" & vbCrLf
Dim Result As String = CommonReason & vbCrLf & DescList.First & vbCrLf & "————————————" & vbCrLf
DescList(0) = "详细错误信息:"
Return Result & Join(DescList, vbCrLf & "→ ") & Stack & TypeDesc
End If
@@ -1396,8 +1396,8 @@ RetryDir:
'常见错误(记得同时修改上面的)
Dim CommonReason As String = Nothing
If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
CommonReason = "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。"
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
@@ -1411,7 +1411,7 @@ RetryDir:
'构造输出信息
If CommonReason IsNot Nothing Then
Return DescList.First & ":" & CommonReason
Return CommonReason & "详细错误:" & DescList.First
Else
DescList.Reverse() '让最深层错误在最左边
Return Join(DescList, " → ")
@@ -1721,16 +1721,6 @@ RetryDir:
Public Function RegexReplaceEach(Input As String, Replacement As MatchEvaluator, Regex As String, Optional options As RegexOptions = RegularExpressions.RegexOptions.None) As String
Return RegularExpressions.Regex.Replace(Input, Regex, Replacement, options)
End Function
''' <summary>
''' 检查传入字符串会不会引发 Issue #4505
''' </summary>
Public Function Ntfs83NameCheck(name As String) As Boolean
Dim regex As New Regex("(.*)~(\d*)")
Dim namePart As Byte() = Encoding.UTF8.GetBytes(regex.Match(name).Groups(1).Value)
Dim numPart As Integer = regex.Match(name).Groups(2).Value.Length
Return namePart.Length >= 6 AndAlso numPart = 1
End Function
#End Region
@@ -1822,10 +1812,10 @@ RetryDir:
'进行搜索,获取相似信息
For Each Entry In Entries
Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query)
Entry.AbsoluteRight = False
For Each Pair In Entry.SearchSource
If Pair.Key.Replace(" ", "").ContainsF(Query.Replace(" ", ""), True) Then Entry.AbsoluteRight = True
Next
Entry.AbsoluteRight =
Query.Split(" ").All( '对于按空格分割的每一段
Function(QueryPart) Entry.SearchSource.Any( '若与任意一个搜索源完全匹配,则标记为完全匹配项
Function(Source) Source.Key.Replace(" ", "").ContainsF(QueryPart, True)))
Next
'按照相似度进行排序
Entries = Sort(Entries,
@@ -1854,10 +1844,26 @@ RetryDir:
#Region "系统"
''' <summary>
''' 可用于临时存放文件的,不含任何特殊字符的文件夹路径,以“\”结尾。
''' </summary>
Public PathPure As String = GetPureASCIIDir()
Private Function GetPureASCIIDir() As String
If (Path & "PCL").IsASCII() Then
Return Path & "PCL\"
ElseIf PathAppdata.IsASCII() Then
Return PathAppdata
ElseIf PathTemp.IsASCII() Then
Return PathTemp
Else
Return OsDrive & "ProgramData\PCL\"
End If
End Function
''' <summary>
''' 指示接取到这个异常的函数进行重试。
''' </summary>
Public Class RetryException
Public Class RestartException
Inherits Exception
End Class
+22 -3
View File
@@ -939,7 +939,6 @@ RequestFinished:
Dim StartPosition As Long, StartSource As NetSource = Nothing
Dim Th As Thread, ThreadInfo As NetThread
SyncLock LockChain
'获取线程起点与下载源
'不分割
If IsNoSplit Then GoTo Capture
@@ -1049,6 +1048,15 @@ StartThread:
If ModeDebug AndAlso HttpResponse.ResponseUri.OriginalString <> Info.Source.Url Then
Log($"[Download] {LocalName} {Info.Uuid}#:重定向至 {HttpResponse.ResponseUri.OriginalString}")
End If
''从响应头获取文件名
'If Info.IsFirstThread Then
' Dim FileName As String = GetFileNameFromResponse(HttpResponse)
' If ModeDebug Then Log($"[Download] {LocalName} {Info.Uuid}#:远程文件名:{If(FileName, "未提供")}")
' If FileName IsNot Nothing AndAlso LocalName = "待定" Then
' LocalName = FileName
' Log($"[Download] {LocalName} {Info.Uuid}#:从响应头获取到文件名")
' End If
'End If
'文件大小校验
ContentLength = HttpResponse.ContentLength
If ContentLength = -1 Then
@@ -1133,7 +1141,7 @@ NotSupportRange:
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
End SyncLock
Dim DeltaTime = GetTimeTick() - Info.LastReceiveTime
If DeltaTime > 1000000 Then DeltaTime = 0 '时间刻反转导致出现极大值
If DeltaTime > 1000000 Then DeltaTime = 1 '时间刻反转导致出现极大值
If RealDataCount > 0 Then
'有数据
If Info.DownloadDone = 0 Then
@@ -1174,7 +1182,7 @@ NotSupportRange:
ResultStream.Write(HttpData, 0, RealDataCount)
End If
'检查速度是否过慢
If DeltaTime > 1000 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1s,且速度小于 1K/s
If DeltaTime > 1500 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1.5s,且速度小于 1.5K/s
Throw New TimeoutException("由于速度过慢断开链接,下载 " & RealDataCount & " B,消耗 " & DeltaTime & " ms。")
End If
Info.LastReceiveTime = GetTimeTick()
@@ -1286,6 +1294,17 @@ Wrong:
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge()
End Try
End Sub
''' <summary>
''' 从 HTTP 响应头中获取文件名。
''' 如果没有,返回 Nothing。
''' </summary>
Private Function GetFileNameFromResponse(response As HttpWebResponse) As String
Dim header As String = response.Headers("Content-Disposition")
If String.IsNullOrEmpty(header) Then Return Nothing
'attachment; filename="filename.ext"
If Not header.Contains("filename=") Then Return Nothing
Return header.After("filename=").Trim(""""c, " "c).Before(";")
End Function
'下载文件的最终收束事件
''' <summary>
@@ -233,8 +233,8 @@ Public Class ValidateFolderName
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!", True).Validate(Str)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 (issue #4505)
If Ntfs83NameCheck(Str) Then Return "文件夹名不能是一个有效的 NTFS 8.3 文件名!"
'检查 NTFS 8.3 文件名(#4505)
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式!"
'检查文件夹重名
Dim Arr As New List(Of String)
If PathIgnore IsNot Nothing Then
@@ -288,8 +288,8 @@ Public Class ValidateFileName
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件名不可为 %!", True).Validate(Str)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 (issue #4505)
If Ntfs83NameCheck(Str) Then Return "文件名不能是一个有效的 NTFS 8.3 文件名!"
'检查 NTFS 8.3 文件名(#4505)
If RegexCheck(Str, ".{2,}~\d") Then Return "文件名不能包含这一特殊格式!"
'检查文件重名
If ParentFolder IsNot Nothing Then
Dim DirInfo As New DirectoryInfo(ParentFolder)
@@ -355,9 +355,9 @@ Fin:
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!").Validate(SubStr)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 (issue #4505)
If Ntfs83NameCheck(Str) Then Return "文件夹名不能是一个有效的 NTFS 8.3 文件名!"
'检查 NTFS 8.3 文件名(#4505)
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式!"
Next
Return ""
End Function
End Class
End Class
@@ -7,7 +7,7 @@ Public Class MyBitmap
''' <summary>
''' 位图缓存。
''' </summary>
Public Shared BitmapCache As New Dictionary(Of String, MyBitmap)
Public Shared BitmapCache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
''' <summary>
''' 存储的图片
@@ -61,7 +61,7 @@ Public Class MyBitmap
Pic = BitmapCache(FilePathOrResourceName).Pic
Else
Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource))
BitmapCache.Add(FilePathOrResourceName, Pic)
BitmapCache.TryAdd(FilePathOrResourceName, Pic)
End If
Else
'使用这种自己接管 FileStream 的方法加载才能解除文件占用
@@ -72,11 +72,9 @@ Public Class MyBitmap
InputStream.Seek(0, SeekOrigin.Begin)
If Header(0) = 82 AndAlso Header(1) = 73 Then
'读取 WebP
If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
Dim FileBytes(InputStream.Length - 1) As Byte
InputStream.Read(FileBytes, 0, FileBytes.Length)
Dim Decoder As New Imazen.WebP.SimpleDecoder()
Pic = Decoder.DecodeFromBytes(FileBytes, FileBytes.Length)
Pic = WebPDecoder.DecodeFromBytes(FileBytes) '将代码隔离在另外一个类中,这样只要不走进这个分支就不会加载 Imazen.WebP.dll
Else
Pic = New System.Drawing.Bitmap(InputStream)
End If
@@ -86,10 +84,9 @@ Public Class MyBitmap
Pic = My.Application.TryFindResource(FilePathOrResourceName)
If Pic Is Nothing Then
Pic = New System.Drawing.Bitmap(1, 1)
Log(ex, $"加载位图失败({FilePathOrResourceName})")
Throw
Throw New Exception($"加载 MyBitmap 失败({FilePathOrResourceName})", ex)
Else
Log(ex, $"指定类型有误的位图加载({FilePathOrResourceName})", LogLevel.Developer)
Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", LogLevel.Developer)
Exit Try
End If
End Try
@@ -116,6 +113,13 @@ Public Class MyBitmap
Pic = New System.Drawing.Bitmap(MS)
End Using
End Sub
Private Class WebPDecoder '将代码隔离在另外一个类中,这样只要不调用这个方法就不会加载 Imazen.WebP.dll
Public Shared Function DecodeFromBytes(Bytes As Byte()) As System.Drawing.Bitmap
If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
Dim Decoder As New Imazen.WebP.SimpleDecoder()
Return Decoder.DecodeFromBytes(Bytes, Bytes.Length)
End Function
End Class
''' <summary>
''' 获取裁切的图片,这个方法不会导致原对象改变且会返回一个新的对象。
@@ -152,4 +156,4 @@ Public Class MyBitmap
End Using
End Sub
End Class
End Class
@@ -389,7 +389,7 @@ Extracted:
版本Json中存在多个Forge
Mod过多导致超出ID限制
NightConfig的Bug
ShadersMod与Optifine同时安装
ShadersMod与OptiFine同时安装
Forge安装不完整
Mod需要Java11
Mod缺少前置或MC版本错误
@@ -516,7 +516,7 @@ Done:
If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失)
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.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("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))
@@ -525,6 +525,7 @@ Done:
If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容)
If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") Then AppendReason(CrashReason.NightConfig的Bug)
If LogMc.Contains("Cannot find launch target fmlclient, unable to launch") Then AppendReason(CrashReason.Forge安装不完整)
If LogMc.Contains("Invalid paths argument, contained no existing paths") AndAlso LogMc.Contains("libraries\net\minecraftforge\fmlcore") Then AppendReason(CrashReason.Forge安装不完整)
If LogMc.Contains("Invalid module name: '' is not a Java identifier") Then AppendReason(CrashReason.Mod名称包含特殊字符)
If LogMc.Contains("has been compiled by a more recent version of the Java Runtime (class file version 55.0), this version of the Java Runtime only recognizes class file versions up to") Then AppendReason(CrashReason.Mod需要Java11)
If LogMc.Contains("java.lang.RuntimeException: java.lang.NoSuchMethodException: no such method: sun.misc.Unsafe.defineAnonymousClass(Class,byte[],Object[])Class/invokeVirtual") Then AppendReason(CrashReason.Mod需要Java11)
@@ -623,8 +624,11 @@ Done:
'崩溃报告分析
If LogCrash IsNot Nothing Then
If LogCrash.Contains("Suspected Mod") Then
Dim Suspects = RegexSearch(LogCrash.Between("Suspected Mod", "Stacktrace"), "(?<=\n\t[^(\t]+\()[^)\n]+")
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
Dim SuspectsRaw As String = LogCrash.Between("Suspected Mod", "Stacktrace")
If Not SuspectsRaw.StartsWithF("s: None") Then 'Suspected Mods: None
Dim Suspects = RegexSearch(SuspectsRaw, "(?<=\n\t[^(\t]+\()[^)\n]+")
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
End If
End If
End If
@@ -744,7 +748,7 @@ NextStack:
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If Line.ContainsF(".jar", True) OrElse
If (Line.ContainsF(".jar", True) AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
@@ -886,6 +890,7 @@ NextStack:
WriteFile(TempFolder & "Report\" & FileName,
SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
Encoding:=FileEncoding)
Log($"[Crash] 导出文件:{FileName},编码:{FileEncoding.HeaderName}")
End If
Next
'导出报告
@@ -942,9 +947,9 @@ NextStack:
End If
Case CrashReason.Mod缺少前置或MC版本错误
If Additional.Any Then
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n未满足的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n缺失的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.堆栈分析发现关键字
If Additional.Count = 1 Then
@@ -980,7 +985,7 @@ NextStack:
If Additional.Count = 1 Then
Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else
Results.Add("以下 Mod 初始化失败,导致游戏无法继续加载:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Results.Add("以下 Mod 初始化失败,导致游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If
Case CrashReason.特定方块导致崩溃
If Additional.Count = 1 Then
@@ -992,7 +997,7 @@ NextStack:
If Additional.Count >= 2 Then
Results.Add("你重复安装了多个相同的 Mod:\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。")
Else
Results.Add("你可能重复安装了多个相同的 Mod,导致游戏无法继续加载。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
Results.Add("你可能重复安装了多个相同的 Mod,导致游戏出错。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
End If
Case CrashReason.特定实体导致崩溃
If Additional.Count = 1 Then
@@ -1002,12 +1007,12 @@ NextStack:
End If
Case CrashReason.OptiFine与Forge不兼容
Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。")
Case CrashReason.ShadersMod与Optifine同时安装
Results.Add("无需同时安装 Optifine 和 Shaders Mod,Optifine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
Case CrashReason.ShadersMod与OptiFine同时安装
Results.Add("无需同时安装 Optifine 和 Shaders Mod,OptiFine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
Case CrashReason.低版本Forge与高版本Java不兼容
Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 1.8.0.320 的 Java")
Case CrashReason.版本Json中存在多个Forge
Results.Add("可能由于使用其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
Results.Add("可能由于其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
Case CrashReason.玩家手动触发调试崩溃
Results.Add("* 事实上,你的游戏没有任何问题,这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗?")
Case CrashReason.Mod需要Java11
@@ -1033,7 +1038,7 @@ NextStack:
Case CrashReason.文件或内容校验失败
Results.Add("部分文件或内容校验失败,导致游戏出现了问题。\n\n请尝试删除游戏(包括 Mod)并重新下载,或尝试在重新下载时使用 VPN。\h")
Case CrashReason.Forge安装不完整
Results.Add("由于 Forge 安装不完整,导致游戏无法正常运行。\n请尝试重新安装 Forge。\h")
Results.Add("由于安装的 Forge 文件丢失,导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge,然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h")
Case CrashReason.Fabric报错
If Additional.Count = 1 Then
Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
@@ -378,7 +378,7 @@ NextInner:
'根据当前登录方式优先返回
Select Case Setup.Get("LoginType")
Case McLoginType.Ms
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
If Setup.Get("CacheMsV2Name") <> "" Then Return Setup.Get("CacheMsV2Name")
Case McLoginType.Legacy
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
Case McLoginType.Nide
@@ -387,7 +387,7 @@ NextInner:
If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
End Select
'查找所有可能的项
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
If Setup.Get("CacheMsV2Name") <> "" Then Return Setup.Get("CacheMsV2Name")
If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
@@ -399,7 +399,7 @@ NextInner:
Public Function McLoginAble() As String
Select Case Setup.Get("LoginType")
Case McLoginType.Ms
If Setup.Get("CacheMsOAuthRefresh") = "" Then
If Setup.Get("CacheMsV2OAuthRefresh") = "" Then
Return FrmLoginMs.IsVaild()
Else
Return ""
@@ -450,7 +450,7 @@ NextInner:
Case McLoginType.Legacy
LoginData = PageLoginLegacy.GetLoginData()
Case McLoginType.Ms
If Setup.Get("CacheMsOAuthRefresh") = "" Then
If Setup.Get("CacheMsV2OAuthRefresh") = "" Then
LoginData = PageLoginMs.GetLoginData()
Else
LoginData = PageLoginMsSkin.GetLoginData()
@@ -552,11 +552,11 @@ Relogin:
Dim Result = MsLoginStep6(AccessToken)
Data.Progress = 0.98
'输出登录结果
Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken)
Setup.Set("CacheMsAccess", AccessToken)
Setup.Set("CacheMsUuid", Result(0))
Setup.Set("CacheMsName", Result(1))
Setup.Set("CacheMsProfileJson", Result(2))
Setup.Set("CacheMsV2OAuthRefresh", OAuthRefreshToken)
Setup.Set("CacheMsV2Access", AccessToken)
Setup.Set("CacheMsV2Uuid", Result(0))
Setup.Set("CacheMsV2Name", Result(1))
Setup.Set("CacheMsV2ProfileJson", Result(2))
Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson"))
MsJson.Remove(Input.UserName) '如果更改了玩家名……
MsJson(Result(1)) = OAuthRefreshToken
@@ -850,7 +850,7 @@ Retry:
While Converter.Result Is Nothing
Thread.Sleep(100)
End While
If TypeOf Converter.Result Is RetryException Then
If TypeOf Converter.Result Is RestartException Then
If MyMsgBox($"请在登录时选择 {vbLQ}其他登录方法{vbRQ},然后选择 {vbLQ}使用我的密码{vbRQ}。{vbCrLf}如果没有该选项,请选择 {vbLQ}设置密码{vbRQ},设置完毕后再登录。",
"需要使用密码登录", "重新登录", "设置密码", "取消",
Button2Action:=Sub() OpenWebsite("https://account.live.com/password/Change")) = 1 Then
@@ -1262,8 +1262,7 @@ Retry:
''' 释放 Java Wrapper 并返回完整文件路径。
''' </summary>
Public Function ExtractJavaWrapper() As String
Dim BaseDir As String = GetPureASCIIDir()
Dim WrapperPath As String = BaseDir & "\JavaWrapper.jar"
Dim WrapperPath As String = PathPure & "JavaWrapper.jar"
Log("[Java] 选定的 Java Wrapper 路径:" & WrapperPath)
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
Try
@@ -1277,7 +1276,7 @@ Retry:
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex2 As Exception
Log(ex2, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成", LogLevel.Developer)
WrapperPath = BaseDir & "\JavaWrapper2.jar"
WrapperPath = PathPure & "JavaWrapper2.jar"
Try
WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex3 As Exception
@@ -1293,22 +1292,6 @@ Retry:
End Function
Private ExtractJavaWrapperLock As New Object
''' <summary>
''' 获取一个可用于临时存放文件的,不含任何特殊字符的文件夹路径。
''' 返回值不以 \ 结尾。
''' </summary>
Public Function GetPureASCIIDir() As String
If (Path & "PCL").IsASCII() Then
Return Path & "PCL"
ElseIf PathAppdata.IsASCII() Then
Return PathAppdata.TrimEnd("\")
ElseIf PathTemp.IsASCII() Then
Return PathTemp.TrimEnd("\")
Else
Return OsDrive & "ProgramData\PCL"
End If
End Function
'主方法,合并 Jvm、Game、Replace 三部分的参数数据
Private Sub McLaunchArgumentMain(Loader As LoaderTask(Of String, List(Of McLibToken)))
McLaunchLog("开始获取 Minecraft 启动参数")
@@ -1408,7 +1391,7 @@ Retry:
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
Try
Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
" -Dauthlibinjector.side=client" &
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
Catch ex As Exception
@@ -1418,7 +1401,7 @@ Retry:
'添加 Java Wrapper 作为主 Jar
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Add("-Doolloo.jlw.tmpdir=""" & GetPureASCIIDir() & """")
DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
'添加 MainClass
@@ -1475,7 +1458,7 @@ NextVersion:
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
Try
Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
" -Dauthlibinjector.side=client" &
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
Catch ex As Exception
@@ -1485,7 +1468,7 @@ NextVersion:
'添加 Java Wrapper 作为主 Jar
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Add("-Doolloo.jlw.tmpdir=""" & GetPureASCIIDir() & """")
DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
'将 "-XXX" 与后面 "XXX" 合并到一起
@@ -1256,9 +1256,8 @@ OnLoaded:
Dim VersionList As New List(Of McVersion)
#Region "循环加载每个版本的信息"
Dim Dirs As DirectoryInfo() = New DirectoryInfo(Path & "versions").GetDirectories
For Each Folder As DirectoryInfo In Dirs
If Not Folder.EnumerateFiles.Any Then
For Each Folder As DirectoryInfo In New DirectoryInfo(Path & "versions").GetDirectories
If Not Folder.Exists OrElse Not Folder.EnumerateFiles.Any Then
Log("[Minecraft] 跳过空文件夹:" & Folder.FullName)
Continue For
End If
@@ -1528,7 +1527,7 @@ OnLoaded:
''' 要求玩家选择一个皮肤文件,并进行相关校验。
''' </summary>
Public Function McSkinSelect() As McSkinInfo
Dim FileName As String = SelectFile("皮肤文件(*.png)|*.png", "选择皮肤文件")
Dim FileName As String = SelectFile("皮肤文件(*.png;*.jpg;*.webp)|*.png;*.jpg;*.webp", "选择皮肤文件")
'验证有效性
If FileName = "" Then Return New McSkinInfo With {.IsVaild = False}
@@ -1935,7 +1934,7 @@ OnLoaded:
''' <summary>
''' 获取版本缺失的支持库文件所对应的 NetTaskFile。
''' </summary>
Public Function McLibFix(Version As McVersion, Optional CoreJarOnly As Boolean = False) As List(Of NetFile)
Public Function McLibFix(Version As McVersion) As List(Of NetFile)
If Not Version.IsLoaded Then Version.Load() '确保例如 JumpLoader 等项被合并入 Json
Dim Result As New List(Of NetFile)
@@ -1948,7 +1947,6 @@ OnLoaded:
Catch ex As Exception
Log(ex, "版本缺失主 jar 文件所必须的信息", LogLevel.Developer)
End Try
If CoreJarOnly Then Return Result
'Library 文件
Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\"))
@@ -1957,15 +1955,15 @@ OnLoaded:
If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then
Dim TargetFile = PathAppdata & "nide8auth.jar"
Dim DownloadInfo As JObject = Nothing
'获取下载信息
Try
Log("[Minecraft] 开始获取统一通行证下载信息")
'测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/
DownloadInfo = GetJson(NetGetCodeByDownload({
'获取下载信息
Try
Log("[Minecraft] 开始获取统一通行证下载信息")
'测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/
DownloadInfo = GetJson(NetGetCodeByDownload({
"https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version)}, IsJson:=True))
Catch ex As Exception
Log(ex, "获取统一通行证下载信息失败")
End Try
Catch ex As Exception
Log(ex, "获取统一通行证下载信息失败")
End Try
'校验文件
If DownloadInfo IsNot Nothing Then
Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString)
@@ -1978,9 +1976,8 @@ OnLoaded:
End If
'Authlib-Injector 文件
If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse
(PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接
Dim TargetFile = PathAppdata & "authlib-injector.jar"
If Setup.Get("VersionServerLogin", Version:=Version) = 4 Then
Dim TargetFile = PathPure & "\authlib-injector.jar"
Dim DownloadInfo As JObject = Nothing
'获取下载信息
Try
@@ -2001,9 +1998,9 @@ OnLoaded:
Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe")
Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress, LogLevel.Developer)
Result.Add(New NetFile({
DownloadAddress,
DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector")
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
DownloadAddress,
DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector")
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
End If
End If
End If
@@ -825,6 +825,7 @@ Finished:
Finally
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表")
End Try
FrmVersionMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
End If
'获取 Mod 文件夹下的可用文件列表
@@ -342,8 +342,8 @@ Retry:
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
If File.Exists(Target) Then
Log("[ModPack] 删除原始整合包文件:" & Target)
File.Delete(Target)
End If
Next
@@ -491,8 +491,8 @@ Retry:
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
If File.Exists(Target) Then
Log("[ModPack] 删除原始整合包文件:" & Target)
File.Delete(Target)
End If
Next
@@ -1,6 +1,7 @@
<Grid x:Class="MyCompItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL"
x:Name="PanBack" Height="64"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
@@ -23,7 +24,7 @@
<Border.Clip>
<RectangleGeometry Rect="0,0,50,50" RadiusX="6" RadiusY="6" />
</Border.Clip>
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
<local:MyImage x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" FallbackSource="pack://application:,,,/images/Icons/NoIcon.png" />
</Border>
<!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
@@ -4,87 +4,14 @@
Public Uuid As Integer = GetUuid()
'Logo
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
Return PathLogo.Source
End Get
Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
Else
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
'位图
PathLogo.Source = New MyBitmap(_Logo)
End If
Catch ex As IOException
Log(ex, "加载资源工程图标时读取失败(" & FileAddress & ")")
Catch ex As ArgumentException
'考虑缓存的图片本身可能有误
Log(ex, "可视化资源工程图标失败(" & FileAddress & ")")
Try
File.Delete(FileAddress)
Log("[Comp] 已清理损坏的资源工程图标:" & FileAddress)
Catch exx As Exception
Log(exx, "清理损坏的资源工程图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
End Try
Catch ex As Exception
Log(ex, "加载资源工程图标失败(" & value & ")")
End Try
PathLogo.Source = value
End Set
End Property
'后台加载 Logo
Private Sub LogoLoader(LocalFileAddress As String)
Dim Retried As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
'CurseForge 图片使用缩略图
Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
End If
'下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
Dim LoadError As Exception = Nothing
RunInUiWait(
Sub()
Try
'在地址更换时取消加载
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
Catch ex As Exception
Log(ex, $"读取资源工程图标失败({LocalFileAddress})")
File.Delete(LocalFileAddress & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(LocalFileAddress) Then
File.Delete(LocalFileAddress & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
End If
Catch ex As Exception
If Not Retried Then
Retried = True
GoTo RetryStart
Else
Log(ex, $"下载资源工程图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
'标题
Public Property Title As String
@@ -24,7 +24,7 @@
<Border.Clip>
<RectangleGeometry Rect="0,0,34,34" RadiusX="6" RadiusY="6" />
</Border.Clip>
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
<local:MyImage x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" FallbackSource="pack://application:,,,/images/Icons/NoIcon.png" />
</Border>
<!-- 标题 -->
<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0"
@@ -52,6 +52,6 @@
</Border>-->
</StackPanel>
<TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="0,0,3,1"
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray3}"
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray4}"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</Grid>
@@ -6,88 +6,14 @@ Public Class MyLocalModItem
Public Uuid As Integer = GetUuid()
'Logo
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
Return PathLogo.Source
End Get
Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property
_Logo = value
If ModeDebug AndAlso Not _Logo = PathImage & "Icons/NoIcon.png" Then Log($"[LocalModItem] Mod {Title} 的图标:{value}")
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
Else
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
'位图
PathLogo.Source = New MyBitmap(_Logo)
End If
Catch ex As IOException
Log(ex, "加载本地 Mod 图标时读取失败(" & FileAddress & ")")
Catch ex As ArgumentException
'考虑缓存的图片本身可能有误
Log(ex, "可视化本地 Mod 图标失败(" & FileAddress & ")")
Try
File.Delete(FileAddress)
Log("[LocalModItem] 已清理损坏的本地 Mod 图标:" & FileAddress)
Catch exx As Exception
Log(exx, "清理损坏的本地 Mod 图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
End Try
Catch ex As Exception
Log(ex, "加载本地 Mod 图标失败(" & value & ")")
End Try
PathLogo.Source = value
End Set
End Property
'后台加载 Logo
Private Sub LogoLoader(LocalFileAddress As String)
Dim Retried As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
'CurseForge 图片使用缩略图
Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
Url = Url.Replace("/256/256/", "/64/64/")
End If
'下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
Dim LoadError As Exception = Nothing
RunInUiWait(
Sub()
Try
'在地址更换时取消加载
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
Catch ex As Exception
Log(ex, "读取本地 Mod 图标失败(" & LocalFileAddress & ")")
File.Delete(LocalFileAddress & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(LocalFileAddress) Then
File.Delete(LocalFileAddress & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
End If
Catch ex As Exception
If Not Retried Then
Retried = True
GoTo RetryStart
Else
Log(ex, $"下载本地 Mod 图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
'标题
Private _Title As String
@@ -143,9 +69,9 @@ RetryStart:
For Each TagText In value
Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
Background=""#0C000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
<TextBlock Text=""" & TagText & """ Foreground=""#88000000"" FontSize=""11"" />
</Border>")
PanTags.Children.Add(NewTag)
Next
@@ -377,7 +303,7 @@ RetryStart:
#End Region
Public Sub Refresh()
Public Sub Refresh() Handles Me.Loaded
RunInUi(
Sub()
'更新
@@ -404,30 +330,45 @@ RetryStart:
Else
BtnUpdate.Visibility = Visibility.Collapsed
End If
'标题
If Entry.Comp Is Nothing Then
Title = Entry.Name
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'描述
Dim NewDescription As String
'标题与描述
Dim DescFileName As String
Select Case Entry.State
Case McMod.McModState.Fine
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path)
DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path)
Case McMod.McModState.Disabled
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
Case Else 'McMod.McModState.Unavailable
NewDescription = GetFileNameFromPath(Entry.Path)
DescFileName = GetFileNameFromPath(Entry.Path)
End Select
Dim NewDescription As String
If Setup.Get("ToolModLocalNameStyle") = 1 Then
'标题显示文件名,详情显示译名
'标题
Title = DescFileName
SubTitle = ""
'描述
If Entry.Comp Is Nothing Then
NewDescription = Entry.Name
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
NewDescription = Titles.Key & Titles.Value
End If
NewDescription = NewDescription.Replace(" | ", " / ")
If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})"
Else
'标题显示译名,详情显示文件名
'标题
If Entry.Comp Is Nothing Then
Title = Entry.Name
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
'描述
NewDescription = DescFileName
End If
If Entry.Comp IsNot Nothing Then
NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Entry.Description IsNot Nothing Then
@@ -436,6 +377,11 @@ RetryStart:
NewDescription += ": " & "存在错误,无法获取信息"
End If
Description = NewDescription
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'主 Logo
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo())
'图标右下角的 Logo
+12 -1
View File
@@ -92,7 +92,18 @@
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Exit Sub
End If
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
Try
Select Case Data.Length
Case 1
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
Case 2
PageOtherTest.StartCustomDownload(Data(0), Data(1))
Case Else
PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2))
End Select
Catch
PageOtherTest.StartCustomDownload(Data(0), "未知")
End Try
Case Else
MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
+4 -4
View File
@@ -101,8 +101,8 @@ Friend Module ModSecret
''' 设置 Headers 的 UA、Referer。
''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Client As WebClient, Optional UseBrowserUserAgent As Boolean = False)
If Url.Contains("modrinth.com") Then '根据 #4334,不添加 PCL 的 UA 反而能正常访问
Client.Headers("User-Agent") = "Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
Client.Headers("User-Agent") = "LogStatistic" '#4951
ElseIf UseBrowserUserAgent Then
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else
@@ -115,8 +115,8 @@ Friend Module ModSecret
''' 设置 Headers 的 UA、Referer。
''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False)
If Url.Contains("modrinth.com") Then '根据 #4334,不添加 PCL 的 UA 反而能正常访问
Request.UserAgent = "Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
Client.Headers("User-Agent") = "LogStatistic" '#4951
ElseIf UseBrowserUserAgent Then
Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else