2.10.9

Plain Craft Launcher 2/Modules/Base/ModBase.vb

@@ -13,13 +13,13 @@ Public Module ModBase
 #Region "声明"
 
     '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.10.8" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.10.8." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.10.9" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.10.9." & VersionBranchCode '标准格式的四段式版本号
     Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If BETA Then
-    Public Const VersionCode As Integer = 367 'Release
+    Public Const VersionCode As Integer = 369 'Release
 #Else
-    Public Const VersionCode As Integer = 370 'Snapshot
+    Public Const VersionCode As Integer = 371 'Snapshot
 #End If
     '自动生成的版本信息
     Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -69,7 +69,7 @@ Public Module ModBase
     ''' <summary>
     ''' 识别码。
     ''' </summary>
-    Public UniqueAddress As String = SecretGetUniqueAddress()
+    Public Identify As String = SecretGetIdentify()
     ''' <summary>
     ''' 程序是否已结束。
     ''' </summary>
@@ -761,7 +761,6 @@ Public Module ModBase
         If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
         Dim length As Integer = FilePath.Length
         If length = 0 Then Throw New Exception("不包含文件名：" & FilePath)
-        If length > 250 Then Throw New PathTooLongException("文件名过长：" & FilePath)
         Return FilePath
     End Function
     ''' <summary>
@@ -1400,12 +1399,13 @@ RetryDir:
 
     ''' <summary>
     ''' 若路径长度大于指定值，则将长路径转换为短路径。
+    ''' 如果路径不存在，则返回原始路径。
     ''' </summary>
     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)
+        GetShortPathName(LongPath.Replace("/", "\"), ShortPath, 260) '第一个参数也会在调用后被修改，使用 Replace 后不会影响原始字符串
         ShortenPath = ShortPath.ToString
         If String.IsNullOrEmpty(ShortenPath) Then Return LongPath
     End Function
@@ -1511,6 +1511,19 @@ RetryDir:
         Return [Enum].GetName(EnumData.GetType, EnumData)
     End Function
     ''' <summary>
+    ''' 将字符串转换为枚举类型，支持数字或原文两种格式，若为空字符串则返回 0。
+    ''' 若转换失败会抛出异常。
+    ''' </summary>
+    <Extension> Public Function ParseToEnum(Of T)(Str As String) As T
+        If String.IsNullOrEmpty(Str) Then
+            Return CType(0, Object)
+        ElseIf IsNumeric(Str) Then
+            Return CType(CInt(Str), Object)
+        Else
+            Return [Enum].Parse(GetType(T), Str, True)
+        End If
+    End Function
+    ''' <summary>
     ''' 将文件大小转化为适合的文本形式，如“1.28 M”。
     ''' </summary>
     ''' <param name="FileSize">以字节为单位的大小表示。</param>
@@ -2579,7 +2592,7 @@ Retry:
                     Log(ex, "可能由于剪贴板被其他程序占用，文本复制失败", LogLevel.Hint)
                 End If
             End Try
-            If ShowSuccessHint Then Hint("已成功复制！", HintType.Finish)
+            If ShowSuccessHint Then Hint("已成功复制！", HintType.Green)
         End Sub)
     End Sub
 
@@ -2716,6 +2729,11 @@ Retry:
     ''' 将 XML 转换为对应 UI 对象。
     ''' </summary>
     Public Function GetObjectFromXML(Str As String) As Object
+        Str = Str. '兼容旧版自定义事件写法
+            Replace("EventType=""", "local:CustomEventService.EventType=""").
+            Replace("EventData=""", "local:CustomEventService.EventData=""").
+            Replace("Property=""EventType""", "Property=""local:CustomEventService.EventType""").
+            Replace("Property=""EventData""", "Property=""local:CustomEventService.EventData""")
         Using Stream As New MemoryStream(Encoding.UTF8.GetBytes(Str))
             '类型检查
             Using Reader As New XamlXmlReader(Stream)
@@ -2831,7 +2849,7 @@ Retry:
                 File.Create(Path & "PCL\Log1.txt").Dispose()
             Catch ex As IOException
                 IsInitSuccess = False
-                Hint("可能同时开启了多个 PCL，程序可能会出现未知问题！", HintType.Critical)
+                Hint("可能同时开启了多个 PCL，程序可能会出现未知问题！", HintType.Red)
                 Log(ex, "日志初始化失败（疑似文件占用问题）")
             Catch ex As Exception
                 IsInitSuccess = False
@@ -2884,6 +2902,7 @@ Retry:
 
         '输出日志
         Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Text}{vbCrLf}" '减轻同步锁占用
+        AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
         If ModeDebug Then
             SyncLock LogListLock
                 LogList.Append(AppendText)
@@ -2903,16 +2922,16 @@ Retry:
         Select Case Level
 #If DEBUG Then
             Case LogLevel.Developer
-                Hint("[开发者模式] " & Text, HintType.Info, False)
+                Hint("[开发者模式] " & Text, HintType.Blue, False)
             Case LogLevel.Debug
-                Hint("[调试模式] " & Text, HintType.Info, False)
+                Hint("[调试模式] " & Text, HintType.Blue, False)
 #Else
             Case LogLevel.Developer
             Case LogLevel.Debug
-                If ModeDebug Then Hint("[调试模式] " & Text, HintType.Info, False)
+                If ModeDebug Then Hint("[调试模式] " & Text, HintType.Blue, False)
 #End If
             Case LogLevel.Hint
-                Hint(Text, HintType.Critical, False)
+                Hint(Text, HintType.Red, False)
             Case LogLevel.Msgbox
                 MyMsgBox(Text, Title, IsWarn:=True)
             Case LogLevel.Feedback
@@ -2955,6 +2974,7 @@ Retry:
 
         '输出日志
         Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Desc}：{Ex.GetDetail(True)}{vbCrLf}" '减轻同步锁占用
+        AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
         If ModeDebug Then
             SyncLock LogListLock
                 LogList.Append(AppendText)
@@ -2973,19 +2993,19 @@ Retry:
 #If DEBUG Then
             Case LogLevel.Developer
                 Dim ExLine As String = Desc & "：" & Ex.GetBrief()
-                Hint("[开发者模式] " & ExLine, HintType.Info, False)
+                Hint("[开发者模式] " & ExLine, HintType.Blue, False)
             Case LogLevel.Debug
                 Dim ExLine As String = Desc & "：" & Ex.GetBrief()
-                Hint("[调试模式] " & ExLine, HintType.Info, False)
+                Hint("[调试模式] " & ExLine, HintType.Blue, False)
 #Else
             Case LogLevel.Developer
             Case LogLevel.Debug
                 Dim ExLine As String = Desc & "：" & Ex.GetBrief()
-                If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Info, False)
+                If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Blue, False)
 #End If
             Case LogLevel.Hint
                 Dim ExLine As String = Desc & "：" & Ex.GetBrief()
-                Hint(ExLine, HintType.Critical, False)
+                Hint(ExLine, HintType.Red, False)
             Case LogLevel.Msgbox
                 MyMsgBox(ExFull, Title, IsWarn:=True)
             Case LogLevel.Feedback

Plain Craft Launcher 2/Modules/Base/ModNet.vb

@@ -998,20 +998,18 @@ StartThread:
                 If ModeDebug AndAlso Response.RequestMessage.RequestUri.ToString <> Th.Source.Url Then Log($"[Download] {LocalName}：重定向至 {Response.RequestMessage.RequestUri}")
                 '文件大小校验
                 ContentLength = Response.Content.Headers.ContentLength.GetValueOrDefault(-1)
-                If ContentLength = -1 Then
+                If ContentLength < 0 Then
                     If FileSize > 1 Then
                         If Th.DownloadStart = 0 Then
                             Log($"[Download] {LocalName}：文件大小未知，但已从其他下载源获取，不作处理")
                         Else
-                            Log($"[Download] {LocalName}：ContentLength 返回了 -1，无法确定是否支持分段下载，视作不支持")
+                            Log($"[Download] {LocalName}：ContentLength 返回了 {ContentLength}，无法确定是否支持分段下载，视作不支持")
                             GoTo NotSupportRange
                         End If
                     Else
                         FileSize = -1 : IsUnknownSize = True
                         Log($"[Download] {LocalName}：文件大小未知")
                     End If
-                ElseIf ContentLength < 0 Then
-                    Throw New Exception("获取片大小失败，结果为 " & ContentLength & "。")
                 ElseIf Th.IsFirstThread Then
                     If Check IsNot Nothing Then
                         If ContentLength < Check.MinSize AndAlso Check.MinSize > 0 Then
@@ -1040,15 +1038,11 @@ StartThread:
                 ElseIf Th.DownloadStart > 0 AndAlso ContentLength = FileSize Then
 NotSupportRange:
                     SyncLock LockSource
-                        If SourcesOnce.Contains(Th.Source) Then
-                            GoTo SourceBreak
-                        Else
-                            SourcesOnce.Add(Th.Source)
-                        End If
+                        If SourcesOnce.Contains(Th.Source) Then GoTo SourceBreak
                     End SyncLock
-                    Throw New WebException($"该下载源不支持分段下载：Range 起始于 {Th.DownloadStart}，预期 ContentLength 为 {FileSize - Th.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
+                    Throw New RangeNotSupportedException($"该下载源不支持分段下载：Range 起始于 {Th.DownloadStart}，预期 ContentLength 为 {FileSize - Th.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
                 ElseIf Not FileSize - Th.DownloadStart = ContentLength Then
-                    Throw New WebException($"获取到的分段大小不一致：Range 起始于 {Th.DownloadStart}，预期 ContentLength 为 {FileSize - Th.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
+                    Throw New RangeNotSupportedException($"获取到的分段大小不一致：Range 起始于 {Th.DownloadStart}，预期 ContentLength 为 {FileSize - Th.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
                 End If
                 'Log($"[Download] {LocalName} {Info.Uuid}#：通过大小检查，文件大小 {FileSize}，起始点 {Info.DownloadStart}，ContentLength {ContentLength}")
                 Th.State = NetState.Get
@@ -1061,6 +1055,7 @@ NotSupportRange:
                     Cache = New MemoryStream
                     ResultStream = Cache
                 Else
+                    Directory.CreateDirectory(PathTemp & "Download")
                     Th.Temp = $"{PathTemp}Download\{Uuid}_{Th.Uuid}_{RandomInteger(0, 999999)}.tmp"
                     ResultStream = New FileStream(Th.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
                 End If
@@ -1165,9 +1160,10 @@ SourceBreak:
             Th.State = NetState.Error
             Th.Source.Ex = ex
             '根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传）
-            If IsMergeFailure OrElse
-               ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse
-               ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse
+            Dim IsRangeNotSupported As Boolean = TypeOf ex Is RangeNotSupportedException OrElse ex.Message.Contains("(416)")
+            If IsMergeFailure OrElse IsRangeNotSupported OrElse
+               ex.Message.Contains("(502)") OrElse ex.Message.Contains("(404)") OrElse
+               ex.Message.Contains("未能解析") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse
                ((ex.Message.Contains("(403)") OrElse ex.Message.Contains("(429)")) AndAlso Not Th.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403/429，所以不应因此禁用下载源
                (Th.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse Th.Source.FailCount > NetTaskThreadLimit + 2 Then
                 '当一个下载源有多个线程在下载时，只选择其中一个线程进行后续处理
@@ -1180,9 +1176,9 @@ SourceBreak:
                 End SyncLock
                 '……后续处理
                 If IsThisFail Then
-                    Log($"[Download] {LocalName}：下载源被禁用（{Th.Source.Id}）：{Th.Source.Url}")
+                    Log($"[Download] {LocalName}：下载源被禁用（{Th.Source.Id}，Range 问题：{IsRangeNotSupported}）：{Th.Source.Url}")
                     Log(ex, $"{If(SourcesOnce.FirstOrDefault?.SingleThread Is Nothing, "", "单线程")}下载源 {Th.Source.Id} 已被禁用",
-                        If(ex.Message.Contains("不支持分段下载") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(416)"), LogLevel.Developer, LogLevel.Debug))
+                        If(IsRangeNotSupported OrElse ex.Message.Contains("(404)"), LogLevel.Developer, LogLevel.Debug))
                     SyncLock LockSource
                         SourcesOnce.Remove(Th.Source)
                     End SyncLock
@@ -1191,9 +1187,10 @@ SourceBreak:
                         Fail(ex)
                     ElseIf HasAvailableSource() AndAlso Not IsMergeFailure Then
                         '当前源失败，但还有下载源：正常地继续执行
-                    ElseIf Not Retried AndAlso Sources.Count > 1 Then
+                    ElseIf Not Retried Then
                         '合并失败或首次下载失败，未重试：将所有下载源重新标记为不允许断点续传的下载源，逐个重新尝试下载
-                        Hint($"{LocalName}：文件下载失败，正在自动重试……", If(ModeDebug, HintType.Critical, HintType.Info)) '在调试模式下给出红色提示
+                        '若所有源均不支持 Range，也会走到这里重试
+                        If Not IsRangeNotSupported Then Hint($"{LocalName}：文件下载失败，正在自动重试……", If(ModeDebug, HintType.Red, HintType.Blue)) '在调试模式下给出红色提示
                         Retried = True
                         SyncLock LockSource
                             SourcesOnce.Clear()
@@ -1388,6 +1385,12 @@ Retry:
         End Sub
 
     End Class
+    Private Class RangeNotSupportedException
+        Inherits WebException
+        Public Sub New(Message As String)
+            MyBase.New(Message)
+        End Sub
+    End Class
     ''' <summary>
     ''' 下载一系列文件的加载器。
     ''' </summary>
@@ -1890,7 +1893,6 @@ Retry:
                     Catch ex As Exception
                         Log(ex, "清理下载缓存失败")
                     End Try
-                    Directory.CreateDirectory(PathTemp & "Download")
                 End If
                 IsDownloadCacheCleared = True
             End SyncLock