2.10.4

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

@@ -13,13 +13,13 @@ Public Module ModBase
 #Region "声明"
 
     '下列版本信息由更新器自动修改
-    Public Const VersionBaseName As String = "2.10.3" '不含分支前缀的显示用版本名
-    Public Const VersionStandardCode As String = "2.10.3." & VersionBranchCode '标准格式的四段式版本号
+    Public Const VersionBaseName As String = "2.10.4" '不含分支前缀的显示用版本名
+    Public Const VersionStandardCode As String = "2.10.4." & VersionBranchCode '标准格式的四段式版本号
     Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
 #If BETA Then
     Public Const VersionCode As Integer = 361 'Release
 #Else
-    Public Const VersionCode As Integer = 362 'Snapshot
+    Public Const VersionCode As Integer = 363 'Snapshot
 #End If
     '自动生成的版本信息
     Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -1551,7 +1551,7 @@ RetryDir:
     ''' <summary>
     ''' 获取 JSON 对象。
     ''' </summary>
-    Public Function GetJson(Data As String)
+    Public Function GetJson(Data As String) As JToken
         Try
             Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
         Catch ex As Exception
@@ -2131,6 +2131,19 @@ RetryDir:
         End Function
     End Class
 
+    ''' <summary>
+    ''' 将二维数组转换为字典。
+    ''' </summary>
+    <Extension> Public Function ToDictionary(Of T)(arr As T(,)) As Dictionary(Of T, T)
+        Dim result As New Dictionary(Of T, T)
+        If arr.Length = 0 Then Return result
+        If arr.GetLength(1) <> 2 Then Throw New ArgumentException("数组必须为两列，第一列为 Key，第二列为 Value。")
+        For i As Integer = 0 To arr.GetLength(0) - 1
+            result(arr(i, 0)) = arr(i, 1)
+        Next
+        Return result
+    End Function
+
     ''' <summary>
     ''' 可用于临时存放文件的，不含任何特殊字符的文件夹路径，以“\”结尾。
     ''' </summary>
@@ -2179,10 +2192,10 @@ RetryDir:
     End Function
 
     ''' <summary>
-    ''' 判断当前系统语言是否为 zh-CN。
+    ''' 判断当前系统语言是否为中文。
     ''' </summary>
     Public Function IsSystemLanguageChinese() As Boolean
-        Return CultureInfo.CurrentCulture.Name = "zh-CN" OrElse CultureInfo.CurrentUICulture.Name = "zh-CN"
+        Return CultureInfo.CurrentCulture.Name.StartsWithF("zh-") OrElse CultureInfo.CurrentUICulture.Name.StartsWithF("zh-")
     End Function
 
     Private Uuid As Integer = 1
@@ -2225,6 +2238,9 @@ NextElement:
         Next i
         Return ResultArray
     End Function
+    <Extension> Public Function Any(Arr As UIElementCollection) As Boolean
+        Return Arr?.Count > 0
+    End Function
 
     ''' <summary>
     ''' 获取格式类似于“11:08:52.037”的当前时间的字符串。
@@ -2462,7 +2478,7 @@ NextElement:
     ''' </summary>
     Public Sub RunInThread(Action As Action)
         If RunInUi() Then
-            RunInNewThread(Action, "Runtime Invoke " & GetUuid() & "#")
+            RunInNewThread(Action, "Invoke " & GetUuid())
         Else
             Action()
         End If
@@ -2760,11 +2776,11 @@ Retry:
             Using Reader As New XamlXmlReader(Stream)
                 While Reader.Read()
                     For Each BlackListType In {GetType(WebBrowser), GetType(Frame), GetType(MediaElement), GetType(ObjectDataProvider), GetType(XamlReader), GetType(Window), GetType(XmlDataProvider)}
-                        If Reader.Type IsNot Nothing AndAlso BlackListType.IsAssignableFrom(Reader.Type.UnderlyingType) Then Throw New UnauthorizedAccessException($"不允许使用 {BlackListType.Name} 类型。")
-                        If Reader.Value IsNot Nothing AndAlso Reader.Value = BlackListType.Name Then Throw New UnauthorizedAccessException($"不允许使用 {BlackListType.Name} 值。")
+                        If Reader.Type IsNot Nothing AndAlso BlackListType.IsAssignableFrom(Reader.Type.UnderlyingType) Then Throw New UnauthorizedAccessException($"基于安全考虑，不允许使用 {BlackListType.Name} 类型。")
+                        If Reader.Value IsNot Nothing AndAlso Reader.Value = BlackListType.Name Then Throw New UnauthorizedAccessException($"基于安全考虑，不允许使用 {BlackListType.Name} 值。")
                     Next
                     For Each BlackListMember In {"Code", "FactoryMethod", "Static"}
-                        If Reader.Member IsNot Nothing AndAlso Reader.Member.Name = BlackListMember Then Throw New UnauthorizedAccessException($"不允许使用 {BlackListMember} 成员。")
+                        If Reader.Member IsNot Nothing AndAlso Reader.Member.Name = BlackListMember Then Throw New UnauthorizedAccessException($"基于安全考虑，不允许使用 {BlackListMember} 成员。")
                     Next
                 End While
             End Using
@@ -2922,7 +2938,7 @@ Retry:
         '处理错误会导致再次调用 Log() 导致无限循环
 
         '输出日志
-        Dim AppendText As String = "[" & GetTimeNow() & "] " & Text & vbCrLf '减轻同步锁占用
+        Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Text}{vbCrLf}" '减轻同步锁占用
         If ModeDebug Then
             SyncLock LogListLock
                 LogList.Append(AppendText)
@@ -2986,7 +3002,7 @@ Retry:
         Dim ExFull As String = Desc & "：" & GetExceptionDetail(Ex)
 
         '输出日志
-        Dim AppendText As String = "[" & GetTimeNow() & "] " & Desc & "：" & GetExceptionDetail(Ex, True) & vbCrLf '减轻同步锁占用
+        Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Desc}：{GetExceptionDetail(Ex, True)}{vbCrLf}" '减轻同步锁占用
         If ModeDebug Then
             SyncLock LogListLock
                 LogList.Append(AppendText)
@@ -3048,7 +3064,7 @@ Retry:
         If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug，请点击 打开文件夹 按钮，并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关，请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
             OpenExplorer(Path & "PCL\Log1.txt")
         End If
-        OpenWebsite("https://github.com/Hex-Dragon/PCL2/issues/")
+        OpenWebsite("https://github.com/Meloong-Git/PCL/issues/")
     End Sub
     Public Function CanFeedback(ShowHint As Boolean) As Boolean
         If False.Equals(PageSetupSystem.IsLauncherNewest) Then

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

@@ -1,152 +0,0 @@
-Imports System
-Imports System.ComponentModel
-Imports System.Runtime.InteropServices
-Imports System.Text
-Imports System.Windows.Interop
-
-
-Public Class DragFileHelper
-
-    Public Event DragDrop As EventHandler
-
-    Public Property DropFilePaths As String()
-        Get
-            Return _DropFilePathsBackingField
-        End Get
-        Private Set(value As String())
-            _DropFilePathsBackingField = value
-        End Set
-    End Property
-    Private _DropFilePathsBackingField As String()
-
-    Public Property DropPoint As POINT
-        Get
-            Return _DropPointBackingField
-        End Get
-        Private Set(value As POINT)
-            _DropPointBackingField = value
-        End Set
-    End Property
-    Private _DropPointBackingField As POINT
-
-    Public Property HwndIntPtrSource As HwndSource
-
-    Public Sub AddHook()
-        Me.RemoveDragHook()
-        Me.HwndIntPtrSource.AddHook(AddressOf WndProc)
-        Dim handle As IntPtr = Me.HwndIntPtrSource.Handle
-        If IsUserAnAdmin() Then RevokeDragDrop(handle)
-        DragAcceptFiles(handle, True)
-        ChangeMessageFilter(handle)
-    End Sub
-
-    Public Sub RemoveDragHook()
-        Me.HwndIntPtrSource.RemoveHook(AddressOf WndProc)
-        DragAcceptFiles(Me.HwndIntPtrSource.Handle, False)
-    End Sub
-
-    Private Function WndProc(ByVal hwnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr, ByRef handled As Boolean) As IntPtr
-        Dim filePaths As String() = Nothing
-        Dim point As POINT = New POINT()
-
-        If TryGetDropInfo(msg, wParam, filePaths, point) Then
-            DropPoint = point
-            DropFilePaths = filePaths
-            RaiseEvent DragDrop(Me, EventArgs.Empty)
-            handled = True
-        End If
-        Return IntPtr.Zero
-    End Function
-
-    <DllImport("user32.dll", SetLastError:=True)>
-    Private Shared Function ChangeWindowMessageFilterEx(ByVal hWnd As IntPtr, ByVal msg As UInteger, ByVal action As UInteger, ByRef pChangeFilterStruct As CHANGEFILTERSTRUCT) As Boolean
-    End Function
-
-    <DllImport("user32.dll", SetLastError:=True)>
-    Private Shared Function ChangeWindowMessageFilter(ByVal msg As UInteger, ByVal flags As UInteger) As Boolean
-    End Function
-
-    <DllImport("shell32.dll")>
-    Private Shared Sub DragAcceptFiles(ByVal hWnd As IntPtr, ByVal fAccept As Boolean)
-    End Sub
-
-    <DllImport("shell32.dll", CharSet:=CharSet.Unicode)>
-    Private Shared Function DragQueryFile(ByVal hWnd As IntPtr, ByVal iFile As UInteger, ByVal lpszFile As StringBuilder, ByVal cch As Integer) As UInteger
-    End Function
-
-    <DllImport("shell32.dll")>
-    Private Shared Function DragQueryPoint(ByVal hDrop As IntPtr, ByRef lppt As POINT) As Boolean
-    End Function
-
-    <DllImport("shell32.dll")>
-    Private Shared Sub DragFinish(ByVal hDrop As IntPtr)
-    End Sub
-
-    <DllImport("ole32.dll")>
-    Private Shared Function RevokeDragDrop(ByVal hWnd As IntPtr) As Integer
-    End Function
-
-    <DllImport("shell32.dll")>
-    Private Shared Function IsUserAnAdmin() As Boolean
-    End Function
-
-    <StructLayout(LayoutKind.Sequential)>
-    Public Structure POINT
-        Public X As Integer
-        Public Y As Integer
-    End Structure
-
-    <StructLayout(LayoutKind.Sequential)>
-    Private Structure CHANGEFILTERSTRUCT
-        Public cbSize As UInteger
-        Public ExtStatus As UInteger
-    End Structure
-
-    Private Const WM_COPYGLOBALDATA As UInteger = &H49
-    Private Const WM_COPYDATA As UInteger = &H4A
-    Private Const WM_DROPFILES As UInteger = &H233
-    Private Const MSGFLT_ALLOW As UInteger = 1
-    Private Const MSGFLT_ADD As UInteger = 1
-    Private Const MAX_PATH As Integer = 260
-
-    Private Shared Sub ChangeMessageFilter(ByVal handle As IntPtr)
-        Dim ver As Version = Environment.OSVersion.Version
-        Dim isVistaOrHigher As Boolean = ver >= New Version(6, 0)
-        Dim isNt61OrHiger As Boolean = ver >= New Version(6, 1)
-
-        If isVistaOrHigher Then
-            Dim status As CHANGEFILTERSTRUCT = New CHANGEFILTERSTRUCT With {.cbSize = 8}
-            For Each msg As UInteger In New UInteger() {WM_DROPFILES, WM_COPYGLOBALDATA, WM_COPYDATA}
-                Dim [error] As Boolean = False
-                If isNt61OrHiger Then
-                    [error] = Not ChangeWindowMessageFilterEx(handle, msg, MSGFLT_ALLOW, status)
-                Else
-                    [error] = Not ChangeWindowMessageFilter(msg, MSGFLT_ADD)
-                End If
-
-                If [error] Then Throw New Win32Exception(Marshal.GetLastWin32Error())
-            Next
-        End If
-    End Sub
-
-    Private Shared Function TryGetDropInfo(ByVal msg As Integer, ByVal wParam As IntPtr, ByRef dropFilePaths As String(), ByRef dropPoint As POINT) As Boolean
-        dropFilePaths = Nothing
-        dropPoint = New POINT()
-
-        If msg <> WM_DROPFILES Then Return False
-
-        Dim fileCount As UInteger = DragQueryFile(wParam, UInteger.MaxValue, Nothing, 0)
-        ReDim dropFilePaths(CInt(fileCount) - 1)
-
-        For i As UInteger = 0 To fileCount - 1
-            Dim sb As New StringBuilder(MAX_PATH)
-            Dim result As UInteger = DragQueryFile(wParam, i, sb, sb.Capacity)
-            If result > 0 Then dropFilePaths(CInt(i)) = sb.ToString()
-        Next
-
-        DragQueryPoint(wParam, dropPoint)
-        DragFinish(wParam)
-        Return True
-    End Function
-
-End Class

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

@@ -339,7 +339,7 @@
                     [Error] = ex
                     State = LoadState.Failed
                 End Try
-            End Sub) With {.Name = Name, .Priority = ThreadPriority}
+            End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
             LastRunningThread.Start() '不能使用 RunInNewThread，否则在函数返回前线程就会运行完，导致误判 IsAborted
         End Sub
         Public Overrides Sub Abort()