InfStarMC/PCL-ISE
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

🔀 合并上游分支

Browse Source
This commit is contained in:
youzi-3222
2025-01-14 14:21:40 +08:00
parent 10e4bc0bbb a8bb82b033
commit fa778eedb7
118 changed files with 8132 additions and 4812 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+265 -120
View File
@@ -1,4 +1,5 @@
Imports System.IO.Compression
Imports System.Globalization
Imports System.IO.Compression
Imports System.Runtime.CompilerServices
Imports System.Security.Cryptography
Imports System.Security.Principal
@@ -11,12 +12,13 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.8.0" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.0." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.8.12" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.12." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
#If BETA Then
Public Const VersionCode As Integer = 326 'Release
Public Const VersionCode As Integer = 347 'Release
#Else
Public Const VersionCode As Integer = 327 'Snapshot
Public Const VersionCode As Integer = 346 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -64,7 +66,7 @@ Public Module ModBase
''' </summary>
Public ApplicationOpenTime As Date = Date.Now
''' <summary>
''' 设备唯一标识符。
''' 识别码。
''' </summary>
Public UniqueAddress As String = SecretGetUniqueAddress()
''' <summary>
@@ -80,13 +82,9 @@ Public Module ModBase
''' </summary>
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
''' <summary>
''' 操作系统版本。Win10 为 10.0。
''' </summary>
Public OsVersion As Version = Environment.OSVersion.Version
''' <summary>
''' 系统盘盘符，以 \ 结尾。例如 “C:\”。
''' </summary>
Public OsDrive As String = Environment.GetLogicalDrives().First.ToUpper.First & ":\"
Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
''' <summary>
''' 程序的缓存文件夹路径，以 \ 结尾。
''' </summary>
@@ -178,6 +176,10 @@ 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
''' </summary>
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>
Public Const IconButtonRight As String = "M757.792745 435.407215L419.597482 96.904967c-40.010393-40.010393-104.886579-40.010393-144.896972 0-40.010393 40.010393-40.010393 104.988908 0 144.9993L540.344959 507.855701 274.70051 773.807135c-40.010393 40.112721-40.010393 104.988908 0 144.9993 40.010393 40.010393 104.886579 40.010393 144.896972 0l338.092935-338.39992c40.112721-40.010393 40.112721-104.988908 0.102328-144.9993z"
@@ -704,7 +706,7 @@ Public Module ModBase
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
WriteFile(FileName, FileContent.ToString)
Catch ex As Exception
Log(ex, $"写入文件失败（{FileName} -> {Key}:{Value}）")
Log(ex, $"写入文件失败（{FileName} → {Key}:{Value}）", LogLevel.Hint)
End Try
End Sub
@@ -778,10 +780,10 @@ Public Module ModBase
End Try
End Sub
''' <summary>
''' 读取文件，如果失败则返回空字符串。
''' 读取文件，如果失败则返回空数组。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
Public Function ReadFileBytes(FilePath As String, Optional Encoding As Encoding = Nothing) As Byte()
Try
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
@@ -791,17 +793,25 @@ Public Module ModBase
ReDim FileBytes(ReadStream.Length - 1)
ReadStream.Read(FileBytes, 0, ReadStream.Length)
End Using
ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
Return FileBytes
Else
Log("[System] 欲读取的文件不存在，已返回空字符串：" & FilePath)
Return ""
Log("[System] 欲读取的文件不存在，已返回空内容：" & FilePath)
Return {}
End If
Catch ex As Exception
Log(ex, "读取文件出错：" & FilePath)
Return ""
Return {}
End Try
End Function
''' <summary>
''' 读取文件，如果失败则返回空字符串。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
Dim FileBytes = ReadFileBytes(FilePath)
ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
End Function
''' <summary>
''' 读取流中的所有文本。
''' </summary>
Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String
@@ -826,50 +836,39 @@ Public Module ModBase
''' <param name="FilePath">文件完整或相对路径。</param>
''' <param name="Text">文件内容。</param>
''' <param name="Append">是否将文件内容追加到当前文件，而不是覆盖它。</param>
Public Function WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing) As Boolean
Try
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'确保目录存在
Directory.CreateDirectory(GetPathFromFullPath(FilePath))
'写入文件
If File.Exists(FilePath) Then
'如果文件存在，刷新目前文件
Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(FilePath)))
writer.Write(Text)
writer.Flush()
writer.Close()
End Using
Else
'如果文件不存在，则新建并写入
File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False)))
End If
Return True
Catch ex As Exception
Log(ex, "写入文件时出错：" & FilePath)
Return False
End Try
End Function
Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing)
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'确保目录存在
Directory.CreateDirectory(GetPathFromFullPath(FilePath))
'写入文件
If File.Exists(FilePath) Then
'如果文件存在，刷新目前文件
Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(ReadFileBytes(FilePath))))
writer.Write(Text)
writer.Flush()
writer.Close()
End Using
Else
'如果文件不存在，则新建并写入
File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False)))
End If
End Sub
''' <summary>
''' 写入文件。
''' 如果 CanThrow 设置为 False，返回是否写入成功。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
''' <param name="Content">文件内容。</param>
''' <param name="Append">是否将文件内容追加到当前文件，而不是覆盖它。</param>
Public Function WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False) As Boolean
Try
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'确保目录存在
Directory.CreateDirectory(GetPathFromFullPath(FilePath))
'写入文件
File.WriteAllBytes(FilePath, Content)
Return True
Catch ex As Exception
Log(ex, "写入文件时出错：" & FilePath)
Return False
End Try
End Function
Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False)
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'确保目录存在
Directory.CreateDirectory(GetPathFromFullPath(FilePath))
'写入文件
File.WriteAllBytes(FilePath, Content)
End Sub
''' <summary>
''' 将流写入文件。
''' </summary>
@@ -899,21 +898,11 @@ Public Module ModBase
'文件编码
''' <summary>
''' 获取文件编码。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function GetEncoding(FilePath As String) As Encoding
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'获取编码
GetEncoding = GetEncoding(File.ReadAllBytes(FilePath))
End Function
''' <summary>
''' 获取 Bytes 的编码。
''' 根据字节数组分析其编码。
''' </summary>
Public Function GetEncoding(Bytes As Byte()) As Encoding
Dim Length As Integer = Bytes.Count
If Length <= 2 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8
If Length < 3 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8
'根据 BOM 判断编码
If Bytes(0) >= &HEF Then
'有 BOM 类型
@@ -986,7 +975,7 @@ Public Module ModBase
End Using
End Function
''' <summary>
''' 弹出选取文件对话框并且要求选取文件。
''' 弹出选取文件对话框，要求选择一个文件。
''' </summary>
''' <param name="FileFilter">要求的格式。如：“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
''' <param name="Title">弹窗的标题。</param>
@@ -1000,12 +989,32 @@ Public Module ModBase
fileDialog.Title = Title
fileDialog.ValidateNames = True
fileDialog.ShowDialog()
SelectFile = fileDialog.FileName
Log("[UI] 选择文件返回：" & SelectFile)
Log("[UI] 选择单个文件返回：" & fileDialog.FileName)
Return fileDialog.FileName
End Using
End Function
''' <summary>
''' 弹出选取文件夹对话框并且要求选取文件夹。如果没有选择就返回空字符串。
''' 弹出选取文件对话框，要求选择多个文件。
''' </summary>
''' <param name="FileFilter">要求的格式。如：“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
''' <param name="Title">弹窗的标题。</param>
Public Function SelectFiles(FileFilter As String, Title As String) As String()
Using fileDialog As New Forms.OpenFileDialog
fileDialog.AddExtension = True
fileDialog.AutoUpgradeEnabled = True
fileDialog.CheckFileExists = True
fileDialog.Filter = FileFilter
fileDialog.Multiselect = True
fileDialog.Title = Title
fileDialog.ValidateNames = True
fileDialog.ShowDialog()
Log("[UI] 选择多个文件返回：" & fileDialog.FileNames.Join(","))
Return fileDialog.FileNames
End Using
End Function
''' <summary>
''' 弹出选取文件夹对话框，要求选取文件夹。
''' 返回以 \ 结尾的完整路径，如果没有选择则返回空字符串。
''' </summary>
Public Function SelectFolder(Optional Title As String = "选择文件夹") As String
Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True}
@@ -1020,7 +1029,7 @@ Public Module ModBase
''' </summary>
Public Function CheckPermission(Path As String) As Boolean
Try
If Path = "" Then Return False
If String.IsNullOrEmpty(Path) Then Return False
If Not Path.EndsWithF("\") Then Path += "\"
If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False
If Not Directory.Exists(Path) Then Return False
@@ -1112,8 +1121,6 @@ Re:
Dim Retry As Boolean = False
Re:
Try
''检测该文件是否在下载中，若在下载则放弃检测
'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
'获取 SHA1
Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim sha1 As SHA1 = New SHA1CryptoServiceProvider()
@@ -1224,7 +1231,8 @@ Re:
''' 尝试根据后缀名判断文件种类并解压文件，支持 gz 与 zip，会尝试将 jar 以 zip 方式解压。
''' 会尝试创建，但不会清空目标文件夹。
''' </summary>
Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing)
Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing,
Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWithF(".gz", True) Then
'以 gz 方式解压
@@ -1240,7 +1248,9 @@ Re:
Else
'以 zip 方式解压
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
Dim TotalCount As Integer = Archive.Entries.Count
For Each Entry As ZipArchiveEntry In Archive.Entries
If ProgressIncrementHandler IsNot Nothing Then ProgressIncrementHandler(1 / TotalCount)
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
Continue For '不创建空文件夹
@@ -1259,28 +1269,47 @@ Re:
Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
If Not Directory.Exists(Path) Then Return 0
Dim DeletedCount As Integer = 0
Dim Temp As String()
Temp = Directory.GetFiles(Path)
For Each str As String In Temp
Dim Files As String()
Try
Files = Directory.GetFiles(Path)
Catch ex As DirectoryNotFoundException '#4549
Log(ex, $"疑似为孤立符号链接，尝试直接删除（{Path}）", LogLevel.Developer)
Directory.Delete(Path)
Return 0
End Try
For Each FilePath As String In Files
Dim RetriedFile As Boolean = False
RetryFile:
Try
File.Delete(str)
File.Delete(FilePath)
DeletedCount += 1
Catch ex As Exception
If IgnoreIssue Then
If Not RetriedFile Then
RetriedFile = True
Log(ex, $"删除文件失败，将在 0.3s 后重试（{FilePath}）")
Thread.Sleep(300)
GoTo RetryFile
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件可忽略地失败")
Else
Throw
End If
End Try
Next
Temp = Directory.GetDirectories(Path)
For Each str As String In Temp
For Each str As String In Directory.GetDirectories(Path)
DeleteDirectory(str, IgnoreIssue)
Next
Dim RetriedDir As Boolean = False
RetryDir:
Try
Directory.Delete(Path, True)
Catch ex As Exception
If IgnoreIssue Then
If Not RetriedDir Then
RetriedDir = True
Log(ex, $"删除文件夹失败，将在 0.3s 后重试（{Path}）")
Thread.Sleep(300)
GoTo RetryDir
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件夹可忽略地失败")
Else
Throw
@@ -1291,13 +1320,16 @@ Re:
''' <summary>
''' 复制文件夹，失败会抛出异常。
''' </summary>
Public Sub CopyDirectory(FromPath As String, ToPath As String)
Public Sub CopyDirectory(FromPath As String, ToPath As String, Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
FromPath = FromPath.Replace("/", "\")
If Not FromPath.EndsWithF("\") Then FromPath &= "\"
ToPath = ToPath.Replace("/", "\")
If Not ToPath.EndsWithF("\") Then ToPath &= "\"
For Each File In EnumerateFiles(FromPath)
Dim AllFiles = EnumerateFiles(FromPath).ToList
Dim FileCount As Integer = AllFiles.Count
For Each File In AllFiles
CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
If ProgressIncrementHandler IsNot Nothing Then ProgressIncrementHandler(1 / FileCount)
Next
End Sub
''' <summary>
@@ -1346,8 +1378,8 @@ Re:
'常见错误（记得同时修改下面的）
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
@@ -1366,7 +1398,7 @@ Re:
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
@@ -1394,8 +1426,8 @@ Re:
'常见错误（记得同时修改上面的）
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
@@ -1409,7 +1441,7 @@ Re:
'构造输出信息
If CommonReason IsNot Nothing Then
Return DescList.First & "：" & CommonReason
Return CommonReason & "详细错误：" & DescList.First
Else
DescList.Reverse() '让最深层错误在最左边
Return Join(DescList, " → ")
@@ -1449,14 +1481,14 @@ Re:
End Function
''' <summary>
''' 获取 Json 对象。
''' 获取 JSON 对象。
''' </summary>
Public Function GetJson(Data As String)
Try
Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
Catch ex As Exception
Dim Length As Integer = If(Data, "").Length
Throw New Exception("格式化 json 对象失败：" & If(Length > 10000, Data.Substring(0, 100) & $"...(全长 {Length} 个字符)..." & Right(Data, 100), Data))
Throw New Exception("格式化 JSON 失败：" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data))
End Try
End Function
@@ -1550,10 +1582,10 @@ Re:
End Function
''' <summary>
''' 获取在子字符串之前的部分。
''' 会裁切尽可能多的内容，但如果未找到子字符串则不裁切。
''' 获取在子字符串第一次出现之前的部分，例如对 2024/11/08 拆切 / 会得到 2024。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function Before(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
<Extension> Public Function BeforeFirst(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase))
If Pos >= 0 Then
Return Str.Substring(0, Pos)
@@ -1562,10 +1594,34 @@ Re:
End If
End Function
''' <summary>
''' 获取在子字符串之后的部分。
''' 会裁切尽可能多的内容，但如果未找到子字符串则不裁切。
''' 获取在子字符串最后一次出现之前的部分，例如对 2024/11/08 拆切 / 会得到 2024/11。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function After(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
<Extension> Public Function BeforeLast(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase))
If Pos >= 0 Then
Return Str.Substring(0, Pos)
Else
Return Str
End If
End Function
''' <summary>
''' 获取在子字符串第一次出现之后的部分，例如对 2024/11/08 拆切 / 会得到 11/08。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function AfterFirst(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase))
If Pos >= 0 Then
Return Str.Substring(Pos + Text.Length)
Else
Return Str
End If
End Function
''' <summary>
''' 获取在子字符串最后一次出现之后的部分，例如对 2024/11/08 拆切 / 会得到 08。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function AfterLast(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase))
If Pos >= 0 Then
Return Str.Substring(Pos + Text.Length)
@@ -1574,17 +1630,17 @@ Re:
End If
End Function
''' <summary>
''' 获取处于两个子字符串之间的部分。
''' 会裁切尽可能多的内容：匹配开始使用 LastIndexOf，匹配结束使用 IndexOf，但如果未找到子字符串则不裁切。
''' 获取处于两个子字符串之间的部分，裁切尽可能多的内容。
''' 如果未找到子字符串则不裁切。
''' </summary>
<Extension> Public Function Between(Str As String, Before As String, After As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.LastIndexOfF(Before, IgnoreCase))
<Extension> Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.LastIndexOfF(After, IgnoreCase))
If StartPos >= 0 Then
StartPos += Before.Length
StartPos += After.Length
Else
StartPos = 0
End If
Dim EndPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.IndexOfF(After, StartPos, IgnoreCase))
Dim EndPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.IndexOfF(Before, StartPos, IgnoreCase))
If EndPos >= 0 Then
Return Str.Substring(StartPos, EndPos - StartPos)
ElseIf StartPos > 0 Then
@@ -1645,10 +1701,15 @@ Re:
End Function
''' <summary>
''' 输入 And 字符不会报错的 Val。
''' 不会报错的 Val。
''' 如果输入有误，返回 0。
''' </summary>
Public Function Val(Str As Object) As Double
Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
Try
Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
Catch
Return 0
End Try
End Function
'转义
@@ -1656,7 +1717,10 @@ Re:
''' 为字符串进行 XML 转义。
''' </summary>
Public Function EscapeXML(Str As String) As String
Return Str.Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
If Str.StartsWithF("{") Then Str = "{}" & Str '#4187
Return Str.
Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").
Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
End Function
'正则
@@ -1802,10 +1866,10 @@ Re:
'进行搜索，获取相似信息
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,
@@ -1834,6 +1898,68 @@ Re:
#Region "系统"
''' <summary>
''' 线程安全的，可以直接使用 For Each 的 List。
''' 在使用 For Each 循环时，列表的结果可能并非最新，但不会抛出异常。
''' </summary>
Public Class SafeList(Of T)
Inherits SynchronizedCollection(Of T)
Implements IEnumerable, IEnumerable(Of T)
'构造函数
Public Sub New()
MyBase.New()
End Sub
Public Sub New(Data As IEnumerable(Of T))
MyBase.New(New Object, Data)
End Sub
Public Shared Widening Operator CType(Data As List(Of T)) As SafeList(Of T)
Return New SafeList(Of T)(Data)
End Operator
Public Shared Widening Operator CType(Data As SafeList(Of T)) As List(Of T)
Return New List(Of T)(Data)
End Operator
'基于 SyncLock 覆写
Public Overloads Function GetEnumerator() As IEnumerator(Of T) Implements IEnumerable(Of T).GetEnumerator
SyncLock SyncRoot
Return Items.ToList.GetEnumerator()
End SyncLock
End Function
Private Overloads Function GetEnumeratorGeneral() As IEnumerator Implements IEnumerable.GetEnumerator
SyncLock SyncRoot
Return Items.ToList.GetEnumerator()
End SyncLock
End Function
End Class
''' <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 RestartException
Inherits Exception
End Class
''' <summary>
''' 指示用户手动取消了操作，或用户已知晓操作被取消的原因。
''' </summary>
Public Class CancelledException
Inherits Exception
End Class
''' <summary>
''' 当前程序是否拥有管理员权限。
''' </summary>
@@ -1852,6 +1978,13 @@ Re:
Return NewProcess.ExitCode
End Function
''' <summary>
''' 判断当前系统语言是否为中文。
''' </summary>
Public Function IsSystemLanguageChinese() As Boolean
Return CultureInfo.CurrentCulture.TwoLetterISOLanguageName = "zh" OrElse CultureInfo.CurrentUICulture.TwoLetterISOLanguageName = "zh"
End Function
Private Uuid As Integer = 1
Private UuidLock As Object
''' <summary>
@@ -1943,10 +2076,10 @@ NextElement:
'12~60 月，“1 年 2 个月”
GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年" & If((TotalMonthes Mod 12) > 0, " " & (TotalMonthes Mod 12) & " 个月", "")
ElseIf TotalMonthes >= 4 Then
'4~11 月，“5 月”
GetTimeSpanString = TotalMonthes & " 月"
'4~11 月，“5 个月”
GetTimeSpanString = TotalMonthes & " 个月"
ElseIf TotalMonthes >= 1 Then
'1~4 月，“2 月 13 天”
'1~4 月，“2 个月 13 天”
GetTimeSpanString = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
ElseIf Span.TotalDays >= 4 Then
'4~30 天，“23 天”
@@ -2068,7 +2201,7 @@ NextElement:
''' <summary>
''' 在新的工作线程中执行代码。
''' </summary>
Public Function RunInNewThread(Action As Action, Name As String, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
Public Function RunInNewThread(Action As Action, Optional Name As String = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
Dim th As New Thread(
Sub()
Try
@@ -2078,7 +2211,7 @@ NextElement:
Catch ex As Exception
Log(ex, Name & "：线程执行失败", LogLevel.Feedback)
End Try
End Sub) With {.Name = Name, .Priority = Priority}
End Sub) With {.Name = If(Name, "Runtime New Invoke " & GetUuid() & "#"), .Priority = Priority}
th.Start()
Return th
End Function
@@ -2417,6 +2550,14 @@ Retry:
Return rect.Contains(bounds.TopLeft) OrElse rect.Contains(bounds.BottomRight)
End Function
''' <summary>
''' 控件是否受到 TextTrimming 属性影响，导致内容被截取。
''' </summary>
<Extension> Public Function IsTextTrimmed(Control As TextBlock) As Boolean
Control.Measure(New Size(Double.MaxValue, Double.MaxValue))
Return Control.DesiredSize.Width > Control.ActualWidth
End Function
#End Region
#Region "Debug"
@@ -2657,7 +2798,11 @@ Retry:
End Sub
Public Function CanFeedback(ShowHint As Boolean) As Boolean
If False.Equals(PageSetupSystem.IsLauncherNewest) Then
If ShowHint Then MyMsgBox("你的 PCL 不是最新版，因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈")
If ShowHint Then
If MyMsgBox($"你的 PCL 不是最新版，因此无法提交反馈。{vbCrLf}请在更新后，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
UpdateCheckByButton()
End If
End If
Return False
Else
Return True
@@ -2669,7 +2814,7 @@ Retry:
Public Sub FeedbackInfo()
On Error Resume Next
Log("[System] 诊断信息：" & vbCrLf &
"操作系统：" & My.Computer.Info.OSFullName & vbCrLf &
"操作系统：" & My.Computer.Info.OSFullName & "（32 位：" & Is32BitSystem & "）" & vbCrLf &
"剩余内存：" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
"DPI：" & DPI & "（" & Math.Round(DPI / 96, 2) * 100 & "%）" & vbCrLf &
"MC 文件夹：" & If(PathMcFolder, "Nothing") & vbCrLf &