Merge branch 'main' into datapacks

This commit is contained in:
Pigeon0v0
2024-09-22 10:16:53 +08:00
committed by GitHub
57 changed files with 3234 additions and 1768 deletions
+10 -9
View File
@@ -2,23 +2,24 @@
一、承诺与声明。 一、承诺与声明。
  开发者承诺,在您遵守本指南的情况下,不会追究您的法律责任,但最终裁量权仍由开发者保留。   开发者承诺,在您遵守本指南的情况下,不会追究您的责任,但最终裁量权仍由开发者保留。
  法律上,开发者仍保留所有权利(All Rights Reserved),且可能随时修改本指南,本指南并不是永久性保证。   法律上,开发者仍保留所有权利(All Rights Reserved),且可能随时修改本指南,本指南并不是永久性保证。
二、少量使用情形。 二、少量使用情形。
  如果您仅合理使用本存储库中的少量内容,或是参考实现思路,您必须:   如果您仅合理使用本存储库中的少量内容,或是参考实现思路,您必须:
  (一)给出适当的署名,且提供指向本存储库的链接。   1、给出适当的署名,且提供指向本存储库的链接。
  (二)不得以任何方式暗示开发者为您或您的使用作担保。   2、不得以任何方式暗示开发者为您或您的使用作担保。
三、大量使用情形。 三、大量使用情形。
  如果您基于该存储库进行衍生创作,或合理使用了本存储库中的较大量内容,您必须:   如果您基于该存储库创作衍生作品,或合理使用了本存储库中的较大量内容,您必须:
  (一)给出适当的署名,且提供指向本存储库的链接。   1、给出适当的署名,且提供指向本存储库的链接。GitHub 上的 Fork 可视为满足此条。
  (二)不得以任何方式暗示开发者为您或您的使用作担保。   2、不得以任何方式暗示开发者为您或您的使用作担保,且需要给出适当的说明,表示这是非官方内容。
  (三)给出适当的说明,表示这是第三方内容。在 GitHub 上直接进行 Fork 是允许的。   3、使用本指南文件作为协议,不得附加额外条款。
  (四)使用本指南文件作为协议,不得附加额外条款。   4、该衍生作品不能被允许用于再次分发。包括但不限于用于制作整合包。
  (五)不得分发编译后的可执行文件。唯一的例外是,你可以在明确禁止再次分发的前提下,在小于 100 人的 QQ 群内分发编译后的可执行文件。   5、该衍生作品的名称必须以 “PCL” 或 “Plain Craft Launcher” 开头,并在其后添加后缀,例如 “PCL 启动修复版”、“PCL PR Collection”。
  6、该衍生作品不得包含 PCL 的赞助功能,或是其他作用相似的功能。包括但不限于主题功能、回声洞投稿功能等。
———————————— ————————————
+17 -1
View File
@@ -90,12 +90,18 @@ Public Class Application
ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0)) ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0))
ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0)) ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
'设置初始窗口 '设置初始窗口
If Setup.Get("UiLauncherLogo") AndAlso Not FormMain.IsLinkRestart Then If Setup.Get("UiLauncherLogo") Then
FrmStart = New SplashScreen("Images\icon.ico") FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True) FrmStart.Show(False, True)
End If End If
'动态 DLL 调用 '动态 DLL 调用
AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
SetDllDirectory(Path & "PCL\")
If Is32BitSystem Then
File.WriteAllBytes(Path & "PCL\libwebp.dll", GetResources("libwebp32"))
Else
File.WriteAllBytes(Path & "PCL\libwebp.dll", GetResources("libwebp64"))
End If
'日志初始化 '日志初始化
LogStart() LogStart()
'添加日志 '添加日志
@@ -171,9 +177,11 @@ Public Class Application
Private Shared AssemblyNAudio As Assembly Private Shared AssemblyNAudio As Assembly
Private Shared AssemblyJson As Assembly Private Shared AssemblyJson As Assembly
Private Shared AssemblyDialog As Assembly Private Shared AssemblyDialog As Assembly
Private Shared AssemblyWebp As Assembly
Private Shared ReadOnly AssemblyNAudioLock As New Object Private Shared ReadOnly AssemblyNAudioLock As New Object
Private Shared ReadOnly AssemblyJsonLock As New Object Private Shared ReadOnly AssemblyJsonLock As New Object
Private Shared ReadOnly AssemblyDialogLock As New Object Private Shared ReadOnly AssemblyDialogLock As New Object
Private Shared ReadOnly AssemblyWebpLock As New Object
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly
If args.Name.StartsWithF("NAudio") Then If args.Name.StartsWithF("NAudio") Then
SyncLock AssemblyNAudioLock SyncLock AssemblyNAudioLock
@@ -199,6 +207,14 @@ Public Class Application
End If End If
Return AssemblyDialog Return AssemblyDialog
End SyncLock End SyncLock
ElseIf args.Name.StartsWithF("Imazen.WebP") Then
SyncLock AssemblyWebpLock
If AssemblyWebp Is Nothing Then
Log("[Start] 加载 DLL:Imazen.WebP")
AssemblyWebp = Assembly.Load(GetResources("WebP"))
End If
Return AssemblyWebp
End SyncLock
Else Else
Return Nothing Return Nothing
End If End If
@@ -111,7 +111,16 @@
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255) If PanBack.Background Is Nothing Then PanBack.Background = New MyColor(0, 255, 255, 255)
If Path.Fill Is Nothing AndAlso Theme = Themes.Black Then Path.Fill = New MyColor(140, 0, 0, 0) If Path.Fill Is Nothing Then
Select Case Theme
Case Themes.Red
Path.Fill = New MyColor(160, 255, 76, 76)
Case Themes.Black
Path.Fill = New MyColor(160, 0, 0, 0)
Case Themes.Custom
Path.Fill = New MyColor(160, Foreground)
End Select
End If
If IsMouseOver Then If IsMouseOver Then
'指向 '指向
Dim AnimList As New List(Of AniData) Dim AnimList As New List(Of AniData)
+40 -12
View File
@@ -10,6 +10,16 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目 '统计更新日志条目
#If BETA Then #If BETA Then
If LastVersion < 336 Then 'Release 2.8.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面允许筛选可更新/启用/禁用的 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "爱发电域名迁移至 afdian.com"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 1.20.1+ 离线登录使用正版皮肤时无法保存游戏的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装的 1.14~1.15 Forge+OptiFine 无法进入世界的 Bug"))
FeatureCount += 19
BugCount += 24
End If
If LastVersion < 332 Then 'Release 2.8.3 If LastVersion < 332 Then 'Release 2.8.3
If LastVersion = 330 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug")) If LastVersion = 330 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug"))
End If End If
@@ -124,6 +134,27 @@ Public Class FormMain
'3:BUG+ IMP* FEAT- '3:BUG+ IMP* FEAT-
'2:BUG* IMP- '2:BUG* IMP-
'1:BUG- '1:BUG-
If LastVersion < 335 Then 'Snapshot 2.8.6
BugCount += 2
End If
If LastVersion < 334 Then 'Snapshot 2.8.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面允许筛选可更新/启用/禁用的 Mod"))
If LastVersion = 333 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装愚人节和预发布版本的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法导出错误报告的 Bug"))
End If
FeatureCount += 6
BugCount += 7
End If
If LastVersion < 333 Then 'Snapshot 2.8.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "爱发电域名迁移至 afdian.com"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 1.20.1+ 离线登录使用正版皮肤时无法保存游戏的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装的 1.14~1.15 Forge+OptiFine 无法进入世界的 Bug"))
FeatureCount += 13
BugCount += 17
End If
If LastVersion < 331 Then 'Snapshot 2.8.3 If LastVersion < 331 Then 'Snapshot 2.8.3
If LastVersion = 329 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug")) If LastVersion = 329 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug"))
End If End If
@@ -307,17 +338,13 @@ Public Class FormMain
RunInNewThread( RunInNewThread(
Sub() Sub()
If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
OpenWebsite("https://afdian.net/a/LTCat?tab=feed") OpenWebsite("https://afdian.com/a/LTCat?tab=feed")
End If End If
End Sub, "UpdateLog Output") End Sub, "UpdateLog Output")
End Sub End Sub
'窗口加载 '窗口加载
Private IsWindowLoadFinished As Boolean = False Private IsWindowLoadFinished As Boolean = False
''' <summary>
''' 是否为联机提权后自动重启。
''' </summary>
Public Shared IsLinkRestart As Boolean = False
Public Sub New() Public Sub New()
ApplicationStartTick = GetTimeTick() ApplicationStartTick = GetTimeTick()
'窗体参数初始化 '窗体参数初始化
@@ -355,7 +382,6 @@ Public Class FormMain
PanMainLeft.Child = FrmLaunchLeft PanMainLeft.Child = FrmLaunchLeft
PanMainRight.Child = FrmLaunchRight PanMainRight.Child = FrmLaunchRight
FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay
If IsLinkRestart Then PageChange(PageType.Link, PageSubType.LinkIoi)
'模式提醒 '模式提醒
#If DEBUG Then #If DEBUG Then
Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Critical) Hint("[开发者模式] PCL 正以开发者模式运行,这可能会造成严重的性能下降,请务必立即向开发者反馈此问题!", HintType.Critical)
@@ -424,7 +450,7 @@ Public Class FormMain
Sub() Sub()
PanBack.RenderTransform = Nothing PanBack.RenderTransform = Nothing
IsWindowLoadFinished = True IsWindowLoadFinished = True
Log($"[System] DPI:{DPI},系统版本:{OsVersion},PCL 位置:{PathWithName}") Log($"[System] DPI:{DPI},系统版本:{Environment.OSVersion.VersionString},PCL 位置:{PathWithName}")
End Sub, , True) End Sub, , True)
}, "Form Show") }, "Form Show")
'Timer 启动 'Timer 启动
@@ -570,7 +596,7 @@ Public Class FormMain
RunInNewThread( RunInNewThread(
Sub() Sub()
Log("[System] 正在强行停止任务") Log("[System] 正在强行停止任务")
For Each Task As LoaderBase In LoaderTaskbar.ToArray For Each Task As LoaderBase In LoaderTaskbar.ToList()
Task.Abort() Task.Abort()
Next Next
End Sub, "强行停止下载任务") End Sub, "强行停止下载任务")
@@ -740,7 +766,7 @@ Public Class FormMain
Try Try
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
'Mod 管理自动刷新 'Mod 管理自动刷新
FrmVersionMod.RefreshList() FrmVersionMod.ReloadModList()
ElseIf PageCurrent = PageType.VersionSelect Then ElseIf PageCurrent = PageType.VersionSelect Then
'版本选择自动刷新 '版本选择自动刷新
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
@@ -889,10 +915,12 @@ Public Class FormMain
Install: Install:
Try Try
For Each ModFile In FilePathList For Each ModFile In FilePathList
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & GetFileNameFromPath(ModFile)) Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName)
Next Next
If FilePathList.Count = 1 Then If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First)}!", HintType.Finish) Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "")}!", HintType.Finish)
Else Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish) Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
End If End If
@@ -909,7 +937,7 @@ Install:
'安装整合包 '安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试 If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装") Log("[System] 文件为压缩包,尝试作为整合包安装")
If ModpackInstall(FilePath, ShowHint:=False) Then Exit Sub If ModpackInstall(FilePath, ShowHint:=False) IsNot Nothing Then Exit Sub
End If End If
'RAR 处理 'RAR 处理
If Extension = "rar" Then If Extension = "rar" Then
Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

+60 -74
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.8.3" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.8.6" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.3." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.8.6." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 332 'Release Public Const VersionCode As Integer = 336 'Release
#Else #Else
Public Const VersionCode As Integer = 331 'Snapshot Public Const VersionCode As Integer = 335 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -80,10 +80,6 @@ Public Module ModBase
''' </summary> ''' </summary>
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936 Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
''' <summary> ''' <summary>
''' 操作系统版本。Win10 为 10.0。
''' </summary>
Public OsVersion As Version = Environment.OSVersion.Version
''' <summary>
''' 系统盘盘符,以 \ 结尾。例如 “C:\”。 ''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
''' </summary> ''' </summary>
Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799 Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
@@ -700,7 +696,7 @@ Public Module ModBase
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini" If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
WriteFile(FileName, FileContent.ToString) WriteFile(FileName, FileContent.ToString)
Catch ex As Exception Catch ex As Exception
Log(ex, $"写入文件失败({FileName} -> {Key}:{Value})") Log(ex, $"写入文件失败({FileName} → {Key}:{Value})", LogLevel.Hint)
End Try End Try
End Sub End Sub
@@ -774,10 +770,10 @@ Public Module ModBase
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
''' 读取文件,如果失败则返回空字符串。 ''' 读取文件,如果失败则返回空数组。
''' </summary> ''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param> ''' <param name="FilePath">文件完整或相对路径。</param>
Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String Public Function ReadFileBytes(FilePath As String, Optional Encoding As Encoding = Nothing) As Byte()
Try Try
'还原文件路径 '还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
@@ -787,17 +783,25 @@ Public Module ModBase
ReDim FileBytes(ReadStream.Length - 1) ReDim FileBytes(ReadStream.Length - 1)
ReadStream.Read(FileBytes, 0, ReadStream.Length) ReadStream.Read(FileBytes, 0, ReadStream.Length)
End Using End Using
ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes)) Return FileBytes
Else Else
Log("[System] 欲读取的文件不存在,已返回空字符串:" & FilePath) Log("[System] 欲读取的文件不存在,已返回空内容:" & FilePath)
Return "" Return {}
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "读取文件出错:" & FilePath) Log(ex, "读取文件出错:" & FilePath)
Return "" Return {}
End Try End Try
End Function End Function
''' <summary> ''' <summary>
''' 读取文件,如果失败则返回空字符串。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
Dim FileBytes = ReadFileBytes(FilePath)
ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
End Function
''' <summary>
''' 读取流中的所有文本。 ''' 读取流中的所有文本。
''' </summary> ''' </summary>
Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String
@@ -822,50 +826,39 @@ Public Module ModBase
''' <param name="FilePath">文件完整或相对路径。</param> ''' <param name="FilePath">文件完整或相对路径。</param>
''' <param name="Text">文件内容。</param> ''' <param name="Text">文件内容。</param>
''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param> ''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
Public Function WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing) As Boolean Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing)
Try '还原文件路径
'还原文件路径 If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath '确保目录存在
'确保目录存在 Directory.CreateDirectory(GetPathFromFullPath(FilePath))
Directory.CreateDirectory(GetPathFromFullPath(FilePath)) '写入文件
'写入文件 If File.Exists(FilePath) Then
If File.Exists(FilePath) Then '如果文件存在,刷新目前文件
'如果文件存在,刷新目前文件 Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(ReadFileBytes(FilePath))))
Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(FilePath))) writer.Write(Text)
writer.Write(Text) writer.Flush()
writer.Flush() writer.Close()
writer.Close() End Using
End Using Else
Else '如果文件不存在,则新建并写入
'如果文件不存在,则新建并写入 File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False)))
File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False))) End If
End If End Sub
Return True
Catch ex As Exception
Log(ex, "写入文件时出错:" & FilePath)
Return False
End Try
End Function
''' <summary> ''' <summary>
''' 写入文件。 ''' 写入文件。
''' 如果 CanThrow 设置为 False,返回是否写入成功。
''' </summary> ''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param> ''' <param name="FilePath">文件完整或相对路径。</param>
''' <param name="Content">文件内容。</param> ''' <param name="Content">文件内容。</param>
''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param> ''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
Public Function WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False) As Boolean Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False)
Try '还原文件路径
'还原文件路径 If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath '确保目录存在
'确保目录存在 Directory.CreateDirectory(GetPathFromFullPath(FilePath))
Directory.CreateDirectory(GetPathFromFullPath(FilePath)) '写入文件
'写入文件 File.WriteAllBytes(FilePath, Content)
File.WriteAllBytes(FilePath, Content) End Sub
Return True
Catch ex As Exception
Log(ex, "写入文件时出错:" & FilePath)
Return False
End Try
End Function
''' <summary> ''' <summary>
''' 将流写入文件。 ''' 将流写入文件。
''' </summary> ''' </summary>
@@ -895,21 +888,11 @@ Public Module ModBase
'文件编码 '文件编码
''' <summary> ''' <summary>
''' 获取文件编码。 ''' 根据字节数组分析其编码。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function GetEncoding(FilePath As String) As Encoding
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'获取编码
GetEncoding = GetEncoding(File.ReadAllBytes(FilePath))
End Function
''' <summary>
''' 获取 Bytes 的编码。
''' </summary> ''' </summary>
Public Function GetEncoding(Bytes As Byte()) As Encoding Public Function GetEncoding(Bytes As Byte()) As Encoding
Dim Length As Integer = Bytes.Count Dim Length As Integer = Bytes.Count
If Length <= 2 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8 If Length < 3 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8
'根据 BOM 判断编码 '根据 BOM 判断编码
If Bytes(0) >= &HEF Then If Bytes(0) >= &HEF Then
'有 BOM 类型 '有 BOM 类型
@@ -1108,8 +1091,6 @@ Re:
Dim Retry As Boolean = False Dim Retry As Boolean = False
Re: Re:
Try Try
''检测该文件是否在下载中,若在下载则放弃检测
'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
'获取 SHA1 '获取 SHA1
Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) Dim file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
Dim sha1 As SHA1 = New SHA1CryptoServiceProvider() Dim sha1 As SHA1 = New SHA1CryptoServiceProvider()
@@ -1587,14 +1568,14 @@ RetryDir:
''' 获取处于两个子字符串之间的部分。 ''' 获取处于两个子字符串之间的部分。
''' 会裁切尽可能多的内容:匹配开始使用 LastIndexOf,匹配结束使用 IndexOf,但如果未找到子字符串则不裁切。 ''' 会裁切尽可能多的内容:匹配开始使用 LastIndexOf,匹配结束使用 IndexOf,但如果未找到子字符串则不裁切。
''' </summary> ''' </summary>
<Extension> Public Function Between(Str As String, Before As String, After As String, Optional IgnoreCase As Boolean = False) As String <Extension> Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
Dim StartPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.LastIndexOfF(Before, IgnoreCase)) Dim StartPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.LastIndexOfF(After, IgnoreCase))
If StartPos >= 0 Then If StartPos >= 0 Then
StartPos += Before.Length StartPos += After.Length
Else Else
StartPos = 0 StartPos = 0
End If End If
Dim EndPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.IndexOfF(After, StartPos, IgnoreCase)) Dim EndPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.IndexOfF(Before, StartPos, IgnoreCase))
If EndPos >= 0 Then If EndPos >= 0 Then
Return Str.Substring(StartPos, EndPos - StartPos) Return Str.Substring(StartPos, EndPos - StartPos)
ElseIf StartPos > 0 Then ElseIf StartPos > 0 Then
@@ -1655,10 +1636,15 @@ RetryDir:
End Function End Function
''' <summary> ''' <summary>
''' 输入 And 字符不会报错的 Val。 ''' 不会报错的 Val。
''' 如果输入有误,返回 0。
''' </summary> ''' </summary>
Public Function Val(Str As Object) As Double Public Function Val(Str As Object) As Double
Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str)) Try
Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
Catch
Return 0
End Try
End Function End Function
'转义 '转义
@@ -2682,7 +2668,7 @@ Retry:
Public Sub FeedbackInfo() Public Sub FeedbackInfo()
On Error Resume Next On Error Resume Next
Log("[System] 诊断信息:" & vbCrLf & Log("[System] 诊断信息:" & vbCrLf &
"操作系统:" & My.Computer.Info.OSFullName & vbCrLf & "操作系统:" & My.Computer.Info.OSFullName & "(32 位:" & Is32BitSystem & ")" & vbCrLf &
"剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf & "剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
"DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf & "DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
"MC 文件夹:" & If(PathMcFolder, "Nothing") & vbCrLf & "MC 文件夹:" & If(PathMcFolder, "Nothing") & vbCrLf &
@@ -566,38 +566,33 @@ Restart:
End Class End Class
'任务栏进度条 '任务栏进度条
Public LoaderTaskbarLock As New Object Public LoaderTaskbar As New Concurrent.ConcurrentBag(Of LoaderBase)
Public LoaderTaskbar As New List(Of LoaderBase)
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度 Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T)) Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader) If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
SyncLock LoaderTaskbarLock LoaderTaskbar.Add(Loader)
LoaderTaskbar.Add(Loader) Log($"[Taskbar] {Loader.Name} 已加入任务列表")
Log($"[Taskbar] {Loader.Name} 已加入任务列表")
End SyncLock
End Sub End Sub
Public Sub LoaderTaskbarProgressRefresh() Public Sub LoaderTaskbarProgressRefresh()
Try Try
Dim NewState As Shell.TaskbarItemProgressState Dim NewState As Shell.TaskbarItemProgressState
Dim NewProgress As Double = LoaderTaskbarProgressGet() Dim NewProgress As Double = LoaderTaskbarProgressGet()
'检查任务是否完成,若完成则移除 '检查任务是否完成,若完成则移除
SyncLock LoaderTaskbarLock '外显任务是否已经全部完成
'外显任务是否已经全部完成 Dim IsAllDownloadTaskCompleted As Boolean = True
Dim IsAllDownloadTaskCompleted As Boolean = True For Each Loader In LoaderTaskbar
For Each Loader In LoaderTaskbar If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False Next
Next '若单个任务已中止或全部任务已完成,则刷新并移除
'若单个任务已中止或全部任务已完成,则刷新并移除 For Each Task In LoaderTaskbar.ToList()
For Each Task In LoaderTaskbar.ToList() If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task) LoaderTaskbar.TryTake(Task)
LoaderTaskbar.Remove(Task) Log($"[Taskbar] {Task.Name} 已移出任务列表")
Log($"[Taskbar] {Task.Name} 已移出任务列表") End If
End If Next
Next
End SyncLock
'更新平滑后的进度 '更新平滑后的进度
If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then If NewProgress <= 0 OrElse NewProgress >= 1 OrElse LoaderTaskbarProgress > NewProgress Then
LoaderTaskbarProgress = NewProgress LoaderTaskbarProgress = NewProgress
@@ -625,15 +620,8 @@ Restart:
End Sub End Sub
Public Function LoaderTaskbarProgressGet() As Double Public Function LoaderTaskbarProgressGet() As Double
Try Try
Dim Total As Double = 0, Count As Integer = 0 If Not LoaderTaskbar.Any Then Return 1
SyncLock LoaderTaskbarLock Return MathClamp(LoaderTaskbar.Select(Function(e) e.Progress).Average(), 0, 1)
For Each Task In LoaderTaskbar.ToList
Total += Task.Progress
Count += 1 '避免多线程影响导致计数出错
Next
End SyncLock
If Count = 0 Then Return 1
Return MathClamp(Total / Count, 0, 1)
Catch ex As Exception Catch ex As Exception
Log(ex, "获取任务栏进度出错", LogLevel.Feedback) Log(ex, "获取任务栏进度出错", LogLevel.Feedback)
Return 0.5 Return 0.5
+53 -59
View File
@@ -1,5 +1,4 @@
Imports System.Net Imports System.Net
Imports PCL.ModNet
Public Module ModNet Public Module ModNet
Public Const NetDownloadEnd As String = ".PCLDownloading" Public Const NetDownloadEnd As String = ".PCLDownloading"
@@ -207,10 +206,10 @@ RequestFinished:
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As Exception Catch ex As Exception
If ex.GetType.Equals(GetType(WebException)) AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then If TypeOf ex Is WebException AndAlso CType(ex, WebException).Status = WebExceptionStatus.Timeout Then
Throw New TimeoutException("连接服务器超时,已接收 " & Result.Count & " B(" & Url & ")") Throw New TimeoutException($"获取结果失败({CType(ex, WebException).Status},{ex.Message},{Url})", ex)
Else Else
Throw New WebException("获取结果失败," & ex.Message & "(" & Url & ")", ex) Throw New WebException($"获取结果失败({If(TypeOf ex Is WebException, CType(ex, WebException).Status & ",", "")}{ex.Message},{Url})", ex)
End If End If
Finally Finally
Request.Abort() Request.Abort()
@@ -269,12 +268,7 @@ RequestFinished:
'下载 '下载
Using Client As New WebClient Using Client As New WebClient
Try Try
If UseBrowserUserAgent Then SecretHeadersSign(Url, Client, UseBrowserUserAgent)
Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else
Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode
End If
Client.Headers(HttpRequestHeader.Referer) = "http://" & VersionCode & ".pcl2.server/"
Client.DownloadFile(Url, LocalFile) Client.DownloadFile(Url, LocalFile)
Catch ex As Exception Catch ex As Exception
File.Delete(LocalFile) File.Delete(LocalFile)
@@ -316,7 +310,7 @@ Retry:
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As Exception Catch ex As Exception
If ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message.Contains("(40") AndAlso DontRetryOnRefused Then RetryCount = 999 If ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message.Contains("(40") AndAlso DontRetryOnRefused Then Throw
Select Case RetryCount Select Case RetryCount
Case 0 Case 0
If ModeDebug Then Log(ex, "[Net] 网络请求第一次失败(" & Url & ")") If ModeDebug Then Log(ex, "[Net] 网络请求第一次失败(" & Url & ")")
@@ -419,7 +413,7 @@ RequestFinished:
Throw Throw
Catch ex As WebException Catch ex As WebException
If ex.Status = WebExceptionStatus.Timeout Then If ex.Status = WebExceptionStatus.Timeout Then
Throw New WebException("连接服务器超时,请检查你的网络环境是否良好(" & Url & ")", ex) ex = New WebException($"连接服务器超时,请检查你的网络环境是否良好({ex.Message},{Url})", ex)
Else Else
'获取请求失败的返回 '获取请求失败的返回
Dim Res As String = "" Dim Res As String = ""
@@ -433,15 +427,34 @@ RequestFinished:
End Using End Using
Catch Catch
End Try End Try
Throw New WebException("网络请求失败(" & Url & "," & ex.Message & ")" & If(String.IsNullOrEmpty(Res), "", vbCrLf & Res), ex) If Res = "" Then
ex = New WebException($"网络请求失败({ex.Status},{ex.Message},{Url})", ex)
Else
ex = New ResponsedWebException($"服务器返回错误({ex.Status},{ex.Message},{Url}){vbCrLf}{Res}", Res, ex)
End If
End If End If
If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
Throw ex
Catch ex As Exception Catch ex As Exception
Throw New WebException("网络请求失败(" & Url & ")", ex) ex = New WebException("网络请求失败(" & Url & ")", ex)
If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
Throw ex
Finally Finally
If DataStream IsNot Nothing Then DataStream.Dispose() If DataStream IsNot Nothing Then DataStream.Dispose()
If Resp IsNot Nothing Then Resp.Dispose() If Resp IsNot Nothing Then Resp.Dispose()
End Try End Try
End Function End Function
Public Class ResponsedWebException
Inherits WebException
''' <summary>
''' 远程服务器给予的回复。
''' </summary>
Public Overloads Property Response As String
Public Sub New(Message As String, Response As String, InnerException As Exception)
MyBase.New(Message, InnerException)
Me.Response = Response
End Sub
End Class
''' <summary> ''' <summary>
''' 最大线程数。 ''' 最大线程数。
@@ -688,7 +701,7 @@ RequestFinished:
''' <summary> ''' <summary>
''' 所属的文件列表任务。 ''' 所属的文件列表任务。
''' </summary> ''' </summary>
Public Tasks As New List(Of LoaderDownload) Public Tasks As New Concurrent.ConcurrentBag(Of LoaderDownload)
''' <summary> ''' <summary>
''' 所有下载源。 ''' 所有下载源。
@@ -881,7 +894,6 @@ RequestFinished:
Public ReadOnly LockState As New Object Public ReadOnly LockState As New Object
Public ReadOnly LockChain As New Object Public ReadOnly LockChain As New Object
Public ReadOnly LockSource As New Object Public ReadOnly LockSource As New Object
Public ReadOnly LockTasks As New Object
Public ReadOnly Uuid As Integer = GetUuid() Public ReadOnly Uuid As Integer = GetUuid()
Public Overrides Function Equals(obj As Object) As Boolean Public Overrides Function Equals(obj As Object) As Boolean
@@ -964,7 +976,7 @@ Capture:
Next Next
'是否禁用多线程,以及规定碎片大小 '是否禁用多线程,以及规定碎片大小
Dim TargetUrl As String = GetSource().Url Dim TargetUrl As String = GetSource().Url
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth.com") Then Return Nothing If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth") Then Return Nothing
'寻找最大碎片 '寻找最大碎片
'FUTURE: 下载引擎重做,计算下载源平均链接时间和线程下载速度,按最高时间节省来开启多线程 'FUTURE: 下载引擎重做,计算下载源平均链接时间和线程下载速度,按最高时间节省来开启多线程
Dim FilePieceMax As NetThread = Threads Dim FilePieceMax As NetThread = Threads
@@ -980,10 +992,8 @@ StartThread:
If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return Nothing If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return Nothing
'构建线程 '构建线程
Dim ThreadUuid As Integer = GetUuid() Dim ThreadUuid As Integer = GetUuid()
SyncLock LockTasks If Not Tasks.Any() Then Return Nothing '由于中断,已没有可用任务
If Not Tasks.Any() Then Return Nothing '由于中断,已没有可用任务 Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
End SyncLock
ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload} ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload}
'链表处理 '链表处理
If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then If ThreadInfo.IsFirstThread OrElse Threads Is Nothing Then
@@ -1140,11 +1150,9 @@ NotSupportRange:
End If End If
SyncLock LockCount SyncLock LockCount
Info.Source.FailCount = 0 Info.Source.FailCount = 0
SyncLock LockTasks For Each Task In Tasks
For Each Task In Tasks Task.FailCount = 0
Task.FailCount = 0 Next
Next
End SyncLock
End SyncLock End SyncLock
NetManager.DownloadDone += RealDataCount NetManager.DownloadDone += RealDataCount
SyncLock LockDone SyncLock LockDone
@@ -1198,11 +1206,9 @@ SourceBreak:
'状态变更 '状态变更
SyncLock LockCount SyncLock LockCount
Info.Source.FailCount += 1 Info.Source.FailCount += 1
SyncLock LockTasks For Each Task In Tasks
For Each Task In Tasks Task.FailCount += 1
Task.FailCount += 1 Next
Next
End SyncLock
End SyncLock End SyncLock
Dim IsTimeoutString As String = GetExceptionSummary(ex).ToLower.Replace(" ", "") Dim IsTimeoutString As String = GetExceptionSummary(ex).ToLower.Replace(" ", "")
Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse Dim IsTimeout As Boolean = IsTimeoutString.Contains("由于连接方在一段时间后没有正确答复或连接的主机没有反应") OrElse
@@ -1307,7 +1313,7 @@ Retry:
'合并文件 '合并文件
If IsNoSplit Then If IsNoSplit Then
'仅有一个线程,从缓存中输出 '仅有一个线程,从缓存中输出
If ModeDebug Then Log($"[Download] {LocalName}:下载结束,从缓存输出文件") If ModeDebug Then Log($"[Download] {LocalName}:下载结束,从缓存输出文件,长度:" & SmailFileCache.Count)
MergeFile = New FileStream(LocalPath, FileMode.Create) MergeFile = New FileStream(LocalPath, FileMode.Create)
AddWriter = New BinaryWriter(MergeFile) AddWriter = New BinaryWriter(MergeFile)
AddWriter.Write(SmailFileCache.ToArray) AddWriter.Write(SmailFileCache.ToArray)
@@ -1344,7 +1350,7 @@ Retry:
'检查文件 '检查文件
Dim CheckResult As String = Check?.Check(LocalPath) Dim CheckResult As String = Check?.Check(LocalPath)
If CheckResult IsNot Nothing Then If CheckResult IsNot Nothing Then
Log($"[Download] {LocalName} 合并文件失败,下载线程细节:") Log($"[Download] {LocalName} 文件校验失败,下载线程细节:")
For Each Th As NetThread In Threads For Each Th As NetThread In Threads
Log($"[Download] {Th.Uuid}#,状态 {GetStringFromEnum(Th.State)},范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone},完成 {Th.DownloadDone},剩余 {Th.DownloadUndone}") Log($"[Download] {Th.Uuid}#,状态 {GetStringFromEnum(Th.State)},范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone},完成 {Th.DownloadDone},剩余 {Th.DownloadUndone}")
Next Next
@@ -1397,10 +1403,8 @@ Retry:
''' </summary> ''' </summary>
Public Sub Abort(CausedByTask As LoaderDownload) Public Sub Abort(CausedByTask As LoaderDownload)
'从特定任务中移除,如果它还属于其他任务,则继续下载 '从特定任务中移除,如果它还属于其他任务,则继续下载
SyncLock LockTasks Tasks.TryTake(CausedByTask)
Tasks.Remove(CausedByTask) If Tasks.Any Then Exit Sub
If Tasks.Any Then Exit Sub
End SyncLock
'确认中断 '确认中断
SyncLock LockState SyncLock LockState
If State >= NetState.Finish Then Exit Sub If State >= NetState.Finish Then Exit Sub
@@ -1430,11 +1434,9 @@ Retry:
NetManager.FileRemain -= 1 NetManager.FileRemain -= 1
If PrintLog Then Log("[Download] " & LocalName & ":已完成,剩余文件 " & NetManager.FileRemain) If PrintLog Then Log("[Download] " & LocalName & ":已完成,剩余文件 " & NetManager.FileRemain)
End SyncLock End SyncLock
SyncLock LockTasks For Each Task In Tasks
For Each Task In Tasks Task.OnFileFinish(Me)
Task.OnFileFinish(Me) Next
Next
End SyncLock
End Sub End Sub
End Class End Class
@@ -1961,9 +1963,7 @@ Retry:
If Files(File.LocalPath).State >= NetState.Finish Then If Files(File.LocalPath).State >= NetState.Finish Then
'该文件已经下载过一次,且下载完成 '该文件已经下载过一次,且下载完成
'将已下载的文件替换成当前文件,重新下载 '将已下载的文件替换成当前文件,重新下载
SyncLock File.LockTasks File.Tasks.Add(Task)
File.Tasks.Add(Task)
End SyncLock
Files(File.LocalPath) = File Files(File.LocalPath) = File
SyncLock LockRemain SyncLock LockRemain
FileRemain += 1 FileRemain += 1
@@ -1974,15 +1974,11 @@ Retry:
'该文件正在下载中 '该文件正在下载中
'将当前文件替换成下载中的文件,即两个任务指向同一个文件 '将当前文件替换成下载中的文件,即两个任务指向同一个文件
File = Files(File.LocalPath) File = Files(File.LocalPath)
SyncLock File.LockTasks File.Tasks.Add(Task)
File.Tasks.Add(Task)
End SyncLock
End If End If
Else Else
'没有该文件 '没有该文件
SyncLock File.LockTasks File.Tasks.Add(Task)
File.Tasks.Add(Task)
End SyncLock
Files.Add(File.LocalPath, File) Files.Add(File.LocalPath, File)
SyncLock LockRemain SyncLock LockRemain
FileRemain += 1 FileRemain += 1
@@ -2004,14 +2000,12 @@ Retry:
''' 是否有正在进行中、需要在下载管理页面显示的下载任务? ''' 是否有正在进行中、需要在下载管理页面显示的下载任务?
''' </summary> ''' </summary>
Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
SyncLock LoaderTaskbarLock For Each Task In LoaderTaskbar
For Each Task In LoaderTaskbar If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
(Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then Return True
Return True End If
End If Next
Next
End SyncLock
Return False Return False
End Function End Function
@@ -288,7 +288,8 @@
End If End If
'Tags 'Tags
Tags = New List(Of String) Tags = New List(Of String)
For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c) For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段:https://github.com/Hex-Dragon/PCL2/issues/4267#issuecomment-2254590831
Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
Select Case Category Select Case Category
'Mod 'Mod
Case 406 : Tags.Add("世界元素") Case 406 : Tags.Add("世界元素")
@@ -408,7 +409,7 @@
Case "technology" : Tags.Add("科技") Case "technology" : Tags.Add("科技")
Case "magic" : Tags.Add("魔法") Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险") Case "adventure" : Tags.Add("冒险")
Case "kitchen-sink" : Tags.Add("烹饪") Case "kitchen-sink" : Tags.Add("大杂烩")
Case "lightweight" : Tags.Add("轻量") Case "lightweight" : Tags.Add("轻量")
'数据包 '数据包
Case "adventure" : Tags.Add("冒险") Case "adventure" : Tags.Add("冒险")
@@ -989,7 +990,7 @@ Retry:
Try Try
'获取工程列表 '获取工程列表
Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl) Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
Dim RequestResult As JObject = NetGetCodeByRequestRetry(CurseForgeUrl, IsJson:=True, Encode:=Encoding.UTF8) Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True)
Task.Progress += 0.2 Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject) Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("data") For Each JsonEntry As JObject In RequestResult("data")
@@ -1004,7 +1005,7 @@ Retry:
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)") Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
Catch ex As Exception Catch ex As Exception
Log(ex, "从 CurseForge 获取工程列表失败") Log(ex, "从 CurseForge 获取工程列表失败")
Storage.CurseForgeTotal = Storage.CurseForgeOffset Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
[Error] = ex [Error] = ex
CurseForgeFailed = True CurseForgeFailed = True
End Try End Try
@@ -1019,7 +1020,7 @@ Retry:
Sub() Sub()
Try Try
Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl) Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
Dim RequestResult As JObject = NetGetCodeByRequestRetry(ModrinthUrl, IsJson:=True, Encode:=Encoding.UTF8) Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True)
Task.Progress += 0.2 Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject) Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("hits") For Each JsonEntry As JObject In RequestResult("hits")
@@ -1037,7 +1038,7 @@ Retry:
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)") Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
Catch ex As Exception Catch ex As Exception
Log(ex, "从 Modrinth 获取工程列表失败") Log(ex, "从 Modrinth 获取工程列表失败")
Storage.ModrinthTotal = Storage.ModrinthOffset Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
[Error] = ex [Error] = ex
ModrinthFailed = True ModrinthFailed = True
End Try End Try
@@ -1063,7 +1064,7 @@ Retry:
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
Throw New Exception("Modrinth 不兼容所选的类型") Throw New Exception("Modrinth 不兼容所选的类型")
Else Else
Throw New Exception("没有符合条件的结果") Throw New Exception("没有搜索结果")
End If End If
End If End If
ElseIf [Error] IsNot Nothing Then ElseIf [Error] IsNot Nothing Then
@@ -1118,7 +1119,7 @@ Retry:
If String.IsNullOrEmpty(Task.Input.SearchText) Then If String.IsNullOrEmpty(Task.Input.SearchText) Then
'如果没有搜索文本,按下载量将结果排序 '如果没有搜索文本,按下载量将结果排序
For Each Result As CompProject In RealResults For Each Result As CompProject In RealResults
Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 30)) Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 10))
Next Next
Else Else
'如果有搜索文本,按关联度将结果排序 '如果有搜索文本,按关联度将结果排序
@@ -1126,7 +1127,7 @@ Retry:
Dim Entry As New List(Of SearchEntry(Of CompProject)) Dim Entry As New List(Of SearchEntry(Of CompProject))
For Each Result As CompProject In RealResults For Each Result As CompProject In RealResults
Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) + Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 30)) / 9) Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 10)) / 9)
Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From { Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1), New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
New KeyValuePair(Of String, Double)(Result.Description, 0.05)}}) New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
@@ -1295,7 +1296,9 @@ Retry:
DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"), DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"), Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"), Url.Replace("://edge", "://media"),
Url}).Distinct().ToList() Url}).Distinct.ToList '对脑残 CurseForge 的下载地址进行多种修正
DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源,这个写法是为了让镜像源排在后面
DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
'Dependencies 'Dependencies
If Type = CompType.Mod Then If Type = CompType.Mod Then
RawDependencies = Data("dependencies"). RawDependencies = Data("dependencies").
@@ -1329,11 +1332,10 @@ Retry:
ReleaseDate = Data("date_published") ReleaseDate = Data("date_published")
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha)) Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads") DownloadCount = Data("downloads")
'可能为空 If CType(Data("files"), JArray).Any() Then '可能为空
If CType(Data("files"), JArray).Any() Then
Dim File As JToken = Data("files")(0) Dim File As JToken = Data("files")(0)
FileName = File("filename") FileName = File("filename")
DownloadUrls = New List(Of String) From {File("url")} DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
Hash = File("hashes")("sha1") Hash = File("hashes")("sha1")
End If End If
'Dependencies 'Dependencies
@@ -1469,9 +1471,9 @@ Retry:
If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存 If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
TargetProject = CompProjectCache(ProjectId) TargetProject = CompProjectCache(ProjectId)
ElseIf FromCurseForge Then 'CurseForge ElseIf FromCurseForge Then 'CurseForge
TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)("data")) TargetProject = New CompProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True)("data"))
Else 'Modrinth Else 'Modrinth
TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)) TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
End If End If
'获取工程对象的文件列表 '获取工程对象的文件列表
Log("[Comp] 开始获取文件列表:" & ProjectId) Log("[Comp] 开始获取文件列表:" & ProjectId)
@@ -1479,13 +1481,13 @@ Retry:
If FromCurseForge Then If FromCurseForge Then
'CurseForge 'CurseForge
If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件 If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
ResultJsonArray = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data") ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
Else '否则使用全部文件 Else '否则使用全部文件
ResultJsonArray = NetGetCodeByRequestRetry($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", Accept:="application/json", IsJson:=True)("data") ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
End If End If
Else Else
'Modrinth 'Modrinth
ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True) ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
End If End If
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)). CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330) Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
@@ -1499,11 +1501,10 @@ Retry:
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}") Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}")
Dim Projects As JArray Dim Projects As JArray
If TargetProject.FromCurseForge Then If TargetProject.FromCurseForge Then
Projects = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", Projects = GetJson(DlModRequest("https://api.curseforge.com/v1/mods",
"POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data") "POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data")
Else Else
Projects = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", IsJson:=True)
Accept:="application/json", IsJson:=True)
End If End If
For Each Project In Projects For Each Project In Projects
Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存 Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存
@@ -844,8 +844,11 @@ NextStack:
Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing) Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
'弹窗提示 '弹窗提示
FrmMain.ShowWindowToTop() FrmMain.ShowWindowToTop()
Dim ShowLog As Action = Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing,
Sub() Sub()
'弹窗选择:查看日志
If File.Exists(DirectFile.Value.Key) Then If File.Exists(DirectFile.Value.Key) Then
ShellOnly("notepad", DirectFile.Value.Key) ShellOnly("notepad", DirectFile.Value.Key)
Else Else
@@ -853,11 +856,9 @@ NextStack:
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf)) WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
ShellOnly(FilePath) ShellOnly(FilePath)
End If End If
End Sub End Sub))
Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, ShowLog))
Case 3 Case 3
'弹窗选择:导出错误报告
Dim FileAddress As String = Nothing Dim FileAddress As String = Nothing
Try Try
'获取文件路径 '获取文件路径
@@ -881,7 +882,10 @@ NextStack:
FileName = "游戏崩溃前的输出.txt" FileName = "游戏崩溃前的输出.txt"
End Select End Select
If File.Exists(OutputFile) Then If File.Exists(OutputFile) Then
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*"))) Dim FileEncoding As Encoding = GetEncoding(ReadFileBytes(OutputFile))
WriteFile(TempFolder & "Report\" & FileName,
SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
Encoding:=FileEncoding)
End If End If
Next Next
'导出报告 '导出报告
@@ -836,8 +836,8 @@
''' <summary> ''' <summary>
''' NeoForge 版本列表,BMCLAPI。 ''' NeoForge 版本列表,BMCLAPI。
''' </summary> ''' </summary>
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListOfficialMain) Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain)
Public Sub DlNeoForgeVersionBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult)) Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON '获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True) Dim ResultLatest As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True) Dim ResultLegacy As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
@@ -1083,29 +1083,120 @@
#End Region #End Region
#Region "DlMod | Mod 镜像源请求"
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。
''' 调用 NetGetCodeByRequestOnce。
''' </summary>
Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000,
IsJson:=IsJson, UseBrowserUserAgent:=True)
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理。
''' 调用 NetRequestOnce。
''' </summary>
Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String, Optional Headers As Dictionary(Of String, String) = Nothing) As String
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod")
Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select
End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000, Headers:=Headers)
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
#End Region
#Region "DlSource | 镜像下载源" #Region "DlSource | 镜像下载源"
Public Function DlSourceResourceGet(MojangBase As String) As String() Public Function DlSourceResourceGet(Original As String) As String()
MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net") Original = Original.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
Return { Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"), Original.
MojangBase Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").
Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
Original
} }
End Function End Function
Public Function DlSourceLibraryGet(MojangBase As String) As String() Public Function DlSourceLibraryGet(Original As String) As String()
Return { Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"), Original.
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"), Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
MojangBase Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
Original
} }
End Function End Function
Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String() Public Function DlSourceModGet(Original As String) As String
If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址") Return Original.
Replace("api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("cdn.modrinth.com", "mod.mcimirror.top").
Replace("api.curseforge.com", "mod.mcimirror.top/curseforge").
Replace("edge.forgecdn.net", "mod.mcimirror.top").
Replace("mediafilez.forgecdn.net", "mod.mcimirror.top").
Replace("media.forgecdn.net", "mod.mcimirror.top")
End Function
Public Function DlSourceLauncherOrMetaGet(Original As String) As String()
If Original Is Nothing Then Throw New Exception("无对应的 json 下载地址")
Return { Return {
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"), Original.
MojangBase Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").
Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
Original
} }
End Function End Function
@@ -1,5 +1,5 @@
Public Module ModJava Public Module ModJava
Public JavaListCacheVersion As Integer = 6 Public JavaListCacheVersion As Integer = 7
''' <summary> ''' <summary>
''' 目前所有可用的 Java。 ''' 目前所有可用的 Java。
@@ -216,10 +216,12 @@
'添加特定的 Java '添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean) Dim JavaPreList As New Dictionary(Of String, Boolean)
If PathMcFolder.Split("\").Count > 3 Then If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录的话) JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录或 %APPDATA% 的话)
End If End If
JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹 JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java(#4286)
If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹 If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹
Dim TargetJavaList As New List(Of JavaEntry) Dim TargetJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList For Each Entry In JavaPreList
@@ -550,7 +552,7 @@ NoUserJava:
'若不全为特殊引用,则清除特殊引用的地址 '若不全为特殊引用,则清除特殊引用的地址
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean) Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList For Each Pair In JavaPreList
If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用") Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
Else Else
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用") Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
@@ -225,7 +225,7 @@ NextInner:
"如果觉得 PCL 还算好用的话,也可以考虑赞助一下作者……一点心意也行……" & vbCrLf & "如果觉得 PCL 还算好用的话,也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
"毕竟一个人开发也不容易(悲)……", "毕竟一个人开发也不容易(悲)……",
"求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then "求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then
OpenWebsite("https://afdian.net/a/LTCat") OpenWebsite("https://afdian.com/a/LTCat")
End If End If
End Select End Select
End Sub, "Donate") End Sub, "Donate")
@@ -506,18 +506,21 @@ NextInner:
End If End If
'尝试登录 '尝试登录
Dim OAuthTokens As String() Dim OAuthTokens As String()
Dim ClientId As String = ""
If Input.OAuthRefreshToken = "" Then If Input.OAuthRefreshToken = "" Then
'无 RefreshToken '无 RefreshToken
Relogin: Relogin:
Dim OAuthCode As String = MsLoginStep1(Data) Dim OAuthCode As String = MsLoginStep1(Data)
If OAuthCode = "Cancel" Then Exit Sub
If Data.IsAborted Then Throw New ThreadInterruptedException If Data.IsAborted Then Throw New ThreadInterruptedException
Data.Progress = 0.2 Data.Progress = 0.2
OAuthTokens = MsLoginStep2(OAuthCode, False) OAuthTokens = MsLoginStep2(OAuthCode, False, ClientId)
Else Else
'有 RefreshToken '有 RefreshToken
OAuthTokens = MsLoginStep2(Input.OAuthRefreshToken, True) OAuthTokens = MsLoginStep2(Input.OAuthRefreshToken, True, ClientId)
End If End If
'要求重新打开登录网页认证 '要求重新打开登录网页认证
If OAuthTokens(0) = "Cancel" Then Exit Sub
If OAuthTokens(0) = "Relogin" Then GoTo Relogin If OAuthTokens(0) = "Relogin" Then GoTo Relogin
Data.Progress = 0.35 Data.Progress = 0.35
If Data.IsAborted Then Throw New ThreadInterruptedException If Data.IsAborted Then Throw New ThreadInterruptedException
@@ -668,6 +671,7 @@ LoginFinish:
Url:=Data.Input.BaseUrl & "/validate", Url:=Data.Input.BaseUrl & "/validate",
Method:="POST", Method:="POST",
Data:=RequestData.ToString(0), Data:=RequestData.ToString(0),
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
ContentType:="application/json; charset=utf-8") '没有返回值的 ContentType:="application/json; charset=utf-8") '没有返回值的
'将登录结果输出 '将登录结果输出
Data.Output.AccessToken = AccessToken Data.Output.AccessToken = AccessToken
@@ -691,6 +695,7 @@ LoginFinish:
""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & " ""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & "
""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """, ""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """,
""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}", ""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}",
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
ContentType:="application/json; charset=utf-8")) ContentType:="application/json; charset=utf-8"))
'将登录结果输出 '将登录结果输出
If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效!") If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效!")
@@ -721,6 +726,7 @@ LoginFinish:
Url:=Data.Input.BaseUrl & "/authenticate", Url:=Data.Input.BaseUrl & "/authenticate",
Method:="POST", Method:="POST",
Data:=RequestData.ToString(0), Data:=RequestData.ToString(0),
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
ContentType:="application/json; charset=utf-8")) ContentType:="application/json; charset=utf-8"))
'检查登录结果 '检查登录结果
If LoginJson("availableProfiles").Count = 0 Then If LoginJson("availableProfiles").Count = 0 Then
@@ -780,6 +786,16 @@ LoginFinish:
Catch ex As Exception Catch ex As Exception
Dim AllMessage As String = GetExceptionSummary(ex) Dim AllMessage As String = GetExceptionSummary(ex)
Log(ex, "登录失败原始错误信息", LogLevel.Normal) Log(ex, "登录失败原始错误信息", LogLevel.Normal)
'读取服务器返回的错误
If TypeOf ex Is ResponsedWebException Then
Dim ErrorMessage As String = Nothing
Try
ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage")
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then Throw New Exception("$登录失败:" & ErrorMessage)
End If
'通用关键字检测
If AllMessage.Contains("403") Then If AllMessage.Contains("403") Then
Select Case Data.Input.Type Select Case Data.Input.Type
Case McLoginType.Auth Case McLoginType.Auth
@@ -808,111 +824,180 @@ LoginFinish:
'微软登录步骤 1:打开网页认证,获取 OAuth Code '微软登录步骤 1:打开网页认证,获取 OAuth Code
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
McLaunchLog("开始微软登录步骤 1") McLaunchLog("开始微软登录步骤 1")
If True OrElse OsVersion <= New Version(10, 0, 17763, 0) Then '由于 #3849,WebBrowser 已经无法正常加载微软登录网页了 OpenWebsite(FormLoginOAuth.LoginUrl1)
SystemBrowser: Dim Result As String =
'Windows 7 或老版 Windows 10 登录 MyMsgBoxInput("等待网页登录",
OpenWebsite(FormLoginOAuth.LoginUrl1) "登录完成后,网页会变得完全空白。把那个空白网页的网址复制到下面的框中就行!" & vbCrLf &
Dim Result As String = "如果网络环境不佳,它可能一直加载不出来,那就只能试试用 VPN 或加速器了。",
MyMsgBoxInput("等待网页登录", ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")},
"登录完成后,网页会变得完全空白,把那个空白网页的网址复制到下面的框中就行了!" & vbCrLf & HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX")
"如果网络环境不佳,它可能一直加载不出来,那就只能试试用 VPN 或加速器了。", If Result Is Nothing Then
ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")}, McLaunchLog("微软登录已在步骤 1 被取消")
HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX") Throw New ThreadInterruptedException("$$")
If Result Is Nothing Then
McLaunchLog("微软登录已在步骤 1 被取消")
Throw New ThreadInterruptedException("$$")
Else
Return RegexSeek(Result, "(?<=code\=)[^&]+")
End If
Hint("网页登录成功,你可以关闭浏览器啦!", HintType.Finish)
Else Else
'Windows 10 登录 Return RegexSeek(Result, "(?<=code\=)[^&]+")
Dim ReturnCode As String = Nothing
Dim ReturnEx As Exception = Nothing
Dim IsFinished As LoadState = LoadState.Loading
Dim LoginForm As FormLoginOAuth = Nothing
Dim IsSwitchToSystemBrowser As Boolean = False
RunInUi(Sub()
Try
LoginForm = New FormLoginOAuth
LoginForm.Show()
AddHandler LoginForm.OnLoginSuccess, Sub(Code As String)
ReturnCode = Code
IsFinished = LoadState.Finished
End Sub
AddHandler LoginForm.OnLoginCanceled, Sub(IsSwitch As Boolean)
IsFinished = LoadState.Aborted
IsSwitchToSystemBrowser = IsSwitch
End Sub
Catch ex As Exception
ReturnEx = ex
IsFinished = LoadState.Failed
End Try
End Sub)
Do While IsFinished = LoadState.Loading AndAlso Not Data.IsAborted
Thread.Sleep(20)
Loop
RunInUi(Sub() If LoginForm IsNot Nothing Then LoginForm.Close())
If IsFinished = LoadState.Finished Then
Return ReturnCode
ElseIf IsFinished = LoadState.Failed Then
Throw ReturnEx
ElseIf IsSwitchToSystemBrowser Then
McLaunchLog("微软登录在步骤 1 要求切换到系统浏览器")
GoTo SystemBrowser
Else
McLaunchLog("微软登录已在步骤 1 被取消")
Throw New ThreadInterruptedException("$$")
End If
End If End If
End Function End Function
'微软登录步骤 2:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken} '微软登录步骤 2:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
Private Function MsLoginStep2(Code As String, IsRefresh As Boolean) As String() Private Function MsLoginStep2(Code As String, IsRefresh As Boolean, ClientId As String, Optional ExpiresIn As String = "900") As String()
McLaunchLog("开始微软登录步骤 2(" & If(IsRefresh, "", "非") & "刷新登录)") McLaunchLog("开始微软登录步骤 2(" & If(IsRefresh, "", "非") & "刷新登录)")
Dim Request As String Dim Request As String
If IsRefresh Then If IsRefresh Then
Request = "client_id=00000000402b5328" & "&" & Request = "grant_type=refresh_token" & "&" &
"client_id=" & ClientId & "&" &
"device_code=" & Code & "&" &
"refresh_token=" & Uri.EscapeDataString(Code) & "&" & "refresh_token=" & Uri.EscapeDataString(Code) & "&" &
"grant_type=refresh_token" & "&" & "scope=XboxLive.signin%20offline_access"
"redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" &
"scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL")
Else Else
Request = "client_id=00000000402b5328" & "&" & Request = "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
"code=" & Uri.EscapeDataString(Code) & "&" & "client_id=" & ClientId & "&" &
"grant_type=authorization_code" & "&" & "device_code=" & Code & "&" &
"redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" & "scope=XboxLive.signin%20offline_access"
"scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL")
End If End If
Dim Result As String Dim Result As String
Try Dim stopwatch As Stopwatch = Stopwatch.StartNew()
Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 2)
Catch ex As Exception While stopwatch.Elapsed < TimeSpan.FromSeconds(ExpiresIn)
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269 Try
Return {"Relogin", ""} Result = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", Request, "application/x-www-form-urlencoded", 2)
Else Catch ex As Exception
Throw If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
Return {"Relogin", ""}
ElseIf ex.Message.Contains("authorization_declined") Then
Hint("你拒绝了 PCL2 的访问权限申请,验证过程被中断!")
Return {"Cancel", ""}
ElseIf ex.Message.Contains("expired_token") Then
Hint("Token 已过期,请尝试重新验证!")
Exit While
ElseIf ex.Message.Contains("AADSTS70016") Then
Continue While
Else
Throw
End If
End Try
If Result IsNot Nothing Then
Dim ResultJson As JObject = GetJson(Result)
Dim AccessToken As String = ResultJson("access_token").ToString
Dim RefreshToken As String = ResultJson("refresh_token").ToString
Return {AccessToken, RefreshToken}
End If End If
End Try
Thread.Sleep(1000)
End While
Hint("验证超时,请尝试重新验证!")
Return {"Cancel", ""}
Dim ResultJson As JObject = GetJson(Result)
Dim AccessToken As String = ResultJson("access_token").ToString
Dim RefreshToken As String = ResultJson("refresh_token").ToString
Return {AccessToken, RefreshToken}
End Function End Function
''微软登录步骤 1:获取 DeviceCode 并显示验证提示
''https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
'Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
' McLaunchLog("开始微软登录步骤 1:获取验证信息")
' Dim PrepareJson As JObject = GetJson(NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
' $"client_id={OAuthClientId}&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded", 2))
' '从这里开始直到步骤 2 结束都没有 Review
' '参考:https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
' If MyMsgBox("请在打开的网页里输入 PCL2 提供的设备代码(会自动复制到剪贴板)。" & vbCrLf &
' "设备代码有时效性,若操作时间过长需要重新进行登录流程。", "正版验证确认", "继续", "取消") <> 1 Then
' Return "Cancel"
' End If
' Dim DeviceCode As String = PrepareJson("device_code")
' Dim UserCode As String = PrepareJson("user_code")
' Dim VerifyUri As String = PrepareJson("verification_uri")
' 'ResultJson("expires_in")
' ClipboardSet(UserCode)
' OpenWebsite(VerifyUri)
' Dim MsgBoxValue As String = ""
' While MsgBoxValue IsNot "1"
' MsgBoxValue = MyMsgBox("本次验证的设备代码为:" & UserCode & vbCrLf & vbCrLf & "你也可以在任意设备上打开下列网址进行验证:" & vbCrLf & VerifyUri & vbCrLf & vbCrLf & "在验证完成后,你可以直接关闭这个弹窗,PCL2 会自动完成接下来的流程。", "正版验证", "关闭", "复制网址", "复制设备代码").ToString
' If MsgBoxValue = "2" Then
' ClipboardSet(VerifyUri)
' Continue While
' ElseIf MsgBoxValue = "3" Then
' ClipboardSet(UserCode)
' Continue While
' ElseIf MsgBoxValue = "1" Then
' Exit While
' End If
' End While
' Return DeviceCode
'End Function
''微软登录步骤 2:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
'Private Function MsLoginStep2(Code As String, IsRefresh As Boolean, Optional ExpiresIn As String = "900") As String()
' McLaunchLog("开始微软登录步骤 2(" & If(IsRefresh, "", "非") & "刷新登录)")
' Dim Request As String
' If IsRefresh Then
' Request = "grant_type=refresh_token" & "&" &
' "client_id=" & OAuthClientId & "&" &
' "device_code=" & Code & "&" &
' "refresh_token=" & Uri.EscapeDataString(Code) & "&" &
' "scope=XboxLive.signin%20offline_access"
' Else
' Request = "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
' "client_id=" & OAuthClientId & "&" &
' "device_code=" & Code & "&" &
' "scope=XboxLive.signin%20offline_access"
' End If
' Dim Result As String
' Dim stopwatch As Stopwatch = Stopwatch.StartNew()
' While stopwatch.Elapsed < TimeSpan.FromSeconds(ExpiresIn)
' Try
' Result = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", Request, "application/x-www-form-urlencoded", 2)
' Catch ex As Exception
' If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
' Return {"Relogin", ""}
' ElseIf ex.Message.Contains("authorization_declined") Then
' Hint("你拒绝了 PCL2 的访问权限申请,验证过程被中断!")
' Return {"Cancel", ""}
' ElseIf ex.Message.Contains("expired_token") Then
' Hint("Token 已过期,请尝试重新验证!")
' Exit While
' ElseIf ex.Message.Contains("AADSTS70016") Then
' Continue While
' Else
' Throw
' End If
' End Try
' If Result IsNot Nothing Then
' Dim ResultJson As JObject = GetJson(Result)
' Dim AccessToken As String = ResultJson("access_token").ToString
' Dim RefreshToken As String = ResultJson("refresh_token").ToString
' Return {AccessToken, RefreshToken}
' End If
' Thread.Sleep(1000)
' End While
' Hint("验证超时,请尝试重新验证!")
' Return {"Cancel", ""}
'End Function
'微软登录步骤 3:从 OAuth AccessToken 获取 XBLToken '微软登录步骤 3:从 OAuth AccessToken 获取 XBLToken
Private Function MsLoginStep3(AccessToken As String) As String Private Function MsLoginStep3(AccessToken As String) As String
McLaunchLog("开始微软登录步骤 3") McLaunchLog("开始微软登录步骤 3")
Dim Request As String = "{ Dim Request As String = "{
""Properties"": { ""Properties"": {
""AuthMethod"": ""RPS"", ""AuthMethod"": ""RPS"",
""SiteName"": ""user.auth.xboxlive.com"", ""SiteName"": ""user.auth.xboxlive.com"",
""RpsTicket"": """ & AccessToken & """ ""RpsTicket"": """ & AccessToken & """
}, },
""RelyingParty"": ""http://auth.xboxlive.com"", ""RelyingParty"": ""http://auth.xboxlive.com"",
""TokenType"": ""JWT"" ""TokenType"": ""JWT""
}" }" 'TODO: 新版登录改为 ""RpsTicket"": ""d=" & AccessToken & """
Dim Result As String = NetRequestMulty("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3) Dim Result As String = NetRequestMulty("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)
Dim ResultJson As JObject = GetJson(Result) Dim ResultJson As JObject = GetJson(Result)
@@ -1069,7 +1154,7 @@ SystemBrowser:
Case 3 Case 3
'使用正版用户名 '使用正版用户名
Try Try
If Not SkinName = "" Then If SkinName <> "" AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项(#3746)
Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName) Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName)
Uuid = McLoginMojangUuid(SkinName, False) Uuid = McLoginMojangUuid(SkinName, False)
End If End If
@@ -1199,7 +1284,7 @@ SystemBrowser:
'统一通行证检测 '统一通行证检测
If Setup.Get("LoginType") = McLoginType.Nide Then If Setup.Get("LoginType") = McLoginType.Nide Then
'至少 Java 8u101 '至少 Java 8u101
MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer) MinVer = If(New Version(1, 8, 0, 141) > MinVer, New Version(1, 8, 0, 141), MinVer)
End If End If
SyncLock JavaLock SyncLock JavaLock
@@ -1226,12 +1311,12 @@ SystemBrowser:
ElseIf MaxVer < New Version(1, 8, 0, 0) Then ElseIf MaxVer < New Version(1, 8, 0, 0) Then
JavaCode = 7 JavaCode = 7
If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = "8u101" JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 8.0.141 ~ 8.0.320", True) Then Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 100) Then ElseIf MinVer > New Version(1, 8, 0, 140) Then
JavaCode = "8u101" JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True) Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 8.0.141 或更高版本的 Java 8", True) Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 321) Then ElseIf MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = 8 JavaCode = 8
If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$") If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$")
@@ -1280,20 +1365,28 @@ SystemBrowser:
Dim WrapperPath As String = BaseDir & "\JavaWrapper.jar" Dim WrapperPath As String = BaseDir & "\JavaWrapper.jar"
Log("[Java] 选定的 Java Wrapper 路径:" & WrapperPath) Log("[Java] 选定的 Java Wrapper 路径:" & WrapperPath)
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突 SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
Dim IsWrapperWritten As Boolean = WriteFile(WrapperPath, GetResources("JavaWrapper")) Try
If Not IsWrapperWritten AndAlso File.Exists(WrapperPath) Then WriteFile(WrapperPath, GetResources("JavaWrapper"))
'以下为 #4243 的修复,因为未知原因 Java Wrapper 可能变为只读文件 Catch ex As Exception
Log("[Java] Java Wrapper 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Debug) If File.Exists(WrapperPath) Then
Try '因为未知原因 Java Wrapper 可能变为只读文件(#4243)
File.Delete(WrapperPath) Log(ex, "Java Wrapper 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Developer)
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper")) Try
Catch ex As Exception File.Delete(WrapperPath)
Log(ex, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成") WriteFile(WrapperPath, GetResources("JavaWrapper"))
WrapperPath = BaseDir & "\JavaWrapper2.jar" Catch ex2 As Exception
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper")) Log(ex2, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成", LogLevel.Developer)
End Try WrapperPath = BaseDir & "\JavaWrapper2.jar"
End If Try
If Not IsWrapperWritten Then Throw New FileNotFoundException("释放 Java Wrapper 失败,请查看 PCL 日志查找详细信息") WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex3 As Exception
Throw New FileNotFoundException("释放 Java Wrapper 最终尝试失败", ex3)
End Try
End Try
Else
Throw New FileNotFoundException("释放 Java Wrapper 失败", ex)
End If
End Try
End SyncLock End SyncLock
Return WrapperPath Return WrapperPath
End Function End Function
@@ -1785,7 +1878,6 @@ NextVersion:
{ {
""authenticationDatabase"": { ""authenticationDatabase"": {
""00000111112222233333444445555566"": { ""00000111112222233333444445555566"": {
""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """, ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
""profiles"": { ""profiles"": {
""66666555554444433333222221111100"": { ""66666555554444433333222221111100"": {
@@ -1816,7 +1908,6 @@ NextVersion:
{ {
""authenticationDatabase"": { ""authenticationDatabase"": {
""00000111112222233333444445555566"": { ""00000111112222233333444445555566"": {
""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """, ""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
""profiles"": { ""profiles"": {
""66666555554444433333222221111100"": { ""66666555554444433333222221111100"": {
@@ -1892,16 +1983,12 @@ NextVersion:
End Try End Try
'离线皮肤 Alex 警告 '离线皮肤 Alex 警告
Try If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.2 ~ 1.7
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.7 ~ 1.2
McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录 McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
(Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex (Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
(Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤 (Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical) Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical)
End If End If
Catch ex As Exception
Log(ex, "检查离线皮肤失效失败")
End Try
'离线皮肤资源包 '离线皮肤资源包
Try Try
@@ -2143,6 +2230,8 @@ IgnoreCustomSkin:
StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";") StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
'设置其他参数 '设置其他参数
StartInfo.StandardErrorEncoding = Encoding.UTF8
StartInfo.StandardOutputEncoding = Encoding.UTF8
StartInfo.WorkingDirectory = McVersionCurrent.PathIndie StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
StartInfo.UseShellExecute = False StartInfo.UseShellExecute = False
StartInfo.RedirectStandardOutput = True StartInfo.RedirectStandardOutput = True
@@ -565,6 +565,7 @@ Recheck:
Log(ex, "合并版本依赖项 json 失败(" & If(InheritVersion, "null").ToString & ")") Log(ex, "合并版本依赖项 json 失败(" & If(InheritVersion, "null").ToString & ")")
End Try End Try
Catch ex As Exception Catch ex As Exception
Log($"[Minecraft] 传入的版本 json 文件内容(共 {Text.Length} 字符,最多输出前 5000 字符):{vbCrLf}{Text.Substring(0, 5000)}")
Throw New Exception("版本 json 不规范(" & If(Name, "null") & ")", ex) Throw New Exception("版本 json 不规范(" & If(Name, "null") & ")", ex)
End Try End Try
Try Try
@@ -665,7 +666,7 @@ Recheck:
Try Try
Dim JsonObjCheck = JsonObject Dim JsonObjCheck = JsonObject
Catch ex As Exception Catch ex As Exception
Log(ex, "版本 json 可用性检查失败(" & Path & ")") Log(ex, "版本 JSON 可用性检查失败(" & Path & ")")
JsonText = "" JsonText = ""
JsonObject = Nothing JsonObject = Nothing
Info = ex.Message Info = ex.Message
@@ -2026,8 +2027,9 @@ OnLoaded:
If Token.Url IsNot Nothing Then If Token.Url IsNot Nothing Then
'获取 Url 的真实地址 '获取 Url 的真实地址
Urls.Add(Token.Url) Urls.Add(Token.Url)
If Token.Url.Contains("launcher.mojang.com/v1/objects") Then If Token.Url.Contains("launcher.mojang.com/v1/objects") OrElse Token.Url.Contains("client.txt") OrElse
Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings Token.Url.Contains(".tsrg") Then
Urls.AddRange(DlSourceLauncherOrMetaGet(Token.Url).ToList()) 'Mappings(#4425)
End If End If
If Token.Url.Contains("maven") Then If Token.Url.Contains("maven") Then
Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/"). Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").
@@ -2049,7 +2051,7 @@ OnLoaded:
'普通文件 '普通文件
Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/"))) Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")))
End If End If
Result.Add(New NetFile(Urls.Distinct.ToArray, Token.LocalPath, Checker)) Result.Add(New NetFile(Urls.Distinct, Token.LocalPath, Checker))
Next Next
'去重并返回 '去重并返回
Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath) Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath)
@@ -707,7 +707,7 @@ Finished:
End If End If
'读取文件 '读取文件
Dim data As New List(Of Byte) Dim data As New List(Of Byte)
For Each b As Byte In File.ReadAllBytes(Path) For Each b As Byte In ReadFileBytes(Path)
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
data.Add(b) data.Add(b)
Next Next
@@ -924,7 +924,7 @@ Finished:
End Try End Try
End Sub End Sub
'联网加载 Mod 详情 '联网加载 Mod 详情
Private Const LocalModCacheVersion As Integer = 5 Private Const LocalModCacheVersion As Integer = 6
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad) Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)) Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key Dim Mods As List(Of McMod) = Loader.Input.Key
@@ -952,7 +952,7 @@ Finished:
Try Try
'步骤 1:获取 Hash 与对应的工程 ID '步骤 1:获取 Hash 与对应的工程 ID
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList() Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST", Dim ModrinthVersion = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject) $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息") Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系 '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
@@ -973,7 +973,7 @@ Finished:
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息") Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Exit Sub If Not ModrinthMapping.Any() Then Exit Sub
Dim ModrinthProject = CType(GetJson(NetRequestRetry( Dim ModrinthProject = CType(GetJson(DlModRequest(
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]", $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]",
"GET", "", "application/json")), JArray) "GET", "", "application/json")), JArray)
For Each ProjectJson In ModrinthProject For Each ProjectJson In ModrinthProject
@@ -985,7 +985,7 @@ Finished:
Next Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息") Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息 '步骤 4:获取更新信息
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST", Dim ModrinthUpdate = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files/update", "POST",
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"", $"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject) ""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject)
For Each Entry In Mods For Each Entry In Mods
@@ -1022,7 +1022,7 @@ Finished:
CurseForgeHashes.Add(Entry.CurseForgeHash) CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Next Next
Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST", Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer) $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息") Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系 '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
@@ -1045,12 +1045,12 @@ Finished:
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息") Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Exit Sub If Not CurseForgeMapping.Any() Then Exit Sub
Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST", Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST",
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data") $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表 Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String) Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject For Each ProjectJson In CurseForgeProject
If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息 '设置 Entry 中的工程信息
Dim Project As New CompProject(ProjectJson) Dim Project As New CompProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏 For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
@@ -1066,7 +1066,8 @@ Finished:
Dim NewestVersion As String = Nothing Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer) Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes") For Each IndexEntry In ProjectJson("latestFilesIndexes")
If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配 If IndexEntry("modLoader") Is Nothing OrElse Not IndexEntry("modLoader").HasValues OrElse '镜像源会返回一个值为 null 的键
ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion") Dim IndexVersion As String = IndexEntry("gameVersion")
If McVersion <> IndexVersion Then Continue For 'MC 版本匹配 If McVersion <> IndexVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件 '由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
@@ -1087,7 +1088,7 @@ Finished:
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息") Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息 '步骤 4:获取更新文件信息
If Not UpdateFileIds.Any() Then Exit Sub If Not UpdateFileIds.Any() Then Exit Sub
Dim CurseForgeFiles = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", Dim CurseForgeFiles = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST",
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data") $"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFiles As New Dictionary(Of McMod, CompFile) Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
For Each FileJson In CurseForgeFiles For Each FileJson In CurseForgeFiles
@@ -1129,11 +1130,13 @@ Finished:
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList() Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存") Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Exit Sub If Not Mods.Any() Then Exit Sub
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳 For Each Entry In Mods
Entry.CompLoaded = SucceedThreadCount = 2 Entry.CompLoaded = SucceedThreadCount = 2
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson() Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
Next Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
RunInUi(Sub() FrmVersionMod?.RefreshBars())
End Sub End Sub
Private Function GetTargetModLoaders() As List(Of CompModLoaderType) Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType) Dim ModLoaders As New List(Of CompModLoaderType)
@@ -12,9 +12,10 @@ Public Module ModModpack
RunInThread(Sub() ModpackInstall(File)) RunInThread(Sub() ModpackInstall(File))
End Sub End Sub
''' <summary> ''' <summary>
''' 安装一个给定的整合包文件,返回是否安装成功。必须在工作线程执行。 ''' 安装一个给定的整合包文件,返回启动的安装加载器,如果未成功启动则返回 Nothing。
''' 必须在工作线程执行。
''' </summary> ''' </summary>
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As Boolean Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Log("[ModPack] 整合包安装请求:" & If(File, "null")) Log("[ModPack] 整合包安装请求:" & If(File, "null"))
Dim Archive As ZipArchive = Nothing Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = "" Dim ArchiveBaseFolder As String = ""
@@ -45,6 +46,7 @@ Public Module ModModpack
If FullNames.Count <> 2 Then Continue For If FullNames.Count <> 2 Then Continue For
'判断是否为关键文件 '判断是否为关键文件
If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断) If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包 If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If FullNames(1) = "manifest.json" Then If FullNames(1) = "manifest.json" Then
Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8)) Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
@@ -55,54 +57,52 @@ Public Module ModModpack
End If End If
End If End If
If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包 If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
Next Next
Catch ex As Exception Catch ex As Exception
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False Return Nothing
ElseIf File.EndsWithF(".rar", True) Then ElseIf File.EndsWithF(".rar", True) Then
Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False Return Nothing
Else Else
Log(ex, "打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Log(ex, "打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False Return Nothing
End If End If
End Try End Try
'执行对应的安装方法 '执行对应的安装方法
Select Case PackType Select Case PackType
Case 0 Case 0
Log("[ModPack] 整合包种类:CurseForge") Log("[ModPack] 整合包种类:CurseForge")
InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo) Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 1 Case 1
Log("[ModPack] 整合包种类:HMCL") Log("[ModPack] 整合包种类:HMCL")
InstallPackHMCL(File, Archive, ArchiveBaseFolder) Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
Case 2 Case 2
Log("[ModPack] 整合包种类:MMC") Log("[ModPack] 整合包种类:MMC")
InstallPackMMC(File, Archive, ArchiveBaseFolder) Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
Case 3 Case 3
Log("[ModPack] 整合包种类:MCBBS") Log("[ModPack] 整合包种类:MCBBS")
InstallPackMCBBS(File, Archive, ArchiveBaseFolder) Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName)
Case 4 Case 4
Log("[ModPack] 整合包种类:Modrinth") Log("[ModPack] 整合包种类:Modrinth")
InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo) Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 9 Case 9
Log("[ModPack] 整合包种类:压缩包") Log("[ModPack] 整合包种类:压缩包")
Archive.Dispose() Archive.Dispose()
Archive = Nothing Archive = Nothing
InstallPackCompress(File, ArchiveBaseFolder) Return InstallPackCompress(File, ArchiveBaseFolder)
Case Else Case Else
If ShowHint Then If ShowHint Then
Hint("未能识别该整合包的种类,无法安装!", HintType.Critical) Hint("未能识别该整合包的种类,无法安装!", HintType.Critical)
Else Else
Log("[ModPack] 未能识别该整合包的种类,无法安装!") Log("[ModPack] 未能识别该整合包的种类,无法安装!")
End If End If
Return False Return Nothing
End Select End Select
Return True
Catch ex As Exception Catch ex As Exception
Log(ex, "准备安装整合包失败", LogLevel.Feedback) Log(ex, "准备安装整合包失败", LogLevel.Feedback)
Return False Return Nothing
Finally Finally
If Archive IsNot Nothing Then Archive.Dispose() If Archive IsNot Nothing Then Archive.Dispose()
End Try End Try
@@ -159,7 +159,8 @@ Retry:
#Region "不同类型整合包的安装方法" #Region "不同类型整合包的安装方法"
'CurseForge 'CurseForge
Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
@@ -167,18 +168,18 @@ Retry:
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open)) Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息") If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Log(ex, "CurseForge 整合包安装信息存在问题", LogLevel.Hint)
Exit Sub Return Nothing
End Try End Try
'获取版本名 '获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then If VersionName Is Nothing Then
Dim PackName As String = If(Json("name"), "") VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Exit Sub If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If End If
'获取 Mod API 版本信息 '获取 Mod API 版本信息
@@ -191,7 +192,7 @@ Retry:
'Forge 指定 'Forge 指定
If Id.Contains("recommended") Then If Id.Contains("recommended") Then
Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint) Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint)
Exit Sub Return Nothing
End If End If
Try Try
Log("[ModPack] 整合包 Forge 版本:" & Id) Log("[ModPack] 整合包 Forge 版本:" & Id)
@@ -259,7 +260,7 @@ Retry:
'获取 Mod 下载信息 '获取 Mod 下载信息
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息", ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray)) Sub(Task As LoaderTask(Of Integer, JArray))
Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data") Task.Output = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
'如果文件已被删除,则 API 会跳过那一项 '如果文件已被删除,则 API 会跳过那一项
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除,因此无法完成整合包安装,请联系整合包作者更新整合包中的 Mod 版本") If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除,因此无法完成整合包安装,请联系整合包作者更新整合包中的 Mod 版本")
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
@@ -319,7 +320,7 @@ Retry:
.FabricVersion = FabricVersion .FabricVersion = FabricVersion
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -350,14 +351,10 @@ Retry:
'重复任务检查 '重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " " Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
For i = 0 To LoaderTaskbar.Count - 1 Hint("该整合包正在安装中!", HintType.Critical)
If LoaderTaskbar(i).Name = LoaderName Then Return Nothing
Hint("该整合包正在安装中!", HintType.Critical) End If
Exit Sub
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -365,11 +362,11 @@ Retry:
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble() If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Sub End Function
'Modrinth 'Modrinth
Private Sub InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
@@ -378,7 +375,7 @@ Retry:
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息") If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub Return Nothing
End Try End Try
'获取 Mod API 版本信息 '获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing Dim MinecraftVersion As String = Nothing
@@ -400,42 +397,42 @@ Retry:
Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion) Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
Case "quilt-loader" 'eg. 1.0.0 Case "quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical) Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub Return Nothing
Case Else Case Else
Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical) Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical)
Exit Sub Return Nothing
End Select End Select
Next Next
'获取版本名 '获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then If VersionName Is Nothing Then
Dim PackName As String = If(Json("name"), "") VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Exit Sub If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If End If
'解压和配置文件 '解压和配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer)) Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress, Task) UnpackFiles(InstallTemp, FileAddress, Task)
Task.Progress = 0.5 Task.Progress = 0.5
'复制 overrides 文件夹和 client-overrides 文件夹 '复制 overrides 文件夹和 client-overrides 文件夹
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName) CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
Else Else
Log("[ModPack] 整合包中未找到 override 目录,已跳过") Log("[ModPack] 整合包中未找到 override 目录,已跳过")
End If End If
Task.Progress = 0.8 Task.Progress = 0.8
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName) CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName)
End If End If
Task.Progress = 0.9 Task.Progress = 0.9
'开启版本隔离 '开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表 '获取下载文件列表
Dim FileList As New List(Of NetFile) Dim FileList As New List(Of NetFile)
For Each File In If(Json("files"), {}) For Each File In If(Json("files"), {})
@@ -452,8 +449,10 @@ Retry:
End Select End Select
End If End If
'添加下载文件 '添加下载文件
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390 Dim Urls = File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToList
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString, Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = Urls.Distinct.ToList()
FileList.Add(New NetFile(Urls, PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True)) New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
Next Next
If FileList.Any Then If FileList.Any Then
@@ -470,7 +469,7 @@ Retry:
.FabricVersion = FabricVersion .FabricVersion = FabricVersion
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -501,14 +500,10 @@ Retry:
'重复任务检查 '重复任务检查
Dim LoaderName As String = "Modrinth 整合包安装:" & VersionName & " " Dim LoaderName As String = "Modrinth 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
For i = 0 To LoaderTaskbar.Count - 1 Hint("该整合包正在安装中!", HintType.Critical)
If LoaderTaskbar(i).Name = LoaderName Then Return Nothing
Hint("该整合包正在安装中!", HintType.Critical) End If
Exit Sub
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -516,25 +511,26 @@ Retry:
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble() If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Sub End Function
'HMCL 'HMCL
Private Sub InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8)) Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub Return Nothing
End Try End Try
'获取版本名 '获取版本名
Dim PackName As String = If(Json("name"), "") Dim VersionName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If VersionName Is Nothing Then Exit Sub If String.IsNullOrEmpty(VersionName) Then Return Nothing
'解压与配置文件 '解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
@@ -555,7 +551,7 @@ Retry:
'构造加载器 '构造加载器
If Json("gameVersion") Is Nothing Then If Json("gameVersion") Is Nothing Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical) Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub Return Nothing
End If End If
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .TargetVersionName = VersionName,
@@ -563,7 +559,7 @@ Retry:
.MinecraftName = Json("gameVersion").ToString .MinecraftName = Json("gameVersion").ToString
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件) '构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)", LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)",
@@ -591,14 +587,10 @@ Retry:
'重复任务检查 '重复任务检查
Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " " Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
For i = 0 To LoaderTaskbar.Count - 1 Hint("该整合包正在安装中!", HintType.Critical)
If LoaderTaskbar(i).Name = LoaderName Then Return Nothing
Hint("该整合包正在安装中!", HintType.Critical) End If
Exit Sub
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -607,10 +599,11 @@ Retry:
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
End Sub Return Loader
End Function
'MMC 'MMC
Private Sub InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim PackJson As JObject, PackInstance As String Dim PackJson As JObject, PackInstance As String
Try Try
@@ -618,14 +611,14 @@ Retry:
PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8) PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub Return Nothing
End Try End Try
'获取版本名 '获取版本名
Dim PackName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "") Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(PackName) <> "" Then PackName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If VersionName Is Nothing Then Exit Sub If String.IsNullOrEmpty(VersionName) Then Return Nothing
'解压、配置设置文件 '解压、配置设置文件
Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\" Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\"
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini" Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
@@ -685,7 +678,7 @@ Retry:
'构造版本安装请求 '构造版本安装请求
If PackJson("components") Is Nothing Then If PackJson("components") Is Nothing Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical) Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub Return Nothing
End If End If
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"} Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
For Each Component In PackJson("components") For Each Component In PackJson("components")
@@ -702,12 +695,12 @@ Retry:
Request.FabricVersion = Component("version") Request.FabricVersion = Component("version")
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0 Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical) Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub Return Nothing
End Select End Select
Next Next
'构造加载器 '构造加载器
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -720,14 +713,10 @@ Retry:
'重复任务检查 '重复任务检查
Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " " Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
For i = 0 To LoaderTaskbar.Count - 1 Hint("该整合包正在安装中!", HintType.Critical)
If LoaderTaskbar(i).Name = LoaderName Then Return Nothing
Hint("该整合包正在安装中!", HintType.Critical) End If
Exit Sub
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -735,10 +724,12 @@ Retry:
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
End Sub Return Loader
End Function
'MCBBS 'MCBBS
Private Sub InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
@@ -746,14 +737,17 @@ Retry:
Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8)) Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
Exit Sub Return Nothing
End Try End Try
'获取版本名 '获取版本名
Dim PackName As String = If(Json("name"), "") Dim ShowRibble As Boolean = VersionName Is Nothing
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") If VersionName Is Nothing Then
If Validate.Validate(PackName) <> "" Then PackName = "" VersionName = If(Json("name"), "")
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If VersionName Is Nothing Then Exit Sub If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing
End If
'解压与配置文件 '解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
@@ -774,7 +768,7 @@ Retry:
'构造加载器 '构造加载器
If Json("addons") Is Nothing Then If Json("addons") Is Nothing Then
Hint("该整合包未提供游戏版本附加信息,无法安装!", HintType.Critical) Hint("该整合包未提供游戏版本附加信息,无法安装!", HintType.Critical)
Exit Sub Return Nothing
End If End If
Dim Addons As New Dictionary(Of String, String) Dim Addons As New Dictionary(Of String, String)
For Each Entry In Json("addons") For Each Entry In Json("addons")
@@ -782,11 +776,11 @@ Retry:
Next Next
If Not Addons.ContainsKey("game") Then If Not Addons.ContainsKey("game") Then
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical) Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Exit Sub Return Nothing
End If End If
If Addons.ContainsKey("quilt") Then If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical) Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Exit Sub Return Nothing
End If End If
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .TargetVersionName = VersionName,
@@ -798,7 +792,7 @@ Retry:
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing) .FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -811,14 +805,10 @@ Retry:
'重复任务检查 '重复任务检查
Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " " Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " "
SyncLock LoaderTaskbarLock If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
For i = 0 To LoaderTaskbar.Count - 1 Hint("该整合包正在安装中!", HintType.Critical)
If LoaderTaskbar(i).Name = LoaderName Then Return Nothing
Hint("该整合包正在安装中!", HintType.Critical) End If
Exit Sub
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -826,28 +816,36 @@ Retry:
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
End Sub Return Loader
End Function
'普通压缩包 '普通压缩包
Private Sub InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) Private Function InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) As LoaderCombo(Of String)
MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹,它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True) MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹,它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True)
'获取解压路径 '获取解压路径
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)") Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
If String.IsNullOrEmpty(TargetFolder) Then Exit Sub If String.IsNullOrEmpty(TargetFolder) Then Return Nothing
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Exit Sub If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Return Nothing
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Exit Sub If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Return Nothing
'要求显示名称 '要求显示名称
Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", GetFolderNameFromPath(TargetFolder), Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", GetFolderNameFromPath(TargetFolder),
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})}) New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
If String.IsNullOrWhiteSpace(NewName) Then Exit Sub If String.IsNullOrWhiteSpace(NewName) Then Return Nothing
'解压 '解压
Hint("正在解压压缩包……") Dim Loader As New LoaderCombo(Of String)("安装压缩包", {
UnpackFiles(TargetFolder, FileAddress, Nothing) New LoaderTask(Of String, Integer)("安装压缩包",
'加入文件夹列表 Sub()
PageSelectLeft.AddFolder(TargetFolder, NewName, False) UnpackFiles(TargetFolder, FileAddress, Nothing)
Hint("已加入游戏文件夹列表:" & NewName, HintType.Finish) PageSelectLeft.AddFolder(TargetFolder, NewName, False) '加入文件夹列表
End Sub End Sub)
})
Loader.Start()
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Return Loader
End Function
#End Region #End Region
@@ -18,9 +18,6 @@
'网络图片 '网络图片
If File.Exists(FileAddress) Then If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress) PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[Comp] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else Else
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png") PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal) RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
@@ -58,6 +55,12 @@ RetryStart:
End If End If
'下载图片 '下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True) NetDownload(Url, LocalFileAddress & DownloadEnd, True)
If Url.EndsWithF("webp") Then
Log($"[Comp] Webp 格式转换:{LocalFileAddress}")
Dim dec = New Imazen.WebP.SimpleDecoder()
Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
End If
Dim LoadError As Exception = Nothing Dim LoadError As Exception = Nothing
RunInUiWait( RunInUiWait(
Sub() Sub()
@@ -20,9 +20,6 @@ Public Class MyLocalModItem
'网络图片 '网络图片
If File.Exists(FileAddress) Then If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress) PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[LocalModItem] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else Else
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png") PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal) RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
@@ -60,6 +57,12 @@ RetryStart:
End If End If
'下载图片 '下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True) NetDownload(Url, LocalFileAddress & DownloadEnd, True)
If Url.EndsWithF("webp") Then
Log($"[Comp] Webp 格式转换:{LocalFileAddress}")
Dim dec = New Imazen.WebP.SimpleDecoder()
Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
End If
Dim LoadError As Exception = Nothing Dim LoadError As Exception = Nothing
RunInUiWait( RunInUiWait(
Sub() Sub()
@@ -799,6 +799,8 @@ NextFile:
Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean
Public Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
#End Region #End Region
Public DragControl = Nothing Public DragControl = Nothing
+14 -10
View File
@@ -10,6 +10,8 @@ Friend Module ModSecret
'在开源内容的注册表键与普通内容的注册表键隔离 '在开源内容的注册表键与普通内容的注册表键隔离
Public Const RegFolder As String = "PCLDebug" Public Const RegFolder As String = "PCLDebug"
'用于微软登录的 ClientId
Public Const OAuthClientId As String = ""
Friend Sub SecretOnApplicationStart() Friend Sub SecretOnApplicationStart()
'提升 UI 线程优先级 '提升 UI 线程优先级
@@ -41,8 +43,9 @@ Friend Module ModSecret
Environment.[Exit](Result.Cancel) Environment.[Exit](Result.Cancel)
End If End If
'开源版本提示 '开源版本提示
MyMsgBox($"该版本中不包含以下特性: MyMsgBox($"该版本中无法使用以下特性:
- CurseForge 查询:需要 API Key(你可以申请一个,然后添加到 SecretHeadersSign 方法中) - CurseForge API 调用:需要你自行申请 API Key,然后添加到 SecretHeadersSign 方法中
- 正版登录:需要你自行申请 Client ID,然后添加到 ModSecret.vb 的开头
- 更新与联网通知:避免滥用隐患 - 更新与联网通知:避免滥用隐患
- 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦…… - 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……
- 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了", "开源版本说明") - 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了", "开源版本说明")
@@ -89,34 +92,35 @@ Friend Module ModSecret
#Region "网络鉴权" #Region "网络鉴权"
Friend Function SecretCdnSign(UrlWithMark As String) Friend Function SecretCdnSign(UrlWithMark As String)
'只处理以 {CDN} 结尾的链接
If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark
Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20") Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20")
End Function End Function
''' <summary> ''' <summary>
''' 设置 Headers 的 UA、Referer。 ''' 设置 Headers 的 UA、Referer。
''' </summary> ''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Client As CookieWebClient, Optional UseBrowserUserAgent As Boolean = False) Friend Sub SecretHeadersSign(Url As String, ByRef Client As WebClient, Optional UseBrowserUserAgent As Boolean = False)
If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用 If Url.Contains("modrinth.com") Then '根据 #4334,不添加 PCL 的 UA 反而能正常访问
If UseBrowserUserAgent Then Client.Headers("User-Agent") = "Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
ElseIf UseBrowserUserAgent Then
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else Else
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
End If End If
Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.server/" Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.open.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问 '如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问
End Sub End Sub
''' <summary> ''' <summary>
''' 设置 Headers 的 UA、Referer。 ''' 设置 Headers 的 UA、Referer。
''' </summary> ''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False) Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False)
If ApplicationStartTick < 1 Then Return '禁止在没有运行程序的情况下通过反射调用 If Url.Contains("modrinth.com") Then '根据 #4334,不添加 PCL 的 UA 反而能正常访问
If UseBrowserUserAgent Then Request.UserAgent = "Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
ElseIf UseBrowserUserAgent Then
Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else Else
Request.UserAgent = "PCL2/" & VersionStandardCode Request.UserAgent = "PCL2/" & VersionStandardCode
End If End If
Request.Referer = "http://" & VersionCode & ".pcl2.server/" Request.Referer = "http://" & VersionCode & ".pcl2.open.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问 '如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问
End Sub End Sub
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.8.3.0")> <Assembly: AssemblyVersion("2.8.6.0")>
<Assembly: AssemblyFileVersion("2.8.3.0")> <Assembly: AssemblyFileVersion("2.8.6.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
+30
View File
@@ -120,6 +120,26 @@ Namespace My.Resources
End Get End Get
End Property End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property libwebp32() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("libwebp32", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property libwebp64() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("libwebp64", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
@@ -149,5 +169,15 @@ Namespace My.Resources
Return CType(obj,Byte()) Return CType(obj,Byte())
End Get End Get
End Property End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property WebP() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("WebP", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
End Module End Module
End Namespace End Namespace
@@ -136,6 +136,12 @@
<data name="Json" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="libwebp32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\libwebp32.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="libwebp64" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\libwebp64.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\ModData.txt;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\ModData.txt;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
@@ -145,4 +151,7 @@
<data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="WebP" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
</root> </root>
@@ -28,15 +28,12 @@ Public Module ModDownloadLib
Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\" Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\"
'重复任务检查 '重复任务检查
SyncLock LoaderTaskbarLock For Each OngoingLoader In LoaderTaskbar
For i = 0 To LoaderTaskbar.Count - 1 If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
If LoaderTaskbar(i).Name = "Minecraft " & Id & " 下载" Then If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return OngoingLoader
If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return LoaderTaskbar(i) Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Critical) Return OngoingLoader
Return LoaderTaskbar(i) Next
End If
Next
End SyncLock
'已有版本检查 '已有版本检查
If Behaviour <> NetPreDownloadBehaviour.IgnoreCheck AndAlso File.Exists(VersionFolder & Id & ".json") AndAlso File.Exists(VersionFolder & Id & ".jar") Then If Behaviour <> NetPreDownloadBehaviour.IgnoreCheck AndAlso File.Exists(VersionFolder & Id & ".json") AndAlso File.Exists(VersionFolder & Id & ".jar") Then
@@ -74,15 +71,12 @@ Public Module ModDownloadLib
VersionFolder = VersionFolder & Id & "\" VersionFolder = VersionFolder & Id & "\"
'重复任务检查 '重复任务检查
SyncLock LoaderTaskbarLock For Each OngoingLoader In LoaderTaskbar
For i = 0 To LoaderTaskbar.Count - 1 If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
If LoaderTaskbar(i).Name = "Minecraft " & Id & " 下载" Then If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Exit Sub
If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Exit Sub Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Critical) Exit Sub
Exit Sub Next
End If
Next
End SyncLock
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
'下载版本 Json 文件 '下载版本 Json 文件
@@ -323,14 +317,11 @@ Public Module ModDownloadLib
If Not Target.Contains("\") Then Exit Sub If Not Target.Contains("\") Then Exit Sub
'重复任务检查 '重复任务检查
SyncLock LoaderTaskbarLock For Each OngoingLoader In LoaderTaskbar
For i = 0 To LoaderTaskbar.Count - 1 If OngoingLoader.Name <> $"OptiFine {DownloadInfo.NameDisplay} 下载" Then Continue For
If LoaderTaskbar(i).Name = "OptiFine " & DownloadInfo.NameDisplay & " 下载" Then Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Critical) Exit Sub
Exit Sub Next
End If
Next
End SyncLock
Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf DownloadStateSave} Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf DownloadStateSave}
Loader.Start(DownloadInfo) Loader.Start(DownloadInfo)
@@ -753,14 +744,11 @@ Retry:
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\" Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
'重复任务检查 '重复任务检查
SyncLock LoaderTaskbarLock For Each OngoingLoader In LoaderTaskbar
For i = 0 To LoaderTaskbar.Count - 1 If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
If LoaderTaskbar(i).Name = "LiteLoader " & Id & " 下载" Then Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Critical) Exit Sub
Exit Sub Next
End If
Next
End SyncLock
'已有版本检查 '已有版本检查
If File.Exists(VersionFolder & VersionName & ".json") Then If File.Exists(VersionFolder & VersionName & ".json") Then
@@ -790,14 +778,11 @@ Retry:
If Not Target.Contains("\") Then Exit Sub If Not Target.Contains("\") Then Exit Sub
'重复任务检查 '重复任务检查
SyncLock LoaderTaskbarLock For Each OngoingLoader In LoaderTaskbar
For i = 0 To LoaderTaskbar.Count - 1 If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
If LoaderTaskbar(i).Name = "LiteLoader " & Id & " 下载" Then Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Critical) Exit Sub
Exit Sub Next
End If
Next
End SyncLock
'构造步骤加载器 '构造步骤加载器
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
@@ -975,14 +960,11 @@ Retry:
If Not Target.Contains("\") Then Exit Sub If Not Target.Contains("\") Then Exit Sub
'重复任务检查 '重复任务检查
SyncLock LoaderTaskbarLock For Each OngoingLoader In LoaderTaskbar
For i = 0 To LoaderTaskbar.Count - 1 If OngoingLoader.Name <> $"{DisplayName} 下载" Then Continue For
If LoaderTaskbar(i).Name = DisplayName & " 下载" Then Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Critical) Exit Sub
Exit Sub Next
End If
Next
End SyncLock
'获取下载地址 '获取下载地址
Dim Files As New List(Of NetFile) Dim Files As New List(Of NetFile)
@@ -1278,15 +1260,17 @@ Retry:
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg] '[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Before("@") Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Before("@")
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1)) Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Libs.Add(New McLibToken With {.IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName, Dim ClientMappings As JToken = RawJson("downloads")("client_mappings")
.Url = RawJson("downloads")("client_mappings")("url"), .Size = RawJson("downloads")("client_mappings")("size"), .SHA1 = RawJson("downloads")("client_mappings")("sha1")}) Libs.Add(New McLibToken With {
Log("[Download] 需要下载 Mappings:" & Address) .IsJumpLoader = False, .IsNatives = False, .LocalPath = Address, .OriginalName = OriginalName,
.Url = ClientMappings("url"), .Size = ClientMappings("size"), .SHA1 = ClientMappings("sha1")})
Log($"[Download] 需要下载 Mappings:{ClientMappings("url")} (SHA1: {ClientMappings("sha1")})")
End If End If
Task.Progress = 0.8 Task.Progress = 0.8
'去除其中的原始 Forgelike 项 '去除其中的原始 Forgelike 项
For i = 0 To Libs.Count - 1 For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}.jar") OrElse If Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}.jar") OrElse
Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}-client.jar") Then Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}-client.jar") Then
Log($"[Download] 已从待下载 {LoaderName} 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug) Log($"[Download] 已从待下载 {LoaderName} 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
Libs.RemoveAt(i) Libs.RemoveAt(i)
Exit For Exit For
@@ -1413,55 +1397,55 @@ Retry:
End Sub) With {.ProgressWeight = 10}) End Sub) With {.ProgressWeight = 10})
Else Else
Log("[Download] 检测为非新版 Forge:" & LoaderVersion) Log("[Download] 检测为非新版 Forge:" & LoaderVersion)
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"安装 {LoaderName}(方式 B)", Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"安装 {LoaderName}(方式 B)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim Installer As ZipArchive = Nothing Dim Installer As ZipArchive = Nothing
Try Try
'解压并获取信息 '解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
Task.Progress = 0.2 Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Task.Progress = 0.4 Task.Progress = 0.4
'新建版本文件夹 '新建版本文件夹
Directory.CreateDirectory(VersionFolder) Directory.CreateDirectory(VersionFolder)
Task.Progress = 0.5 Task.Progress = 0.5
If Json("install") Is Nothing Then If Json("install") Is Nothing Then
'中版:Legacy 方式 1 '中版:Legacy 方式 1
Log("[Download] 开始进行 Forge 安装,Legacy 方式 1:" & InstallerAddress) Log("[Download] 开始进行 Forge 安装,Legacy 方式 1:" & InstallerAddress)
'建立 Json 文件 '建立 Json 文件
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open)) Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
JsonVersion("id") = TargetVersion JsonVersion("id") = TargetVersion
WriteFile(VersionFolder & TargetVersion & ".json", JsonVersion.ToString) WriteFile(VersionFolder & TargetVersion & ".json", JsonVersion.ToString)
Task.Progress = 0.6 Task.Progress = 0.6
'解压支持库文件 '解压支持库文件
Installer.Dispose() Installer.Dispose()
ExtractFile(InstallerAddress, InstallerAddress & "_unrar\") ExtractFile(InstallerAddress, InstallerAddress & "_unrar\")
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\") CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DeleteDirectory(InstallerAddress & "_unrar\") DeleteDirectory(InstallerAddress & "_unrar\")
Else Else
'旧版:Legacy 方式 2 '旧版:Legacy 方式 2
Log("[Download] 开始进行 Forge 安装,Legacy 方式 2:" & InstallerAddress) Log("[Download] 开始进行 Forge 安装,Legacy 方式 2:" & InstallerAddress)
'解压 Jar 文件 '解压 Jar 文件
Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder) Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
If File.Exists(JarAddress) Then File.Delete(JarAddress) If File.Exists(JarAddress) Then File.Delete(JarAddress)
WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open) WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
Task.Progress = 0.9 Task.Progress = 0.9
'建立 Json 文件 '建立 Json 文件
Json("versionInfo")("id") = TargetVersion Json("versionInfo")("id") = TargetVersion
If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit) If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit)
WriteFile(VersionFolder & TargetVersion & ".json", Json("versionInfo").ToString) WriteFile(VersionFolder & TargetVersion & ".json", Json("versionInfo").ToString)
End If End If
'新建 mods 文件夹 '新建 mods 文件夹
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
Catch ex As Exception Catch ex As Exception
Throw New Exception("非新版方式安装 Forge 失败", ex) Throw New Exception("非新版方式安装 Forge 失败", ex)
Finally Finally
Try Try
'清理文件 '清理文件
If Installer IsNot Nothing Then Installer.Dispose() If Installer IsNot Nothing Then Installer.Dispose()
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress) If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\") If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
Catch ex As Exception Catch ex As Exception
Log(ex, "非新版方式安装 Forge 清理文件时出错") Log(ex, "非新版方式安装 Forge 清理文件时出错")
End Try End Try
End Try End Try
@@ -1730,14 +1714,11 @@ Retry:
If Not Target.Contains("\") Then Exit Sub If Not Target.Contains("\") Then Exit Sub
'重复任务检查 '重复任务检查
SyncLock LoaderTaskbarLock For Each OngoingLoader In LoaderTaskbar
For i = 0 To LoaderTaskbar.Count - 1 If OngoingLoader.Name <> $"Fabric {Version} 安装器下载" Then Continue For
If LoaderTaskbar(i).Name = "Fabric " & Version & " 安装器下载" Then Hint("该版本正在下载中!", HintType.Critical)
Hint("该版本正在下载中!", HintType.Critical) Exit Sub
Exit Sub Next
End If
Next
End SyncLock
'构造步骤加载器 '构造步骤加载器
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
@@ -1773,26 +1754,26 @@ Retry:
'下载 Json '下载 Json
MinecraftName = MinecraftName.Replace("∞", "infinite") '放在 ID 后面避免影响版本文件夹名称 MinecraftName = MinecraftName.Replace("∞", "infinite") '放在 ID 后面避免影响版本文件夹名称
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取 Fabric 主文件下载地址", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取 Fabric 主文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'启动依赖版本的下载 '启动依赖版本的下载
If FixLibrary Then If FixLibrary Then
McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, MinecraftName) McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, MinecraftName)
End If End If
Task.Progress = 0.5 Task.Progress = 0.5
'构造文件请求 '构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile({ Task.Output = New List(Of NetFile) From {New NetFile({
"https://bmclapi2.bangbang93.com/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json", "https://bmclapi2.bangbang93.com/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json",
"https://meta.fabricmc.net/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json" "https://meta.fabricmc.net/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json"
}, VersionFolder & Id & ".json", New FileChecker(IsJson:=True))} }, VersionFolder & Id & ".json", New FileChecker(IsJson:=True))}
'新建 mods 文件夹 '新建 mods 文件夹
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
End Sub) With {.ProgressWeight = 0.5}) End Sub) With {.ProgressWeight = 0.5})
Loaders.Add(New LoaderDownload("下载 Fabric 主文件", New List(Of NetFile)) With {.ProgressWeight = 2.5}) Loaders.Add(New LoaderDownload("下载 Fabric 主文件", New List(Of NetFile)) With {.ProgressWeight = 2.5})
'下载支持库 '下载支持库
If FixLibrary Then If FixLibrary Then
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Fabric 支持库文件", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析 Fabric 支持库文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False}) Sub(Task) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
Loaders.Add(New LoaderDownload("下载 Fabric 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 8}) Loaders.Add(New LoaderDownload("下载 Fabric 支持库文件", New List(Of NetFile)) With {.ProgressWeight = 8})
End If End If
@@ -2039,9 +2020,11 @@ Retry:
Dim LiteLoaderFolder As String = Nothing Dim LiteLoaderFolder As String = Nothing
If Request.LiteLoaderEntry IsNot Nothing Then LiteLoaderFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-LiteLoader" If Request.LiteLoaderEntry IsNot Nothing Then LiteLoaderFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-LiteLoader"
'OptiFine 是否作为 Mod 进行下载 '判断 OptiFine 是否作为 Mod 进行下载
Dim OptiFineAsMod As Boolean = Dim MinecraftCode As Integer = If(Request.MinecraftName.Contains("."), Val(Request.MinecraftName.Split(".")(1)), 0)
(Request.OptiFineEntry IsNot Nothing OrElse Request.OptiFineVersion IsNot Nothing) AndAlso Request.FabricVersion IsNot Nothing Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso '1. 选择了 OptiFine
(Request.FabricVersion IsNot Nothing OrElse '2. 选择了 Fabric...
(Request.ForgeEntry IsNot Nothing AndAlso MinecraftCode >= 14 AndAlso MinecraftCode <= 15)) '...或者 Forge 1.14~15(#4134)
If OptiFineAsMod Then If OptiFineAsMod Then
Log("[Download] OptiFine 将作为 Mod 进行下载") Log("[Download] OptiFine 将作为 Mod 进行下载")
OptiFineFolder = New McVersion(OutputFolder).GetPathIndie(True) & "mods\" OptiFineFolder = New McVersion(OutputFolder).GetPathIndie(True) & "mods\"
@@ -43,6 +43,12 @@
Type = "愚人节版" Type = "愚人节版"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) Version.Add("lore", GetMcFoolName(Version("id")))
Case Else '4/1 自动视作愚人节版
Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2)
If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then
Type = "愚人节版"
Version("type") = "special"
End If
End Select End Select
Case "special" Case "special"
'已被处理的愚人节版 '已被处理的愚人节版
@@ -56,7 +62,7 @@
'排序 '排序
For i = 0 To Dict.Keys.Count - 1 For i = 0 To Dict.Keys.Count - 1
Dict(Dict.Keys(i)) = Sort(Dict.Values(i), Dict(Dict.Keys(i)) = Sort(Dict.Values(i),
Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date)) Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date))
Next Next
'清空当前 '清空当前
PanMain.Children.Clear() PanMain.Children.Clear()
@@ -170,11 +170,11 @@
Dim LogoFileAddress As String = PathTemp & "CompLogo\" & GetHash(CompItem.Logo) & ".png" Dim LogoFileAddress As String = PathTemp & "CompLogo\" & GetHash(CompItem.Logo) & ".png"
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True}) Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包", Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() Sub()
If Not ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Then If ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Is Nothing Then
Throw New Exception("整合包安装出现异常!") Throw New Exception("整合包安装出现异常!")
End If End If
End Sub) With {.ProgressWeight = 0.1}) End Sub) With {.ProgressWeight = 0.1})
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
@@ -618,6 +618,12 @@
Type = "愚人节版" Type = "愚人节版"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) Version.Add("lore", GetMcFoolName(Version("id")))
Case Else '4/1 自动视作愚人节版
Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2)
If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then
Type = "愚人节版"
Version("type") = "special"
End If
End Select End Select
Case "special" Case "special"
'已被处理的愚人节版 '已被处理的愚人节版
@@ -33,6 +33,7 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320"> <local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" /> <local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.21" /> <local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" /> <local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" /> <local:MyComboBoxItem Content="1.20.4" />
@@ -8,7 +8,7 @@
<StackPanel Orientation="Vertical" Margin="5"> <StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="NeoForge 简介" x:Name="CardTip"> <local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="NeoForge 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20"> <StackPanel Margin="25,40,15,20">
<TextBlock Margin="0,0,0,11" Text="NeoForge 是 Minecraft 1.19+ 的 Mod 加载器,你需要先安装它才能安装各种 NeoForge 模组。&#xa;本页面提供 NeoForge 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" /> <TextBlock Margin="0,0,0,11" Text="NeoForge 是 Minecraft 1.20.1+ 的 Mod 加载器,你需要先安装它才能安装各种 NeoForge 模组,它也兼容一些 Forge 模组。&#xa;本页面提供 NeoForge 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" />
<Grid Height="35"> <Grid Height="35">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
@@ -32,6 +32,7 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320"> <local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" /> <local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.21" /> <local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" /> <local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" /> <local:MyComboBoxItem Content="1.20.4" />
@@ -60,7 +61,7 @@
<local:MyComboBoxItem Tag="4472/technology" Content="科技" /> <local:MyComboBoxItem Tag="4472/technology" Content="科技" />
<local:MyComboBoxItem Tag="4473/magic" Content="魔法" /> <local:MyComboBoxItem Tag="4473/magic" Content="魔法" />
<local:MyComboBoxItem Tag="4475/adventure" Content="冒险" /> <local:MyComboBoxItem Tag="4475/adventure" Content="冒险" />
<local:MyComboBoxItem Tag="/kitchen-sink" Content="烹饪" /> <local:MyComboBoxItem Tag="/kitchen-sink" Content="大杂烩" />
<local:MyComboBoxItem Tag="4476/" Content="探索" /> <local:MyComboBoxItem Tag="4476/" Content="探索" />
<local:MyComboBoxItem Tag="4477/" Content="小游戏" /> <local:MyComboBoxItem Tag="4477/" Content="小游戏" />
<local:MyComboBoxItem Tag="4471/" Content="科幻" /> <local:MyComboBoxItem Tag="4471/" Content="科幻" />
@@ -241,7 +241,8 @@ Retry:
{"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"}, {"Translator-Chinese", "Crowdin 中文翻译者披风"}, {"Translator", "Crowdin 翻译者披风"}, {"Cobalt", "Cobalt 披风"},
{"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"}, {"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"},
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"}, {"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"},
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"}, {"Follower's", "追随者披风"} {"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"},
{"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}
} }
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}} Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes") For Each Cape In SkinData("capes")
@@ -21,19 +21,27 @@
'加载版本 '加载版本
RunInNewThread( RunInNewThread(
Sub() Sub()
''自动整合包安装:准备 '自动整合包安装:准备
'Dim PackInstallPath As String = Nothing Dim PackInstallPath As String = Nothing
'If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip" If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip"
'If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack" If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack"
'If PackInstallPath IsNot Nothing Then If PackInstallPath IsNot Nothing Then
' Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug) If MyMsgBox($"PCL 即将在当前文件夹下自动安装整合包。", "自动安装", "继续", "取消") = 1 Then
' If Not Directory.Exists(Path & ".minecraft\") Then '确认自动安装
' Directory.CreateDirectory(Path & ".minecraft\") Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug)
' Directory.CreateDirectory(Path & ".minecraft\versions\") Setup.Set("LaunchFolderSelect", "$.minecraft\")
' McFolderLauncherProfilesJsonCreate(Path & ".minecraft\") If Not Directory.Exists(Path & ".minecraft\") Then
' End If Directory.CreateDirectory(Path & ".minecraft\")
' Setup.Set("LaunchFolderSelect", "$.minecraft\") Directory.CreateDirectory(Path & ".minecraft\versions\")
'End If McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Else
'取消自动安装
Log("[Launch] 取消自动安装整合包:" & PackInstallPath, LogLevel.Debug)
PackInstallPath = Nothing
End If
End If
'确认 Minecraft 文件夹存在 '确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path) PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
@@ -48,21 +56,27 @@
End If End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder) Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000)) If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
''自动整合包安装 '自动整合包安装
'If PackInstallPath IsNot Nothing Then If PackInstallPath IsNot Nothing Then
' If ModpackInstall(PackInstallPath) Then Dim InstallLoader = ModpackInstall(PackInstallPath)
' Log("[Launch] 自动安装整合包成功:" & PackInstallPath) If InstallLoader Is Nothing Then
' File.Delete(PackInstallPath) Log("[Launch] 自动安装整合包失败:" & PackInstallPath)
' Else Else
' Log("[Launch] 自动安装整合包失败:" & PackInstallPath) Log("[Launch] 自动安装整合包开始:" & PackInstallPath)
' End If RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
'End If InstallLoader.WaitForExit()
If InstallLoader.State = LoadState.Finished Then
Log("[Launch] 自动安装整合包成功,删除安装包:" & PackInstallPath)
File.Delete(PackInstallPath)
End If
End If
End If
'确认 Minecraft 版本存在 '确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect") Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion = If(Selection = "", Nothing, New McVersion(Selection)) Dim Version As McVersion = If(Selection = "", Nothing, New McVersion(Selection))
If Version Is Nothing OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then If Version Is Nothing OrElse Not Version.Path.StartsWithF(PathMcFolder) OrElse Not Version.Check() Then
'无效的版本 '无效的版本
Log("[Launch] Minecraft 版本无效" & If(Version Is Nothing, ",没有有效版本", ":" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug)) Log("[Launch] 当前选择的 Minecraft 版本无效:" & If(Version Is Nothing, "null", Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing Version = Nothing
@@ -102,6 +102,10 @@ Download:
Log("[Page] 主页预设:Minecraft 皮肤推荐") Log("[Page] 主页预设:Minecraft 皮肤推荐")
Url = "https://forgepixel.com/pcl_sub_file" Url = "https://forgepixel.com/pcl_sub_file"
GoTo Download GoTo Download
Case 6
Log("[Page] 主页预设:OpenBMCLAPI 仪表盘 Lite")
Url = "https://pcl-bmcl.milulu.xyz/"
GoTo Download
End Select End Select
End Select End Select
RunInUi(Sub() LoadContent(Content)) RunInUi(Sub() LoadContent(Content))
@@ -58,19 +58,21 @@
Hint("正在尝试更换,请稍候!") Hint("正在尝试更换,请稍候!")
Setup.Set("CacheAuthUuid", "") '清空选择缓存 Setup.Set("CacheAuthUuid", "") '清空选择缓存
Setup.Set("CacheAuthName", "") Setup.Set("CacheAuthName", "")
RunInThread(Sub() RunInThread(
Try Sub()
Dim Data As McLoginServer = GetLoginData() Try
Data.ForceReselectProfile = True Dim Data As McLoginServer = GetLoginData()
McLoginLoader.WaitForExit(Data, IsForceRestart:=True) Data.ForceReselectProfile = True
RunInUi(Sub() Reload(True)) McLoginLoader.WaitForExit(Data, IsForceRestart:=True)
Catch ex As Exception RunInUi(Sub() Reload(True))
Log(ex, "更换角色失败", LogLevel.Hint) Catch ex As Exception
End Try Log(ex, "更换角色失败", LogLevel.Hint)
End Sub) End Try
End Sub)
End Sub End Sub
Private Sub BtnExit_Click() Handles BtnExit.Click Private Sub BtnExit_Click() Handles BtnExit.Click
Setup.Set("CacheAuthAccess", "") Setup.Set("CacheAuthAccess", "")
Setup.Set("CacheAuthUuid", "")
FrmLaunchLeft.RefreshPage(False, True) FrmLaunchLeft.RefreshPage(False, True)
End Sub End Sub
@@ -99,7 +99,7 @@ Retry:
Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1")) Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1"))
Dim Contents As New Net.Http.MultipartFormDataContent From { Dim Contents As New Net.Http.MultipartFormDataContent From {
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"}, {New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
{New Net.Http.ByteArrayContent(File.ReadAllBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)} {New Net.Http.ByteArrayContent(ReadFileBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)}
} }
Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync
If Result.Contains("request requires user authentication") Then If Result.Contains("request requires user authentication") Then
@@ -29,7 +29,7 @@
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" /> <EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip> </Image.Clip>
</Image> </Image>
<local:MyButton Text="赞助作者" Grid.Column="2" Grid.Row="0" Height="35" EventType="打开网页" EventData="https://afdian.net/a/LTCat" /> <local:MyButton Text="赞助作者" Grid.Column="2" Grid.Row="0" Height="35" EventType="打开网页" EventData="https://afdian.com/a/LTCat" />
<local:MyButton Text="查看源代码" Grid.Column="2" Grid.Row="1" Height="35" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" /> <local:MyButton Text="查看源代码" Grid.Column="2" Grid.Row="1" Height="35" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
@@ -55,7 +55,7 @@
<local:MyListItem Title="MC 百科" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Mod 名称的中文翻译和更多相关信息!" Grid.Row="1" Grid.Column="1" /> <local:MyListItem Title="MC 百科" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Mod 名称的中文翻译和更多相关信息!" Grid.Row="1" Grid.Column="1" />
<local:MyButton x:Name="BtnAboutWiki" Text="打开百科" Grid.Row="1" Grid.Column="2" Height="35" /> <local:MyButton x:Name="BtnAboutWiki" Text="打开百科" Grid.Row="1" Grid.Column="2" Height="35" />
<local:MyListItem Title="00ll00" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Java Launch Wrapper 和一些重要服务支持!" Grid.Row="2" Grid.Column="1" /> <local:MyListItem Title="00ll00" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 Java Launch Wrapper 和一些重要服务支持!" Grid.Row="2" Grid.Column="1" />
<local:MyListItem Title="DoodleHuang" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了部分很难找到的 Minecraft 版本与一些技术支持!" Grid.Row="3" Grid.Column="1" /> <local:MyListItem Title="z0z0r4" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="提供了 MCIM 中国 Mod 下载镜像源和帮助库图床!" Grid.Row="3" Grid.Column="1" />
<local:MyListItem Title="Patrick" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="设计并制作了 PCL 图标,让我从做图标的水深火热中得到了解脱……" Grid.Row="4" Grid.Column="1" /> <local:MyListItem Title="Patrick" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="设计并制作了 PCL 图标,让我从做图标的水深火热中得到了解脱……" Grid.Row="4" Grid.Column="1" />
<local:MyListItem Title="Hao_Tian" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="在内测中找出了一大堆没人想得到的诡异 Bug,有非同寻常的 Bug 体质" Grid.Row="5" Grid.Column="1" /> <local:MyListItem Title="Hao_Tian" Margin="-5,0,0,0" IsHitTestVisible="False" Grid.ColumnSpan="2" Info="在内测中找出了一大堆没人想得到的诡异 Bug,有非同寻常的 Bug 体质" Grid.Row="5" Grid.Column="1" />
<local:MyListItem Title="Minecraft 中文论坛" Margin="-5,0,15,0" IsHitTestVisible="False" Info="虽然已经关站了,但感谢此前提供了 MCBBS 镜像源……" Grid.Row="6" Grid.Column="1" /> <local:MyListItem Title="Minecraft 中文论坛" Margin="-5,0,15,0" IsHitTestVisible="False" Info="虽然已经关站了,但感谢此前提供了 MCBBS 镜像源……" Grid.Row="6" Grid.Column="1" />
@@ -75,7 +75,7 @@
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" /> <EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip> </Image.Clip>
</Image> </Image>
<Image Source="/Plain Craft Launcher 2;component/Images/Heads/DoodleHuang.png" Grid.Row="3" Margin="3"> <Image Source="/Plain Craft Launcher 2;component/Images/Heads/z0z0r4.png" Grid.Row="3" Margin="3">
<Image.Clip> <Image.Clip>
<EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" /> <EllipseGeometry Center="17 17" RadiusX="17" RadiusY="17" />
</Image.Clip> </Image.Clip>
@@ -104,312 +104,82 @@
</local:MyCard> </local:MyCard>
<local:MyCard Margin="0,0,0,15" Title="赞助者"> <local:MyCard Margin="0,0,0,15" Title="赞助者">
<StackPanel Margin="25,40,10,20"> <StackPanel Margin="25,40,10,20">
<TextBlock HorizontalAlignment="Left" Text="以下是 2024 年 5~6 月的高级赞助者们!感谢各位对 PCL 和伟大的咕咕咕事业的支持!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" /> <TextBlock HorizontalAlignment="Left" Text="以下是 2024 年 8 月的高级赞助者们!感谢各位对 PCL 和伟大的咕咕咕事业的支持!" Margin="0,0,25,5.5" TextTrimming="None" TextWrapping="WrapWithOverflow" />
<WrapPanel Margin="0,0,0,10"> <WrapPanel Margin="0,0,0,10">
<TextBlock Width="120" Margin="0,1.5" Text="哈哈哈哈哈" /> <TextBlock Width="120" Margin="0,1.5" Text="没用的元元" />
<TextBlock Width="120" Margin="0,1.5" Text="江户川柯南" /> <TextBlock Width="120" Margin="0,1.5" Text="鸮不是号鸟" />
<TextBlock Width="120" Margin="0,1.5" Text="loner..?" /> <TextBlock Width="120" Margin="0,1.5" Text="兮兮要次糖糖" />
<TextBlock Width="120" Margin="0,1.5" Text="野比大豆" /> <TextBlock Width="120" Margin="0,1.5" Text="wxzsghh114514" />
<TextBlock Width="120" Margin="0,1.5" Text="无心之举" /> <TextBlock Width="120" Margin="0,1.5" Text="地了排子" />
<TextBlock Width="120" Margin="0,1.5" Text="林禊" /> <TextBlock Width="120" Margin="0,1.5" Text="阿宅cheli" />
<TextBlock Width="120" Margin="0,1.5" Text="??!" /> <TextBlock Width="120" Margin="0,1.5" Text="笑脸114514" />
<TextBlock Width="120" Margin="0,1.5" Text="Petrichor" /> <TextBlock Width="120" Margin="0,1.5" Text="小麦A" />
<TextBlock Width="120" Margin="0,1.5" Text="一只可爱的frisk啊" /> <TextBlock Width="120" Margin="0,1.5" Text="未名小七TAO" />
<TextBlock Width="120" Margin="0,1.5" Text="luvFwt" /> <TextBlock Width="120" Margin="0,1.5" Text="雪冥" />
<TextBlock Width="120" Margin="0,1.5" Text="厨师长" /> <TextBlock Width="120" Margin="0,1.5" Text="氟西汀" />
<TextBlock Width="120" Margin="0,1.5" Text="星輝月下゛" /> <TextBlock Width="120" Margin="0,1.5" Text="阿巴阿巴" />
<TextBlock Width="120" Margin="0,1.5" Text="密早宪综籽" /> <TextBlock Width="120" Margin="0,1.5" Text="侦探hj" />
<TextBlock Width="120" Margin="0,1.5" Text="黑云月稀" /> <TextBlock Width="120" Margin="0,1.5" Text="666" />
<TextBlock Width="120" Margin="0,1.5" Text="星月球" /> <TextBlock Width="120" Margin="0,1.5" Text="萬帆WanFan" />
<TextBlock Width="120" Margin="0,1.5" Text="ADerAQi" /> <TextBlock Width="120" Margin="0,1.5" Text="swayst" />
<TextBlock Width="120" Margin="0,1.5" Text="van" /> <TextBlock Width="120" Margin="0,1.5" Text="yuchen" />
<TextBlock Width="120" Margin="0,1.5" Text="Eterfrusa" /> <TextBlock Width="120" Margin="0,1.5" Text="鲸落猫南北" />
<TextBlock Width="120" Margin="0,1.5" Text="kpocc07" /> <TextBlock Width="120" Margin="0,1.5" Text="念池鱼思故渊" />
<TextBlock Width="120" Margin="0,1.5" Text="觉莫" /> <TextBlock Width="120" Margin="0,1.5" Text="No_1died" />
<TextBlock Width="120" Margin="0,1.5" Text="我是DGHSFG" /> <TextBlock Width="120" Margin="0,1.5" Text="Error02" />
<TextBlock Width="120" Margin="0,1.5" Text="lhw0616" /> <TextBlock Width="120" Margin="0,1.5" Text="橙子皮" />
<TextBlock Width="120" Margin="0,1.5" Text="2DGIRL" /> <TextBlock Width="120" Margin="0,1.5" Text="丨丨丨丨" />
<TextBlock Width="120" Margin="0,1.5" Text="雨猫霖" /> <TextBlock Width="120" Margin="0,1.5" Text="零崽" />
<TextBlock Width="120" Margin="0,1.5" Text="Grazie" /> <TextBlock Width="120" Margin="0,1.5" Text="叁無" />
<TextBlock Width="120" Margin="0,1.5" Text="鲲鹏roc" /> <TextBlock Width="120" Margin="0,1.5" Text="火星上行走的柠檬精" />
<TextBlock Width="120" Margin="0,1.5" Text="皮皮苏" /> <TextBlock Width="120" Margin="0,1.5" Text="北极椰子" />
<TextBlock Width="120" Margin="0,1.5" Text="哆啦哆啦" /> <TextBlock Width="120" Margin="0,1.5" Text="流玉髓" />
<TextBlock Width="120" Margin="0,1.5" Text="serendipity" /> <TextBlock Width="120" Margin="0,1.5" Text="咕咕" />
<TextBlock Width="120" Margin="0,1.5" Text="W-Qi" /> <TextBlock Width="120" Margin="0,1.5" Text="小鹏1098" />
<TextBlock Width="120" Margin="0,1.5" Text="tenneidp" /> <TextBlock Width="120" Margin="0,1.5" Text="风雪" />
<TextBlock Width="120" Margin="0,1.5" Text="叢沄" /> <TextBlock Width="120" Margin="0,1.5" Text="梦幻の小店" />
<TextBlock Width="120" Margin="0,1.5" Text="jian_ke" /> <TextBlock Width="120" Margin="0,1.5" Text="nhrnick" />
<TextBlock Width="120" Margin="0,1.5" Text="天天的周末" />
<TextBlock Width="120" Margin="0,1.5" Text="雪梨" />
<TextBlock Width="120" Margin="0,1.5" Text="Z_ebra" />
<TextBlock Width="120" Margin="0,1.5" Text="acmzyh" />
<TextBlock Width="120" Margin="0,1.5" Text="yuyyyu" />
<TextBlock Width="120" Margin="0,1.5" Text="看看" />
<TextBlock Width="120" Margin="0,1.5" Text="墨霜夜" />
<TextBlock Width="120" Margin="0,1.5" Text="皇势力" />
<TextBlock Width="120" Margin="0,1.5" Text="曦予千山" />
<TextBlock Width="120" Margin="0,1.5" Text="Lv50.疾旋鼬" />
<TextBlock Width="120" Margin="0,1.5" Text="雪暮" />
<TextBlock Width="120" Margin="0,1.5" Text="铁树" />
<TextBlock Width="120" Margin="0,1.5" Text="ZHypocrite" /> <TextBlock Width="120" Margin="0,1.5" Text="ZHypocrite" />
<TextBlock Width="120" Margin="0,1.5" Text="浑荀" /> <TextBlock Width="120" Margin="0,1.5" Text="闫雁" />
<TextBlock Width="120" Margin="0,1.5" Text="yoo-ovo" /> <TextBlock Width="120" Margin="0,1.5" Text="不知道叫啥" />
<TextBlock Width="120" Margin="0,1.5" Text="洛梓风anemo" /> <TextBlock Width="120" Margin="0,1.5" Text="隔壁家老张" />
<TextBlock Width="120" Margin="0,1.5" Text="胡桃的狗" /> <TextBlock Width="120" Margin="0,1.5" Text="DZY" />
<TextBlock Width="120" Margin="0,1.5" Text="落灯花" /> <TextBlock Width="120" Margin="0,1.5" Text="Hugh" />
<TextBlock Width="120" Margin="0,1.5" Text="涩图来一份" /> <TextBlock Width="120" Margin="0,1.5" Text="Jto" />
<TextBlock Width="120" Margin="0,1.5" Text="FSAH217" /> <TextBlock Width="120" Margin="0,1.5" Text="JO极名字" />
<TextBlock Width="120" Margin="0,1.5" Text="炽绪" /> <TextBlock Width="120" Margin="0,1.5" Text="啊猫" />
<TextBlock Width="120" Margin="0,1.5" Text="JUBEYsl" /> <TextBlock Width="120" Margin="0,1.5" Text="章九连" />
<TextBlock Width="120" Margin="0,1.5" Text="阿祺27" /> <TextBlock Width="120" Margin="0,1.5" Text="zeq_killjsj" />
<TextBlock Width="120" Margin="0,1.5" Text="江上数峰青" /> <TextBlock Width="120" Margin="0,1.5" Text="重庆你周哥" />
<TextBlock Width="120" Margin="0,1.5" Text="ECHO" /> <TextBlock Width="120" Margin="0,1.5" Text="我是桶子哥" />
<TextBlock Width="120" Margin="0,1.5" Text="路易斯" /> <TextBlock Width="120" Margin="0,1.5" Text="chenxingyin" />
<TextBlock Width="120" Margin="0,1.5" Text="别曹曹了" /> <TextBlock Width="120" Margin="0,1.5" Text="koimiaori" />
<TextBlock Width="120" Margin="0,1.5" Text="Szy" />
<TextBlock Width="120" Margin="0,1.5" Text="长安常安" />
<TextBlock Width="120" Margin="0,1.5" Text="鲨鲨" />
<TextBlock Width="120" Margin="0,1.5" Text="对白拼拼凑凑" />
<TextBlock Width="120" Margin="0,1.5" Text="月下吃米糖" />
<TextBlock Width="120" Margin="0,1.5" Text="小雨要" />
<TextBlock Width="120" Margin="0,1.5" Text="臻榛搸殝" />
<TextBlock Width="120" Margin="0,1.5" Text="王富贵" />
<TextBlock Width="120" Margin="0,1.5" Text="久久" />
<TextBlock Width="120" Margin="0,1.5" Text="嗯哼?" />
<TextBlock Width="120" Margin="0,1.5" Text="木沐" />
<TextBlock Width="120" Margin="0,1.5" Text="永久里" />
<TextBlock Width="120" Margin="0,1.5" Text="小白狐" />
<TextBlock Width="120" Margin="0,1.5" Text="Z." />
<TextBlock Width="120" Margin="0,1.5" Text="芝惑鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="MegnaAegwynn " />
<TextBlock Width="120" Margin="0,1.5" Text="DJLD" />
<TextBlock Width="120" Margin="0,1.5" Text="曦月" />
<TextBlock Width="120" Margin="0,1.5" Text="TylerDeng" />
<TextBlock Width="120" Margin="0,1.5" Text="1899年的提拉米苏" />
<TextBlock Width="120" Margin="0,1.5" Text="bzwm" />
<TextBlock Width="120" Margin="0,1.5" Text="GhaMZz" />
<TextBlock Width="120" Margin="0,1.5" Text="雪游" />
<TextBlock Width="120" Margin="0,1.5" Text="奇怪的大土豆" />
<TextBlock Width="120" Margin="0,1.5" Text="Moonlight-池绾" />
<TextBlock Width="120" Margin="0,1.5" Text="fusocietyck" />
<TextBlock Width="120" Margin="0,1.5" Text="爬爬鸡" />
<TextBlock Width="120" Margin="0,1.5" Text="山千海千" />
<TextBlock Width="120" Margin="0,1.5" Text="氿离Yoi" />
<TextBlock Width="120" Margin="0,1.5" Text="如风沐烟" />
<TextBlock Width="120" Margin="0,1.5" Text="一条博子" />
<TextBlock Width="120" Margin="0,1.5" Text="m1679" />
<TextBlock Width="120" Margin="0,1.5" Text="snow" />
<TextBlock Width="120" Margin="0,1.5" Text="3瓶奶茶" />
<TextBlock Width="120" Margin="0,1.5" Text="Elkanah_" />
<TextBlock Width="120" Margin="0,1.5" Text="孤默少言" />
<TextBlock Width="120" Margin="0,1.5" Text="也要拿出真本事" />
<TextBlock Width="120" Margin="0,1.5" Text="武彩鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="雷霆兴哥" />
<TextBlock Width="120" Margin="0,1.5" Text="EnsoNani" />
<TextBlock Width="120" Margin="0,1.5" Text="Ann.Midnight" />
<TextBlock Width="120" Margin="0,1.5" Text="郁子恒是FW" />
<TextBlock Width="120" Margin="0,1.5" Text="ZIHE_kk" />
<TextBlock Width="120" Margin="0,1.5" Text="文八" />
<TextBlock Width="120" Margin="0,1.5" Text="寂月星落" />
<TextBlock Width="120" Margin="0,1.5" Text="Writer_DaMao" />
<TextBlock Width="120" Margin="0,1.5" Text="gwd233" />
<TextBlock Width="120" Margin="0,1.5" Text="Sutvh" />
<TextBlock Width="120" Margin="0,1.5" Text="崔东山" />
<TextBlock Width="120" Margin="0,1.5" Text="Botaiii" />
<TextBlock Width="120" Margin="0,1.5" Text="凛仙子D-" />
<TextBlock Width="120" Margin="0,1.5" Text="MooFaH" />
<TextBlock Width="120" Margin="0,1.5" Text="嘿哈吼" />
<TextBlock Width="120" Margin="0,1.5" Text="下山吃肉的兔子" />
<TextBlock Width="120" Margin="0,1.5" Text="warship" />
<TextBlock Width="120" Margin="0,1.5" Text="木落微雨" />
<TextBlock Width="120" Margin="0,1.5" Text="杨阳baby" />
<TextBlock Width="120" Margin="0,1.5" Text="白茶" />
<TextBlock Width="120" Margin="0,1.5" Text="路过一下的尘垒" />
<TextBlock Width="120" Margin="0,1.5" Text="counterea" />
<TextBlock Width="120" Margin="0,1.5" Text="雨中盛开的花朵" />
<TextBlock Width="120" Margin="0,1.5" Text="珊瑚宫心海" />
<TextBlock Width="120" Margin="0,1.5" Text="luner" />
<TextBlock Width="120" Margin="0,1.5" Text="时崎王罪丶" />
<TextBlock Width="120" Margin="0,1.5" Text="Nicht" />
<TextBlock Width="120" Margin="0,1.5" Text="冰薇" />
<TextBlock Width="120" Margin="0,1.5" Text="Archetto" />
<TextBlock Width="120" Margin="0,1.5" Text="蓝冰之刃" />
<TextBlock Width="120" Margin="0,1.5" Text="Baguette" />
<TextBlock Width="120" Margin="0,1.5" Text="KenshenLove" />
<TextBlock Width="120" Margin="0,1.5" Text="风见翎" />
<TextBlock Width="120" Margin="0,1.5" Text="雷霆" />
<TextBlock Width="120" Margin="0,1.5" Text="[擦汗]" />
<TextBlock Width="120" Margin="0,1.5" Text="远东雪橇猫" />
<TextBlock Width="120" Margin="0,1.5" Text="安夏洛克" />
<TextBlock Width="120" Margin="0,1.5" Text="acac" />
<TextBlock Width="120" Margin="0,1.5" Text="瑞风" />
<TextBlock Width="120" Margin="0,1.5" Text="xiankeQAQ" />
<TextBlock Width="120" Margin="0,1.5" Text="BDUCK" />
<TextBlock Width="120" Margin="0,1.5" Text="fuaglove" />
<TextBlock Width="120" Margin="0,1.5" Text="prprprrrpop" />
<TextBlock Width="120" Margin="0,1.5" Text="YOCE" />
<TextBlock Width="120" Margin="0,1.5" Text="忹." />
<TextBlock Width="120" Margin="0,1.5" Text="夜青" />
<TextBlock Width="120" Margin="0,1.5" Text="橘糸侑You" />
<TextBlock Width="120" Margin="0,1.5" Text="薇克波顿" />
<TextBlock Width="120" Margin="0,1.5" Text="夂冬螽" />
<TextBlock Width="120" Margin="0,1.5" Text="Colitary" />
<TextBlock Width="120" Margin="0,1.5" Text="Harm_b10ck" />
<TextBlock Width="120" Margin="0,1.5" Text="乆月" />
<TextBlock Width="120" Margin="0,1.5" Text="Kaoukala" />
<TextBlock Width="120" Margin="0,1.5" Text="墨染★希" />
<TextBlock Width="120" Margin="0,1.5" Text="松菀" />
<TextBlock Width="120" Margin="0,1.5" Text="疾驰火车" />
<TextBlock Width="120" Margin="0,1.5" Text="疾影烬" />
<TextBlock Width="120" Margin="0,1.5" Text="Awfrlu+" /> <TextBlock Width="120" Margin="0,1.5" Text="Awfrlu+" />
<TextBlock Width="120" Margin="0,1.5" Text="Lava_drop_" /> <TextBlock Width="120" Margin="0,1.5" Text="古河渚上花" />
<TextBlock Width="120" Margin="0,1.5" Text="? *???* ?" /> <TextBlock Width="120" Margin="0,1.5" Text="THE END" />
<TextBlock Width="120" Margin="0,1.5" Text="Gwynsur" /> <TextBlock Width="120" Margin="0,1.5" Text="哎呀菜菜子" />
<TextBlock Width="120" Margin="0,1.5" Text="许淼淼" />
<TextBlock Width="120" Margin="0,1.5" Text="waneng0807" />
<TextBlock Width="120" Margin="0,1.5" Text="安anLa" />
<TextBlock Width="120" Margin="0,1.5" Text="MQDCB" />
<TextBlock Width="120" Margin="0,1.5" Text="我dnmd" />
<TextBlock Width="120" Margin="0,1.5" Text="猫舍旁边有恶犬" />
<TextBlock Width="120" Margin="0,1.5" Text="yk" />
<TextBlock Width="120" Margin="0,1.5" Text="Cik-z" />
<TextBlock Width="120" Margin="0,1.5" Text="胡桃不是桃丫" />
<TextBlock Width="120" Margin="0,1.5" Text="陌白" />
<TextBlock Width="120" Margin="0,1.5" Text="C418" />
<TextBlock Width="120" Margin="0,1.5" Text="醉梦仙露" />
<TextBlock Width="240" Margin="0,1.5" Text="Re.从零开始跟猪鲨鲨恋爱" />
<TextBlock Width="120" Margin="0,1.5" Text="玄?" />
<TextBlock Width="120" Margin="0,1.5" Text="olwlm" />
<TextBlock Width="120" Margin="0,1.5" Text="XiaoLe_SH" />
<TextBlock Width="120" Margin="0,1.5" Text="龙大炮" />
<TextBlock Width="120" Margin="0,1.5" Text="陆阿藏" />
<TextBlock Width="120" Margin="0,1.5" Text="lo" />
<TextBlock Width="120" Margin="0,1.5" Text="七夜英理" />
<TextBlock Width="120" Margin="0,1.5" Text="lizi" />
<TextBlock Width="120" Margin="0,1.5" Text="范德Fa" />
<TextBlock Width="120" Margin="0,1.5" Text="云自无心" />
<TextBlock Width="120" Margin="0,1.5" Text="尚可" />
<TextBlock Width="120" Margin="0,1.5" Text="回转命运" />
<TextBlock Width="120" Margin="0,1.5" Text="恶搞的人格" />
<TextBlock Width="120" Margin="0,1.5" Text="安安生生" />
<TextBlock Width="120" Margin="0,1.5" Text="蛋仔派对-小冷" />
<TextBlock Width="120" Margin="0,1.5" Text="间铃" />
<TextBlock Width="120" Margin="0,1.5" Text="瀧柳" />
<TextBlock Width="120" Margin="0,1.5" Text="IRasciblebh" />
<TextBlock Width="120" Margin="0,1.5" Text="15183318101" />
<TextBlock Width="120" Margin="0,1.5" Text="LALALA" />
<TextBlock Width="120" Margin="0,1.5" Text="大香蕉" />
<TextBlock Width="120" Margin="0,1.5" Text="Another0" />
<TextBlock Width="120" Margin="0,1.5" Text="丢天帝" />
<TextBlock Width="120" Margin="0,1.5" Text="魔法喵酱" />
<TextBlock Width="120" Margin="0,1.5" Text="wshilaoliu" />
<TextBlock Width="120" Margin="0,1.5" Text="PangDaHusky" />
<TextBlock Width="120" Margin="0,1.5" Text="qi_lu" />
<TextBlock Width="120" Margin="0,1.5" Text="LetvGodyan" />
<TextBlock Width="120" Margin="0,1.5" Text="Amo" />
<TextBlock Width="120" Margin="0,1.5" Text="liang" />
<TextBlock Width="120" Margin="0,1.5" Text="baijillys" />
<TextBlock Width="120" Margin="0,1.5" Text="栗悟飯とカメハメ波" />
<TextBlock Width="120" Margin="0,1.5" Text="姜路扬" />
<TextBlock Width="120" Margin="0,1.5" Text="LuluPipi" />
<TextBlock Width="120" Margin="0,1.5" Text="Atuo" />
<TextBlock Width="120" Margin="0,1.5" Text="泳圈鼬用攀瀑" />
<TextBlock Width="120" Margin="0,1.5" Text="EWD" />
<TextBlock Width="120" Margin="0,1.5" Text="孟然君" />
<TextBlock Width="120" Margin="0,1.5" Text="num61" />
<TextBlock Width="120" Margin="0,1.5" Text="Elysia_mc" />
<TextBlock Width="120" Margin="0,1.5" Text="Wehrmacht" />
<TextBlock Width="120" Margin="0,1.5" Text="野生的小乐子" />
<TextBlock Width="120" Margin="0,1.5" Text="星韵林" />
<TextBlock Width="120" Margin="0,1.5" Text="剁椒鱼头" />
<TextBlock Width="120" Margin="0,1.5" Text="Jking" />
<TextBlock Width="240" Margin="0,1.5" Text="抖音搜索:清凉夏日一只瓜" />
<TextBlock Width="120" Margin="0,1.5" Text="HEARLEY" />
<TextBlock Width="120" Margin="0,1.5" Text="woaini_awa" />
<TextBlock Width="120" Margin="0,1.5" Text="龙天行" />
<TextBlock Width="120" Margin="0,1.5" Text="亦羽君" />
<TextBlock Width="120" Margin="0,1.5" Text="言十七" />
<TextBlock Width="120" Margin="0,1.5" Text="zzc" />
<TextBlock Width="120" Margin="0,1.5" Text="w?z?r?y" />
<TextBlock Width="120" Margin="0,1.5" Text="havoc" />
<TextBlock Width="120" Margin="0,1.5" Text="一条咸鱼" />
<TextBlock Width="120" Margin="0,1.5" Text="大鸡翅膀" />
<TextBlock Width="120" Margin="0,1.5" Text="月语" />
<TextBlock Width="120" Margin="0,1.5" Text="BBQ" />
<TextBlock Width="120" Margin="0,1.5" Text="糖糖" />
<TextBlock Width="120" Margin="0,1.5" Text="七月一" />
<TextBlock Width="120" Margin="0,1.5" Text="独角受" />
<TextBlock Width="120" Margin="0,1.5" Text="10000cituitui" />
<TextBlock Width="120" Margin="0,1.5" Text="Television" />
<TextBlock Width="120" Margin="0,1.5" Text="......" />
<TextBlock Width="120" Margin="0,1.5" Text="LONG11" />
<TextBlock Width="120" Margin="0,1.5" Text="OP仙人" />
<TextBlock Width="120" Margin="0,1.5" Text="陌音依矢—笠风" />
<TextBlock Width="120" Margin="0,1.5" Text="kinno_mc" />
<TextBlock Width="120" Margin="0,1.5" Text="Avid" />
<TextBlock Width="120" Margin="0,1.5" Text="brimobe" />
<TextBlock Width="120" Margin="0,1.5" Text="Momoki" />
<TextBlock Width="120" Margin="0,1.5" Text="徐小疯" />
<TextBlock Width="120" Margin="0,1.5" Text="我爱龙猫!!!" />
<TextBlock Width="120" Margin="0,1.5" Text="233" />
<TextBlock Width="120" Margin="0,1.5" Text="礼尚往来" />
<TextBlock Width="120" Margin="0,1.5" Text="会吐槽的毛熊" />
<TextBlock Width="120" Margin="0,1.5" Text="耶梦加得" />
<TextBlock Width="120" Margin="0,1.5" Text="pumpkin" />
<TextBlock Width="120" Margin="0,1.5" Text="Solaray3" />
<TextBlock Width="120" Margin="0,1.5" Text="m1a0w0" />
<TextBlock Width="120" Margin="0,1.5" Text="懿轩" />
<TextBlock Width="120" Margin="0,1.5" Text="圆圆xyz" />
<TextBlock Width="120" Margin="0,1.5" Text="EchoLong" />
<TextBlock Width="120" Margin="0,1.5" Text="光与影的对白" />
<TextBlock Width="120" Margin="0,1.5" Text="AptS:1547" /> <TextBlock Width="120" Margin="0,1.5" Text="AptS:1547" />
<TextBlock Width="120" Margin="0,1.5" Text="中转站" /> <TextBlock Width="120" Margin="0,1.5" Text="安麓" />
<TextBlock Width="120" Margin="0,1.5" Text="情猫" /> <TextBlock Width="120" Margin="0,1.5" Text="彘彘彘彘彘彘" />
<TextBlock Width="120" Margin="0,1.5" Text="胡桃Mahero" /> <TextBlock Width="120" Margin="0,1.5" Text="通大小学弟" />
<TextBlock Width="120" Margin="0,1.5" Text="Ew_o" /> <TextBlock Width="120" Margin="0,1.5" Text="Ender__sun" />
<TextBlock Width="120" Margin="0,1.5" Text="叽里呱啦" /> <TextBlock Width="120" Margin="0,1.5" Text="此生浮" />
<TextBlock Width="120" Margin="0,1.5" Text="MHNIO" /> <TextBlock Width="120" Margin="0,1.5" Text="皮皮恒" />
<TextBlock Width="120" Margin="0,1.5" Text="小洺" /> <TextBlock Width="120" Margin="0,1.5" Text="charlesmin" />
<TextBlock Width="120" Margin="0,1.5" Text="龙儿" /> <TextBlock Width="120" Margin="0,1.5" Text="snow" />
<TextBlock Width="120" Margin="0,1.5" Text="ccll48" />
<TextBlock Width="120" Margin="0,1.5" Text="Ling7844" />
<TextBlock Width="120" Margin="0,1.5" Text="不会写网名的屑" />
<TextBlock Width="120" Margin="0,1.5" Text="Aresposeidon1124" />
<TextBlock Width="120" Margin="0,1.5" Text="钻石Daiyamondo" />
<TextBlock Width="120" Margin="0,1.5" Text="七月无风" />
<TextBlock Width="120" Margin="0,1.5" Text="YuTian" />
<TextBlock Width="120" Margin="0,1.5" Text="csleep" />
<TextBlock Width="120" Margin="0,1.5" Text="小天使" />
<TextBlock Width="120" Margin="0,1.5" Text="墨水" />
<TextBlock Width="120" Margin="0,1.5" Text="阿耀" />
<TextBlock Width="120" Margin="0,1.5" Text="青绵kipilu" />
<TextBlock Width="120" Margin="0,1.5" Text="IWI_Margarita" />
<TextBlock Width="120" Margin="0,1.5" Text="小林カンナ" />
<TextBlock Width="120" Margin="0,1.5" Text="TD-Clotys" />
<TextBlock Width="120" Margin="0,1.5" Text="哈先生" />
<TextBlock Width="120" Margin="0,1.5" Text="老潘" />
<TextBlock Width="120" Margin="0,1.5" Text="绝少" />
<TextBlock Width="120" Margin="0,1.5" Text="咸鱼汤鱼咸" />
<TextBlock Width="120" Margin="0,1.5" Text="Celery" />
<TextBlock Width="120" Margin="0,1.5" Text="简称FV" />
<TextBlock Width="120" Margin="0,1.5" Text="飞翔的PUMA" />
<TextBlock Width="120" Margin="0,1.5" Text="123456。?" />
<TextBlock Width="120" Margin="0,1.5" Text="heitong_shu" />
<TextBlock Width="120" Margin="0,1.5" Text="Lan" />
<TextBlock Width="120" Margin="0,1.5" Text="sanjuou" />
<TextBlock Width="120" Margin="0,1.5" Text="芙芙" />
<TextBlock Width="120" Margin="0,1.5" Text="zyc11230170" />
<TextBlock Width="120" Margin="0,1.5" Text="TOUHOULUO" />
<TextBlock Width="120" Margin="0,1.5" Text="在下雾切" />
<TextBlock Width="120" Margin="0,1.5" Text="exusiai2357" />
<TextBlock Width="120" Margin="0,1.5" Text="???" />
<TextBlock Width="120" Margin="0,1.5" Text="润煌Ricardo" />
<TextBlock Width="120" Margin="0,1.5" Text="无风" />
<TextBlock Width="120" Margin="0,1.5" Text="缘花乐" />
<TextBlock Width="120" Margin="0,1.5" Text="Willian" />
<TextBlock Width="120" Margin="0,1.5" Text="墨尘烟雨" />
<TextBlock Width="120" Margin="0,1.5" Text="加五九九五" />
<TextBlock Width="120" Margin="0,1.5" Text="白裘峪" />
<TextBlock Width="120" Margin="0,1.5" Text="加载中..." />
<TextBlock Width="120" Margin="0,1.5" Text="Стразар" />
<TextBlock Width="120" Margin="0,1.5" Text="夜语霖" />
<TextBlock Width="120" Margin="0,1.5" Text="Wolfgang_233" />
<TextBlock Width="120" Margin="0,1.5" Text="小螺浩" />
<TextBlock Width="120" Margin="0,1.5" Text="rtoe332" />
<TextBlock Width="120" Margin="0,1.5" Text="lliiooll" />
<TextBlock Width="120" Margin="0,1.5" Text="QFwushang" />
<TextBlock Width="120" Margin="0,1.5" Text="竹翼" />
<TextBlock Width="120" Margin="0,1.5" Text="没差" />
<TextBlock Width="120" Margin="0,1.5" Text="用户13223" />
<TextBlock Width="120" Margin="0,1.5" Text="猫羽喵" />
</WrapPanel> </WrapPanel>
<Grid Height="35"> <Grid Height="35">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
@@ -418,7 +188,7 @@
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnDonateOutput" Grid.Column="0" MinWidth="140" Text="生成解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" Visibility="Collapsed" /> <local:MyButton x:Name="BtnDonateOutput" Grid.Column="0" MinWidth="140" Text="生成解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" Visibility="Collapsed" />
<local:MyButton x:Name="BtnDonateDonate" Grid.Column="0" MinWidth="140" Text="赞助作者" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" EventType="打开网页" EventData="https://afdian.net/a/LTCat" /> <local:MyButton x:Name="BtnDonateDonate" Grid.Column="0" MinWidth="140" Text="赞助作者" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" EventType="打开网页" EventData="https://afdian.com/a/LTCat" />
<local:MyButton x:Name="BtnDonateCopy" Grid.Column="1" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnDonateCopy" Grid.Column="1" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnDonateInput" Grid.Column="2" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnDonateInput" Grid.Column="2" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid> </Grid>
@@ -427,12 +197,12 @@
<local:MyCard Margin="0,0,0,15" Title="法律信息" IsSwaped="True" CanSwap="True"> <local:MyCard Margin="0,0,0,15" Title="法律信息" IsSwaped="True" CanSwap="True">
<StackPanel Margin="25,39,23,20"> <StackPanel Margin="25,39,23,20">
<TextBlock Text="隐私说明" TextWrapping="Wrap" Margin="0,6,0,4" FontWeight="Bold" /> <TextBlock Text="隐私说明" TextWrapping="Wrap" Margin="0,6,0,4" FontWeight="Bold" />
<TextBlock Margin="0,0,0,2" LineHeight="17" Text="本软件会汇报自己的版本名与版本号,以统计用户数量与各版本的用户数量占比。除此之外,本软件不会上传您的任何信息。&#13;若您能提供未经外部修改的本软件本体上传隐私信息的确凿证据,开发者会向您支付 PCL 开发所获全部净收入。" TextWrapping="Wrap" /> <TextBlock Margin="0,0,0,2" LineHeight="17" Text="本软件的 User Agent 中包含启动器的版本号,以统计各版本的用户数量。&#13;除此之外,本软件不会向开发者上传任何其他信息。" TextWrapping="Wrap" />
<TextBlock Text="其他信息" TextWrapping="Wrap" Margin="0,12,0,4" FontWeight="Bold" /> <TextBlock Text="其他信息" TextWrapping="Wrap" Margin="0,12,0,4" FontWeight="Bold" />
<TextBlock Margin="0,0,0,2" LineHeight="17" Text="Copyright © 龙腾猫跃 2016. All Rights Reserved.&#13;计算机软件著作权登记号:2020SR0875133&#13;违法违规行为举报投诉邮箱:hexdragon@vip.qq.com" TextWrapping="Wrap" /> <TextBlock Margin="0,0,0,2" LineHeight="17" Text="Copyright © 龙腾猫跃 2016. All Rights Reserved.&#13;计算机软件著作权登记号:2020SR0875133&#13;违法违规行为举报投诉邮箱:hexdragon@vip.qq.com&#13;非 MINECRAFT 官方产品。未经 MOJANG 或 MICROSOFT 批准,也不与 MOJANG 或 MICROSOFT 关联。" TextWrapping="Wrap" />
<StackPanel Orientation="Horizontal" Height="35" HorizontalAlignment="Left" Margin="0,12,0,0"> <StackPanel Orientation="Horizontal" Height="35" HorizontalAlignment="Left" Margin="0,12,0,0">
<local:MyButton Text="用户协议与免责声明" Width="170" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" EventType="打开网页" EventData="https://shimo.im/docs/rGrd8pY8xWkt6ryW" /> <local:MyButton Text="用户协议与免责声明" Width="170" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" EventType="打开网页" EventData="https://shimo.im/docs/rGrd8pY8xWkt6ryW" />
<local:MyButton Text="查看源代码" Width="140" Padding="13,0" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" /> <local:MyButton Text="开源代码" Width="140" Padding="13,0" EventType="打开网页" EventData="https://github.com/Hex-Dragon/PCL2" />
</StackPanel> </StackPanel>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
@@ -19,7 +19,7 @@
End Sub End Sub
Private Sub BtnAboutBmclapi_Click(sender As Object, e As EventArgs) Handles BtnAboutBmclapi.Click Private Sub BtnAboutBmclapi_Click(sender As Object, e As EventArgs) Handles BtnAboutBmclapi.Click
OpenWebsite("https://afdian.net/a/bangbang93") OpenWebsite("https://afdian.com/a/bangbang93")
End Sub End Sub
Private Sub BtnAboutWiki_Click(sender As Object, e As EventArgs) Handles BtnAboutWiki.Click Private Sub BtnAboutWiki_Click(sender As Object, e As EventArgs) Handles BtnAboutWiki.Click
OpenWebsite("https://www.mcmod.cn") OpenWebsite("https://www.mcmod.cn")
@@ -107,7 +107,8 @@
{"ToolDownloadTranslate", New SetupEntry(0, Source:=SetupSource.Registry)}, {"ToolDownloadTranslate", New SetupEntry(0, Source:=SetupSource.Registry)},
{"ToolDownloadKeepModpack", New SetupEntry(False, Source:=SetupSource.Registry)}, {"ToolDownloadKeepModpack", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolDownloadIgnoreQuilt", New SetupEntry(True, Source:=SetupSource.Registry)}, {"ToolDownloadIgnoreQuilt", New SetupEntry(True, Source:=SetupSource.Registry)},
{"ToolDownloadCert", New SetupEntry(True, Source:=SetupSource.Registry)}, {"ToolDownloadCert", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolDownloadMod", New SetupEntry(1, Source:=SetupSource.Registry)},
{"ToolUpdateAlpha", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)}, {"ToolUpdateAlpha", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)}, {"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolUpdateSnapshot", New SetupEntry(False, Source:=SetupSource.Registry)}, {"ToolUpdateSnapshot", New SetupEntry(False, Source:=SetupSource.Registry)},
@@ -7,9 +7,9 @@
PanScroll="{Binding ElementName=PanBack}"> PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10"> <StackPanel x:Name="PanMain" Margin="25,10">
<local:MyCard x:Name="CardSkin" Margin="0,15" Title="离线皮肤"> <local:MyCard x:Name="CardSkin" Margin="0,15" Title="离线皮肤" CanSwap="True" IsSwaped="True">
<StackPanel Margin="25,40,25,15"> <StackPanel Margin="25,40,25,15">
<local:MyHint Text="由于技术问题,皮肤预览与 Steve/Alex/自定义 选项暂时仅保证对 1.19.2 以前的版本有效!" IsWarn="False" Margin="0,0,0,10" /> <local:MyHint Text="由于技术问题,此功能只保证对 1.19.2 以前的版本有效!" IsWarn="True" Margin="0,0,0,10" />
<Grid Margin="-1,0,0,0"> <Grid Margin="-1,0,0,0">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition /> <ColumnDefinition />
@@ -20,6 +20,8 @@
<RowDefinition Height="7" /> <RowDefinition Height="7" />
<RowDefinition Height="28" /> <RowDefinition Height="28" />
<RowDefinition Height="7" /> <RowDefinition Height="7" />
<RowDefinition Height="28" />
<RowDefinition Height="7" />
<RowDefinition Height="27" /> <RowDefinition Height="27" />
<RowDefinition Height="27" /> <RowDefinition Height="27" />
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
@@ -31,34 +33,40 @@
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="版本列表获取" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="版本列表获取" Margin="0,0,25,0" />
<local:MyComboBox x:Name="ComboDownloadVersion" Grid.ColumnSpan="2" Tag="ToolDownloadVersion" Grid.Column="1"> <local:MyComboBox x:Name="ComboDownloadVersion" Grid.ColumnSpan="2" Tag="ToolDownloadVersion" Grid.Column="1">
<local:MyComboBoxItem Content="尽量使用镜像源(加载快,但版本可能不是最新的)" IsSelected="True" /> <local:MyComboBoxItem Content="尽量使用镜像源(加载快,但版本可能不是最新的)" IsSelected="True" />
<local:MyComboBoxItem Content="在官方源加载缓慢时改用镜像源(平衡)" /> <local:MyComboBoxItem Content="仅在官方源加载缓慢时改用镜像源" />
<local:MyComboBoxItem Content="尽量使用官方源(保证版本为最新,但加载非常缓慢)" /> <local:MyComboBoxItem Content="尽量使用官方源(保证版本最新,但加载缓慢)" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Mod 命名风格" Margin="0,0,25,0" /> <TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Mod 信息获取" Margin="0,0,25,0" />
<local:MyComboBox Grid.Row="2" x:Name="ComboDownloadTranslate" Grid.ColumnSpan="2" Tag="ToolDownloadTranslate" Grid.Column="1" <local:MyComboBox x:Name="ComboDownloadMod" Grid.Row="2" Grid.ColumnSpan="2" Tag="ToolDownloadMod" Grid.Column="1">
<local:MyComboBoxItem Content="尽量使用镜像源" />
<local:MyComboBoxItem Content="仅在官方源加载缓慢时改用镜像源" />
<local:MyComboBoxItem Content="尽量使用官方源" IsSelected="True" />
</local:MyComboBox>
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="Mod 命名风格" Margin="0,0,25,0" />
<local:MyComboBox Grid.Row="4" x:Name="ComboDownloadTranslate" Grid.ColumnSpan="2" Tag="ToolDownloadTranslate" Grid.Column="1"
ToolTip="决定下载的 Mod 的默认文件名中,中文译名应该放在哪个位置"> ToolTip="决定下载的 Mod 的默认文件名中,中文译名应该放在哪个位置">
<local:MyComboBoxItem Content="译名位于文件名开头:[遗物] relics-0.1.14" IsSelected="True" /> <local:MyComboBoxItem Content="译名位于文件名开头:[遗物] relics-0.1.14" IsSelected="True" />
<local:MyComboBoxItem Content="译名位于文件名开头:遗物-relics-0.1.14" /> <local:MyComboBoxItem Content="译名位于文件名开头:遗物-relics-0.1.14" />
<local:MyComboBoxItem Content="译名位于文件名末尾:relics-0.1.14-遗物" /> <local:MyComboBoxItem Content="译名位于文件名末尾:relics-0.1.14-遗物" />
<local:MyComboBoxItem Content="不添加中文译名:relics-0.1.14" /> <local:MyComboBoxItem Content="不添加中文译名:relics-0.1.14" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock Grid.Row="4" VerticalAlignment="Center" HorizontalAlignment="Left" Text="最大线程数" Margin="0,0,25,0" /> <TextBlock Grid.Row="6" VerticalAlignment="Center" HorizontalAlignment="Left" Text="最大线程数" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadThread" Grid.Row="4" Tag="ToolDownloadThread" MaxValue="255" Value="63" Grid.Column="1" <local:MySlider x:Name="SliderDownloadThread" Grid.Row="6" Tag="ToolDownloadThread" MaxValue="255" Value="63" Grid.Column="1"
ToolTip="线程数越多,限速的文件下载越快,但过高的线程数会造成下载时非常严重的卡顿。&#xa;一般而言,64 线程已可以保证足够的下载速度。" /> ToolTip="线程数越多,限速的文件下载越快,但过高的线程数会造成下载时非常严重的卡顿。&#xa;一般而言,64 线程已可以保证足够的下载速度。" />
<TextBlock VerticalAlignment="Center" Grid.Row="5" HorizontalAlignment="Left" Text="速度限制" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="7" HorizontalAlignment="Left" Text="速度限制" Margin="0,0,25,0" />
<local:MySlider x:Name="SliderDownloadSpeed" Grid.Row="5" Tag="ToolDownloadSpeed" MaxValue="42" Value="42" Grid.Column="1" <local:MySlider x:Name="SliderDownloadSpeed" Grid.Row="7" Tag="ToolDownloadSpeed" MaxValue="42" Value="42" Grid.Column="1"
ToolTip="设置下载的速度上限,以避免在下载时导致其他需要联网的程序卡死" /> ToolTip="设置下载的速度上限,以避免在下载时导致其他需要联网的程序卡死" />
<TextBlock VerticalAlignment="Top" Grid.Row="6" HorizontalAlignment="Left" Text="目标文件夹" Margin="0,5,25,5" /> <TextBlock VerticalAlignment="Top" Grid.Row="9" HorizontalAlignment="Left" Text="目标文件夹" Margin="0,5,25,5" />
<TextBlock Margin="0,5" HorizontalAlignment="Left" Text="请在 启动 → 版本选择 → 文件夹列表 中更改下载目标文件夹。&#xa;在某个文件夹或游戏版本上右键,即可选择打开对应文件夹。" Grid.Row="6" Grid.Column="1" VerticalAlignment="Center" Opacity="0.5" /> <TextBlock Margin="0,5" HorizontalAlignment="Left" Text="请在 启动 → 版本选择 → 文件夹列表 中更改下载目标文件夹。&#xa;在某个文件夹或游戏版本上右键,即可选择打开对应文件夹。" Grid.Row="9" Grid.Column="1" VerticalAlignment="Center" Opacity="0.5" />
<local:MyCheckBox Margin="0,5,0,4" Text="安装整合包时保留原始压缩包" Grid.Row="7" Height="22" Grid.ColumnSpan="2" <local:MyCheckBox Margin="0,5,0,4" Text="安装整合包时保留原始压缩包" Grid.Row="10" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadKeepModpack" Tag="ToolDownloadKeepModpack" x:Name="CheckDownloadKeepModpack" Tag="ToolDownloadKeepModpack"
ToolTip="安装整合包时,在版本文件夹下保留用于安装的原始整合包压缩包文件" /> ToolTip="安装整合包时,在版本文件夹下保留用于安装的原始整合包压缩包文件" />
<local:MyCheckBox Margin="0,2,0,4" Text="简化 Mod 加载器显示" Grid.Row="8" Height="22" Grid.ColumnSpan="2" <local:MyCheckBox Margin="0,2,0,4" Text="简化 Mod 加载器显示" Grid.Row="11" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadIgnoreQuilt" Tag="ToolDownloadIgnoreQuilt" x:Name="CheckDownloadIgnoreQuilt" Tag="ToolDownloadIgnoreQuilt"
ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" /> ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" />
<local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="9" Height="22" Grid.ColumnSpan="2" <local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="12" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadCert" Tag="ToolDownloadCert" x:Name="CheckDownloadCert" Tag="ToolDownloadCert"
ToolTip="验证证书会提高安全性,但疑似有概率导致正版登录失败(#3018)。&#xa;如果在正版登录时因为 [根据验证过程,远程证书无效] 失败,可以尝试关闭此项。" /> ToolTip="开启验证会提高安全性、降低盗号风险(见 #2767),但也可能导致正版登录失败(见 #3018)。" />
</Grid> </Grid>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
@@ -93,7 +101,8 @@
<RowDefinition Height="28" /> <RowDefinition Height="28" />
<RowDefinition Height="9" /> <RowDefinition Height="9" />
<RowDefinition Height="28" /> <RowDefinition Height="28" />
<RowDefinition Height="9" /> <RowDefinition Height="5" />
<RowDefinition Height="Auto" />
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动器更新" Margin="0,0,25,0" /> <TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="启动器更新" Margin="0,0,25,0" />
@@ -116,15 +125,23 @@
<local:ValidateFolderPath UseMinecraftCharCheck="False" /> <local:ValidateFolderPath UseMinecraftCharCheck="False" />
</local:MyTextBox.ValidateRules> </local:MyTextBox.ValidateRules>
</local:MyTextBox> </local:MyTextBox>
<Grid Height="35" Grid.Row="6" Grid.ColumnSpan="5" Margin="0,5,0,0"> <Grid Height="35" Grid.Row="6" Grid.ColumnSpan="5" Margin="0,12,0,0">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyButton Grid.Column="0" x:Name="BtnSystemUpdate" MinWidth="140" Text="检查更新" Padding="13,0" Margin="0,0,20,0" /> <local:MyButton Grid.Column="0" x:Name="BtnSystemUpdate" MinWidth="140" Text="检查更新" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="1" x:Name="BtnSystemIdentify" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" /> <local:MyButton Grid.Column="1" x:Name="BtnSystemSettingExp" MinWidth="140" Text="导出设置" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="2" x:Name="BtnSystemUnlock" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" /> <local:MyButton Grid.Column="2" x:Name="BtnSystemSettingImp" MinWidth="140" Text="导入设置" Padding="13,0" Margin="0,0,20,0" />
</Grid>
<Grid Height="35" Grid.Row="7" Grid.ColumnSpan="5" Margin="0,12,0,0" x:Name="PanDonate">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton Grid.Column="0" x:Name="BtnSystemIdentify" MinWidth="140" Text="复制识别码" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="1" x:Name="BtnSystemUnlock" MinWidth="140" Text="输入解锁码" Padding="13,0" Margin="0,0,20,0" />
</Grid> </Grid>
</Grid> </Grid>
</local:MyCard> </local:MyCard>
@@ -35,7 +35,10 @@
'重复加载部分 '重复加载部分
PanBack.ScrollToHome() PanBack.ScrollToHome()
#If Not BETA Then #If BETA Then
PanDonate.Visibility = Visibility.Collapsed
#Else
PanDonate.Visibility = Visibility.Visible
ItemSystemUpdateDownload.Content = "在有新版本时自动下载(更新快照版可能需要更新密钥)" ItemSystemUpdateDownload.Content = "在有新版本时自动下载(更新快照版可能需要更新密钥)"
#End If #End If
@@ -56,6 +59,7 @@
SliderDownloadSpeed.Value = Setup.Get("ToolDownloadSpeed") SliderDownloadSpeed.Value = Setup.Get("ToolDownloadSpeed")
ComboDownloadVersion.SelectedIndex = Setup.Get("ToolDownloadVersion") ComboDownloadVersion.SelectedIndex = Setup.Get("ToolDownloadVersion")
ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate") ComboDownloadTranslate.SelectedIndex = Setup.Get("ToolDownloadTranslate")
ComboDownloadMod.SelectedIndex = Setup.Get("ToolDownloadMod")
CheckDownloadKeepModpack.Checked = Setup.Get("ToolDownloadKeepModpack") CheckDownloadKeepModpack.Checked = Setup.Get("ToolDownloadKeepModpack")
CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt") CheckDownloadIgnoreQuilt.Checked = Setup.Get("ToolDownloadIgnoreQuilt")
CheckDownloadCert.Checked = Setup.Get("ToolDownloadCert") CheckDownloadCert.Checked = Setup.Get("ToolDownloadCert")
@@ -90,6 +94,7 @@
Setup.Reset("ToolDownloadKeepModpack") Setup.Reset("ToolDownloadKeepModpack")
Setup.Reset("ToolDownloadIgnoreQuilt") Setup.Reset("ToolDownloadIgnoreQuilt")
Setup.Reset("ToolDownloadCert") Setup.Reset("ToolDownloadCert")
Setup.Reset("ToolDownloadMod")
Setup.Reset("ToolUpdateRelease") Setup.Reset("ToolUpdateRelease")
Setup.Reset("ToolUpdateSnapshot") Setup.Reset("ToolUpdateSnapshot")
Setup.Reset("ToolHelpChinese") Setup.Reset("ToolHelpChinese")
@@ -117,7 +122,7 @@
Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change Private Shared Sub SliderChange(sender As MySlider, e As Object) Handles SliderDebugAnim.Change, SliderDownloadThread.Change, SliderDownloadSpeed.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Value)
End Sub End Sub
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboDownloadTranslate.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboDownloadVersion.SelectionChanged, ComboDownloadTranslate.SelectionChanged, ComboSystemUpdate.SelectionChanged, ComboSystemActivity.SelectionChanged, ComboDownloadMod.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex) If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub End Sub
Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged Private Shared Sub TextBoxChange(sender As MyTextBox, e As Object) Handles TextSystemCache.ValidatedTextChanged
@@ -212,4 +217,15 @@
End Try End Try
End Function End Function
#Region "导出 / 导入设置"
Private Sub BtnSystemSettingExp_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemSettingExp.Click
Hint("该功能尚在开发中!")
End Sub
Private Sub BtnSystemSettingImp_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnSystemSettingImp.Click
Hint("该功能尚在开发中!")
End Sub
#End Region
End Class End Class
@@ -242,6 +242,7 @@
<local:MyComboBoxItem Content="简单主页(作者:MFn233)" /> <local:MyComboBoxItem Content="简单主页(作者:MFn233)" />
<local:MyComboBoxItem Content="每日整合包推荐(作者:wkea)" /> <local:MyComboBoxItem Content="每日整合包推荐(作者:wkea)" />
<local:MyComboBoxItem Content="Minecraft 皮肤推荐(作者:wkea)" /> <local:MyComboBoxItem Content="Minecraft 皮肤推荐(作者:wkea)" />
<local:MyComboBoxItem Content="OpenBMCLAPI 仪表盘 Lite(作者:Silverteal、Mxmilu666)" />
</local:MyComboBox> </local:MyComboBox>
</Grid> </Grid>
</StackPanel> </StackPanel>
@@ -451,7 +451,7 @@ Refresh:
End If End If
End Sub End Sub
Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp Private Sub LabLauncherTheme8Copy_MouseRightButtonUp() Handles LabLauncherTheme8Copy.MouseRightButtonUp
OpenWebsite("https://afdian.net/a/LTCat") OpenWebsite("https://afdian.com/a/LTCat")
End Sub End Sub
Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp Private Sub LabLauncherTheme9Copy_MouseRightButtonUp() Handles LabLauncherTheme9Copy.MouseRightButtonUp
PageOtherLeft.TryFeedback() PageOtherLeft.TryFeedback()
@@ -664,7 +664,7 @@ Refresh:
'公开预览版 '公开预览版
Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click
OpenWebsite("https://afdian.net/a/LTCat") OpenWebsite("https://afdian.com/a/LTCat")
End Sub End Sub
'滑动条 '滑动条
@@ -60,11 +60,9 @@ Public Class PageSpeedLeft
End Try End Try
If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub If FrmSpeedRight Is Nothing OrElse FrmSpeedRight.PanMain Is Nothing Then Exit Sub
Try Try
SyncLock LoaderTaskbarLock For Each Loader In LoaderTaskbar.ToList
For Each Loader In LoaderTaskbar.ToList TaskRefresh(Loader)
TaskRefresh(Loader) Next
Next
End SyncLock
Catch ex As Exception Catch ex As Exception
Log(ex, "下载管理右栏监视出错", LogLevel.Feedback) Log(ex, "下载管理右栏监视出错", LogLevel.Feedback)
End Try End Try
@@ -197,13 +195,11 @@ Public Class PageSpeedLeft
Sub(sender As MyIconButton, e As EventArgs) Sub(sender As MyIconButton, e As EventArgs)
AniDispose(sender, False) AniDispose(sender, False)
AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack()) AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack())
RightCards.Remove(Loader.Name) Dim LoaderName = If(Loader Is Nothing, "null", Loader.Name)
SyncLock LoaderTaskbarLock RightCards.Remove(LoaderName)
LoaderTaskbar.Remove(Loader) LoaderTaskbar.TryTake(Loader)
Log($"[Taskbar] 由于下载管理卡片关闭,{Loader.Name} 已移出任务列表") Log($"[Taskbar] 关闭下载管理卡片:{LoaderName},且移出任务列表")
End SyncLock RunInThread(Sub() Loader?.Abort())
Log($"[Watcher] 关闭下载管理卡片:{Loader.Name}")
RunInThread(Sub() Loader.Abort())
End Sub End Sub
'如果已经失败,再刷新一次,修改成失败的控件 '如果已经失败,再刷新一次,修改成失败的控件
If Loader.State = LoadState.Failed Then If Loader.State = LoadState.Failed Then
@@ -96,7 +96,7 @@
Catch ex As Exception Catch ex As Exception
Log(ex, "强制刷新时清理本地 Mod 信息缓存失败") Log(ex, "强制刷新时清理本地 Mod 信息缓存失败")
End Try End Try
If FrmVersionMod IsNot Nothing Then FrmVersionMod.RefreshList(True) '无需 Else,还没加载刷个鬼的新 If FrmVersionMod IsNot Nothing Then FrmVersionMod.ReloadModList(True) '无需 Else,还没加载刷个鬼的新
ItemMod.Checked = True ItemMod.Checked = True
Hint("正在刷新……", Log:=False) Hint("正在刷新……", Log:=False)
End Sub End Sub
@@ -23,8 +23,15 @@
<local:MyButton x:Name="BtnManageCheck" Grid.Column="3" MinWidth="140" Text="检查 Mod" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ToolTip="快速检查 Mod 的版本要求、重复、前置缺失等问题。&#xa;结果仅供参考,由于部分 Mod 标注的信息有误,可能并不准确。" Visibility="Collapsed" /> <local:MyButton x:Name="BtnManageCheck" Grid.Column="3" MinWidth="140" Text="检查 Mod" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ToolTip="快速检查 Mod 的版本要求、重复、前置缺失等问题。&#xa;结果仅供参考,由于部分 Mod 标注的信息有误,可能并不准确。" Visibility="Collapsed" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,15" Title=" " MinHeight="40"> <local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,14" Title=" " MinHeight="55">
<StackPanel Margin="20,38,18,18" Name="PanList" VerticalAlignment="Top" /> <StackPanel x:Name="PanFilter" Margin="15,13,0,0" Orientation="Horizontal" VerticalAlignment="Top" HorizontalAlignment="Left" Height="28">
<local:MyRadioButton Tag="0" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="全部" x:Name="BtnFilterAll" Checked="True" />
<local:MyRadioButton Tag="1" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已启用" x:Name="BtnFilterEnabled" />
<local:MyRadioButton Tag="2" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已禁用" x:Name="BtnFilterDisabled" />
<local:MyRadioButton Tag="3" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="可更新" x:Name="BtnFilterCanUpdate" />
<local:MyRadioButton Tag="4" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="错误" x:Name="BtnFilterError" />
</StackPanel>
<StackPanel Margin="20,48,18,22" Name="PanList" VerticalAlignment="Top" />
</local:MyCard> </local:MyCard>
</StackPanel> </StackPanel>
</local:MyScrollViewer> </local:MyScrollViewer>
@@ -8,7 +8,7 @@
If FrmMain.PageLast.Page <> FormMain.PageType.CompDetail Then PanBack.ScrollToHome() If FrmMain.PageLast.Page <> FormMain.PageType.CompDetail Then PanBack.ScrollToHome()
AniControlEnabled += 1 AniControlEnabled += 1
SelectedMods.Clear() SelectedMods.Clear()
RefreshList() ReloadModList()
ChangeAllSelected(False) ChangeAllSelected(False)
AniControlEnabled -= 1 AniControlEnabled -= 1
@@ -16,6 +16,11 @@
If IsLoad Then Exit Sub If IsLoad Then Exit Sub
IsLoad = True IsLoad = True
'调整按钮边距(这玩意儿没法从 XAML 改)
For Each Btn As MyRadioButton In PanFilter.Children
Btn.LabText.Margin = New Thickness(-2, 0, 8, 0)
Next
#If DEBUG Then #If DEBUG Then
BtnManageCheck.Visibility = Visibility.Visible BtnManageCheck.Visibility = Visibility.Visible
#End If #End If
@@ -24,9 +29,10 @@
''' <summary> ''' <summary>
''' 刷新 Mod 列表。 ''' 刷新 Mod 列表。
''' </summary> ''' </summary>
Public Sub RefreshList(Optional ForceReload As Boolean = False) Public Sub ReloadModList(Optional ForceReload As Boolean = False)
If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then
Log("[System] 已刷新 Mod 列表") Log("[System] 已刷新 Mod 列表")
Filter = FilterType.All
PanBack.ScrollToHome() PanBack.ScrollToHome()
SearchBox.Text = "" SearchBox.Text = ""
End If End If
@@ -53,10 +59,9 @@
''' 将加载器结果的 Mod 列表加载为 UI。 ''' 将加载器结果的 Mod 列表加载为 UI。
''' </summary> ''' </summary>
Private Sub LoadUIFromLoaderOutput() Private Sub LoadUIFromLoaderOutput()
Dim Mods As List(Of McMod) = McModLoader.Output
Try Try
'判断应该显示哪一个页面 '判断应该显示哪一个页面
If Mods.Any() Then If McModLoader.Output.Any() Then
PanBack.Visibility = Visibility.Visible PanBack.Visibility = Visibility.Visible
PanEmpty.Visibility = Visibility.Collapsed PanEmpty.Visibility = Visibility.Collapsed
Else Else
@@ -64,13 +69,15 @@
PanBack.Visibility = Visibility.Collapsed PanBack.Visibility = Visibility.Collapsed
Exit Sub Exit Sub
End If End If
'输出结果 '修改缓存
ModItems.Clear() ModItems.Clear()
For Each ModEntity As McMod In Mods For Each ModEntity As McMod In McModLoader.Output
ModItems(ModEntity.RawFileName) = McModListItem(ModEntity) ModItems(ModEntity.RawFileName) = McModListItem(ModEntity)
Next Next
'显示结果
Filter = FilterType.All
SearchBox.Text = "" '这会触发结果刷新,所以需要在 ModItems 更新之后,详见 #3124 的视频 SearchBox.Text = "" '这会触发结果刷新,所以需要在 ModItems 更新之后,详见 #3124 的视频
RefreshResult(Mods) RefreshUI()
Catch ex As Exception Catch ex As Exception
Log(ex, "加载 Mod 列表 UI 失败", LogLevel.Feedback) Log(ex, "加载 Mod 列表 UI 失败", LogLevel.Feedback)
End Try End Try
@@ -122,38 +129,138 @@
End Sub End Sub
''' <summary> ''' <summary>
''' 刷新结果显示。 ''' 刷新整个 UI。
''' </summary> ''' </summary>
Private Sub RefreshResult(Mods As List(Of McMod)) Public Sub RefreshUI()
PanList.Children.Clear() If PanList Is Nothing Then Exit Sub
For Each TargetMod In Mods Dim ShowMods = GetShowingMods(True).ToList()
PanList.Children.Add(ModItems(TargetMod.RawFileName)) '重新列出列表
Next AniControlEnabled += 1
RefreshTitle() If ShowMods.Any() Then
End Sub PanList.Visibility = Visibility.Visible
''' <summary> PanList.Children.Clear()
''' 刷新卡片标题。 For Each TargetMod In ShowMods
''' </summary> Dim Item As MyLocalModItem = ModItems(TargetMod.RawFileName)
Private Sub RefreshTitle() Item.Checked = SelectedMods.Contains(TargetMod.RawFileName) '更新选中状态
Dim Mods = PanList.Children.Cast(Of MyLocalModItem).Select(Function(i) i.Entry).ToList PanList.Children.Add(Item)
Dim Counter = {0, 0, 0} Next
For Each ModEntity As McMod In Mods
Counter(ModEntity.State) += 1
Next
Dim TypeList As New List(Of String)
If Counter(McMod.McModState.Disabled) > 0 Then TypeList.Add("禁用 " & Counter(McMod.McModState.Disabled))
If Counter(McMod.McModState.Unavaliable) > 0 Then TypeList.Add("错误 " & Counter(McMod.McModState.Unavaliable))
If Counter(McMod.McModState.Fine) > 0 Then TypeList.Insert(0, If(TypeList.Any, "启用 ", "") & Counter(McMod.McModState.Fine))
If Not IsSearching Then
PanListBack.Title = "Mod 列表 (" & Join(TypeList, ",") & ")"
ElseIf TypeList.Any() Then
PanListBack.Title = "搜索结果 (" & Join(TypeList, ",") & ")"
Else Else
PanListBack.Title = "无搜索结果" PanList.Visibility = Visibility.Collapsed
End If End If
PanList.Visibility = If(Mods.Any(), Visibility.Visible, Visibility.Collapsed) AniControlEnabled -= 1
SelectedMods = SelectedMods.Where(Function(m) ShowMods.Any(Function(s) s.RawFileName = m)).ToList '取消选中已经不显示的 Mod
RefreshBars()
End Sub End Sub
''' <summary>
''' 刷新顶栏和底栏显示。
''' </summary>
Public Sub RefreshBars()
'-----------------
' 顶部栏
'-----------------
'计数
Dim AnyCount As Integer = 0
Dim EnabledCount As Integer = 0
Dim DisabledCount As Integer = 0
Dim UpdateCount As Integer = 0
Dim UnavalialeCount As Integer = 0
For Each ModItem In GetShowingMods(False)
AnyCount += 1
If ModItem.CanUpdate Then UpdateCount += 1
If ModItem.State.Equals(McMod.McModState.Fine) Then EnabledCount += 1
If ModItem.State.Equals(McMod.McModState.Disabled) Then DisabledCount += 1
If ModItem.State.Equals(McMod.McModState.Unavaliable) Then UnavalialeCount += 1
Next
'显示
BtnFilterAll.Text = If(IsSearching, "搜索结果", "全部") & $" ({AnyCount})"
BtnFilterCanUpdate.Text = $"可更新 ({UpdateCount})"
BtnFilterCanUpdate.Visibility = If(Filter = FilterType.CanUpdate OrElse
UpdateCount > 0, Visibility.Visible, Visibility.Collapsed)
BtnFilterEnabled.Text = $"启用 ({EnabledCount})"
BtnFilterEnabled.Visibility = If(Filter = FilterType.Enabled OrElse Filter = FilterType.Disabled OrElse
EnabledCount > 0 AndAlso EnabledCount <> AnyCount, Visibility.Visible, Visibility.Collapsed)
BtnFilterDisabled.Text = $"禁用 ({DisabledCount})"
BtnFilterDisabled.Visibility = If(Filter = FilterType.Enabled OrElse Filter = FilterType.Disabled OrElse
DisabledCount > 0, Visibility.Visible, Visibility.Collapsed)
BtnFilterError.Text = $"错误 ({UnavalialeCount})"
BtnFilterError.Visibility = If(Filter = FilterType.Unavaliable OrElse
UnavalialeCount > 0, Visibility.Visible, Visibility.Collapsed)
'-----------------
' 底部栏
'-----------------
'计数
Dim NewCount As Integer = SelectedMods.Count
Dim Selected = NewCount > 0
If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字
'按钮可用性
If Selected Then
Dim HasUpdate As Boolean = False
Dim HasEnabled As Boolean = False
Dim HasDisabled As Boolean = False
For Each ModEntity In McModLoader.Output
If SelectedMods.Contains(ModEntity.RawFileName) Then
If ModEntity.CanUpdate Then HasUpdate = True
If ModEntity.State = McMod.McModState.Fine Then
HasEnabled = True
ElseIf ModEntity.State = McMod.McModState.Disabled Then
HasDisabled = True
End If
End If
Next
BtnSelectDisable.IsEnabled = HasEnabled
BtnSelectEnable.IsEnabled = HasDisabled
BtnSelectUpdate.IsEnabled = HasUpdate
End If
'更新显示状态
If AniControlEnabled = 0 Then
PanListBack.Margin = New Thickness(0, 0, 0, If(Selected, 95, 15))
If Selected Then
'仅在数量增加时播放出现/跳跃动画
If BottomBarShownCount >= NewCount Then
BottomBarShownCount = NewCount
Return
Else
BottomBarShownCount = NewCount
End If
'出现/跳跃动画
CardSelect.Visibility = Visibility.Visible
AniStart({
AaOpacity(CardSelect, 1 - CardSelect.Opacity, 60),
AaTranslateY(CardSelect, -27 - TransSelect.Y, 120, Ease:=New AniEaseOutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, 3, 150, 120, Ease:=New AniEaseInoutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, -1, 90, 270, Ease:=New AniEaseInoutFluent(AniEasePower.Weak))
}, "Mod Sidebar")
Else
'不重复播放隐藏动画
If BottomBarShownCount = 0 Then Return
BottomBarShownCount = 0
'隐藏动画
AniStart({
AaOpacity(CardSelect, -CardSelect.Opacity, 90),
AaTranslateY(CardSelect, -10 - TransSelect.Y, 90, Ease:=New AniEaseInFluent(AniEasePower.Weak)),
AaCode(Sub() CardSelect.Visibility = Visibility.Collapsed, After:=True)
}, "Mod Sidebar")
End If
Else
AniStop("Mod Sidebar")
BottomBarShownCount = NewCount
If Selected Then
CardSelect.Visibility = Visibility.Visible
CardSelect.Opacity = 1
TransSelect.Y = -25
Else
CardSelect.Visibility = Visibility.Collapsed
CardSelect.Opacity = 0
TransSelect.Y = -10
End If
End If
End Sub
Private BottomBarShownCount As Integer = 0
#End Region #End Region
#Region "管理" #Region "管理"
@@ -192,11 +299,7 @@
''' 全选。 ''' 全选。
''' </summary> ''' </summary>
Private Sub BtnManageSelectAll_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageSelectAll.Click Private Sub BtnManageSelectAll_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageSelectAll.Click
If SelectedMods.Count < PanList.Children.Count Then ChangeAllSelected(SelectedMods.Count < GetShowingMods(True).Count)
ChangeAllSelected(True)
Else
ChangeAllSelected(False)
End If
End Sub End Sub
''' <summary> ''' <summary>
@@ -223,91 +326,19 @@
Else Else
SelectedMods.Remove(SelectedKey) SelectedMods.Remove(SelectedKey)
End If End If
'更新下边栏 UI RefreshBars()
RefreshBottomBar()
End Sub
'改变下边栏状态
Private ShownCount As Integer = 0
Private Sub RefreshBottomBar()
'计数
Dim NewCount As Integer = SelectedMods.Count
Dim Selected = NewCount > 0
If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字
'按钮可用性
If Selected Then
Dim HasUpdate As Boolean = False
Dim HasEnabled As Boolean = False
Dim HasDisabled As Boolean = False
For Each ModEntity In McModLoader.Output
If SelectedMods.Contains(ModEntity.RawFileName) Then
If ModEntity.CanUpdate Then HasUpdate = True
If ModEntity.State = McMod.McModState.Fine Then
HasEnabled = True
ElseIf ModEntity.State = McMod.McModState.Disabled Then
HasDisabled = True
End If
End If
Next
BtnSelectDisable.IsEnabled = HasEnabled
BtnSelectEnable.IsEnabled = HasDisabled
BtnSelectUpdate.IsEnabled = HasUpdate
End If
'更新显示状态
If AniControlEnabled = 0 Then
If Selected Then
'仅在数量增加时播放出现/跳跃动画
If ShownCount >= NewCount Then
ShownCount = NewCount
Return
Else
ShownCount = NewCount
End If
'出现/跳跃动画
CardSelect.Visibility = Visibility.Visible
AniStart({
AaOpacity(CardSelect, 1 - CardSelect.Opacity, 60),
AaTranslateY(CardSelect, -27 - TransSelect.Y, 120, Ease:=New AniEaseOutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, 3, 150, 120, Ease:=New AniEaseInoutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, -1, 90, 270, Ease:=New AniEaseInoutFluent(AniEasePower.Weak))
}, "Mod Sidebar")
Else
'不重复播放隐藏动画
If ShownCount = 0 Then Return
ShownCount = 0
'隐藏动画
AniStart({
AaOpacity(CardSelect, -CardSelect.Opacity, 90),
AaTranslateY(CardSelect, -10 - TransSelect.Y, 90, Ease:=New AniEaseInFluent(AniEasePower.Weak)),
AaCode(Sub() CardSelect.Visibility = Visibility.Collapsed, After:=True)
}, "Mod Sidebar")
End If
Else
AniStop("Mod Sidebar")
ShownCount = NewCount
If Selected Then
CardSelect.Visibility = Visibility.Visible
CardSelect.Opacity = 1
TransSelect.Y = -25
Else
CardSelect.Visibility = Visibility.Collapsed
CardSelect.Opacity = 0
TransSelect.Y = -10
End If
End If
End Sub End Sub
'切换所有项的选择状态 '切换所有项的选择状态
Private Sub ChangeAllSelected(Value As Boolean) Private Sub ChangeAllSelected(Value As Boolean)
AniControlEnabled += 1 AniControlEnabled += 1
SelectedMods.Clear() SelectedMods.Clear()
For Each Item As MyLocalModItem In PanList.Children For Each Item As MyLocalModItem In GetShowingMods(True).Select(Function(m) ModItems(m.RawFileName))
Item.Checked = Value Item.Checked = Value
If Value Then SelectedMods.Add(Item.Entry.RawFileName) If Value Then SelectedMods.Add(Item.Entry.RawFileName)
Next Next
AniControlEnabled -= 1 AniControlEnabled -= 1
'更新下边栏 UI RefreshBars()
RefreshBottomBar()
End Sub End Sub
Private Sub UnselectedAllWithAnimation() Handles Load.StateChanged, Me.PageExit Private Sub UnselectedAllWithAnimation() Handles Load.StateChanged, Me.PageExit
Dim CacheAniControlEnabled = AniControlEnabled Dim CacheAniControlEnabled = AniControlEnabled
@@ -321,6 +352,75 @@
#End Region #End Region
#Region "筛选"
Private _Filter As FilterType = FilterType.All
Private Property Filter As FilterType
Get
Return _Filter
End Get
Set(value As FilterType)
If _Filter = value Then Return
_Filter = value
Select Case value
Case FilterType.All
BtnFilterAll.Checked = True
Case FilterType.Enabled
BtnFilterEnabled.Checked = True
Case FilterType.Disabled
BtnFilterDisabled.Checked = True
Case FilterType.CanUpdate
BtnFilterCanUpdate.Checked = True
Case Else
BtnFilterError.Checked = True
End Select
RefreshUI()
End Set
End Property
Private Enum FilterType As Integer
All = 0
Enabled = 1
Disabled = 2
CanUpdate = 3
Unavaliable = 4
End Enum
''' <summary>
''' 获取所有应该显示在 UI 中的 Mod。
''' </summary>
Private Function GetShowingMods(ApplyFilter As Boolean) As IEnumerable(Of McMod)
If McModLoader.Output Is Nothing Then Return New List(Of McMod)
Return If(IsSearching, SearchResult, McModLoader.Output).Where(Function(m) Not ApplyFilter OrElse CanPassFilter(m))
End Function
''' <summary>
''' 检查该 Mod 项是否符合当前筛选的类别。
''' </summary>
Private Function CanPassFilter(CheckingMod As McMod) As Boolean
Select Case Filter
Case FilterType.All
Return True
Case FilterType.Enabled
Return CheckingMod.State = McMod.McModState.Fine
Case FilterType.Disabled
Return CheckingMod.State = McMod.McModState.Disabled
Case FilterType.CanUpdate
Return CheckingMod.CanUpdate
Case FilterType.Unavaliable
Return CheckingMod.State = McMod.McModState.Unavaliable
Case Else
Return False
End Select
End Function
'点击筛选项触发的改变
Private Sub ChangeFilter(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnFilterAll.Check, BtnFilterCanUpdate.Check, BtnFilterDisabled.Check, BtnFilterEnabled.Check, BtnFilterError.Check
Filter = sender.Tag
RefreshUI()
End Sub
#End Region
#Region "下边栏" #Region "下边栏"
'启用 / 禁用 '启用 / 禁用
@@ -362,7 +462,7 @@
FileSystem.Rename(ModEntity.Path, NewPath) FileSystem.Rename(ModEntity.Path, NewPath)
Catch ex As FileNotFoundException Catch ex As FileNotFoundException
Log(ex, $"未找到需要重命名的 Mod({If(ModEntity.Path, "null")})", LogLevel.Feedback) Log(ex, $"未找到需要重命名的 Mod({If(ModEntity.Path, "null")})", LogLevel.Feedback)
RefreshList(True) ReloadModList(True)
Return Return
Catch ex As Exception Catch ex As Exception
Log(ex, $"重命名 Mod 失败({If(ModEntity.Path, "null")})") Log(ex, $"重命名 Mod 失败({If(ModEntity.Path, "null")})")
@@ -382,12 +482,11 @@
PanList.Children.RemoveAt(IndexOfUi) PanList.Children.RemoveAt(IndexOfUi)
PanList.Children.Insert(IndexOfUi, NewItem) PanList.Children.Insert(IndexOfUi, NewItem)
Next Next
RefreshTitle() '改变数量显示 If IsSuccessful Then
If Not IsSuccessful Then RefreshBars()
Hint("由于文件被占用,Mod 的状态切换失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
RefreshList(True)
Else Else
RefreshBottomBar() Hint("由于文件被占用,Mod 的状态切换失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
ReloadModList(True)
End If End If
End Sub End Sub
@@ -504,7 +603,7 @@
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
RefreshList(True) ReloadModList(True)
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化 Mod 更新失败") Log(ex, "初始化 Mod 更新失败")
End Try End Try
@@ -538,7 +637,7 @@
End If End If
Catch ex As OperationCanceledException Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消") Log(ex, "删除 Mod 被主动取消")
RefreshList(True) ReloadModList(True)
Return Return
Catch ex As Exception Catch ex As Exception
Log(ex, $"删除 Mod 失败({ModEntity.Path})", LogLevel.Msgbox) Log(ex, $"删除 Mod 失败({ModEntity.Path})", LogLevel.Msgbox)
@@ -548,18 +647,19 @@
SelectedMods.Remove(ModEntity.RawFileName) SelectedMods.Remove(ModEntity.RawFileName)
'更改 Loader 和 UI 中的列表 '更改 Loader 和 UI 中的列表
McModLoader.Output.Remove(ModEntity) McModLoader.Output.Remove(ModEntity)
SearchResult?.Remove(ModEntity)
ModItems.Remove(ModEntity.RawFileName) ModItems.Remove(ModEntity.RawFileName)
Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry.Equals(ModEntity))) Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry.Equals(ModEntity)))
If IndexOfUi >= 0 Then PanList.Children.RemoveAt(IndexOfUi) If IndexOfUi >= 0 Then PanList.Children.RemoveAt(IndexOfUi)
Next Next
RefreshTitle() RefreshBars()
If Not IsSuccessful Then If Not IsSuccessful Then
Hint("由于文件被占用,Mod 删除失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical) Hint("由于文件被占用,Mod 删除失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
RefreshList(True) ReloadModList(True)
ElseIf PanList.Children.Count = 0 Then ElseIf PanList.Children.Count = 0 Then
RefreshList(True) '删除了全部文件 ReloadModList(True) '删除了全部文件
Else Else
RefreshBottomBar() RefreshBars()
End If End If
'显示结果提示 '显示结果提示
If Not IsSuccessful Then Exit Sub If Not IsSuccessful Then Exit Sub
@@ -578,10 +678,10 @@
End If End If
Catch ex As OperationCanceledException Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消") Log(ex, "删除 Mod 被主动取消")
RefreshList(True) ReloadModList(True)
Catch ex As Exception Catch ex As Exception
Log(ex, "删除 Mod 出现未知错误", LogLevel.Feedback) Log(ex, "删除 Mod 出现未知错误", LogLevel.Feedback)
RefreshList(True) ReloadModList(True)
End Try End Try
End Sub End Sub
@@ -694,8 +794,8 @@
Return Not String.IsNullOrWhiteSpace(SearchBox.Text) Return Not String.IsNullOrWhiteSpace(SearchBox.Text)
End Get End Get
End Property End Property
Private SearchResult As List(Of McMod)
Public Sub SearchRun() Handles SearchBox.TextChanged Public Sub SearchRun() Handles SearchBox.TextChanged
ChangeAllSelected(False)
If IsSearching Then If IsSearching Then
'构造请求 '构造请求
Dim QueryList As New List(Of SearchEntry(Of McMod)) Dim QueryList As New List(Of SearchEntry(Of McMod))
@@ -718,12 +818,9 @@
QueryList.Add(New SearchEntry(Of McMod) With {.Item = Entry, .SearchSource = SearchSource}) QueryList.Add(New SearchEntry(Of McMod) With {.Item = Entry, .SearchSource = SearchSource})
Next Next
'进行搜索 '进行搜索
Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35) SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35).Select(Function(r) r.Item).ToList
RefreshResult(SearchResult.Select(Function(r) r.Item).ToList)
Else
'退出搜索状态
RefreshResult(McModLoader.Output)
End If End If
RefreshUI()
End Sub End Sub
#End Region #End Region
@@ -284,14 +284,11 @@
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try Try
'重复任务检查 '重复任务检查
SyncLock LoaderTaskbarLock For Each OngoingLoader In LoaderTaskbar
For i = 0 To LoaderTaskbar.Count - 1 If OngoingLoader.Name <> PageVersionLeft.Version.Name & " 文件补全" Then Continue For
If LoaderTaskbar(i).Name = PageVersionLeft.Version.Name & " 文件补全" Then Hint("正在处理中,请稍候!", HintType.Critical)
Hint("正在处理中,请稍候!", HintType.Critical) Exit Sub
Exit Sub Next
End If
Next
End SyncLock
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False)) Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False))
Loader.OnStateChanged = Loader.OnStateChanged =
@@ -140,6 +140,10 @@
<Prefer32Bit>false</Prefer32Bit> <Prefer32Bit>false</Prefer32Bit>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Reference Include="Imazen.WebP, Version=10.0.1.0, Culture=neutral, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>Resources\Imazen.WebP.dll</HintPath>
</Reference>
<Reference Include="NAudio, Version=1.7.3.0, Culture=neutral, processorArchitecture=MSIL"> <Reference Include="NAudio, Version=1.7.3.0, Culture=neutral, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion> <SpecificVersion>False</SpecificVersion>
<Private>False</Private> <Private>False</Private>
@@ -879,7 +883,6 @@
<Resource Include="Images\Heads\bangbang93.png" /> <Resource Include="Images\Heads\bangbang93.png" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Resource Include="Images\Heads\DoodleHuang.png" />
<Resource Include="Images\Heads\wiki.png" /> <Resource Include="Images\Heads\wiki.png" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
@@ -931,9 +934,15 @@
<Resource Include="Images\Heads\MCBBS.png" /> <Resource Include="Images\Heads\MCBBS.png" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Content Include="Resources\Imazen.WebP.dll" />
<Content Include="Resources\libwebp32.dll" />
<Content Include="Resources\libwebp64.dll" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Resource Include="Images\Blocks\NeoForge.png" /> <Resource Include="Images\Blocks\NeoForge.png" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<Resource Include="Images\Heads\z0z0r4.png" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" /> <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project> </Project>
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large Load Diff
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.