Merge branch 'main' into main
This commit is contained in:
@@ -1,25 +1,41 @@
|
||||
Imports System.Reflection
|
||||
Imports System.Reflection
|
||||
Imports System.Windows.Threading
|
||||
Imports Microsoft.Win32
|
||||
|
||||
Public Class Application
|
||||
|
||||
#If DEBUG Then
|
||||
''' <summary>
|
||||
''' 用于开始程序时的一些测试。
|
||||
''' </summary>
|
||||
Private Sub Test()
|
||||
Try
|
||||
ModDevelop.Start()
|
||||
Catch ex As Exception
|
||||
Log(ex, "开发者模式测试出错", LogLevel.Msgbox)
|
||||
End Try
|
||||
End Sub
|
||||
#End If
|
||||
|
||||
'开始
|
||||
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
|
||||
Try
|
||||
SecretOnApplicationStart()
|
||||
'核心初始化
|
||||
MeloongCore.Main.Init("PCL")
|
||||
MeloongCore.Wpf.Main.Init()
|
||||
Logger.Instance = New PclLogger With {.logFolder = Paths.BaseThenName, .MinLevel = If(ModeDebug, LogLevel.Trace, LogLevel.Info)}
|
||||
'提升主线程优先级
|
||||
Thread.CurrentThread.Priority = ThreadPriority.Highest
|
||||
'执行开发版测试
|
||||
If BuildType = BuildTypes.Debug Then
|
||||
Try
|
||||
ModDevelop.Start()
|
||||
Catch ex As Exception
|
||||
Logger.Error(ex, "开发者模式测试出错", LogBehavior.Alert)
|
||||
End Try
|
||||
End If
|
||||
'检查 .NET Framework 版本
|
||||
Try
|
||||
Using ndpKey As RegistryKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry32).OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\v4\Full\")
|
||||
If ndpKey?.GetValue("Release") IsNot Nothing AndAlso CInt(ndpKey.GetValue("Release")) < 528040 Then OldEnvironmentAssert()
|
||||
End Using
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "检查 .NET Framework 版本失败")
|
||||
End Try
|
||||
'修复 WPF 字体加载(#3467)
|
||||
Try
|
||||
Dim _unused As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
|
||||
Catch ex As UriFormatException
|
||||
Environment.SetEnvironmentVariable("windir", Environment.GetEnvironmentVariable("SystemRoot"), EnvironmentVariableTarget.User)
|
||||
Dim _unused As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
|
||||
End Try
|
||||
'检查参数调用
|
||||
If e.Args.Length > 0 Then
|
||||
If e.Args(0) = "--update" Then
|
||||
@@ -48,232 +64,219 @@ Public Class Application
|
||||
Else
|
||||
Environment.Exit((My.Computer.Info.AvailablePhysicalMemory - Ram) / 1024) '返回清理的内存量(K)
|
||||
End If
|
||||
#If DEBUG Then
|
||||
'制作更新包
|
||||
ElseIf e.Args(0) = "--edit1" Then
|
||||
ExeEdit(e.Args(1), True)
|
||||
Environment.Exit(ProcessReturnValues.TaskDone)
|
||||
ElseIf e.Args(0) = "--edit2" Then
|
||||
ExeEdit(e.Args(1), False)
|
||||
Environment.Exit(ProcessReturnValues.TaskDone)
|
||||
#End If
|
||||
End If
|
||||
End If
|
||||
'初始化文件结构
|
||||
Directory.CreateDirectory(Path & "PCL\Pictures")
|
||||
Directory.CreateDirectory(Path & "PCL\Musics")
|
||||
Try
|
||||
Directory.CreateDirectory(PathTemp)
|
||||
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限")
|
||||
DirectoryUtils.Create(Paths.Base & "PCL\Pictures\")
|
||||
DirectoryUtils.Create(Paths.Base & "PCL\Musics\")
|
||||
CheckPermissionWithException(Paths.Base & "PCL\")
|
||||
Catch ex As Exception
|
||||
If PathTemp = IO.Path.GetTempPath() & "PCL\" Then
|
||||
MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
|
||||
MsgBox($"PCL 没有对当前文件夹的权限({Paths.Base}PCL\),请尝试:" & vbCrLf &
|
||||
"1. 将 PCL 移动到其他文件夹" & If(Paths.Base.StartsWithF("C:", True), ",例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
|
||||
"2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
|
||||
"3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
|
||||
MsgBoxStyle.Critical, "运行环境错误")
|
||||
Environment.[Exit](ProcessReturnValues.Cancel)
|
||||
End Try
|
||||
RetryCacheCheck:
|
||||
Try
|
||||
DirectoryUtils.Create(PathTemp)
|
||||
CheckPermissionWithException(PathTemp)
|
||||
Catch ex As Exception
|
||||
If PathTemp = Path.GetTempPath() & "PCL\" Then
|
||||
MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDisplay(True), "缓存文件夹不可用")
|
||||
Else
|
||||
MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用")
|
||||
Setup.Set("SystemSystemCache", "")
|
||||
PathTemp = IO.Path.GetTempPath() & "PCL\"
|
||||
MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDisplay(True), "缓存文件夹不可用")
|
||||
Settings.Set("SystemSystemCache", "")
|
||||
PathTemp = Path.GetTempPath() & "PCL\"
|
||||
GoTo RetryCacheCheck
|
||||
End If
|
||||
End Try
|
||||
Directory.CreateDirectory(PathTemp & "Cache")
|
||||
Directory.CreateDirectory(PathTemp & "Download")
|
||||
Directory.CreateDirectory(PathAppdata)
|
||||
'检测单例
|
||||
#If Not DEBUG Then
|
||||
Dim ShouldWaitForExit As Boolean = e.Args.Length > 0 AndAlso e.Args(0) = "--wait" '要求等待已有的 PCL 退出
|
||||
Dim WaitRetryCount As Integer = 0
|
||||
WaitRetry:
|
||||
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ")
|
||||
If WindowHwnd = IntPtr.Zero Then FindWindow(Nothing, "Plain Craft Launcher 2 ")
|
||||
If WindowHwnd <> IntPtr.Zero Then
|
||||
If ShouldWaitForExit AndAlso WaitRetryCount < 20 Then '至多等待 10 秒
|
||||
WaitRetryCount += 1
|
||||
Thread.Sleep(500)
|
||||
GoTo WaitRetry
|
||||
End If
|
||||
'将已有的 PCL 窗口拖出来
|
||||
ShowWindowToTop(WindowHwnd)
|
||||
'播放提示音并退出
|
||||
Beep()
|
||||
Environment.[Exit](ProcessReturnValues.Cancel)
|
||||
End If
|
||||
#End If
|
||||
DirectoryUtils.Create(PathTemp & "Cache\")
|
||||
DirectoryUtils.Create(Paths.AppDataThenName)
|
||||
'要求单例
|
||||
WaitingMutex(e)
|
||||
'设置 ToolTipService 默认值
|
||||
ToolTipService.InitialShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(300))
|
||||
ToolTipService.BetweenShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(400))
|
||||
ToolTipService.ShowDurationProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(9999999))
|
||||
ToolTipService.PlacementProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(Primitives.PlacementMode.Bottom))
|
||||
ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0))
|
||||
ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
|
||||
ToolTipService.InitialShowDelayProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(100))
|
||||
'设置网络配置默认值
|
||||
ServicePointManager.Expect100Continue = False
|
||||
ServicePointManager.DefaultConnectionLimit = 10000
|
||||
ServicePointManager.UseNagleAlgorithm = False
|
||||
ServicePointManager.EnableDnsRoundRobin = True
|
||||
ServicePointManager.ReusePort = True
|
||||
If Environment.OSVersion.Version < New Version(6, 2) Then 'Windows 7 回退(#8519)
|
||||
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
|
||||
End If
|
||||
'设置初始窗口
|
||||
If Setup.Get("UiLauncherLogo") Then
|
||||
If Settings.Get(Of Boolean)("UiLauncherLogo") Then
|
||||
FrmStart = New SplashScreen("Images\icon.ico")
|
||||
FrmStart.Show(False, True)
|
||||
End If
|
||||
'动态 DLL 调用
|
||||
AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
|
||||
'日志初始化
|
||||
LogStart()
|
||||
'添加日志
|
||||
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
|
||||
#If RELEASE Then
|
||||
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",正式版", "")}")
|
||||
#Else
|
||||
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
|
||||
#End If
|
||||
Log($"[Start] 程序路径:{PathWithName}")
|
||||
Log($"[Start] 系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
|
||||
Log($"[Start] 管理员权限:{IsAdmin()}")
|
||||
'基础信息
|
||||
Logger.Info($"程序版本:{VersionDisplay} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
|
||||
If BuildType = BuildTypes.Snapshot Then
|
||||
Logger.Info($"识别码:{Identify}{If(ThemeCheckOne(9), ",已解锁反馈主题", ",未解锁反馈主题")}")
|
||||
Else
|
||||
Logger.Info($"识别码:{Identify}")
|
||||
End If
|
||||
Logger.Info($"程序路径:{PathExe}")
|
||||
Logger.Info($"系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
|
||||
Logger.Info($"管理员权限:{WindowsUtils.HasAdminRole()}")
|
||||
'检测异常环境
|
||||
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
|
||||
MyMsgBox("请将 PCL 从压缩包中解压之后再使用!" & vbCrLf & "在当前环境下运行可能会导致丢失游戏存档或设置,部分功能也可能无法使用!", "环境警告", "我知道了", IsWarn:=True)
|
||||
If Paths.Base.Contains(Path.GetTempPath()) OrElse Paths.Base.Contains("AppData\Local\Temp\") Then
|
||||
MyMsgBox("请将 PCL 从压缩包中解压后再使用!" & vbCrLf & "如果不会解压,可以在网上寻找教程。", "需要解压!", "我知道了", IsWarn:=True, ForceWait:=True)
|
||||
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
|
||||
End If
|
||||
If Is32BitSystem Then
|
||||
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True)
|
||||
If Not Environment.Is64BitOperatingSystem Then
|
||||
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,请重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True, ForceWait:=True)
|
||||
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
|
||||
End If
|
||||
'设置初始化
|
||||
Setup.Load("SystemDebugMode")
|
||||
Setup.Load("SystemDebugAnim")
|
||||
Setup.Load("ToolDownloadThread")
|
||||
Setup.Load("ToolDownloadCert")
|
||||
Setup.Load("ToolDownloadSpeed")
|
||||
'网络配置初始化
|
||||
ServicePointManager.Expect100Continue = True
|
||||
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
|
||||
ServicePointManager.DefaultConnectionLimit = 1024
|
||||
'计时
|
||||
Log("[Start] 第一阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
|
||||
ApplicationStartTick = GetTimeTick()
|
||||
'执行测试
|
||||
#If DEBUG Then
|
||||
Test()
|
||||
#End If
|
||||
Logger.Info($"第一阶段加载用时:{GetTimeMs() - ApplicationStartTick} ms")
|
||||
ApplicationStartTick = GetTimeMs()
|
||||
AniControlEnabled += 1
|
||||
Catch ex As Exception
|
||||
Dim FilePath As String = Nothing
|
||||
Try
|
||||
FilePath = PathWithName
|
||||
FilePath = PathExe
|
||||
Catch
|
||||
End Try
|
||||
MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
|
||||
MsgBox(ex.GetDisplay(True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
|
||||
FormMain.EndProgramForce(ProcessReturnValues.Exception)
|
||||
End Try
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 要求程序以单例运行。
|
||||
''' 如果已在运行,则将其窗口拖出来并播放提示音,然后结束当前进程。
|
||||
''' </summary>
|
||||
Private Shared Sub WaitingMutex(e As StartupEventArgs)
|
||||
If BuildType = BuildTypes.Debug Then Return
|
||||
Try
|
||||
Dim MutexCreatedNew As Boolean
|
||||
PclMutex = New Mutex(True, "PCL_SingletonMutex", MutexCreatedNew)
|
||||
If MutexCreatedNew Then Return
|
||||
Logger.Warn("已有一个 PCL 实例正在运行")
|
||||
'等待已有的 PCL 退出
|
||||
If e.Args.Length > 0 AndAlso e.Args(0) = "--wait" Then
|
||||
Try
|
||||
If PclMutex.WaitOne(10000) Then Return '等待至多 10 秒
|
||||
Catch Ignored As AbandonedMutexException
|
||||
Return '已有实例异常退出,继续启动
|
||||
End Try
|
||||
End If
|
||||
'将已有的 PCL 窗口拖出来
|
||||
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ")
|
||||
If WindowHwnd = IntPtr.Zero Then WindowHwnd = FindWindow(Nothing, "Plain Craft Launcher 2 ")
|
||||
If WindowHwnd <> IntPtr.Zero Then ShowWindowToTop(WindowHwnd)
|
||||
'播放提示音并退出
|
||||
Beep()
|
||||
Environment.[Exit](ProcessReturnValues.Cancel)
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "单例检查失败")
|
||||
End Try
|
||||
End Sub
|
||||
Private Shared PclMutex As Mutex
|
||||
|
||||
'结束
|
||||
Private Sub Application_SessionEnding(sender As Object, e As SessionEndingCancelEventArgs) Handles Me.SessionEnding
|
||||
FrmMain.EndProgram(False)
|
||||
FrmMain?.EndProgram(False)
|
||||
End Sub
|
||||
|
||||
'异常
|
||||
Private IsCritErrored As Boolean = False
|
||||
Private Sub Application_DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs) Handles Me.DispatcherUnhandledException
|
||||
On Error Resume Next
|
||||
e.Handled = True
|
||||
If IsProgramEnded Then Exit Sub
|
||||
If IsCritErrored Then
|
||||
'在汇报错误后继续引发错误,知道这次压不住了
|
||||
FormMain.EndProgramForce(ProcessReturnValues.Exception)
|
||||
Exit Sub
|
||||
'触发页面的 Dispatcher
|
||||
If FrmMain?.PageLeft IsNot Nothing AndAlso TypeOf FrmMain.PageLeft Is IDispatcherUnhandledException Then
|
||||
CType(FrmMain.PageLeft, IDispatcherUnhandledException).DispatcherUnhandledException(sender, e)
|
||||
If e.Handled Then Return
|
||||
End If
|
||||
IsCritErrored = True
|
||||
Dim ExceptionString As String = GetExceptionDetail(e.Exception, True)
|
||||
If ExceptionString.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse
|
||||
ExceptionString.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse
|
||||
ExceptionString.Contains(".NET Framework") OrElse ' “自动错误判断” 的结果分析
|
||||
ExceptionString.Contains("未能加载文件或程序集") Then
|
||||
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
|
||||
MsgBox("你的 .NET Framework 版本过低或损坏,请下载并重新安装 .NET Framework 4.6.2!", MsgBoxStyle.Information, "运行环境错误")
|
||||
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
|
||||
If FrmMain?.PageRight IsNot Nothing AndAlso TypeOf FrmMain.PageRight Is IDispatcherUnhandledException Then
|
||||
CType(FrmMain.PageRight, IDispatcherUnhandledException).DispatcherUnhandledException(sender, e)
|
||||
If e.Handled Then Return
|
||||
End If
|
||||
'正常处理
|
||||
e.Handled = True
|
||||
If IsProgramEnding Then Return
|
||||
FeedbackInfo()
|
||||
Dim Detail As String = e.Exception.GetDisplay(True)
|
||||
If Detail.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse Detail.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse Detail.Contains("未能加载文件或程序集") OrElse
|
||||
Detail.Contains(".NET Framework") Then ' “自动错误判断” 的结果分析
|
||||
OldEnvironmentAssert(e.Exception)
|
||||
Else
|
||||
FeedbackInfo()
|
||||
Log(e.Exception, "程序出现未知错误", LogLevel.Assert, "锟斤拷烫烫烫")
|
||||
Logger.Error(e.Exception, "程序出现未知错误", LogBehavior.AlertThenCrash)
|
||||
End If
|
||||
End Sub
|
||||
Private Shared Sub OldEnvironmentAssert(Optional ex As Exception = Nothing)
|
||||
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net48-offline-installer")
|
||||
If ex Is Nothing Then
|
||||
Logger.Error($"你的 .NET Framework 版本过低或损坏,请下载并重新安装 .NET Framework 4.8!{vbCrLf}若安装失败,可以先卸载高版本的 .NET Framework 然后再试。", LogBehavior.AlertThenCrash)
|
||||
Else
|
||||
Logger.Error(ex, $"你的 .NET Framework 版本过低或损坏,请下载并重新安装 .NET Framework 4.8!{vbCrLf}若安装失败,可以先卸载高版本的 .NET Framework 然后再试。", LogBehavior.AlertThenCrash)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'动态 DLL 调用
|
||||
Private Shared AssemblyNAudio As Assembly
|
||||
Private Shared AssemblyJson As Assembly
|
||||
Private Shared AssemblyDialog As Assembly
|
||||
Private Shared AssemblyImazenWebp As Assembly
|
||||
Private Shared ReadOnly AssemblyNAudioLock As New Object
|
||||
Private Shared ReadOnly AssemblyJsonLock As New Object
|
||||
Private Shared ReadOnly AssemblyDialogLock As New Object
|
||||
Private Shared ReadOnly AssemblyImazenWebpLock As New Object
|
||||
'动态 DLL 加载
|
||||
Private Sub New() '这里必须尽早调用,且不能使用任何库,否则加载 MeloongCore 就会导致崩溃
|
||||
Static Prefixes As String() = {"NAudio", "Newtonsoft.Json", "Ookii.Dialogs.Wpf", "Imazen.WebP", "CacheCow.Common", "CacheCow.Client.FileStore", "CacheCow.Client", "ThrottleDebounce", "System.Net.Http.Formatting", "PCLCS", "MeloongCore.Wpf", "MeloongCore"}
|
||||
Static LoadedAssemblies As New ConcurrentDictionary(Of String, Lazy(Of Assembly))(StringComparer.Ordinal) '缓存
|
||||
AddHandler AppDomain.CurrentDomain.AssemblyResolve,
|
||||
Function(sender As Object, Args As ResolveEventArgs) As Assembly
|
||||
Dim Prefix As String = Prefixes.FirstOrDefault(Function(p) Args.Name.StartsWith(p, StringComparison.Ordinal))
|
||||
If Prefix Is Nothing Then Return Nothing
|
||||
Dim LazyAssembly = LoadedAssemblies.GetOrAdd(Prefix, Function(p) New Lazy(Of Assembly)(
|
||||
Function()
|
||||
Dim LoadedAssembly = Assembly.Load(DirectCast(My.Resources.ResourceManager.GetObject(p), Byte()))
|
||||
If p = "Imazen.WebP" Then ExtractLibwebp() 'WebP 特判
|
||||
Return LoadedAssembly
|
||||
End Function, LazyThreadSafetyMode.ExecutionAndPublication))
|
||||
Return LazyAssembly.Value
|
||||
End Function
|
||||
End Sub
|
||||
Private Shared Sub ExtractLibwebp() '这个方法会调用 ModBase,进而调用 MeloongCore,所以不能放在 New 里
|
||||
SetDllDirectory(PathPure.TrimEnd("\"c))
|
||||
Try
|
||||
ExtractResources(PathPure & "libwebp.dll", "libwebp64")
|
||||
Catch ex As Exception
|
||||
Logger.Warn(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时,同时写入文件导致文件占用,进而导致崩溃
|
||||
End Try
|
||||
End Sub
|
||||
Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
|
||||
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly
|
||||
If args.Name.StartsWithF("NAudio") Then
|
||||
SyncLock AssemblyNAudioLock
|
||||
If AssemblyNAudio Is Nothing Then
|
||||
Log("[Start] 加载 DLL:NAudio")
|
||||
AssemblyNAudio = Assembly.Load(GetResources("NAudio"))
|
||||
End If
|
||||
Return AssemblyNAudio
|
||||
End SyncLock
|
||||
ElseIf args.Name.StartsWithF("Newtonsoft.Json") Then
|
||||
SyncLock AssemblyJsonLock
|
||||
If AssemblyJson Is Nothing Then
|
||||
Log("[Start] 加载 DLL:Json")
|
||||
AssemblyJson = Assembly.Load(GetResources("Json"))
|
||||
End If
|
||||
Return AssemblyJson
|
||||
End SyncLock
|
||||
ElseIf args.Name.StartsWithF("Ookii.Dialogs.Wpf") Then
|
||||
SyncLock AssemblyDialogLock
|
||||
If AssemblyDialog Is Nothing Then
|
||||
Log("[Start] 加载 DLL:Dialogs")
|
||||
AssemblyDialog = Assembly.Load(GetResources("Dialogs"))
|
||||
End If
|
||||
Return AssemblyDialog
|
||||
End SyncLock
|
||||
ElseIf args.Name.StartsWithF("Imazen.WebP") Then
|
||||
SyncLock AssemblyImazenWebpLock
|
||||
If AssemblyImazenWebp Is Nothing Then
|
||||
Log("[Start] 加载 DLL:Imazen.WebP")
|
||||
AssemblyImazenWebp = Assembly.Load(GetResources("Imazen_WebP"))
|
||||
SetDllDirectory(PathPure.TrimEnd("\"))
|
||||
WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64"))
|
||||
End If
|
||||
Return AssemblyImazenWebp
|
||||
End SyncLock
|
||||
Else
|
||||
Return Nothing
|
||||
End If
|
||||
End Function
|
||||
|
||||
'切换窗口
|
||||
|
||||
'控件模板事件
|
||||
Private Sub MyIconButton_Click(sender As Object, e As EventArgs)
|
||||
Select Case Setup.Get("LoginType")
|
||||
Select Case Settings.Get(Of McLoginType)("LoginType")
|
||||
Case McLoginType.Ms
|
||||
'微软
|
||||
Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson"))
|
||||
Dim MsJson As JObject = Settings.Get(Of String)("LoginMsJson").DeserializeJson()
|
||||
MsJson.Remove(sender.Tag)
|
||||
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
|
||||
Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
|
||||
If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0
|
||||
FrmLoginMs.ComboAccounts.Items.Remove(sender.Parent)
|
||||
Case McLoginType.Legacy
|
||||
'离线
|
||||
Dim Names As New List(Of String)
|
||||
Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨"))
|
||||
Names.AddRange(Settings.Get(Of String)("LoginLegacyName").ToString.Split("¨"))
|
||||
Names.Remove(sender.Tag)
|
||||
Setup.Set("LoginLegacyName", Join(Names, "¨"))
|
||||
Settings.Set("LoginLegacyName", Names.Join("¨"c))
|
||||
FrmLoginLegacy.ComboName.ItemsSource = Names
|
||||
FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
|
||||
Case Else
|
||||
'第三方
|
||||
Dim Token As String = GetStringFromEnum(Setup.Get("LoginType"))
|
||||
Dim Token As String = Settings.Get(Of McLoginType)("LoginType").ToString()
|
||||
Dim Dict As New Dictionary(Of String, String)
|
||||
Dim Names As New List(Of String)
|
||||
Dim Passs As New List(Of String)
|
||||
If Not Setup.Get("Login" & Token & "Email") = "" Then Names.AddRange(Setup.Get("Login" & Token & "Email").ToString.Split("¨"))
|
||||
If Not Setup.Get("Login" & Token & "Pass") = "" Then Passs.AddRange(Setup.Get("Login" & Token & "Pass").ToString.Split("¨"))
|
||||
If Not Settings.Get(Of String)("Login" & Token & "Email") = "" Then Names.AddRange(Settings.Get(Of String)("Login" & Token & "Email").Split("¨"))
|
||||
If Not Settings.Get(Of String)("Login" & Token & "Pass") = "" Then Passs.AddRange(Settings.Get(Of String)("Login" & Token & "Pass").Split("¨"))
|
||||
For i = 0 To Names.Count - 1
|
||||
Dict.Add(Names(i), Passs(i))
|
||||
Next
|
||||
Dict.Remove(sender.Tag)
|
||||
Setup.Set("Login" & Token & "Email", Join(Dict.Keys, "¨"))
|
||||
Setup.Set("Login" & Token & "Pass", Join(Dict.Values, "¨"))
|
||||
Settings.Set("Login" & Token & "Email", Dict.Keys.Join("¨"c))
|
||||
Settings.Set("Login" & Token & "Pass", Dict.Values.Join("¨"c))
|
||||
Select Case Token
|
||||
Case "Nide"
|
||||
FrmLoginNide.ComboName.ItemsSource = Dict.Keys
|
||||
|
||||
Reference in New Issue
Block a user