This commit is contained in:
龙腾猫跃
2026-05-15 22:06:22 +08:00
parent 277c020186
commit 53fe8204cf
110 changed files with 30470 additions and 4729 deletions
@@ -29,7 +29,7 @@
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析原版支持库文件(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Thread.Sleep(50) '等待 JSON 文件实际写入硬盘(#3710)
Log("[Download] 开始分析原版支持库文件:" & VersionFolder)
Logger.Info($"开始分析原版支持库文件:{VersionFolder}")
Task.Output = McLibNetFilesFromInstance(New McInstance(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载原版支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False})
@@ -47,7 +47,7 @@
End Try
'顺手添加 Json 项目
Try
Dim InstanceJson As JObject = GetJson(ReadFile(VersionFolder & InstanceName & ".json"))
Dim InstanceJson As JObject = GetJson(FileUtils.ReadAsString(VersionFolder & InstanceName & ".json"))
InstanceJson.Add("clientVersion", Id)
FileUtils.Write($"{VersionFolder}{InstanceName}.json", InstanceJson.ToString)
Catch ex As Exception
@@ -158,8 +158,8 @@
Try
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Return
Dim VersionFolder As String = Dialogs.SelectFolder("选择目标文件夹", False).FirstOrDefault
If VersionFolder Is Nothing Then Return
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
@@ -180,8 +180,8 @@
'分析服务端 JAR 文件下载地址
Dim Instance As New McInstance(VersionFolder)
If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("server") Is Nothing OrElse Instance.JsonObject("downloads")("server")("url") Is Nothing Then
File.Delete(VersionFolder & Id & ".json")
If Not New DirectoryInfo(VersionFolder).GetFileSystemInfos.Any() Then DeleteDirectory(VersionFolder)
FileUtils.Delete(VersionFolder & Id & ".json")
If Not DirectoryUtils.GetInfo(VersionFolder).GetFileSystemInfos.Any() Then DirectoryUtils.Delete(VersionFolder)
Task.Output = New List(Of NetFile)
Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载,没法下,撤退!", HintType.Red)
Thread.Sleep(2000) '等玩家把上一个提示看完
@@ -207,7 +207,7 @@ pause"
FileUtils.Write(VersionFolder & "Launch Server.bat", Bat,
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
'删除版本 JSON
File.Delete(VersionFolder & Id & ".json")
FileUtils.Delete(VersionFolder & Id & ".json")
End Sub) With {.ProgressWeight = 0.5, .Show = False})
'下载服务端文件
Loaders.Add(New LoaderDownload("下载服务端文件", New List(Of NetFile)) With {.ProgressWeight = 5})
@@ -219,7 +219,7 @@ pause"
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 服务端下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 Minecraft 服务端下载失败")
End Try
End Sub
Public Sub McDownloadMenuSave(sender As Object, e As RoutedEventArgs)
@@ -234,8 +234,8 @@ pause"
Try
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Return
Dim VersionFolder As String = Dialogs.SelectFolder("选择目标文件夹", False).FirstOrDefault
If VersionFolder Is Nothing Then Return
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
@@ -264,7 +264,7 @@ pause"
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 Minecraft 下载失败")
End Try
End Sub
''' <summary>
@@ -323,7 +323,7 @@ pause"
ElseIf Id.StartsWithF("rd-") Then
WikiName = "Java版Pre-classic_" & Id
Else
Log("[Error] 未知的版本格式:" & Id & "。", NotifyLevel.MsgBoxAndFeedback)
Logger.Error($"未知的版本格式:{Id}。")
Return
End If
OpenWebsite("https://zh.minecraft.wiki/w/" & WikiName.Replace("_experimental-snapshot-", "-exp"))
@@ -336,8 +336,8 @@ pause"
Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry)
Try
Dim Id As String = DownloadInfo.InstanceName
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName, "OptiFine Jar (*.jar)|*.jar")
If Not Target.Contains("\") Then Return
Dim Target As String = Dialogs.SaveFile("选择保存位置", DownloadInfo.FileName, filter:={("jar", "OptiFine Jar")})
If Target Is Nothing Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -353,7 +353,7 @@ pause"
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 OptiFine 下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 OptiFine 下载失败")
End Try
End Sub
Private Sub McDownloadOptiFineInstall(BaseMcFolderHome As String, Target As String, Task As LoaderTask(Of List(Of NetFile), Boolean), UseJavaWrapper As Boolean)
@@ -380,7 +380,7 @@ pause"
End SyncLock
'添加 Java Wrapper 作为主 Jar
Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get("LaunchAdvanceDisableJLW") Then
If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" -jar ""{ExtractPatch("JavaWrapper")}"" optifine.Installer"
Else
Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer"
@@ -395,14 +395,14 @@ pause"
.CreateNoWindow = True,
.RedirectStandardError = True,
.RedirectStandardOutput = True,
.WorkingDirectory = FileUtils.ShortenPath(BaseMcFolderHome)
.WorkingDirectory = PathUtils.ToShortPath(BaseMcFolderHome)
}
If Info.EnvironmentVariables.ContainsKey("appdata") Then
Info.EnvironmentVariables("appdata") = BaseMcFolderHome
Else
Info.EnvironmentVariables.Add("appdata", BaseMcFolderHome)
End If
Log("[Download] 开始安装 OptiFine:" & Target)
Logger.Info($"开始安装 OptiFine:{Target}")
Dim TotalLength As Integer = 0
Dim process As New Process With {.StartInfo = Info}
Dim LastResult As String = ""
@@ -415,17 +415,17 @@ pause"
outputWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
Logger.Trace(LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器信息失败")
Logger.Warn(ex, "读取 OptiFine 安装器信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
Logger.Info("由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
@@ -439,17 +439,17 @@ pause"
errorWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
Logger.Trace(LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器错误信息失败")
Logger.Warn(ex, "读取 OptiFine 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
Logger.Info("由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
@@ -507,10 +507,10 @@ pause"
PageData = NetRequestByClientRetry("https://optifine.net/adloadx?f=" & DownloadInfo.FileName,
Encoding:=New UTF8Encoding(False), Accept:="text/html", SimulateBrowserHeaders:=True)
Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.DisplayName & " 官方下载地址:" & Sources.Last)
Sources.Add("https://optifine.net/" & PageData.RegexSearch("downloadx\?f=[^""']+").First)
Logger.Info($"OptiFine {DownloadInfo.DisplayName} 官方下载地址:{Sources.Last}")
Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.DisplayName & " 官方下载地址失败")
Logger.Warn(ex, $"获取 OptiFine {DownloadInfo.DisplayName} 官方下载地址失败")
End Try
'构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))}
@@ -522,43 +522,43 @@ pause"
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Any Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
If TargetLoaders.Any Then Logger.Info("OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsInterrupted Then Return
'拷贝原版文件
'复制原版文件
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Dim ClientName As String = PathUtils.GetLastPart(ClientFolder)
DirectoryUtils.Create(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json")
If Not FileUtils.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
FileUtils.Copy($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json")
End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar")
If Not FileUtils.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
FileUtils.Copy($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar")
End If
End SyncLock
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'安装(新旧方式均需要原版 Jar 和 Json)
If IsNewerVersion Then
Log("[Download] 检测为新版 OptiFine:" & DownloadInfo.Inherit)
Logger.Info($"检测为新版 OptiFine:{DownloadInfo.Inherit}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine(方式 A)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim BaseMcFolderHome As String = RequestTaskTempFolder()
Dim BaseMcFolder As String = BaseMcFolderHome & ".minecraft\"
Try
'准备安装环境
If Directory.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then
DeleteDirectory(BaseMcFolder & "versions\" & DownloadInfo.Inherit)
If DirectoryUtils.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then
DirectoryUtils.Delete(BaseMcFolder & "versions\" & DownloadInfo.Inherit)
End If
DirectoryUtils.Create(BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\")
McFolderLauncherProfilesJsonCreate(BaseMcFolder)
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json",
FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar",
FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar",
BaseMcFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
Task.Progress = 0.06
'进行安装
@@ -568,7 +568,7 @@ Retry:
McDownloadOptiFineInstall(BaseMcFolderHome, Target, Task, UseJavaWrapper)
Catch ex As Exception
If UseJavaWrapper Then
Log(ex, "使用 JavaWrapper 安装 OptiFine 失败,将不使用 JavaWrapper 并重试")
Logger.Warn(ex, "使用 JavaWrapper 安装 OptiFine 失败,将不使用 JavaWrapper 并重试")
UseJavaWrapper = False
GoTo Retry
Else
@@ -577,27 +577,23 @@ Retry:
End Try
Task.Progress = 0.96
'复制文件
File.Delete(BaseMcFolder & "launcher_profiles.json")
CopyDirectory(BaseMcFolder, McFolder)
FileUtils.Delete(BaseMcFolder & "launcher_profiles.json")
DirectoryUtils.Copy(BaseMcFolder, McFolder)
Task.Progress = 0.98
'清理文件
File.Delete(Target)
DeleteDirectory(BaseMcFolderHome)
FileUtils.Delete(Target)
DirectoryUtils.Delete(BaseMcFolderHome)
Catch ex As Exception
Throw New Exception("安装 OptiFine(方式 A)失败", ex)
End Try
End Sub) With {.ProgressWeight = 8})
Else
Log("[Download] 检测为旧版 OptiFine:" & DownloadInfo.Inherit)
Logger.Info($"检测为旧版 OptiFine:{DownloadInfo.Inherit}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine(方式 B)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Try
'新建版本文件夹
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.1
'复制 Jar 文件
If File.Exists(VersionFolder & Id & ".jar") Then File.Delete(VersionFolder & Id & ".jar")
CopyFile(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar")
FileUtils.Copy(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar", VersionFolder & Id & ".jar")
Task.Progress = 0.7
'建立 Json 文件
Dim InheritInstance As New McInstance(McFolder & "versions\" & DownloadInfo.Inherit)
@@ -663,10 +659,10 @@ Retry:
PageData = NetRequestByClientRetry("https://optifine.net/adloadx?f=" & DownloadInfo.FileName,
Encoding:=New UTF8Encoding(False), Accept:="text/html", SimulateBrowserHeaders:=True)
Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.DisplayName & " 官方下载地址:" & Sources.Last)
Sources.Add("https://optifine.net/" & PageData.RegexSearch("downloadx\?f=[^""']+").First)
Logger.Info($"OptiFine {DownloadInfo.DisplayName} 官方下载地址:{Sources.Last}")
Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.DisplayName & " 官方下载地址失败")
Logger.Warn(ex, $"获取 OptiFine {DownloadInfo.DisplayName} 官方下载地址失败")
End Try
Task.Progress = 0.9
'构造文件请求
@@ -753,8 +749,8 @@ Retry:
Private Sub McDownloadLiteLoaderSave(DownloadInfo As DlLiteLoaderListEntry)
Try
Dim Id As String = DownloadInfo.Inherit
Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), "LiteLoader 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Return
Dim Target As String = Dialogs.SaveFile("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), filter:={("jar", "LiteLoader 安装器")})
If Target Is Nothing Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -796,7 +792,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 LiteLoader 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 LiteLoader 安装器下载失败")
End Try
End Sub
@@ -920,10 +916,10 @@ Retry:
Public Sub McDownloadForgelikeSave(Info As DlForgelikeEntry)
Try
Dim Target As String = SelectSaveFile("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
$"{Info.LoaderName} 安装器 (*.{Info.FileExtension})|*.{Info.FileExtension}")
Dim Target As String = Dialogs.SaveFile("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
filter:={(Info.FileExtension, $"{Info.LoaderName} 安装器")})
If Target Is Nothing Then Return
Dim DisplayName As String = $"{Info.LoaderName} {Info.Inherit} - {Info.VersionName}"
If Not Target.Contains("\") Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -962,7 +958,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, $"开始 {Info.LoaderName} 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"开始 {Info.LoaderName} 安装器下载失败")
End Try
End Sub
@@ -990,7 +986,7 @@ Retry:
End SyncLock
'添加 Java Wrapper 作为主 Jar
Dim Arguments As String
If UseJavaWrapper AndAlso Not Settings.Get("LaunchAdvanceDisableJLW") Then
If UseJavaWrapper AndAlso Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractPatch("JavaWrapper")}"" com.bangbang93.ForgeInstaller ""{McFolder}"
Else
Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}"
@@ -1007,7 +1003,7 @@ Retry:
.RedirectStandardOutput = True
}
Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge")
Log($"[Download] 开始安装 {LoaderName}:" & Arguments)
Logger.Info($"开始安装 {LoaderName}:{Arguments}")
Dim process As New Process With {.StartInfo = Info}
Dim LastResults As New Queue(Of String)
Using outputWaitHandle As New AutoResetEvent(False)
@@ -1024,11 +1020,11 @@ Retry:
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, $"读取 {LoaderName} 安装器信息失败")
Logger.Warn(ex, $"读取 {LoaderName} 安装器信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log($"[Installer] 由于任务取消,已中止 {LoaderName} 安装")
Logger.Info($"由于任务取消,已中止 {LoaderName} 安装")
process.Kill()
End If
Catch
@@ -1047,11 +1043,11 @@ Retry:
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, $"读取 {LoaderName} 安装器错误信息失败")
Logger.Warn(ex, $"读取 {LoaderName} 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Interrupted AndAlso Not process.HasExited Then
Log($"[Installer] 由于任务取消,已中止 {LoaderName} 安装")
Logger.Info($"由于任务取消,已中止 {LoaderName} 安装")
process.Kill()
End If
Catch
@@ -1071,7 +1067,7 @@ Retry:
process.Dispose()
'检查是否安装成功:最后 5 行中是否有 true(true 可能在倒数数行,见 #832)
If LastResults.Reverse().Take(5).Any(Function(l) l = "true") Then Return
Log(LastResults.Join(vbCrLf))
Logger.Warn(LastResults.Join(vbCrLf))
Dim LastLines As String = ""
For i As Integer = Math.Max(0, LastResults.Count - 5) To LastResults.Count - 1 '最后 5 行
LastLines &= vbCrLf & LastResults(i)
@@ -1084,13 +1080,10 @@ Retry:
Private Sub ForgelikeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean))
Select Case Content
Case "Extracting json"
Log("[Installer] " & Content)
Task.Progress = 0.07
Case "Downloading libraries"
Log("[Installer] " & Content)
Task.Progress = 0.08
Case " File exists: Checksum validated."
If ModeDebug Then Log("[Installer] " & Content)
Task.Progress += 0.003
Case "Building Processors"
Task.Progress = 0.18
@@ -1117,10 +1110,10 @@ Retry:
Case "Injecting profile"
Task.Progress = 0.91
Case Else
If ModeDebug Then Log("[Installer] " & Content)
Logger.Trace(Content)
Return
End Select
Log("[Installer] " & Content)
Logger.Info(Content)
End Sub
''' <summary>
@@ -1197,18 +1190,18 @@ Retry:
'安装(仅在新版安装时需要原版 Jar)
If IsNeoForge OrElse LoaderVersion.BeforeFirst(".") >= 20 Then
Log($"[Download] 检测为{If(IsNeoForge, " Neo", "新版 ")}Forge:" & LoaderVersion)
Dim Libs As List(Of McLibToken) = Nothing
Logger.Info($"检测为{If(IsNeoForge, " Neo", "新版 ")}Forge:{LoaderVersion}")
Dim Libs As List(Of McLibEntry) = Nothing
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = New List(Of NetFile)
Dim Installer As ZipArchive = Nothing
Try
'解压并获取、合并两个 Json 的信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Installer = FileUtils.OpenZip(InstallerAddress)
Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Dim Json2 As JObject = GetJson(ReadFile(Installer.GetEntry("version.json").Open))
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
Dim Json2 As JObject = GetJson(Installer.GetEntry("version.json").Open().ReadString)
Json.Merge(Json2)
'获取 Lib 下载信息
Libs = McLibListGetWithJson(Json, True)
@@ -1221,17 +1214,17 @@ Retry:
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).BeforeFirst("@")
Dim Address = McLibGet(OriginalName).Replace(".jar", "." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Dim ClientMappings As JToken = RawJson("downloads")("client_mappings")
Libs.Add(New McLibToken With {
Libs.Add(New McLibEntry With {
.IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.Url = ClientMappings("url"), .Size = ClientMappings("size"), .SHA1 = ClientMappings("sha1")})
Log($"[Download] 需要下载 Mappings:{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})")
Logger.Info($"需要下载 Mappings:{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})")
End If
Task.Progress = 0.8
'去除其中的原始 Forgelike 项
For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}.jar") OrElse
Libs(i).LocalPath.EndsWithF($"{LoaderName.Lower}-{Inherit}-{LoaderVersion}-client.jar") Then
Log($"[Download] 已从待下载 {LoaderName} 支持库中移除:" & Libs(i).LocalPath, NotifyLevel.DebugModeOnly)
Logger.Warn($"已从待下载 {LoaderName} 支持库中移除:{Libs(i).LocalPath}")
Libs.RemoveAt(i)
Exit For
End If
@@ -1240,7 +1233,6 @@ Retry:
Catch ex As Exception
Throw New Exception($"获取{If(IsNeoForge, " Neo", "新版 ")}Forge 支持库列表失败", ex)
Finally
'释放文件
If Installer IsNot Nothing Then Installer.Dispose()
End Try
End Sub) With {.ProgressWeight = 1})
@@ -1249,13 +1241,10 @@ Retry:
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
#Region "Forgelike 文件"
If IsCustomFolder Then
For Each LibFile As McLibToken In Libs
For Each LibFile As McLibEntry In Libs
Dim RealPath As String = LibFile.LocalPath.Replace(McFolderSelected, McFolder)
If Not File.Exists(RealPath) Then
DirectoryUtils.Create(RealPath, isFilePath:=True)
CopyFile(LibFile.LocalPath, RealPath)
End If
If ModeDebug Then Log($"[Download] 复制的 {LoaderName} 支持库文件:" & LibFile.LocalPath)
If Not FileUtils.Exists(RealPath) Then FileUtils.Copy(LibFile.LocalPath, RealPath)
Logger.Trace($"复制的 {LoaderName} 支持库文件:{LibFile.LocalPath}")
Next
End If
#End Region
@@ -1264,22 +1253,22 @@ Retry:
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList()
If TargetLoaders.Any Then Log($"[Download] {LoaderName} 安装正在等待原版文件下载完成")
If TargetLoaders.Any Then Logger.Info($"{LoaderName} 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsInterrupted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
If Task.IsInterrupted Then Return
'拷贝原版文件
'复制原版文件
If Not IsCustomFolder Then Return
SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Dim ClientName As String = PathUtils.GetLastPart(ClientFolder)
DirectoryUtils.Create(McFolder & "versions\" & Inherit)
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
CopyFile(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
If Not FileUtils.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".json") Then
FileUtils.Copy(ClientFolder & ClientName & ".json", McFolder & "versions\" & Inherit & "\" & Inherit & ".json")
End If
If Not File.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
CopyFile(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
If Not FileUtils.Exists(McFolder & "versions\" & Inherit & "\" & Inherit & ".jar") Then
FileUtils.Copy(ClientFolder & ClientName & ".jar", McFolder & "versions\" & Inherit & "\" & Inherit & ".jar")
End If
End SyncLock
#End Region
@@ -1288,12 +1277,12 @@ Retry:
Sub(Task As LoaderTask(Of Boolean, Boolean))
Dim Installer As ZipArchive = Nothing
Try
Log($"[Download] 开始进行 Forgelike 安装:" & InstallerAddress)
Logger.Info($"开始进行 Forgelike 安装:{InstallerAddress}")
'记录当前文件夹列表(在新建目标文件夹之前)
Dim OldList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.Select(Function(i) i.FullName).ToList()
Dim OldList = DirectoryUtils.GetDirectories(McFolder & "versions\", True).ToList()
'解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Installer = FileUtils.OpenZip(InstallerAddress)
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
'新建目标版本文件夹
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.04
@@ -1305,23 +1294,23 @@ Retry:
Retry:
Try
'释放 Forge 注入器
FileUtils.Write(PathTemp & "Cache\forge_installer.jar", GetResources("ForgeInstaller"))
ExtractResources(PathTemp & "Cache\forge_installer.jar", "ForgeInstaller")
Task.Progress = 0.06
'运行注入器
ForgelikeInjector(InstallerAddress, Task, McFolder, UseJavaWrapper, IsNeoForge)
Task.Progress = 0.97
Catch ex As Exception
If UseJavaWrapper Then
Log(ex, $"使用 JavaWrapper 安装 {LoaderName} 失败,将不使用 JavaWrapper 并重试")
Logger.Warn(ex, $"使用 JavaWrapper 安装 {LoaderName} 失败,将不使用 JavaWrapper 并重试")
UseJavaWrapper = False
GoTo Retry
Else
Throw New Exception($"运行 {LoaderName} 安装器失败", ex)
End If
End Try
'拷贝新增的版本 Json
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
'复制新增的版本 Json
Dim DeltaList = DirectoryUtils.GetDirectories(McFolder & "versions\", True).
SkipWhile(Function(i) OldList.Contains(i)).Select(Function(f) DirectoryUtils.GetInfo(f)).ToList()
If DeltaList.Count > 1 Then
'它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
'也可能是因为 Forge 安装器的 Bug,生成了一个名字错误的文件夹,所以需要检查文件夹是否为空
@@ -1329,62 +1318,61 @@ Retry:
End If
If DeltaList.Count = 1 Then
'如果没有新增文件夹,那么预测的文件夹名就是正确的
'如果只新增 1 个文件夹,那么拷贝 json 文件
'如果只新增 1 个文件夹,那么复制 json 文件
Dim JsonFile As FileInfo = DeltaList(0).EnumerateFiles.First()
FileUtils.Write(VersionFolder & NewInstanceName & ".json", ReadFile(JsonFile.FullName))
Log($"[Download] 已拷贝新增的版本 JSON 文件:{JsonFile.FullName} -> {VersionFolder}{NewInstanceName}.json")
FileUtils.Copy(JsonFile.FullName, VersionFolder & NewInstanceName & ".json")
Logger.Info($"已复制新增的版本 JSON 文件:{JsonFile.FullName} -> {VersionFolder}{NewInstanceName}.json")
ElseIf DeltaList.Count > 1 Then
'新增了多个文件夹
Log($"[Download] 有多个疑似的新增版本,无法确定:{DeltaList.Select(Function(d) d.Name).Join(";")}")
Logger.Info($"有多个疑似的新增版本,无法确定:{DeltaList.Select(Function(d) d.Name).Join(";")}")
Else
'没有新增文件夹
Log("[Download] 未找到新增的版本文件夹")
Logger.Info("未找到新增的版本文件夹")
End If
Catch ex As Exception
Throw New Exception($"安装新 {LoaderName} 版本失败", ex)
Finally
'清理文件
Try
If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
Installer?.Dispose()
FileUtils.Delete(InstallerAddress)
Catch ex As Exception
Log(ex, $"安装 {LoaderName} 清理文件时出错")
Logger.Warn(ex, $"安装 {LoaderName} 清理文件时出错")
End Try
End Try
End Sub) With {.ProgressWeight = 10})
Else
Log("[Download] 检测为非新版 Forge:" & LoaderVersion)
Logger.Info($"检测为非新版 Forge:{LoaderVersion}")
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"安装 {LoaderName}(方式 B)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim Installer As ZipArchive = Nothing
Try
'解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open, FileAccess.Read, FileShare.Read))
Installer = FileUtils.OpenZip(InstallerAddress)
Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Dim Json As JObject = GetJson(Installer.GetEntry("install_profile.json").Open().ReadString)
Task.Progress = 0.4
'新建版本文件夹
DirectoryUtils.Create(VersionFolder)
Task.Progress = 0.5
If Json("install") Is Nothing Then
'中版:Legacy 方式 1
Log("[Download] 开始进行 Forge 安装,Legacy 方式 1:" & InstallerAddress)
Logger.Info($"开始进行 Forge 安装,Legacy 方式 1:{InstallerAddress}")
'建立 Json 文件
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
Dim JsonVersion As JObject = GetJson(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open().ReadString)
JsonVersion("id") = NewInstanceName
FileUtils.Write(VersionFolder & NewInstanceName & ".json", JsonVersion.ToString)
Task.Progress = 0.6
'解压支持库文件
Installer.Dispose()
ExtractCompressedFile(InstallerAddress, InstallerAddress & "_unrar\")
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DeleteDirectory(InstallerAddress & "_unrar\")
FileUtils.ExtractToDirectory(InstallerAddress, InstallerAddress & "_unrar\")
If DirectoryUtils.Exists(InstallerAddress & "_unrar\maven\") Then DirectoryUtils.Copy(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DirectoryUtils.Delete(InstallerAddress & "_unrar\")
Else
'旧版:Legacy 方式 2
Log("[Download] 开始进行 Forge 安装,Legacy 方式 2:" & InstallerAddress)
Logger.Info($"开始进行 Forge 安装,Legacy 方式 2:{InstallerAddress}")
'解压 Jar 文件
Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
If File.Exists(JarAddress) Then File.Delete(JarAddress)
FileUtils.Write(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
Task.Progress = 0.9
'建立 Json 文件
@@ -1398,10 +1386,10 @@ Retry:
Try
'清理文件
If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
FileUtils.Delete(InstallerAddress)
DirectoryUtils.Delete(InstallerAddress & "_unrar\")
Catch ex As Exception
Log(ex, "非新版方式安装 Forge 清理文件时出错")
Logger.Warn(ex, "非新版方式安装 Forge 清理文件时出错")
End Try
End Try
End Sub) With {.ProgressWeight = 1})
@@ -1422,7 +1410,7 @@ Retry:
If Entries.Any Then
FreshVersion = Entries(0)
Else
Log("[System] 未找到可用的 Forge 版本")
Logger.Info("未找到可用的 Forge 版本")
End If
Dim RecommendedVersion As DlForgeVersionEntry = Nothing
For Each Entry In Entries
@@ -1522,7 +1510,7 @@ Retry:
RunInNewThread(
Sub()
Try
Log("[Download] 刷新 Forge 推荐版本缓存开始")
Logger.Info("刷新 Forge 推荐版本缓存开始")
Dim Result As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/promos", RequireJson:=True)
If Result.Length < 1000 Then Throw New Exception("获取的结果过短(" & Result & ")")
Dim ResultJson As JContainer = GetJson(Result)
@@ -1539,9 +1527,9 @@ Retry:
'保存
Dim CacheJson As String = "{" & RecommendedList.Join(",") & "}"
FileUtils.Write(PathTemp & "Cache\ForgeRecommendedList.json", CacheJson)
Log("[Download] 刷新 Forge 推荐版本缓存成功")
Logger.Info("刷新 Forge 推荐版本缓存成功")
Catch ex As Exception
Log(ex, "刷新 Forge 推荐版本缓存失败")
Logger.Warn(ex, "刷新 Forge 推荐版本缓存失败")
End Try
End Sub, "ForgeRecommendedRefresh")
End Sub
@@ -1553,16 +1541,16 @@ Retry:
Public Function McDownloadForgeRecommendedGet(McVersion As String) As String
Try
If McVersion Is Nothing Then Return Nothing
Dim List As String = ReadFile(PathTemp & "Cache\ForgeRecommendedList.json")
If List Is Nothing OrElse List = "" Then
Log("[Download] 没有 Forge 推荐版本缓存文件")
Dim List As String = FileUtils.TryReadAsString(PathTemp & "Cache\ForgeRecommendedList.json")
If String.IsNullOrEmpty(List) Then
Logger.Info("没有 Forge 推荐版本缓存文件")
Return Nothing
End If
Dim Json As JObject = GetJson(List)
If Json Is Nothing OrElse (Not If(McVersion, "").Contains(".")) OrElse Not Json.ContainsKey(McVersion) Then Return Nothing
Return If(Json(McVersion), "").ToString
Catch ex As Exception
Log(ex, "获取 Forge 推荐版本失败(" & If(McVersion, "null") & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"获取 Forge 推荐版本失败({If(McVersion, "null")})")
Return Nothing
End Try
End Function
@@ -1587,7 +1575,7 @@ Retry:
End If
Next
Else
Log("[System] 未找到可用的 NeoForge 版本", NotifyLevel.DebugModeOnly)
Logger.Warn("未找到可用的 NeoForge 版本")
End If
'显示各个版本
If FreshStableVersion IsNot Nothing Then
@@ -1674,10 +1662,10 @@ Retry:
Public Sub McDownloadFabricLoaderSave(DownloadInfo As JObject)
Try
Dim Url As String = DownloadInfo("url").ToString
Dim FileName As String = GetFileNameFromPath(Url)
Dim Version As String = GetFileNameFromPath(DownloadInfo("version").ToString)
Dim Target As String = SelectSaveFile("选择保存位置", FileName, "Fabric 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Return
Dim FileName As String = PathUtils.GetLastPart(Url)
Dim Version As String = PathUtils.GetLastPart(DownloadInfo("version").ToString)
Dim Target As String = Dialogs.SaveFile("选择保存位置", FileName, filter:={("jar", "Fabric 安装器")})
If Target Is Nothing Then Return
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
@@ -1701,7 +1689,7 @@ Retry:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Fabric 安装器下载失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始 Fabric 安装器下载失败")
End Try
End Sub
@@ -1860,7 +1848,7 @@ Retry:
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Green)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red)
Hint(Loader.Name & "失败:" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted
Hint(Loader.Name & "已取消!", HintType.Blue)
End Select
@@ -1875,7 +1863,7 @@ Retry:
Hint(Loader.Name & "成功!", HintType.Green)
'TODO: 自动选择安装成功的版本
Case LoadState.Failed
MyMsgBox(Loader.Error.GetDetail, Loader.Name & "失败", IsWarn:=True)
MyMsgBox(Loader.Error.GetDisplay(True), Loader.Name & "失败", IsWarn:=True)
Case LoadState.Interrupted
Hint(Loader.Name & "已取消!", HintType.Blue)
Case LoadState.Loading
@@ -1889,15 +1877,15 @@ Retry:
Thread.Sleep(1000) '防止存在尚未完全释放的文件,导致清理失败(例如整合包安装)
If Loader.State = LoadState.Failed OrElse Loader.State = LoadState.Interrupted Then
'删除版本文件夹
If Directory.Exists(Loader.Input & "saves\") OrElse Directory.Exists(Loader.Input & "versions\") Then
Log("[Download] 由于版本已被独立启动,不清理版本文件夹:" & Loader.Input, NotifyLevel.DevelopOnly)
If DirectoryUtils.Exists(Loader.Input & "saves\") OrElse DirectoryUtils.Exists(Loader.Input & "versions\") Then
Logger.Warn($"由于版本已被独立启动,不清理版本文件夹:{Loader.Input}")
Else
Log("[Download] 由于下载失败或取消,清理版本文件夹:" & Loader.Input, NotifyLevel.DevelopOnly)
DeleteDirectory(Loader.Input)
Logger.Warn($"由于下载失败或取消,清理版本文件夹:{Loader.Input}")
DirectoryUtils.Delete(Loader.Input)
End If
End If
Catch ex As Exception
Log(ex, "下载失败或取消后清理版本文件夹失败")
Logger.Warn(ex, "下载失败或取消后清理版本文件夹失败")
End Try
End Sub
@@ -1920,7 +1908,7 @@ Retry:
Catch ex As CancelledException
Return False
Catch ex As Exception
Log(ex, "开始合并安装失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "开始合并安装失败")
Return False
End Try
End Function
@@ -1934,7 +1922,7 @@ Retry:
'获取参数
Dim VersionFolder As String = McFolderSelected & "versions\" & Request.NewInstanceName & "\"
If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder)
If DirectoryUtils.Exists(TempMcFolder) Then DirectoryUtils.Delete(TempMcFolder)
Dim OptiFineFolder As String = Nothing
If Request.OptiFineVersion IsNot Nothing Then
If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.AfterLast("_HD_U_") '#735
@@ -1964,7 +1952,7 @@ Retry:
Dim ModsTempFolder As String = TempMcFolder & "mods\"
Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso Modable '选择了 OptiFine 与任意 Mod 加载器
If OptiFineAsMod Then
Log("[Download] OptiFine 将作为 Mod 进行下载")
Logger.Info("OptiFine 将作为 Mod 进行下载")
If Request.LiteLoaderEntry IsNot Nothing Then
OptiFineFolder = ModsTempFolder & Request.MinecraftName & "\" '#8147
Else
@@ -1973,15 +1961,15 @@ Retry:
End If
'记录日志
If OptiFineFolder IsNot Nothing Then Log("[Download] OptiFine 缓存:" & OptiFineFolder)
If ForgeFolder IsNot Nothing Then Log("[Download] Forge 缓存:" & ForgeFolder)
If NeoForgeFolder IsNot Nothing Then Log("[Download] NeoForge 缓存:" & NeoForgeFolder)
If FabricFolder IsNot Nothing Then Log("[Download] Fabric 缓存:" & FabricFolder)
If LiteLoaderFolder IsNot Nothing Then Log("[Download] LiteLoader 缓存:" & LiteLoaderFolder)
Log("[Download] 对应的原版版本:" & Request.MinecraftName)
If OptiFineFolder IsNot Nothing Then Logger.Info($"OptiFine 缓存:{OptiFineFolder}")
If ForgeFolder IsNot Nothing Then Logger.Info($"Forge 缓存:{ForgeFolder}")
If NeoForgeFolder IsNot Nothing Then Logger.Info($"NeoForge 缓存:{NeoForgeFolder}")
If FabricFolder IsNot Nothing Then Logger.Info($"Fabric 缓存:{FabricFolder}")
If LiteLoaderFolder IsNot Nothing Then Logger.Info($"LiteLoader 缓存:{LiteLoaderFolder}")
Logger.Info($"对应的原版版本:{Request.MinecraftName}")
'重复版本检查
If File.Exists($"{VersionFolder}{Request.NewInstanceName}.json") Then
If FileUtils.Exists($"{VersionFolder}{Request.NewInstanceName}.json") Then
Hint("版本 " & Request.NewInstanceName & " 已经存在!", HintType.Red)
Throw New CancelledException
End If
@@ -1991,11 +1979,11 @@ Retry:
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() FileUtils.Write(VersionFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
'Fabric API
If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsTempFolder, ResourceVersion.DownloadReason.Dependency, Request.MinecraftName, ModLoaders.Fabric)}) With {.ProgressWeight = 3, .Block = False})
End If
'OptiFabric
If Request.OptiFabric IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsTempFolder)}) With {.ProgressWeight = 3, .Block = False})
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsTempFolder, ResourceVersion.DownloadReason.Dependency, Request.MinecraftName, ModLoaders.Fabric)}) With {.ProgressWeight = 3, .Block = False})
End If
'原版
Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.NewInstanceName)) With {.Show = False, .ProgressWeight = 39,
@@ -2038,19 +2026,19 @@ Retry:
MergeJson(VersionFolder, VersionFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.2
'迁移文件
If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", McFolderSelected & "libraries")
DirectoryUtils.Copy(TempMcFolder & "libraries", McFolderSelected & "libraries")
Task.Progress = 0.8
'创建 Mod 和资源包文件夹
Dim ModsFolder = New McInstance(VersionFolder).PathIndie & "mods\" '版本隔离信息在此时被决定
If Directory.Exists(ModsTempFolder) Then
CopyDirectory(ModsTempFolder, ModsFolder)
If DirectoryUtils.Exists(ModsTempFolder) Then
DirectoryUtils.Copy(ModsTempFolder, ModsFolder)
ElseIf Modable Then
DirectoryUtils.Create(ModsFolder)
Log("[Download] 自动创建 Mod 文件夹:" & ModsFolder)
Logger.Info($"自动创建 Mod 文件夹:{ModsFolder}")
End If
Dim ResourcepacksFolder = New McInstance(VersionFolder).PathIndie & "resourcepacks\"
DirectoryUtils.Create(ResourcepacksFolder)
Log("[Download] 自动创建资源包文件夹:" & ResourcepacksFolder)
Logger.Info($"自动创建资源包文件夹:{ResourcepacksFolder}")
End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件
If Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then
@@ -2060,7 +2048,7 @@ Retry:
LoaderList.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
End If
'删除忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() File.Delete(VersionFolder & ".pclignore")) With {.Show = False})
LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() FileUtils.Delete(VersionFolder & ".pclignore")) With {.Show = False})
'总加载器
Return LoaderList
End Function
@@ -2069,7 +2057,7 @@ Retry:
''' 将多个版本 JSON 进行合并,如果目标已存在则直接覆盖。失败会抛出异常。
''' </summary>
Private Sub MergeJson(OutputFolder As String, MinecraftFolder As String, Optional OptiFineFolder As String = Nothing, Optional OptiFineAsMod As Boolean = False, Optional ForgeFolder As String = Nothing, Optional ForgeVersion As String = Nothing, Optional NeoForgeFolder As String = Nothing, Optional NeoForgeVersion As String = Nothing, Optional FabricFolder As String = Nothing, Optional LiteLoaderFolder As String = Nothing)
Log("[Download] 开始进行版本合并,输出:" & OutputFolder & ",Minecraft:" & MinecraftFolder &
Logger.Info($"开始进行版本合并,输出:{OutputFolder},Minecraft:{MinecraftFolder}" &
If(OptiFineFolder IsNot Nothing, ",OptiFine:" & OptiFineFolder, "") &
If(ForgeFolder IsNot Nothing, ",Forge:" & ForgeFolder, "") &
If(NeoForgeFolder IsNot Nothing, ",NeoForge:" & NeoForgeFolder, "") &
@@ -2083,78 +2071,78 @@ Retry:
Dim OutputJar As String, MinecraftJar As String
#Region "初始化路径信息"
If Not OutputFolder.EndsWithF("\") Then OutputFolder += "\"
OutputName = GetFolderNameFromPath(OutputFolder)
OutputName = PathUtils.GetLastPart(OutputFolder)
OutputJsonPath = OutputFolder & OutputName & ".json"
OutputJar = OutputFolder & OutputName & ".jar"
If Not MinecraftFolder.EndsWithF("\") Then MinecraftFolder += "\"
MinecraftName = GetFolderNameFromPath(MinecraftFolder)
MinecraftName = PathUtils.GetLastPart(MinecraftFolder)
MinecraftJsonPath = MinecraftFolder & MinecraftName & ".json"
MinecraftJar = MinecraftFolder & MinecraftName & ".jar"
If HasOptiFine Then
If Not OptiFineFolder.EndsWithF("\") Then OptiFineFolder += "\"
OptiFineName = GetFolderNameFromPath(OptiFineFolder)
OptiFineName = PathUtils.GetLastPart(OptiFineFolder)
OptiFineJsonPath = OptiFineFolder & OptiFineName & ".json"
End If
If HasForge Then
If Not ForgeFolder.EndsWithF("\") Then ForgeFolder += "\"
ForgeName = GetFolderNameFromPath(ForgeFolder)
ForgeName = PathUtils.GetLastPart(ForgeFolder)
ForgeJsonPath = ForgeFolder & ForgeName & ".json"
End If
If HasNeoForge Then
If Not NeoForgeFolder.EndsWithF("\") Then NeoForgeFolder += "\"
NeoForgeName = GetFolderNameFromPath(NeoForgeFolder)
NeoForgeName = PathUtils.GetLastPart(NeoForgeFolder)
NeoForgeJsonPath = NeoForgeFolder & NeoForgeName & ".json"
End If
If HasLiteLoader Then
If Not LiteLoaderFolder.EndsWithF("\") Then LiteLoaderFolder += "\"
LiteLoaderName = GetFolderNameFromPath(LiteLoaderFolder)
LiteLoaderName = PathUtils.GetLastPart(LiteLoaderFolder)
LiteLoaderJsonPath = LiteLoaderFolder & LiteLoaderName & ".json"
End If
If HasFabric Then
If Not FabricFolder.EndsWithF("\") Then FabricFolder += "\"
FabricName = GetFolderNameFromPath(FabricFolder)
FabricName = PathUtils.GetLastPart(FabricFolder)
FabricJsonPath = FabricFolder & FabricName & ".json"
End If
#End Region
Dim OutputJson As JObject, MinecraftJson As JObject, OptiFineJson As JObject = Nothing, ForgeJson As JObject = Nothing, NeoForgeJson As JObject = Nothing, LiteLoaderJson As JObject = Nothing, FabricJson As JObject = Nothing
#Region "读取文件并检查文件是否合规"
Dim MinecraftJsonText As String = ReadFile(MinecraftJsonPath)
Dim MinecraftJsonText As String = If(FileUtils.TryReadAsString(MinecraftJsonPath), "")
If Not MinecraftJsonText.StartsWithF("{") Then Throw New Exception("Minecraft json 有误,地址:" & MinecraftJsonPath & ",前段内容:" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000)))
MinecraftJson = GetJson(MinecraftJsonText)
If HasOptiFine Then
Dim OptiFineJsonText As String = ReadFile(OptiFineJsonPath)
Dim OptiFineJsonText As String = If(FileUtils.TryReadAsString(OptiFineJsonPath), "")
If Not OptiFineJsonText.StartsWithF("{") Then Throw New Exception("OptiFine json 有误,地址:" & OptiFineJsonPath & ",前段内容:" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000)))
OptiFineJson = GetJson(OptiFineJsonText)
End If
If HasForge Then
Dim ForgeJsonText As String = ReadFile(ForgeJsonPath)
Dim ForgeJsonText As String = If(FileUtils.TryReadAsString(ForgeJsonPath), "")
If Not ForgeJsonText.StartsWithF("{") Then Throw New Exception("Forge json 有误,地址:" & ForgeJsonPath & ",前段内容:" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000)))
ForgeJson = GetJson(ForgeJsonText)
End If
If HasNeoForge Then
Dim NeoForgeJsonText As String = ReadFile(NeoForgeJsonPath)
Dim NeoForgeJsonText As String = If(FileUtils.TryReadAsString(NeoForgeJsonPath), "")
If Not NeoForgeJsonText.StartsWithF("{") Then Throw New Exception("NeoForge json 有误,地址:" & NeoForgeJsonPath & ",前段内容:" & NeoForgeJsonText.Substring(0, Math.Min(NeoForgeJsonText.Length, 1000)))
NeoForgeJson = GetJson(NeoForgeJsonText)
End If
If HasLiteLoader Then
Dim LiteLoaderJsonText As String = ReadFile(LiteLoaderJsonPath)
Dim LiteLoaderJsonText As String = If(FileUtils.TryReadAsString(LiteLoaderJsonPath), "")
If Not LiteLoaderJsonText.StartsWithF("{") Then Throw New Exception("LiteLoader json 有误,地址:" & LiteLoaderJsonPath & ",前段内容:" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000)))
LiteLoaderJson = GetJson(LiteLoaderJsonText)
End If
If HasFabric Then
Dim FabricJsonText As String = ReadFile(FabricJsonPath)
Dim FabricJsonText As String = If(FileUtils.TryReadAsString(FabricJsonPath), "")
If Not FabricJsonText.StartsWithF("{") Then Throw New Exception("Fabric json 有误,地址:" & FabricJsonPath & ",前段内容:" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000)))
FabricJson = GetJson(FabricJsonText)
End If
@@ -2169,7 +2157,7 @@ Retry:
If(NeoForgeJson IsNot Nothing, If(NeoForgeJson("minecraftArguments"), " ").ToString, " ") & " " &
If(LiteLoaderJson IsNot Nothing, If(LiteLoaderJson("minecraftArguments"), " ").ToString, " ")
'分割参数字符串
Dim RawArguments As List(Of String) = AllArguments.Split(" ").Where(Function(l) l <> "").Select(Function(l) l.Trim).ToList
Dim RawArguments As List(Of String) = AllArguments.Split(" ", True).Select(Function(l) l.Trim).ToList
Dim SplitArguments As New List(Of String)
For i = 0 To RawArguments.Count - 1
If RawArguments(i).StartsWithF("-") Then
@@ -2224,11 +2212,8 @@ Retry:
#Region "保存"
FileUtils.Write(OutputJsonPath, OutputJson.ToString)
If MinecraftJar <> OutputJar Then '可能是同一个文件
If File.Exists(OutputJar) Then File.Delete(OutputJar)
CopyFile(MinecraftJar, OutputJar)
End If
Log("[Download] 版本合并 " & OutputName & " 完成")
FileUtils.Copy(MinecraftJar, OutputJar)
Logger.Info($"版本合并 {OutputName} 完成")
#End Region
End Sub
@@ -2250,23 +2235,23 @@ Retry:
''' <param name="Patch">"LUA" 或 "JavaWrapper"。</param>
Public Function ExtractPatch(Patch As String) As String
Dim PatchPath As String = $"{PathPure}{Patch}.jar"
Log($"[Java] 选定的 {Patch} 路径:{PatchPath}")
Logger.Info($"选定的 {Patch} 路径:{PatchPath}")
Static Lock As New Object
SyncLock Lock '避免 OptiFine 和 Forge 安装时同时释放导致冲突
Try
FileUtils.Write(PatchPath, GetResources(Patch))
ExtractResources(PatchPath, Patch)
Catch ex As Exception
If File.Exists(PatchPath) Then
If FileUtils.Exists(PatchPath) Then
'因为未知原因可能变为只读文件(#4243)
Log(ex, $"{Patch} 文件释放失败,但文件已存在,将在删除后尝试重新生成", NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"{Patch} 文件释放失败,但文件已存在,将在删除后尝试重新生成")
Try
File.Delete(PatchPath)
FileUtils.Write(PatchPath, GetResources(Patch))
FileUtils.Delete(PatchPath)
ExtractResources(PatchPath, Patch)
Catch ex2 As Exception
Log(ex2, $"{Patch} 文件重新释放失败,将尝试更换文件名重新生成", NotifyLevel.DevelopOnly)
Logger.Warn(ex2, $"{Patch} 文件重新释放失败,将尝试更换文件名重新生成")
PatchPath = $"{PathPure}{Patch}2.jar"
Try
FileUtils.Write(PatchPath, GetResources(Patch))
ExtractResources(PatchPath, Patch)
Catch ex3 As Exception
Throw New FileNotFoundException($"释放 {Patch} 最终尝试失败", ex3)
End Try
@@ -525,7 +525,7 @@
Next
'自动选择版本
If VersionWaitingSelect Is Nothing Then Exit Try
Log("[Download] 自动选择 MC 版本:" & VersionWaitingSelect)
Logger.Info($"自动选择 MC 版本:{VersionWaitingSelect}")
For Each Version As JObject In Versions
If Version("id").ToString <> VersionWaitingSelect Then Continue For
Dim Item = McDownloadListItem(Version, Sub()
@@ -535,7 +535,7 @@
Return
Next
Catch ex As Exception
Log(ex, "可视化安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化安装版本列表出错")
End Try
End Sub
''' <summary>
@@ -627,7 +627,7 @@
PanOptiFine.Children.Add(OptiFineDownloadListItem(Version, AddressOf OptiFine_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 OptiFine 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 OptiFine 安装版本列表出错")
End Try
End Sub
@@ -689,7 +689,7 @@
PanLiteLoader.Children.Add(LiteLoaderDownloadListItem(Version, AddressOf LiteLoader_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 LiteLoader 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 LiteLoader 安装版本列表出错")
End Try
End Sub
@@ -763,7 +763,7 @@
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 Forge 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 Forge 安装版本列表出错")
End Try
End Sub
@@ -821,7 +821,7 @@
PanNeoForge.Children.Add(NeoForgeDownloadListItem(Version, AddressOf NeoForge_Selected, False))
Next
Catch ex As Exception
Log(ex, "可视化 NeoForge 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 NeoForge 安装版本列表出错")
End Try
End Sub
@@ -883,7 +883,7 @@
CardFabric.SwapControl = PanFabric
CardFabric.SwapType = 12
Catch ex As Exception
Log(ex, "可视化 Fabric 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 Fabric 安装版本列表出错")
End Try
End Sub
@@ -926,8 +926,8 @@
If Part = TargetName Then Return True
Next
'将版本名分割语素(例如 1.16.4/5)
Dim Lefts = RegexSearch(FabricApiName.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
Dim Rights = RegexSearch(TargetName.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
Dim Lefts = FabricApiName.BeforeFirst("]").RegexSearch("[a-z/]+|[0-9/]+").ToList
Dim Rights = TargetName.BeforeFirst("]").RegexSearch("[a-z/]+|[0-9/]+").ToList
'对每段进行判断
Dim i As Integer = 0
While True
@@ -946,7 +946,7 @@
End While
Return True
Catch ex As Exception
Log(ex, "判断 Fabric API 版本适配性出错(" & FabricApiName & ", " & VanillaName & ")")
Logger.Warn(ex, $"判断 Fabric API 版本适配性出错({FabricApiName}, {VanillaName})")
Return False
End Try
End Function
@@ -984,7 +984,7 @@
For Each Version In DlFabricApiLoader.Output
If IsFabricApiCompatible(Version) Then
If Not Version.Display.StartsWithF("[") Then
Log("[Download] 已特判修改 Fabric API 显示名:" & Version.Display, NotifyLevel.DebugModeOnly)
Logger.Warn($"已特判修改 Fabric API 显示名:{Version.Display}")
Version.Display = "[" & VanillaName & "] " & Version.Display
End If
Versions.Add(Version)
@@ -1002,11 +1002,11 @@
If Not AutoSelectedFabricApi Then
AutoSelectedFabricApi = True
Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanFabricApi.Children(0))
Log($"[Download] 已自动选择 Fabric API:{Item.Title}")
Logger.Info($"已自动选择 Fabric API:{Item.Title}")
FabricApi_Selected(Item, Nothing)
End If
Catch ex As Exception
Log(ex, "可视化 Fabric API 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 Fabric API 安装版本列表出错")
End Try
End Sub
@@ -1035,7 +1035,7 @@
If VanillaName Is Nothing Then Return False
Return ModFile.GameVersions.Contains(VanillaName)
Catch ex As Exception
Log(ex, "判断 OptiFabric 版本适配性出错(" & VanillaName & ")")
Logger.Warn(ex, $"判断 OptiFabric 版本适配性出错({VanillaName})")
Return False
End Try
End Function
@@ -1095,10 +1095,10 @@
If AutoSelectedOptiFabric OrElse VanillaDrop >= 140 AndAlso VanillaDrop <= 150 Then Return '1.14~15 不自动选择
AutoSelectedOptiFabric = True
Dim Item As MyListItem = MyVirtualizingElement.TryInit(PanOptiFabric.Children(0))
Log($"[Download] 已自动选择 OptiFabric:{Item.Title}")
Logger.Info($"已自动选择 OptiFabric:{Item.Title}")
OptiFabric_Selected(Item, Nothing)
Catch ex As Exception
Log(ex, "可视化 OptiFabric 安装版本列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化 OptiFabric 安装版本列表出错")
End Try
End Sub
@@ -1125,7 +1125,7 @@
Private Sub BtnStart_Click() Handles BtnStart.Click
'确认版本隔离
If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
(Settings.Get("LaunchArgumentIndieV2") = 0 OrElse Settings.Get("LaunchArgumentIndieV2") = 2) Then
(Settings.Get(Of Integer)("LaunchArgumentIndieV2") = 0 OrElse Settings.Get(Of Integer)("LaunchArgumentIndieV2") = 2) Then
If MyMsgBox("你尚未开启版本隔离,多个 MC 版本会共用同一个 Mod 文件夹。" & vbCrLf &
"因此,游戏可能会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
"推荐先在 设置 → 启动选项 → 默认版本隔离 中开启版本隔离!", "版本隔离提示", "取消下载", "继续") = 1 Then
@@ -53,7 +53,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败(ID " & ID & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换分页面失败(ID {ID})")
Finally
AniControlEnabled -= 1
End Try
@@ -79,7 +79,7 @@
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Return
Log("[Control] 按下资源工程列表项:" & LabTitle.Text)
Logger.Info($"按下资源工程列表项:{LabTitle.Text}")
End If
End Sub
Private Sub MyResourceItem_Click(sender As MyResourceItem, e As EventArgs) Handles Me.Click
@@ -89,20 +89,20 @@
For Each Card As MyCard In FrmDownloadResourceDetail.PanResults.Children
If Card.Title <> "" AndAlso Not Card.IsSwapped Then Titles.Add(Card.Title)
Next
Log("[Resource] 记录当前已展开的卡片:" & String.Join("、", Titles))
Logger.Info($"记录当前已展开的卡片:{String.Join("、", Titles)}")
FrmMain.PageCurrent.Additional(1) = Titles
End If
'打开详情页
Dim TargetType As ResourceTypes
Dim TargetInstance As String = Nothing
Dim TargetLoader As ModLoaderTypes = ModLoaderTypes.Any
Dim TargetLoader As ModLoaders = ModLoaders.None
If FrmMain.PageCurrent.Page = FormMain.PageType.Download Then
'从下载页进入
Select Case FrmMain.PageCurrentSub
Case FormMain.PageSubType.DownloadMod
TargetType = ResourceTypes.Mod
TargetInstance = FrmDownloadMod.Content.Loader.Input.GameVersion
TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoader
TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoaders
Case FormMain.PageSubType.DownloadPack
TargetType = ResourceTypes.ModPack
TargetInstance = FrmDownloadPack.Content.Loader.Input.GameVersion
@@ -1,12 +1,28 @@
Public Class PageDownloadResourceDetail
Private ResourceItem As MyResourceItem = Nothing
''' <summary>
''' 当前页面应展示的内容类别。
''' 若当前页面是在查看前置时进入,则为 Any;这也能用于指示当前是否在查看前置。
''' </summary>
Private TargetResourceType As ResourceTypes
Private Project As ResourceProject
Private TargetVersion As String
Private TargetLoaders As ModLoaders
Public Sub LoadPageArguments() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2)
TargetLoaders = CType(FrmMain.PageCurrent.Additional(3), ModLoaders)
If TargetLoaders <> ModLoaders.None AndAlso Not TargetLoaders.Flags.IsSingle Then TargetLoaders = TargetLoaders.Flags.First() '强制取第一个
TargetResourceType = FrmMain.PageCurrent.Additional(4)
End Sub
#Region "加载器"
Private ResourceFileLoader As New LoaderTask(Of Integer, List(Of ResourceVersion))(
"Resource File",
Sub(Task)
LoadTargetFromAdditional()
LoadPageArguments()
Dim Result = ResourceVersion.FromProjectId(Project.Id, Project.Platform)
If Task.IsInterrupted Then Return
Task.Output = Result
@@ -14,22 +30,9 @@
'初始化加载器信息
Private Sub PageDownloadResourceDetail_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
LoadTargetFromAdditional()
LoadPageArguments()
PageLoaderInit(Load, PanLoad, PanMain, CardIntro, ResourceFileLoader, AddressOf Load_OnFinish)
End Sub
Public Sub LoadTargetFromAdditional() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0)
TargetInstance = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3)
TargetType = FrmMain.PageCurrent.Additional(4)
End Sub
Private Project As ResourceProject
Private TargetInstance As String, TargetLoader As ModLoaderTypes
''' <summary>
''' 当前页面应展示的内容类别。
''' 若当前页面是在查看前置时进入,则也可能为 Any。
''' </summary>
Private TargetType As ResourceTypes
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case ResourceFileLoader.State
@@ -37,7 +40,7 @@
Dim ErrorMessage As String = ""
If ResourceFileLoader.Error IsNot Nothing Then ErrorMessage = ResourceFileLoader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Resource] 下载的文件 json 列表损坏,已自动重试", NotifyLevel.DebugModeOnly)
Logger.Warn("下载的文件 json 列表损坏,已自动重试")
PageLoaderRestart()
End If
End Select
@@ -75,13 +78,13 @@
'筛选类型相同的结果(Modrinth 会返回 Mod、服务端插件、数据包混合的列表)
Private Function GetResults() As List(Of ResourceVersion)
Dim Results As List(Of ResourceVersion) = ResourceFileLoader.Output
Select Case TargetType
Select Case TargetResourceType
Case ResourceTypes.Any
Results = Results.Where(Function(r) r.ResourceType <> ResourceTypes.Plugin).ToList
Case ResourceTypes.Shader, ResourceTypes.ResourcePack
'不筛选光影和资源包,否则原版光影会因为是资源包格式而被过滤(#6473)
Case Else
Results = Results.Where(Function(r) r.ResourceType = TargetType).ToList
Results = Results.Where(Function(r) r.ResourceType = TargetResourceType).ToList
End Select
Return Results
End Function
@@ -132,10 +135,10 @@ GroupDone:
Next
'自动选择
Dim ToCheck As MyRadioButton = Nothing
If TargetInstance <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetInstance))
If TargetVersion <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
If TargetFile IsNot Nothing Then
Dim TargetGroup = GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld)
Dim TargetGroup = GetGroupedVersionName(TargetVersion, GroupedDrop, GroupedOld)
For Each Button As MyRadioButton In PanFilter.Children
If Button.Text <> TargetGroup Then Continue For
ToCheck = Button
@@ -153,12 +156,11 @@ GroupDone:
Private Sub UpdateFilterResult()
Dim Results = GetResults()
Dim TargetCardName As String = If(TargetInstance <> "" OrElse TargetLoader <> ModLoaderTypes.Any,
$"{If(TargetLoader <> ModLoaderTypes.Any, TargetLoader.ToString & " ", "")}{TargetInstance}(所选版本)", "")
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoaders <> ModLoaders.None,
$"{If(TargetLoaders <> ModLoaders.None, TargetLoaders.ToString & " ", "")}{TargetVersion}(所选版本)", "")
'归类到卡片下
Dim Dict As New SortedDictionary(Of String, List(Of ResourceVersion))(New CardSorter(TargetCardName))
Dict.Add("其他", New List(Of ResourceVersion))
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(ModLoaderTypes)))
For Each Version As ResourceVersion In Results
For Each GameVersion In Version.GameVersions
'检查是否符合版本筛选器
@@ -168,12 +170,12 @@ GroupDone:
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
'遍历加入的加载器列表
Dim Loaders As New List(Of String)
If Project.Loaders.Count > 1 AndAlso '工程至少有两个加载器
If Project.ModLoaders.Flags.Count > 1 AndAlso '工程至少有两个加载器
Version.ResourceType = ResourceTypes.Mod AndAlso '是 Mod
McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的
For Each Loader In Version.Loaders
If Loader = ModLoaderTypes.Quilt AndAlso Settings.Get("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
For Each Loader In Version.ModLoaders.Flags
If Loader = ModLoaders.Quilt AndAlso Settings.Get(Of Boolean)("ToolDownloadIgnoreQuilt") Then Continue For
Loaders.Add(Loader.ToString & " ")
Next
End If
If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的,确保它在一张卡片里
@@ -186,11 +188,11 @@ GroupDone:
Next
Next
'添加筛选的版本的卡片
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetVersion, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then
Dict.Add(TargetCardName, New List(Of ResourceVersion))
For Each Version As ResourceVersion In Results
If Version.GameVersions.Contains(TargetInstance) AndAlso
(TargetLoader = ModLoaderTypes.Any OrElse Version.Loaders.Contains(TargetLoader)) Then
If Version.GameVersions.Contains(TargetVersion) AndAlso
(TargetLoaders = ModLoaders.None OrElse TargetLoaders.Flags.Intersect(Version.ModLoaders.Flags).Any) Then
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld) = VersionFilter) Then Continue For
@@ -205,16 +207,16 @@ GroupDone:
If Not Pair.Value.Any() Then Continue For
If Pair.Key = TargetCardName.Replace("(所选版本)", "") Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(TargetType = ResourceTypes.ModPack, 9, 8)} '9 是安装,8 是另存为
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(TargetResourceType = ResourceTypes.ModPack, 9, 8)} '9 是安装,8 是另存为
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
PanResults.Children.Add(NewCard)
'确定卡片是否展开
'确定卡片是否默认展开
If Pair.Key = TargetCardName OrElse
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
MyCard.StackInstall(NewStack, If(TargetType = ResourceTypes.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为
MyCard.StackInstall(NewStack, If(TargetResourceType = ResourceTypes.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为
Else
NewCard.IsSwapped = True
End If
@@ -228,15 +230,15 @@ GroupDone:
CType(PanResults.Children(0), MyCard).IsSwapped = False
End If
'替代提示
If Project.Types = ResourceTypes.ModOrDataPack AndAlso (TargetType = ResourceTypes.Mod OrElse TargetType = ResourceTypes.DataPack) Then
If Project.Types = ResourceTypes.ModOrDataPack AndAlso (TargetResourceType = ResourceTypes.Mod OrElse TargetResourceType = ResourceTypes.DataPack) Then
HintAlternative.Visibility = Visibility.Visible
HintAlternative.Text = If(TargetType = ResourceTypes.Mod,
HintAlternative.Text = If(TargetResourceType = ResourceTypes.Mod,
"以下是该项目的 Mod 版本。点击这里查看其数据包版本。", "以下是该项目的数据包版本。点击这里查看其 Mod 版本。")
Else
HintAlternative.Visibility = Visibility.Collapsed
End If
Catch ex As Exception
Log(ex, "可视化工程下载列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "可视化工程下载列表出错")
End Try
End Sub
Private Function GetGroupedVersionName(Name As String, GroupedByDrop As Boolean, FoldOld As Boolean) As String
@@ -303,16 +305,18 @@ GroupDone:
Dim Loaders As New List(Of LoaderBase)
Dim Target As String = $"{McFolderSelected}versions\{InstanceName}\原始整合包.{If(Project.Platform = ResourcePlatforms.CurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = ResourceItem.PathLogo.ActualSource
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderDownload("下载整合包文件", {
File.ToNetFile(Target, ResourceVersion.DownloadReason.Standalone, File.GameVersions.FirstOrDefault, File.ModLoaders)
}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() ModpackInstall(Target, InstanceName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
Sub() ModpackInstall(Target, InstanceName, If(FileUtils.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
Sub(MyLoader)
Select Case MyLoader.State
Case LoadState.Failed
Hint(MyLoader.Name & "失败:" & MyLoader.Error.GetBrief(), HintType.Red)
Hint(MyLoader.Name & "失败:" & MyLoader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted
Hint(MyLoader.Name & "已取消!", HintType.Blue)
Case LoadState.Loading
@@ -326,7 +330,7 @@ GroupDone:
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "下载资源整合包失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "下载资源整合包失败")
End Try
End Sub
'资源下载;整合包另存为
@@ -356,13 +360,13 @@ GroupDone:
End Select
Dim IsInstanceSuitable As Func(Of McInstance, Boolean) = Nothing
'获取资源所需的加载器
Dim AllowedLoaders As New List(Of ModLoaderTypes)
If File.Loaders.Any Then
AllowedLoaders = File.Loaders
ElseIf Project.Loaders.Any Then
AllowedLoaders = Project.Loaders
Dim AllowedLoaders As ModLoaders = ModLoaders.None
If File.ModLoaders <> ModLoaders.None Then
AllowedLoaders = File.ModLoaders
ElseIf Project.ModLoaders <> ModLoaders.None Then
AllowedLoaders = Project.ModLoaders
End If
Log($"[Resource] {Desc}要求的加载器种类:" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
Logger.Info($"{Desc}要求的加载器种类:{AllowedLoaders}")
'判断某个版本是否符合资源要求
IsInstanceSuitable =
Function(Instance As McInstance)
@@ -403,21 +407,16 @@ GroupDone:
End Function) Then Return False
End If
'加载器
If Not AllowedLoaders.Any() Then Return True '无要求
If AllowedLoaders.Contains(ModLoaderTypes.Forge) AndAlso Instance.Version.HasForge Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.Fabric) AndAlso Instance.Version.HasFabric Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.NeoForge) AndAlso Instance.Version.HasNeoForge Then Return True
If AllowedLoaders.Contains(ModLoaderTypes.LiteLoader) AndAlso Instance.Version.HasLiteLoader Then Return True
Return False
Return AllowedLoaders = ModLoaders.None OrElse AllowedLoaders.Flags.Intersect(Instance.Version.ModLoaders.Flags).Any
End Function
'获取常规资源默认下载位置
If CachedFolder.ContainsKey(File.ResourceType) Then
DefaultFolder = CachedFolder(File.ResourceType)
Log($"[Resource] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
Logger.Info($"使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
ElseIf McInstanceSelected IsNot Nothing AndAlso IsInstanceSuitable(McInstanceSelected) Then
DefaultFolder = $"{McInstanceSelected.PathIndie}{SubFolder}"
DirectoryUtils.Create(DefaultFolder)
Log($"[Resource] 使用当前版本作为默认下载位置:{DefaultFolder}")
Logger.Info($"使用当前版本作为默认下载位置:{DefaultFolder}")
Else
'查找所有可能的版本
Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished
@@ -426,21 +425,21 @@ GroupDone:
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
End If
Dim SuitableInstanceList = McInstanceList.Values.SelectMany(Function(l) l).Where(Function(v) IsInstanceSuitable(v)).
Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}"))
Select(Function(v) DirectoryUtils.GetInfo($"{v.PathIndie}{SubFolder}"))
If SuitableInstanceList.Any Then
Dim SelectedInstance = SuitableInstanceList.
OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
First()
DefaultFolder = SelectedInstance.FullName
DefaultFolder = PathUtils.RemoveExtendedPrefix(SelectedInstance.FullName)
DirectoryUtils.Create(DefaultFolder)
Log($"[Resource] 使用适合的游戏版本作为默认下载位置:{DefaultFolder}")
Logger.Info($"使用适合的游戏版本作为默认下载位置:{DefaultFolder}")
Else
DefaultFolder = McFolderSelected
If NeedLoad Then
Hint($"当前 MC 文件夹中没有找到合适的版本!")
Else
Log("[Resource] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
Logger.Info("由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If
End If
End If
@@ -452,7 +451,7 @@ GroupDone:
Else
Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - ").
Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
Select Case Settings.Get("ToolDownloadTranslateV2")
Select Case Settings.Get(Of Integer)("ToolDownloadTranslateV2")
Case 0
FileName = $"【{ChineseName}】{File.FileName}"
Case 1
@@ -470,17 +469,18 @@ GroupDone:
Sub()
'弹窗要求选择保存位置
Dim Target As String
Target = SelectSaveFile("选择保存位置", FileName,
Desc & "文件|" &
If(File.ResourceType = ResourceTypes.Mod,
If(File.FileName.EndsWithF(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWithF(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Return
Dim Ext As String = If(File.ResourceType = ResourceTypes.Mod,
If(File.FileName.EndsWithF(".litemod"), "litemod", "jar"),
If(File.FileName.EndsWithF(".mrpack"), "mrpack", "zip"))
Target = Dialogs.SaveFile("选择保存位置", FileName, DefaultFolder, {(Ext, Desc & "文件")})
If Target Is Nothing Then Return
'构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & Path.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder Then CachedFolder(File.ResourceType) = GetPathFromFullPath(Target)
Dim LoaderName As String = Desc & "下载:" & PathUtils.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder Then CachedFolder(File.ResourceType) = PathUtils.RemoveLastPart(Target)
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
Loaders.Add(New LoaderDownload("下载文件", {
File.ToNetFile(Target, If(TargetResourceType = ResourceTypes.Any, ResourceVersion.DownloadReason.Dependency, ResourceVersion.DownloadReason.Standalone))
}) With {.ProgressWeight = 6, .Block = True})
'启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(1)
@@ -489,7 +489,7 @@ GroupDone:
FrmMain.BtnExtraDownload.Ribble()
End Sub)
Catch ex As Exception
Log(ex, "保存资源文件失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "保存资源文件失败")
End Try
End Sub, "Download Resource Detail Save")
End Sub
@@ -506,8 +506,8 @@ GroupDone:
'Mod / 数据包 互相跳转
Private Sub HintAlternative_Click() Handles HintAlternative.Click
TargetType = If(TargetType = ResourceTypes.Mod, ResourceTypes.DataPack, ResourceTypes.Mod)
FrmMain.PageCurrent.Additional(4) = TargetType '加载器会从这里重新拿数据
TargetResourceType = If(TargetResourceType = ResourceTypes.Mod, ResourceTypes.DataPack, ResourceTypes.Mod)
FrmMain.PageCurrent.Additional(4) = TargetResourceType '加载器会从这里重新拿数据
PageLoaderRestart(IsForceRestart:=True)
End Sub
@@ -522,7 +522,7 @@ GroupDone:
If Not Deps.Any() Then Return
Deps = Deps.Where(
Function(dep)
If Not ResourceProject.Cache.ContainsKey(dep) Then Log($"[Resource] 未找到 ID {dep} 的前置信息", NotifyLevel.DebugModeOnly)
If Not ResourceProject.Cache.ContainsKey(dep) Then Logger.Warn($"未找到 ID {dep} 的前置信息")
Return ResourceProject.Cache.ContainsKey(dep)
End Function).ToList
'添加开头间隔
@@ -49,9 +49,10 @@
<local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" Margin="10,0,0,0">
<local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="NeoForge" Tag="6" />
<local:MyComboBoxItem Content="NeoForge" Tag="16" />
<local:MyComboBoxItem Content="Fabric" Tag="4" />
<local:MyComboBoxItem Content="Quilt" Tag="5" />
<local:MyComboBoxItem Content="Quilt" Tag="8" />
<local:MyComboBoxItem Content="LiteLoader" Tag="2" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" />
@@ -74,7 +74,7 @@ Public Class PageResource
Public Shared TargetName As String = Nothing
'在点击 MyResourceItem 时会获取 Loader 的输入,以使资源详情页面可以应用相同的筛选项
Public Loader = ResourceSearcher.GetLoader(AddressOf LoaderInput)
Public Loader As LoaderTask(Of ResourceSearcher.SearchRequest, Integer) = ResourceSearcher.GetLoader(AddressOf LoaderInput)
Private Sub PageResource_Loaded(sender As Object, e As EventArgs) Handles Me.Loaded
Static IsFirstLoaded As Boolean = False
@@ -126,7 +126,7 @@ Public Class PageResource
.SearchText = TextSearchName.Text
.GameVersion = GameVersion
.Tag = ComboSearchTag.SelectedItem.Tag
.ModLoader = If(PageType = ResourceTypes.Mod, Val(ComboSearchLoader.SelectedItem.Tag), ModLoaderTypes.Any)
.ModLoaders = If(PageType = ResourceTypes.Mod, Val(ComboSearchLoader.SelectedItem.Tag), ModLoaders.None)
.Sources = CType(Val(ComboSearchSource.SelectedItem.Tag), ResourcePlatforms)
End With
Return Request
@@ -144,14 +144,14 @@ Public Class PageResource
'结果 UI 化
Private Sub Load_OnFinish()
Try
Log($"[Resource] 开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
Logger.Info($"开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
'列表项
PanProjects.Children.Clear()
Dim Index As Integer = Math.Min(Page * PAGE_SIZE, Storage.Results.Count - 1)
For Each Result In Storage.Results.GetRange(Index, Math.Min(Storage.Results.Count - Index, PAGE_SIZE))
PanProjects.Children.Add(Result.ToResourceItem(
ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing,
ShowLoaderDesc:=Loader.Input.ModLoader = ModLoaderTypes.Any AndAlso (PageType = ResourceTypes.Mod OrElse PageType = ResourceTypes.ModPack)))
ShowLoaderDesc:=Loader.Input.ModLoaders = ModLoaders.None AndAlso (PageType = ResourceTypes.Mod OrElse PageType = ResourceTypes.ModPack)))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
@@ -177,7 +177,7 @@ Public Class PageResource
'强制返回顶部
ScrollToTop()
Catch ex As Exception
Log(ex, $"可视化{TypeNameSpaced}列表出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"可视化{TypeNameSpaced}列表出错")
End Try
End Sub
@@ -188,7 +188,7 @@ Public Class PageResource
Dim ErrorMessage As String = ""
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log($"[Download] 下载的{TypeNameSpaced}列表 json 文件损坏,已自动重试", NotifyLevel.DebugModeOnly)
Logger.Warn($"下载的{TypeNameSpaced}列表 json 文件损坏,已自动重试")
CType(Parent, MyPageRight).PageLoaderRestart()
End If
End Select
@@ -208,7 +208,7 @@ Public Class PageResource
CardPages.IsEnabled = False
Page = NewPage
FrmMain.BackToTop()
Log($"[Download] {TypeName}:切换到第 {Page + 1} 页")
Logger.Info($"{TypeName}:切换到第 {Page + 1} 页")
RunInThread(
Sub()
Thread.Sleep(100) '等待向上滚的动画结束
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL;assembly="
x:Name="PanBack" Height="44"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True" Cursor="Hand">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="6" />
<ColumnDefinition Width="34" />
@@ -61,11 +61,11 @@ Public Class MyLocalModItem
End Property
'相关联的 Mod
Public Property Entry As ResourceFile
Public Property Entry As LocalResourceFile
Get
Return Tag
End Get
Set(value As ResourceFile)
Set(value As LocalResourceFile)
Tag = value
End Set
End Property
@@ -80,7 +80,7 @@ Public Class MyLocalModItem
If IsMouseDown Then
RaiseEvent Click(sender, e)
If e.Handled Then Return
Log("[Control] 按下本地 Mod 列表项:" & LabTitle.Text)
Logger.Info($"按下本地 Mod 列表项:{LabTitle.Text}")
End If
End Sub
@@ -203,7 +203,7 @@ Public Class MyLocalModItem
AniStop("MyLocalModItem Checked " & Uuid)
End If
Catch ex As Exception
Log(ex, "设置 Checked 失败")
Logger.Warn(ex, "设置 Checked 失败")
End Try
End Set
End Property
@@ -335,9 +335,9 @@ Public Class MyLocalModItem
BtnUpdate.Visibility = Visibility.Collapsed
End If
'标题与描述
Dim DescFileName As String = Path.GetFileNameWithoutExtension(Entry.File.FullName)
Dim DescFileName As String = Entry.File.Name.BeforeLast(".")
Dim NewDescription As String
If Settings.Get("ToolModLocalNameStyle") = 1 Then
If Settings.Get(Of Integer)("ToolModLocalNameStyle") = 1 Then
'标题显示文件名,详情显示译名
'标题
Title = DescFileName
@@ -25,7 +25,7 @@ Public Class PageInstanceExport
AniControlEnabled -= 1
End Sub
Public Sub RefreshAll() Implements IRefreshable.Refresh
Log($"[Export] 刷新导出页面")
Logger.Info($"刷新导出页面")
HintOptiFine.Visibility = If(PageInstanceLeft.Instance.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
CurrentInstance = PageInstanceLeft.Instance.PathVersion
TextExportName.Text = ""
@@ -56,7 +56,7 @@ Public Class PageInstanceExport
Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String())
Panel.Children.Clear()
For Each Folder In Folders
Dim TargetFolder As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Folder)
Dim TargetFolder = DirectoryUtils.GetInfo(PageInstanceLeft.Instance.PathIndie & Folder)
If Not TargetFolder.Exists() Then Continue For
'查找文件夹下的对应项
If AcceptCompressedFile Then
@@ -98,14 +98,14 @@ Public Class PageInstanceExport
Return False
End Try
End Function
Dim PathInfo As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie)
Dim PathInfo = DirectoryUtils.GetInfo(PageInstanceLeft.Instance.PathIndie)
AllEntries.AddRange(PathInfo.EnumerateFiles().Select(Function(f) f.Name))
For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory)
AllEntries.Add($"{SubFolder.Name}\")
AllEntries.AddRange(SubFolder.EnumerateFiles().Select(Function(f) $"{SubFolder.Name}\{f.Name}"))
AllEntries.AddRange(SubFolder.EnumerateDirectories().Where(IsValidDirectory).Select(Function(d) $"{SubFolder.Name}\{d.Name}\"))
Next
Log($"[Export] 共发现 {AllEntries.Count} 个可行的二级文件/文件夹")
Logger.Info($"共发现 {AllEntries.Count} 个可行的二级文件/文件夹")
'确认选项是否应该被显示
Dim IsVisible =
Function(TargetOption As ExportOption) As Boolean
@@ -121,16 +121,16 @@ Public Class PageInstanceExport
Try
If AllEntries.Any(Function(Entry) Entry Like Rule) Then Return True
Catch ex As Exception
Log(ex, $"错误的规则:{Rule}", NotifyLevel.AllUsers)
Logger.Error(ex, $"错误的规则:{Rule}", LogBehavior.Toast)
Return False
End Try
'粗略检查所有级
Rule = Rule.Trim("*?".ToCharArray)
If Rule.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries).Count >= 3 Then
If Rule.Split("\"c, True).Count >= 3 Then
If Rule.EndsWithF("\") Then
Return IsValidDirectory(New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Rule)) '文件夹有效
Return IsValidDirectory(DirectoryUtils.GetInfo(PageInstanceLeft.Instance.PathIndie & Rule)) '文件夹有效
Else
Return File.Exists(PageInstanceLeft.Instance.PathIndie & Rule) '文件有效
Return FileUtils.Exists(PageInstanceLeft.Instance.PathIndie & Rule) '文件有效
End If
Else
Return False
@@ -303,8 +303,8 @@ Public Class PageInstanceExport
'保存配置文件
Private Sub ExportConfig() Handles BtnAdvancedExport.Click
Try
Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Settings.Get("CacheExportConfig"))
If String.IsNullOrEmpty(ConfigPath) Then Return
Dim ConfigPath As String = Dialogs.SaveFile("选择文件位置", "export_config.txt", Settings.Get(Of String)("CacheExportConfig"), {("txt", "整合包导出配置")})
If ConfigPath Is Nothing Then Return
Settings.Set("CacheExportConfig", ConfigPath)
Dim ConfigLines As New List(Of String)
'ini 段
@@ -343,19 +343,19 @@ Public Class PageInstanceExport
Hint("已保存配置文件:" & ConfigPath, HintType.Green)
OpenExplorer(ConfigPath)
Catch ex As Exception
Log(ex, "保存配置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "保存配置失败", LogBehavior.Alert)
End Try
End Sub
'读取配置文件
Private Sub ImportConfig() Handles BtnAdvancedImport.Click
Try
Dim ConfigPath As String = SelectFile("整合包导出配置(*.txt)|*.txt", "选择配置文件", Settings.Get("CacheExportConfig"))
Dim ConfigPath As String = Dialogs.SelectFile("选择配置文件", False, Settings.Get(Of String)("CacheExportConfig"), {({"txt"}, "整合包导出配置")}).FirstOrDefault()
If String.IsNullOrEmpty(ConfigPath) Then Return
Settings.Set("CacheExportConfig", ConfigPath)
Dim Segments As String() = ReadFile(ConfigPath).Split(Sperator)
Dim Segments As String() = FileUtils.ReadAsString(ConfigPath).Split(Sperator)
'ini 段
Dim Ini As New Dictionary(Of String, String)
For Each Line In Segments(0).Split(vbCrLf.ToCharArray())
For Each Line In Segments(0).SplitLines(True)
Line = Line.Trim
If Line = "" OrElse Line.StartsWithF("#") OrElse Line.StartsWithF("=") Then Continue For
Dim Index As Integer = Line.IndexOfF(":")
@@ -369,17 +369,17 @@ Public Class PageInstanceExport
If Not CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = Ini.GetOrDefault("ModrinthUploadMode", False) '#7979,加个特判
ConfigPackPath = Ini.GetOrDefault("PackPath", Nothing)
'导出内容段
RulesOverrides = Segments(1).ReplaceLineEndings(vbLf, mergeMultiple:=True).Split(vbLf).ToList
RulesOverrides = Segments(1).SplitLines(True).ToList
'追加内容段
If Segments.Length > 2 Then
ExtraFiles = Segments(2).ReplaceLineEndings(vbLf, mergeMultiple:=True).Split(vbLf).ToList
ExtraFiles = Segments(2).SplitLines(True).ToList
Else
ExtraFiles = Nothing
End If
'结束
Hint("已读取配置文件:" & ConfigPath, HintType.Green)
Catch ex As Exception
Log(ex, "读取配置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "读取配置失败", LogBehavior.Alert)
End Try
End Sub
@@ -412,23 +412,23 @@ Public Class PageInstanceExport
If Not String.IsNullOrWhiteSpace(ConfigPackPath) AndAlso
(Not ConfigPackPath.EndsWithF("\") AndAlso Not ConfigPackPath.EndsWithF("/")) Then
Try
DirectoryUtils.Create(ConfigPackPath, isFilePath:=True)
DirectoryUtils.Create(PathUtils.RemoveLastPart(ConfigPackPath))
PackPath = ConfigPackPath
Log($"[Export] 使用配置文件中指定的导出路径:{ConfigPackPath}")
Logger.Info($"使用配置文件中指定的导出路径:{ConfigPackPath}")
Catch ex As Exception
Log(ex, $"无法使用配置文件中指定的导出路径({ConfigPackPath})", NotifyLevel.DebugModeOnly)
If MyMsgBox($"指定的路径:{ConfigPackPath}{vbCrLf}{vbCrLf}{ex.GetDetail}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
Logger.Warn(ex, $"无法使用配置文件中指定的导出路径({ConfigPackPath})")
If MyMsgBox($"指定的路径:{ConfigPackPath}{vbCrLf}{vbCrLf}{ex.GetDisplay(True)}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
End Try
End If
If PackPath Is Nothing Then
Dim Extensions As New List(Of String)
Extensions.Add("压缩文件(*.zip)|*.zip")
If Not CheckOptionsPcl.Checked Then Extensions.Add("Modrinth 整合包文件(*.mrpack)|*.mrpack")
PackPath = SelectSaveFile("选择导出位置",
PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), Extensions.Join("|"))
Log($"[Export] 手动指定的导出路径:{PackPath}")
Dim Extensions As New List(Of (Extension As String, Display As String))
Extensions.Add(("zip", "压缩文件"))
If Not CheckOptionsPcl.Checked Then Extensions.Add(("mrpack", "Modrinth 整合包文件"))
PackPath = Dialogs.SaveFile("选择导出位置",
PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), filter:=Extensions)
Logger.Info($"手动指定的导出路径:{PackPath}")
End If
If String.IsNullOrEmpty(PackPath) Then Return
If PackPath Is Nothing Then Return
'缓存所需参数
Dim CacheFolder = RequestTaskTempFolder()
@@ -441,7 +441,7 @@ Public Class PageInstanceExport
Dim IncludePCLCustom As Boolean = IncludePCL AndAlso CheckOptionsPclCustom.Checked
Dim AllRules = StandardizeLines(GetAllRules(), True).ToList()
Dim AllExtraFiles = StandardizeLines(GetExtraFileLines(), False).ToList()
Log($"[Export] 准备导出整合包,共有 {AllRules.Count} 条规则,{AllExtraFiles.Count} 条追加内容行")
Logger.Info($"准备导出整合包,共有 {AllRules.Count} 条规则,{AllExtraFiles.Count} 条追加内容行")
'构造步骤加载器
Dim Loaders As New List(Of LoaderBase)
@@ -452,7 +452,7 @@ Public Class PageInstanceExport
Loaders.Add(New LoaderTask(Of Integer, Integer)("下载 PCL 正式版",
Sub(Loader As LoaderTask(Of Integer, Integer))
DownloadLatestPCL(Loader)
CopyFile(PathTemp & "Latest.exe", CacheFolder & "Plain Craft Launcher.exe")
FileUtils.Copy(PathTemp & "Latest.exe", CacheFolder & "Plain Craft Launcher.exe")
End Sub) With {.ProgressWeight = 0.5, .Block = False})
End If
@@ -460,9 +460,9 @@ Public Class PageInstanceExport
#Region "复制文件"
Loaders.Add(New LoaderTask(Of Integer, List(Of ResourceFile))("复制导出内容",
Sub(Loader As LoaderTask(Of Integer, List(Of ResourceFile)))
Loader.Output = New List(Of ResourceFile)
Loaders.Add(New LoaderTask(Of Integer, List(Of LocalResourceFile))("复制导出内容",
Sub(Loader As LoaderTask(Of Integer, List(Of LocalResourceFile)))
Loader.Output = New List(Of LocalResourceFile)
'复制版本文件
Dim Progress As Integer = 0
Dim SearchFolder As Action(Of DirectoryInfo)
@@ -471,7 +471,7 @@ Public Class PageInstanceExport
'文件夹:进一步搜索
For Each SubFolder In Folder.EnumerateDirectories("*", SearchOption.TopDirectoryOnly)
'跳过部分又没用文件又多的文件夹,加快搜索
If Folder.FullName = PathIndie AndAlso {"assets", "versions", "libraries"}.Contains(SubFolder.Name) Then Continue For
If {"assets", "versions", "libraries"}.Contains(SubFolder.Name) AndAlso PathIndie = PathUtils.RemoveExtendedPrefix(Folder.FullName) Then Continue For
If {"structureCacheV1", ".fabric", ".git", "avatar-cache", "cosmetic-cache"}.Contains(SubFolder.Name) Then Continue For
SearchFolder(SubFolder)
Next
@@ -486,12 +486,12 @@ Public Class PageInstanceExport
Next
If Not ShouldKeep Then Continue For
Dim TargetPath As String = OverridesFolder & RelativePath
CopyFile(Entry.FullName, TargetPath)
FileUtils.Copy(Entry.FullName, TargetPath)
'若为压缩包,考虑联网获取路径
If CheckHostedAssets AndAlso
{".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.Lower) AndAlso
{"mods", "packs", "openloader", "resource"}.Any(Function(s) RelativePath.Contains(s)) Then
Dim ModFile As New ResourceFile(TargetPath)
Dim ModFile As New LocalResourceFile(TargetPath)
Dim Unused = ModFile.ModrinthHash '提前计算 Hash
Unused = ModFile.CurseForgeHash
Loader.Output.Add(ModFile)
@@ -504,21 +504,21 @@ Public Class PageInstanceExport
End If
Next
End Sub
SearchFolder(New DirectoryInfo(PathIndie))
Log($"[Export] 复制 overrides 文件完成,有 {Loader.Output.Count} 个文件需要联网检查")
SearchFolder(DirectoryUtils.GetInfo(PathIndie))
Logger.Info($"复制 overrides 文件完成,有 {Loader.Output.Count} 个文件需要联网检查")
Loader.Progress = 0.95
'复制追加内容到根目录
Dim BaseFolder As String = If(IncludePCL, CacheFolder, CacheFolder & "modpack\")
For Each Line In AllExtraFiles
If Line.EndsWithF("\") OrElse Line.EndsWithF("/") Then
If Directory.Exists(Line) Then
CopyDirectory(Line, BaseFolder & GetFolderNameFromPath(Line) & "\")
If DirectoryUtils.Exists(Line) Then
DirectoryUtils.Copy(Line, BaseFolder & PathUtils.GetLastPart(Line) & "\")
Else
Hint($"未找到配置文件中指定的文件夹:{Line}", HintType.Red)
End If
Else
If File.Exists(Line) Then
CopyFile(Line, BaseFolder & GetFileNameFromPath(Line))
If FileUtils.Exists(Line) Then
FileUtils.Copy(Line, BaseFolder & PathUtils.GetLastPart(Line))
Else
Hint($"未找到配置文件中指定的单个文件:{Line}", HintType.Red)
End If
@@ -526,19 +526,19 @@ Public Class PageInstanceExport
Next
Loader.Progress = 0.97
'复制 PCL 版本设置
CopyDirectory(McVersion.PathVersion & "PCL\", OverridesFolder & "PCL\")
If DirectoryUtils.Exists(McVersion.PathVersion & "PCL\") Then DirectoryUtils.Copy(McVersion.PathVersion & "PCL\", OverridesFolder & "PCL\")
WriteIni(OverridesFolder & "PCL\Setup.ini", "IsStar", False)
'复制 PCL 本体(正式版)
If BuildType = BuildTypes.Release AndAlso IncludePCL Then CopyFile(PathExe, CacheFolder & "Plain Craft Launcher.exe")
If BuildType = BuildTypes.Release AndAlso IncludePCL Then FileUtils.Copy(PathExe, CacheFolder & "Plain Craft Launcher.exe")
'复制 PCL 个性化内容
If IncludePCLCustom Then
If Directory.Exists(PathExeFolder & "PCL\Pictures\") Then CopyDirectory(PathExeFolder & "PCL\Pictures\", CacheFolder & "PCL\Pictures\")
If Directory.Exists(PathExeFolder & "PCL\Musics\") Then CopyDirectory(PathExeFolder & "PCL\Musics\", CacheFolder & "PCL\Musics\")
If Directory.Exists(PathExeFolder & "PCL\Help\") Then CopyDirectory(PathExeFolder & "PCL\Help\", CacheFolder & "PCL\Help\")
If File.Exists(PathExeFolder & "PCL\Custom.xaml") Then CopyFile(PathExeFolder & "PCL\Custom.xaml", CacheFolder & "PCL\Custom.xaml")
If File.Exists(PathExeFolder & "PCL\Setup.ini") Then CopyFile(PathExeFolder & "PCL\Setup.ini", CacheFolder & "PCL\Setup.ini")
If File.Exists(PathExeFolder & "PCL\hints.txt") Then CopyFile(PathExeFolder & "PCL\hints.txt", CacheFolder & "PCL\hints.txt")
If File.Exists(PathExeFolder & "PCL\Logo.png") Then CopyFile(PathExeFolder & "PCL\Logo.png", CacheFolder & "PCL\Logo.png")
If DirectoryUtils.Exists(PathExeFolder & "PCL\Pictures\") Then DirectoryUtils.Copy(PathExeFolder & "PCL\Pictures\", CacheFolder & "PCL\Pictures\")
If DirectoryUtils.Exists(PathExeFolder & "PCL\Musics\") Then DirectoryUtils.Copy(PathExeFolder & "PCL\Musics\", CacheFolder & "PCL\Musics\")
If DirectoryUtils.Exists(PathExeFolder & "PCL\Help\") Then DirectoryUtils.Copy(PathExeFolder & "PCL\Help\", CacheFolder & "PCL\Help\")
If FileUtils.Exists(PathExeFolder & "PCL\Custom.xaml") Then FileUtils.Copy(PathExeFolder & "PCL\Custom.xaml", CacheFolder & "PCL\Custom.xaml")
If FileUtils.Exists(PathExeFolder & "PCL\Setup.ini") Then FileUtils.Copy(PathExeFolder & "PCL\Setup.ini", CacheFolder & "PCL\Setup.ini")
If FileUtils.Exists(PathExeFolder & "PCL\hints.txt") Then FileUtils.Copy(PathExeFolder & "PCL\hints.txt", CacheFolder & "PCL\hints.txt")
If FileUtils.Exists(PathExeFolder & "PCL\Logo.png") Then FileUtils.Copy(PathExeFolder & "PCL\Logo.png", CacheFolder & "PCL\Logo.png")
End If
End Sub) With {.ProgressWeight = 5})
@@ -546,11 +546,11 @@ Public Class PageInstanceExport
#Region "联网检查"
Loaders.Add(New LoaderTask(Of List(Of ResourceFile), Dictionary(Of ResourceFile, List(Of String)))("联网获取文件信息",
Sub(Loader As LoaderTask(Of List(Of ResourceFile), Dictionary(Of ResourceFile, List(Of String))))
Loader.Output = New Dictionary(Of ResourceFile, List(Of String))
If Not CheckHostedAssets Then Log($"[Export] 要求跳过联网获取步骤") : Return
If Not Loader.Input.Any Then Log($"[Export] 没有需要联网检查的文件,跳过联网获取步骤") : Return
Loaders.Add(New LoaderTask(Of List(Of LocalResourceFile), Dictionary(Of LocalResourceFile, List(Of String)))("联网获取文件信息",
Sub(Loader As LoaderTask(Of List(Of LocalResourceFile), Dictionary(Of LocalResourceFile, List(Of String))))
Loader.Output = New Dictionary(Of LocalResourceFile, List(Of String))
If Not CheckHostedAssets Then Logger.Info($"要求跳过联网获取步骤") : Return
If Not Loader.Input.Any Then Logger.Info($"没有需要联网检查的文件,跳过联网获取步骤") : Return
'分平台获取下载地址
Dim EndedThreadCount As Integer = 0, FailedExceptions As New List(Of Exception)
@@ -569,9 +569,9 @@ Public Class PageInstanceExport
'写入下载地址
Loader.Output.AddIntoValueCollection(ModFile, ModrinthRaw(ModFile.ModrinthHash)("files")(0)("url"))
Next
Log($"[Export] 从 Modrinth 获取到 {ModrinthRaw.Count} 个本地资源项的对应信息")
Logger.Info($"从 Modrinth 获取到 {ModrinthRaw.Count} 个本地资源项的对应信息")
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
Logger.Warn(ex, "从 Modrinth 获取本地 Mod 信息失败")
FailedExceptions.Add(ex)
Finally
EndedThreadCount += 1
@@ -592,16 +592,16 @@ Public Class PageInstanceExport
Dim File As JObject = ResultJson("file")
If String.IsNullOrEmpty(File("downloadUrl")) Then Continue For
'查找对应的文件
Dim ModFile As ResourceFile = Loader.Input.FirstOrDefault(Function(m) m.CurseForgeHash = File("fileFingerprint").ToObject(Of UInteger))
Dim ModFile As LocalResourceFile = Loader.Input.FirstOrDefault(Function(m) m.CurseForgeHash = File("fileFingerprint").ToObject(Of UInteger))
If ModFile Is Nothing Then Continue For
'写入下载地址
For Each Address In ResourceVersion.ParseCurseForgeDownloadUrls(File("downloadUrl").ToString)
Loader.Output.AddIntoValueCollection(ModFile, Address)
Next
Next
Log($"[Export] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地资源项的对应信息")
Logger.Info($"从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地资源项的对应信息")
Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
Logger.Warn(ex, "从 CurseForge 获取本地 Mod 信息失败")
FailedExceptions.Add(ex)
Finally
EndedThreadCount += 1
@@ -633,17 +633,17 @@ Public Class PageInstanceExport
#Region "生成压缩包"
Loaders.Add(New LoaderTask(Of Dictionary(Of ResourceFile, List(Of String)), Integer)("生成压缩包",
Sub(Loader As LoaderTask(Of Dictionary(Of ResourceFile, List(Of String)), Integer))
Loaders.Add(New LoaderTask(Of Dictionary(Of LocalResourceFile, List(Of String)), Integer)("生成压缩包",
Sub(Loader As LoaderTask(Of Dictionary(Of LocalResourceFile, List(Of String)), Integer))
'整理文件列表
Dim Files As New JArray
For Each Pair In Loader.Input
Dim ModFile As ResourceFile = Pair.Key
Dim ModFile As LocalResourceFile = Pair.Key
Files.Add(New JObject From {
{"path", ModFile.File.FullName.AfterFirst(OverridesFolder).Replace("\", "/")},
{"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.File.FullName)}}},
{"path", PathUtils.RemoveExtendedPrefix(ModFile.File.FullName).AfterFirst(OverridesFolder).Replace("\", "/")},
{"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", HashUtils.ComputeFromFile(ModFile.File.FullName, HashUtils.HashMethod.Sha512)}}},
{"downloads", New JArray(Pair.Value.OrderBy(Function(u) u.Contains("modrinth.com")))}, '不优先选择 Modrinth
{"fileSize", New FileInfo(ModFile.File.FullName).Length}
{"fileSize", ModFile.File.Length}
})
ModFile.File.Delete()
Next
@@ -662,25 +662,22 @@ Public Class PageInstanceExport
{"files", Files},
{"dependencies", Dependencies}
}
File.WriteAllText(CacheFolder & "modpack\modrinth.index.json", ResultJson.ToString(Newtonsoft.Json.Formatting.Indented))
FileUtils.Write(CacheFolder & "modpack\modrinth.index.json", ResultJson.ToString(Newtonsoft.Json.Formatting.Indented))
'打包
DirectoryUtils.Create(PackPath, isFilePath:=True)
If File.Exists(PackPath) Then File.Delete(PackPath)
If IncludePCL Then
'首次压缩整合包
ZipFile.CreateFromDirectory(CacheFolder & "modpack\", CacheFolder & "modpack.mrpack")
FileUtils.CreateZipFromDirectory(CacheFolder & "modpack.mrpack", CacheFolder & "modpack\")
Loader.Progress = 0.5
DeleteDirectory(CacheFolder & "modpack\")
DirectoryUtils.Delete(CacheFolder & "modpack\")
Loader.Progress = 0.6
'二次压缩整合包
ZipFile.CreateFromDirectory(CacheFolder, PackPath)
FileUtils.CreateZipFromDirectory(PackPath, CacheFolder)
Loader.Progress = 0.9
Else
'直接压缩整合包
ZipFile.CreateFromDirectory(CacheFolder & "modpack\", PackPath)
FileUtils.CreateZipFromDirectory(PackPath, CacheFolder & "modpack\")
Loader.Progress = 0.8
End If
DeleteDirectory(CacheFolder, True)
OpenExplorer(PackPath)
End Sub) With {.ProgressWeight = 6})
@@ -65,7 +65,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败(ID " & ID & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换分页面失败(ID {ID})")
Finally
AniControlEnabled -= 1
End Try
@@ -29,7 +29,7 @@
''' </summary>
Public Sub ReloadModList(Optional ForceReload As Boolean = False)
If Not LoaderRun(If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then Return
Log("[System] 已刷新 Mod 列表")
Logger.Info("已刷新 Mod 列表")
Filter = FilterType.All
PanBack.ScrollToHome()
SearchBox.Text = ""
@@ -42,10 +42,10 @@
Try
ResourceProject.Cache.Clear()
ResourceVersion.ProjectFilesCache.Clear()
File.Delete(PathTemp & "Cache\LocalMod.json")
Log("[Mod] 由于点击刷新按钮,清理本地 Mod 信息缓存")
FileUtils.Delete(PathTemp & "Cache\LocalMod.json")
Logger.Info("由于点击刷新按钮,清理本地 Mod 信息缓存")
Catch ex As Exception
Log(ex, "强制刷新时清理本地 Mod 信息缓存失败")
Logger.Warn(ex, "强制刷新时清理本地 Mod 信息缓存失败")
End Try
If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.ReloadModList(True) '无需 Else,还没加载刷个鬼的新
FrmInstanceLeft.ItemMod.Checked = True
@@ -53,15 +53,13 @@
End Sub
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanAllBack, Nothing, McModLoader, AddressOf LoadUIFromLoaderOutput, AutoRun:=False)
PageLoaderInit(Load, PanLoad, PanAllBack, Nothing, LocalResourceLoader, AddressOf LoadUIFromLoaderOutput, AutoRun:=False)
End Sub
Private Sub Load_Click(sender As Object, e As MouseButtonEventArgs) Handles Load.Click
If McModLoader.State = LoadState.Failed Then
LoaderRun(LoaderFolderRunType.ForceRun)
End If
If LocalResourceLoader.State = LoadState.Failed Then LoaderRun(LoaderFolderRunType.ForceRun)
End Sub
Public Function LoaderRun(Type As LoaderFolderRunType) As Boolean
Return LoaderFolderRun(McModLoader, PageInstanceLeft.Instance.PathIndie & "mods\", Type)
Return LoaderFolderRun(LocalResourceLoader, PageInstanceLeft.Instance.PathIndie & "mods\", Type)
End Function
#End Region
@@ -78,7 +76,7 @@
Private Sub LoadUIFromLoaderOutput()
Try
'判断应该显示哪一个页面
If McModLoader.Output.Any() Then
If LocalResourceLoader.Output.Any() Then
PanBack.Visibility = Visibility.Visible
PanEmpty.Visibility = Visibility.Collapsed
Else
@@ -88,7 +86,7 @@
End If
'修改缓存
ModItems.Clear()
For Each ModEntity As ResourceFile In McModLoader.Output
For Each ModEntity As LocalResourceFile In LocalResourceLoader.Output
ModItems(ModEntity.EnabledName) = McModListItem(ModEntity)
Next
'显示结果
@@ -96,10 +94,10 @@
SearchBox.Text = "" '这会触发结果刷新,所以需要在 ModItems 更新之后,详见 #3124 的视频
RefreshUI()
Catch ex As Exception
Log(ex, "加载 Mod 列表 UI 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "加载 Mod 列表 UI 失败")
End Try
End Sub
Private Function McModListItem(Entry As ResourceFile) As MyLocalModItem
Private Function McModListItem(Entry As LocalResourceFile) As MyLocalModItem
AniControlEnabled += 1
Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry,
.ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.EnabledName)}
@@ -145,7 +143,7 @@
''' </summary>
Public Sub RefreshUI()
If PanList Is Nothing Then Return
Dim ShowingMods = If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of ResourceFile))).Where(Function(m) CanPassFilter(m)).ToList
Dim ShowingMods = If(IsSearching, SearchResult, If(LocalResourceLoader.Output, New List(Of LocalResourceFile))).Where(Function(m) CanPassFilter(m)).ToList
'重新列出列表
AniControlEnabled += 1
If ShowingMods.Any() Then
@@ -178,7 +176,7 @@
Dim AnyCount As Integer = 0
Dim EnabledCount As Integer = 0
Dim UpdateCount As Integer = 0
For Each ModItem In If(IsSearching, SearchResult, If(McModLoader.Output, New List(Of ResourceFile)))
For Each ModItem In If(IsSearching, SearchResult, If(LocalResourceLoader.Output, New List(Of LocalResourceFile)))
AnyCount += 1
If ModItem.HasUpdate Then UpdateCount += 1
If ModItem.IsEnabled Then EnabledCount += 1
@@ -206,7 +204,7 @@
Dim HasUpdate As Boolean = False
Dim HasEnabled As Boolean = False
Dim HasDisabled As Boolean = False
For Each ModEntity In McModLoader.Output
For Each ModEntity In LocalResourceLoader.Output
If Not SelectedMods.Contains(ModEntity.EnabledName) Then Continue For
If ModEntity.HasUpdate Then HasUpdate = True
If ModEntity.IsEnabled Then HasEnabled = True
@@ -274,7 +272,7 @@
DirectoryUtils.Create(PageInstanceLeft.Instance.PathIndie & "mods\")
OpenExplorer(PageInstanceLeft.Instance.PathIndie & "mods\")
Catch ex As Exception
Log(ex, "打开 Mods 文件夹失败", NotifyLevel.MsgBox)
Logger.Error(ex, "打开 Mods 文件夹失败", LogBehavior.Alert)
End Try
End Sub
@@ -289,7 +287,7 @@
''' 安装 Mod。
''' </summary>
Private Sub BtnManageInstall_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageInstall.Click, BtnHintInstall.Click
Dim FileList = SelectFiles("Mod 文件(*.jar;*.litemod;*.disabled;*.old)|*.jar;*.litemod;*.disabled;*.old", "选择要安装的 Mod")
Dim FileList = Dialogs.SelectFile("选择要安装的 Mod", True, filter:={({"jar", "litemod", "disabled", "old"}, "Mod 文件")})
If Not FileList.Any Then Return
InstallMods(FileList)
End Sub
@@ -301,7 +299,7 @@
Dim Extension As String = FilePathList.First.AfterLast(".").Lower
'检查文件扩展名
If Not {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then Return False
Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
Logger.Info("文件为 jar/litemod 格式,尝试作为 Mod 安装")
'检查回收站:回收站中的文件有错误的文件名
If FilePathList.First.Contains(":\$RECYCLE.BIN\") Then
Hint("请先将文件从回收站还原,再尝试安装!", HintType.Red)
@@ -321,21 +319,21 @@
Install:
Try
For Each ModFile In FilePathList
Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "").Replace(".old", "")
Dim NewFileName = PathUtils.GetLastPart(ModFile).Replace(".disabled", "").Replace(".old", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, Instance.PathIndie & "mods\" & NewFileName)
FileUtils.Copy(ModFile, Instance.PathIndie & "mods\" & NewFileName)
Next
If FilePathList.IsSingle Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}!", HintType.Green)
Hint($"已安装 {PathUtils.GetLastPart(FilePathList.First).Replace(".disabled", "").Replace(".old", "")}!", HintType.Green)
Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Green)
End If
'刷新列表
If FrmMain.PageCurrent = FormMain.PageType.InstanceSetup AndAlso FrmMain.PageCurrentSub = FormMain.PageSubType.InstanceMod Then
LoaderFolderRun(McModLoader, Instance.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
LoaderFolderRun(LocalResourceLoader, Instance.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
End If
Catch ex As Exception
Log(ex, "复制 Mod 文件失败", NotifyLevel.MsgBox)
Logger.Error(ex, "复制 Mod 文件失败", LogBehavior.Alert)
End Try
End If
Return True
@@ -435,7 +433,7 @@ Install:
''' <summary>
''' 检查该 Mod 项是否符合当前筛选的类别。
''' </summary>
Private Function CanPassFilter(CheckingMod As ResourceFile) As Boolean
Private Function CanPassFilter(CheckingMod As LocalResourceFile) As Boolean
Select Case Filter
Case FilterType.All
Return True
@@ -462,18 +460,18 @@ Install:
'启用 / 禁用
Private Sub BtnSelectED_Click(sender As MyIconTextButton, e As RouteEventArgs) Handles BtnSelectEnable.Click, BtnSelectDisable.Click
EDMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName)),
EDMods(LocalResourceLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName)),
Not sender.Equals(BtnSelectDisable))
ChangeAllSelected(False)
End Sub
Private Sub EDMods(ModList As IEnumerable(Of ResourceFile), IsEnable As Boolean)
Private Sub EDMods(ModList As IEnumerable(Of LocalResourceFile), IsEnable As Boolean)
Dim IsSuccessful As Boolean = True
For Each ModE In ModList.ToList
Dim ModEntity = ModE '仅用于去除迭代变量无法修改的限制
Dim NewPath As String = Nothing
If ModEntity.IsEnabled AndAlso Not IsEnable Then
'禁用
NewPath = ModEntity.File.FullName & If(File.Exists(ModEntity.File.FullName & ".old"), ".old", ".disabled")
NewPath = PathUtils.RemoveExtendedPrefix(ModEntity.File.FullName) & If(FileUtils.Exists(ModEntity.File.FullName & ".old"), ".old", ".disabled")
ElseIf Not ModEntity.IsEnabled AndAlso IsEnable Then
'启用
NewPath = ModEntity.EnabledFullName
@@ -482,36 +480,36 @@ Install:
End If
'重命名
Try
If File.Exists(NewPath) Then
If File.Exists(ModEntity.File.FullName) Then
If FileUtils.Exists(NewPath) Then
If FileUtils.Exists(ModEntity.File.FullName) Then
'同时存在两个名称的 Mod
If GetFileMD5(ModEntity.File.FullName) <> GetFileMD5(NewPath) Then
MyMsgBox($"目前同时存在启用和禁用的两个 Mod 文件:{vbCrLf} - {NewPath}{vbCrLf} - {ModEntity.File.FullName}{vbCrLf}{vbCrLf}注意,这两个文件的内容并不相同。{vbCrLf}在手动删除或重命名其中一个文件后,才能继续操作。", "存在文件冲突")
If HashUtils.ComputeFromFile(ModEntity.File.FullName, HashUtils.HashMethod.Md5) <> HashUtils.ComputeFromFile(NewPath, HashUtils.HashMethod.Md5) Then
MyMsgBox($"目前同时存在启用和禁用的两个 Mod 文件:{vbCrLf} - {PathUtils.GetLastPart(NewPath)}{vbCrLf} - {ModEntity.File.Name}{vbCrLf}{vbCrLf}注意,这两个文件的内容并不相同。{vbCrLf}在手动删除或重命名其中一个文件后,才能继续操作。", "存在文件冲突")
Continue For
End If
Else
'已经重命名过了
Log("[Mod] Mod 的状态已被切换", NotifyLevel.DebugModeOnly)
Logger.Warn("Mod 的状态已被切换")
Continue For
End If
End If
File.Delete(NewPath)
File.Move(ModEntity.File.FullName, NewPath)
FileUtils.Delete(NewPath)
FileUtils.Move(ModEntity.File.FullName, NewPath)
Catch ex As FileNotFoundException
Log(ex, $"未找到需要重命名的 Mod({If(ModEntity.File.FullName, "null")})", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"未找到需要重命名的 Mod({If(ModEntity.File.FullName, "null")})")
ReloadModList(True)
Return
Catch ex As Exception
Log(ex, $"重命名 Mod 失败({If(ModEntity.File.FullName, "null")})")
Logger.Warn(ex, $"重命名 Mod 失败({If(ModEntity.File.FullName, "null")})")
IsSuccessful = False
End Try
'更改 Loader 中的列表
Dim NewModEntity As New ResourceFile(NewPath)
Dim NewModEntity As New LocalResourceFile(NewPath)
NewModEntity.FromJson(ModEntity.ToJson)
If McModLoader.Output.Contains(ModEntity) Then
Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity)
McModLoader.Output.RemoveAt(IndexOfLoader)
McModLoader.Output.Insert(IndexOfLoader, NewModEntity)
If LocalResourceLoader.Output.Contains(ModEntity) Then
Dim IndexOfLoader As Integer = LocalResourceLoader.Output.IndexOf(ModEntity)
LocalResourceLoader.Output.RemoveAt(IndexOfLoader)
LocalResourceLoader.Output.Insert(IndexOfLoader, NewModEntity)
End If
If SearchResult IsNot Nothing AndAlso SearchResult.Contains(ModEntity) Then '#4862
Dim IndexOfResult As Integer = SearchResult.IndexOf(ModEntity)
@@ -538,7 +536,7 @@ Install:
'更新
Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click
Dim UpdateList As List(Of ResourceFile) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName) AndAlso m.HasUpdate).ToList()
Dim UpdateList As List(Of LocalResourceFile) = LocalResourceLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName) AndAlso m.HasUpdate).ToList()
If Not UpdateList.Any() Then Return
UpdateMods(UpdateList)
ChangeAllSelected(False)
@@ -547,9 +545,9 @@ Install:
''' 记录正在进行 Mod 更新的 mods 文件夹路径。
''' </summary>
Public Shared UpdatingInstanceModFolders As New List(Of String)
Public Sub UpdateMods(ModList As IEnumerable(Of ResourceFile))
Public Sub UpdateMods(ModList As IEnumerable(Of LocalResourceFile))
'更新前警告
If Not Settings.Get("HintUpdateMod") OrElse ModList.Count >= 15 Then
If Not Settings.Get(Of Boolean)("HintUpdateMod") OrElse ModList.Count >= 15 Then
If MyMsgBox($"新版本 Mod 可能不兼容旧存档或者其他 Mod,这可能导致游戏崩溃,甚至永久损坏存档!{vbCrLf}如果你在游玩整合包,请千万不要自行更新 Mod!{vbCrLf}{vbCrLf}在更新前,请先备份存档,并检查 Mod 的更新日志。{vbCrLf}如果更新后出现问题,你也可以在回收站找回更新前的 Mod。", "Mod 更新警告", "我已了解风险,继续更新", "取消", IsWarn:=True) = 1 Then
Settings.Set("HintUpdateMod", True)
Else
@@ -561,7 +559,7 @@ Install:
ModList = ModList.ToList() '防止刷新影响迭代器
Dim FileList As New List(Of NetFile)
Dim FileCopyList As New Dictionary(Of String, String)
For Each Entry As ResourceFile In ModList
For Each Entry As LocalResourceFile In ModList
Dim File As ResourceVersion = Entry.UpdateFile
If Not File.DownloadAvailable Then Continue For
'确认更新后的文件名
@@ -590,8 +588,8 @@ Install:
End If
'添加到下载列表
Dim TempAddress As String = PathTemp & "mods\" & Entry.File.Name.Replace(CurrentReplaceName, NewestReplaceName) '需要下载到 mods 文件夹,以便重复文件检查时识别
Dim RealAddress As String = GetPathFromFullPath(Entry.File.FullName) & Entry.File.Name.Replace(CurrentReplaceName, NewestReplaceName)
FileList.Add(File.ToNetFile(TempAddress))
Dim RealAddress As String = Path.Combine(PathUtils.RemoveLastPart(Entry.File.FullName), Entry.File.Name.Replace(CurrentReplaceName, NewestReplaceName))
FileList.Add(File.ToNetFile(TempAddress, ResourceVersion.DownloadReason.Update, PageInstanceLeft.Instance.Version.VanillaName, PageInstanceLeft.Instance.Version.ModLoaders))
FileCopyList(TempAddress) = RealAddress
Next
'构造加载器
@@ -601,31 +599,31 @@ Install:
InstallLoaders.Add(New LoaderTask(Of Integer, Integer)("替换旧版 Mod 文件",
Sub()
Try
For Each Entry As ResourceFile In ModList
If File.Exists(Entry.File.FullName) Then
My.Computer.FileSystem.DeleteFile(Entry.File.FullName, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
For Each Entry As LocalResourceFile In ModList
If FileUtils.Exists(Entry.File.FullName) Then
FileUtils.Delete(Entry.File.FullName, True)
Else
Log($"[Mod] 未找到更新前的 Mod 文件,跳过对它的删除:{Entry.File.FullName}", NotifyLevel.DebugModeOnly)
Logger.Warn($"未找到更新前的 Mod 文件,跳过对它的删除:{Entry.File.FullName}")
End If
Next
For Each Entry As KeyValuePair(Of String, String) In FileCopyList
If File.Exists(Entry.Value) Then
My.Computer.FileSystem.DeleteFile(Entry.Value, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
Log($"[Mod] 更新后的 Mod 文件已存在,将会把它放入回收站:{Entry.Value}", NotifyLevel.DebugModeOnly)
If FileUtils.Exists(Entry.Value) Then
FileUtils.Delete(Entry.Value, True)
Logger.Warn($"更新后的 Mod 文件已存在,将会把它放入回收站:{Entry.Value}")
End If
If Directory.Exists(GetPathFromFullPath(Entry.Value)) Then
File.Move(Entry.Key, Entry.Value)
FinishedFileNames.Add(GetFileNameFromPath(Entry.Value))
If DirectoryUtils.Exists(PathUtils.RemoveLastPart(Entry.Value)) Then
FileUtils.Move(Entry.Key, Entry.Value)
FinishedFileNames.Add(PathUtils.GetLastPart(Entry.Value))
Else
Log($"[Mod] 更新后的目标文件夹已被删除:{Entry.Value}", NotifyLevel.DebugModeOnly)
Logger.Warn($"更新后的目标文件夹已被删除:{Entry.Value}")
End If
Next
Catch ex As OperationCanceledException
Log(ex, "替换旧版 Mod 文件时被主动取消")
Logger.Warn(ex, "替换旧版 Mod 文件时被主动取消")
End Try
End Sub))
'结束处理
Dim Loader As New LoaderCombo(Of IEnumerable(Of ResourceFile))("Mod 更新:" & PageInstanceLeft.Instance.Name, InstallLoaders)
Dim Loader As New LoaderCombo(Of IEnumerable(Of LocalResourceFile))("Mod 更新:" & PageInstanceLeft.Instance.Name, InstallLoaders)
Dim PathMods As String = PageInstanceLeft.Instance.PathIndie & "mods\"
Loader.OnStateChanged =
Sub()
@@ -634,35 +632,35 @@ Install:
Case LoadState.Finished
Select Case FinishedFileNames.Count
Case 0 '一般是由于 Mod 文件被占用,然后玩家主动取消
Log($"[Mod] 没有 Mod 被成功更新")
Logger.Info($"没有 Mod 被成功更新")
Case 1
Hint($"已成功更新 {FinishedFileNames.Single}!", HintType.Green)
Case Else
Hint($"已成功更新 {FinishedFileNames.Count} 个 Mod!", HintType.Green)
End Select
Case LoadState.Failed
Hint("Mod 更新失败:" & Loader.Error.GetBrief(), HintType.Red)
Hint("Mod 更新失败:" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted
Hint("Mod 更新已中止!", HintType.Blue)
Case Else
Return
End Select
Log($"[Mod] 已从正在进行 Mod 更新的文件夹列表移除:{PathMods}")
Logger.Info($"已从正在进行 Mod 更新的文件夹列表移除:{PathMods}")
UpdatingInstanceModFolders.Remove(PathMods)
'清理缓存
RunInNewThread(
Sub()
Try
For Each TempFile In FileCopyList.Keys
If File.Exists(TempFile) Then File.Delete(TempFile)
FileUtils.Delete(TempFile)
Next
Catch ex As Exception
Log(ex, "清理 Mod 更新缓存失败")
Logger.Warn(ex, "清理 Mod 更新缓存失败")
End Try
End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal)
End Sub
'启动加载器
Log($"[Mod] 开始更新 {ModList.Count} 个 Mod:{PathMods}")
Logger.Info($"开始更新 {ModList.Count} 个 Mod:{PathMods}")
UpdatingInstanceModFolders.Add(PathMods)
Loader.Start()
LoaderTaskbarAdd(Loader)
@@ -670,49 +668,45 @@ Install:
FrmMain.BtnExtraDownload.Ribble()
ReloadModList(True)
Catch ex As Exception
Log(ex, "初始化 Mod 更新失败")
Logger.Warn(ex, "初始化 Mod 更新失败")
End Try
End Sub
'删除
Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click
DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName)))
DeleteMods(LocalResourceLoader.Output.Where(Function(m) SelectedMods.Contains(m.EnabledName)))
ChangeAllSelected(False)
End Sub
Private Sub DeleteMods(ModList As IEnumerable(Of ResourceFile))
Private Sub DeleteMods(ModsToDelete As IEnumerable(Of LocalResourceFile))
Try
Dim IsSuccessful As Boolean = True
Dim IsShiftPressed As Boolean = My.Computer.Keyboard.ShiftKeyDown
'确认需要删除的文件
ModList = ModList.SelectMany(
Function(Target As ResourceFile)
Dim ModList = ModsToDelete.SelectMany(
Function(Target As LocalResourceFile)
If Target.IsEnabled Then
Return {Target.File.FullName, Target.File.FullName & If(File.Exists(Target.File.FullName & ".old"), ".old", ".disabled")}
Return {Target.File.FullName, Target.File.FullName & If(FileUtils.Exists(Target.File.FullName & ".old"), ".old", ".disabled")}
Else
Return {Target.File.FullName, Target.EnabledFullName}
End If
End Function).Distinct.Where(Function(m) File.Exists(m)).Select(Function(m) New ResourceFile(m)).ToList()
End Function).Distinct.Where(Function(m) FileUtils.Exists(m)).Select(Function(m) New LocalResourceFile(m)).ToList()
'实际删除文件
For Each ModEntity In ModList
'删除
Try
If IsShiftPressed Then
ModEntity.File.Delete()
Else
My.Computer.FileSystem.DeleteFile(ModEntity.File.FullName, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
FileUtils.Delete(ModEntity.File.FullName, Not IsShiftPressed)
Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消")
Logger.Warn(ex, "删除 Mod 被主动取消")
ReloadModList(True)
Return
Catch ex As Exception
Log(ex, $"删除 Mod 失败({ModEntity.File.FullName})", NotifyLevel.MsgBox)
Logger.Error(ex, $"删除 Mod 失败({ModEntity.File.FullName})", LogBehavior.Alert)
IsSuccessful = False
End Try
'取消选中
SelectedMods.Remove(ModEntity.EnabledName)
'更改 Loader 和 UI 中的列表
McModLoader.Output.Remove(ModEntity)
LocalResourceLoader.Output.Remove(ModEntity)
SearchResult?.Remove(ModEntity)
ModItems.Remove(ModEntity.EnabledName)
Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry.Equals(ModEntity)))
@@ -743,10 +737,10 @@ Install:
End If
End If
Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消")
Logger.Warn(ex, "删除 Mod 被主动取消")
ReloadModList(True)
Catch ex As Exception
Log(ex, "删除 Mod 出现未知错误", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "删除 Mod 出现未知错误")
ReloadModList(True)
End Try
LoaderRun(LoaderFolderRunType.UpdateOnly)
@@ -765,16 +759,12 @@ Install:
Public Sub Info_Click(sender As Object, e As EventArgs)
Try
Dim ModEntry As ResourceFile = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry
Dim ModEntry As LocalResourceFile = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry
'加载失败信息
If ModEntry.Project IsNot Nothing Then
'跳转到 Mod 下载页面
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.ResourceDetail,
.Additional = {ModEntry.Project, New List(Of String), PageInstanceLeft.Instance.Version.VanillaName,
If(PageInstanceLeft.Instance.Version.HasForge, ModLoaderTypes.Forge,
If(PageInstanceLeft.Instance.Version.HasNeoForge, ModLoaderTypes.NeoForge,
If(PageInstanceLeft.Instance.Version.HasFabric, ModLoaderTypes.Fabric, ModLoaderTypes.Any))),
ResourceTypes.Mod}})
.Additional = {ModEntry.Project, New List(Of String), PageInstanceLeft.Instance.Version.VanillaName, PageInstanceLeft.Instance.Version.ModLoaders, ResourceTypes.Mod}})
Else
'获取信息
Dim ContentLines As New List(Of String)
@@ -805,7 +795,7 @@ Install:
End If
End If
Catch ex As Exception
Log(ex, "获取 Mod 详情失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "获取 Mod 详情失败")
End Try
End Sub
'打开文件所在的位置
@@ -814,7 +804,7 @@ Install:
Dim ListItem As MyLocalModItem = sender.Tag
OpenExplorer(ListItem.Entry.File.FullName)
Catch ex As Exception
Log(ex, "打开 Mod 文件位置失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "打开 Mod 文件位置失败")
End Try
End Sub
'删除
@@ -837,12 +827,12 @@ Install:
Return Not String.IsNullOrWhiteSpace(SearchBox.Text)
End Get
End Property
Private SearchResult As List(Of ResourceFile)
Private SearchResult As List(Of LocalResourceFile)
Public Sub SearchRun() Handles SearchBox.TextChanged
If IsSearching Then
'构造请求
Dim QueryList As New List(Of SearchEntry(Of ResourceFile))
For Each Entry As ResourceFile In McModLoader.Output
Dim QueryList As New List(Of SearchEntry(Of LocalResourceFile))
For Each Entry As LocalResourceFile In LocalResourceLoader.Output
Dim SearchSources As New List(Of SearchSource)
SearchSources.Add(New SearchSource(Entry.Display, 1))
SearchSources.Add(New SearchSource(Entry.File.Name, 1))
@@ -858,7 +848,7 @@ Install:
If Entry.Project.Description <> Entry.Description Then SearchSources.Add(New SearchSource(Entry.Project.Description, 0.4))
SearchSources.Add(New SearchSource(String.Join("", Entry.Project.Tags), 0.2))
End If
QueryList.Add(New SearchEntry(Of ResourceFile) With {.Item = Entry, .SearchSource = SearchSources})
QueryList.Add(New SearchEntry(Of LocalResourceFile) With {.Item = Entry, .SearchSource = SearchSources})
Next
'进行搜索
SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35).Select(Function(r) r.Item).ToList
@@ -9,7 +9,7 @@
End Sub
Public Sub BtnDownload_Loaded() Handles BtnDownload.Loaded
Dim NewVisibility = If((Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse If(FrmSelectRight Is Nothing, False, FrmSelectRight.ShowHidden), Visibility.Collapsed, Visibility.Visible)
Dim NewVisibility = If((Settings.Get(Of Boolean)("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse If(FrmSelectRight Is Nothing, False, FrmSelectRight.ShowHidden), Visibility.Collapsed, Visibility.Visible)
If BtnDownload.Visibility <> NewVisibility Then
BtnDownload.Visibility = NewVisibility
PanMain.TriggerForceResize()
@@ -65,13 +65,13 @@
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "修改版本分类失败(" & PageInstanceLeft.Instance.Name & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"修改版本分类失败({PageInstanceLeft.Instance.Name})")
End Try
Reload() '更新 “打开 Mod 文件夹” 按钮
Else
'改为隐藏
Try
If Not Settings.Get("HintHide") Then
If Not Settings.Get(Of Boolean)("HintHide") Then
If MyMsgBox("确认要从版本列表中隐藏该版本吗?隐藏该版本后,它将不再出现于 PCL 显示的版本列表中。" & vbCrLf & "此后,在版本列表页面按下 F11 才可以查看被隐藏的版本。", "隐藏版本提示",, "取消") <> 1 Then
ComboDisplayType.SelectedIndex = 0
Return
@@ -82,7 +82,7 @@
WriteIni(McFolderSelected & "PCL.ini", "InstanceCache", "") '要求刷新缓存
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "隐藏版本 " & PageInstanceLeft.Instance.Name & " 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"隐藏版本 {PageInstanceLeft.Instance.Name} 失败")
End Try
End If
End Sub
@@ -97,7 +97,7 @@
Reload()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 描述更改失败", NotifyLevel.MsgBox)
Logger.Error(ex, $"版本 {PageInstanceLeft.Instance.Name} 描述更改失败", LogBehavior.Alert)
End Try
End Sub
@@ -109,51 +109,29 @@
Dim OldPath As String = PageInstanceLeft.Instance.PathVersion
'修改此部分的同时修改快速安装的版本名检测*
Dim NewName As String = MyMsgBoxInput("重命名版本", "", OldName, New ObjectModel.Collection(Of Validate) From {
New ValidateFolderName(McFolderSelected & "versions", IgnoreCase:=False), New ValidateExceptSame(OldName & "_temp", "不能使用该名称!")})
New ValidateFolderName(McFolderSelected & "versions", IgnoreCase:=False)})
If String.IsNullOrWhiteSpace(NewName) Then Return
Dim NewPath As String = McFolderSelected & "versions\" & NewName & "\"
'获取临时中间名,以防止仅修改大小写的重命名失败
Dim TempName As String = NewName & "_temp"
Dim TempPath As String = McFolderSelected & "versions\" & TempName & "\"
Dim OnlyChangedCase As Boolean = NewName.Lower = OldName.Lower
'重新读取版本 JSON 信息,避免 JsonObject 中已被合并的项被重新存储
Dim JsonObject As JObject
Dim OldJsonPath As String = PageInstanceLeft.Instance.GetJsonPath()
Try
JsonObject = GetJson(ReadFile(OldJsonPath))
JsonObject = GetJson(FileUtils.ReadAsString(OldJsonPath))
Catch ex As Exception
Log(ex, "在重命名读取 json 时失败")
Logger.Warn(ex, "在重命名读取 json 时失败")
JsonObject = PageInstanceLeft.Instance.JsonObject
End Try
'重命名主文件夹
Directory.Move(OldPath, TempPath)
Directory.Move(TempPath, NewPath)
DirectoryUtils.Move(OldPath, NewPath)
'清理 ini 缓存
IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt")
IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini")
PageInstanceLeft.Instance.ResetIniCache()
'重命名 jar 文件与 natives 文件夹
'不能进行遍历重命名,否则在版本名很短的时候容易误伤其他文件(#6443)
If Directory.Exists($"{NewPath}{OldName}-natives") Then
If OnlyChangedCase Then
Directory.Move($"{NewPath}{OldName}-natives", $"{NewPath}{OldName}natives_temp")
Directory.Move($"{NewPath}{OldName}-natives_temp", $"{NewPath}{NewName}-natives")
Else
DeleteDirectory($"{NewPath}{NewName}-natives")
Directory.Move($"{NewPath}{OldName}-natives", $"{NewPath}{NewName}-natives")
End If
End If
If File.Exists($"{NewPath}{OldName}.jar") Then
If OnlyChangedCase Then
File.Move($"{NewPath}{OldName}.jar", $"{NewPath}{OldName}_temp.jar")
File.Move($"{NewPath}{OldName}_temp.jar", $"{NewPath}{NewName}.jar")
Else
File.Delete($"{NewPath}{NewName}.jar")
File.Move($"{NewPath}{OldName}.jar", $"{NewPath}{NewName}.jar")
End If
End If
If DirectoryUtils.Exists($"{NewPath}{OldName}-natives") Then DirectoryUtils.Move($"{NewPath}{OldName}-natives", $"{NewPath}{NewName}-natives")
If FileUtils.Exists($"{NewPath}{OldName}.jar") Then FileUtils.Move($"{NewPath}{OldName}.jar", $"{NewPath}{NewName}.jar")
'替换版本设置文件中的路径
If File.Exists(NewPath & "PCL\Setup.ini") Then
FileUtils.Write(NewPath & "PCL\Setup.ini", ReadFile(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath))
If FileUtils.Exists(NewPath & "PCL\Setup.ini") Then
FileUtils.Write(NewPath & "PCL\Setup.ini", FileUtils.ReadAsString(NewPath & "PCL\Setup.ini").Replace(OldPath, NewPath))
End If
'更改已选中的版本
If ReadIni(McFolderSelected & "PCL.ini", "Version") = OldName Then
@@ -162,10 +140,10 @@
'更新版本 Json
Try
JsonObject("id") = NewName
FileUtils.Delete(NewPath & PathUtils.GetLastPart(OldJsonPath))
FileUtils.Write(NewPath & NewName & ".json", JsonObject.ToString)
File.Delete(NewPath & GetFileNameFromPath(OldJsonPath))
Catch ex As Exception
Log(ex, "重命名版本 json 失败")
Logger.Warn(ex, "重命名版本 json 失败")
End Try
'刷新与提示
Hint("重命名成功!", HintType.Green)
@@ -174,7 +152,7 @@
Reload()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "重命名版本失败", NotifyLevel.MsgBox)
Logger.Error(ex, "重命名版本失败", LogBehavior.Alert)
End Try
End Sub
@@ -184,17 +162,17 @@
'选择 自定义 时修改图片
Try
If ComboDisplayLogo.SelectedItem Is ItemDisplayLogoCustom Then
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpeg;*.jpg;*.gif;*.webp)|*.png;*.jpeg;*.jpg;*.gif;*.webp", "选择图片")
If FileName = "" Then
Dim FileName As String = Dialogs.SelectFile("选择图片", False, filter:={({"png", "jpeg", "jpg", "gif", "webp"}, "常用图片文件")}).FirstOrDefault()
If String.IsNullOrEmpty(FileName) Then
Reload() '还原选项
Return
End If
CopyFile(FileName, PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
FileUtils.Copy(FileName, PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
Else
File.Delete(PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
FileUtils.Delete(PageInstanceLeft.Instance.PathVersion & "PCL\Logo.png")
End If
Catch ex As Exception
Log(ex, "更改自定义版本图标失败(" & PageInstanceLeft.Instance.Name & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"更改自定义版本图标失败({PageInstanceLeft.Instance.Name})")
End Try
'进行更改
Try
@@ -207,7 +185,7 @@
Reload()
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "更改版本图标失败(" & PageInstanceLeft.Instance.Name & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"更改版本图标失败({PageInstanceLeft.Instance.Name})")
End Try
End Sub
@@ -220,7 +198,7 @@
McInstanceListForceRefresh = True
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
Catch ex As Exception
Log(ex, "版本 " & PageInstanceLeft.Instance.Name & " 收藏状态更改失败", NotifyLevel.MsgBox)
Logger.Error(ex, $"版本 {PageInstanceLeft.Instance.Name} 收藏状态更改失败", LogBehavior.Alert)
End Try
End Sub
@@ -258,8 +236,8 @@
Private Sub BtnManageScript_Click() Handles BtnManageScript.Click
Try
'弹窗要求指定脚本的保存位置
Dim SavePath As String = SelectSaveFile("选择脚本保存位置", "启动 " & PageInstanceLeft.Instance.Name & ".bat", "批处理文件(*.bat)|*.bat")
If SavePath = "" Then Return
Dim SavePath As String = Dialogs.SaveFile("选择脚本保存位置", "启动 " & PageInstanceLeft.Instance.Name & ".bat", filter:={("bat", "批处理文件")})
If SavePath Is Nothing Then Return
'检查中断(等玩家选完弹窗指不定任务就结束了呢……)
If McLaunchLoader.State = LoadState.Loading Then
Hint("请在当前启动任务结束后再试!", HintType.Red)
@@ -267,14 +245,14 @@
End If
'生成脚本
If McLaunchStart(New McLaunchOptions With {.SaveBatch = SavePath, .Instance = PageInstanceLeft.Instance}) Then
If Settings.Get("LoginType") = McLoginType.Legacy Then
If Settings.Get(Of McLoginType)("LoginType") = McLoginType.Legacy Then
Hint("正在导出启动脚本……")
Else
Hint("正在导出启动脚本……(注意,使用脚本启动可能会导致登录失效!)")
End If
End If
Catch ex As Exception
Log(ex, "导出启动脚本失败(" & PageInstanceLeft.Instance.Name & ")", NotifyLevel.MsgBox)
Logger.Error(ex, $"导出启动脚本失败({PageInstanceLeft.Instance.Name})", LogBehavior.Alert)
End Try
End Sub
@@ -300,7 +278,7 @@
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Green)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & Loader.Error.GetBrief(), HintType.Red)
Hint(Loader.Name & "失败:" & Loader.Error.GetDisplay(False), HintType.Red)
Case LoadState.Interrupted
Hint(Loader.Name & "已取消!", HintType.Blue)
End Select
@@ -310,7 +288,7 @@
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "尝试补全文件失败(" & PageInstanceLeft.Instance.Name & ")", NotifyLevel.MsgBox)
Logger.Error(ex, $"尝试补全文件失败({PageInstanceLeft.Instance.Name})", LogBehavior.Alert)
End Try
End Sub
@@ -324,13 +302,8 @@
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""),
"版本删除确认", , "取消",, IsHintIndie OrElse IsShiftPressed)
Case 1
IniClearCache(PageInstanceLeft.Instance.PathIndie & "options.txt")
IniClearCache(PageInstanceLeft.Instance.PathVersion & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(PageInstanceLeft.Instance.PathVersion)
Else
FileIO.FileSystem.DeleteDirectory(PageInstanceLeft.Instance.PathVersion, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
PageInstanceLeft.Instance.ResetIniCache()
DirectoryUtils.Delete(PageInstanceLeft.Instance.PathVersion, Not IsShiftPressed)
Hint("已删除版本 " & PageInstanceLeft.Instance.Name & "!", HintType.Green)
Case 2
Return
@@ -338,9 +311,9 @@
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
FrmMain.PageBack()
Catch ex As OperationCanceledException
Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 被主动取消")
Logger.Warn(ex, $"删除版本 {PageInstanceLeft.Instance.Name} 被主动取消")
Catch ex As Exception
Log(ex, "删除版本 " & PageInstanceLeft.Instance.Name & " 失败", NotifyLevel.MsgBox)
Logger.Error(ex, $"删除版本 {PageInstanceLeft.Instance.Name} 失败", LogBehavior.Alert)
End Try
End Sub
@@ -36,7 +36,7 @@
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="游戏窗口标题" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentTitle" Grid.Row="2" Grid.ColumnSpan="2" local:SettingService.Key="VersionArgumentTitle" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则跟随全局设置的值。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="跟随全局设置" MaxLength="100" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="4" Grid.ColumnSpan="2" local:SettingService.Key="VersionArgumentInfo" Grid.Column="1" HintText="跟随全局设置" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角。&#xa;若留空,则跟随全局设置的值。&#xa;&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。">
<local:MyTextBox x:Name="TextArgumentInfo" Grid.Row="4" Grid.ColumnSpan="2" local:SettingService.Key="VersionArgumentInfo" Grid.Column="1" HintText="跟随全局设置" ToolTip="注意:Mojang 于 Minecraft 26.1 移除了该设置,因此该设置在新版本中无效。&#xa;&#xa;该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角。&#xa;若留空,则跟随全局设置的值。&#xa;&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。">
<local:MyTextBox.ValidateRules>
<local:ValidateExcept>
<local:ValidateExcept.Excepts>
@@ -250,7 +250,7 @@
ToolTip="是否使用 Java Launch Wrapper 修复 Java 18- 在中文路径下可能无法正常启动的问题。&#xa;详见:https://github.com/00ll00/java_launch_wrapper" />
<local:MyCheckBox Height="28" Text="禁用 LWJGL Unsafe Agent" local:SettingService.Key="VersionAdvanceDisableLUA"
ToolTipService.Placement="Right"
ToolTip="是否使用 LWJGL Unsafe Agent 修复 Java 25+ 的一个性能问题。&#xa;详见:https://github.com/HMCL-dev/lwjgl-unsafe-agent" />
ToolTip="是否使用 LWJGL Unsafe Agent 修复 LWJGL 3.4.1 的一个性能问题。&#xa;详见:https://github.com/HMCL-dev/lwjgl-unsafe-agent" />
</StackPanel>
</Grid>
</local:MyCard>
@@ -28,17 +28,17 @@
'启动参数
Dim _unused = PageInstanceLeft.Instance.PathIndie '触发自动判定
ComboArgumentIndieV2.SelectedIndex = If(Settings.Get("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance), 0, 1)
ComboArgumentIndieV2.SelectedIndex = If(Settings.Get(Of Boolean)("VersionArgumentIndieV2", Instance:=PageInstanceLeft.Instance), 0, 1)
RefreshJavaComboBox()
'服务器
ComboServerLogin.SelectedIndex = Settings.Get("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
ComboServerLogin.SelectedIndex = Settings.Get(Of Integer)("VersionServerLogin", Instance:=PageInstanceLeft.Instance)
ComboServerLoginLast = ComboServerLogin.SelectedIndex
UpdateServerLoginUI()
'高级设置
If Settings.Get("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) = 2 Then
Log("[Setup] 已迁移老版本的关闭文件校验设置")
If Settings.Get(Of Integer)("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance) = 2 Then
Logger.Info("已迁移老版本的关闭文件校验设置")
Settings.Reset("VersionAdvanceAssets", Instance:=PageInstanceLeft.Instance)
Settings.Set("VersionAdvanceAssetsV2", True, Instance:=PageInstanceLeft.Instance)
End If
@@ -46,10 +46,10 @@
SettingService.RefreshSettings(Me)
'游戏内存
OnVersionRamTypeChanged(Settings.Get("VersionRamType", Instance:=PageInstanceLeft.Instance))
OnVersionRamTypeChanged(Settings.Get(Of Integer)("VersionRamType", Instance:=PageInstanceLeft.Instance))
Catch ex As Exception
Log(ex, "重载版本独立设置时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "重载版本独立设置时出错")
End Try
End Sub
@@ -65,10 +65,10 @@
Settings.Reset("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
JavaSearchLoader.Start(IsForceRestart:=True)
Log("[Setup] 已初始化版本独立设置")
Logger.Info("已初始化版本独立设置")
Hint("已初始化版本独立设置!", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化版本独立设置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "初始化版本独立设置失败", LogBehavior.Alert)
End Try
Reload()
@@ -219,7 +219,7 @@
''' </summary>
Public Shared Function GetRam(Instance As McInstance, Optional Is32BitJava As Boolean? = Nothing) As Double
'跟随全局设置
If Settings.Get("VersionRamType", Instance:=Instance) = 2 Then
If Settings.Get(Of Integer)("VersionRamType", Instance:=Instance) = 2 Then
Return PageSetupLaunch.GetRam(Instance, True, Is32BitJava)
End If
@@ -229,7 +229,7 @@
'使用当前版本的设置
Dim RamGive As Double
If Settings.Get("VersionRamType", Instance:=Instance) = 0 Then
If Settings.Get(Of Integer)("VersionRamType", Instance:=Instance) = 0 Then
'自动配置
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
'确定需求的内存值
@@ -240,7 +240,7 @@
If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load()
If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Instance.PathIndie & "mods\")
Dim ModDir = DirectoryUtils.GetInfo(Instance.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Count(Function(f) {".jar", ".zip", ".litemod"}.Contains(f.Extension.Lower)), 0)
RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90
@@ -285,7 +285,7 @@ PreFin:
RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1)
Else
'手动配置
Dim Value As Integer = Settings.Get("VersionRamCustom", Instance:=Instance)
Dim Value As Integer = Settings.Get(Of Integer)("VersionRamCustom", Instance:=Instance)
If Value <= 12 Then
RamGive = Value * 0.1 + 0.3
ElseIf Value <= 25 Then
@@ -374,10 +374,10 @@ PreFin:
'初始化列表
ComboArgumentJava.Items.Clear()
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "跟随全局设置", .Tag = "使用全局设置"})
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"})
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择(推荐)", .Tag = "自动选择"})
'更新列表
Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Settings.Get("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
Dim SelectedBySetup As String = Settings.Get(Of String)("VersionArgumentJavaSelect", Instance:=PageInstanceLeft.Instance)
Try
For Each Java In JavaList.ToList().OrderByDescending(Function(v) v.MajorVersion)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
@@ -389,7 +389,7 @@ PreFin:
Next
Catch ex As Exception
Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log(ex, "更新版本设置 Java 下拉框失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "更新版本设置 Java 下拉框失败")
End Try
'更新选择项
If SelectedItem Is Nothing AndAlso JavaList.Any Then
@@ -424,15 +424,15 @@ PreFin:
If "使用全局设置".Equals(SelectedJava) Then
'选择 “自动”
Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置:跟随全局设置")
Logger.Info("修改版本 Java 选择设置:跟随全局设置")
ElseIf "自动选择".Equals(SelectedJava) Then
'选择 “自动”
Settings.Set("VersionArgumentJavaSelect", "", Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置:自动选择")
Logger.Info("修改版本 Java 选择设置:自动选择")
Else
'选择指定项
Settings.Set("VersionArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None), Instance:=PageInstanceLeft.Instance)
Log("[Java] 修改版本 Java 选择设置:" & SelectedJava.ToString)
Logger.Info($"修改版本 Java 选择设置:{SelectedJava}")
End If
RefreshRam(True)
End Sub
@@ -20,7 +20,7 @@
Data = Converter.Content
Init()
Catch ex As Exception
Log(ex, "登录弹窗初始化失败", NotifyLevel.AllUsers)
Logger.Error(ex, "登录弹窗初始化失败", LogBehavior.Toast)
End Try
End Sub
@@ -35,9 +35,9 @@
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyMsgBox " & Uuid)
'记录日志
Log("[Control] 登录弹窗:" & LabTitle.Text & vbCrLf & LabCaption.Text)
Logger.Info($"登录弹窗:{LabTitle.Text}{vbCrLf}{LabCaption.Text}")
Catch ex As Exception
Log(ex, "登录弹窗加载失败", NotifyLevel.AllUsers)
Logger.Error(ex, "登录弹窗加载失败", LogBehavior.Toast)
End Try
End Sub
Private Sub Close()
@@ -123,8 +123,8 @@
Return
Catch ex As Exception
'修改错误列表时,同时修改 ModLaunch.MsLoginStep1Refresh 中的对应代码
If TypeOf ex Is ResponsedWebException Then
Dim Response = CType(ex, ResponsedWebException).Response
If TypeOf ex Is HttpRequestCodeException Then
Dim Response = CType(ex, HttpRequestCodeException).Response
If Response.Contains("authorization_declined") Then
Finished(New Exception("$你拒绝了 PCL 申请的权限……"))
Return
@@ -147,7 +147,7 @@
End If
If UnknownFailureCount <= 2 Then
UnknownFailureCount += 1
Log(ex, $"登录轮询第 {UnknownFailureCount} 次失败")
Logger.Warn(ex, $"登录轮询第 {UnknownFailureCount} 次失败")
Thread.Sleep(2000)
Else
Finished(New Exception("登录轮询失败", ex))
@@ -14,7 +14,7 @@
ToolTip = If(_Address = "", "加载中", "点击更换皮肤(右键查看更多选项)")
End Set
End Property
Public Loader As LoaderTask(Of EqualableList(Of String), String)
Public Loader As LoaderTask(Of (String, String), String)
'控件动画
Private Sub PanSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles Me.MouseEnter
@@ -44,7 +44,7 @@
Public Sub BtnSkinSave_Click() Handles BtnSkinSave.Click
Save(Loader)
End Sub
Public Shared Sub Save(Loader As LoaderTask(Of EqualableList(Of String), String))
Public Shared Sub Save(Loader As LoaderTask(Of (String, String), String))
Dim Address = Loader.Output
If Not Loader.State = LoadState.Finished Then
Hint("皮肤正在获取中,请稍候!", HintType.Red)
@@ -52,19 +52,20 @@
Return
End If
Try
Dim FileAddress As String = SelectSaveFile("选取保存皮肤的位置", GetFileNameFromPath(Address), "皮肤图片文件(*.png)|*.png")
Dim FileAddress As String = Dialogs.SaveFile("选取保存皮肤的位置", PathUtils.GetLastPart(Address), filter:={("png", "皮肤图片文件")})
If FileAddress Is Nothing Then Return
If FileAddress.Contains("\") Then
File.Delete(FileAddress)
FileUtils.Delete(FileAddress)
If Address.StartsWithF(PathImage) Then
Dim Image As New MyBitmap(Address)
Image.Save(FileAddress)
Else
CopyFile(Address, FileAddress)
FileUtils.Copy(Address, FileAddress)
End If
Hint("皮肤保存成功!", HintType.Green)
End If
Catch ex As Exception
Log(ex, "保存皮肤失败", NotifyLevel.AllUsers)
Logger.Error(ex, "保存皮肤失败", LogBehavior.Toast)
End Try
End Sub
Private Sub BtnSkinSave_Checked(sender As MyMenuItem, e As RoutedEventArgs) Handles BtnSkinSave.Checked
@@ -79,14 +80,14 @@
'检查文件存在
Address = Loader.Output
If String.IsNullOrEmpty(Address) Then Throw New Exception("皮肤加载器 " & Loader.Name & " 没有输出")
If Not Address.StartsWithF(PathImage) AndAlso Not File.Exists(Address) Then Throw New FileNotFoundException("皮肤文件未找到", Address)
If Not Address.StartsWithF(PathImage) AndAlso Not FileUtils.Exists(Address) Then Throw New FileNotFoundException("皮肤文件未找到", Address)
'加载
Dim Image As MyBitmap
Try
Image = New MyBitmap(Address)
Catch ex As Exception '#2272
Log(ex, $"皮肤文件已损坏:{Address}", NotifyLevel.AllUsers)
File.Delete(Address)
Logger.Error(ex, $"皮肤文件已损坏:{Address}", LogBehavior.Toast)
FileUtils.Delete(Address)
Return
End Try
ImgBack.Tag = Address
@@ -113,9 +114,9 @@
End If
'脸层
ImgBack.Source = Image.Clip(Scale * 8, Scale * 8, Scale * 8, Scale * 8)
Log("[Skin] 载入头像成功:" & Loader.Name)
Logger.Info($"载入头像成功:{Loader.Name}")
Catch ex As Exception
Log(ex, "载入头像失败(" & If(Address, "null") & "," & Loader.Name & ")", NotifyLevel.AllUsers)
Logger.Error(ex, $"载入头像失败({If(Address, "null")},{Loader.Name})", LogBehavior.Toast)
End Try
End Sub
''' <summary>
@@ -134,7 +135,7 @@
''' <summary>
''' 刷新皮肤缓存。
''' </summary>
Public Shared Sub RefreshCache(Optional sender As LoaderTask(Of EqualableList(Of String), String) = Nothing)
Public Shared Sub RefreshCache(Optional sender As LoaderTask(Of (String, String), String) = Nothing)
Dim HasLoaderRunning As Boolean = False
For Each SkinLoader In PageLaunchLeft.SkinLoaders
If SkinLoader.State = LoadState.Loading Then
@@ -150,9 +151,9 @@
Try
Hint("正在刷新头像……")
'清空缓存
Log("[Skin] 正在清空皮肤缓存")
If Directory.Exists(PathTemp & "Cache\Skin") Then DeleteDirectory(PathTemp & "Cache\Skin")
If Directory.Exists(PathTemp & "Cache\Uuid") Then DeleteDirectory(PathTemp & "Cache\Uuid")
Logger.Info("正在清空皮肤缓存")
If DirectoryUtils.Exists(PathTemp & "Cache\Skin") Then DirectoryUtils.Delete(PathTemp & "Cache\Skin")
If DirectoryUtils.Exists(PathTemp & "Cache\Uuid") Then DirectoryUtils.Delete(PathTemp & "Cache\Uuid")
IniClearCache(PathTemp & "Cache\Skin\IndexMs.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexNide.ini")
IniClearCache(PathTemp & "Cache\Skin\IndexAuth.ini")
@@ -163,7 +164,7 @@
Next
Hint("已刷新头像!", HintType.Green)
Catch ex As Exception
Log(ex, "刷新皮肤缓存失败", NotifyLevel.MsgBox)
Logger.Error(ex, "刷新皮肤缓存失败", LogBehavior.Alert)
End Try
End Sub)
End If
@@ -177,8 +178,8 @@
Sub()
Try
'更新缓存
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Settings.Get("CacheMsV2Uuid"), SkinAddress)
Log($"[Skin] 已写入皮肤地址缓存 {Settings.Get("CacheMsV2Uuid")} -> {SkinAddress}")
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Settings.Get(Of String)("CacheMsV2Uuid"), SkinAddress)
Logger.Info($"已写入皮肤地址缓存 {Settings.Get(Of String)("CacheMsV2Uuid")} -> {SkinAddress}")
'刷新控件
For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}
SkinLoader.WaitForExit(IsForceRestart:=True)
@@ -186,7 +187,7 @@
'完成提示
Hint("更改皮肤成功!", HintType.Green)
Catch ex As Exception
Log(ex, "更改正版皮肤后刷新皮肤失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "更改正版皮肤后刷新皮肤失败")
End Try
End Sub)
End Sub
@@ -255,7 +256,7 @@ Retry:
Next
SelectedIndex = MyMsgBoxSelect(SelectionControl, "选择披风", "确定", "取消")
Catch ex As Exception
Log(ex, "获取玩家皮肤列表失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "获取玩家皮肤列表失败")
End Try
End Sub)
If SelectedIndex Is Nothing Then Return
@@ -278,7 +279,7 @@ Retry:
McLoginMsLoader.Output.ProfileJson = SkinData.ToString()
End If
Catch ex As Exception
Log(ex, "更改披风失败", NotifyLevel.AllUsers)
Logger.Error(ex, "更改披风失败", LogBehavior.Toast)
Finally
IsChanging = False
End Try
@@ -23,39 +23,39 @@
Sub()
'自动整合包安装:准备
Dim PackInstallPath As String = Nothing
If File.Exists(PathExeFolder & "modpack.zip") Then PackInstallPath = PathExeFolder & "modpack.zip"
If File.Exists(PathExeFolder & "modpack.mrpack") Then PackInstallPath = PathExeFolder & "modpack.mrpack"
If FileUtils.Exists(PathExeFolder & "modpack.zip") Then PackInstallPath = PathExeFolder & "modpack.zip"
If FileUtils.Exists(PathExeFolder & "modpack.mrpack") Then PackInstallPath = PathExeFolder & "modpack.mrpack"
If PackInstallPath IsNot Nothing Then
Log("[Launch] 需自动安装整合包:" & PackInstallPath, NotifyLevel.DebugModeOnly)
Logger.Warn($"需自动安装整合包:{PackInstallPath}")
PageSelectLeft.CreateMcFolderInCurrentPath()
McFolderListLoader.WaitForExit()
End If
'确认 Minecraft 文件夹存在
If McFolderSelected = "" OrElse Not Directory.Exists(McFolderSelected) Then
If McFolderSelected = "" OrElse Not DirectoryUtils.Exists(McFolderSelected) Then
'无效的文件夹
If McFolderSelected = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹")
Logger.Info("没有已储存的 Minecraft 文件夹")
Else
Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & McFolderSelected, NotifyLevel.DebugModeOnly)
Logger.Warn($"Minecraft 文件夹无效,该文件夹已不存在:{McFolderSelected}")
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
McFolderSelected = McFolderList.First.Location
End If
If Settings.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
If Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'自动整合包安装
If PackInstallPath IsNot Nothing Then
Try
Dim InstallLoader = ModpackInstall(PackInstallPath)
Log("[Launch] 自动安装整合包已开始:" & PackInstallPath)
Logger.Info($"自动安装整合包已开始:{PackInstallPath}")
InstallLoader.WaitForExit()
If InstallLoader.State = LoadState.Finished Then
Log("[Launch] 自动安装整合包成功,清理安装包:" & PackInstallPath)
If File.Exists(PackInstallPath) Then File.Delete(PackInstallPath)
Logger.Info($"自动安装整合包成功,清理安装包:{PackInstallPath}")
FileUtils.Delete(PackInstallPath)
End If
Catch ex As CancelledException
Log(ex, "自动安装整合包被用户取消:" & PackInstallPath)
Logger.Warn(ex, $"自动安装整合包被用户取消:{PackInstallPath}")
Catch ex As Exception
Log(ex, "自动安装整合包失败:" & PackInstallPath, NotifyLevel.MsgBox)
Logger.Error(ex, $"自动安装整合包失败:{PackInstallPath}", LogBehavior.Alert)
End Try
End If
'确认 Minecraft 版本存在
@@ -63,14 +63,14 @@
Dim Instance As McInstance = If(Selection = "", Nothing, New McInstance(Selection))
If Instance Is Nothing OrElse Not Instance.PathVersion.StartsWithF(McFolderSelected) OrElse Not Instance.Check() Then
'无效的版本
Log("[Launch] 当前选择的 Minecraft 版本无效:" & If(Instance Is Nothing, "null", Instance.PathVersion), If(IsNothing(Instance), NotifyLevel.Silent, NotifyLevel.DebugModeOnly))
Logger.Info($"当前选择的 Minecraft 版本无效:{If(Instance Is Nothing, "null", Instance.PathVersion)}", If(IsNothing(Instance), LogBehavior.None, LogBehavior.ToastIfDebug))
If Not McInstanceListLoader.State = LoadState.Finished Then LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McInstanceList.Any() OrElse McInstanceList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Instance = Nothing
Log("[Launch] 无可用 Minecraft 版本")
Logger.Info("无可用 Minecraft 版本")
Else
Instance = McInstanceList.First.Value(0)
Log("[Launch] 自动选择 Minecraft 版本:" & Instance.PathVersion)
Logger.Info($"自动选择 Minecraft 版本:{Instance.PathVersion}")
End If
End If
RunInUi(
@@ -85,7 +85,7 @@
End Sub, "Version Check", ThreadPriority.AboveNormal)
'改变页面
Dim LoginType As McLoginType = Settings.Get("LoginType")
Dim LoginType = Settings.Get(Of McLoginType)("LoginType")
If LoginType = McLoginType.Legacy OrElse LoginType = McLoginType.Ms Then CType(FindName("RadioLoginType" & LoginType), MyRadioButton).Checked = True
RefreshPage(False, False)
@@ -99,7 +99,7 @@
''' </summary>
Public Sub PageChangeToLaunching()
'修改登陆方式
Select Case Settings.Get("LoginType")
Select Case Settings.Get(Of McLoginType)("LoginType")
Case McLoginType.Legacy
LabLaunchingMethod.Text = "离线登录"
Case McLoginType.Ms
@@ -257,7 +257,7 @@
PageCurrent = Type
Return PageNew
Catch ex As Exception
Log(ex, "切换登录分页失败(" & GetStringFromEnum(CType(Type, [Enum])) & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换登录分页失败({Type})")
Return PageNew
End Try
End Function
@@ -270,17 +270,17 @@
Dim Type As PageType
Dim LoginPageType As Integer
If McInstanceSelected IsNot Nothing Then
LoginPageType = Settings.Get("VersionServerLogin", Instance:=McInstanceSelected)
LoginPageType = Settings.Get(Of Integer)("VersionServerLogin", Instance:=McInstanceSelected)
'缓存当前版本的页面种类,下一次打开 McInstanceSelected 为空时才能加载出正确的页面
Settings.Set("LoginPageType", LoginPageType)
Else
LoginPageType = Settings.Get("LoginPageType")
LoginPageType = Settings.Get(Of Integer)("LoginPageType")
End If
Select Case LoginPageType
Case 0 '正版或离线
UnknownType:
If RadioLoginType5.Checked Then
If Settings.Get("CacheMsV2Access") = "" Then
If Settings.Get(Of String)("CacheMsV2Access") = "" Then
Type = PageType.Ms
Else
Type = PageType.MsSkin
@@ -295,7 +295,7 @@ UnknownType:
RadioLoginType5.Visibility = Visibility.Visible
RadioLoginType0.Visibility = Visibility.Visible
Case 1 '仅正版
If Settings.Get("CacheMsV2Access") = "" Then
If Settings.Get(Of String)("CacheMsV2Access") = "" Then
Type = PageType.Ms
Else
Type = PageType.MsSkin
@@ -315,7 +315,7 @@ UnknownType:
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonOffline)
LabTypeOne.Text = "离线登录"
Case 3 '统一通行证
If Settings.Get("CacheNideAccess") = "" Then
If Settings.Get(Of String)("CacheNideAccess") = "" Then
Type = PageType.Nide
Else
Type = PageType.NideSkin
@@ -326,7 +326,7 @@ UnknownType:
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard)
LabTypeOne.Text = "统一通行证登录"
Case 4 'Authlib-Injector
If Settings.Get("CacheAuthAccess") = "" Then
If Settings.Get(Of String)("CacheAuthAccess") = "" Then
Type = PageType.Auth
Else
Type = PageType.AuthSkin
@@ -335,16 +335,16 @@ UnknownType:
PanType.Visibility = Visibility.Collapsed
PanTypeOne.Visibility = Visibility.Visible
PathTypeOne.Data = (New GeometryConverter).ConvertFromString(Logo.IconButtonCard)
LabTypeOne.Text = If(McInstanceSelected Is Nothing, Settings.Get("CacheAuthServerName"), Settings.Get("VersionServerAuthName", Instance:=McInstanceSelected))
LabTypeOne.Text = If(McInstanceSelected Is Nothing, Settings.Get(Of String)("CacheAuthServerName"), Settings.Get(Of String)("VersionServerAuthName", Instance:=McInstanceSelected))
If LabTypeOne.Text = "" Then LabTypeOne.Text = "第三方登录"
Case Else
Log("[Control] 未知的登录页面:" & LoginPageType, NotifyLevel.AllUsers)
Logger.Error($"未知的登录页面:{LoginPageType}", LogBehavior.Toast)
GoTo UnknownType
End Select
'刷新页面
If PageCurrent = Type Then Return
PageChange(Type, Anim).Reload(KeepInput)
Dim Control As MyRadioButton = FindName("RadioLoginType" & Settings.Get("LoginType"))
Dim Control As MyRadioButton = FindName("RadioLoginType" & Settings.Get(Of McLoginType)("LoginType"))
If Control IsNot Nothing Then Control.Checked = True
End Sub
Private Sub RadioLoginType_Change(sender As Object, raiseByMouse As Boolean) Handles RadioLoginType0.Check, RadioLoginType5.Check
@@ -356,21 +356,21 @@ UnknownType:
#Region "皮肤"
'微软正版皮肤
Public Shared SkinMs As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal)
Private Shared Function SkinMsInput() As EqualableList(Of String)
Public Shared SkinMs As New LoaderTask(Of (String, String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal)
Private Shared Function SkinMsInput() As (String, String)
'获取名称
Return New EqualableList(Of String) From {Settings.Get("CacheMsV2Name"), Settings.Get("CacheMsV2Uuid")}
Return (Settings.Get(Of String)("CacheMsV2Name"), Settings.Get(Of String)("CacheMsV2Uuid"))
End Function
Private Shared Sub SkinMsLoad(Data As LoaderTask(Of EqualableList(Of String), String))
Private Shared Sub SkinMsLoad(Data As LoaderTask(Of (String, String), String))
'清空已有皮肤
'如果在输入时清空皮肤,若输入内容一样则不会执行 Load 方法,导致皮肤不被加载
RunInUi(Sub() If FrmLoginMsSkin IsNot Nothing AndAlso FrmLoginMsSkin.Skin IsNot Nothing Then FrmLoginMsSkin.Skin.Clear())
'获取 Url
Dim UserName As String = Data.Input(0)
Dim Uuid As String = Data.Input(1)
Dim UserName As String = Data.Input.Item1
Dim Uuid As String = Data.Input.Item2
If UserName = "" Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取微软正版皮肤失败,ID 为空")
Logger.Info("获取微软正版皮肤失败,ID 为空")
GoTo Finish
End If
Try
@@ -383,15 +383,15 @@ UnknownType:
Data.Output = ""
Return
Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then
If ex.GetDisplay(False).Contains("(429)") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取正版皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", NotifyLevel.AllUsers)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then
Logger.Error($"获取正版皮肤失败({UserName}):获取皮肤太过频繁,请 5 分钟后再试!", LogBehavior.Toast)
ElseIf ex.GetDisplay(False).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 用户未设置自定义皮肤,跳过皮肤加载")
Logger.Info("用户未设置自定义皮肤,跳过皮肤加载")
Else
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log(ex, "获取微软正版皮肤失败(" & UserName & ")", NotifyLevel.AllUsers)
Logger.Error(ex, $"获取微软正版皮肤失败({UserName})", LogBehavior.Toast)
End If
End Try
Finish:
@@ -404,39 +404,39 @@ Finish:
End Sub
'离线皮肤
Public Shared SkinLegacy As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Legacy", AddressOf SkinLegacyLoad, AddressOf SkinLegacyInput, ThreadPriority.AboveNormal)
Private Shared Function SkinLegacyInput() As EqualableList(Of String)
Public Shared SkinLegacy As New LoaderTask(Of (String, String), String)("Loader Skin Legacy", AddressOf SkinLegacyLoad, AddressOf SkinLegacyInput, ThreadPriority.AboveNormal)
Private Shared Function SkinLegacyInput() As (String, String)
'根据类型判断输入
Dim Type As Integer = Settings.Get("LaunchSkinType")
Dim Type As Integer = Settings.Get(Of Integer)("LaunchSkinType")
Select Case Type
Case 0
If FrmLoginLegacy IsNot Nothing AndAlso FrmLoginLegacy.IsReloaded Then
Return New EqualableList(Of String) From {0, If(FrmLoginLegacy.ComboName.Text.Trim, "")}
ElseIf Settings.Get("LoginLegacyName") = "" Then
Return New EqualableList(Of String) From {0, ""}
If FrmLoginLegacy?.IsReloaded Then
Return ("0", If(FrmLoginLegacy.ComboName.Text.Trim, ""))
ElseIf Settings.Get(Of String)("LoginLegacyName") = "" Then
Return ("0", "")
Else
Return New EqualableList(Of String) From {0, If(Settings.Get("LoginLegacyName").ToString.BeforeFirst("¨"), "")}
Return ("0", If(Settings.Get(Of String)("LoginLegacyName").ToString.BeforeFirst("¨"), ""))
End If
Case 3
Return New EqualableList(Of String) From {3, Settings.Get("LaunchSkinID")}
Return ("3", Settings.Get(Of String)("LaunchSkinID"))
Case Else
Return New EqualableList(Of String) From {Type}
Return (Type.ToString, "")
End Select
End Function
Private Shared Sub SkinLegacyLoad(Data As LoaderTask(Of EqualableList(Of String), String))
Private Shared Sub SkinLegacyLoad(Data As LoaderTask(Of (String, String), String))
'清空已有皮肤
RunInUi(Sub() If FrmLoginLegacy IsNot Nothing AndAlso FrmLoginLegacy.Skin IsNot Nothing Then FrmLoginLegacy.Skin.Clear())
'获取 Url
Select Case Data.Input(0)
Select Case CInt(Data.Input.Item1)
Case 0 '默认
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(Data.Input(1))) & ".png"
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(Data.Input.Item2)) & ".png"
Case 1 'Steve
UseDefault:
Data.Output = PathImage & "Skins/Steve.png"
Case 2 'Alex
Data.Output = PathImage & "Skins/Alex.png"
Case 3 '正版
Dim ID As String = Data.Input(1)
Dim ID As String = Data.Input.Item2
Try
If ID.Count < 2 Then
Data.Output = PathImage & "Skins/Steve.png"
@@ -453,16 +453,16 @@ UseDefault:
Data.Output = ""
Return
Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then
If ex.GetDisplay(False).Contains("(429)") Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png"
Log("获取离线登录使用的正版皮肤失败(" & ID & "):获取皮肤太过频繁,请 5 分钟后再试!")
Logger.Info($"获取离线登录使用的正版皮肤失败({ID}):获取皮肤太过频繁,请 5 分钟后再试!")
Else
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(ID)) & ".png"
Log(ex, "获取离线登录使用的正版皮肤失败(" & ID & ")")
Logger.Warn(ex, $"获取离线登录使用的正版皮肤失败({ID})")
End If
End Try
Case 4 '自定义
If Not File.Exists(PathAppdata & "CustomSkin.png") Then
If Not FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
Hint("未找到离线皮肤自定义文件,可能它已被删除。PCL 将使用默认的 Steve 皮肤!")
Settings.Set("LaunchSkinType", 1)
GoTo UseDefault
@@ -478,21 +478,21 @@ UseDefault:
End Sub
'统一通行证皮肤
Public Shared SkinNide As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Nide", AddressOf SkinNideLoad, AddressOf SkinNideInput, ThreadPriority.AboveNormal)
Private Shared Function SkinNideInput() As EqualableList(Of String)
Public Shared SkinNide As New LoaderTask(Of (String, String), String)("Loader Skin Nide", AddressOf SkinNideLoad, AddressOf SkinNideInput, ThreadPriority.AboveNormal)
Private Shared Function SkinNideInput() As (String, String)
'获取名称
Return New EqualableList(Of String) From {Settings.Get("CacheNideName"), Settings.Get("CacheNideUuid")}
Return (Settings.Get(Of String)("CacheNideName"), Settings.Get(Of String)("CacheNideUuid"))
End Function
Private Shared Sub SkinNideLoad(Data As LoaderTask(Of EqualableList(Of String), String))
Private Shared Sub SkinNideLoad(Data As LoaderTask(Of (String, String), String))
'清空已有皮肤
'如果在输入时清空皮肤,若输入内容一样则不会执行 Load 方法,导致皮肤不被加载
RunInUi(Sub() If FrmLoginNideSkin IsNot Nothing AndAlso FrmLoginNideSkin.Skin IsNot Nothing Then FrmLoginNideSkin.Skin.Clear())
'获取 Url
Dim UserName As String = Data.Input(0)
Dim Uuid As String = Data.Input(1)
Dim UserName As String = Data.Input.Item1
Dim Uuid As String = Data.Input.Item2
If UserName = "" Then
Data.Output = PathImage & "Skins/" & McSkinSex(McLoginLegacyUuid(UserName)) & ".png"
Log("[Minecraft] 获取统一通行证皮肤失败,ID 为空")
Logger.Info("获取统一通行证皮肤失败,ID 为空")
GoTo Finish
End If
Try
@@ -505,15 +505,15 @@ UseDefault:
Data.Output = ""
Return
Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then
If ex.GetDisplay(False).Contains("(429)") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取统一通行证皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", NotifyLevel.AllUsers)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then
Logger.Error($"获取统一通行证皮肤失败({UserName}):获取皮肤太过频繁,请 5 分钟后再试!", LogBehavior.Toast)
ElseIf ex.GetDisplay(False).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤,跳过皮肤加载")
Logger.Info("用户未设置自定义皮肤,跳过皮肤加载")
Else
Data.Output = PathImage & "Skins/Steve.png"
Log(ex, "获取统一通行证皮肤失败(" & UserName & ")", NotifyLevel.AllUsers)
Logger.Error(ex, $"获取统一通行证皮肤失败({UserName})", LogBehavior.Toast)
End If
End Try
Finish:
@@ -526,21 +526,21 @@ Finish:
End Sub
'Authlib-Injector 皮肤
Public Shared SkinAuth As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Auth", AddressOf SkinAuthLoad, AddressOf SkinAuthInput, ThreadPriority.AboveNormal)
Private Shared Function SkinAuthInput() As EqualableList(Of String)
Public Shared SkinAuth As New LoaderTask(Of (String, String), String)("Loader Skin Auth", AddressOf SkinAuthLoad, AddressOf SkinAuthInput, ThreadPriority.AboveNormal)
Private Shared Function SkinAuthInput() As (String, String)
'获取名称
Return New EqualableList(Of String) From {Settings.Get("CacheAuthName"), Settings.Get("CacheAuthUuid")}
Return (Settings.Get(Of String)("CacheAuthName"), Settings.Get(Of String)("CacheAuthUuid"))
End Function
Private Shared Sub SkinAuthLoad(Data As LoaderTask(Of EqualableList(Of String), String))
Private Shared Sub SkinAuthLoad(Data As LoaderTask(Of (String, String), String))
'清空已有皮肤
'如果在输入时清空皮肤,若输入内容一样则不会执行 Load 方法,导致皮肤不被加载
RunInUi(Sub() If FrmLoginAuthSkin IsNot Nothing AndAlso FrmLoginAuthSkin.Skin IsNot Nothing Then FrmLoginAuthSkin.Skin.Clear())
'获取 Url
Dim UserName As String = Data.Input(0)
Dim UUID As String = Data.Input(1)
Dim UserName As String = Data.Input.Item1
Dim UUID As String = Data.Input.Item2
If UserName = "" Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取 Authlib-Injector 皮肤失败,ID 为空")
Logger.Info("获取 Authlib-Injector 皮肤失败,ID 为空")
GoTo Finish
End If
Try
@@ -553,15 +553,15 @@ Finish:
Data.Output = ""
Return
Catch ex As Exception
If ex.GetBrief.Contains("(429)") Then
If ex.GetDisplay(False).Contains("(429)") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 获取 Authlib-Injector 皮肤失败(" & UserName & "):获取皮肤太过频繁,请 5 分钟后再试!", NotifyLevel.AllUsers)
ElseIf ex.GetBrief.Contains("未设置自定义皮肤") Then
Logger.Error($"获取 Authlib-Injector 皮肤失败({UserName}):获取皮肤太过频繁,请 5 分钟后再试!", LogBehavior.Toast)
ElseIf ex.GetDisplay(False).Contains("未设置自定义皮肤") Then
Data.Output = PathImage & "Skins/Steve.png"
Log("[Minecraft] 用户未设置自定义皮肤,跳过皮肤加载")
Logger.Info("用户未设置自定义皮肤,跳过皮肤加载")
Else
Data.Output = PathImage & "Skins/Steve.png"
Log(ex, "获取 Authlib-Injector 皮肤失败(" & UserName & ")", NotifyLevel.AllUsers)
Logger.Error(ex, $"获取 Authlib-Injector 皮肤失败({UserName})", LogBehavior.Toast)
End If
End Try
Finish:
@@ -575,7 +575,7 @@ Finish:
'全部皮肤加载器
'需要放在其中元素的后面,否则会因为它提前被加载而莫名其妙变成 Nothing
Public Shared SkinLoaders As New List(Of LoaderTask(Of EqualableList(Of String), String)) From {SkinMs, SkinLegacy, SkinNide, SkinAuth}
Public Shared SkinLoaders As New List(Of LoaderTask(Of (String, String), String)) From {SkinMs, SkinLegacy, SkinNide, SkinAuth}
#End Region
@@ -616,7 +616,7 @@ Finish:
CurrentState = 0
Else
If McInstanceSelected Is Nothing Then
If Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow Then
If Settings.Get(Of Boolean)("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow Then
CurrentState = 1
Else
CurrentState = 2
@@ -632,28 +632,28 @@ Finish:
BtnLaunchState = CurrentState
Select Case CurrentState
Case 0
Log("[Minecraft] 启动按钮:正在加载 Minecraft 版本")
Logger.Info("启动按钮:正在加载 Minecraft 版本")
FrmLaunchLeft.BtnLaunch.Text = "正在加载"
FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "正在加载中,请稍候"
FrmLaunchLeft.BtnVersion.IsEnabled = False
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 1
Log("[Minecraft] 启动按钮:无 Minecraft 版本,下载已禁用")
Logger.Info("启动按钮:无 Minecraft 版本,下载已禁用")
FrmLaunchLeft.BtnLaunch.Text = "启动游戏"
FrmLaunchLeft.BtnLaunch.IsEnabled = False
FrmLaunchLeft.LabVersion.Text = "未找到可用的游戏版本"
FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 2
Log("[Minecraft] 启动按钮:无 Minecraft 版本,要求下载")
Logger.Info("启动按钮:无 Minecraft 版本,要求下载")
FrmLaunchLeft.BtnLaunch.Text = "下载游戏"
FrmLaunchLeft.BtnLaunch.IsEnabled = True
FrmLaunchLeft.LabVersion.Text = "未找到可用的游戏版本"
FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnMore.Visibility = Visibility.Collapsed
Case 3
Log("[Minecraft] 启动按钮:Minecraft 版本:" & McInstanceSelected.PathVersion)
Logger.Info($"启动按钮:Minecraft 版本:{McInstanceSelected.PathVersion}")
FrmLaunchLeft.BtnLaunch.Text = "启动游戏"
FrmLaunchLeft.BtnVersion.IsEnabled = True
FrmLaunchLeft.BtnLaunch.IsEnabled = True
@@ -662,7 +662,7 @@ Finish:
End Select
ExitRefresh:
'功能隐藏
FrmLaunchLeft.BtnVersion.Visibility = If(Not PageSetupUI.HiddenForceShow AndAlso Settings.Get("UiHiddenFunctionSelect"), Visibility.Collapsed, Visibility.Visible)
FrmLaunchLeft.BtnVersion.Visibility = If(Not PageSetupUI.HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenFunctionSelect"), Visibility.Collapsed, Visibility.Visible)
If CurrentState = 3 Then
FrmLaunchLeft.BtnMore.Visibility = FrmLaunchLeft.BtnVersion.Visibility
End If
@@ -679,7 +679,7 @@ ExitRefresh:
If Not McLaunchProcess.HasExited Then McLaunchProcess.Kill()
End If
Catch ex As Exception
Log(ex, "取消启动结束进程失败", NotifyLevel.AllUsers)
Logger.Error(ex, "取消启动结束进程失败", LogBehavior.Toast)
End Try
End If
End Sub
@@ -708,7 +708,7 @@ ExitRefresh:
Next
LabLaunchingStage.Text = "已完成"
Catch ex As Exception
Log(ex, "获取是否启动完成失败,可能是由于启动状态改变导致集合已修改")
Logger.Warn(ex, "获取是否启动完成失败,可能是由于启动状态改变导致集合已修改")
Return
End Try
LabLaunchingTitle.Text = If(IsLaunched OrElse McLaunchLoaderReal.State = LoadState.Finished,
@@ -733,7 +733,7 @@ ExitRefresh:
Next
End If
Catch ex As Exception
Log(ex, "获取 Minecraft 启动下载器失败,可能是因为启动被取消")
Logger.Warn(ex, "获取 Minecraft 启动下载器失败,可能是因为启动被取消")
HasLaunchDownloader = False
End Try
LabLaunchingDownload.Text = FormatFileSize(NetManager.Speed) & "/s"
@@ -769,7 +769,7 @@ ExitRefresh:
End If
AniStart(AnimList, "Launching Progress")
Catch ex As Exception
Log(ex, "刷新启动信息失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新启动信息失败")
End Try
End Sub
Private ShowProgress As Double = 0
@@ -9,7 +9,7 @@ Public Class PageLaunchRight
'快照版提示
PanHint.Visibility =
(BuildType <> BuildTypes.Release AndAlso VersionBranchMain = "Official" AndAlso
DonationRank < DonationRanks.Rank23 AndAlso Not CType(Settings.Get("HintSnapshot"), Boolean)).ToVisibility
CurrentRank < DonationRank.Rank23 AndAlso Not Settings.Get(Of Boolean)("HintSnapshot")).ToVisibility
End Sub
#Region "主页"
@@ -25,25 +25,25 @@ Public Class PageLaunchRight
RefreshReal()
End SyncLock
Catch ex As Exception
Log(ex, "加载 PCL 主页自定义信息失败", If(ModeDebug, NotifyLevel.MsgBox, NotifyLevel.AllUsers))
Logger.Error(ex, "加载 PCL 主页自定义信息失败", If(ModeDebug, LogBehavior.Alert, LogBehavior.Toast))
End Try
End Sub)
End Sub
Private Sub RefreshReal()
Dim Content As String = Nothing, Url As String = Nothing
Select Case Settings.Get("UiCustomType")
Select Case Settings.Get(Of Integer)("UiCustomType")
Case 1
'加载本地文件
Log("[Page] 主页自定义数据来源:本地文件")
Content = ReadFile(PathExeFolder & "PCL\Custom.xaml") 'ReadFile 会进行存在检测
Logger.Info("主页自定义数据来源:本地文件")
Content = FileUtils.TryReadAsString(PathExeFolder & "PCL\Custom.xaml")
Case 2
'联网下载
Url = Settings.Get("UiCustomNet")
Url = Settings.Get(Of String)("UiCustomNet")
Case 3
'预设
Select Case Settings.Get("UiCustomPreset")
Select Case Settings.Get(Of Integer)("UiCustomPreset")
Case 0
Log("[Page] 主页预设:你知道吗")
Logger.Info("主页预设:你知道吗")
Content = "
<local:MyCard Title=""你知道吗?"" Margin=""0,0,0,15"">
<TextBlock Margin=""25,38,23,15"" FontSize=""13.5"" IsHitTestVisible=""False"" Text=""{hint}"" TextWrapping=""Wrap"" Foreground=""{DynamicResource ColorBrush1}"" />
@@ -52,7 +52,7 @@ Public Class PageLaunchRight
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
</local:MyCard>"
Case 1
Log("[Page] 主页预设:回声洞")
Logger.Info("主页预设:回声洞")
Content = "
<local:MyCard Title=""回声洞"" Margin=""0,0,0,15"">
<TextBlock Margin=""25,38,23,15"" FontSize=""13.5"" IsHitTestVisible=""False"" Text=""{cave}"" TextWrapping=""Wrap"" Foreground=""{DynamicResource ColorBrush1}"" />
@@ -61,64 +61,67 @@ Public Class PageLaunchRight
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
</local:MyCard>"
Case 2
Log("[Page] 主页预设:Minecraft 新闻")
Logger.Info("主页预设:Minecraft 新闻")
Url = "https://mcnews.meloong.com"
Case 3
Log("[Page] 主页预设:简单主页")
Logger.Info("主页预设:简单主页")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/MFn233/Custom.xaml"
Case 4
Log("[Page] 主页预设:每日整合包推荐")
Logger.Info("主页预设:每日整合包推荐")
Url = "https://pclsub.sodamc.com/"
Case 5
Log("[Page] 主页预设:Minecraft 皮肤推荐")
Logger.Info("主页预设:Minecraft 皮肤推荐")
Url = "https://forgepixel.com/pcl_sub_file"
Case 6
Log("[Page] 主页预设:OpenBMCLAPI 仪表盘 Lite")
Logger.Info("主页预设:OpenBMCLAPI 仪表盘 Lite")
Url = "https://pcl-bmcl.milu.ink/"
Case 7
Log("[Page] 主页预设:主页市场")
Logger.Info("主页预设:主页市场")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/p/Homepages/Homepage.Market/Custom.xaml"
Case 8
Log("[Page] 主页预设:更新日志")
Logger.Info("主页预设:更新日志")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/Joker2184/UpdateHomepage.xaml"
Case 9
Log("[Page] 主页预设:PCL 新功能说明书")
Logger.Info("主页预设:PCL 新功能说明书")
Url = "https://raw.gitcode.com/WForst-Breeze/WhatsNewPCL/raw/main/Custom.xaml"
Case 10
Log("[Page] 主页预设:OpenMCIM Dashboard")
Logger.Info("主页预设:OpenMCIM Dashboard")
Url = "https://files.mcimirror.top/PCL"
Case 11
Log("[Page] 主页预设:杂志主页")
Logger.Info("主页预设:杂志主页")
Url = "http://118.195.192.193:26995/d/magazine-homepage-pcl/Custom.xaml"
Case 12
Log("[Page] 主页预设:PCL GitHub 仪表盘")
Url = "https://ddf.pcl-community.org/Custom.xaml"
Logger.Info("主页预设:PCL GitHub 仪表盘")
Url = "https://ddf.pcl-community.top/Custom.xaml"
Case 13
Log("[Page] 主页预设:PCL 更新摘要")
Logger.Info("主页预设:PCL 更新摘要")
Url = "https://raw.gitcode.com/ENC_Euphony/PCL-AI-Summary-HomePage/raw/master/Custom.xaml"
Case 14
Log("[Page] 主页预设:今日新闻热点")
Logger.Info("主页预设:今日新闻热点")
Url = "https://pcl.wyc-w.top/index.xaml"
Case 15
Log("[Page] 主页预设:Minecraft 芝士站")
Logger.Info("主页预设:Minecraft 芝士站")
Url = "https://www.xxag.top/mkss"
Case 16
Logger.Info("主页预设:整合包推荐引擎")
Url = "https://qawsedrftgyhujiko.fun/pcl2/Custom.xaml"
End Select
End Select
'联网下载
If Not String.IsNullOrWhiteSpace(Url) Then
If Url = Settings.Get("CacheSavedPageUrl") AndAlso File.Exists(PathTemp & "Cache\Custom.xaml") Then
If Url = Settings.Get(Of String)("CacheSavedPageUrl") AndAlso FileUtils.Exists(PathTemp & "Cache\Custom.xaml") Then
'缓存可用
Log("[Page] 主页自定义数据来源:联网缓存文件")
Content = ReadFile(PathTemp & "Cache\Custom.xaml")
Logger.Info("主页自定义数据来源:联网缓存文件")
Content = FileUtils.TryReadAsString(PathTemp & "Cache\Custom.xaml")
'后台更新缓存
OnlineLoader.Start(New Tuple(Of String, Boolean)(Url, False))
OnlineLoader.Start((Url, False))
Else
'缓存不可用
Log("[Page] 主页自定义数据来源:联网全新下载")
Logger.Info("主页自定义数据来源:联网全新下载")
Hint("正在加载主页……")
RunInUiWait(Sub() LoadContent(Nothing)) '在加载结束前清空页面
Settings.Set("CacheSavedPageVersion", "")
OnlineLoader.Start(New Tuple(Of String, Boolean)(Url, True)) '下载完成后将会再次触发更新
OnlineLoader.Start((Url, True)) '下载完成后将会再次触发更新
Return
End If
End If
@@ -128,10 +131,10 @@ Public Class PageLaunchRight
Private RefreshLock As New Object
'联网获取主页文件
Private OnlineLoader As New LoaderTask(Of Tuple(Of String, Boolean), Integer)("下载主页", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
Private Sub OnlineLoaderSub(Task As LoaderTask(Of Tuple(Of String, Boolean), Integer))
Dim Address As String = Task.Input.Item1 '#3721 中连续触发两次导致内容变化
Dim ShouldRefresh As Boolean = Task.Input.Item2
Private OnlineLoader As New LoaderTask(Of (Address As String, ShouldRefresh As Boolean), Integer)("下载主页", AddressOf OnlineLoaderSub) With {.ReloadTimeout = 10 * 60 * 1000}
Private Sub OnlineLoaderSub(Task As LoaderTask(Of (Address As String, ShouldRefresh As Boolean), Integer))
Dim Address As String = Task.Input.Address '#3721 中连续触发两次导致内容变化
Dim ShouldRefresh As Boolean = Task.Input.ShouldRefresh
Try
'替换自定义变量与设置
Address = ArgumentReplace(Address, AddressOf WebUtility.HtmlEncode)
@@ -150,26 +153,26 @@ Public Class PageLaunchRight
Try
Version = NetRequestByClientRetry(VersionAddress)
If Version.Length > 1000 Then Throw New Exception($"获取的主页版本过长({Version.Length} 字符)")
Dim CurrentVersion As String = Settings.Get("CacheSavedPageVersion")
Dim CurrentVersion As String = Settings.Get(Of String)("CacheSavedPageVersion")
If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then
Log($"[Page] 当前缓存的主页已为最新,当前版本:{Version},检查源:{VersionAddress}")
Logger.Info($"当前缓存的主页已为最新,当前版本:{Version},检查源:{VersionAddress}")
Return
End If
Log($"[Page] 需要下载联网主页,当前版本:{Version},检查源:{VersionAddress}")
Logger.Info($"需要下载联网主页,当前版本:{Version},检查源:{VersionAddress}")
Catch exx As Exception
Log(exx, $"联网获取主页版本失败", NotifyLevel.DevelopOnly)
Log($"[Page] 无法检查联网主页版本,将直接下载,检查源:{VersionAddress}")
Logger.Warn(exx, $"联网获取主页版本失败")
Logger.Info($"无法检查联网主页版本,将直接下载,检查源:{VersionAddress}")
End Try
'实际下载
Dim FileContent As String = NetRequestByClientRetry(Address)
Log($"[Page] 已联网下载主页,内容长度:{FileContent.Length},来源:{Address}")
Logger.Info($"已联网下载主页,内容长度:{FileContent.Length},来源:{Address}")
Settings.Set("CacheSavedPageUrl", Address)
Settings.Set("CacheSavedPageVersion", Version)
FileUtils.Write(PathTemp & "Cache\Custom.xaml", FileContent)
'若内容变更则要求刷新
If LoadedContentHash <> FileContent.GetHashCode() AndAlso ShouldRefresh Then Refresh()
Catch ex As Exception
Log(ex, $"下载主页失败({Address})", If(ModeDebug, NotifyLevel.MsgBox, NotifyLevel.AllUsers))
Logger.Error(ex, $"下载主页失败({Address})", If(ModeDebug, LogBehavior.Alert, LogBehavior.Toast))
End Try
End Sub
@@ -178,7 +181,7 @@ Public Class PageLaunchRight
''' 必须在 UI 线程调用。
''' </summary>
Public Sub ForceRefresh() Implements IRefreshable.Refresh
Log("[Page] 要求强制刷新主页")
Logger.Info("要求强制刷新主页")
ClearCache()
'实际的刷新
If FrmMain.PageCurrent.Page = FormMain.PageType.Launch Then
@@ -194,10 +197,10 @@ Public Class PageLaunchRight
''' </summary>
Private Sub ClearCache()
LoadedContentHash = -1
OnlineLoader.Input = New Tuple(Of String, Boolean)("", True)
OnlineLoader.Input = ("", True)
Settings.Set("CacheSavedPageUrl", "")
Settings.Set("CacheSavedPageVersion", "")
Log("[Page] 已清空主页缓存")
Logger.Info("已清空主页缓存")
End Sub
''' <summary>
@@ -214,7 +217,7 @@ Public Class PageLaunchRight
'实际加载内容
PanCustom.Children.Clear()
If String.IsNullOrWhiteSpace(Content) Then
Log($"[Page] 实例化:清空主页 UI,来源为空")
Logger.Info($"实例化:清空主页 UI,来源为空")
Return
End If
Dim LoadStartTime As Date = Date.Now
@@ -223,16 +226,16 @@ Public Class PageLaunchRight
Do While Content.Contains("xmlns")
Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Loop
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Log($"[Page] 实例化:加载主页 UI 开始,最终内容长度:{Content.Count}")
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"" xmlns:core=""clr-namespace:MeloongCore;assembly=MeloongCore"" xmlns:corewpf=""clr-namespace:MeloongCore.Wpf;assembly=MeloongCore.Wpf"">" & Content & "</StackPanel>"
Logger.Info($"实例化:加载主页 UI 开始,最终内容长度:{Content.Count}")
PanCustom.Children.Add(GetObjectFromXML(Content))
'加载计时
Dim LoadCostTime = (Date.Now - LoadStartTime).Milliseconds
Log($"[Page] 实例化:加载主页 UI 完成,耗时 {LoadCostTime}ms")
Logger.Info($"实例化:加载主页 UI 完成,耗时 {LoadCostTime}ms")
If LoadCostTime > 3000 Then Hint($"主页加载过于缓慢(花费了 {Math.Round(LoadCostTime / 1000, 1)} 秒),请向主页作者反馈此问题,或暂时停止使用该主页")
End SyncLock
Catch ex As Exception
Log(ex, "加载失败的主页内容:" & vbCrLf & Content)
Logger.Warn(ex, $"加载失败的主页内容:{vbCrLf}{Content}")
OnLoadContentFailed(ex)
End Try
End Sub
@@ -240,12 +243,12 @@ Public Class PageLaunchRight
''' 加载主页失败时调用。
''' </summary>
Private Sub OnLoadContentFailed(ex As Exception)
If ModeDebug OrElse Settings.Get("UiCustomType") = 1 Then
Log(ex, "加载主页失败")
If MyMsgBox(If(TypeOf ex Is UnauthorizedAccessException, ex.Message, $"主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{ex.GetBrief}"),
If ModeDebug OrElse Settings.Get(Of Integer)("UiCustomType") = 1 Then
Logger.Warn(ex, "加载主页失败")
If MyMsgBox(If(TypeOf ex Is UnauthorizedAccessException, ex.Message, $"主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{ex.GetDisplay(False)}"),
"加载主页失败", "重试", "取消") = 1 Then ForceRefresh()
Else
Log(ex, "加载主页失败", NotifyLevel.AllUsers)
Logger.Error(ex, "加载主页失败", LogBehavior.Toast)
End If
End Sub
''' <summary>
@@ -5,20 +5,20 @@
''' </summary>
Public Sub Reload(KeepInput As Boolean)
'记住密码
CheckRemember.Checked = Settings.Get("LoginRemember")
CheckRemember.Checked = Settings.Get(Of Boolean)("LoginRemember")
If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载,导致文本框里没东西
'保留输入,只刷新下拉框列表
Dim Input As String = ComboName.Text
ComboName.ItemsSource = If(Settings.Get("LoginAuthEmail") = "", Nothing, Settings.Get("LoginAuthEmail").ToString.Split("¨"))
ComboName.ItemsSource = If(Settings.Get(Of String)("LoginAuthEmail") = "", Nothing, Settings.Get(Of String)("LoginAuthEmail").Split("¨"))
ComboName.Text = Input
Else
'不保留输入,刷新列表后自动选择第一项
If Settings.Get("LoginAuthEmail") = "" Then
If Settings.Get(Of String)("LoginAuthEmail") = "" Then
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Settings.Get("LoginAuthEmail").ToString.Split("¨")
ComboName.Text = Settings.Get("LoginAuthEmail").ToString.BeforeFirst("¨")
If Settings.Get("LoginRemember") Then TextPass.Password = Settings.Get("LoginAuthPass").ToString.BeforeFirst("¨").Trim
ComboName.ItemsSource = Settings.Get(Of String)("LoginAuthEmail").Split("¨")
ComboName.Text = Settings.Get(Of String)("LoginAuthEmail").BeforeFirst("¨")
If Settings.Get(Of Boolean)("LoginRemember") Then TextPass.Password = Settings.Get(Of String)("LoginAuthPass").BeforeFirst("¨").Trim
End If
End If
IsFirstLoad = False
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。
''' </summary>
Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheAuthServerServer"), Settings.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver"
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get(Of String)("CacheAuthServerServer"), Settings.Get(Of String)("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver"
If FrmLoginAuth Is Nothing Then
Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = "", .Password = "", .Description = "Authlib-Injector", .Type = McLoginType.Auth}
Else
@@ -55,10 +55,10 @@
If AniControlEnabled = 0 Then Settings.Set("CacheAuthAccess", "")
End Sub
Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged
If sender.SelectedIndex = -1 OrElse Not Settings.Get("LoginRemember") Then
If sender.SelectedIndex = -1 OrElse Not Settings.Get(Of Boolean)("LoginRemember") Then
TextPass.Password = ""
Else
TextPass.Password = Settings.Get("LoginAuthPass").ToString.Split("¨")(sender.SelectedIndex).Trim
TextPass.Password = Settings.Get(Of String)("LoginAuthPass").ToString.Split("¨")(sender.SelectedIndex).Trim
End If
End Sub
Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change
@@ -71,15 +71,15 @@
End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then
OpenWebsite(If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister")))
OpenWebsite(If(McInstanceSelected IsNot Nothing, Settings.Get(Of String)("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get(Of String)("CacheAuthServerRegister")))
Else
Dim Website As String = If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister"))
Dim Website As String = If(McInstanceSelected IsNot Nothing, Settings.Get(Of String)("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get(Of String)("CacheAuthServerRegister"))
OpenWebsite(Website.Replace("/auth/register", "/auth/forgot"))
End If
End Sub
'切换注册按钮可见性
Private Sub ReloadRegisterButton() Handles Me.Loaded
Dim Address As String = If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister"))
Dim Address As String = If(McInstanceSelected IsNot Nothing, Settings.Get(Of String)("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get(Of String)("CacheAuthServerRegister"))
BtnLink.Visibility = If(String.IsNullOrEmpty(New ValidateHttp().Validate(Address)), Visibility.Visible, Visibility.Collapsed)
End Sub
@@ -12,17 +12,17 @@
''' 刷新页面显示的所有信息。
''' </summary>
Public Sub Reload(KeepInput As Boolean)
TextName.Text = Settings.Get("CacheAuthName")
TextEmail.Text = Settings.Get("CacheAuthUsername")
TextEmail.Visibility = If(Settings.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible)
TextName.Text = Settings.Get(Of String)("CacheAuthName")
TextEmail.Text = Settings.Get(Of String)("CacheAuthUsername")
TextEmail.Visibility = If(Settings.Get(Of Boolean)("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible)
PageLoginLegacy_Loaded()
End Sub
''' <summary>
''' 获取当前页面的登录信息。
''' </summary>
Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheAuthServerServer"), Settings.Get("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver"
Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = Settings.Get("CacheAuthUsername"), .Password = Settings.Get("CacheAuthPass"), .Description = "Authlib-Injector", .Type = McLoginType.Auth}
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get(Of String)("CacheAuthServerServer"), Settings.Get(Of String)("VersionServerAuthServer", Instance:=McInstanceSelected)) & "/authserver"
Return New McLoginServer(McLoginType.Auth) With {.Token = "Auth", .BaseUrl = Server, .UserName = Settings.Get(Of String)("CacheAuthUsername"), .Password = Settings.Get(Of String)("CacheAuthPass"), .Description = "Authlib-Injector", .Type = McLoginType.Auth}
End Function
Private Sub PageLoginAuthSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter
@@ -46,7 +46,7 @@
Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click
If McLoginLoader.State = LoadState.Loading Then
Log("[Launch] 要求更换角色,但登录加载器繁忙", NotifyLevel.DebugModeOnly)
Logger.Warn("要求更换角色,但登录加载器繁忙")
If TypeOf McLoginLoader.Input Is McLoginServer AndAlso CType(McLoginLoader.Input, McLoginServer).ForceReselectProfile Then
Hint("正在尝试更换,请稍候!")
Else
@@ -65,7 +65,7 @@
McLoginLoader.WaitForExit(Data, IsForceRestart:=True)
RunInUi(Sub() Reload(True))
Catch ex As Exception
Log(ex, "更换角色失败", NotifyLevel.AllUsers)
Logger.Error(ex, "更换角色失败", LogBehavior.Toast)
End Try
End Sub)
End Sub
@@ -78,7 +78,7 @@
End Sub
Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click
Dim Address As String = If(McInstanceSelected IsNot Nothing, Settings.Get("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get("CacheAuthServerRegister"))
Dim Address As String = If(McInstanceSelected IsNot Nothing, Settings.Get(Of String)("VersionServerAuthRegister", Instance:=McInstanceSelected), Settings.Get(Of String)("CacheAuthServerRegister"))
If String.IsNullOrEmpty(New ValidateHttp().Validate(Address)) Then OpenWebsite(Address.Replace("/auth/register", "/user/closet"))
End Sub
@@ -18,15 +18,15 @@ Public Class PageLoginLegacy
If KeepInput AndAlso IsReloaded Then '避免第一次就以 KeepInput 的方式加载,导致文本框里没东西
'保留输入,只刷新下拉框列表
Dim Input As String = ComboName.Text.Trim
ComboName.ItemsSource = If(Settings.Get("LoginLegacyName") = "", Nothing, Settings.Get("LoginLegacyName").ToString.Split("¨"))
ComboName.ItemsSource = If(Settings.Get(Of String)("LoginLegacyName") = "", Nothing, Settings.Get(Of String)("LoginLegacyName").Split("¨"))
ComboName.Text = Input
Else
'不保留输入,刷新列表后自动选择第一项
If Settings.Get("LoginLegacyName") = "" Then
If Settings.Get(Of String)("LoginLegacyName") = "" Then
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Settings.Get("LoginLegacyName").ToString.Split("¨")
ComboName.Text = Settings.Get("LoginLegacyName").ToString.BeforeFirst("¨").Trim
ComboName.ItemsSource = Settings.Get(Of String)("LoginLegacyName").ToString.Split("¨")
ComboName.Text = Settings.Get(Of String)("LoginLegacyName").ToString.BeforeFirst("¨").Trim
End If
End If
IsReloaded = True
@@ -36,7 +36,7 @@ Public Class PageLoginLegacy
''' </summary>
Public Shared Function GetLoginData() As McLoginData
Dim UserName As String = If(FrmLoginLegacy Is Nothing, "", FrmLoginLegacy.ComboName.Text.Replace("¨", "").Trim)
Return New McLoginLegacy With {.UserName = UserName, .SkinType = Settings.Get("LaunchSkinType"), .SkinName = Settings.Get("LaunchSkinID")}
Return New McLoginLegacy With {.UserName = UserName, .SkinType = Settings.Get(Of Integer)("LaunchSkinType"), .SkinName = Settings.Get(Of String)("LaunchSkinID")}
End Function
''' <summary>
''' 当前页面的登录信息是否有效。
@@ -62,12 +62,12 @@ Public Class PageLoginLegacy
End If
End Sub
Private Sub ComboLegacy_TextChanged(sender As Object, e As TextChangedEventArgs) Handles ComboName.TextChanged
If Settings.Get("LaunchSkinType") = 0 Then PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
HintChinese.Visibility = If(RegexCheck(ComboName.Text, "^[0-9A-Za-z_]*$"), Visibility.Collapsed, Visibility.Visible)
If Settings.Get(Of Integer)("LaunchSkinType") = 0 Then PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
HintChinese.Visibility = If(ComboName.Text.RegexCheck("^[0-9A-Za-z_]*$"), Visibility.Collapsed, Visibility.Visible)
RunInUi(Sub() PanMain.InvalidateMeasure(), True) '由于 WPF 的 Bug,它不一定会自动更新 HintChinese 的大小(#6627)
End Sub
Private Sub Skin_Click() Handles Skin.Click
If (Settings.Get("UiHiddenPageSetup") OrElse Settings.Get("UiHiddenSetupLaunch")) AndAlso Not PageSetupUI.HiddenForceShow Then
If (Settings.Get(Of Boolean)("UiHiddenPageSetup") OrElse Settings.Get(Of Boolean)("UiHiddenSetupLaunch")) AndAlso Not PageSetupUI.HiddenForceShow Then
Hint("启动设置已被禁用!", HintType.Red)
Else
FrmMain.PageChange(FormMain.PageType.Setup, FormMain.PageSubType.SetupLaunch) '切换到皮肤设置页面
@@ -9,7 +9,7 @@
ComboAccounts.Items.Clear()
ComboAccounts.Items.Add(New MyComboBoxItem With {.Content = "添加新账号"})
Try
Dim MsJson As JObject = GetJson(Settings.Get("LoginMsJson"))
Dim MsJson As JObject = GetJson(Settings.Get(Of String)("LoginMsJson"))
For Each Account In MsJson
Dim Item As MyListItem = CType(FindResource("ComboBoxItemTemplateWithDelete"), DataTemplate).LoadContent()
Item.Tag = Account.Value.ToString
@@ -18,7 +18,7 @@
ComboAccounts.Items.Add(Item)
Next
Catch ex As Exception
Log(ex, $"微软登录信息出错,登录信息已被重置({Settings.Get("LoginMsJson")})", NotifyLevel.AllUsers)
Logger.Error(ex, $"微软登录信息出错,登录信息已被重置({Settings.Get(Of String)("LoginMsJson")})", LogBehavior.Toast)
Settings.Set("LoginMsJson", "{}")
End Try
'如果不保留输入,刷新列表后自动选择第一项
@@ -37,7 +37,7 @@
''' 获取当前页面的登录信息。
''' </summary>
Public Shared Function GetLoginData() As McLoginMs
If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Settings.Get("CacheMsV2OAuthRefresh"), .UserName = Settings.Get("CacheMsV2Name")}
If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Settings.Get(Of String)("CacheMsV2OAuthRefresh"), .UserName = Settings.Get(Of String)("CacheMsV2Name")}
Dim Result As McLoginMs = Nothing
RunInUiWait(
Sub()
@@ -92,9 +92,9 @@
ElseIf ex.Message.StartsWithF("$") Then
Hint(ex.Message.TrimStart("$"), HintType.Red)
ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.Contains("SSL/TLS") Then
Log(ex, "正版登录验证失败,请考虑在 [设置 → 其他] 中关闭 [在正版登录时验证 SSL 证书],然后再试。" & vbCrLf & vbCrLf & "原始错误信息:", NotifyLevel.MsgBox)
Logger.Error(ex, $"正版登录验证失败,请考虑在 [设置 → 其他] 中关闭 [在正版登录时验证 SSL 证书],然后再试。{vbCrLf}{vbCrLf}原始错误信息:", LogBehavior.Alert)
Else
Log(ex, "正版登录尝试失败", NotifyLevel.MsgBox)
Logger.Error(ex, "正版登录尝试失败", LogBehavior.Alert)
End If
Finally
RunInUi(
@@ -12,7 +12,7 @@
''' 刷新页面显示的所有信息。
''' </summary>
Public Sub Reload(KeepInput As Boolean)
TextName.Text = Settings.Get("CacheMsV2Name")
TextName.Text = Settings.Get(Of String)("CacheMsV2Name")
'皮肤在 Loaded 加载
End Sub
''' <summary>
@@ -20,9 +20,9 @@
''' </summary>
Public Shared Function GetLoginData() As McLoginMs
If McLoginMsLoader.State = LoadState.Finished Then
Return New McLoginMs With {.OAuthRefreshToken = Settings.Get("CacheMsV2OAuthRefresh"), .UserName = Settings.Get("CacheMsV2Name"), .AccessToken = Settings.Get("CacheMsV2Access"), .Uuid = Settings.Get("CacheMsV2Uuid"), .ProfileJson = Settings.Get("CacheMsV2ProfileJson")}
Return New McLoginMs With {.OAuthRefreshToken = Settings.Get(Of String)("CacheMsV2OAuthRefresh"), .UserName = Settings.Get(Of String)("CacheMsV2Name"), .AccessToken = Settings.Get(Of String)("CacheMsV2Access"), .Uuid = Settings.Get(Of String)("CacheMsV2Uuid"), .ProfileJson = Settings.Get(Of String)("CacheMsV2ProfileJson")}
Else
Return New McLoginMs With {.OAuthRefreshToken = Settings.Get("CacheMsV2OAuthRefresh"), .UserName = Settings.Get("CacheMsV2Name")}
Return New McLoginMs With {.OAuthRefreshToken = Settings.Get(Of String)("CacheMsV2OAuthRefresh"), .UserName = Settings.Get(Of String)("CacheMsV2Name")}
End If
End Function
@@ -49,6 +49,7 @@
Settings.Set("CacheMsV2ProfileJson", "")
Settings.Set("CacheMsV2Uuid", "")
Settings.Set("CacheMsV2Name", "")
Settings.Set("CacheMsV2Expires", 0L)
McLoginMsLoader.Interrupt()
FrmLaunchLeft.RefreshPage(False, True)
End Sub
@@ -88,14 +89,18 @@ Retry:
Thread.Sleep(10)
Loop
If McLoginMsLoader.State = LoadState.Failed Then Throw New Exception("登录失败", McLoginMsLoader.Error)
Dim AccessToken As String = Settings.Get("CacheMsV2Access")
Dim Uuid As String = Settings.Get("CacheMsV2Uuid")
Dim Result As String = NetRequestByClientRetry("https://api.minecraftservices.com/minecraft/profile/skins", HttpMethod.Post,
Content:=New Net.Http.MultipartFormDataContent From {
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
{New Net.Http.ByteArrayContent(ReadFileBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)}
},
Headers:={{"Authorization", "Bearer " & AccessToken}, {"Accept", "*/*"}, {"User-Agent", "MojangSharp/0.1"}})
Dim AccessToken As String = Settings.Get(Of String)("CacheMsV2Access")
Dim Uuid As String = Settings.Get(Of String)("CacheMsV2Uuid")
Dim Result As String = Nothing
ResilientUtils.Retry( 'MultipartFormDataContent 在一次请求后就会被 Dispose,所以不能直接 Retry(#8397)
Sub()
Result = NetRequestByClient("https://api.minecraftservices.com/minecraft/profile/skins", HttpMethod.Post,
Content:=New Net.Http.MultipartFormDataContent From {
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
{New Net.Http.ByteArrayContent(FileUtils.ReadAsBytes(SkinInfo.LocalFile)), "file", PathUtils.GetLastPart(SkinInfo.LocalFile)}
},
Headers:={{"Authorization", "Bearer " & AccessToken}, {"Accept", "*/*"}, {"User-Agent", "MojangSharp/0.1"}})
End Sub, 3)
If Result.Contains("request requires user authentication") Then
Hint("正在重新登录,将在登录后自动更改皮肤……")
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
@@ -105,7 +110,7 @@ Retry:
Return
End If
'获取新皮肤地址
Log("[Skin] 皮肤修改返回值:" & vbCrLf & Result)
Logger.Info($"皮肤修改返回值:{vbCrLf}{Result}")
Dim ResultJson As JObject = GetJson(Result)
If ResultJson.ContainsKey("errorMessage") Then Throw New Exception(ResultJson("errorMessage").ToString) '#5309
For Each Skin As JObject In ResultJson("skins")
@@ -116,15 +121,15 @@ Retry:
Next
Throw New Exception("未知错误(" & Result & ")")
Catch ex As Exception
If TypeOf ex Is OperationCanceledException OrElse TypeOf ex Is TimeoutException Then
If ex.IsBadNetwork Then
Hint("更改皮肤失败:连接皮肤服务器超时,请稍后再试,或使用 VPN 改善网络环境", HintType.Red)
ElseIf TypeOf ex Is ResponsedWebException AndAlso CType(ex, ResponsedWebException).StatusCode = HttpStatusCode.Unauthorized Then
Log(ex, "更改皮肤时遭遇 401 错误", NotifyLevel.DevelopOnly)
ElseIf TypeOf ex Is HttpRequestCodeException AndAlso CType(ex, HttpRequestCodeException).StatusCode = HttpStatusCode.Unauthorized Then
Logger.Warn(ex, "更改皮肤时遭遇 401 错误")
Hint("正在重新登录,将在登录后自动更改皮肤……")
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
GoTo Retry
Else
Log(ex, "更改皮肤失败", NotifyLevel.AllUsers)
Logger.Error(ex, "更改皮肤失败", LogBehavior.Toast)
End If
Finally
IsChanging = False
@@ -5,20 +5,20 @@
''' </summary>
Public Sub Reload(KeepInput As Boolean)
'记住密码
CheckRemember.Checked = Settings.Get("LoginRemember")
CheckRemember.Checked = Settings.Get(Of Boolean)("LoginRemember")
If KeepInput AndAlso Not IsFirstLoad Then '避免第一次就以 KeepInput 的方式加载,导致文本框里没东西
'保留输入,只刷新下拉框列表
Dim Input As String = ComboName.Text
ComboName.ItemsSource = If(Settings.Get("LoginNideEmail") = "", Nothing, Settings.Get("LoginNideEmail").ToString.Split("¨"))
ComboName.ItemsSource = If(Settings.Get(Of String)("LoginNideEmail") = "", Nothing, Settings.Get(Of String)("LoginNideEmail").ToString.Split("¨"))
ComboName.Text = Input
Else
'不保留输入,刷新列表后自动选择第一项
If Settings.Get("LoginNideEmail") = "" Then
If Settings.Get(Of String)("LoginNideEmail") = "" Then
ComboName.ItemsSource = Nothing
Else
ComboName.ItemsSource = Settings.Get("LoginNideEmail").ToString.Split("¨")
ComboName.Text = Settings.Get("LoginNideEmail").ToString.BeforeFirst("¨")
If Settings.Get("LoginRemember") Then TextPass.Password = Settings.Get("LoginNidePass").ToString.BeforeFirst("¨").Trim
ComboName.ItemsSource = Settings.Get(Of String)("LoginNideEmail").Split("¨")
ComboName.Text = Settings.Get(Of String)("LoginNideEmail").BeforeFirst("¨")
If Settings.Get(Of Boolean)("LoginRemember") Then TextPass.Password = Settings.Get(Of String)("LoginNidePass").BeforeFirst("¨").Trim
End If
End If
IsFirstLoad = False
@@ -27,7 +27,7 @@
''' 获取当前页面的登录信息。
''' </summary>
Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheNideServer"), Settings.Get("VersionServerNide", Instance:=McInstanceSelected))
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get(Of String)("CacheNideServer"), Settings.Get(Of String)("VersionServerNide", Instance:=McInstanceSelected))
If FrmLoginNide Is Nothing Then
Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = "", .Password = "", .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
Else
@@ -55,10 +55,10 @@
If AniControlEnabled = 0 Then Settings.Set("CacheNideAccess", "")
End Sub
Private Sub ComboName_SelectionChanged(sender As MyComboBox, e As SelectionChangedEventArgs) Handles ComboName.SelectionChanged
If sender.SelectedIndex = -1 OrElse Not Settings.Get("LoginRemember") Then
If sender.SelectedIndex = -1 OrElse Not Settings.Get(Of Boolean)("LoginRemember") Then
TextPass.Password = ""
Else
TextPass.Password = Settings.Get("LoginNidePass").ToString.Split("¨")(sender.SelectedIndex).Trim
TextPass.Password = Settings.Get(Of String)("LoginNidePass").Split("¨")(sender.SelectedIndex).Trim
End If
End Sub
Private Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckRemember.Change
@@ -71,7 +71,7 @@
End Sub
Private Sub Btn_Click(sender As Object, e As EventArgs) Handles BtnLink.Click
If BtnLink.Content = "注册账号" Then
OpenWebsite("https://login.mc-user.com:233/" & Settings.Get("VersionServerNide", Instance:=McInstanceSelected) & "/register")
OpenWebsite("https://login.mc-user.com:233/" & Settings.Get(Of String)("VersionServerNide", Instance:=McInstanceSelected) & "/register")
Else
OpenWebsite("https://login.mc-user.com:233/account/login")
End If
@@ -12,17 +12,17 @@
''' 刷新页面显示的所有信息。
''' </summary>
Public Sub Reload(KeepInput As Boolean)
TextName.Text = Settings.Get("CacheNideName")
TextEmail.Text = Settings.Get("CacheNideUsername")
TextEmail.Visibility = If(Settings.Get("UiLauncherEmail"), Visibility.Collapsed, Visibility.Visible)
TextName.Text = Settings.Get(Of String)("CacheNideName")
TextEmail.Text = Settings.Get(Of String)("CacheNideUsername")
TextEmail.Visibility = (Not Settings.Get(Of Boolean)("UiLauncherEmail")).ToVisibility
'皮肤在 Loaded 加载
End Sub
''' <summary>
''' 获取当前页面的登录信息。
''' </summary>
Public Shared Function GetLoginData() As McLoginServer
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get("CacheNideServer"), Settings.Get("VersionServerNide", Instance:=McInstanceSelected))
Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = Settings.Get("CacheNideUsername"), .Password = Settings.Get("CacheNidePass"), .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
Dim Server As String = If(IsNothing(McInstanceSelected), Settings.Get(Of String)("CacheNideServer"), Settings.Get(Of String)("VersionServerNide", Instance:=McInstanceSelected))
Return New McLoginServer(McLoginType.Nide) With {.Token = "Nide", .UserName = Settings.Get(Of String)("CacheNideUsername"), .Password = Settings.Get(Of String)("CacheNidePass"), .Description = "统一通行证", .Type = McLoginType.Nide, .BaseUrl = "https://auth.mc-user.com:233/" & Server & "/authserver"}
End Function
Private Sub PageLoginNideSkin_MouseEnter(sender As Object, e As MouseEventArgs) Handles PanData.MouseEnter
@@ -51,7 +51,7 @@
End Sub
Private Sub Skin_Click(sender As Object, e As MouseButtonEventArgs) Handles Skin.Click
OpenWebsite("https://login.mc-user.com:233/" & If(IsNothing(McInstanceSelected), Settings.Get("CacheNideServer"), Settings.Get("VersionServerNide", Instance:=McInstanceSelected)) & "/skin")
OpenWebsite("https://login.mc-user.com:233/" & If(IsNothing(McInstanceSelected), Settings.Get(Of String)("CacheNideServer"), Settings.Get(Of String)("VersionServerNide", Instance:=McInstanceSelected)) & "/skin")
End Sub
End Class
@@ -25,7 +25,7 @@ Public Class PageLinkMain
If LinkState = NewState Then Return
Dim OldState = LinkState
LinkState = NewState
Log($"[Link] 主状态由 {GetStringFromEnum(OldState)} 变更为 {GetStringFromEnum(NewState)}")
Logger.Info($"主状态由 {OldState} 变更为 {NewState}")
'触发状态切换
RunInUi(
Sub()
@@ -51,7 +51,7 @@ Public Class PageLinkMain
Case LoadState.Finished
ChangeState(LinkStates.Finished)
Case LoadState.Failed
Telemetry("联机失败", "Exception", FilterUserName(Loader.Error.GetDetail, "*"))
Telemetry("联机失败", "Exception", FilterUserName(Loader.Error.GetDisplay(True), "*"))
ChangeState(LinkStates.Failed)
End Select
End Sub
@@ -109,7 +109,7 @@ Public Class PageLinkMain
NetworkName = $"P{ServerPort.ConvertRadix(16).PadLeft(4, "0"c)}-{GenerateRandomCode()}"
NetworkSecret = GenerateRandomCode()
DiscoverNodeID = -1
Log($"[Link] 尝试创建房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort}")
Logger.Info($"尝试创建房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort}")
'启动
ChangeState(LinkStates.Loading)
End Sub
@@ -135,7 +135,7 @@ Public Class PageLinkMain
Return
End If
Code = FixCodeFormat(Code)
Log($"[Link] 实际使用的邀请码:{Code}")
Logger.Info($"实际使用的邀请码:{Code}")
'基础信息
IsServerSide = False
ServerPort = Code.Substring(1, 4).Upper.ConvertRadix(16, 10)
@@ -146,7 +146,7 @@ Public Class PageLinkMain
Else
DiscoverNodeID = Code.Substring(20, 3).Upper.ConvertRadix(16, 10)
End If
Log($"[Link] 尝试加入房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort},发现节点 {DiscoverNodeID}")
Logger.Info($"尝试加入房间,网络名 {NetworkName},网络密码 {NetworkSecret},端口 {ServerPort},发现节点 {DiscoverNodeID}")
'启动
LastCode = Code
ChangeState(LinkStates.Loading)
@@ -229,15 +229,15 @@ Public Class PageLinkMain
UpdateProgressBar(1)
'显示错误信息
LabLoadTitle.Text = FailReason
Dim Brief As String = LinkLoader.Error.GetBrief
Dim Brief As String = LinkLoader.Error.GetDisplay(False)
Dim InnerEx As Exception = LinkLoader.Error
If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message
Do Until InnerEx.InnerException Is Nothing
InnerEx = InnerEx.InnerException
If InnerEx.Message.StartsWithF("$") Then Brief = InnerEx.Message
Loop
LabLoadDesc.Text = If(Brief.StartsWithF("$"), Brief.TrimStart("$"), LinkLoader.Error.GetDetail)
Log(LinkLoader.Error, LabLoadTitle.Text)
LabLoadDesc.Text = If(Brief.StartsWithF("$"), Brief.TrimStart("$"), LinkLoader.Error.GetDisplay(True))
Logger.Warn(LinkLoader.Error, LabLoadTitle.Text)
End Sub
'===============================
@@ -247,7 +247,7 @@ Public Class PageLinkMain
Private Sub UpdateLoadingPage(Title As String, FailBrief As String)
If FailReason = FailBrief & "失败" Then Return
FailReason = FailBrief & "失败"
Log("[Link] 开始步骤:" & Title)
Logger.Info($"开始步骤:{Title}")
RunInUiWait(
Sub()
If FrmLinkMain Is Nothing OrElse Not FrmLinkMain.LabLoadDesc.IsLoaded Then Return
@@ -451,21 +451,21 @@ Public Class PageLinkMain
Case Reflection.ProcessorArchitecture.Arm
Architecture = "arm64"
Case Else
Log($"[Link] CPU 是不支持的 {Architecture} 架构,这可能会导致联机模块无法启动!", NotifyLevel.DebugModeOnly)
Logger.Warn($"CPU 是不支持的 {Architecture} 架构,这可能会导致联机模块无法启动!")
Architecture = "arm64"
End Select
Log("[Link] CPU 架构:" & Architecture)
Logger.Info($"CPU 架构:{Architecture}")
Telemetry("联机开始")
'检查 EasyTier 版本
UpdateLoadingPage("正在检查联机模块版本……", "检查联机模块版本")
If Not (File.Exists(PathEasyTier & "联机模块 CLI.exe") AndAlso File.Exists(PathEasyTier & "联机模块.exe") AndAlso
File.Exists(PathEasyTier & "Packet.dll")) Then
If Not (FileUtils.Exists(PathEasyTier & "联机模块 CLI.exe") AndAlso FileUtils.Exists(PathEasyTier & "联机模块.exe") AndAlso
FileUtils.Exists(PathEasyTier & "Packet.dll")) Then
Settings.Set("LinkEasyTierVersion", -1)
End If
Dim LocalVersion As Integer = Settings.Get("LinkEasyTierVersion")
Dim LocalVersion As Integer = Settings.Get(Of Integer)("LinkEasyTierVersion")
ServerVersion = ServerConfig("Link")("EasyTierVersion")
Dim RequiredFiles As New List(Of NetFile)
Log($"[Link] EasyTier 本地版本:{LocalVersion},需求版本:{ServerVersion}")
Logger.Info($"EasyTier 本地版本:{LocalVersion},需求版本:{ServerVersion}")
If LocalVersion < ServerVersion Then
RequiredFiles.Add(New NetFile(
ServerConfig("Link")("Downloads").Select(Function(UrlEntry) UrlEntry.ToString.Replace("{arch}", Architecture)),
@@ -481,28 +481,26 @@ Public Class PageLinkMain
Private Sub InitLaunch(Task As LoaderTask(Of Integer, Integer))
'解压文件
UpdateLoadingPage("正在解压联机模块……", "解压联机模块")
If File.Exists(PathEasyTier & "EasyTier.zip") Then
If FileUtils.Exists(PathEasyTier & "EasyTier.zip") Then
'解压
Dim ExtractPath As String = RequestTaskTempFolder()
ExtractCompressedFile(PathEasyTier & "EasyTier.zip", ExtractPath,
ProgressIncrementHandler:=Sub(Progress) Task.Progress += Progress * 0.05)
Dim ExtractedPath As String = New DirectoryInfo(ExtractPath).EnumerateDirectories.FirstOrDefault?.FullName
Log("[Link] 联机模块解压时的临时路径:" & ExtractedPath)
CopyDirectory(ExtractedPath, PathEasyTier)
FileUtils.ExtractToDirectory(PathEasyTier & "EasyTier.zip", ExtractPath,
progressHandler:=Sub(Percentage) Task.Progress = Percentage * 0.05)
DirectoryUtils.Copy(DirectoryUtils.GetDirectories(ExtractPath).First, PathEasyTier)
'重命名
File.Delete(PathEasyTier & "联机模块.exe")
File.Move(PathEasyTier & "easytier-core.exe", PathEasyTier & "联机模块.exe")
File.Delete(PathEasyTier & "联机模块 CLI.exe")
File.Move(PathEasyTier & "easytier-cli.exe", PathEasyTier & "联机模块 CLI.exe")
FileUtils.Delete(PathEasyTier & "联机模块.exe")
FileUtils.Move(PathEasyTier & "easytier-core.exe", PathEasyTier & "联机模块.exe")
FileUtils.Delete(PathEasyTier & "联机模块 CLI.exe")
FileUtils.Move(PathEasyTier & "easytier-cli.exe", PathEasyTier & "联机模块 CLI.exe")
'清理
File.Delete(PathEasyTier & "EasyTier.zip")
FileUtils.Delete(PathEasyTier & "EasyTier.zip")
Settings.Set("LinkEasyTierVersion", ServerVersion)
End If
Task.Progress = 0.07
'获取节点列表
UpdateLoadingPage("正在获取节点列表……", "获取节点列表")
Dim RawPeers As List(Of String)
Dim CustomPeers As String = Settings.Get("LinkCustomPeer")
Dim CustomPeers As String = Settings.Get(Of String)("LinkCustomPeer")
If String.IsNullOrWhiteSpace(CustomPeers) Then
If DiscoverNodeID = -2 AndAlso Not IsServerSide Then
Panic("未填写自定义节点设置", $"$你必须在 {vbLQ}自定义节点{vbRQ} 设置中填写与房主相同的内容,{vbCrLf}才能进入该房间!")
@@ -512,7 +510,7 @@ Public Class PageLinkMain
Else
If DiscoverNodeID <> -2 AndAlso Not IsServerSide Then Hint("房主可能没有使用自定义节点设置,请确认你们的自定义节点设置是否一致!")
RawPeers = CustomPeers.Split(",,".ToCharArray).Select(Function(p) p.Trim).Where(Function(p) Not String.IsNullOrEmpty(p)).ToList()
Log("[Link] 使用自定义节点:" & CustomPeers)
Logger.Info($"使用自定义节点:{CustomPeers}")
End If
Task.Progress = 0.13
'获取空闲端口
@@ -539,7 +537,7 @@ Public Class PageLinkMain
For Each Peer As String In RawPeers
Arguments += $" -p=""{Peer}"""
Next
If Settings.Get("LinkLatencyMode") = 1 Then Arguments += " --latency-first"
If Settings.Get(Of Integer)("LinkLatencyMode") = 1 Then Arguments += " --latency-first"
'启动进程
ProcessStart(Arguments)
Task.Progress = 0.15
@@ -553,7 +551,7 @@ Public Class PageLinkMain
'查找目标节点
Dim Ping = GetPeerPing()
If Ping > 0 Then
Log($"[Link] 已与目标建立连接,当前 Ping 为 {Ping:0.0}ms")
Logger.Info($"已与目标建立连接,当前 Ping 为 {Ping:0.0}ms")
Telemetry("联机成功", "Server", IsServerSide, "NAT", NATType)
Exit Do '退出循环
End If
@@ -616,7 +614,7 @@ Public Class PageLinkMain
Try
RawNodes = GetJson(NetRequestByClient("https://uptime.easytier.cn/api/nodes?page=1&per_page=1000", RequireJson:=True))
Catch exx As Exception
Log(exx, "从源站获取节点列表失败,将使用 CDN 缓存")
Logger.Warn(exx, "从源站获取节点列表失败,将使用 CDN 缓存")
RawNodes = GetJson(NetRequestByClientRetry("https://easytier.meloong.com/?page=1&per_page=1000", RequireJson:=True))
IsFallbackRawList = True
End Try
@@ -654,18 +652,18 @@ ForcedPass:
ElseIf DiscoverNodeID > 0 Then '>0:作为加入者,根据 ID 选择对应的发现节点;如果没有,使用回退发现节点
SelectedDiscoverNode = Nodes.FirstOrDefault(Function(n) n("id").ToObject(Of Integer) = DiscoverNodeID)
If SelectedDiscoverNode Is Nothing Then
Log($"[Link] 未找到 ID {DiscoverNodeID} 的发现节点", NotifyLevel.DebugModeOnly)
Logger.Warn($"未找到 ID {DiscoverNodeID} 的发现节点")
Panic("房间已过期", "请让房主重新创建房间!")
Throw New ThreadInterruptedException
End If
End If
If SelectedDiscoverNode Is Nothing Then '使用回退发现节点
SelectedDiscoverNode = New JObject From {{"address", FallbackDiscoverAddress}, {"id", FallbackDiscoverID}}
Log("[Link] 将使用回退发现节点", NotifyLevel.DebugModeOnly)
Logger.Warn("将使用回退发现节点")
End If
FinalPeers.Add(SelectedDiscoverNode("address").ToString())
FinalDiscoverID = SelectedDiscoverNode("id").ToObject(Of Integer)
Log($"[Link] 发现节点:{SelectedDiscoverNode("address")} (ID: {FinalDiscoverID})")
Logger.Info($"发现节点:{SelectedDiscoverNode("address")} (ID: {FinalDiscoverID})")
'选取中继节点
If ModeDebug OrElse Not IsServerSide Then '房主只连接发现节点,不连接中继节点
Dim RelayCount As Integer = ServerConfig("Link")("RandomPeer").ToObject(Of Integer)
@@ -676,7 +674,7 @@ ForcedPass:
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
Log(ex, "获取节点列表失败,联机质量可能受到影响", NotifyLevel.AllUsers)
Logger.Error(ex, "获取节点列表失败,联机质量可能受到影响", LogBehavior.Toast)
FinalPeers.AddRange(ServerConfig("Link")("Peers").Select(Function(p) p.ToString))
If FinalDiscoverID <= 0 Then
FinalPeers.Add(FallbackDiscoverAddress)
@@ -716,16 +714,16 @@ ForcedPass:
If ProcessObject.Id = ProcessCore?.Id Then Continue For
If ProcessObject.ProcessName <> "联机模块" AndAlso ProcessObject.ProcessName <> "联机模块 CLI" Then Continue For
Try
Log("[Link] 停止残留的联机模块,PID:" & ProcessObject.Id & ",进程名:" & ProcessObject.ProcessName)
Logger.Info($"停止残留的联机模块,PID:{ProcessObject.Id},进程名:{ProcessObject.ProcessName}")
ProcessObject.Kill()
ProcessObject.Close()
Catch exx As Exception
Log(exx, $"结束进程失败({ProcessObject.ProcessName},PID {ProcessObject.Id})")
Logger.Warn(exx, $"结束进程失败({ProcessObject.ProcessName},PID {ProcessObject.Id})")
End Try
Next
'关闭由自身启动的进程
If ProcessCore IsNot Nothing AndAlso Not ProcessCore.HasExited Then
Log("[Link] 停止所启动的联机模块,PID:" & ProcessCore.Id)
Logger.Info($"停止所启动的联机模块,PID:{ProcessCore.Id}")
ProcessCore.Kill()
ProcessCore.Close()
ProcessCore = Nothing
@@ -734,7 +732,7 @@ ForcedPass:
ProcessOutputHandle?.Dispose()
ProcessErrorHandle?.Dispose()
Catch ex As Exception
Log(ex, "停止联机模块失败")
Logger.Warn(ex, "停止联机模块失败")
End Try
End Sub
''' <summary>
@@ -770,7 +768,7 @@ ForcedPass:
.StandardOutputEncoding = Encoding.UTF8,
.StandardErrorEncoding = Encoding.UTF8
}
Log("[Link] 正在启动 EasyTier:" & Arguments)
Logger.Info($"正在启动 EasyTier:{Arguments}")
ProcessCore = New Process With {.StartInfo = Info}
Dim LogLineHandler =
Function(sender As Object, e As DataReceivedEventArgs, Handle As AutoResetEvent)
@@ -782,7 +780,7 @@ ForcedPass:
ProcessLogLine(e.Data)
Catch unused As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 EasyTier 信息失败")
Logger.Warn(ex, "读取 EasyTier 信息失败")
End Try
Return Nothing
End Function
@@ -796,15 +794,15 @@ ForcedPass:
End Sub
Private Sub ProcessLogLine(Line As String)
'记录日志
Log("[EasyTier] " & Line)
Logger.Info(Line)
LogHistory.Enqueue(Line)
If LogHistory.Count >= 10 Then LogHistory.Dequeue()
'检查日志内容
If Line.ContainsIgnoreCase("new peer connection added") Then
Log("[Link] 已建立连接:" & If(RegexSeek(Line, "(?<=remote_addr.+?"")[^""}]{3,}"), Line), NotifyLevel.DebugModeOnly)
Logger.Warn($"已建立连接:{If(Line.RegexSeek("(?<=remote_addr.+?"")[^""}]{3,}"), Line)}")
Update()
ElseIf Line.ContainsIgnoreCase("peer connection removed") Then
Log("[Link] 已断开连接:" & If(RegexSeek(Line, "(?<=remote_addr.+?"")[^""}]{3,}"), Line), NotifyLevel.DebugModeOnly)
Logger.Warn($"已断开连接:{If(Line.RegexSeek("(?<=remote_addr.+?"")[^""}]{3,}"), Line)}")
Update()
End If
End Sub
@@ -919,7 +917,7 @@ ForcedPass:
Dim CliResult = StartProcessAndGetOutput(PathEasyTier & "联机模块 CLI.exe", $"-o json -p 127.0.0.1:{RPCPort} peer", 2000, Encoding:=Encoding.UTF8, PrintLog:=False)
'解析
If Not CliResult.Contains("lat_ms") Then Throw New Exception("CLI 调用失败:" & vbCrLf & CliResult)
If GetUuid() Mod If(ModeDebug, 23, 103) = 0 Then Log("[EasyTier] CLI 输出抽样:" & vbCrLf & CliResult)
If GetUuid() Mod If(ModeDebug, 23, 103) = 0 Then Logger.Info($"CLI 输出抽样:{vbCrLf}{CliResult}")
Dim NewPeers As New List(Of Peer)
For Each Line As JObject In CType(GetJson(CliResult), JArray)
Try
@@ -930,14 +928,14 @@ ForcedPass:
NewPeers.Add(Peer)
End If
Catch exx As Exception
Log(exx, $"错误的信息({Line})")
Logger.Warn(exx, $"错误的信息({Line})")
End Try
Next
'完成
Peers = NewPeers
FailCount = 0
Catch ex As Exception
Log(ex, "获取节点信息失败")
Logger.Warn(ex, "获取节点信息失败")
If LinkState = LinkStates.Finished Then
FailCount += 1
If FailCount >= 4 Then Panic("获取节点信息失败", ex.Message)
@@ -1011,7 +1009,7 @@ ForcedPass:
'每 200ms 更新进度条
If LinkState = LinkStates.Loading Then RunInUi(AddressOf UpdateProgressBar)
Catch ex As Exception
Log(ex, "联机模块主时钟出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "联机模块主时钟出错")
Thread.Sleep(10000)
End Try
Loop
@@ -1060,7 +1058,7 @@ ForcedPass:
Else
HintFinish.Text = "你或者房主的网络环境不太好,"
End If
If String.IsNullOrWhiteSpace(Settings.Get("LinkCustomPeer")) Then
If String.IsNullOrWhiteSpace(Settings.Get(Of String)("LinkCustomPeer")) Then
HintFinish.Text &= "正使用社区节点进行中继。"
Else
HintFinish.Text &= "正通过自定义节点进行中继。"
@@ -1102,7 +1100,7 @@ ForcedPass:
SocketFlags.None,
New IPEndPoint(IPAddress.Loopback, 4445))
Catch ex As Exception
Log(ex, "广播联机房间端口失败")
Logger.Warn(ex, "广播联机房间端口失败")
End Try
End If
End Sub
@@ -117,30 +117,16 @@
<StackPanel Margin="25,40,19,20">
<TextBlock HorizontalAlignment="Left" Text="以下是近期的高级赞助者们!感谢大家对 PCL 的支持!!!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" />
<WrapPanel Margin="0,0,0,10">␍ <TextBlock Margin="0,1.5,6,0" Text="." />
<TextBlock Margin="0,1.5,6,0" Text="." />
<TextBlock Margin="0,1.5,6,0" Text="X" />
<TextBlock Margin="0,1.5,6,0" Text="..." />
<TextBlock Margin="0,1.5,6,0" Text="R" />
<TextBlock Margin="0,1.5,6,0" Text="L" />
<TextBlock Margin="0,1.5,6,0" Text="X" />
<TextBlock Margin="0,1.5,6,0" Text="D" />
<TextBlock Margin="0,1.5,6,0" Text="le" />
<TextBlock Margin="0,1.5,6,0" Text="vv" />
<TextBlock Margin="0,1.5,6,0" Text="IT" />
<TextBlock Margin="0,1.5,6,0" Text="卓" />
<TextBlock Margin="0,1.5,6,0" Text="玖" />
<TextBlock Margin="0,1.5,6,0" Text="雨" />
<TextBlock Margin="0,1.5,6,0" Text="辰" />
<TextBlock Margin="0,1.5,6,0" Text="李" />
<TextBlock Margin="0,1.5,6,0" Text="顺" />
<TextBlock Margin="0,1.5,6,0" Text="茧" />
<TextBlock Margin="0,1.5,6,0" Text="烬" />
<TextBlock Margin="0,1.5,6,0" Text="莫" />
<TextBlock Margin="0,1.5,6,0" Text="尊" />
<TextBlock Margin="0,1.5,6,0" Text="埃" />
<TextBlock Margin="0,1.5,6,0" Text="灷" />
<TextBlock Margin="0,1.5,6,0" Text="蒙" />
<TextBlock Margin="0,1.5,6,0" Text="鸢" />
<TextBlock Margin="0,1.5,6,0" Text="羽" />
<TextBlock Margin="0,1.5,6,0" Text="梦" />
<TextBlock Margin="0,1.5,6,0" Text="零" />
<TextBlock Margin="0,1.5,6,0" Text="笕" />
<TextBlock Margin="0,1.5,6,0" Text="枫" />
<TextBlock Margin="0,1.5,6,0" Text="W" />
@@ -154,104 +140,45 @@
<TextBlock Margin="0,1.5,6,0" Text="谷" />
<TextBlock Margin="0,1.5,6,0" Text="泽" />
<TextBlock Margin="0,1.5,6,0" Text="林" />
<TextBlock Margin="0,1.5,6,0" Text="TT" />
<TextBlock Margin="0,1.5,6,0" Text="粥" />
<TextBlock Margin="0,1.5,6,0" Text="。" />
<TextBlock Margin="0,1.5,6,0" Text="泠" />
<TextBlock Margin="0,1.5,6,0" Text="白" />
<TextBlock Margin="0,1.5,6,0" Text="唯" />
<TextBlock Margin="0,1.5,6,0" Text="棠" />
<TextBlock Margin="0,1.5,6,0" Text="沐" />
<TextBlock Margin="0,1.5,6,0" Text="柒ᝰ" />
<TextBlock Margin="0,1.5,6,0" Text="廖" />
<TextBlock Margin="0,1.5,6,0" Text="烨" />
<TextBlock Margin="0,1.5,6,0" Text="yu" />
<TextBlock Margin="0,1.5,6,0" Text="......" />
<TextBlock Margin="0,1.5,6,0" Text="zjx" />
<TextBlock Margin="0,1.5,6,0" Text="up" />
<TextBlock Margin="0,1.5,6,0" Text="XX" />
<TextBlock Margin="0,1.5,6,0" Text="sjg" />
<TextBlock Margin="0,1.5,6,0" Text="yfx" />
<TextBlock Margin="0,1.5,6,0" Text="💬" />
<TextBlock Margin="0,1.5,6,0" Text="7%" />
<TextBlock Margin="0,1.5,6,0" Text="UU" />
<TextBlock Margin="0,1.5,6,0" Text="PQ" />
<TextBlock Margin="0,1.5,6,0" Text="^^" />
<TextBlock Margin="0,1.5,6,0" Text="tkx" />
<TextBlock Margin="0,1.5,6,0" Text="Siri" />
<TextBlock Margin="0,1.5,6,0" Text="bre" />
<TextBlock Margin="0,1.5,6,0" Text="xtq" />
<TextBlock Margin="0,1.5,6,0" Text="qin" />
<TextBlock Margin="0,1.5,6,0" Text="ZJL" />
<TextBlock Margin="0,1.5,6,0" Text="汐a" />
<TextBlock Margin="0,1.5,6,0" Text="PFF" />
<TextBlock Margin="0,1.5,6,0" Text="ZYL" />
<TextBlock Margin="0,1.5,6,0" Text="ZYL" />
<TextBlock Margin="0,1.5,6,0" Text="555" />
<TextBlock Margin="0,1.5,6,0" Text="661" />
<TextBlock Margin="0,1.5,6,0" Text="LSP" />
<TextBlock Margin="0,1.5,6,0" Text="轩₩" />
<TextBlock Margin="0,1.5,6,0" Text="zzw" />
<TextBlock Margin="0,1.5,6,0" Text="ybb" />
<TextBlock Margin="0,1.5,6,0" Text="JJJT" />
<TextBlock Margin="0,1.5,6,0" Text="ZCY" />
<TextBlock Margin="0,1.5,6,0" Text="Kiro" />
<TextBlock Margin="0,1.5,6,0" Text="Win" />
<TextBlock Margin="0,1.5,6,0" Text="Van" />
<TextBlock Margin="0,1.5,6,0" Text="hhh" />
<TextBlock Margin="0,1.5,6,0" Text="bbb" />
<TextBlock Margin="0,1.5,6,0" Text="沙轻" />
<TextBlock Margin="0,1.5,6,0" Text="缤语" />
<TextBlock Margin="0,1.5,6,0" Text="xsqs" />
<TextBlock Margin="0,1.5,6,0" Text="空青" />
<TextBlock Margin="0,1.5,6,0" Text="奇才" />
<TextBlock Margin="0,1.5,6,0" Text="阿宅" />
<TextBlock Margin="0,1.5,6,0" Text="聆溪" />
<TextBlock Margin="0,1.5,6,0" Text="柒安" />
<TextBlock Margin="0,1.5,6,0" Text="池木" />
<TextBlock Margin="0,1.5,6,0" Text="君猫" />
<TextBlock Margin="0,1.5,6,0" Text="離鬯" />
<TextBlock Margin="0,1.5,6,0" Text="yihe" />
<TextBlock Margin="0,1.5,6,0" Text="泽涛" />
<TextBlock Margin="0,1.5,6,0" Text="习页" />
<TextBlock Margin="0,1.5,6,0" Text="旋叶" />
<TextBlock Margin="0,1.5,6,0" Text="方十" />
<TextBlock Margin="0,1.5,6,0" Text="苑煜" />
<TextBlock Margin="0,1.5,6,0" Text="沐清" />
<TextBlock Margin="0,1.5,6,0" Text="阿杰" />
<TextBlock Margin="0,1.5,6,0" Text="阳仔" />
<TextBlock Margin="0,1.5,6,0" Text="吸管" />
<TextBlock Margin="0,1.5,6,0" Text="夜幕" />
<TextBlock Margin="0,1.5,6,0" Text="夜墨" />
<TextBlock Margin="0,1.5,6,0" Text="芥裔" />
<TextBlock Margin="0,1.5,6,0" Text="冯睿" />
<TextBlock Margin="0,1.5,6,0" Text="夜昼" />
<TextBlock Margin="0,1.5,6,0" Text="鎔謙" />
<TextBlock Margin="0,1.5,6,0" Text="三木" />
<TextBlock Margin="0,1.5,6,0" Text="太二" />
<TextBlock Margin="0,1.5,6,0" Text="墨染" />
<TextBlock Margin="0,1.5,6,0" Text="晚点" />
<TextBlock Margin="0,1.5,6,0" Text="景文" />
<TextBlock Margin="0,1.5,6,0" Text="天火" />
<TextBlock Margin="0,1.5,6,0" Text="迟涵" />
<TextBlock Margin="0,1.5,6,0" Text="冬莫" />
<TextBlock Margin="0,1.5,6,0" Text="羽嵩" />
<TextBlock Margin="0,1.5,6,0" Text="湙泽" />
<TextBlock Margin="0,1.5,6,0" Text="梦幻" />
<TextBlock Margin="0,1.5,6,0" Text="嘿嘿" />
<TextBlock Margin="0,1.5,6,0" Text="枫叶" />
<TextBlock Margin="0,1.5,6,0" Text="赤阳" />
<TextBlock Margin="0,1.5,6,0" Text="画猫" />
<TextBlock Margin="0,1.5,6,0" Text="UTA" />
<TextBlock Margin="0,1.5,6,0" Text="柠凉" />
<TextBlock Margin="0,1.5,6,0" Text="本來" />
<TextBlock Margin="0,1.5,6,0" Text=":)" />
<TextBlock Margin="0,1.5,6,0" Text="朔辉" />
<TextBlock Margin="0,1.5,6,0" Text="秋骑" />
<TextBlock Margin="0,1.5,6,0" Text="无一" />
<TextBlock Margin="0,1.5,6,0" Text="老八" />
<TextBlock Margin="0,1.5,6,0" Text="胖子" />
<TextBlock Margin="0,1.5,6,0" Text="御翰" />
<TextBlock Margin="0,1.5,6,0" Text="烛火" />
<TextBlock Margin="0,1.5,6,0" Text="笨挽" />
<TextBlock Margin="0,1.5,6,0" Text="悦木" />
<TextBlock Margin="0,1.5,6,0" Text="林霖" />
<TextBlock Margin="0,1.5,6,0" Text="谷雨" />
<TextBlock Margin="0,1.5,6,0" Text="辞七" />
<TextBlock Margin="0,1.5,6,0" Text="血狐" />
<TextBlock Margin="0,1.5,6,0" Text="君泽" />
<TextBlock Margin="0,1.5,6,0" Text="歧辰" />
<TextBlock Margin="0,1.5,6,0" Text="嗷嗷" />
<TextBlock Margin="0,1.5,6,0" Text="陌陌" />
<TextBlock Margin="0,1.5,6,0" Text="小王" />
<TextBlock Margin="0,1.5,6,0" Text="小龙" />
<TextBlock Margin="0,1.5,6,0" Text="月桂" />
<TextBlock Margin="0,1.5,6,0" Text="沐槿" />
<TextBlock Margin="0,1.5,6,0" Text="雨润" />
<TextBlock Margin="0,1.5,6,0" Text="颜峰" />
<TextBlock Margin="0,1.5,6,0" Text="符符" />
<TextBlock Margin="0,1.5,6,0" Text="冰块" />
<TextBlock Margin="0,1.5,6,0" Text="莫林" />
<TextBlock Margin="0,1.5,6,0" Text="Gun" />
@@ -286,99 +213,72 @@
<TextBlock Margin="0,1.5,6,0" Text="稚苕" />
<TextBlock Margin="0,1.5,6,0" Text="白龙" />
<TextBlock Margin="0,1.5,6,0" Text="影杀" />
<TextBlock Margin="0,1.5,6,0" Text="惊蛰" />
<TextBlock Margin="0,1.5,6,0" Text="诺兮" />
<TextBlock Margin="0,1.5,6,0" Text="哎哟" />
<TextBlock Margin="0,1.5,6,0" Text="博弈" />
<TextBlock Margin="0,1.5,6,0" Text="白渊" />
<TextBlock Margin="0,1.5,6,0" Text="喃喃" />
<TextBlock Margin="0,1.5,6,0" Text="再说" />
<TextBlock Margin="0,1.5,6,0" Text="愛執" />
<TextBlock Margin="0,1.5,6,0" Text="浮誇" />
<TextBlock Margin="0,1.5,6,0" Text="菜猫" />
<TextBlock Margin="0,1.5,6,0" Text="雪柳" />
<TextBlock Margin="0,1.5,6,0" Text="吉刻" />
<TextBlock Margin="0,1.5,6,0" Text="幻天" />
<TextBlock Margin="0,1.5,6,0" Text="西窗" />
<TextBlock Margin="0,1.5,6,0" Text="赵駉" />
<TextBlock Margin="0,1.5,6,0" Text="三伏" />
<TextBlock Margin="0,1.5,6,0" Text="阿哲" />
<TextBlock Margin="0,1.5,6,0" Text="耄耋" />
<TextBlock Margin="0,1.5,6,0" Text="梦羽" />
<TextBlock Margin="0,1.5,6,0" Text="墨汐" />
<TextBlock Margin="0,1.5,6,0" Text="玄狐" />
<TextBlock Margin="0,1.5,6,0" Text="tusk" />
<TextBlock Margin="0,1.5,6,0" Text="星甲" />
<TextBlock Margin="0,1.5,6,0" Text="YmY" />
<TextBlock Margin="0,1.5,6,0" Text="time" />
<TextBlock Margin="0,1.5,6,0" Text="sadv" />
<TextBlock Margin="0,1.5,6,0" Text="gate" />
<TextBlock Margin="0,1.5,6,0" Text="king" />
<TextBlock Margin="0,1.5,6,0" Text="ZHH" />
<TextBlock Margin="0,1.5,6,0" Text="Ezzo" />
<TextBlock Margin="0,1.5,6,0" Text="^O^" />
<TextBlock Margin="0,1.5,6,0" Text="GUO" />
<TextBlock Margin="0,1.5,6,0" Text="gino" />
<TextBlock Margin="0,1.5,6,0" Text="luoo" />
<TextBlock Margin="0,1.5,6,0" Text="9787" />
<TextBlock Margin="0,1.5,6,0" Text="HJYz" />
<TextBlock Margin="0,1.5,6,0" Text="0216" />
<TextBlock Margin="0,1.5,6,0" Text="DOA" />
<TextBlock Margin="0,1.5,6,0" Text="1001" />
<TextBlock Margin="0,1.5,6,0" Text="Qing" />
<TextBlock Margin="0,1.5,6,0" Text="TOM" />
<TextBlock Margin="0,1.5,6,0" Text="Gaze" />
<TextBlock Margin="0,1.5,6,0" Text="Cella" />
<TextBlock Margin="0,1.5,6,0" Text="Keyn" />
<TextBlock Margin="0,1.5,6,0" Text="Ilyen" />
<TextBlock Margin="0,1.5,6,0" Text="1950" />
<TextBlock Margin="0,1.5,6,0" Text="AL76" />
<TextBlock Margin="0,1.5,6,0" Text="4Ghz" />
<TextBlock Margin="0,1.5,6,0" Text="cong" />
<TextBlock Margin="0,1.5,6,0" Text="WAR" />
<TextBlock Margin="0,1.5,6,0" Text="。_。" />
<TextBlock Margin="0,1.5,6,0" Text="lucky" />
<TextBlock Margin="0,1.5,6,0" Text="Gd64" />
<TextBlock Margin="0,1.5,6,0" Text="vbird" />
<TextBlock Margin="0,1.5,6,0" Text="空调c" />
<TextBlock Margin="0,1.5,6,0" Text="gugu" />
<TextBlock Margin="0,1.5,6,0" Text="Brant" />
<TextBlock Margin="0,1.5,6,0" Text="⁣    ​" />
<TextBlock Margin="0,1.5,6,0" Text="RKRK" />
<TextBlock Margin="0,1.5,6,0" Text="verge" />
<TextBlock Margin="0,1.5,6,0" Text="Tarka" />
<TextBlock Margin="0,1.5,6,0" Text="cHEn." />
<TextBlock Margin="0,1.5,6,0" Text="Elysia" />
<TextBlock Margin="0,1.5,6,0" Text="Eiligo" />
<TextBlock Margin="0,1.5,6,0" Text="友人A" />
<TextBlock Margin="0,1.5,6,0" Text="jiagar" />
<TextBlock Margin="0,1.5,6,0" Text="RANX" />
<TextBlock Margin="0,1.5,6,0" Text="hanm" />
<TextBlock Margin="0,1.5,6,0" Text="Akula" />
<TextBlock Margin="0,1.5,6,0" Text="54188" />
<TextBlock Margin="0,1.5,6,0" Text="&amp;#39;" />
<TextBlock Margin="0,1.5,6,0" Text="Cx330" />
<TextBlock Margin="0,1.5,6,0" Text="ZDHK" />
<TextBlock Margin="0,1.5,6,0" Text="ToTxT" />
<TextBlock Margin="0,1.5,6,0" Text="HzzzT" />
<TextBlock Margin="0,1.5,6,0" Text="EAger" />
<TextBlock Margin="0,1.5,6,0" Text="ziqian" />
<TextBlock Margin="0,1.5,6,0" Text="kunsir" />
<TextBlock Margin="0,1.5,6,0" Text="LiarCT" />
<TextBlock Margin="0,1.5,6,0" Text="rg_gfc" />
<TextBlock Margin="0,1.5,6,0" Text="Lloora" />
<TextBlock Margin="0,1.5,6,0" Text="调试器" />
<TextBlock Margin="0,1.5,6,0" Text="咕咕柒" />
<TextBlock Margin="0,1.5,6,0" Text="xuque" />
<TextBlock Margin="0,1.5,6,0" Text="希希希" />
<TextBlock Margin="0,1.5,6,0" Text="飞猪侠" />
<TextBlock Margin="0,1.5,6,0" Text="张卿予" />
<TextBlock Margin="0,1.5,6,0" Text="剑骨头" />
<TextBlock Margin="0,1.5,6,0" Text="栀熙阳" />
<TextBlock Margin="0,1.5,6,0" Text="晚雾鹤" />
<TextBlock Margin="0,1.5,6,0" Text="狐猫喵" />
<TextBlock Margin="0,1.5,6,0" Text="祤之锌" />
<TextBlock Margin="0,1.5,6,0" Text="金苹果" />
<TextBlock Margin="0,1.5,6,0" Text="云野寂" />
<TextBlock Margin="0,1.5,6,0" Text="金木研" />
<TextBlock Margin="0,1.5,6,0" Text="Scoop" />
<TextBlock Margin="0,1.5,6,0" Text="绘梨衣" />
<TextBlock Margin="0,1.5,6,0" Text="夜小辞" />
<TextBlock Margin="0,1.5,6,0" Text="明月奴" />
<TextBlock Margin="0,1.5,6,0" Text="光和热" />
<TextBlock Margin="0,1.5,6,0" Text="柳贯一" />
<TextBlock Margin="0,1.5,6,0" Text="湫某辞" />
<TextBlock Margin="0,1.5,6,0" Text="大哈操" />
<TextBlock Margin="0,1.5,6,0" Text="顾東凡" />
<TextBlock Margin="0,1.5,6,0" Text="云之梦" />
<TextBlock Margin="0,1.5,6,0" Text="叶云翳" />
<TextBlock Margin="0,1.5,6,0" Text="爱钱钱" />
<TextBlock Margin="0,1.5,6,0" Text="oaken" />
<TextBlock Margin="0,1.5,6,0" Text="小小球" />
<TextBlock Margin="0,1.5,6,0" Text="徐炳文" />
<TextBlock Margin="0,1.5,6,0" Text="天羽煜" />
<TextBlock Margin="0,1.5,6,0" Text="小牛马" />
<TextBlock Margin="0,1.5,6,0" Text="折尾猫" />
<TextBlock Margin="0,1.5,6,0" Text="橘雨恋" />
<TextBlock Margin="0,1.5,6,0" Text="耿大壮" />
<TextBlock Margin="0,1.5,6,0" Text="无头像" />
<TextBlock Margin="0,1.5,6,0" Text="格洛芬" />
<TextBlock Margin="0,1.5,6,0" Text="史迪威" />
<TextBlock Margin="0,1.5,6,0" Text="小苏子" />
<TextBlock Margin="0,1.5,6,0" Text="塔塔开" />
<TextBlock Margin="0,1.5,6,0" Text="七代风" />
<TextBlock Margin="0,1.5,6,0" Text="狐狸喵" />
<TextBlock Margin="0,1.5,6,0" Text="俥仔面" />
<TextBlock Margin="0,1.5,6,0" Text="英仙座" />
<TextBlock Margin="0,1.5,6,0" Text="小零子" />
<TextBlock Margin="0,1.5,6,0" Text="白清河" />
<TextBlock Margin="0,1.5,6,0" Text="晚江诗" />
<TextBlock Margin="0,1.5,6,0" Text="諸星洋" />
<TextBlock Margin="0,1.5,6,0" Text="哦哦哦" />
<TextBlock Margin="0,1.5,6,0" Text="咕谷谷" />
<TextBlock Margin="0,1.5,6,0" Text="长白山" />
<TextBlock Margin="0,1.5,6,0" Text="杨某某" />
<TextBlock Margin="0,1.5,6,0" Text="云尘眠" />
<TextBlock Margin="0,1.5,6,0" Text="腐目cx" />
<TextBlock Margin="0,1.5,6,0" Text="大鱻鱼" />
<TextBlock Margin="0,1.5,6,0" Text="颠修钩" />
<TextBlock Margin="0,1.5,6,0" Text="拉罗克" />
@@ -411,126 +311,77 @@
<TextBlock Margin="0,1.5,6,0" Text="哒哒哒" />
<TextBlock Margin="0,1.5,6,0" Text="咕咕咕" />
<TextBlock Margin="0,1.5,6,0" Text="TROLL" />
<TextBlock Margin="0,1.5,6,0" Text="yoyal8" />
<TextBlock Margin="0,1.5,6,0" Text="苦不迭" />
<TextBlock Margin="0,1.5,6,0" Text="童瑞林" />
<TextBlock Margin="0,1.5,6,0" Text="派大鑫" />
<TextBlock Margin="0,1.5,6,0" Text="小年糕" />
<TextBlock Margin="0,1.5,6,0" Text="卡骆儿" />
<TextBlock Margin="0,1.5,6,0" Text="范海辛" />
<TextBlock Margin="0,1.5,6,0" Text="风吹语" />
<TextBlock Margin="0,1.5,6,0" Text="辞熙语" />
<TextBlock Margin="0,1.5,6,0" Text="鸿小运" />
<TextBlock Margin="0,1.5,6,0" Text="陈两仪" />
<TextBlock Margin="0,1.5,6,0" Text="叶辛梓" />
<TextBlock Margin="0,1.5,6,0" Text="窗锁昼" />
<TextBlock Margin="0,1.5,6,0" Text="ITMTX" />
<TextBlock Margin="0,1.5,6,0" Text="Zh11h" />
<TextBlock Margin="0,1.5,6,0" Text="SEKGY" />
<TextBlock Margin="0,1.5,6,0" Text="111sui" />
<TextBlock Margin="0,1.5,6,0" Text="aKALA" />
<TextBlock Margin="0,1.5,6,0" Text="gyj120" />
<TextBlock Margin="0,1.5,6,0" Text="Young" />
<TextBlock Margin="0,1.5,6,0" Text="凌·秋烨" />
<TextBlock Margin="0,1.5,6,0" Text="wujian" />
<TextBlock Margin="0,1.5,6,0" Text="0fore0" />
<TextBlock Margin="0,1.5,6,0" Text="zkmz4" />
<TextBlock Margin="0,1.5,6,0" Text="Du1yn" />
<TextBlock Margin="0,1.5,6,0" Text="Dshiya" />
<TextBlock Margin="0,1.5,6,0" Text="G-next" />
<TextBlock Margin="0,1.5,6,0" Text="N0rdiK" />
<TextBlock Margin="0,1.5,6,0" Text="Sphinx" />
<TextBlock Margin="0,1.5,6,0" Text="kimma" />
<TextBlock Margin="0,1.5,6,0" Text="Jupiter" />
<TextBlock Margin="0,1.5,6,0" Text="张jin浩" />
<TextBlock Margin="0,1.5,6,0" Text="Duomi" />
<TextBlock Margin="0,1.5,6,0" Text="TINTIN" />
<TextBlock Margin="0,1.5,6,0" Text="Sakura" />
<TextBlock Margin="0,1.5,6,0" Text="Corpus" />
<TextBlock Margin="0,1.5,6,0" Text="Thgink" />
<TextBlock Margin="0,1.5,6,0" Text="forever" />
<TextBlock Margin="0,1.5,6,0" Text="Zemira" />
<TextBlock Margin="0,1.5,6,0" Text="一哥3.0" />
<TextBlock Margin="0,1.5,6,0" Text="PanBIS" />
<TextBlock Margin="0,1.5,6,0" Text="e1apse" />
<TextBlock Margin="0,1.5,6,0" Text="cmly03" />
<TextBlock Margin="0,1.5,6,0" Text="114514" />
<TextBlock Margin="0,1.5,6,0" Text="YEYEYE" />
<TextBlock Margin="0,1.5,6,0" Text="Phuket" />
<TextBlock Margin="0,1.5,6,0" Text="Atomic" />
<TextBlock Margin="0,1.5,6,0" Text="jiduhui" />
<TextBlock Margin="0,1.5,6,0" Text="Snowill" />
<TextBlock Margin="0,1.5,6,0" Text="kvmvvx" />
<TextBlock Margin="0,1.5,6,0" Text="sabrina" />
<TextBlock Margin="0,1.5,6,0" Text="424241" />
<TextBlock Margin="0,1.5,6,0" Text="XIruotE" />
<TextBlock Margin="0,1.5,6,0" Text="Dr.Ayin" />
<TextBlock Margin="0,1.5,6,0" Text="onlong" />
<TextBlock Margin="0,1.5,6,0" Text="zuozhe" />
<TextBlock Margin="0,1.5,6,0" Text="ling141" />
<TextBlock Margin="0,1.5,6,0" Text="Secular" />
<TextBlock Margin="0,1.5,6,0" Text="zxxxfan" />
<TextBlock Margin="0,1.5,6,0" Text="MY17IT" />
<TextBlock Margin="0,1.5,6,0" Text="張 懙 李" />
<TextBlock Margin="0,1.5,6,0" Text="TNT285" />
<TextBlock Margin="0,1.5,6,0" Text="Decade" />
<TextBlock Margin="0,1.5,6,0" Text="laobide" />
<TextBlock Margin="0,1.5,6,0" Text="ccb大神" />
<TextBlock Margin="0,1.5,6,0" Text="plastick" />
<TextBlock Margin="0,1.5,6,0" Text="loouse_" />
<TextBlock Margin="0,1.5,6,0" Text="饺子MC" />
<TextBlock Margin="0,1.5,6,0" Text="杰 NI 龟" />
<TextBlock Margin="0,1.5,6,0" Text="kill1122" />
<TextBlock Margin="0,1.5,6,0" Text="Axetere" />
<TextBlock Margin="0,1.5,6,0" Text="super9y" />
<TextBlock Margin="0,1.5,6,0" Text="DUANG" />
<TextBlock Margin="0,1.5,6,0" Text="Foxman" />
<TextBlock Margin="0,1.5,6,0" Text="猫yi巴草" />
<TextBlock Margin="0,1.5,6,0" Text="goblind" />
<TextBlock Margin="0,1.5,6,0" Text="NeroicX" />
<TextBlock Margin="0,1.5,6,0" Text="章鱼B26" />
<TextBlock Margin="0,1.5,6,0" Text="秦爅QIN" />
<TextBlock Margin="0,1.5,6,0" Text="weather" />
<TextBlock Margin="0,1.5,6,0" Text="qwptpw" />
<TextBlock Margin="0,1.5,6,0" Text="RedLink" />
<TextBlock Margin="0,1.5,6,0" Text="SkyArea" />
<TextBlock Margin="0,1.5,6,0" Text="奶酪Jzy_" />
<TextBlock Margin="0,1.5,6,0" Text="李領link" />
<TextBlock Margin="0,1.5,6,0" Text="^-_-^" />
<TextBlock Margin="0,1.5,6,0" Text="筱星辰⭐" />
<TextBlock Margin="0,1.5,6,0" Text="Starying" />
<TextBlock Margin="0,1.5,6,0" Text="wwwww" />
<TextBlock Margin="0,1.5,6,0" Text="Flawless" />
<TextBlock Margin="0,1.5,6,0" Text="Buyihan" />
<TextBlock Margin="0,1.5,6,0" Text="疾驰火车" />
<TextBlock Margin="0,1.5,6,0" Text="鸿星天帝" />
<TextBlock Margin="0,1.5,6,0" Text="我不在线" />
<TextBlock Margin="0,1.5,6,0" Text="跳水的鱼" />
<TextBlock Margin="0,1.5,6,0" Text="咸鱼雷音" />
<TextBlock Margin="0,1.5,6,0" Text="云映鹤影" />
<TextBlock Margin="0,1.5,6,0" Text="金禾向暖" />
<TextBlock Margin="0,1.5,6,0" Text="驿路梨花" />
<TextBlock Margin="0,1.5,6,0" Text="气息荒古" />
<TextBlock Margin="0,1.5,6,0" Text="milenter" />
<TextBlock Margin="0,1.5,6,0" Text="霜木翔凤" />
<TextBlock Margin="0,1.5,6,0" Text="只见伊人" />
<TextBlock Margin="0,1.5,6,0" Text="苏家阿辰" />
<TextBlock Margin="0,1.5,6,0" Text="未知用户" />
<TextBlock Margin="0,1.5,6,0" Text="唐吉課德" />
<TextBlock Margin="0,1.5,6,0" Text="童年的梦" />
<TextBlock Margin="0,1.5,6,0" Text="时灵风逝" />
<TextBlock Margin="0,1.5,6,0" Text="二十四誓" />
<TextBlock Margin="0,1.5,6,0" Text="英白拉多" />
<TextBlock Margin="0,1.5,6,0" Text="红袖添香" />
<TextBlock Margin="0,1.5,6,0" Text="氮气炸锅" />
<TextBlock Margin="0,1.5,6,0" Text="望月悠月" />
<TextBlock Margin="0,1.5,6,0" Text="有事掘坟" />
<TextBlock Margin="0,1.5,6,0" Text="爱源神!" />
<TextBlock Margin="0,1.5,6,0" Text="小小小马" />
<TextBlock Margin="0,1.5,6,0" Text="未梦领来" />
<TextBlock Margin="0,1.5,6,0" Text="鸡鸡鸡鸡" />
<TextBlock Margin="0,1.5,6,0" Text="村里村夫" />
<TextBlock Margin="0,1.5,6,0" Text="阿元颜月" />
<TextBlock Margin="0,1.5,6,0" Text="竹林提酒" />
<TextBlock Margin="0,1.5,6,0" Text="黎月红夕" />
<TextBlock Margin="0,1.5,6,0" Text="天下无双" />
<TextBlock Margin="0,1.5,6,0" Text="四月喝茶" />
<TextBlock Margin="0,1.5,6,0" Text="vx:久念" />
<TextBlock Margin="0,1.5,6,0" Text="咫尺之遥" />
<TextBlock Margin="0,1.5,6,0" Text="谁知道喽" />
<TextBlock Margin="0,1.5,6,0" Text="和光同尘" />
<TextBlock Margin="0,1.5,6,0" Text="琉璃柏影" />
<TextBlock Margin="0,1.5,6,0" Text="白鸢鲸落" />
<TextBlock Margin="0,1.5,6,0" Text="陌刀云一" />
<TextBlock Margin="0,1.5,6,0" Text="柠岫汐峪" />
<TextBlock Margin="0,1.5,6,0" Text="敷衍了事" />
<TextBlock Margin="0,1.5,6,0" Text="天穹流星" />
<TextBlock Margin="0,1.5,6,0" Text="歪嘴战神" />
<TextBlock Margin="0,1.5,6,0" Text="南荒北愚" />
<TextBlock Margin="0,1.5,6,0" Text="青衫故人" />
<TextBlock Margin="0,1.5,6,0" Text="幽烛漠鸢" />
<TextBlock Margin="0,1.5,6,0" Text="煎饼硌牙" />
<TextBlock Margin="0,1.5,6,0" Text="无铭芝式" />
<TextBlock Margin="0,1.5,6,0" Text="殷野猫音" />
<TextBlock Margin="0,1.5,6,0" Text="龙门朔辰" />
<TextBlock Margin="0,1.5,6,0" Text="null_000" />
<TextBlock Margin="0,1.5,6,0" Text="霜寒千星" />
<TextBlock Margin="0,1.5,6,0" Text="虫草絮语" />
<TextBlock Margin="0,1.5,6,0" Text="咸鱼冻肉" />
<TextBlock Margin="0,1.5,6,0" Text="六六六折" />
<TextBlock Margin="0,1.5,6,0" Text="摆烂大帝" />
<TextBlock Margin="0,1.5,6,0" Text="念念不忘" />
<TextBlock Margin="0,1.5,6,0" Text="万权之星" />
<TextBlock Margin="0,1.5,6,0" Text="西风所见" />
<TextBlock Margin="0,1.5,6,0" Text="猫猫七子" />
<TextBlock Margin="0,1.5,6,0" Text="雾散別离" />
<TextBlock Margin="0,1.5,6,0" Text="不想社交" />
<TextBlock Margin="0,1.5,6,0" Text="匿迹誊纳" />
<TextBlock Margin="0,1.5,6,0" Text="城南旧事" />
@@ -565,80 +416,60 @@
<TextBlock Margin="0,1.5,6,0" Text="空井里蛙" />
<TextBlock Margin="0,1.5,6,0" Text="空乐白夜" />
<TextBlock Margin="0,1.5,6,0" Text="白色按钮" />
<TextBlock Margin="0,1.5,6,0" Text="环境更加" />
<TextBlock Margin="0,1.5,6,0" Text="ZOIOML" />
<TextBlock Margin="0,1.5,6,0" Text="泽兰白芷" />
<TextBlock Margin="0,1.5,6,0" Text="春野甘兰" />
<TextBlock Margin="0,1.5,6,0" Text="南音之钧" />
<TextBlock Margin="0,1.5,6,0" Text="川泽于耐" />
<TextBlock Margin="0,1.5,6,0" Text="青木暖火" />
<TextBlock Margin="0,1.5,6,0" Text="天天快乐" />
<TextBlock Margin="0,1.5,6,0" Text="阿克华孜" />
<TextBlock Margin="0,1.5,6,0" Text="yunwuyi" />
<TextBlock Margin="0,1.5,6,0" Text="落幕星空" />
<TextBlock Margin="0,1.5,6,0" Text="muming" />
<TextBlock Margin="0,1.5,6,0" Text="纸币ORZ" />
<TextBlock Margin="0,1.5,6,0" Text="西蛮qwq" />
<TextBlock Margin="0,1.5,6,0" Text="nyanmjc" />
<TextBlock Margin="0,1.5,6,0" Text="J_danzai" />
<TextBlock Margin="0,1.5,6,0" Text="CO2_996" />
<TextBlock Margin="0,1.5,6,0" Text="houteng" />
<TextBlock Margin="0,1.5,6,0" Text="無WuAD" />
<TextBlock Margin="0,1.5,6,0" Text="Lioncute" />
<TextBlock Margin="0,1.5,6,0" Text="MoonSir" />
<TextBlock Margin="0,1.5,6,0" Text="情殇·瑕疵" />
<TextBlock Margin="0,1.5,6,0" Text="捌月·拾伍" />
<TextBlock Margin="0,1.5,6,0" Text="CityHaze" />
<TextBlock Margin="0,1.5,6,0" Text="wdy9527" />
<TextBlock Margin="0,1.5,6,0" Text="xiaoyuya" />
<TextBlock Margin="0,1.5,6,0" Text="N3W04H" />
<TextBlock Margin="0,1.5,6,0" Text="久遠 蓮華" />
<TextBlock Margin="0,1.5,6,0" Text="777seese" />
<TextBlock Margin="0,1.5,6,0" Text=" 脖子右拧" />
<TextBlock Margin="0,1.5,6,0" Text="NicoACG" />
<TextBlock Margin="0,1.5,6,0" Text="许和0331" />
<TextBlock Margin="0,1.5,6,0" Text="HHHbbb" />
<TextBlock Margin="0,1.5,6,0" Text="Whelone" />
<TextBlock Margin="0,1.5,6,0" Text="Vergilius." />
<TextBlock Margin="0,1.5,6,0" Text="筱墨OwO" />
<TextBlock Margin="0,1.5,6,0" Text="Beholder" />
<TextBlock Margin="0,1.5,6,0" Text="虫虫OwO" />
<TextBlock Margin="0,1.5,6,0" Text="3355411²" />
<TextBlock Margin="0,1.5,6,0" Text="Sevenfan" />
<TextBlock Margin="0,1.5,6,0" Text="loveryder" />
<TextBlock Margin="0,1.5,6,0" Text="PierceShi" />
<TextBlock Margin="0,1.5,6,0" Text="Bu1e_Cat" />
<TextBlock Margin="0,1.5,6,0" Text="NuoMi_Z" />
<TextBlock Margin="0,1.5,6,0" Text="Zikyeung" />
<TextBlock Margin="0,1.5,6,0" Text="小沉Chen" />
<TextBlock Margin="0,1.5,6,0" Text="QILUOVO" />
<TextBlock Margin="0,1.5,6,0" Text="有鱼sama" />
<TextBlock Margin="0,1.5,6,0" Text="EXcloudZ" />
<TextBlock Margin="0,1.5,6,0" Text="想rua狐狸" />
<TextBlock Margin="0,1.5,6,0" Text="AmorSick" />
<TextBlock Margin="0,1.5,6,0" Text="添加剂ing" />
<TextBlock Margin="0,1.5,6,0" Text="Luangum" />
<TextBlock Margin="0,1.5,6,0" Text="CHLSama" />
<TextBlock Margin="0,1.5,6,0" Text="666abcba" />
<TextBlock Margin="0,1.5,6,0" Text="Sariel小懒" />
<TextBlock Margin="0,1.5,6,0" Text="wanglizhi" />
<TextBlock Margin="0,1.5,6,0" Text="chen0701" />
<TextBlock Margin="0,1.5,6,0" Text="androidhi" />
<TextBlock Margin="0,1.5,6,0" Text="gggg1234" />
<TextBlock Margin="0,1.5,6,0" Text="江寒_John" />
<TextBlock Margin="0,1.5,6,0" Text="bentianjia" />
<TextBlock Margin="0,1.5,6,0" Text="shiroNeko" />
<TextBlock Margin="0,1.5,6,0" Text="yukihomu" />
<TextBlock Margin="0,1.5,6,0" Text="祈愿之星☆" />
<TextBlock Margin="0,1.5,6,0" Text="IIINNNeilII" />
<TextBlock Margin="0,1.5,6,0" Text="爱游戏的狼" />
<TextBlock Margin="0,1.5,6,0" Text="Morkonce" />
<TextBlock Margin="0,1.5,6,0" Text="大臣的二红" />
<TextBlock Margin="0,1.5,6,0" Text="孤影赴星河" />
<TextBlock Margin="0,1.5,6,0" Text="清闲挺自在" />
<TextBlock Margin="0,1.5,6,0" Text="欢呼与果糖" />
<TextBlock Margin="0,1.5,6,0" Text="飞天大锅饭" />
<TextBlock Margin="0,1.5,6,0" Text="烟熏秋刀鱼" />
<TextBlock Margin="0,1.5,6,0" Text="人海不可爱" />
<TextBlock Margin="0,1.5,6,0" Text="希希爱睡觉" />
<TextBlock Margin="0,1.5,6,0" Text="六面三倍速" />
<TextBlock Margin="0,1.5,6,0" Text="orangexixi" />
<TextBlock Margin="0,1.5,6,0" Text="gugugaga" />
<TextBlock Margin="0,1.5,6,0" Text="月下如墨黑" />
<TextBlock Margin="0,1.5,6,0" Text="此心无一事" />
<TextBlock Margin="0,1.5,6,0" Text="烂鱼一条线" />
<TextBlock Margin="0,1.5,6,0" Text="欲买桂花酒" />
<TextBlock Margin="0,1.5,6,0" Text="慢悠悠报表" />
<TextBlock Margin="0,1.5,6,0" Text="蓝莓要健康" />
<TextBlock Margin="0,1.5,6,0" Text="Salted fish" />
<TextBlock Margin="0,1.5,6,0" Text="深根地缚灵" />
<TextBlock Margin="0,1.5,6,0" Text="群管机器人" />
<TextBlock Margin="0,1.5,6,0" Text="鱼儿爱上猫" />
<TextBlock Margin="0,1.5,6,0" Text="Anhydride" />
<TextBlock Margin="0,1.5,6,0" Text="帕秋莉~go" />
<TextBlock Margin="0,1.5,6,0" Text="废材狐阿桔" />
<TextBlock Margin="0,1.5,6,0" Text="玉玉小南娘" />
<TextBlock Margin="0,1.5,6,0" Text="欣喜的掌声" />
<TextBlock Margin="0,1.5,6,0" Text="小云爱中国" />
<TextBlock Margin="0,1.5,6,0" Text="内存漫游者" />
<TextBlock Margin="0,1.5,6,0" Text="压力暴大了" />
<TextBlock Margin="0,1.5,6,0" Text="摆地摊的王" />
<TextBlock Margin="0,1.5,6,0" Text="鲜花女男爵" />
<TextBlock Margin="0,1.5,6,0" Text="团结起来!" />
<TextBlock Margin="0,1.5,6,0" Text="BeiWu_CN" />
<TextBlock Margin="0,1.5,6,0" Text="渔船制造师" />
@@ -654,49 +485,40 @@
<TextBlock Margin="0,1.5,6,0" Text="洒水车之歌" />
<TextBlock Margin="0,1.5,6,0" Text="已被静心了" />
<TextBlock Margin="0,1.5,6,0" Text="茉莉千百羽" />
<TextBlock Margin="0,1.5,6,0" Text="289775340" />
<TextBlock Margin="0,1.5,6,0" Text="baicai1339" />
<TextBlock Margin="0,1.5,6,0" Text="橘子味笙笙" />
<TextBlock Margin="0,1.5,6,0" Text="厨师哥布林" />
<TextBlock Margin="0,1.5,6,0" Text="飘逸的花猫" />
<TextBlock Margin="0,1.5,6,0" Text="爱的救赎者" />
<TextBlock Margin="0,1.5,6,0" Text="清墨咕咕咕" />
<TextBlock Margin="0,1.5,6,0" Text="红色枫树叶" />
<TextBlock Margin="0,1.5,6,0" Text="空气避难所" />
<TextBlock Margin="0,1.5,6,0" Text="神秘人的哥" />
<TextBlock Margin="0,1.5,6,0" Text="落雨乄北辰" />
<TextBlock Margin="0,1.5,6,0" Text="一条闲鲨鱼" />
<TextBlock Margin="0,1.5,6,0" Text="一只木元鸽" />
<TextBlock Margin="0,1.5,6,0" Text="W.D.gaster" />
<TextBlock Margin="0,1.5,6,0" Text="星野源.小毅" />
<TextBlock Margin="0,1.5,6,0" Text="mreaaaaay" />
<TextBlock Margin="0,1.5,6,0" Text="Swampday" />
<TextBlock Margin="0,1.5,6,0" Text="Kimonomc" />
<TextBlock Margin="0,1.5,6,0" Text="翎安Lingan" />
<TextBlock Margin="0,1.5,6,0" Text="Kizuner630" />
<TextBlock Margin="0,1.5,6,0" Text="Stevens520" />
<TextBlock Margin="0,1.5,6,0" Text="123456。?" />
<TextBlock Margin="0,1.5,6,0" Text="loading182" />
<TextBlock Margin="0,1.5,6,0" Text="hhhjtqdydz" />
<TextBlock Margin="0,1.5,6,0" Text="蛋白质_变质" />
<TextBlock Margin="0,1.5,6,0" Text="LMY666888" />
<TextBlock Margin="0,1.5,6,0" Text="DeathHunk" />
<TextBlock Margin="0,1.5,6,0" Text="sheng_1062" />
<TextBlock Margin="0,1.5,6,0" Text="Frankie_233" />
<TextBlock Margin="0,1.5,6,0" Text="izmash0449" />
<TextBlock Margin="0,1.5,6,0" Text="Hashtag233" />
<TextBlock Margin="0,1.5,6,0" Text="Chucky_Luo" />
<TextBlock Margin="0,1.5,6,0" Text="Zerovaluelh" />
<TextBlock Margin="0,1.5,6,0" Text="JUST LIKE IT" />
<TextBlock Margin="0,1.5,6,0" Text="      极光明落" />
<TextBlock Margin="0,1.5,6,0" Text="一叶,知秋~" />
<TextBlock Margin="0,1.5,6,0" Text="joinwick789" />
<TextBlock Margin="0,1.5,6,0" Text="250的敌敌畏" />
<TextBlock Margin="0,1.5,6,0" Text="forever_晨风" />
<TextBlock Margin="0,1.5,6,0" Text="Fakecaptain" />
<TextBlock Margin="0,1.5,6,0" Text="C.肥宅快乐水" />
<TextBlock Margin="0,1.5,6,0" Text="QingYiLiang" />
<TextBlock Margin="0,1.5,6,0" Text="arcueid1023" />
<TextBlock Margin="0,1.5,6,0" Text="Mr. Narrator" />
<TextBlock Margin="0,1.5,6,0" Text="while(true){}" />
<TextBlock Margin="0,1.5,6,0" Text="Haobot2026" />
<TextBlock Margin="0,1.5,6,0" Text="粉色妖精小姐" />
<TextBlock Margin="0,1.5,6,0" Text="十六枚铜币丶" />
<TextBlock Margin="0,1.5,6,0" Text="Romarunner" />
<TextBlock Margin="0,1.5,6,0" Text="凯文卡斯兰娜" />
<TextBlock Margin="0,1.5,6,0" Text="殷殷殷!!!" />
<TextBlock Margin="0,1.5,6,0" Text="打泡泡SAMA" />
<TextBlock Margin="0,1.5,6,0" Text="猫的龙车吸引" />
<TextBlock Margin="0,1.5,6,0" Text="谁念桥边红药" />
<TextBlock Margin="0,1.5,6,0" Text="酱汁饼大可爱" />
<TextBlock Margin="0,1.5,6,0" Text="下水道的鼠鼠" />
<TextBlock Margin="0,1.5,6,0" Text="萨卡兹大蟑螂" />
<TextBlock Margin="0,1.5,6,0" Text="吃麦片的老鼠" />
<TextBlock Margin="0,1.5,6,0" Text="双狼天下第一" />
<TextBlock Margin="0,1.5,6,0" Text="丿地狱天使丿" />
<TextBlock Margin="0,1.5,6,0" Text="回忆随缘而起" />
@@ -704,63 +526,55 @@
<TextBlock Margin="0,1.5,6,0" Text="想不到丶名字" />
<TextBlock Margin="0,1.5,6,0" Text="叙事的第一周" />
<TextBlock Margin="0,1.5,6,0" Text="这位是非人类" />
<TextBlock Margin="0,1.5,6,0" Text="小石潭记qwq" />
<TextBlock Margin="0,1.5,6,0" Text="红白巫女です" />
<TextBlock Margin="0,1.5,6,0" Text="吃满保底之人" />
<TextBlock Margin="0,1.5,6,0" Text="Sylph_茜尔芙" />
<TextBlock Margin="0,1.5,6,0" Text="dadadadada" />
<TextBlock Margin="0,1.5,6,0" Text="longmao666" />
<TextBlock Margin="0,1.5,6,0" Text="Awolfofcolor" />
<TextBlock Margin="0,1.5,6,0" Text="Omori_sunny" />
<TextBlock Margin="0,1.5,6,0" Text="请不要打luosi" />
<TextBlock Margin="0,1.5,6,0" Text="qingtian4135" />
<TextBlock Margin="0,1.5,6,0" Text="xiaolong_492" />
<TextBlock Margin="0,1.5,6,0" Text="guduzihaoge" />
<TextBlock Margin="0,1.5,6,0" Text="ン黑色幽默🏮" />
<TextBlock Margin="0,1.5,6,0" Text="Rinshonagon" />
<TextBlock Margin="0,1.5,6,0" Text="Tincyclopedia" />
<TextBlock Margin="0,1.5,6,0" Text="minecraftac11" />
<TextBlock Margin="0,1.5,6,0" Text="esj554611445" />
<TextBlock Margin="0,1.5,6,0" Text="Chara&Chara" />
<TextBlock Margin="0,1.5,6,0" Text="lightning_bolt" />
<TextBlock Margin="0,1.5,6,0" Text="123456789000" />
<TextBlock Margin="0,1.5,6,0" Text="zishuijing2021" />
<TextBlock Margin="0,1.5,6,0" Text="qq1967131327" />
<TextBlock Margin="0,1.5,6,0" Text="捞猴子的月亮呐" />
<TextBlock Margin="0,1.5,6,0" Text="躁郁钢管大魅魔" />
<TextBlock Margin="0,1.5,6,0" Text="智慧树下铭记我" />
<TextBlock Margin="0,1.5,6,0" Text="无垠回荡克雷松" />
<TextBlock Margin="0,1.5,6,0" Text="泪水打湿泪水湿" />
<TextBlock Margin="0,1.5,6,0" Text="みやぐにあかり" />
<TextBlock Margin="0,1.5,6,0" Text="苇名剑圣有地绫" />
<TextBlock Margin="0,1.5,6,0" Text="搔首弄姿那些年" />
<TextBlock Margin="0,1.5,6,0" Text="逐梦青年当自强" />
<TextBlock Margin="0,1.5,6,0" Text="哈基米南北路多" />
<TextBlock Margin="0,1.5,6,0" Text="休伯利安养老院" />
<TextBlock Margin="0,1.5,6,0" Text="名为咸鱼的渣子" />
<TextBlock Margin="0,1.5,6,0" Text="零落不知猫寻海" />
<TextBlock Margin="0,1.5,6,0" Text="大脑斧和哒老虎" />
<TextBlock Margin="0,1.5,6,0" Text="再来一笼小笼包" />
<TextBlock Margin="0,1.5,6,0" Text="玩魔术的暗杀者" />
<TextBlock Margin="0,1.5,6,0" Text="只留清白在人间" />
<TextBlock Margin="0,1.5,6,0" Text="maboyuaneasy" />
<TextBlock Margin="0,1.5,6,0" Text="照井黎Terui_Rei" />
<TextBlock Margin="0,1.5,6,0" Text="约翰·冯·海格力斯" />
<TextBlock Margin="0,1.5,6,0" Text="Kiana Kasiana" />
<TextBlock Margin="0,1.5,6,0" Text="南ིྀ熙ིྀ寒ིྀ笙ིྀ" />
<TextBlock Margin="0,1.5,6,0" Text="18949212459aa" />
<TextBlock Margin="0,1.5,6,0" Text="M3GALOVANIA" />
<TextBlock Margin="0,1.5,6,0" Text="星之梦Hoshino_" />
<TextBlock Margin="0,1.5,6,0" Text="某不知名的GWM" />
<TextBlock Margin="0,1.5,6,0" Text="MrFudgeSquare" />
<TextBlock Margin="0,1.5,6,0" Text="WeimingFanzhe" />
<TextBlock Margin="0,1.5,6,0" Text="筱筱雨吖_Official" />
<TextBlock Margin="0,1.5,6,0" Text="PolarPanda2333" />
<TextBlock Margin="0,1.5,6,0" Text="大笨蛋你在里面吗" />
<TextBlock Margin="0,1.5,6,0" Text="斯卡里茨皇家铁匠" />
<TextBlock Margin="0,1.5,6,0" Text="憧憬成为冲系战狼" />
<TextBlock Margin="0,1.5,6,0" Text="把烦恼丢进云海里" />
<TextBlock Margin="0,1.5,6,0" Text="记得零食分我一半" />
<TextBlock Margin="0,1.5,6,0" Text="好好吃饭好好睡觉" />
<TextBlock Margin="0,1.5,6,0" Text="六月に舞う雪の鳶" />
<TextBlock Margin="0,1.5,6,0" Text="AAALLLAAANNN" />
<TextBlock Margin="0,1.5,6,0" Text="Minecraft_DeBug" />
<TextBlock Margin="0,1.5,6,0" Text="Black_Banana_Cat" />
<TextBlock Margin="0,1.5,6,0" Text="祖国未来的狗尾巴草" />
<TextBlock Margin="0,1.5,6,0" Text="山有扶苏,隰有荷华" />
<TextBlock Margin="0,1.5,6,0" Text="月亮呼了星星一巴掌" />
<TextBlock Margin="0,1.5,6,0" Text="窝绰承保拾憶闪富拉" />
<TextBlock Margin="0,1.5,6,0" Text="化权埵萨柯摩,隆奎" />
<TextBlock Margin="0,1.5,6,0" Text="AAA今州耙耙柑批发" />
<TextBlock Margin="0,1.5,6,0" Text="Mercuryearedrabbit" />
<TextBlock Margin="0,1.5,6,0" Text="W0nd3rfu1 H34v3n" />
<TextBlock Margin="0,1.5,6,0" Text="So Sweet Bitter Days" />
<TextBlock Margin="0,1.5,6,0" Text="没有翅膀却想飞上天空" />
<TextBlock Margin="0,1.5,6,0" Text="Exeller(没钱的腐竹)" />
<TextBlock Margin="0,1.5,6,0" Text="牛至涂芥末越冲越上头" />
<TextBlock Margin="0,1.5,6,0" Text="正电荷PositiveCharge" />
<TextBlock Margin="0,1.5,6,0" Text="沒錢點UberEats也不會變有錢" />
<TextBlock Margin="0,1.5,6,0" Text="(ꐦ°᷄д°᷅)咱也不敢问啊" />
<TextBlock Margin="0,1.5,6,0" Text="去撞南墙再撞北墙然后西墙最后东墙" />
</WrapPanel>
<Grid Height="35">
<Grid.ColumnDefinitions>
@@ -61,7 +61,7 @@
Next
Catch ex As Exception
Log(ex, "加载帮助列表 UI 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "加载帮助列表 UI 失败")
End Try
End Sub
@@ -76,7 +76,7 @@
EnterHelpPage(Entry)
End If
Catch ex As Exception
Log(ex, "处理帮助项目点击时发生意外错误", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "处理帮助项目点击时发生意外错误")
End Try
End Sub
Public Shared Sub EnterHelpPage(Location As String)
@@ -90,7 +90,7 @@
If FrmHelpDetail.Init(Entry) Then
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}})
Else
Log("[Help] 已取消进入帮助项目,这一般是由于 xaml 初始化失败,且用户在弹窗中手动放弃", NotifyLevel.DebugModeOnly)
Logger.Warn("已取消进入帮助项目,这一般是由于 xaml 初始化失败,且用户在弹窗中手动放弃")
End If
End Sub)
End Sub)
@@ -105,20 +105,11 @@
If FrmHelpDetail.Init(Entry) Then
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.HelpDetail, .Additional = {Entry, FrmHelpDetail}})
Else
Log("[Help] 已取消进入帮助项目,这一般是由于 xaml 初始化失败,且用户在弹窗中手动放弃", NotifyLevel.DebugModeOnly)
Logger.Warn("已取消进入帮助项目,这一般是由于 xaml 初始化失败,且用户在弹窗中手动放弃")
End If
End Sub)
End Sub)
End Sub
Public Shared Function GetHelpPage(Location As String) As PageOtherHelpDetail
If Not HelpLoader.State = LoadState.Finished Then HelpLoader.WaitForExit(GetUuid)
Dim FrmHelpDetail As New PageOtherHelpDetail
If FrmHelpDetail.Init(New HelpEntry(Location)) Then
Return FrmHelpDetail
Else
Throw New Exception("已取消进入帮助项目,这一般是由于 xaml 初始化失败,且用户在弹窗中手动放弃")
End If
End Function
''' <summary>
''' 搜索帮助。
@@ -22,14 +22,14 @@
Do While Content.Contains("xmlns")
Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Loop
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"" xmlns:core=""clr-namespace:MeloongCore;assembly=MeloongCore"" xmlns:corewpf=""clr-namespace:MeloongCore.Wpf;assembly=MeloongCore.Wpf"">" & Content & "</StackPanel>"
Me.Entry = Entry
PanCustom.Children.Clear()
PanCustom.Children.Add(GetObjectFromXML(Content))
Return True
Catch ex As Exception
Log("[System] 自定义信息内容:" & vbCrLf & Content)
Log(ex, "加载帮助 XAML 文件失败", NotifyLevel.MsgBox)
Logger.Info($"自定义信息内容:{vbCrLf}{Content}")
Logger.Error(ex, "加载帮助 XAML 文件失败", LogBehavior.Alert)
Return False
End Try
End Function
@@ -5,9 +5,9 @@
Private Sub PageOtherLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
'是否处于隐藏的子页面
Dim IsHiddenPage As Boolean = False
If ItemHelp.Checked AndAlso Settings.Get("UiHiddenOtherHelp") Then IsHiddenPage = True
If ItemAbout.Checked AndAlso Settings.Get("UiHiddenOtherAbout") Then IsHiddenPage = True
If ItemTest.Checked AndAlso Settings.Get("UiHiddenOtherTest") Then IsHiddenPage = True
If ItemHelp.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then IsHiddenPage = True
If ItemAbout.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then IsHiddenPage = True
If ItemTest.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest") Then IsHiddenPage = True
If PageSetupUI.HiddenForceShow Then IsHiddenPage = False
'若页面错误,或尚未加载,则继续
If IsLoad AndAlso Not IsHiddenPage Then Return
@@ -16,9 +16,9 @@
PageSetupUI.HiddenRefresh()
'选择第一个未被禁用的子页面
If IsPageSwitched Then Return
If Not Settings.Get("UiHiddenOtherHelp") Then
If Not Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then
ItemHelp.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenOtherAbout") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then
ItemAbout.SetChecked(True, False, False)
Else
ItemTest.SetChecked(True, False, False)
@@ -37,9 +37,9 @@
Public Sub New()
InitializeComponent()
'选择第一个未被禁用的子页面
If Not Settings.Get("UiHiddenOtherHelp") Then
If Not Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then
PageID = FormMain.PageSubType.OtherHelp
ElseIf Not Settings.Get("UiHiddenOtherAbout") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then
PageID = FormMain.PageSubType.OtherAbout
Else
PageID = FormMain.PageSubType.OtherTest
@@ -83,7 +83,7 @@
PageChangeRun(PageGet(ID))
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败(ID " & ID & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换分页面失败(ID {ID})")
Finally
AniControlEnabled -= 1
End Try
@@ -131,7 +131,12 @@
e.Handled = True
End Sub
Public Shared Sub TryFeedback()
If Not CanFeedback(True) Then Return
If False.Equals(PageSetupSystem.IsLauncherNewest) Then
If MyMsgBox($"你的 PCL 不是最新版,因此无法提交反馈。{vbCrLf}请在更新后,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
UpdateCheckByButton()
End If
Return
End If
Select Case MyMsgBox("在提交新反馈前,建议先搜索反馈列表,以避免重复提交。" & vbCrLf & "如果无法打开该网页,请使用 VPN 改善网络环境。",
"反馈", "提交新反馈", "查看反馈列表", "取消")
Case 1
@@ -81,14 +81,14 @@
End Sub
NewItem.Buttons = {NewIconButton}
FrmSelectLeft.PanList.Children.Add(NewItem)
Log("[Minecraft] 有效的 Minecraft 文件夹:" & Folder.Name & " > " & Folder.Location)
Logger.Info($"有效的 Minecraft 文件夹:{Folder.Name} > {Folder.Location}")
Next
'标题文本
FrmSelectLeft.PanList.Children.Add(New TextBlock With {.Text = "添加或导入", .Margin = New Thickness(13, 18, 5, 4), .Opacity = 0.6, .FontSize = 12})
'确认创建按钮状态
If Not Directory.Exists(PathExeFolder & ".minecraft\") Then
If Not DirectoryUtils.Exists(PathExeFolder & ".minecraft\") Then
Dim ItemCreate As New MyListItem With {.IsScaleAnimationEnabled = False, .Type = MyListItem.CheckType.Clickable, .Title = "新建 .minecraft 文件夹", .Height = 34,
.ToolTip = "在 PCL 当前所在文件夹下创建新的 .minecraft 文件夹",
.LogoScale = 0.9,
@@ -138,7 +138,7 @@
End If
Catch ex As Exception
Log(ex, "构建 Minecraft 文件夹列表 UI 出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "构建 Minecraft 文件夹列表 UI 出错")
Finally
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") '刷新版本列表
End Try
@@ -155,8 +155,8 @@
End If
Try
'获取输入
NewFolder = SelectFolder()
If NewFolder = "" Then Return
NewFolder = Dialogs.SelectFolder("选择 Minecraft 文件夹", False).FirstOrDefault
If NewFolder Is Nothing Then Return
If NewFolder.Contains("!") OrElse NewFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Red) : Return
'要求输入显示名称
Dim SplitedNames As String() = NewFolder.TrimEnd("\").Split("\")
@@ -168,7 +168,7 @@
'添加文件夹
AddFolder(NewFolder, NewName, True)
Catch ex As Exception
Log(ex, "添加文件夹失败(" & NewFolder & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"添加文件夹失败({NewFolder})")
End Try
End Sub
''' <summary>
@@ -190,15 +190,15 @@
End If
'检查实际的 Minecraft 文件夹位置(没有问题,或是在子文件夹中)
If Not CheckPermission(FolderPath & "versions\") Then
For Each Folder As DirectoryInfo In New DirectoryInfo(FolderPath).GetDirectories
If CheckPermission(Folder.FullName & "\versions\") Then
FolderPath = Folder.FullName & "\"
For Each Folder In DirectoryUtils.GetDirectories(FolderPath)
If CheckPermission(Folder & "\versions\") Then
FolderPath = Folder & "\"
Exit For
End If
Next
End If
'判断是否已经添加过,若添加过则直接修改自定义名
Dim Folders As New List(Of String)(Settings.Get("LaunchFolders").ToString.Split("|"))
Dim Folders As New List(Of String)(Settings.Get(Of String)("LaunchFolders").Split("|"))
Dim IsAdded As Boolean = False
Dim IsReplace As Boolean = False
For i = 0 To Folders.Count - 1
@@ -229,10 +229,10 @@
If ShowHint Then Hint("文件夹 " & DisplayName & " 已添加!", HintType.Green)
'检查是否为根目录整合包,自动关闭版本隔离
'1. 根目录中存在数个 Mod
Dim ModFolder As New DirectoryInfo(FolderPath & "mods\")
Dim ModFolder = DirectoryUtils.GetInfo(FolderPath & "mods\")
If Not (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count >= 3) Then Return
'2. 版本数较少,可能为整合包
Dim VersionFolderInfo As New DirectoryInfo(FolderPath & "versions\")
Dim VersionFolderInfo = DirectoryUtils.GetInfo(FolderPath & "versions\")
If Not (VersionFolderInfo.Exists AndAlso VersionFolderInfo.EnumerateDirectories.Count <= 3) Then Return
'3. 能够找到可安装 Mod 的版本
For Each VersionFolder In VersionFolderInfo.EnumerateDirectories
@@ -240,15 +240,15 @@
Instance.Load()
If Not Instance.Modable Then Continue For
'4. 该版本的隔离文件夹下不存在 mods
Dim ModIndieFolder As New DirectoryInfo(Instance.PathVersion & "mods\")
Dim ModIndieFolder = DirectoryUtils.GetInfo(Instance.PathVersion & "mods\")
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Return
'满足以上全部条件则视为根目录整合包
Settings.Set("VersionArgumentIndie", 2, Instance:=Instance)
Settings.Set("VersionArgumentIndieV2", False, Instance:=Instance)
Log("[Setup] 已自动关闭单版本隔离:" & Instance.Name, NotifyLevel.DebugModeOnly)
Logger.Warn($"已自动关闭单版本隔离:{Instance.Name}")
Next
Catch ex As Exception
Log(ex, "向文件夹列表中添加新文件夹失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "向文件夹列表中添加新文件夹失败")
End Try
End Sub)
End Sub
@@ -265,11 +265,11 @@
End Sub
Public Shared Sub CreateMcFolderInCurrentPath()
McFolderSelected = PathExeFolder & ".minecraft\"
If Not Directory.Exists(McFolderSelected) Then
If Not DirectoryUtils.Exists(McFolderSelected) Then
DirectoryUtils.Create(McFolderSelected & "versions\")
McFolderLauncherProfilesJsonCreate(McFolderSelected)
End If
AddFolder(McFolderSelected, GetFolderNameFromPath(PathExeFolder), False)
AddFolder(McFolderSelected, PathUtils.GetLastPart(PathExeFolder), False)
End Sub
'右键菜单
@@ -282,12 +282,10 @@
Select Case MyMsgBox("是否需要清理 PCL 在该文件夹中的配置文件?" & vbCrLf & "这包括各个版本的独立设置(如自定义图标、第三方登录配置)等,对游戏本身没有影响。", "配置文件清理", "删除", "保留", "取消")
Case 1
'删除配置文件
If File.Exists(Target.Location & "PCL.ini") Then File.Delete(Target.Location & "PCL.ini")
If Directory.Exists(Target.Location & "versions\") Then
For Each InstanceInfo In New DirectoryInfo(Target.Location & "versions\").EnumerateDirectories
If Directory.Exists(InstanceInfo.FullName & "\PCL\") Then DeleteDirectory(InstanceInfo.FullName & "\PCL\", True)
Next
End If
FileUtils.Delete(Target.Location & "PCL.ini")
For Each Instance In DirectoryUtils.GetDirectories(Target.Location & "versions\", True)
DirectoryUtils.Delete(Path.Combine(Instance, "PCL"), True)
Next
Case 2
'不删除
Case 3
@@ -299,7 +297,7 @@
Hint(If(Target.Type = McFolder.Types.Custom, "文件夹 " & DeletedName & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Green)
McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception
Log(ex, "从列表中移除游戏文件夹失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "从列表中移除游戏文件夹失败")
End Try
End Sub
Public Sub Delete_Click(sender As Object, e As RoutedEventArgs)
@@ -320,11 +318,11 @@
'删除文件夹
Try
Hint("正在" & DeleteText & "文件夹 " & Target.Name & "!", HintType.Blue)
DeleteDirectory(Target.Location)
DirectoryUtils.Delete(Target.Location)
If DeleteText = "清空" Then DirectoryUtils.Create(Target.Location)
Hint("已" & DeleteText & "文件夹 " & Target.Name & "!", HintType.Green)
Catch ex As Exception
Log(ex, DeleteText & "文件夹 " & Target.Name & " 失败", NotifyLevel.AllUsers)
Logger.Error(ex, $"{DeleteText}文件夹 {Target.Name} 失败", LogBehavior.Toast)
Finally
'刷新列表
McFolderListLoader.Start(IsForceRestart:=True)
@@ -337,7 +335,7 @@
''' </summary>
Private Shared Function RemoveFolderFromSetup(Target As McFolder) As String
Dim DeletedName As String = Nothing
Dim Folders = Settings.Get("LaunchFolders").ToString.Split({"|"c}, StringSplitOptions.RemoveEmptyEntries).ToList
Dim Folders = Settings.Get(Of String)("LaunchFolders").Split("|"c, True).ToList
For Each Folder In Folders.ToList
If Not Folder.EndsWithF(Target.Location) Then Continue For
DeletedName = Folder.BeforeFirst(">")
@@ -371,7 +369,7 @@
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
If String.IsNullOrWhiteSpace(NewName) Then Return
'修改自定义名
Dim Folders As New List(Of String)(Settings.Get("LaunchFolders").ToString.Split("|"))
Dim Folders As New List(Of String)(Settings.Get(Of String)("LaunchFolders").Split("|"))
Dim IsAdded As Boolean = False
For i = 0 To Folders.Count - 1
Dim FolderCurrent As String = Folders(i)
@@ -394,7 +392,7 @@
Settings.Set("LaunchFolders", Folders.Join("|"))
McFolderListLoader.Start(IsForceRestart:=True)
Catch ex As Exception
Log(ex, "重命名文件夹失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "重命名文件夹失败")
End Try
End Sub
@@ -102,7 +102,7 @@
Else
LabEmptyTitle.Text = "无可用版本"
LabEmptyContent.Text = "未找到任何版本的游戏,请先下载任意版本的游戏。" & vbCrLf & "若有已存在的游戏,请在左边的列表中选择添加文件夹,选择 .minecraft 文件夹将其导入。"
BtnEmptyDownload.Visibility = If(Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
BtnEmptyDownload.Visibility = If(Settings.Get(Of Boolean)("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If
Else
PanBack.Visibility = Visibility.Visible
@@ -110,7 +110,7 @@
End If
Catch ex As Exception
Log(ex, "将版本列表转换显示时失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "将版本列表转换显示时失败")
End Try
End Sub
Public Shared Sub McInstanceListContent(sender As MyListItem, e As EventArgs)
@@ -204,13 +204,8 @@
If(IsHintIndie, vbCrLf & "由于该版本开启了版本隔离,删除版本时该版本对应的存档、资源包、Mod 等文件也将被一并删除!", ""),
"版本删除确认", , "取消",, True)
Case 1
IniClearCache(Instance.PathIndie & "options.txt")
IniClearCache(Instance.PathVersion & "PCL\Setup.ini")
If IsShiftPressed Then
DeleteDirectory(Instance.PathVersion)
Else
FileIO.FileSystem.DeleteDirectory(Instance.PathVersion, FileIO.UIOption.AllDialogs, FileIO.RecycleOption.SendToRecycleBin)
End If
Instance.ResetIniCache()
DirectoryUtils.Delete(Instance.PathVersion, Not IsShiftPressed)
Hint("版本 " & Instance.Name & " 已删除!", HintType.Green)
Case 2
Return
@@ -238,14 +233,14 @@
LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End If
Catch ex As OperationCanceledException
Log(ex, "删除版本 " & Instance.Name & " 被主动取消")
Logger.Warn(ex, $"删除版本 {Instance.Name} 被主动取消")
Catch ex As Exception
Log(ex, "删除版本 " & Instance.Name & " 失败", NotifyLevel.MsgBox)
Logger.Error(ex, $"删除版本 {Instance.Name} 失败", LogBehavior.Alert)
End Try
End Sub
Public Sub BtnEmptyDownload_Loaded() Handles BtnEmptyDownload.Loaded
Dim NewVisibility = If((Settings.Get("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse ShowHidden, Visibility.Collapsed, Visibility.Visible)
Dim NewVisibility = If((Settings.Get(Of Boolean)("UiHiddenPageDownload") AndAlso Not PageSetupUI.HiddenForceShow) OrElse ShowHidden, Visibility.Collapsed, Visibility.Visible)
If BtnEmptyDownload.Visibility <> NewVisibility Then
BtnEmptyDownload.Visibility = NewVisibility
PanLoad.TriggerForceResize()
@@ -8,7 +8,7 @@
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,25,25,10">
<local:MyCard x:Name="CardArgument" Margin="0,0,0,15" Title="启动选项">
<StackPanel Margin="25,40,25,15">
<StackPanel Margin="25,40,25,25">
<Grid>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
@@ -29,7 +29,6 @@
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="默认版本隔离" Margin="0,0,25,0" />
<local:MyComboBox local:SettingService.Key="LaunchArgumentIndieV2" x:Name="ComboArgumentIndieV2"
@@ -50,7 +49,7 @@
Grid.Row="2" Grid.ColumnSpan="2" Grid.Column="1" ToolTip="自定义游戏窗口的标题,若留空则不进行更改。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。" HintText="默认" MaxLength="100" />
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="自定义信息" Margin="0,0,25,0" />
<local:MyTextBox local:SettingService.Key="LaunchArgumentInfo"
Grid.Row="4" Grid.ColumnSpan="2" Text="PCL" Grid.Column="1" ToolTip="该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。">
Grid.Row="4" Grid.ColumnSpan="2" Text="PCL" Grid.Column="1" ToolTip="注意:Mojang 于 Minecraft 26.1 移除了该设置,因此该设置在新版本中无效。&#xa;&#xa;该信息会显示在游戏主界面的左下角,与 F3 调试页面的左上角。&#xa;你可以用替换标记来动态改变其内容,在 更多 → 帮助 中搜索 “替换标记” 以了解用法。">
<local:MyTextBox.ValidateRules>
<local:ValidateExcept>
<local:ValidateExcept.Excepts>
@@ -106,21 +105,24 @@
</local:MyTextBox.ValidateRules>
</local:MyTextBox>
</Grid>
<TextBlock VerticalAlignment="Center" Grid.Row="12" HorizontalAlignment="Left" Text="游戏 Java" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboArgumentJava" Grid.ColumnSpan="2" Grid.Row="12" Grid.Column="1"
ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹,在进行自动选择时 PCL 会尽量优先选择它">
<ComboBoxItem Content="加载中……" IsSelected="True" />
<!--<local:MyComboBoxItem Content="Java 8 (1.8.0_171),64 位:C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" IsSelected="True" ToolTip="C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" />-->
</local:MyComboBox>
<Grid Grid.Row="13" Grid.Column="1">
<TextBlock VerticalAlignment="Center" Grid.Row="12" HorizontalAlignment="Left" Text="Java" Margin="0,0,25,0" />
<Grid Grid.ColumnSpan="2" Grid.Row="12" Grid.Column="1" HorizontalAlignment="Stretch">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<Path Height="16" HorizontalAlignment="Left" Stretch="Uniform" Margin="6,10.5,0,0" Data="F1 M 20,17L 43.25,17L 56,29.75L 56,40L 52,37.5L 52,34L 39,34L 39,21L 24,21L 24,55L 36,55L 32,59L 20,59L 20,17 Z M 43,22.25L 43,30L 50.75,30L 43,22.25 Z M 48,38C 53.5228,38 58,42.4772 58,48C 58,53.5229 53.5228,58 48,58C 46.1455,58 44.4089,57.4952 42.9201,56.6155L 36.1213,63.4142C 35.3403,64.1953 34.0739,64.1953 33.2929,63.4142L 32.5858,62.7071C 31.8047,61.9261 31.8047,60.6597 32.5858,59.8787L 39.3845,53.0799C 38.5048,51.5911 38,49.8545 38,48C 38,42.4772 42.4771,38 48,38 Z M 48,42C 44.6863,42 42,44.6863 42,48C 42,51.3137 44.6863,54 48,54C 51.3137,54 54,51.3137 54,48C 54,44.6863 51.3137,42 48,42 Z" VerticalAlignment="Top" Fill="{Binding Foreground, ElementName=BtnArgumentJavaSearch}" />
<local:MyTextButton HorizontalAlignment="Left" x:Name="BtnArgumentJavaSearch" Text="自动搜索" Padding="25,10,5,5" Grid.Row="5" VerticalContentAlignment="Top" />
<Path Height="16" VerticalAlignment="Top" HorizontalAlignment="Left" Stretch="Uniform" Margin="22,10.5,0,0" Grid.Column="1" StrokeThickness="0.5" Data="M827.4 589.1l-30.7-50.7V151.3c0-29.9-25.2-54.3-56.1-54.3h-527c-9.9 0-24.8 6.3-24.8 24.8v700.5c0 20.2 12.1 37 31.7 43.8l169.1 58.6c4.4 1.5 9.1 2.3 13.8 2.3 10.2 0 20.7-3.4 29.9-10 12.9-9.2 20.3-22.4 20.3-36.2l-0.1-16.6h325.7c30.9 0 56.1-24.3 56.1-54.3v-193c0-9.8-2.7-19.4-7.9-27.8z m-423.5 288l-165.6-54.8V153.8l201.5 51.4v439.2c-0.1 0.5-0.8 2.6-3.2 5.3l-20.9 23.4c-7.6 8.4-11.7 18.7-11.7 28.9v175.1zM785.7 810c0 2.2-2.6 4.6-6.4 4.6h-326l-0.6-108.4 20.9-23.4c10.2-11.4 15.9-25 15.9-38.2V205.2c0-21.6-14-39.3-35.7-45.1l-50.4-13.4h337.3c3.8 0 6.4 2.4 6.4 4.6v387.1c0 9.7 2.7 19.4 8 27.9l30.7 50.7v193z" Stroke="{Binding Foreground, ElementName=BtnArgumentJavaSelect}" Fill="{Binding Foreground, ElementName=BtnArgumentJavaSelect}" />
<local:MyTextButton x:Name="BtnArgumentJavaSelect" Margin="17,0,0,0" Padding="24.5,10,5,5" Text="手动导入" Grid.Row="5" Grid.Column="1" VerticalContentAlignment="Top" HorizontalAlignment="Left" />
<local:MyComboBox
x:Name="ComboArgumentJava" Grid.Column="0" ToolTip="若将 Java 放在游戏文件夹或 PCL 文件夹,在进行自动选择时 PCL 会尽量优先选择它">
<ComboBoxItem Content="加载中……" IsSelected="True" />
<!--<local:MyComboBoxItem Content="Java 8 (1.8.0_171),64 位:C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5" IsSelected="True" ToolTip="C:\Program Files (x86)\Common Files\Oracle\Java\javapath\javaw.exe" />-->
</local:MyComboBox>
<local:MyIconTextButton Margin="5,0,0,0"
x:Name="BtnArgumentJavaSearch" Text="搜索" Grid.Column="1"
Logo="F1 M 20,17L 43.25,17L 56,29.75L 56,40L 52,37.5L 52,34L 39,34L 39,21L 24,21L 24,55L 36,55L 32,59L 20,59L 20,17 Z M 43,22.25L 43,30L 50.75,30L 43,22.25 Z M 48,38C 53.5228,38 58,42.4772 58,48C 58,53.5229 53.5228,58 48,58C 46.1455,58 44.4089,57.4952 42.9201,56.6155L 36.1213,63.4142C 35.3403,64.1953 34.0739,64.1953 33.2929,63.4142L 32.5858,62.7071C 31.8047,61.9261 31.8047,60.6597 32.5858,59.8787L 39.3845,53.0799C 38.5048,51.5911 38,49.8545 38,48C 38,42.4772 42.4771,38 48,38 Z M 48,42C 44.6863,42 42,44.6863 42,48C 42,51.3137 44.6863,54 48,54C 51.3137,54 54,51.3137 54,48C 54,44.6863 51.3137,42 48,42 Z" />
<local:MyIconTextButton
x:Name="BtnArgumentJavaSelect" Text="导入" Grid.Column="2"
Logo="M827.4 589.1l-30.7-50.7V151.3c0-29.9-25.2-54.3-56.1-54.3h-527c-9.9 0-24.8 6.3-24.8 24.8v700.5c0 20.2 12.1 37 31.7 43.8l169.1 58.6c4.4 1.5 9.1 2.3 13.8 2.3 10.2 0 20.7-3.4 29.9-10 12.9-9.2 20.3-22.4 20.3-36.2l-0.1-16.6h325.7c30.9 0 56.1-24.3 56.1-54.3v-193c0-9.8-2.7-19.4-7.9-27.8z m-423.5 288l-165.6-54.8V153.8l201.5 51.4v439.2c-0.1 0.5-0.8 2.6-3.2 5.3l-20.9 23.4c-7.6 8.4-11.7 18.7-11.7 28.9v175.1zM785.7 810c0 2.2-2.6 4.6-6.4 4.6h-326l-0.6-108.4 20.9-23.4c10.2-11.4 15.9-25 15.9-38.2V205.2c0-21.6-14-39.3-35.7-45.1l-50.4-13.4h337.3c3.8 0 6.4 2.4 6.4 4.6v387.1c0 9.7 2.7 19.4 8 27.9l30.7 50.7v193z" />
</Grid>
</Grid>
</StackPanel>
@@ -291,7 +293,7 @@
<local:MyCheckBox Height="28" Text="禁用 Java Launch Wrapper" local:SettingService.Key="LaunchAdvanceDisableJLW"
ToolTipService.Placement="Right" ToolTip="是否使用 Java Launch Wrapper 修复 Java 18- 在中文路径下可能无法正常启动的问题。&#xa;详见:https://github.com/00ll00/java_launch_wrapper" />
<local:MyCheckBox Height="28" Text="禁用 LWJGL Unsafe Agent" local:SettingService.Key="LaunchAdvanceDisableLUA"
ToolTipService.Placement="Right" ToolTip="是否使用 LWJGL Unsafe Agent 修复 Java 25+ 的一个性能问题。&#xa;详见:https://github.com/HMCL-dev/lwjgl-unsafe-agent" />
ToolTipService.Placement="Right" ToolTip="是否使用 LWJGL Unsafe Agent 修复 LWJGL 3.4.1 的一个性能问题。&#xa;详见:https://github.com/HMCL-dev/lwjgl-unsafe-agent" />
<local:MyCheckBox Height="28" Text="使用高性能显卡" local:SettingService.Key="LaunchAdvanceGraphicCard"
ToolTipService.Placement="Right" ToolTip="自动在 Windows 设置 → 系统 → 屏幕 → 显示卡 中将 PCL 和 Java 改为使用高性能显卡。&#xa;如果同时有集成显卡和独立显卡,这能确保 MC 使用独立显卡进行渲染,以大幅提高帧率。" />
</StackPanel>
@@ -27,10 +27,10 @@
UpdateRamType()
UpdateJavaComboBox()
Catch ex As NullReferenceException
Log(ex, "启动设置项存在异常,已被自动重置", NotifyLevel.MsgBox)
Logger.Error(ex, "启动设置项存在异常,已被自动重置", LogBehavior.Alert)
Reset()
Catch ex As Exception
Log(ex, "重载启动设置时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "重载启动设置时出错")
End Try
End Sub
Public Sub Reset()
@@ -42,7 +42,7 @@
JavaSearchLoader.Start(IsForceRestart:=True)
Hint("已初始化启动设置!", HintType.Green)
Catch ex As Exception
Log(ex, "初始化启动设置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "初始化启动设置失败", LogBehavior.Alert)
End Try
Refresh()
End Sub
@@ -57,7 +57,7 @@
Private Sub RadioSkinType3_Check(sender As Object, e As RouteEventArgs) Handles RadioSkinType4.PreviewCheck
If Not (AniControlEnabled = 0 AndAlso e.RaiseByMouse) Then Return
'已有图片则不再选择
If File.Exists(PathAppdata & "CustomSkin.png") Then Return
If FileUtils.Exists(PathAppdata & "CustomSkin.png") Then Return
'没有图片则要求选择
Dim SkinInfo As McSkinInfo = McSkinSelect()
If Not SkinInfo.IsVaild Then
@@ -70,9 +70,8 @@
'返回是否成功改变
Private Function ChangeSkin(SkinInfo As McSkinInfo) As Boolean
Try
'拷贝文件
File.Delete(PathAppdata & "CustomSkin.png")
CopyFile(SkinInfo.LocalFile, PathAppdata & "CustomSkin.png")
'复制文件
FileUtils.Copy(SkinInfo.LocalFile, PathAppdata & "CustomSkin.png")
'将单层皮肤扩展到双层
Dim Bitmap As New MyBitmap(PathAppdata & "CustomSkin.png")
If Bitmap.Pic.Width = 64 AndAlso Bitmap.Pic.Height = 32 Then
@@ -81,15 +80,15 @@
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(NewBitmap)
g.DrawImageUnscaled(Img, New System.Drawing.Point(0, 0))
End Using
File.Delete(PathAppdata & "CustomSkin.png")
FileUtils.Delete(PathAppdata & "CustomSkin.png")
NewBitmap.Save(PathAppdata & "CustomSkin.png")
End If
'更新设置
Settings.Set("LaunchSkinSlim", SkinInfo.IsSlim)
ChangeSkin = True
Return True
Catch ex As Exception
Log(ex, "改变离线皮肤失败", NotifyLevel.MsgBox)
ChangeSkin = False
Logger.Error(ex, "改变离线皮肤失败", LogBehavior.Alert)
Return False
Finally
'设置当前显示
PageLaunchLeft.SkinLegacy.Start(IsForceRestart:=True)
@@ -97,11 +96,11 @@
End Function
Private Sub BtnSkinDelete_Click(sender As Object, e As EventArgs) Handles BtnSkinDelete.Click
Try
File.Delete(PathAppdata & "CustomSkin.png")
FileUtils.Delete(PathAppdata & "CustomSkin.png")
RadioSkinType0.SetChecked(True, True)
Hint("离线皮肤已清空!", HintType.Green)
Catch ex As Exception
Log(ex, "清空离线皮肤失败", NotifyLevel.MsgBox)
Logger.Error(ex, "清空离线皮肤失败", LogBehavior.Alert)
End Try
End Sub
Private Sub BtnSkinSave_Click(sender As Object, e As EventArgs) Handles BtnSkinSave.Click
@@ -115,7 +114,7 @@
PageLaunchLeft.SkinLegacy.Start()
'设置 UI 改变
If FrmSetupLaunch Is Nothing Then Return
Select Case Settings.Get("LaunchSkinType")
Select Case Settings.Get(Of Integer)("LaunchSkinType")
Case 0, 1, 2 '默认
FrmSetupLaunch.PanSkinID.Visibility = Visibility.Collapsed
FrmSetupLaunch.PanSkinChange.Visibility = Visibility.Collapsed
@@ -135,7 +134,7 @@
Public Shared Sub UpdateRamType()
If FrmSetupLaunch?.SliderRamCustom Is Nothing Then Return
FrmSetupLaunch.SliderRamCustom.IsEnabled = Settings.Get("LaunchRamType") = 1
FrmSetupLaunch.SliderRamCustom.IsEnabled = Settings.Get(Of Integer)("LaunchRamType") = 1
End Sub
''' <summary>
@@ -278,7 +277,7 @@
'------------------------------------------
Dim RamGive As Double
If Settings.Get("LaunchRamType") = 0 Then
If Settings.Get(Of Integer)("LaunchRamType") = 0 Then
'自动配置
Dim RamAvailable As Double = Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10
'确定需求的内存值
@@ -289,7 +288,7 @@
If Instance IsNot Nothing AndAlso Not Instance.IsLoaded Then Instance.Load()
If Instance IsNot Nothing AndAlso Instance.Modable Then
'可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Instance.PathIndie & "mods\")
Dim ModDir = DirectoryUtils.GetInfo(Instance.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Count(Function(f) {".jar", ".zip", ".litemod"}.Contains(f.Extension.Lower)), 0)
RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90
@@ -334,7 +333,7 @@ PreFin:
RamGive = Math.Round(Math.Max(RamGive, RamMininum), 1)
Else
'手动配置
Dim Value As Integer = Settings.Get("LaunchRamCustom")
Dim Value = Settings.Get(Of Integer)("LaunchRamCustom")
If Value <= 12 Then
RamGive = Value * 0.1 + 0.3
ElseIf Value <= 25 Then
@@ -359,10 +358,10 @@ PreFin:
If ComboArgumentJava Is Nothing Then Return
'初始化列表
ComboArgumentJava.Items.Clear()
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择合适的 Java", .Tag = "自动选择"})
ComboArgumentJava.Items.Add(New MyComboBoxItem With {.Content = "自动选择(推荐)", .Tag = "自动选择"})
'更新列表
Dim SelectedItem As MyComboBoxItem = Nothing
Dim SelectedBySetup As String = Settings.Get("LaunchArgumentJavaSelect")
Dim SelectedBySetup As String = Settings.Get(Of String)("LaunchArgumentJavaSelect")
Try
For Each Java In JavaList.ToList().OrderByDescending(Function(v) v.MajorVersion)
Dim ListItem = New MyComboBoxItem With {.Content = Java.ToString, .ToolTip = Java.PathFolder, .Tag = Java}
@@ -374,7 +373,7 @@ PreFin:
Next
Catch ex As Exception
Settings.Set("LaunchArgumentJavaSelect", "")
Log(ex, "更新设置 Java 下拉框失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "更新设置 Java 下拉框失败")
End Try
'更新选择项
If SelectedItem Is Nothing AndAlso JavaList.Any Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择”
@@ -403,11 +402,11 @@ PreFin:
If "自动选择".Equals(SelectedJava) Then
'选择 “自动”
Settings.Set("LaunchArgumentJavaSelect", "")
Log("[Java] 修改 Java 选择设置:自动选择")
Logger.Info("修改 Java 选择设置:自动选择")
Else
'选择指定项
Settings.Set("LaunchArgumentJavaSelect", CType(SelectedJava.ToJson(), JObject).ToString(Newtonsoft.Json.Formatting.None))
Log("[Java] 修改 Java 选择设置:" & SelectedJava.ToString)
Logger.Info($"修改 Java 选择设置:{SelectedJava}")
End If
RefreshRam(True)
End Sub
@@ -419,16 +418,16 @@ PreFin:
Return
End If
'选择 Java
Dim JavaSelected As String = SelectFile("javaw.exe|javaw.exe", "选择 bin 文件夹中的 javaw.exe 文件")
If JavaSelected = "" Then Return
JavaSelected = GetPathFromFullPath(JavaSelected)
Dim JavaSelected As String = Dialogs.SelectFile("选择 bin 文件夹中的 javaw.exe 文件", False, filter:={({"exe"}, "javaw.exe")}).FirstOrDefault()
If String.IsNullOrEmpty(JavaSelected) Then Return
JavaSelected = PathUtils.AddSlashSuffix(PathUtils.RemoveLastPart(JavaSelected))
Try
'验证 Java 可用
Dim NewEntry As New JavaEntry(JavaSelected, True)
NewEntry.Check()
'加入列表
Dim JavaNewList As New JArray From {NewEntry.ToJson}
For Each JsonEntry In GetJson(Settings.Get("LaunchArgumentJavaAll"))
For Each JsonEntry In GetJson(Settings.Get(Of String)("LaunchArgumentJavaAll"))
Dim Entry = JavaEntry.FromJson(JsonEntry)
If Entry.PathFolder = NewEntry.PathFolder Then Continue For
JavaNewList.Add(JsonEntry)
@@ -438,7 +437,7 @@ PreFin:
JavaSearchLoader.Start(IsForceRestart:=True)
Hint("已将该 Java 加入 Java 列表!", HintType.Green)
Catch ex As Exception
Log(ex, "该 Java 存在异常,无法使用", NotifyLevel.MsgBox, "异常的 Java")
Logger.Error(ex, "该 Java 存在异常,无法使用", LogBehavior.Alert)
Return
End Try
End Sub
@@ -488,7 +487,7 @@ PreFin:
If Not CheckArgumentRam.Checked Then Return
If MyMsgBox("内存优化会显著延长启动耗时,建议仅在内存不足时开启。" & vbCrLf &
"如果你在使用机械硬盘,这还可能导致一小段时间的严重卡顿。" &
If(IsAdmin(), "", $"{vbCrLf}{vbCrLf}每次启动游戏,PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限,可以右键 PCL,打开 属性 → 兼容性 → 以管理员身份运行此程序。"),
If(SystemUtils.HasAdminRole(), "", $"{vbCrLf}{vbCrLf}每次启动游戏,PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限,可以右键 PCL,打开 属性 → 兼容性 → 以管理员身份运行此程序。"),
"提醒", "确定", "取消") = 2 Then
CheckArgumentRam.Checked = False
End If
@@ -5,10 +5,10 @@
Private Sub PageSetupLeft_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
'是否处于隐藏的子页面
Dim IsHiddenPage As Boolean = False
If ItemLaunch.Checked AndAlso Settings.Get("UiHiddenSetupLaunch") Then IsHiddenPage = True
If ItemUI.Checked AndAlso Settings.Get("UiHiddenSetupUi") Then IsHiddenPage = True
If ItemSystem.Checked AndAlso Settings.Get("UiHiddenSetupSystem") Then IsHiddenPage = True
If ItemLink.Checked AndAlso Settings.Get("UiHiddenSetupLink") Then IsHiddenPage = True
If ItemLaunch.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLaunch") Then IsHiddenPage = True
If ItemUI.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupUi") Then IsHiddenPage = True
If ItemSystem.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupSystem") Then IsHiddenPage = True
If ItemLink.Checked AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLink") Then IsHiddenPage = True
If PageSetupUI.HiddenForceShow Then IsHiddenPage = False
'若页面错误,或尚未加载,则继续
If IsLoad AndAlso Not IsHiddenPage Then Return
@@ -17,13 +17,13 @@
PageSetupUI.HiddenRefresh()
'选择第一个未被禁用的子页面
If IsPageSwitched Then Return
If Not Settings.Get("UiHiddenSetupLaunch") Then
If Not Settings.Get(Of Boolean)("UiHiddenSetupLaunch") Then
ItemLaunch.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenSetupUi") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupUi") Then
ItemUI.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenSetupSystem") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupSystem") Then
ItemSystem.SetChecked(True, False, False)
ElseIf Not Settings.Get("UiHiddenSetupLink") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupLink") Then
ItemLink.SetChecked(True, False, False)
Else
ItemLaunch.SetChecked(True, False, False)
@@ -42,13 +42,13 @@
Public Sub New()
InitializeComponent()
'选择第一个未被禁用的子页面
If Not Settings.Get("UiHiddenSetupLaunch") Then
If Not Settings.Get(Of Boolean)("UiHiddenSetupLaunch") Then
PageID = FormMain.PageSubType.SetupLaunch
ElseIf Not Settings.Get("UiHiddenSetupUi") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupUi") Then
PageID = FormMain.PageSubType.SetupUI
ElseIf Not Settings.Get("UiHiddenSetupSystem") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupSystem") Then
PageID = FormMain.PageSubType.SetupSystem
ElseIf Not Settings.Get("UiHiddenSetupLink") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenSetupLink") Then
PageID = FormMain.PageSubType.SetupLink
Else
PageID = FormMain.PageSubType.SetupLaunch
@@ -115,7 +115,7 @@
PageID = ID
Catch ex As Exception
Log(ex, "切换分页面失败(ID " & ID & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"切换分页面失败(ID {ID})")
Finally
AniControlEnabled -= 1
End Try
@@ -23,10 +23,10 @@
Public Sub Reset()
Try
SettingService.ResetSettings(Me)
Log("[Setup] 已初始化联机页设置")
Logger.Info("已初始化联机页设置")
Hint("已初始化联机页设置!", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化联机页设置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "初始化联机页设置失败", LogBehavior.Alert)
End Try
Reload()
End Sub
@@ -30,10 +30,10 @@
Public Sub Reset()
Try
SettingService.ResetSettings(Me)
Log("[Setup] 已初始化启动器页设置")
Logger.Info("已初始化启动器页设置")
Hint("已初始化启动器页设置!", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化启动器页设置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "初始化启动器页设置失败", LogBehavior.Alert)
End Try
Reload()
End Sub
@@ -58,7 +58,7 @@
End Sub
Private Sub SliderDownloadThread_PreviewChange(sender As Object, e As RouteEventArgs) Handles SliderDownloadThread.PreviewChange
If SliderDownloadThread.Value < 100 Then Return
If Not Settings.Get("HintDownloadThread") Then
If Not Settings.Get(Of Boolean)("HintDownloadThread") Then
Settings.Set("HintDownloadThread", True)
MyMsgBox("如果设置过多的下载线程,可能会导致下载时出现非常严重的卡顿。" & vbCrLf &
"一般设置 64 线程即可满足大多数下载需求,除非你知道你在干什么,否则不建议设置更多的线程数!", "警告", "我知道了", IsWarn:=True)
@@ -109,12 +109,12 @@
Public Shared Function IsLauncherNewest() As Boolean?
Try
'确认服务器公告是否正常
Dim ServerContent As String = ReadFile(PathTemp & "Cache\Notice.cfg")
Dim ServerContent As String = If(FileUtils.TryReadAsString(PathTemp & "Cache\Notice.cfg"), "")
If ServerContent.Split("|").Count < 3 Then Return Nothing
'确认是否为最新
Return ServerContent.Split("|")(If(BuildType = BuildTypes.Release, 2, 1)) <= VersionCode
Catch ex As Exception
Log(ex, "确认启动器更新失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "确认启动器更新失败")
Return Nothing
End Try
End Function
@@ -269,11 +269,11 @@
<local:MyComboBoxItem local:SettingService.Value="0" Content="你知道吗?" />
<local:MyComboBoxItem local:SettingService.Value="1" Content="回声洞" />
<local:MyComboBoxItem local:SettingService.Value="2" Content="Minecraft 新闻(作者:最亮的信标)" />
<local:MyComboBoxItem local:SettingService.Value="3" Content="简单主页(作者:MFn233)" />
<!--<local:MyComboBoxItem local:SettingService.Value="3" Content="简单主页(作者:MFn233)" />-->
<local:MyComboBoxItem local:SettingService.Value="4" Content="每日整合包推荐(作者:wkea)" />
<local:MyComboBoxItem local:SettingService.Value="5" Content="Minecraft 皮肤推荐(作者:wkea)" />
<local:MyComboBoxItem local:SettingService.Value="6" Content="OpenBMCLAPI 仪表盘 Lite(作者:Silverteal、Mxmilu666)" />
<local:MyComboBoxItem local:SettingService.Value="7" Content="PCL 主页市场(作者:凌云)" />
<!--<local:MyComboBoxItem local:SettingService.Value="7" Content="PCL 主页市场(作者:凌云)" />-->
<!--<local:MyComboBoxItem local:SettingService.Value="8" Content="PCL 新闻速报(作者:Joker2184)" />-->
<local:MyComboBoxItem local:SettingService.Value="9" Content="PCL 新功能说明书(作者:WForst-Breeze)" />
<!--<local:MyComboBoxItem local:SettingService.Value="10" Content="OpenMCIM 仪表盘(作者:SALTWOOD)" />-->
@@ -282,6 +282,7 @@
<local:MyComboBoxItem local:SettingService.Value="13" Content="Minecraft 更新摘要(作者:pynickle)" />
<local:MyComboBoxItem local:SettingService.Value="14" Content="今日新闻热点(作者:EYicheng)" />
<local:MyComboBoxItem local:SettingService.Value="15" Content="Minecraft 芝士站(作者:awaEric233)" />
<local:MyComboBoxItem local:SettingService.Value="16" Content="整合包推荐引擎(作者:CHMYGZ)" />
</local:MyComboBox>
</Grid>
</StackPanel>
@@ -54,19 +54,19 @@
'主页
OnMainPageTypeChanged()
Catch ex As NullReferenceException
Log(ex, "个性化设置项存在异常,已被自动重置", NotifyLevel.MsgBox)
Logger.Error(ex, "个性化设置项存在异常,已被自动重置", LogBehavior.Alert)
Reset()
Catch ex As Exception
Log(ex, "重载个性化设置时出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "重载个性化设置时出错")
End Try
End Sub
Public Sub Reset()
Try
SettingService.ResetSettings(Me)
Log("[Setup] 已初始化个性化设置!")
Logger.Info("已初始化个性化设置!")
Hint("已初始化个性化设置", HintType.Green, False)
Catch ex As Exception
Log(ex, "初始化个性化设置失败", NotifyLevel.MsgBox)
Logger.Error(ex, "初始化个性化设置失败", LogBehavior.Alert)
End Try
Refresh()
End Sub
@@ -97,7 +97,7 @@
End Sub
Private Sub BtnBackgroundClear_Click(sender As Object, e As EventArgs) Handles BtnBackgroundClear.Click
If MyMsgBox("即将删除背景图片文件夹中的所有文件。" & vbCrLf & "此操作不可撤销,是否确定?", "警告",, "取消", IsWarn:=True) = 1 Then
DeleteDirectory(PathExeFolder & "PCL\Pictures")
DirectoryUtils.Delete(PathExeFolder & "PCL\Pictures")
BackgroundRefresh(False, True)
Hint("背景图片已清空!", HintType.Green)
End If
@@ -113,10 +113,9 @@
'获取可用的图片文件
DirectoryUtils.Create(PathExeFolder & "PCL\Pictures\")
Dim Pic As New List(Of String)
For Each File In EnumerateFiles(PathExeFolder & "PCL\Pictures\")
If File.Extension.Lower <> ".ini" AndAlso File.Extension.Lower <> ".db" Then '文件夹可能会被加入 .ini 和 thumbs.db
Pic.Add(File.FullName)
End If
For Each File In DirectoryUtils.GetFiles(PathExeFolder & "PCL\Pictures\")
Dim Extension As String = PathUtils.GetExtension(File)
If Extension <> "ini" AndAlso Extension <> "db" Then Pic.Add(File) '文件夹可能会被加入 .ini 和 thumbs.db
Next
'加载
If Not Pic.Any() Then
@@ -133,18 +132,16 @@
If Refresh Then
Dim Address As String = RandomOne(Pic)
Try
Log("[UI] 加载背景图片:" & Address)
Logger.Info($"加载背景图片:{Address}")
FrmMain.ImgBack.Background = New MyBitmap(Address)
FrmMain.ImgBack.Visibility = Visibility.Visible
FrmMain.UpdateBackgroundAndTitleBar()
If IsHint Then Hint("背景图片已刷新:" & GetFileNameFromPath(Address), HintType.Green, False)
If IsHint Then Hint("背景图片已刷新:" & PathUtils.GetLastPart(Address), HintType.Green, False)
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("刷新背景图片失败,该图片文件可能并非标准格式。" & vbCrLf &
"你可以尝试使用画图打开该文件并重新保存,这会让图片变为标准格式。" & vbCrLf &
"文件:" & Address, NotifyLevel.MsgBox)
Logger.Error($"刷新背景图片失败,该图片文件可能并非标准格式。{vbCrLf}你可以尝试使用画图打开该文件并重新保存,这会让图片变为标准格式。{vbCrLf}文件:{Address}", LogBehavior.Alert)
Else
Log(ex, "刷新背景图片失败(" & Address & ")", NotifyLevel.MsgBox)
Logger.Error(ex, $"刷新背景图片失败({Address})", LogBehavior.Alert)
End If
End Try
End If
@@ -152,27 +149,26 @@
End If
Catch ex As Exception
Log(ex, "刷新背景图片时出现未知错误", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新背景图片时出现未知错误")
End Try
End Sub
'顶部栏
Private Sub BtnLogoChange_Click(sender As Object, e As EventArgs) Handles BtnLogoChange.Click
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpg;*.jpeg;*.gif;*.webp)|*.png;*.jpg;*.jpeg;*.gif;*.webp", "选择图片")
If FileName = "" Then Return
Dim FileName As String = Dialogs.SelectFile("选择图片", False, filter:={({"png", "jpg", "jpeg", "gif", "webp"}, "常用图片文件")}).FirstOrDefault()
If String.IsNullOrEmpty(FileName) Then Return
Dim TargetPath As String = PathExeFolder & "PCL\Logo.png"
Try
'拷贝文件
File.Delete(PathExeFolder & "PCL\Logo.png")
CopyFile(FileName, PathExeFolder & "PCL\Logo.png")
'复制文件
FileUtils.Copy(FileName, TargetPath)
'设置当前显示
FrmMain.ImageTitleLogo.Source = Nothing '防止因为 Source 属性前后的值相同而不更新 (#5628)
FrmMain.ImageTitleLogo.Source = PathExeFolder & "PCL\Logo.png"
FrmMain.ImageTitleLogo.Source = TargetPath
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("改变标题栏图片失败,该图片文件可能并非标准格式。" & vbCrLf &
"你可以尝试使用画图打开该文件并重新保存,这会让图片变为标准格式。", NotifyLevel.MsgBox)
Logger.Error($"改变标题栏图片失败,该图片文件可能并非标准格式。{vbCrLf}你可以尝试使用画图打开该文件并重新保存,这会让图片变为标准格式。{vbCrLf}文件:{TargetPath}", LogBehavior.Alert)
Else
Log(ex, "设置标题栏图片失败", NotifyLevel.MsgBox)
Logger.Error(ex, "设置标题栏图片失败", LogBehavior.Alert)
End If
FrmMain.ImageTitleLogo.Source = Nothing
End Try
@@ -181,50 +177,48 @@
If Not (AniControlEnabled = 0 AndAlso e.RaiseByMouse) Then Return
Refresh:
'已有图片则不再选择
If File.Exists(PathExeFolder & "PCL\Logo.png") Then
Dim TargetPath As String = PathExeFolder & "PCL\Logo.png"
If FileUtils.Exists(TargetPath) Then
Try
FrmMain.ImageTitleLogo.Source = Nothing '防止因为 Source 属性前后的值相同而不更新 (#5628)
FrmMain.ImageTitleLogo.Source = PathExeFolder & "PCL\Logo.png"
FrmMain.ImageTitleLogo.Source = TargetPath
Catch ex As Exception
If ex.Message.Contains("参数无效") Then
Log("调整标题栏图片失败,该图片文件可能并非标准格式。" & vbCrLf &
"你可以尝试使用画图打开该文件并重新保存,这会让图片变为标准格式。", NotifyLevel.MsgBox)
Logger.Error($"改变标题栏图片失败,该图片文件可能并非标准格式。{vbCrLf}你可以尝试使用画图打开该文件并重新保存,这会让图片变为标准格式。{vbCrLf}文件:{TargetPath}", LogBehavior.Alert)
Else
Log(ex, "调整标题栏图片失败", NotifyLevel.MsgBox)
Logger.Error(ex, "调整标题栏图片失败", LogBehavior.Alert)
End If
FrmMain.ImageTitleLogo.Source = Nothing
e.Handled = True
Try
File.Delete(PathExeFolder & "PCL\Logo.png")
FileUtils.Delete(TargetPath)
Catch exx As Exception
Log(exx, "清理错误的标题栏图片失败", NotifyLevel.MsgBox)
Logger.Error(exx, "清理错误的标题栏图片失败", LogBehavior.Alert)
End Try
End Try
Return
End If
'没有图片则要求选择
Dim FileName As String = SelectFile("常用图片文件(*.png;*.jpeg;*.jpg;*.gif;*.webp)|*.png;*.jpeg;*.jpg;*.gif;*.webp", "选择图片")
If FileName = "" Then
Dim FileName As String = Dialogs.SelectFile("选择图片", False, filter:={({"png", "jpeg", "jpg", "gif", "webp"}, "常用图片文件")}).FirstOrDefault()
If String.IsNullOrEmpty(FileName) Then
FrmMain.ImageTitleLogo.Source = Nothing
e.Handled = True
Else
Try
'拷贝文件
File.Delete(PathExeFolder & "PCL\Logo.png")
CopyFile(FileName, PathExeFolder & "PCL\Logo.png")
FileUtils.Copy(FileName, TargetPath)
GoTo Refresh
Catch ex As Exception
Log(ex, "复制标题栏图片失败", NotifyLevel.MsgBox)
Logger.Error(ex, "复制标题栏图片失败", LogBehavior.Alert)
End Try
End If
End Sub
Private Sub BtnLogoDelete_Click(sender As Object, e As EventArgs) Handles BtnLogoDelete.Click
Try
File.Delete(PathExeFolder & "PCL\Logo.png")
FileUtils.Delete(PathExeFolder & "PCL\Logo.png")
RadioLogoType1.SetChecked(True, True)
Hint("标题栏图片已清空!", HintType.Green)
Catch ex As Exception
Log(ex, "清空标题栏图片失败", NotifyLevel.MsgBox)
Logger.Error(ex, "清空标题栏图片失败", LogBehavior.Alert)
End Try
End Sub
@@ -242,7 +236,7 @@ Refresh:
PanMusicDetail.Visibility = Visibility.Visible
BtnMusicClear.Visibility = Visibility.Visible
CardMusic.Title = "背景音乐(" &
EnumerateFiles(PathExeFolder & "PCL\Musics\").Count(Function(f) Not {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(f.Extension.Lower)) &
DirectoryUtils.GetFiles(PathExeFolder & "PCL\Musics\").Count(Function(f) Not {"ini", "jpg", "txt", "cfg", "lrc", "db", "png"}.Contains(PathUtils.GetExtension(f))) &
" 首)"
Else
PanMusicVolume.Visibility = Visibility.Collapsed
@@ -264,16 +258,16 @@ Refresh:
Thread.Sleep(200)
'删除文件
Try
DeleteDirectory(PathExeFolder & "PCL\Musics")
DirectoryUtils.Delete(PathExeFolder & "PCL\Musics")
Hint("背景音乐已删除!", HintType.Green)
Catch ex As Exception
Log(ex, "删除背景音乐失败", NotifyLevel.MsgBox)
Logger.Error(ex, "删除背景音乐失败", LogBehavior.Alert)
End Try
Try
DirectoryUtils.Create(PathExeFolder & "PCL\Musics\")
RunInUi(Sub() MusicRefreshPlay(False))
Catch ex As Exception
Log(ex, "重建背景音乐文件夹失败", NotifyLevel.MsgBox)
Logger.Error(ex, "重建背景音乐文件夹失败", LogBehavior.Alert)
End Try
End Sub)
End If
@@ -290,14 +284,14 @@ Refresh:
'主页
Private Sub BtnCustomFile_Click(sender As Object, e As EventArgs) Handles BtnCustomFile.Click
Try
If File.Exists(PathExeFolder & "PCL\Custom.xaml") Then
If FileUtils.Exists(PathExeFolder & "PCL\Custom.xaml") Then
If MyMsgBox("当前已存在布局文件,继续生成教学文件将会覆盖现有布局文件!", "覆盖确认", "继续", "取消", IsWarn:=True) = 2 Then Return
End If
FileUtils.Write(PathExeFolder & "PCL\Custom.xaml", GetResources("Custom"))
ExtractResources(PathExeFolder & "PCL\Custom.xaml", "Custom")
Hint("教学文件已生成!", HintType.Green)
OpenExplorer(PathExeFolder & "PCL\Custom.xaml")
Catch ex As Exception
Log(ex, "生成教学文件失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "生成教学文件失败")
End Try
End Sub
Private Sub BtnCustomRefresh_Click() Handles BtnCustomRefresh.Click
@@ -314,7 +308,7 @@ Refresh:
End Sub
Public Shared Sub OnMainPageTypeChanged()
If FrmSetupUI Is Nothing Then Return
Select Case CInt(Settings.Get("UiCustomType"))
Select Case CInt(Settings.Get(Of Integer)("UiCustomType"))
Case 0 '无
FrmSetupUI.PanCustomPreset.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
@@ -326,7 +320,7 @@ Refresh:
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Visible
FrmSetupUI.PanCustomNet.Visibility = Visibility.Collapsed
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Settings.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustomWarn.Visibility = If(Settings.Get(Of Boolean)("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从 PCL 文件夹下的 Custom.xaml 读取主页内容。{vbCrLf}你可以手动编辑该文件,向主页添加文本、图片、常用网站、快捷启动等功能。"
CustomEventService.SetEventType(FrmSetupUI.HintCustom, CustomEvent.EventType.None)
Case 2 '联网
@@ -334,7 +328,7 @@ Refresh:
FrmSetupUI.PanCustomLocal.Visibility = Visibility.Collapsed
FrmSetupUI.PanCustomNet.Visibility = Visibility.Visible
FrmSetupUI.HintCustom.Visibility = Visibility.Visible
FrmSetupUI.HintCustomWarn.Visibility = If(Settings.Get("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustomWarn.Visibility = If(Settings.Get(Of Boolean)("HintCustomWarn"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.HintCustom.Text = $"从指定网址联网获取主页内容。服主也可以用于动态更新服务器公告。{vbCrLf}如果你制作了稳定运行的联网主页,可以点击这条提示投稿,若合格即可加入预设!"
CustomEventService.SetEventType(FrmSetupUI.HintCustom, CustomEvent.EventType.打开网页)
CustomEventService.SetEventData(FrmSetupUI.HintCustom, "https://github.com/Meloong-Git/PCL/discussions/2528")
@@ -435,56 +429,56 @@ Refresh:
If FrmMain.PanTitleSelect Is Nothing OrElse Not FrmMain.PanTitleSelect.IsLoaded Then Return
Try
'顶部栏
If Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageDownload") AndAlso Settings.Get("UiHiddenPageLink") AndAlso Settings.Get("UiHiddenPageSetup") AndAlso Settings.Get("UiHiddenPageOther") Then
If Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenPageDownload") AndAlso Settings.Get(Of Boolean)("UiHiddenPageLink") AndAlso Settings.Get(Of Boolean)("UiHiddenPageSetup") AndAlso Settings.Get(Of Boolean)("UiHiddenPageOther") Then
'顶部栏已被全部隐藏
FrmMain.PanTitleSelect.Visibility = Visibility.Collapsed
Else
'顶部栏未被全部隐藏
FrmMain.PanTitleSelect.Visibility = Visibility.Visible
FrmMain.BtnTitleSelect1.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageDownload"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect2.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageLink"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect3.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageSetup"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect4.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenPageOther"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect1.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenPageDownload"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect2.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenPageLink"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect3.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenPageSetup"), Visibility.Collapsed, Visibility.Visible)
FrmMain.BtnTitleSelect4.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenPageOther"), Visibility.Collapsed, Visibility.Visible)
End If
'功能
FrmLaunchLeft.RefreshButtonsUI()
If FrmSetupUI IsNot Nothing Then
FrmSetupUI.CardSwitch.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenFunctionHidden"), Visibility.Collapsed, Visibility.Visible)
FrmSetupUI.CardSwitch.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenFunctionHidden"), Visibility.Collapsed, Visibility.Visible)
End If
'设置子页面
If FrmSetupLeft IsNot Nothing Then
FrmSetupLeft.ItemLaunch.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenSetupLaunch"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemUI.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenSetupUi"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemLink.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenSetupLink"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemSystem.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenSetupSystem"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemLaunch.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLaunch"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemUI.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenSetupUi"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemLink.Visibility = Visibility.Collapsed 'If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLink"), Visibility.Collapsed, Visibility.Visible)
FrmSetupLeft.ItemSystem.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenSetupSystem"), Visibility.Collapsed, Visibility.Visible)
'隐藏左边选择卡
Dim AvaliableCount As Integer = 0
If Not Settings.Get("UiHiddenSetupLaunch") Then AvaliableCount += 1
If Not Settings.Get("UiHiddenSetupUi") Then AvaliableCount += 1
'If Not Settings.Get("UiHiddenSetupLink") Then AvaliableCount += 1
If Not Settings.Get("UiHiddenSetupSystem") Then AvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenSetupLaunch") Then AvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenSetupUi") Then AvaliableCount += 1
'If Not Settings.Get(Of Boolean)("UiHiddenSetupLink") Then AvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenSetupSystem") Then AvaliableCount += 1
FrmSetupLeft.PanItem.Visibility = If(AvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If
'更多子页面
Dim OtherAvaliableCount As Integer = 0
If Not Settings.Get("UiHiddenOtherHelp") Then OtherAvaliableCount += 1
If Not Settings.Get("UiHiddenOtherAbout") Then OtherAvaliableCount += 1
If Not Settings.Get("UiHiddenOtherTest") Then OtherAvaliableCount += 1
If Not Settings.Get("UiHiddenOtherFeedback") Then OtherAvaliableCount += 1
If Not Settings.Get("UiHiddenOtherVote") Then OtherAvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then OtherAvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then OtherAvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenOtherTest") Then OtherAvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenOtherFeedback") Then OtherAvaliableCount += 1
If Not Settings.Get(Of Boolean)("UiHiddenOtherVote") Then OtherAvaliableCount += 1
If FrmOtherLeft IsNot Nothing Then
FrmOtherLeft.ItemHelp.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherHelp"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemFeedback.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherFeedback"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemVote.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherVote"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemAbout.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherAbout"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemTest.Visibility = If(Not HiddenForceShow AndAlso Settings.Get("UiHiddenOtherTest"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemHelp.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenOtherHelp"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemFeedback.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenOtherFeedback"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemVote.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenOtherVote"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemAbout.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout"), Visibility.Collapsed, Visibility.Visible)
FrmOtherLeft.ItemTest.Visibility = If(Not HiddenForceShow AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest"), Visibility.Collapsed, Visibility.Visible)
'隐藏左边选择卡
FrmOtherLeft.PanItem.Visibility = If(OtherAvaliableCount < 2 AndAlso Not HiddenForceShow, Visibility.Collapsed, Visibility.Visible)
End If
If OtherAvaliableCount = 1 AndAlso Not HiddenForceShow Then
If Not Settings.Get("UiHiddenOtherHelp") Then
If Not Settings.Get(Of Boolean)("UiHiddenOtherHelp") Then
FrmMain.BtnTitleSelect4.Text = "帮助"
ElseIf Not Settings.Get("UiHiddenOtherAbout") Then
ElseIf Not Settings.Get(Of Boolean)("UiHiddenOtherAbout") Then
FrmMain.BtnTitleSelect4.Text = "关于"
Else
FrmMain.BtnTitleSelect4.Text = "百宝箱"
@@ -499,7 +493,7 @@ Refresh:
'备注
If FrmSetupUI IsNot Nothing Then FrmSetupUI.CardSwitch.Title = If(HiddenForceShow, "功能隐藏(已暂时关闭,按 F12 以重新启用)", "功能隐藏")
Catch ex As Exception
Log(ex, "刷新功能隐藏项目失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新功能隐藏项目失败")
End Try
End Sub
@@ -514,7 +508,7 @@ Refresh:
CheckHiddenSetupUI.Checked = True
Else
'关闭
If Settings.Get("UiHiddenSetupLaunch") AndAlso Settings.Get("UiHiddenSetupUi") AndAlso Settings.Get("UiHiddenSetupSystem") AndAlso Settings.Get("UiHiddenSetupLink") Then
If Settings.Get(Of Boolean)("UiHiddenSetupLaunch") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupUi") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupSystem") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLink") Then
CheckHiddenSetupLaunch.Checked = False
CheckHiddenSetupSystem.Checked = False
CheckHiddenSetupLink.Checked = False
@@ -524,7 +518,7 @@ Refresh:
End Sub
Private Sub HiddenSetupSub() Handles CheckHiddenSetupLaunch.Change, CheckHiddenSetupSystem.Change, CheckHiddenSetupLink.Change, CheckHiddenSetupUI.Change
'设置子页面
If Settings.Get("UiHiddenSetupLaunch") AndAlso Settings.Get("UiHiddenSetupUi") AndAlso Settings.Get("UiHiddenSetupSystem") AndAlso Settings.Get("UiHiddenSetupLink") Then
If Settings.Get(Of Boolean)("UiHiddenSetupLaunch") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupUi") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupSystem") AndAlso Settings.Get(Of Boolean)("UiHiddenSetupLink") Then
'已被全部隐藏
CheckHiddenPageSetup.Checked = True
Else
@@ -543,8 +537,8 @@ Refresh:
CheckHiddenOtherHelp.Checked = True
Else
'关闭
If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") AndAlso
Settings.Get("UiHiddenOtherVote") AndAlso Settings.Get("UiHiddenOtherFeedback") Then
If Settings.Get(Of Boolean)("UiHiddenOtherHelp") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest") AndAlso
Settings.Get(Of Boolean)("UiHiddenOtherVote") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherFeedback") Then
CheckHiddenOtherAbout.Checked = False
CheckHiddenOtherTest.Checked = False
CheckHiddenOtherFeedback.Checked = False
@@ -555,7 +549,7 @@ Refresh:
End Sub
Private Sub HiddenOtherSub(sender As Object, user As Boolean) Handles CheckHiddenOtherHelp.Change, CheckHiddenOtherAbout.Change, CheckHiddenOtherTest.Change
'更多子页面(有具体内容的)
If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") Then
If Settings.Get(Of Boolean)("UiHiddenOtherHelp") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest") Then
'已被全部隐藏
CheckHiddenPageOther.Checked = True
Else
@@ -564,7 +558,7 @@ Refresh:
End If
'修改无具体内容的项
If Not user Then Return
If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") Then
If Settings.Get(Of Boolean)("UiHiddenOtherHelp") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest") Then
CheckHiddenOtherFeedback.Checked = True
CheckHiddenOtherVote.Checked = True
End If
@@ -572,8 +566,8 @@ Refresh:
Private Sub HiddenOtherNet(sender As Object, user As Boolean) Handles CheckHiddenOtherFeedback.Change, CheckHiddenOtherVote.Change
'更多子页面(无具体内容的)
If Not user Then Return
If Settings.Get("UiHiddenOtherHelp") AndAlso Settings.Get("UiHiddenOtherAbout") AndAlso Settings.Get("UiHiddenOtherTest") AndAlso
(Not Settings.Get("UiHiddenOtherFeedback") OrElse Not Settings.Get("UiHiddenOtherVote")) Then
If Settings.Get(Of Boolean)("UiHiddenOtherHelp") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherAbout") AndAlso Settings.Get(Of Boolean)("UiHiddenOtherTest") AndAlso
(Not Settings.Get(Of Boolean)("UiHiddenOtherFeedback") OrElse Not Settings.Get(Of Boolean)("UiHiddenOtherVote")) Then
CheckHiddenOtherAbout.Checked = False
CheckHiddenOtherTest.Checked = False
CheckHiddenOtherHelp.Checked = False
@@ -1,5 +1,5 @@
Public Class Settings
Private Shared ReadOnly Entries As Dictionary(Of String, Setting) = (New List(Of Setting) From {
Public Shared ReadOnly Entries As Dictionary(Of String, Setting) = (New List(Of Setting) From {
New Setting("Identify", "", Source:=Sources.Registry),
New Setting("WindowHeight", 550),
New Setting("WindowWidth", 900),
@@ -27,7 +27,7 @@
New Setting("SystemHighestBetaVersionReg", 0, Source:=Sources.Registry, Encrypted:=True),
New Setting("SystemHighestAlphaVersionReg", 0, Source:=Sources.Registry, Encrypted:=True),
New Setting("SystemHelpVersion", 0, Source:=Sources.Registry),
New Setting("SystemDebugMode", False, Source:=Sources.Registry),
New Setting("SystemDebugMode", False, Source:=Sources.Registry, OnChanged:=Sub() Logger.Instance.MinLevel = If(ModeDebug, LogLevel.Trace, LogLevel.Info)),
New Setting("SystemDebugAnim", 9, Source:=Sources.Registry),
New Setting("SystemDebugDelay", False, Source:=Sources.Registry),
New Setting("SystemDebugSkipCopy", False, Source:=Sources.Registry),
@@ -47,11 +47,11 @@
New Setting("CacheMsName", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Migrated", False, Source:=Sources.Registry),
New Setting("CacheMsV2OAuthRefresh", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2OAuthExpires", 0, Source:=Sources.Registry),
New Setting("CacheMsV2Access", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2ProfileJson", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Uuid", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Name", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheMsV2Expires", 0L, Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideAccess", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideClient", "", Source:=Sources.Registry, Encrypted:=True),
New Setting("CacheNideUuid", "", Source:=Sources.Registry, Encrypted:=True),
@@ -193,12 +193,12 @@
New Setting("VersionServerAuthServer", "", Source:=Sources.Instance)
}).ToDictionary(Function(e) e.Key)
Private Enum Sources
Public Enum Sources
Normal
Registry
Instance
End Enum
Private Class Setting
Public Class Setting
Public Key As String
Public Encrypted As Boolean
Public DefaultValue As Object
@@ -220,7 +220,7 @@
Me.Type = If(Value, "").GetType
Me.OnChanged = OnChanged
Catch ex As Exception
Log(ex, "初始化设置项失败", NotifyLevel.MsgBoxAndFeedback) '#5095 的 fallback
Logger.Error(ex, "初始化设置项失败") '#5095 的 fallback
End Try
End Sub
@@ -228,10 +228,11 @@
''' 读取过的设置的缓存,若从未读取过则为 Nothing。
''' 若为版本独立设置,键为版本路径;否则,键为空字符串。
''' </summary>
Private ValueCache As New Dictionary(Of String, Object)
Public ValueCache As New ConcurrentDictionary(Of String, Object)
Public Function GetCache(Instance As McInstance)
Dim Key As String = If(Source = Sources.Instance, Instance.PathVersion, "")
Return If(ValueCache.ContainsKey(Key), ValueCache(Key), Nothing)
Dim Result = Nothing
Return If(ValueCache.TryGetValue(Key, Result), Result, Nothing)
End Function
Public Sub [Set](Value As Object, Instance As McInstance)
Dim Key As String = If(Source = Sources.Instance, Instance.PathVersion, "")
@@ -243,12 +244,13 @@
''' </summary>
Public Sub Save(Optional Instance As McInstance = Nothing)
Dim Value As String = GetCache(Instance)
Logger.Trace($"保存设置:{Key} = {Value}{If(Instance Is Nothing, "", $"(实例:{Instance?.PathVersion})")}")
If Encrypted Then
Try
If Value Is Nothing Then Value = ""
Value = SecretEncrypt(Value, "PCL" & Identify)
Catch ex As Exception
Log(ex, "加密设置失败:" & Key, NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"加密设置失败:{Key}")
End Try
End If
Select Case Source
@@ -281,7 +283,7 @@
'触发改变事件(必须在保存之后,以保证 VersionServerLogin 之类的在事件中读取到的是最新的值)
If Entry.OnChanged IsNot Nothing Then Entry.OnChanged.Invoke(Value)
Catch ex As Exception
Log(ex, "设置设置项时出错(" & Key & ", " & Value & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"设置设置项时出错({Key}, {Value})")
End Try
End Sub
''' <summary>
@@ -336,7 +338,7 @@
Try
GotValue = SecretDecrypt(GotValue, "PCL" & Identify)
Catch ex As Exception
Log(ex, "解密设置失败:" & Key, NotifyLevel.DevelopOnly)
Logger.Warn(ex, $"解密设置失败:{Key}")
GotValue = Entry.DefaultValue
Entry.Set(Entry.DefaultValue, Instance)
Entry.Save(Instance)
@@ -345,11 +347,14 @@
End If
Entry.Set(CTypeDynamic(GotValue, Entry.Type), Instance)
Catch ex As Exception
Log(ex, "读取设置失败:" & Key, NotifyLevel.AllUsers)
Logger.Error(ex, $"读取设置失败:{Key}", LogBehavior.Toast)
Entry.Set(CTypeDynamic(Entry.DefaultValue, Entry.Type), Instance)
End Try
Return Entry.GetCache(Instance)
End Function
Public Shared Function [Get](Of T)(Key As String, Optional Instance As McInstance = Nothing) As T
Return [Get](Key, Instance)
End Function
''' <summary>
''' 获取某个未经加密的设置项的值。
''' 若该设置项经过了加密,则会抛出异常。
@@ -385,7 +390,7 @@
'触发改变事件
If Entry.OnChanged IsNot Nothing Then Entry.OnChanged.Invoke(Entry.DefaultValue)
Catch ex As Exception
Log(ex, "重置设置项时出错(" & Key & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"重置设置项时出错({Key})")
End Try
End Sub
@@ -55,7 +55,7 @@
#End Region
Catch ex As Exception
Log(ex, "下载管理左栏监视出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "下载管理左栏监视出错")
End Try
If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Return
Try
@@ -63,7 +63,7 @@
TaskRefresh(Loader)
Next
Catch ex As Exception
Log(ex, "下载管理右栏监视出错", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "下载管理右栏监视出错")
End Try
End Sub
Public Sub TaskRefresh(Loader As LoaderBase)
@@ -78,7 +78,7 @@
If Val(Card.Tag) = NewValue Then Return
Card.Tag = NewValue
If Card.Children.Count <= 3 Then
Log("[Watcher] 元素不足的卡片:" & Loader.Name, NotifyLevel.DebugModeOnly)
Logger.Warn($"元素不足的卡片:{Loader.Name}")
Return
End If
Card = Card.Children(3)
@@ -90,7 +90,7 @@
Card.Children.Clear()
Card.Children.Add(GetObjectFromXML("<Path xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" Stretch=""Uniform"" Tag=""Failed"" Data=""F1 M2.5,0 L0,2.5 7.5,10 0,17.5 2.5,20 10,12.5 17.5,20 20,17.5 12.5,10 20,2.5 17.5,0 10,7.5 2.5,0Z"" Height=""15"" Width=""15"" HorizontalAlignment=""Center"" Grid.Column=""0"" Grid.Row=""0"" Fill=""{DynamicResource ColorBrush3}"" Margin=""0,1,0,0"" VerticalAlignment=""Top""/>"))
Dim Tb As TextBlock = GetObjectFromXML("<TextBlock xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" TextWrapping=""Wrap"" HorizontalAlignment=""Left"" ToolTip=""单击复制错误详情"" Grid.Column=""1"" Grid.Row=""0"" Margin=""0,0,0,5"" />")
Tb.Text = Loader.Error.GetDetail()
Tb.Text = Loader.Error.GetDisplay(True)
AddHandler Tb.MouseLeftButtonDown,
Sub(sender As TextBlock, e As EventArgs)
ClipboardSet(sender.Text, False)
@@ -106,7 +106,7 @@
#Region "进度不同,更新卡片"
Try
If Card.Children.Count < LoaderList.Count * 2 Then
Log($"[Watcher] 刷新下载管理卡片 {Loader.Name} 失败:卡片中仅有 {Card.Children.Count} 个子项,要求至少有 {LoaderList.Count * 2} 个子项", NotifyLevel.DebugModeOnly)
Logger.Warn($"刷新下载管理卡片 {Loader.Name} 失败:卡片中仅有 {Card.Children.Count} 个子项,要求至少有 {LoaderList.Count * 2} 个子项")
Exit Try
End If
Dim Row As Integer = 0
@@ -133,12 +133,12 @@
Row += 1
Next
Catch ex As Exception
Log(ex, $"刷新下载管理卡片 {Loader.Name} 失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"刷新下载管理卡片 {Loader.Name} 失败")
End Try
#End Region
End Select
Catch ex As Exception
Log(ex, "更新下载管理显示失败(" & Loader.State.ToString & ")", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, $"更新下载管理显示失败({Loader.State})")
End Try
ElseIf Not (Loader.State = LoadState.Interrupted OrElse Loader.State = LoadState.Finished) Then
Try
@@ -177,13 +177,13 @@
Try
Card = GetObjectFromXML(CardXAML)
Catch ex As Exception
Log(ex, "新建下载管理卡片失败")
Log("出错的卡片内容:" & vbCrLf & CardXAML)
Logger.Warn(ex, "新建下载管理卡片失败")
Logger.Info($"出错的卡片内容:{vbCrLf}{CardXAML}")
Throw
End Try
FrmSpeedRight.PanMain.Children.Insert(0, Card)
RightCards.Add(Loader.Name, Card)
Log($"[Watcher] 新建下载管理卡片:{Loader.Name}")
Logger.Info($"新建下载管理卡片:{Loader.Name}")
'添加取消按钮
Dim Cancel As New MyIconButton With {.Name = "BtnCancel", .Logo = "F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z", .Height = 20, .Margin = New Thickness(0, 10, 10, 0), .LogoScale = 1.1, .HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Top}
Card.Children.Add(Cancel)
@@ -193,7 +193,7 @@
AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack())
RightCards.Remove(Loader.Name)
LoaderTaskbar.Remove(Loader)
Log($"[Taskbar] 关闭下载管理卡片:{Loader.Name},且移出任务列表")
Logger.Info($"关闭下载管理卡片:{Loader.Name},且移出任务列表")
RunInThread(Sub() Loader.Interrupt())
End Sub
'如果已经失败,再刷新一次,修改成失败的控件
@@ -203,11 +203,11 @@
End If
#End Region
Catch ex As Exception
Log(ex, "添加下载管理卡片失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "添加下载管理卡片失败")
End Try
End If
Catch ex As Exception
Log(ex, "刷新下载管理显示失败", NotifyLevel.MsgBoxAndFeedback)
Logger.Error(ex, "刷新下载管理显示失败")
End Try
End Sub
Public Sub TaskRemove(Loader As Object)
@@ -218,7 +218,7 @@
Dim Card As Grid = RightCards(Loader.Name)
FrmSpeedRight.PanMain.Children.Remove(Card)
RightCards.Remove(Loader.Name)
Log($"[Watcher] 移除下载管理卡片:{Loader.Name}")
Logger.Info($"移除下载管理卡片:{Loader.Name}")
End Sub)
End If
End Sub