Compare commits

..
50 Commits
Author SHA1 Message Date
龙腾猫跃 a84601d99c 2.7.2 2024-05-13 18:09:30 +08:00
龙腾猫跃 a5a3800957 Merge pull request #3781 from Chiloven945/main
修改模组及整合包版本筛选列表冗余
2024-05-06 17:14:35 +08:00
龙腾猫跃 baba653a67 Update README.md 2024-05-06 17:10:37 +08:00
龙腾猫跃 5733cbdb0e Merge pull request #3768 from allMagicNB/Revive-#85-#91-#192
Revive #85 #91 #192
2024-05-06 16:09:33 +08:00
ClovenBugle 6e1072d042 修改整合包版本筛选列表冗余
删去1.20、1.20.3、1.20.5因均有被继后版本修复的bug
添加1.19.2因其为1.19最常用的模组版本
2024-05-04 11:40:42 +08:00
ClovenBugle efe58c9748 修改模组版本筛选列表冗余
删去1.20、1.20.3、1.20.5因均有被继后版本修复的bug
添加1.19.2因其为1.19最常用的模组版本
2024-05-04 11:37:50 +08:00
allMagicNB 5b58e3868d 更换爱发电主页链接 2024-05-01 16:28:24 +08:00
allMagicNB 0a48feba18 不加了不加了……都预览不了 2024-05-01 14:58:46 +08:00
allMagicNB 7d89b90ae1 换 SVG…… 2024-05-01 14:31:02 +08:00
allMagicNB f6cae4ea23 添加 “赞助-爱发电” Badge 2024-05-01 14:14:29 +08:00
allMagicNB a09baee5f8 添加 “赞助-爱发电” Badge 2024-05-01 14:13:20 +08:00
allMagicNB fa3d5bc09b 增加 “Issues” Badge 2024-05-01 13:33:39 +08:00
allMagicNB c169532794 为 Bagde 添加链接和说明 2024-05-01 10:48:38 +08:00
allMagic 37313e4d6e Update README.md
再改下
2024-05-01 10:18:04 +08:00
allMagic dd9cdaf15f Update README.md
换了下 Star 的 Logo
2024-05-01 10:17:32 +08:00
allMagic 6a2f95e96f Update README.md
Revive #85 #91 #192
2024-04-30 23:00:24 +08:00
龙腾猫跃 d682b59803 Merge pull request #3732 from allMagicNB/main
增加资源下载界面的 1.20.5(#3731)
2024-04-25 04:14:52 +08:00
allMagic 02347239b4 Add 1.20.5 2024-04-25 02:12:48 +08:00
allMagic dc4eda533c Add 1.20.5 2024-04-25 02:10:28 +08:00
龙腾猫跃 d86ad945a6 Merge pull request #3699 from zkitefly/crash
updata CrashReason.Fabric报错并给出解决方案
2024-04-19 22:04:02 +08:00
zkitefly 12be800391 updata CrashReason.Fabric报错并给出解决方案 2024-04-19 13:52:59 +00:00
龙腾猫跃 c47b80df36 2.7.1 正式版 2024-04-08 17:15:20 +08:00
龙腾猫跃 43b0acba08 2.7.1 2024-04-08 01:54:35 +08:00
龙腾猫跃 c1cad542c2 Merge pull request #3530 from wuliaodexiaoluo/main
添加 JVM 参数
2024-04-05 22:14:26 +08:00
龙腾猫跃 09f9b8f1e5 Merge branch 'main' into main 2024-04-05 22:14:18 +08:00
龙腾猫跃 4241060010 2.7.0 正式版 2024-04-05 17:36:13 +08:00
龙腾猫跃 0dab617b64 2.7.0 2024-04-04 03:26:43 +08:00
龙腾猫跃 515b7e89c5 Merge pull request #3593 from allMagicNB/main
fix #3591
2024-04-04 01:26:23 +08:00
allMagic d83f98b34a fix #3591 2024-04-02 13:32:14 +08:00
allMagic e2030970a3 fix #3591 2024-04-02 06:23:00 +08:00
allMagic e623d3464a fix #3591 2024-04-01 22:55:39 +08:00
allMagic 81346f0821 fix #3591 2024-04-01 22:37:05 +08:00
allMagic 810c6e8618 fix #3591 2024-04-01 22:17:49 +08:00
wuliaodexiaoluo a5199d32ed Update FormMain.xaml.vb 2024-03-20 08:42:54 +08:00
wuliaodexiaoluo b058e7722d Update FormMain.xaml.vb 2024-03-19 14:52:56 +08:00
wuliaodexiaoluo 4beef0fb5d Merge pull request #4 from wuliaodexiaoluo/wuliaodexiaoluo-patch-2
Update FormMain.xaml.vb
2024-03-19 13:56:29 +08:00
wuliaodexiaoluo eb195373ea Update FormMain.xaml.vb
修复 UAC 阻止文件拖拽
2024-03-19 13:56:11 +08:00
wuliaodexiaoluo 65ca2e0cf4 Update PageSetupLaunch.xaml 2024-03-16 13:10:15 +08:00
wuliaodexiaoluo 09e420ad6b Merge pull request #3 from wuliaodexiaoluo/wuliaodexiaoluo-patch-2
Update PageSetupLaunch.xaml
2024-03-16 13:01:45 +08:00
wuliaodexiaoluo 95429cc9cc Merge branch 'main' into wuliaodexiaoluo-patch-2 2024-03-16 13:01:37 +08:00
wuliaodexiaoluo 5a78a46b28 Update PageSetupLaunch.xaml
解决描述错误
2024-03-16 12:53:00 +08:00
wuliaodexiaoluo 3ae624d4fb Update PageSetupLaunch.xaml
手滑了抱歉。。。
2024-03-16 12:51:14 +08:00
wuliaodexiaoluo 91f39f2afd Merge pull request #2 from wuliaodexiaoluo/wuliaodexiaoluo-patch-1
Fix # 3511
2024-03-16 12:31:42 +08:00
wuliaodexiaoluo 65da5b67f7 Update PageSetupLaunch.xaml 2024-03-16 12:30:46 +08:00
wuliaodexiaoluo 268cb092dd Update PageSetupLaunch.xaml 2024-03-16 12:27:47 +08:00
wuliaodexiaoluo 9728af60d0 Update PageSetupLaunch.xaml 2024-03-16 12:24:48 +08:00
wuliaodexiaoluo 7affc1e24f Merge pull request #1 from Hex-Dragon/main
Update
2024-03-16 12:23:26 +08:00
龙腾猫跃 3076f3a6b7 Merge pull request #3475 from WorldHim/patch-1
修复 #3461 换行缺失
2024-03-03 04:42:17 +08:00
WorldHim 02c8b7211b fix: #3461 2024-03-02 20:30:02 +08:00
龙腾猫跃 5843649cfa 2.6.15 正式版 2024-03-02 18:04:12 +08:00
59 changed files with 2043 additions and 1759 deletions

No files matched your search

+14 -14
View File
@@ -19,7 +19,6 @@ Public Class Application
'开始
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
ApplicationStartTick = GetTimeTick()
SecretOnApplicationStart()
Try
'检查参数调用
@@ -28,11 +27,11 @@ Public Class Application
'自动更新
UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4))
Environment.Exit(Result.Cancel)
'ElseIf e.Args(0).StartsWith("--link") Then
'ElseIf e.Args(0).StartsWithF("--link") Then
' '稍作等待后切换到联机页面
' Thread.Sleep(1000)
' FormMain.IsLinkRestart = True
ElseIf e.Args(0).StartsWith("--memory") Then
ElseIf e.Args(0).StartsWithF("--memory") Then
'内存优化
Dim Ram = My.Computer.Info.AvailablePhysicalMemory
Try
@@ -104,9 +103,10 @@ Public Class Application
'日志初始化
LogStart()
'添加日志
Log("[Start] 程序版本:" & VersionDisplayName & "(" & VersionCode & ")")
Log("[Start] 识别码:" & UniqueAddress & If(ThemeCheckOne(9), ",已解锁反馈主题", ""))
Log("[Start] 程序路径:" & PathWithName)
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode})")
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
Log($"[Start] 程序路径:{PathWithName}")
Log($"[Start] 系统编码:{Encoding.Default} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
'检测压缩包运行
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("PCL 正在临时文件夹运行,设置、游戏存档等很可能无法保存,且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True)
@@ -173,7 +173,7 @@ Public Class Application
Private Shared ReadOnly AssemblyJsonLock As New Object
Private Shared ReadOnly AssemblyDialogLock As New Object
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly
If args.Name.StartsWith("NAudio") Then
If args.Name.StartsWithF("NAudio") Then
SyncLock AssemblyNAudioLock
If AssemblyNAudio Is Nothing Then
Log("[Start] 加载 DLL:NAudio")
@@ -181,7 +181,7 @@ Public Class Application
End If
Return AssemblyNAudio
End SyncLock
ElseIf args.Name.StartsWith("Newtonsoft.Json") Then
ElseIf args.Name.StartsWithF("Newtonsoft.Json") Then
SyncLock AssemblyJsonLock
If AssemblyJson Is Nothing Then
Log("[Start] 加载 DLL:Json")
@@ -189,7 +189,7 @@ Public Class Application
End If
Return AssemblyJson
End SyncLock
ElseIf args.Name.StartsWith("Ookii.Dialogs.Wpf") Then
ElseIf args.Name.StartsWithF("Ookii.Dialogs.Wpf") Then
SyncLock AssemblyDialogLock
If AssemblyDialog Is Nothing Then
Log("[Start] 加载 DLL:Dialogs")
@@ -220,7 +220,7 @@ Public Class Application
Names.Remove(sender.Tag)
Setup.Set("LoginLegacyName", Join(Names, "¨"))
FrmLoginLegacy.ComboName.ItemsSource = Names
FrmLoginLegacy.ComboName.Text = If(Names.Count > 0, Names(0), "")
FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
Case Else
'第三方
Dim Token As String = GetStringFromEnum(Setup.Get("LoginType"))
@@ -238,12 +238,12 @@ Public Class Application
Select Case Token
Case "Nide"
FrmLoginNide.ComboName.ItemsSource = Dict.Keys
FrmLoginNide.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
FrmLoginNide.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
FrmLoginNide.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "")
FrmLoginNide.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "")
Case "Auth"
FrmLoginAuth.ComboName.ItemsSource = Dict.Keys
FrmLoginAuth.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
FrmLoginAuth.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
FrmLoginAuth.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "")
FrmLoginAuth.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "")
End Select
End Select
End Sub
@@ -138,7 +138,7 @@
Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then
If Tag.ToString.StartsWith("链接-") OrElse Tag.ToString.StartsWith("启动-") Then
If Tag.ToString.StartsWithF("链接-") OrElse Tag.ToString.StartsWithF("启动-") Then
Hint("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!")
End If
End If
@@ -1,7 +1,7 @@
Public Class MyIconButton
'声明
Public Event Click(sender As Object, e As EventArgs) '自定义事件
'自定义事件
Public Event Click(sender As Object, e As EventArgs)
'自定义属性
@@ -210,7 +210,7 @@
If Not IsNothing(PathLogo) Then Children.Remove(PathLogo)
'添加新 Logo
If Not _Logo = "" Then
If _Logo.ToLower.StartsWith("http") Then
If _Logo.StartsWithF("http", True) Then
'网络图片
PathLogo = New Image With {
.Tag = Me,
@@ -220,7 +220,7 @@
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False}
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear)
ElseIf _Logo.ToLower.EndsWith(".png") OrElse _Logo.ToLower.EndsWith(".jpg") Then
ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) Then
'位图
Dim Bitmap = New MyBitmap(_Logo)
PathLogo = New Canvas With {
@@ -328,7 +328,7 @@
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4))
If Not IsNothing(PathLogo) Then
If _Logo.EndsWith(".png") Then
If _Logo.EndsWithF(".png", True) Then
PathLogo.Margin = New Thickness(4, 5, 3, 5)
Else
PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8)
@@ -58,11 +58,12 @@
Interop.ComponentDispatcher.PopModal()
'动画
AniStart({
AaCode(Sub()
If WaitingMyMsgBox.Count = 0 Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaCode(
Sub()
If Not WaitingMyMsgBox.Any() Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaOpacity(Me, -Opacity, 80, 20),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
@@ -63,11 +63,12 @@
Interop.ComponentDispatcher.PopModal()
'动画
AniStart({
AaCode(Sub()
If WaitingMyMsgBox.Count = 0 Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaCode(
Sub()
If Not WaitingMyMsgBox.Any() Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaOpacity(Me, -Opacity, 80, 20),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
@@ -56,11 +56,12 @@
Interop.ComponentDispatcher.PopModal()
'动画
AniStart({
AaCode(Sub()
If WaitingMyMsgBox.Count = 0 Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaCode(
Sub()
If Not WaitingMyMsgBox.Any() Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaOpacity(Me, -Opacity, 80, 20),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
@@ -89,7 +89,7 @@
If PanAlways IsNot Nothing Then PanAlways.Visibility = Visibility.Collapsed
'初次运行加载器
If PageLoaderAutoRun Then
If PageLoader.GetType.Name.StartsWith("LoaderTask") Then
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Nothing, PageLoaderInputInvoke))
Else
Dim Input = Nothing
@@ -107,7 +107,7 @@
'重试
Public Sub PageLoaderRestart(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = True) '由外部调用的重试
If Not PageLoaderAutoRun Then Exit Sub
If PageLoader.GetType.Name.StartsWith("LoaderTask") Then
If PageLoader.GetType.Name.StartsWithF("LoaderTask") Then
PageLoader.Start(CType(PageLoader, Object).StartGetInput(Input, PageLoaderInputInvoke), IsForceRestart:=IsForceRestart)
Else
If Input Is Nothing AndAlso PageLoaderInputInvoke IsNot Nothing Then Input = PageLoaderInputInvoke()
@@ -8,10 +8,12 @@
Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Exit Sub
Dim SourceType = e.Source.GetType
If Content.TemplatedParent Is Nothing AndAlso
((GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType)) Then
If Content.TemplatedParent Is Nothing AndAlso (
(GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse
TypeOf e.Source Is CheckBox
) Then
'如果当前是在对有滚动条的下拉框或文本框执行,则不接管操作
Exit Sub
End If
+85 -189
View File
@@ -10,6 +10,18 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 321 Then 'Release 2.7.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
BugCount += 1
End If
If LastVersion < 319 Then 'Release 2.7.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持滑动鼠标快速选中、取消选中多个 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 MC 24w14a+ 的 Bug"))
FeatureCount += 10
BugCount += 10
End If
If LastVersion < 317 Then 'Release 2.6.15
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
FeatureCount += 2
@@ -82,64 +94,32 @@ Public Class FormMain
FeatureCount += 35
BugCount += 36
End If
If LastVersion < 281 Then 'Release 2.4.9
If LastVersion = 279 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复进入 Mod、整合包下载页时报错的 Bug"))
FeatureCount += 1
BugCount += 5
End If
If LastVersion < 279 Then 'Release 2.4.8
FeatureCount += 1
BugCount += 10
End If
If LastVersion < 276 Then 'Release 2.4.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "增加 在游戏启动前执行命令 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化界面动画,修改部分配色"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文搜索"))
FeatureCount += 25
BugCount += 56
End If
If LastVersion < 272 Then 'Release 2.4.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修改部分配色,让整体边框变得更淡"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法从下载页安装最新 MC 版本的整合包的 Bug"))
If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
FeatureCount += 13
BugCount += 23
End If
If LastVersion < 268 Then 'Release 2.4.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "游戏崩溃的弹窗添加了直接查看日志的选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在更多分类下添加了新功能投票选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "自动安装时支持检查 OptiFine 对 Forge 的具体版本需求"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化自动 Java 选择的准确度"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文名的显示"))
FeatureCount += 14
BugCount += 33
End If
If LastVersion < 265 Then 'Release 2.3.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分情况下无法启动路径带有中文的游戏的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复多个可能导致 OptiFine、Forge 安装失败的 Bug"))
FeatureCount += 13
BugCount += 9
End If
If LastVersion < 260 Then 'Release 2.3.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题"))
FeatureCount += 22
BugCount += 4
End If
If LastVersion < 257 Then 'Release 2.3.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复下载部分 Mod、整合包的 Bug"))
FeatureCount += 4
BugCount += 4
End If
#Else
'5: FEAT+
'4: IMP+ FEAT*
'3:BUG+ IMP* FEAT-
'2:BUG* IMP-
'1:BUG-
If LastVersion < 322 Then 'Snapshot 2.7.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug"))
FeatureCount += 18
BugCount += 18
End If
If LastVersion < 320 Then 'Snapshot 2.7.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
BugCount += 1
End If
If LastVersion < 318 Then 'Snapshot 2.7.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持滑动鼠标快速选中、取消选中多个 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 MC 24w14a+ 的 Bug"))
FeatureCount += 10
BugCount += 10
End If
If LastVersion < 316 Then 'Snapshot 2.6.15
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
FeatureCount += 2
@@ -251,116 +231,29 @@ Public Class FormMain
FeatureCount += 5
BugCount += 5
End If
If LastVersion < 282 Then 'Snapshot 2.4.9
FeatureCount += 1
BugCount += 5
If LastVersion = 280 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复进入 Mod、整合包下载页时报错的 Bug"))
End If
If LastVersion < 280 Then 'Snapshot 2.4.8
FeatureCount += 1
BugCount += 10
End If
If LastVersion < 278 Then 'Snapshot 2.4.7
If LastVersion = 277 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复设置背景音乐可能导致无法启动 PCL 的 Bug"))
BugCount += 2
End If
If LastVersion < 277 Then 'Snapshot 2.4.6
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在百宝箱添加了清理 MC 日志、崩溃报告的按钮"))
FeatureCount += 8
BugCount += 21
End If
If LastVersion < 275 Then 'Snapshot 2.4.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "增加 在游戏启动前执行命令 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化界面动画,修改部分配色"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文搜索"))
FeatureCount += 17
BugCount += 35
End If
If LastVersion < 273 Then 'Snapshot 2.4.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在版本设置页导出启动脚本、打开存档文件夹等"))
If LastVersion = 271 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法同时开启多个 Minecraft 客户端的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法从下载页安装最新 MC 版本的整合包的 Bug"))
FeatureCount += 7
BugCount += 8
End If
If LastVersion < 271 Then 'Snapshot 2.4.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 Mod、整合包下载的版本检查与显示"))
If LastVersion <= 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 LiteLoader 的 Bug"))
FeatureCount += 6
BugCount += 15
End If
If LastVersion < 269 Then 'Snapshot 2.4.2
If LastVersion = 267 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法下载 CurseForge 整合包的 Bug"))
FeatureCount += 2
BugCount += 3
End If
If LastVersion < 267 Then 'Snapshot 2.4.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "暂时关闭了联机功能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "自动安装时支持检查 OptiFine 对 Forge 的具体版本需求"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化自动 Java 选择的准确度"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 Mod 中文名的显示"))
FeatureCount += 12
BugCount += 22
End If
If LastVersion < 266 Then 'Snapshot 2.4.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "游戏崩溃的弹窗添加了直接查看日志的选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在更多分类下添加了新功能投票选项"))
FeatureCount += 3
BugCount += 11
End If
If LastVersion < 264 Then 'Snapshot 2.3.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法启动部分 Forge 版本的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复多个可能导致 OptiFine、Forge 安装失败的 Bug"))
FeatureCount += 2
BugCount += 3
End If
If LastVersion < 263 Then 'Snapshot 2.3.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分情况下无法启动路径带有中文的游戏的 Bug"))
FeatureCount += 11
BugCount += 5
End If
If LastVersion < 262 Then 'Snapshot 2.3.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "修复无法使用 Mod、整合包搜索功能的 Bug"))
BugCount += 1
End If
If LastVersion < 261 Then 'Snapshot 2.3.2
FeatureCount += 8
BugCount += 4
End If
If LastVersion < 259 Then 'Snapshot 2.3.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "解决了联机人数 ≥3 人时出现的频繁掉线或突发高延迟的问题"))
FeatureCount += 14
End If
If LastVersion < 258 Then 'Snapshot 2.3.0
FeatureCount += 4
BugCount += 4
End If
#End If
'整理更新日志文本
Dim ContentList As New List(Of String)
Dim SortedFeatures = Sort(FeatureList, Function(Left As KeyValuePair(Of Integer, String), Right As KeyValuePair(Of Integer, String)) As Boolean
Return Left.Key > Right.Key
End Function)
If SortedFeatures.Count = 0 AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then
ContentList.Add("龙猫忘记写更新日志啦!可以去提醒他一下……")
End If
Dim SortedFeatures = Sort(FeatureList, Function(Left, Right) Left.Key > Right.Key)
If Not SortedFeatures.Any() AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then ContentList.Add("龙猫忘记写更新日志啦!可以去提醒他一下……")
For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项
ContentList.Add(SortedFeatures(i).Value)
Next
If SortedFeatures.Count > 10 Then FeatureCount += SortedFeatures.Count - 10
If FeatureCount > 0 OrElse BugCount > 0 Then
ContentList.Add(If(FeatureCount > 0, "其他 " & FeatureCount & " 项小调整与修改", "") &
If(FeatureCount > 0 AndAlso BugCount > 0, ",", "") &
If(BugCount > 0, "修复了 " & BugCount & " 个 Bug", "") &
",详见完整更新日志")
If(FeatureCount > 0 AndAlso BugCount > 0, ",", "") &
If(BugCount > 0, "修复了 " & BugCount & " 个 Bug", "") &
",详见完整更新日志")
End If
Dim Content As String = "· " & Join(ContentList, vbCrLf & "· ")
'输出更新日志
RunInNewThread(Sub()
If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
OpenWebsite("https://afdian.net/a/LTCat?tab=feed")
End If
End Sub, "UpdateLog Output")
RunInNewThread(
Sub()
If MyMsgBox(Content, "PCL 已更新至 " & VersionDisplayName, "确定", "完整更新日志") = 2 Then
OpenWebsite("https://afdian.net/a/LTCat?tab=feed")
End If
End Sub, "UpdateLog Output")
End Sub
'窗口加载
@@ -512,7 +405,6 @@ Public Class FormMain
Log("[Start] 第三阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms")
End Sub
'Private Declare Function ChangeWindowMessageFilter Lib "user32.dll" (message As Integer, action As Integer) As Boolean
'根据打开次数触发的事件
Private Sub RunCountSub()
Setup.Set("SystemCount", Setup.Get("SystemCount") + 1)
@@ -550,6 +442,8 @@ Public Class FormMain
Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
End If
#End If
'被移除的窗口设置选项
If Setup.Get("LaunchArgumentWindowType") = 5 Then Setup.Set("LaunchArgumentWindowType", 1)
'修改主题设置项名称
If LowerVersionCode <= 207 Then
Dim UnlockedTheme As New List(Of String) From {"2"}
@@ -773,7 +667,7 @@ Public Class FormMain
If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack()
End Sub
Private Sub TriggerPageBack()
If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall Then
If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall AndAlso FrmDownloadInstall.IsInSelectPage Then
FrmDownloadInstall.ExitSelectPage()
Else
PageBack()
@@ -810,7 +704,7 @@ Public Class FormMain
Try
Dim Str As String = e.Data.GetData(DataFormats.Text)
Log("[System] 接受文本拖拽:" & Str)
If Str.StartsWith("authlib-injector:yggdrasil-server:") Then
If Str.StartsWithF("authlib-injector:yggdrasil-server:") Then
'Authlib 拖拽
e.Handled = True
Dim AuthlibServer As String = Net.WebUtility.UrlDecode(Str.Substring("authlib-injector:yggdrasil-server:".Length))
@@ -853,7 +747,7 @@ Public Class FormMain
'正在主页,需要刷新左边栏
FrmLaunchLeft.RefreshPage(True, False)
End If
ElseIf Str.StartsWith("file:///") Then
ElseIf Str.StartsWithF("file:///") Then
'文件拖拽(例如从浏览器下载窗口拖入)
Dim FilePath = Net.WebUtility.UrlDecode(Str).Substring("file:///".Length).Replace("/", "\")
e.Handled = True
@@ -881,7 +775,7 @@ Public Class FormMain
RunInNewThread(
Sub()
Dim FilePath As String = FilePathList.First
Log("[System] 接受文件拖拽:" & FilePath & If(FilePathList.Count > 0, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer)
Log("[System] 接受文件拖拽:" & FilePath & If(FilePathList.Any, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer)
'基础检查
If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
Hint("请拖入一个文件,而非文件夹!", HintType.Critical)
@@ -1296,8 +1190,11 @@ Install:
''' 通过点击返回按钮或手动触发返回来改变页面。
''' </summary>
Public Sub PageBack() Handles BtnTitleInner.Click
If PageStack.Count = 0 Then Exit Sub
PageChangeActual(PageStack(0))
If PageStack.Any() Then
PageChangeActual(PageStack(0))
Else
PageChange(PageType.Launch)
End If
End Sub
'实际处理页面切换
@@ -1316,27 +1213,13 @@ Install:
PageChangeExit()
Else
'即将切换到一个子页面
If PageStack.Count = 0 Then
'主页面 → 子页面,进入
PanTitleInner.Visibility = Visibility.Visible
PanTitleMain.IsHitTestVisible = False
PanTitleInner.IsHitTestVisible = True
PageNameRefresh(Stack)
AniStart({
AaOpacity(PanTitleMain, -PanTitleMain.Opacity, 150),
AaX(PanTitleMain, 12 - PanTitleMain.Margin.Left, 150,, New AniEaseInFluent(AniEasePower.Weak)),
AaOpacity(PanTitleInner, 1 - PanTitleInner.Opacity, 150, 200),
AaX(PanTitleInner, -PanTitleInner.Margin.Left, 350, 200, New AniEaseOutBack),
AaCode(Sub() PanTitleMain.Visibility = Visibility.Collapsed,, True)
}, "FrmMain Titlebar FirstLayer")
PageStack.Insert(0, PageCurrent)
Else
If PageStack.Any Then
'子页面 → 另一个子页面,更新
AniStart({
AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
AaCode(Sub() LabTitleInner.Text = PageName,, True),
AaOpacity(LabTitleInner, 1, 150, 30)
}, "FrmMain Titlebar SubLayer")
AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
AaCode(Sub() LabTitleInner.Text = PageName,, True),
AaOpacity(LabTitleInner, 1, 150, 30)
}, "FrmMain Titlebar SubLayer")
If PageStack.Contains(Stack) Then
'返回到更上层的子页面
Do While PageStack.Contains(Stack)
@@ -1346,6 +1229,20 @@ Install:
'进入更深层的子页面
PageStack.Insert(0, PageCurrent)
End If
Else
'主页面 → 子页面,进入
PanTitleInner.Visibility = Visibility.Visible
PanTitleMain.IsHitTestVisible = False
PanTitleInner.IsHitTestVisible = True
PageNameRefresh(Stack)
AniStart({
AaOpacity(PanTitleMain, -PanTitleMain.Opacity, 150),
AaX(PanTitleMain, 12 - PanTitleMain.Margin.Left, 150,, New AniEaseInFluent(AniEasePower.Weak)),
AaOpacity(PanTitleInner, 1 - PanTitleInner.Opacity, 150, 200),
AaX(PanTitleInner, -PanTitleInner.Margin.Left, 350, 200, New AniEaseOutBack),
AaCode(Sub() PanTitleMain.Visibility = Visibility.Collapsed,, True)
}, "FrmMain Titlebar FirstLayer")
PageStack.Insert(0, PageCurrent)
End If
End If
#End Region
@@ -1452,9 +1349,7 @@ Install:
''' 退出子界面。
''' </summary>
Private Sub PageChangeExit()
If PageStack.Count = 0 Then
'主页面 → 主页面,无事发生
Else
If PageStack.Any Then
'子页面 → 主页面,退出
PanTitleMain.Visibility = Visibility.Visible
PanTitleMain.IsHitTestVisible = True
@@ -1467,6 +1362,8 @@ Install:
AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True)
}, "FrmMain Titlebar FirstLayer")
PageStack.Clear()
Else
'主页面 → 主页面,无事发生
End If
End Sub
@@ -1477,23 +1374,22 @@ Install:
End Sub
Private Sub PanMainLeft_Resize(NewWidth As Double)
Dim Delta As Double = NewWidth - RectLeftBackground.Width
If Math.Abs(Delta) < 0.1 Then Exit Sub
If AniControlEnabled = 0 Then
If Math.Abs(Delta) > 0.1 AndAlso AniControlEnabled = 0 Then
If PanMain.Opacity < 0.1 Then PanMainLeft.IsHitTestVisible = False '避免左边栏指向背景未能完美覆盖左边栏
If NewWidth > 0 Then
'宽度足够,显示
AniStart({
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
}, "FrmMain LeftChange", True)
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
}, "FrmMain LeftChange", True)
Else
'宽度不足,隐藏
AniStart({
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
}, "FrmMain LeftChange", True)
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
}, "FrmMain LeftChange", True)
End If
Else
RectLeftBackground.Width = NewWidth
@@ -869,7 +869,7 @@ NextAni:
Loop
'如果当前动画组都执行完毕则删除
If Entry.Data.Count = 0 Then
If Not Entry.Data.Any() Then
'为了避免新添加的动画影响顺序,不能 RemoveAt(i)
'为了允许动画在执行中添加同名动画组,不能按名字移除
For Current = 0 To AniGroups.Count - 1
+172 -158
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.6.15" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.15." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.7.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.7.2." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 317 'Release
Public Const VersionCode As Integer = 321 'Release
#Else
Public Const VersionCode As Integer = 316 'Snapshot
Public Const VersionCode As Integer = 322 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -58,7 +58,7 @@ Public Module ModBase
''' <summary>
''' 程序的打开计时。
''' </summary>
Public ApplicationStartTick As Long
Public ApplicationStartTick As Long = GetTimeTick()
''' <summary>
''' 程序打开时的时间。
''' </summary>
@@ -76,6 +76,10 @@ Public Module ModBase
''' </summary>
Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem
''' <summary>
''' 是否使用 GBK 编码。
''' </summary>
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
''' <summary>
''' 操作系统版本。Win10 为 10.0。
''' </summary>
Public OsVersion As Version = Environment.OSVersion.Version
@@ -110,6 +114,14 @@ Public Module ModBase
''' </summary>
Public Const IconButtonDelete As String = "M520.192 0C408.43 0 317.44 82.87 313.563 186.734H52.736c-29.038 0-52.663 21.943-52.663 49.079s23.625 49.152 52.663 49.152h58.075v550.473c0 103.35 75.118 187.757 167.717 187.757h472.43c92.599 0 167.716-83.894 167.716-187.757V285.477h52.59c29.038 0 52.59-21.943 52.663-49.08-0.073-27.135-23.625-49.151-52.663-49.151H726.235C723.237 83.017 631.955 0 520.192 0zM404.846 177.957c3.803-50.03 50.176-89.015 107.447-89.015 57.197 0 103.57 38.985 106.788 89.015H404.92zM284.379 933.669c-33.353 0-69.997-39.351-69.997-95.525v-549.01H833.39v549.522c0 56.247-36.645 95.525-69.998 95.525H284.379v-0.512z M357.23 800.695a48.274 48.274 0 0 0 47.616-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.69 49.006V751.69c0 27.282 20.846 49.006 47.617 49.006z m166.62 0a48.274 48.274 0 0 0 47.688-49.006V471.7a48.274 48.274 0 0 0-47.689-49.08 48.274 48.274 0 0 0-47.543 49.006V751.69c0 27.282 21.431 49.006 47.543 49.006z m142.92 0a48.274 48.274 0 0 0 47.543-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.616 49.006V751.69c0 27.282 20.773 49.006 47.543 49.006z"
''' <summary>
''' 图标按钮,禁止,1x
''' </summary>
Public Const IconButtonStop As String = "M508 990.4c-261.6 0-474.4-212-474.4-474.4S246.4 41.6 508 41.6s474.4 212 474.4 474.4S769.6 990.4 508 990.4zM508 136.8c-209.6 0-379.2 169.6-379.2 379.2 0 209.6 169.6 379.2 379.2 379.2s379.2-169.6 379.2-379.2C887.2 306.4 717.6 136.8 508 136.8zM697.6 563.2 318.4 563.2c-26.4 0-47.2-21.6-47.2-47.2 0-26.4 21.6-47.2 47.2-47.2l379.2 0c26.4 0 47.2 21.6 47.2 47.2C744.8 542.4 724 563.2 697.6 563.2z"
''' <summary>
''' 图标按钮,勾选,1x
''' </summary>
Public Const IconButtonCheck As String = "M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z"
''' <summary>
''' 图标按钮,笔,1x
''' </summary>
Public Const IconButtonEdit As String = "M732.64 64.32C688.576 21.216 613.696 21.216 569.6 64.32L120.128 499.52c-17.6 12.896-26.432 30.144-30.848 51.68L32 870.048c0 25.856 8.8 56 26.432 73.248 17.632 17.216 17.632 48.704 88.64 48.704h13.248l326.08-56c22.016-4.32 39.68-12.928 52.864-30.176l449.472-435.2c22.048-21.536 35.264-47.36 35.264-77.536 0-30.176-13.216-56-35.264-77.568l-256.096-251.2zM139.712 903.776l56-326.912 311.04-295.136 267.104 269.44-310.976 295.168-323.168 57.44zM844.576 467.84l-273.984-260.672 61.856-59.84c8.832-8.512 26.528-8.512 39.776 0l234.24 226.496c4.384 4.288 8.832 12.8 8.832 17.088s-4.416 8.544-8.864 12.8l-61.856 64.128z"
@@ -471,11 +483,11 @@ Public Module ModBase
Const Digits As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/+="
'零与负数的处理
If String.IsNullOrEmpty(Input) Then Return "0"
Dim IsNegative As Boolean = Input.StartsWith("-")
Dim IsNegative As Boolean = Input.StartsWithF("-")
If IsNegative Then Input = Input.TrimStart("-")
'转换为十进制
Dim RealNum As Long = 0, Scale As Long = 1
For Each Digit In Input.Reverse.Select(Function(l) Digits.IndexOf(l))
For Each Digit In Input.Reverse.Select(Function(l) Digits.IndexOfF(l))
RealNum += Digit * Scale
Scale *= FromRadix
Next
@@ -614,82 +626,53 @@ Public Module ModBase
End Sub
'Ini 文件
Private Class IniCache
Public FileContent As String = ""
Public KVCache As New Dictionary(Of String, String)
End Class
Private ReadOnly IniCacheList As New Dictionary(Of String, IniCache)
Private ReadOnly IniCache As New Dictionary(Of String, Dictionary(Of String, String))
''' <summary>
''' 清除某 Ini 文件的运行时缓存。
''' 清除某 ini 文件的运行时缓存。
''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
Public Sub IniClearCache(FileName As String)
'还原文件路径
If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini"
'检索缓存
If IniCacheList.ContainsKey(FileName) Then IniCacheList.Remove(FileName)
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
If IniCache.ContainsKey(FileName) Then IniCache.Remove(FileName)
End Sub
''' <summary>
''' 获取 Ini 文件内容,这可能会使用到缓存。
''' 获取 ini 文件缓存。如果没有,则新读取 ini 文件内容。
''' 在文件不存在或读取失败时返回 Nothing。
''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
Private Function IniGetContent(FileName As String) As IniCache
Private Function IniGetContent(FileName As String) As Dictionary(Of String, String)
Try
'还原文件路径
If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini"
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
'检索缓存
If IniCacheList.ContainsKey(FileName) Then
'返回缓存中的信息
Dim Cache As New IniCache
IniCacheList.TryGetValue(FileName, Cache)
Return Cache '防止ByRef导致缓存变更
Else
Dim Ini As IniCache
If File.Exists(FileName) Then
'返回文件信息并且记入缓存
Dim Cache As String = (vbCrLf & ReadFile(FileName) & vbCrLf).Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).Replace(vbCrLf & vbCrLf, vbCrLf).Replace(vbNullChar, "")
Ini = New IniCache With {.FileContent = Cache}
Else
'返回空文件信息
Ini = New IniCache With {.FileContent = ""}
End If
If Not IniCacheList.ContainsKey(FileName) Then IniCacheList.Add(FileName, Ini) '避免多线程异步执行此方法时造成多次添加项
Return Ini
End If
If IniCache.ContainsKey(FileName) Then Return IniCache(FileName)
'读取文件
If Not File.Exists(FileName) Then Return Nothing
Dim Ini As New Dictionary(Of String, String)
For Each Line In ReadFile(FileName).Split(vbCrLf.ToArray(), StringSplitOptions.RemoveEmptyEntries)
Dim Index As Integer = Line.IndexOfF(":")
If Index > 0 Then Ini(Line.Substring(0, Index)) = Line.Substring(Index + 1) '可能会有重复键,见 #3616
Next
IniCache(FileName) = Ini
Return Ini
Catch ex As Exception
Log(ex, "读取文件失败:" & FileName, LogLevel.Hint)
Return New IniCache With {.FileContent = ""}
Log(ex, $"生成 ini 文件缓存失败({FileName})", LogLevel.Hint)
Return Nothing
End Try
End Function
''' <summary>
''' 读取Ini文件,这可能会使用到缓存。
''' 读取 ini 文件。这可能会使用到缓存。
''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
''' <param name="Key">键。</param>
''' <param name="DefaultValue">没有找到键时返回的默认值。</param>
Public Function ReadIni(FileName As String, Key As String, Optional DefaultValue As String = "") As String
Try
'获取目前文件
Dim NowIni As IniCache = IniGetContent(FileName)
If IsNothing(NowIni) Then Return DefaultValue
'使用缓存
If NowIni.KVCache.ContainsKey(Key) Then Return If(NowIni.KVCache(Key), DefaultValue)
'没有缓存,读取文件
If NowIni.FileContent.Contains(vbCrLf & Key & ":") Then
Dim Ret As String = Mid(NowIni.FileContent, NowIni.FileContent.IndexOf(vbCrLf & Key & ":") + 3)
Ret = If(Ret.Contains(vbCrLf), Mid(Ret, 1, Ret.IndexOf(vbCrLf)), Ret).Replace(Key & ":", "")
NowIni.KVCache.Add(Key, If(Ret = vbLf, "", Ret))
Return If(Ret = vbLf, "", Ret)
Else
Return DefaultValue
End If
Catch ex As Exception
'读取失败
Return DefaultValue
End Try
Dim Content = IniGetContent(FileName)
If Content Is Nothing OrElse Not Content.ContainsKey(Key) Then Return DefaultValue
Return Content(Key)
End Function
''' <summary>
''' 写入ini文件,这会更新缓存。
''' 写入 ini 文件,这会更新缓存。
''' </summary>
''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
''' <param name="Key">键。</param>
@@ -697,47 +680,41 @@ Public Module ModBase
''' <remarks></remarks>
Public Sub WriteIni(FileName As String, Key As String, Value As String)
Try
'还原文件路径
If Not FileName.Contains(":\") Then FileName = Path & "PCL\" & FileName & ".ini"
If IsNothing(Value) Then Value = ""
Value = Value.Replace(vbCrLf, "")
'创建文件夹
If Not Directory.Exists(GetPathFromFullPath(FileName)) Then Directory.CreateDirectory(GetPathFromFullPath(FileName))
'预处理
Key = Key.Replace(vbCr, "").Replace(vbLf, "").Replace(":", "")
Value = Value.Replace(vbCr, "").Replace(vbLf, "") '允许 Value 中包含冒号
'获取目前文件
Dim NowFile As String = IniGetContent(FileName).FileContent
If Not NowFile.EndsWith(vbCrLf) Then NowFile += vbCrLf
'如果值一样就不处理
If NowFile.Contains(vbCrLf & Key & ":" & Value & vbCrLf) Then Exit Sub
'处理文件
Dim FindResult As String = ReadIni(FileName, Key)
If FindResult = "" AndAlso Not NowFile.Contains(vbCrLf & Key & ":") Then
'不存在这个键
NowFile = NowFile & vbCrLf & Key & ":" & Value & vbCrLf
Else
'存在这个键
NowFile = NowFile.Replace(vbCrLf & Key & ":" & FindResult & vbCrLf, vbCrLf & Key & ":" & Value & vbCrLf)
End If
WriteFile(FileName, NowFile)
'刷新目前缓存
IniCacheList(FileName).FileContent = NowFile
IniCacheList(FileName).KVCache.Remove(Key)
IniCacheList(FileName).KVCache.Add(Key, Value)
Dim Content As Dictionary(Of String, String) = IniGetContent(FileName)
If Content Is Nothing Then Content = New Dictionary(Of String, String)
If Content.ContainsKey(Key) AndAlso Content(Key) = Value Then Exit Sub '如果值一样就不处理
'更新缓存
Content(Key) = Value
'写入文件
Dim FileContent As New StringBuilder
For Each Pair In Content
FileContent.Append(Pair.Key)
FileContent.Append(":")
FileContent.Append(Pair.Value)
FileContent.Append(vbCrLf)
Next
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
WriteFile(FileName, FileContent.ToString)
Catch ex As Exception
Log(ex, "写入文件失败:" & FileName & "/" & Key & ": " & Value)
Log(ex, $"写入文件失败({FileName} -> {Key}:{Value})")
End Try
End Sub
'路径处理
''' <summary>
''' 从文件路径或者 Url 获取不包含文件名的路径,或获取文件夹的父文件夹路径。不包含路径将会抛出异常。
''' 从文件路径或者 Url 获取不包含文件名的路径,或获取文件夹的父文件夹路径。
''' 取决于原路径格式,路径以 / 或 \ 结尾。
''' 不包含路径将会抛出异常。
''' </summary>
Public Function GetPathFromFullPath(FilePath As String) As String
If Not (FilePath.Contains("\") OrElse FilePath.Contains("/")) Then Throw New Exception("不包含路径:" & FilePath)
If FilePath.EndsWith("\") OrElse FilePath.EndsWith("/") Then
If FilePath.EndsWithF("\") OrElse FilePath.EndsWithF("/") Then
'是文件夹路径
Dim IsRight As Boolean = FilePath.EndsWith("\")
Dim IsRight As Boolean = FilePath.EndsWithF("\")
FilePath = Left(FilePath, Len(FilePath) - 1)
GetPathFromFullPath = Left(FilePath, FilePath.LastIndexOfAny({"\", "/"})) & If(IsRight, "\", "/")
If GetPathFromFullPath = "" Then Throw New Exception("不包含路径:" & FilePath)
@@ -752,11 +729,13 @@ Public Module ModBase
''' </summary>
Public Function GetFileNameFromPath(FilePath As String) As String
FilePath = FilePath.Replace("/", "\")
If FilePath.EndsWith("\") Then Throw New Exception("不包含文件名:" & FilePath)
Dim FileName As String = FilePath.Split("\").Last.Split("?").First '去掉网络参数后的 ?
If FileName.Length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
If FileName.Length > 250 Then Throw New PathTooLongException("文件名过长:" & FilePath)
Return FileName
If FilePath.EndsWithF("\") Then Throw New Exception("不包含文件名:" & FilePath)
If FilePath.Contains("?") Then FilePath = FilePath.Substring(0, FilePath.IndexOfF("?")) '去掉网络参数后的 ?
If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
Dim length As Integer = FilePath.Length
If length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
If length > 250 Then Throw New PathTooLongException("文件名过长:" & FilePath)
Return FilePath
End Function
''' <summary>
''' 从文件路径或者 Url 获取不包含路径与扩展名的文件名。不包含文件名将会抛出异常。
@@ -764,7 +743,7 @@ Public Module ModBase
Public Function GetFileNameWithoutExtentionFromPath(FilePath As String) As String
Dim Name As String = GetFileNameFromPath(FilePath)
If Name.Contains(".") Then
Return Name.Substring(0, Name.LastIndexOf("."))
Return Name.Substring(0, Name.LastIndexOfF("."))
Else
Return Name
End If
@@ -773,8 +752,8 @@ Public Module ModBase
''' 从文件夹路径获取文件夹名。
''' </summary>
Public Function GetFolderNameFromPath(FolderPath As String) As String
If FolderPath.EndsWith(":\") OrElse FolderPath.EndsWith(":\\") Then Return FolderPath.Substring(0, 1)
If FolderPath.EndsWith("\") OrElse FolderPath.EndsWith("/") Then FolderPath = Left(FolderPath, FolderPath.Length - 1)
If FolderPath.EndsWithF(":\") OrElse FolderPath.EndsWithF(":\\") Then Return FolderPath.Substring(0, 1)
If FolderPath.EndsWithF("\") OrElse FolderPath.EndsWithF("/") Then FolderPath = Left(FolderPath, FolderPath.Length - 1)
Return GetFileNameFromPath(FolderPath)
End Function
@@ -1027,7 +1006,7 @@ Public Module ModBase
Public Function SelectFolder(Optional Title As String = "选择文件夹") As String
Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True}
folderDialog.ShowDialog()
SelectFolder = If(String.IsNullOrEmpty(folderDialog.SelectedPath), "", folderDialog.SelectedPath & If(folderDialog.SelectedPath.EndsWith("\"), "", "\"))
SelectFolder = If(String.IsNullOrEmpty(folderDialog.SelectedPath), "", folderDialog.SelectedPath & If(folderDialog.SelectedPath.EndsWithF("\"), "", "\"))
Log("[UI] 选择文件夹返回:" & SelectFolder)
End Function
@@ -1038,8 +1017,8 @@ Public Module ModBase
Public Function CheckPermission(Path As String) As Boolean
Try
If Path = "" Then Return False
If Not Path.EndsWith("\") Then Path += "\"
If Path.EndsWith(":\System Volume Information\") OrElse Path.EndsWith(":\$RECYCLE.BIN\") Then Return False
If Not Path.EndsWithF("\") Then Path += "\"
If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False
If Not Directory.Exists(Path) Then Return False
Dim FileName As String = "CheckPermission" & GetUuid()
If File.Exists(Path & FileName) Then File.Delete(Path & FileName)
@@ -1056,7 +1035,7 @@ Public Module ModBase
''' </summary>
Public Sub CheckPermissionWithException(Path As String)
If String.IsNullOrWhiteSpace(Path) Then Throw New ArgumentNullException("文件夹名不能为空!")
If Not Path.EndsWith("\") Then Path += "\"
If Not Path.EndsWithF("\") Then Path += "\"
If Not Directory.Exists(Path) Then Throw New DirectoryNotFoundException("文件夹不存在!")
If File.Exists(Path & "CheckPermission") Then File.Delete(Path & "CheckPermission")
File.Create(Path & "CheckPermission").Dispose()
@@ -1240,43 +1219,35 @@ Re:
''' <summary>
''' 尝试根据后缀名判断文件种类并解压文件,支持 gz 与 zip,会尝试将 jar 以 zip 方式解压。
''' 会尝试创建,但不会清空目标文件夹。
''' 成功返回 True,并非压缩文件或失败返回 False。
''' </summary>
Public Function ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) As Boolean
Try
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWith(".gz") Then
'以 gz 方式解压
Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
Dim data As Integer = stream.ReadByte()
While data <> -1
decompressedFile.WriteByte(data)
data = stream.ReadByte()
End While
decompressedFile.Close()
stream.Close()
Return True
Else
'以 zip 方式解压
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
For Each Entry As ZipArchiveEntry In Archive.Entries
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If DestinationPath.EndsWith("\") OrElse DestinationPath.EndsWith("/") Then
Continue For '不创建空文件夹
Else
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
Entry.ExtractToFile(DestinationPath, True)
End If
Next
End Using
Return True
End If
Catch ex As Exception
Log(ex, "尝试解压文件失败")
Return False
End Try
End Function
Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing)
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWithF(".gz", True) Then
'以 gz 方式解压
Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
Dim data As Integer = stream.ReadByte()
While data <> -1
decompressedFile.WriteByte(data)
data = stream.ReadByte()
End While
decompressedFile.Close()
stream.Close()
Else
'以 zip 方式解压
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
For Each Entry As ZipArchiveEntry In Archive.Entries
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
Continue For '不创建空文件夹
Else
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
Entry.ExtractToFile(DestinationPath, True)
End If
Next
End Using
End If
End Sub
''' <summary>
''' 删除文件夹,返回删除的文件个数。通过参数选择是否抛出异常。
@@ -1318,9 +1289,9 @@ Re:
''' </summary>
Public Sub CopyDirectory(FromPath As String, ToPath As String)
FromPath = FromPath.Replace("/", "\")
If Not FromPath.EndsWith("\") Then FromPath &= "\"
If Not FromPath.EndsWithF("\") Then FromPath &= "\"
ToPath = ToPath.Replace("/", "\")
If Not ToPath.EndsWith("\") Then ToPath &= "\"
If Not ToPath.EndsWithF("\") Then ToPath &= "\"
For Each File In EnumerateFiles(FromPath)
CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
Next
@@ -1367,7 +1338,7 @@ Re:
Loop
DescList = DescList.Distinct.ToList
Dim Desc As String = Join(DescList, vbCrLf & "→ ")
Dim Stack As String = If(StackList.Count > 0, vbCrLf & Join(StackList, vbCrLf), "")
Dim Stack As String = If(StackList.Any, vbCrLf & Join(StackList, vbCrLf), "")
'常见错误(记得同时修改下面的)
Dim CommonReason As String = Nothing
@@ -1566,6 +1537,48 @@ Re:
Next
Return tmp.ToString()
End Function
''' <summary>
''' 检查字符串中的字符是否均为 ASCII 字符。
''' </summary>
<Extension> Public Function IsASCII(Input As String) As Boolean
Return Input.All(Function(c) AscW(c) < 128)
End Function
''' <summary>
''' 高速的 StartsWith。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function StartsWithF(Str As String, Prefix As String, Optional IgnoreCase As Boolean = False) As Boolean
Return Str.StartsWith(Prefix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 高速的 EndsWith。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function EndsWithF(Str As String, Suffix As String, Optional IgnoreCase As Boolean = False) As Boolean
Return Str.EndsWith(Suffix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 支持可变大小写判断的 Contains。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function ContainsF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Boolean
Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) >= 0
End Function
''' <summary>
''' 高速的 IndexOf。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function IndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 高速的 LastIndexOf。
''' </summary>
<Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
Public Function LastIndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
Return Str.LastIndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
End Function
''' <summary>
''' 输入 And 字符不会报错的 Val。
@@ -1649,14 +1662,14 @@ Re:
Source = Source.ToLower.Replace(" ", "")
Query = Query.ToLower.Replace(" ", "")
Dim sourceLength As Integer = Source.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存
Do While qp < Query.Length
Do While qp < queryLength
'对 qp 作为开始位置计算
Dim sp As Integer = 0, lenMax As Integer = 0, spMax As Integer = 0
'查找以 qp 为头的最大子串
Do While sp < Source.Length
'对每个 sp 作为开始位置计算最大子串
Dim len As Integer = 0
Do While (qp + len) < Query.Length AndAlso (sp + len) < Source.Length AndAlso Source(sp + len) = Query(qp + len)
Do While (qp + len) < queryLength AndAlso (sp + len) < Source.Length AndAlso Source(sp + len) = Query(qp + len)
len += 1
Loop
'存储 len
@@ -1671,7 +1684,7 @@ Re:
Source = Source.Substring(0, spMax) & If(Source.Count > spMax + lenMax, Source.Substring(spMax + lenMax), String.Empty) '将源中的对应字段替换空
'存储 lenSum
Dim IncWeight = (Math.Pow(1.4, 3 + lenMax) - 3.6) '根据长度加成
IncWeight *= (1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax))) '根据位置加成
IncWeight *= 1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax)) '根据位置加成
lenSum += IncWeight
End If
'根据结果增加 qp
@@ -1721,23 +1734,24 @@ Re:
Public Function Search(Of T)(Entries As List(Of SearchEntry(Of T)), Query As String, Optional MaxBlurCount As Integer = 5, Optional MinBlurSimilarity As Double = 0.1) As List(Of SearchEntry(Of T))
'初始化
Dim ResultList As New List(Of SearchEntry(Of T))
If Entries.Count = 0 Then Return ResultList
If Not Entries.Any() Then Return ResultList
'进行搜索,获取相似信息
For Each Entry In Entries
Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query)
Entry.AbsoluteRight = False
For Each Pair In Entry.SearchSource
If Pair.Key.ToLower.Replace(" ", "").Contains(Query.ToLower.Replace(" ", "")) Then Entry.AbsoluteRight = True
If Pair.Key.Replace(" ", "").ContainsF(Query.Replace(" ", ""), True) Then Entry.AbsoluteRight = True
Next
Next
'按照相似度进行排序
Entries = Sort(Entries, Function(Left As SearchEntry(Of T), Right As SearchEntry(Of T)) As Boolean
If Left.AbsoluteRight Xor Right.AbsoluteRight Then
Return Left.AbsoluteRight
Else
Return Left.Similarity > Right.Similarity
End If
End Function)
Entries = Sort(Entries,
Function(Left, Right) As Boolean
If Left.AbsoluteRight Xor Right.AbsoluteRight Then
Return Left.AbsoluteRight
Else
Return Left.Similarity > Right.Similarity
End If
End Function)
'返回结果
Dim BlurCount As Integer = 0
For Each Entry In Entries
@@ -2061,7 +2075,7 @@ NextElement:
''' <param name="SortRule">传入两个对象,若第一个对象应该排在前面,则返回 True。</param>
Public Function Sort(Of T)(List As IList(Of T), SortRule As CompareThreadStart(Of T)) As List(Of T)
Dim NewList As New List(Of T)
While List.Count > 0
While List.Any
Dim Highest = List(0)
For i = 1 To List.Count - 1
If SortRule(List(i), Highest) Then Highest = List(i)
@@ -2089,7 +2103,7 @@ NextElement:
Dim AllArguments() As String = Command.Split(" ")
For i = 0 To AllArguments.Length - 1
If AllArguments(i) = "-" & Name Then
If AllArguments.Length = i + 1 OrElse AllArguments(i + 1).StartsWith("-") Then Return True
If AllArguments.Length = i + 1 OrElse AllArguments(i + 1).StartsWithF("-") Then Return True
Return AllArguments(i + 1)
End If
Next
@@ -2116,7 +2130,7 @@ NextElement:
''' </summary>
Public Sub OpenWebsite(Url As String)
Try
If Not Url.ToLower.StartsWith("http") Then Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
If Not Url.StartsWithF("http", True) Then Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
Log("[System] 正在打开网页:" & Url)
Process.Start(Url)
Catch ex As Exception
@@ -2634,7 +2648,7 @@ Retry:
''' </summary>
Public Function Shuffle(Of T)(array As IList(Of T)) As IList(Of T)
Shuffle = New List(Of T)
Do While array.Count > 0
Do While array.Any
Dim i As Integer = RandomInteger(0, array.Count - 1)
Shuffle.Add(array(i))
array.RemoveAt(i)
@@ -490,7 +490,7 @@
Select Case Loader.State
Case LoadState.Finished
'检查是否需要重启
If Loader.GetType.Name.StartsWith("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
GoTo Restart
@@ -500,7 +500,7 @@
End If
Case LoadState.Loading
'检查是否需要重启
If Loader.GetType.Name.StartsWith("LoaderTask") Then
If Loader.GetType.Name.StartsWithF("LoaderTask") Then
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
GoTo Restart
@@ -517,9 +517,9 @@ Restart:
If Input IsNot Nothing Then
'若输入类型与下一个加载器相同才继续
Dim LoaderType As String = Loader.GetType.Name
If LoaderType.StartsWith("LoaderTask") OrElse LoaderType.StartsWith("LoaderCombo") Then
If LoaderType.StartsWithF("LoaderTask") OrElse LoaderType.StartsWithF("LoaderCombo") Then
Loader.Start(If(Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IsForceRestarting)
ElseIf LoaderType.StartsWith("LoaderDownload") Then
ElseIf LoaderType.StartsWithF("LoaderDownload") Then
Loader.Start(If(TypeOf Input Is List(Of NetFile), Input, Nothing), IsForceRestarting)
Else
Throw New Exception("未知的加载器类型(" & LoaderType & ")")
@@ -545,7 +545,7 @@ Restart:
Public Shared Sub GetLoaderList(Loader As Object, ByRef List As List(Of LoaderBase), Optional RequireShow As Boolean = True)
For Each SubLoader In Loader.Loaders
If SubLoader.Show OrElse Not RequireShow Then List.Add(SubLoader)
If SubLoader.GetType.Name.StartsWith("LoaderCombo") Then GetLoaderList(SubLoader, List)
If SubLoader.GetType.Name.StartsWithF("LoaderCombo") Then GetLoaderList(SubLoader, List)
Next
End Sub
''' <summary>
@@ -571,7 +571,7 @@ Restart:
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
Public Sub LoaderTaskbarAdd(Loader As LoaderBase)
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Add(Loader)
@@ -587,11 +587,11 @@ Restart:
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.Show AndAlso Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar.ToList()
If (IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting) AndAlso Task.Show Then
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
@@ -606,7 +606,7 @@ Restart:
End If
RunInUi(Sub() FrmMain.BtnExtraDownload.Progress = LoaderTaskbarProgress)
'更新任务栏信息
If LoaderTaskbar.Count = 0 OrElse LoaderTaskbarProgress = 1 Then
If Not LoaderTaskbar.Any() OrElse LoaderTaskbarProgress = 1 Then
NewState = Shell.TaskbarItemProgressState.None
ElseIf LoaderTaskbarProgress < 0.015 Then
NewState = Shell.TaskbarItemProgressState.Indeterminate
@@ -628,7 +628,6 @@ Restart:
Dim Total As Double = 0, Count As Integer = 0
SyncLock LoaderTaskbarLock
For Each Task In LoaderTaskbar.ToList
If Not Task.Show Then Continue For
Total += Task.Progress
Count += 1 '避免多线程影响导致计数出错
Next
+224 -294
View File
@@ -1,4 +1,5 @@
Imports System.Net
Imports PCL.ModNet
Public Module ModNet
Public Const NetDownloadEnd As String = ".PCLDownloading"
@@ -189,7 +190,7 @@ RequestFinished:
Dim Request As HttpWebRequest = WebRequest.Create(Url)
Dim Result As New List(Of Byte)
Try
If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Request.ProtocolVersion = HttpVersion.Version11
If Url.StartsWithF("https", True) Then Request.ProtocolVersion = HttpVersion.Version11
Request.Timeout = Timeout
Request.Accept = Accept
SecretHeadersSign(Url, Request, UseBrowserUserAgent)
@@ -235,11 +236,11 @@ RequestFinished:
''' 以多线程下载网页文件的方式获取网页源代码。
''' </summary>
''' <param name="Urls">网页的 Url 列表。</param>
Public Function NetGetCodeByDownload(Urls As String(), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
Dim Temp As String = PathTemp & "Cache\Code\" & Urls(0).GetHashCode() & "_" & GetUuid()
Public Function NetGetCodeByDownload(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
Dim Temp As String = PathTemp & "Cache\Code\" & Urls.First.GetHashCode() & "_" & GetUuid()
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(第一下载源:" & Urls(0) & ")")
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(第一下载源:" & Urls.First & ")")
NetGetCodeByDownload = ReadFile(Temp)
File.Delete(Temp)
Finally
@@ -397,7 +398,7 @@ RequestFinished:
Req.ContentType = ContentType
Req.Timeout = Timeout
SecretHeadersSign(Url, Req, UseBrowserUserAgent)
If Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then Req.ProtocolVersion = HttpVersion.Version11
If Url.StartsWithF("https", True) Then Req.ProtocolVersion = HttpVersion.Version11
If Method = "POST" OrElse Method = "PUT" Then
Req.ContentLength = SendData.Length
DataStream = Req.GetRequestStream()
@@ -448,7 +449,7 @@ RequestFinished:
''' <summary>
''' 速度下限。
''' </summary>
Public NetTaskSpeedLimitLow As Long = 1024 * 1024L
Public NetTaskSpeedLimitLow As Long = 256 * 1024L '256K/s
''' <summary>
''' 速度上限。若无限制则为 -1。
''' </summary>
@@ -601,7 +602,7 @@ RequestFinished:
SyncLock Task.LockChain
If NextThread Is Nothing Then
If Task.IsUnknownSize Then
Return 1024 * 1024 * 1024 '1G
Return 5 * 1024 * 1024 * 1024L '5G
Else
Return Task.FileSize - 1
End If
@@ -616,7 +617,7 @@ RequestFinished:
''' </summary>
Public ReadOnly Property DownloadUndone As Long
Get
Return DownloadEnd + 1 - (DownloadStart + DownloadDone)
Return DownloadEnd - (DownloadStart + DownloadDone) + 1
End Get
End Property
''' <summary>
@@ -715,7 +716,7 @@ RequestFinished:
CurrentSource = Sources(Id)
End While
Return CurrentSource
ElseIf SourcesOnce.Count > 0 Then
ElseIf SourcesOnce.Any Then
'仅存在单线程可用源
Return SourcesOnce(0)
Else
@@ -728,7 +729,7 @@ RequestFinished:
''' 是否已经没有可用源了。
''' </summary>
Public Function IsSourceFailed(Optional AllowOnceSource As Boolean = True) As Boolean
If AllowOnceSource AndAlso SourcesOnce.Count > 0 Then Return False
If AllowOnceSource AndAlso SourcesOnce.Any Then Return False
SyncLock LockSource
For Each Source As NetSource In Sources
If Not Source.IsFailed Then Return False
@@ -754,15 +755,12 @@ RequestFinished:
''' 导致下载失败的原因。
''' </summary>
Public Ex As New List(Of Exception)
'''' <summary>
'''' 文件进行整体重试的计数。
'''' </summary>
'Private RetryCount As Integer = 0
''' <summary>
''' 作为文件组成部分的线程链表。
''' 如果没有线程,可以为 Nothing。
''' </summary>
Private Threads As NetThread
Public Threads As NetThread
''' <summary>
''' 文件的总大小。若为 -2 则为未获取,若为 -1 则为无法获取准确大小。
@@ -844,10 +842,10 @@ RequestFinished:
Case NetState.Get
Return 0.04
Case NetState.Download
'正在下载中,对应 5% ~ 99%
'正在下载中,对应 5% ~ 98%
Dim OriginalProgress As Double = If(IsUnknownSize, 0.5, DownloadDone / Math.Max(FileSize, 1))
OriginalProgress = 1 - (1 - OriginalProgress) ^ 0.9
Return OriginalProgress * 0.94 + 0.05
Return OriginalProgress * 0.93 + 0.05
Case NetState.Merge
Return 0.99
Case NetState.Finish, NetState.Error
@@ -878,14 +876,13 @@ RequestFinished:
End Property
Private Const FilePieceLimit As Long = 256 * 1024
Public ReadOnly RandomCode As Integer = RandomInteger(0, 999999)
Public ReadOnly LockCount As New Object
Public ReadOnly LockState As New Object
Public ReadOnly LockChain As New Object
Public ReadOnly LockSource As New Object
Public ReadOnly LockTasks As New Object
Private ReadOnly Uuid As Integer = GetUuid()
Public ReadOnly Uuid As Integer = GetUuid()
Public Overrides Function Equals(obj As Object) As Boolean
Dim file = TryCast(obj, NetFile)
Return file IsNot Nothing AndAlso Uuid = file.Uuid
@@ -897,7 +894,7 @@ RequestFinished:
''' 新建一个需要下载的文件。
''' </summary>
''' <param name="LocalPath">包含文件名的本地地址。</param>
Public Sub New(Urls As String(), LocalPath As String, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
Public Sub New(Urls As IEnumerable(Of String), LocalPath As String, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
Dim Sources As New List(Of NetSource)
Dim Count As Integer = 0
Urls = Urls.Distinct.ToArray
@@ -914,14 +911,15 @@ RequestFinished:
''' <summary>
''' 尝试开始一个新的下载线程。
''' 如果失败,返回 Nothing。
''' </summary>
Public Function TryBeginThread() As Boolean
Public Function TryBeginThread() As NetThread
Try
'条件检测
If NetTaskThreadCount >= NetTaskThreadLimit OrElse IsSourceFailed() OrElse
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return False
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return False
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing
SyncLock LockState
If State < NetState.Connect Then State = NetState.Connect
End SyncLock
@@ -936,7 +934,7 @@ RequestFinished:
'单线程
If IsSourceFailed(False) Then
'确认没有其他线程正使用此点
If SourcesOnce(0).Thread IsNot Nothing AndAlso SourcesOnce(0).Thread.State <> NetState.Error Then Return False
If SourcesOnce(0).Thread IsNot Nothing AndAlso SourcesOnce(0).Thread.State <> NetState.Error Then Return Nothing
'占用此点
Capture:
SmailFileCache = Nothing
@@ -952,14 +950,8 @@ Capture:
If Threads Is Nothing Then
StartPosition = 0
StartSource = GetSource(FirstThreadSource)
If StartSource Is Nothing Then
'没有可用源了
Throw New Exception("无可用源,请反馈此问题。")
Else
'有可用源
FirstThreadSource = StartSource.Id + 1
GoTo StartThread
End If
FirstThreadSource = StartSource.Id + 1
GoTo StartThread
End If
'寻找失败点
For Each Thread As NetThread In Threads
@@ -971,24 +963,25 @@ Capture:
Next
'是否禁用多线程,以及规定碎片大小
Dim TargetUrl As String = GetSource().Url
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") Then Return False
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth.com") Then Return Nothing
'寻找最大碎片
'FUTURE: 下载引擎重做,计算下载源平均链接时间和线程下载速度,按最高时间节省来开启多线程
Dim FilePieceMax As NetThread = Threads
For Each Thread As NetThread In Threads
If Thread.DownloadUndone > FilePieceMax.DownloadUndone Then FilePieceMax = Thread
Next
If FilePieceMax Is Nothing OrElse FilePieceMax.DownloadUndone < FilePieceLimit Then Return False
If FilePieceMax Is Nothing OrElse FilePieceMax.DownloadUndone < FilePieceLimit Then Return Nothing
StartPosition = FilePieceMax.DownloadEnd - FilePieceMax.DownloadUndone * 0.4
StartSource = GetSource()
'开始线程
StartThread:
If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return False
If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return Nothing
'构建线程
Dim ThreadUuid As Integer = GetUuid()
SyncLock LockTasks
If Tasks.Count = 0 Then Return False '由于中断,已没有可用任务
Th = New Thread(AddressOf Thread) With {.Name = "NetTask " & Tasks(0).Uuid & "/" & Uuid & " Download " & ThreadUuid & "#", .Priority = ThreadPriority.BelowNormal}
If Not Tasks.Any() Then Return Nothing '由于中断,已没有可用任务
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}
'链表处理
@@ -1012,11 +1005,11 @@ StartThread:
If IsSourceFailed(False) Then SourcesOnce(0).Thread = ThreadInfo
End SyncLock
Th.Start(ThreadInfo)
Return True
Return ThreadInfo
Catch ex As Exception
Log(ex, "尝试开始下载线程失败(" & If(LocalName, "Nothing") & ")", LogLevel.Hint)
Return False
Return Nothing
End Try
End Function
''' <summary>
@@ -1035,49 +1028,59 @@ StartThread:
If SourcesOnce.Contains(Info.Source) AndAlso Not Info.Equals(Info.Source.Thread) Then GoTo SourceBreak
'请求头
HttpRequest = WebRequest.Create(Info.Source.Url)
If Info.Source.Url.StartsWith("https", StringComparison.OrdinalIgnoreCase) Then HttpRequest.ProtocolVersion = HttpVersion.Version11
If Info.Source.Url.StartsWithF("https", True) Then HttpRequest.ProtocolVersion = HttpVersion.Version11
'HttpRequest.Proxy = Nothing 'new WebProxy(Ip, Port)
HttpRequest.Timeout = Timeout
HttpRequest.AddRange(Info.DownloadStart)
SecretHeadersSign(Info.Source.Url, HttpRequest, UseBrowserUserAgent)
Dim ContentLength As Long = 0
Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse()
If ModeDebug AndAlso HttpResponse.ResponseUri.OriginalString <> Info.Source.Url Then
Log($"[Download] {LocalName} {Info.Uuid}#:重定向至 {HttpResponse.ResponseUri.OriginalString}")
End If
'文件大小校验
Dim ThreadFileSize = HttpResponse.ContentLength
If ThreadFileSize = -1 Then
ContentLength = HttpResponse.ContentLength
If ContentLength = -1 Then
If FileSize > 1 Then
Log("[Download] " & LocalName & " " & Info.Uuid & "#:文件大小未知,但已从其他下载源获取,不作处理")
If Info.DownloadStart = 0 Then
Log($"[Download] {LocalName} {Info.Uuid}#:文件大小未知,但已从其他下载源获取,不作处理")
Else
Log($"[Download] {LocalName} {Info.Uuid}#:ContentLength 返回了 -1,无法确定是否支持分段下载,视作不支持")
GoTo NotSupportRange
End If
Else
FileSize = -1 : IsUnknownSize = True
Log("[Download] " & LocalName & " " & Info.Uuid & "#:文件大小未知")
Log($"[Download] {LocalName} {Info.Uuid}#:文件大小未知")
End If
ElseIf ThreadFileSize < 0 Then
Throw New Exception("获取片大小失败,结果为 " & ThreadFileSize & "。")
ElseIf ContentLength < 0 Then
Throw New Exception("获取片大小失败,结果为 " & ContentLength & "。")
ElseIf Info.IsFirstThread Then
If Check IsNot Nothing Then
If ThreadFileSize < Check.MinSize AndAlso Check.MinSize > 0 Then
Throw New Exception("文件大小不足,获取结果为 " & ThreadFileSize & ",要求至少为 " & Check.MinSize & "。")
If ContentLength < Check.MinSize AndAlso Check.MinSize > 0 Then
Throw New Exception($"文件大小不足,获取结果为 {ContentLength},要求至少为 {Check.MinSize}。")
End If
If ThreadFileSize <> Check.ActualSize AndAlso Check.ActualSize > 0 Then
Throw New Exception("文件大小不一致,获取结果为 " & ThreadFileSize & ",要求必须为 " & Check.ActualSize & "。")
If ContentLength <> Check.ActualSize AndAlso Check.ActualSize > 0 Then
Throw New Exception($"文件大小不一致,获取结果为 {ContentLength},要求必须为 {Check.ActualSize}。")
End If
End If
FileSize = ThreadFileSize : IsUnknownSize = False
Log("[Download] " & LocalName & ":文件大小 " & ThreadFileSize & " B" & "(" & GetString(ThreadFileSize) & ")")
FileSize = ContentLength : IsUnknownSize = False
Log($"[Download] {LocalName} {Info.Uuid}#:文件大小 {ContentLength}({GetString(ContentLength)})")
'若文件大小大于 50 M,进行剩余磁盘空间校验
If ThreadFileSize > 50 * 1024 * 1024 Then
If ContentLength > 50 * 1024 * 1024 Then
For Each Drive As DriveInfo In DriveInfo.GetDrives
Dim DriveName As String = Drive.Name.First.ToString
Dim RequiredSpace = If(PathTemp.StartsWith(DriveName), ThreadFileSize * 1.1, 0) +
If(LocalPath.StartsWith(DriveName), ThreadFileSize + 5 * 1024 * 1024, 0)
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) +
If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0)
If Drive.TotalFreeSpace < RequiredSpace Then
Throw New Exception(DriveName & " 盘空间不足,无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间,但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" &
If(PathTemp.StartsWith(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", ""))
If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存,你可以在设置中调整缓存文件夹的位置。", ""))
End If
Next
End If
ElseIf FileSize < 0 Then
Throw New Exception("非首线程运行时,尚未获取文件大小。")
ElseIf Info.DownloadStart > 0 AndAlso ThreadFileSize = FileSize Then
Throw New Exception("非首线程运行时,尚未获取文件大小")
ElseIf Info.DownloadStart > 0 AndAlso ContentLength = FileSize Then
NotSupportRange:
SyncLock LockSource
If SourcesOnce.Contains(Info.Source) Then
GoTo SourceBreak
@@ -1085,10 +1088,11 @@ StartThread:
SourcesOnce.Add(Info.Source)
End If
End SyncLock
Throw New WebException("该下载源不支持断点续传。")
ElseIf Not FileSize - Info.DownloadStart = ThreadFileSize Then
Throw New WebException("获取到的片大小不一致:线程结果为 " & ThreadFileSize & " B,任务结果为 " & FileSize & "B,起点为 " & Info.DownloadStart & "B。")
Throw New WebException($"该下载源不支持分段下载:Range 起始于 {Info.DownloadStart},预期 ContentLength 为 {FileSize - Info.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}")
ElseIf Not FileSize - Info.DownloadStart = ContentLength Then
Throw New WebException($"获取到的分段大小不一致:Range 起始于 {Info.DownloadStart},预期 ContentLength 为 {FileSize - Info.DownloadStart},返回 ContentLength 为 {ContentLength},总文件大小 {FileSize}")
End If
'Log($"[Download] {LocalName} {Info.Uuid}#:通过大小检查,文件大小 {FileSize},起始点 {Info.DownloadStart},ContentLength {ContentLength}")
Info.State = NetState.Get
SyncLock LockState
If State < NetState.Get Then State = NetState.Get
@@ -1108,7 +1112,7 @@ StartThread:
Dim HttpData As Byte() = New Byte(16384) {}
HttpDataCount = HttpStream.Read(HttpData, 0, 16384)
While (IsUnknownSize OrElse Info.DownloadUndone > 0) AndAlso '判断是否下载完成
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Info.Source.IsFailed OrElse Info.Equals(Info.Source.Thread))
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Info.Source.IsFailed OrElse Info.Equals(Info.Source.Thread))
'限速
While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0
Threading.Thread.Sleep(16)
@@ -1170,17 +1174,17 @@ StartThread:
End Using
End Using
SourceBreak:
If HttpDataCount = 0 AndAlso Info.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
'服务器无返回数据
Throw New Exception("服务器无返回数据,但下载尚未完成")
ElseIf State = NetState.Error OrElse Info.Source.IsFailed OrElse (Info.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
If State = NetState.Error OrElse Info.Source.IsFailed OrElse (Info.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
'被外部中断
Info.State = NetState.Error
Log("[Download] " & LocalName & " " & Info.Uuid & "#:中断")
Log($"[Download] {LocalName} {Info.Uuid}#:中断")
ElseIf HttpDataCount = 0 AndAlso Info.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
'服务器无返回数据
Throw New Exception($"返回的 ContentLength 过多:ContentLength 为 {ContentLength},但获取到的总数据量仅为 {Info.DownloadDone}(全文件总数据量 {DownloadDone})")
Else
'本线程完成
Info.State = NetState.Finish
If ModeDebug Then Log("[Download] " & LocalName & " " & Info.Uuid & "#:完成,已下载 " & GetString(Info.DownloadDone))
If ModeDebug Then Log($"[Download] {LocalName} {Info.Uuid}#:完成,已下载 {Info.DownloadDone}")
End If
Catch ex As Exception
'状态变更
@@ -1212,11 +1216,11 @@ SourceBreak:
'End SyncLock
Info.Source.Ex = ex
'根据情况判断,是否在多线程下禁用下载源(连续错误过多,或不支持断点续传)
'BMCLAPI 的部分源在高频率请求下会返回 403,所以不应因此禁用下载源
If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse
ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的片大小不一致") OrElse
(Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse
Info.Source.FailCount > NetTaskThreadLimit Then
ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse
(ex.Message.Contains("(403)") AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403,所以不应因此禁用下载源
(Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse
Info.Source.FailCount > NetTaskThreadLimit + 2 Then
Dim IsThisFail As Boolean = False
SyncLock LockSource
If Info.Source.Thread IsNot Nothing AndAlso Info.Source.Thread.Equals(Info) Then
@@ -1232,8 +1236,8 @@ Wrong:
End SyncLock
'本线程引发下载源被禁用
If IsThisFail Then
Log("[Download] " & LocalName & " " & Uuid & "#:下载源被禁用(" & Info.Source.Id & "):" & Info.Source.Url)
Log(ex, "下载源 " & Info.Source.Id & " 已被禁用", If(ex.Message.Contains("不支持断点续传") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(416)"), LogLevel.Developer, LogLevel.Debug))
Log($"[Download] {LocalName} {Info.Uuid}#:下载源被禁用({Info.Source.Id}):{Info.Source.Url}")
Log(ex, "下载源 " & Info.Source.Id & " 已被禁用", If(ex.Message.Contains("不支持分段下载") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(416)"), LogLevel.Developer, LogLevel.Debug))
If IsSourceFailed() Then
'没有可用源
Log("[Download] 文件 " & LocalName & " 已无可用下载源")
@@ -1265,6 +1269,7 @@ Wrong:
SyncLock NetTaskThreadCountLock
NetTaskThreadCount -= 1
End SyncLock
'可能在没有下载完的时候开始合并文件了,这造成了大多数合并失败
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge()
End Try
End Sub
@@ -1287,7 +1292,6 @@ Wrong:
Try
Retry:
SyncLock LockChain
If ModeDebug Then Log("[Download] " & LocalName & ":正在合并文件")
'创建文件夹
If File.Exists(LocalPath) Then File.Delete(LocalPath)
Dim Info As New FileInfo(LocalPath)
@@ -1295,6 +1299,7 @@ Retry:
'合并文件
If IsNoSplit Then
'仅有一个线程,从缓存中输出
If ModeDebug Then Log($"[Download] {LocalName}:下载结束,从缓存输出文件")
MergeFile = New FileStream(LocalPath, FileMode.Create)
AddWriter = New BinaryWriter(MergeFile)
AddWriter.Write(SmailFileCache.ToArray)
@@ -1302,17 +1307,19 @@ Retry:
MergeFile.Dispose() : MergeFile = Nothing
ElseIf Threads.DownloadDone = DownloadDone AndAlso Threads.Temp IsNot Nothing Then
'仅有一个文件,直接复制
If ModeDebug Then Log($"[Download] {LocalName}:下载结束,仅有一个文件,无需合并")
CopyFile(Threads.Temp, LocalPath)
Else
'有多个线程,合并
If ModeDebug Then Log($"[Download] {LocalName}:下载结束,开始合并文件")
MergeFile = New FileStream(LocalPath, FileMode.Create)
AddWriter = New BinaryWriter(MergeFile)
For Each Thread As NetThread In Threads
If Thread.DownloadDone = 0 OrElse Thread.Temp Is Nothing Then Continue For
Using fs As New FileStream(Thread.Temp, FileMode.Open, FileAccess.Read, FileShare.Read)
Dim TempReader As New BinaryReader(fs)
AddWriter.Write(TempReader.ReadBytes(fs.Length))
TempReader.Close()
Using TempReader As New BinaryReader(fs)
AddWriter.Write(TempReader.ReadBytes(Thread.DownloadDone))
End Using
End Using
Next
AddWriter.Dispose() : AddWriter = Nothing
@@ -1329,9 +1336,9 @@ Retry:
'检查文件
Dim CheckResult As String = Check?.Check(LocalPath)
If CheckResult IsNot Nothing Then
Log("[Download] " & Uuid & "# 的下载线程细节:")
Log($"[Download] {LocalName} 合并文件失败,下载线程细节:")
For Each Th As NetThread In Threads
Log("[Download] " & Th.Uuid & "#,状态 " & GetStringFromEnum(CType(Th.State, [Enum])) & ",字节范围 " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & ",字节剩余 " & Th.DownloadUndone)
Log($"[Download] {Th.Uuid}#,状态 {GetStringFromEnum(Th.State)},范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone},完成 {Th.DownloadDone},剩余 {Th.DownloadUndone}")
Next
Throw New Exception(CheckResult)
End If
@@ -1379,11 +1386,6 @@ Retry:
SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1
Log("[Download] " & LocalName & ":已失败,剩余文件 " & NetManager.FileRemain)
'If NetManage.FileRemainList.Contains(LocalPath) Then
' NetManage.FileRemainList.Remove(LocalPath)
'Else
' Log("ERROR " & LocalPath)
'End If
End SyncLock
For Each Task In Tasks
Task.OnFileFail(Me)
@@ -1396,7 +1398,7 @@ Retry:
'确认任务移除
SyncLock LockTasks
Tasks.Remove(CausedByTask)
If Tasks.Count > 0 Then Exit Sub
If Tasks.Any Then Exit Sub
End SyncLock
'确认中断
SyncLock LockState
@@ -1406,11 +1408,6 @@ Retry:
SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1
If ModeDebug Then Log("[Download] " & LocalName & ":已取消,剩余文件 " & NetManager.FileRemain)
'If NetManage.FileRemainList.Contains(LocalPath) Then
' NetManage.FileRemainList.Remove(LocalPath)
'Else
' Log("ERROR " & LocalPath)
'End If
End SyncLock
End Sub
@@ -1426,11 +1423,6 @@ Retry:
SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1
If PrintLog Then Log("[Download] " & LocalName & ":已完成,剩余文件 " & NetManager.FileRemain)
'If NetManage.FileRemainList.Contains(LocalPath) Then
' NetManage.FileRemainList.Remove(LocalPath)
'Else
' Log("ERROR " & LocalPath)
'End If
End SyncLock
SyncLock LockTasks
For Each Task In Tasks
@@ -1465,7 +1457,7 @@ Retry:
Public Overrides Property Progress As Double
Get
If State >= LoadState.Finished Then Return 1
If Files.Count = 0 Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了
If Not Files.Any() Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了
Return _Progress
End Get
Set(value As Double)
@@ -1507,7 +1499,7 @@ FinishExCatch:
#End Region
''' <summary>
''' 刷新公开属性。由 NetManager 每 0.2 秒调用一次。
''' 刷新公开属性。由 NetManager 每 0.1 秒调用一次。
''' </summary>
Public Sub RefreshStat()
'计算进度
@@ -1519,15 +1511,15 @@ FinishExCatch:
NewProgress += File.Progress * 0.2
TotalProgress += 0.2
Else
NewProgress += File.Progress '* If(File.Progress < 1, 0.9, 1)
NewProgress += File.Progress
TotalProgress += 1
End If
Next
End SyncLock
If TotalProgress > 0 Then NewProgress /= TotalProgress
'刷新进度
If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 1 - (1 - NewProgress) ^ 0.9 'MathBezier(NewProgress, 0, 0.05, 1, 0.8, 0.0001)
_Progress = NewProgress * 0.99 + 0.01
If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 2 * (NewProgress ^ 3) - 3 * (NewProgress ^ 2) + 2 * NewProgress '2x^3-3x^2+2x,模拟开头和结尾更慢的情况
_Progress = NewProgress
End Sub
Public Sub New(Name As String, FileTasks As List(Of NetFile))
@@ -1556,77 +1548,78 @@ NextElement:
End SyncLock
State = LoadState.Loading
'开始执行
RunInNewThread(Sub()
Try
'输入检测
If Files.Count = 0 Then
OnFinish()
Exit Sub
End If
For Each File As NetFile In Files
If File Is Nothing Then Throw New ArgumentException("存在空文件请求!")
For Each Source As NetSource In File.Sources
If Not (Source.Url.ToLower.StartsWith("https://") OrElse Source.Url.ToLower.StartsWith("http://")) Then
Source.Ex = New ArgumentException("输入的下载链接不正确!")
Source.IsFailed = True
End If
Next
If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确!")
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确!")
If File.LocalPath.EndsWith("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径!")
'文件夹检测
Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
Next
'接入下载管理器
NetManager.Start(Me)
'将文件分配给多个线程以进行已存在查找
Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表
Dim FoldersFinal As New List(Of String) '最终用于查找的列表
If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹,因为 HMCL 会把所有文件存在这里
For Each Folder In McFolderList
Folders.Add(Folder.Path)
Next
Folders = Folders.Distinct.ToList
For Each Folder In Folders
If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder)
Next
End If
'最多 5 个线程,最少每个线程分配 10 个文件
SyncLock FilesLock
Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1)
Dim FilesInThread As New List(Of NetFile)
For Each File In Files
FilesInThread.Add(File)
If FilesInThread.Count = FilesPerThread Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
Next
If FilesInThread.Count > 0 Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
End SyncLock
Catch ex As Exception
OnFail(New List(Of Exception) From {ex})
End Try
End Sub, "NetTask " & Uuid & " Main")
RunInNewThread(
Sub()
Try
'输入检测
If Not Files.Any() Then
OnFinish()
Exit Sub
End If
For Each File As NetFile In Files
If File Is Nothing Then Throw New ArgumentException("存在空文件请求!")
For Each Source As NetSource In File.Sources
If Not (Source.Url.StartsWithF("https://", True) OrElse Source.Url.StartsWithF("http://", True)) Then
Source.Ex = New ArgumentException("输入的下载链接不正确!")
Source.IsFailed = True
End If
Next
If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确!")
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确!")
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径!")
'文件夹检测
Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
Next
'接入下载管理器
NetManager.Start(Me)
'将文件分配给多个线程以进行已存在查找
Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表
Dim FoldersFinal As New List(Of String) '最终用于查找的列表
If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹,因为 HMCL 会把所有文件存在这里
For Each Folder In McFolderList
Folders.Add(Folder.Path)
Next
Folders = Folders.Distinct.ToList
For Each Folder In Folders
If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder)
Next
End If
'最多 5 个线程,最少每个线程分配 10 个文件
SyncLock FilesLock
Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1)
Dim FilesInThread As New List(Of NetFile)
For Each File In Files
FilesInThread.Add(File)
If FilesInThread.Count = FilesPerThread Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
Next
If FilesInThread.Any Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
End SyncLock
Catch ex As Exception
OnFail(New List(Of Exception) From {ex})
End Try
End Sub, "NetTask " & Uuid & " Main")
End Sub
Private Sub StartCopy(Files As List(Of NetFile), FolderList As List(Of String))
Try
If ModeDebug Then Log("[Download] 检查线程分配文件数:" & Files.Count)
If ModeDebug Then Log("[Download] 检查线程分配文件数:" & Files.Count & ",线程名:" & Thread.CurrentThread.Name)
'试图从已存在的 Minecraft 文件夹中寻找目标文件
Dim ExistFiles As New List(Of KeyValuePair(Of NetFile, String)) '{NetFile, Target As String}
For Each File As NetFile In Files
Dim ExistFilePath As String = Nothing
'判断是否有已存在的文件
If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWith(PathMcFolder) Then
If File.Check IsNot Nothing AndAlso McFolderList IsNot Nothing AndAlso PathMcFolder IsNot Nothing AndAlso File.Check.CanUseExistsFile AndAlso File.LocalPath.StartsWithF(PathMcFolder) Then
Dim Relative = File.LocalPath.Replace(PathMcFolder, "")
For Each Folder In FolderList
Dim Target = Folder & Relative
@@ -1699,17 +1692,16 @@ Retry:
Public Sub OnFail(ExList As List(Of Exception))
SyncLock LockState
If State > LoadState.Loading Then Exit Sub
If ExList Is Nothing OrElse ExList.Count = 0 Then ExList = New List(Of Exception) From {New Exception("未知错误!")}
If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误!")}
'寻找第一个不是 404 的下载源
Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList
[Error] = If(UsefulExs.Count > 0, UsefulExs(0), ExList(0))
[Error] = If(UsefulExs.Any, UsefulExs(0), ExList(0))
'获取实际失败的文件
SyncLock FilesLock
For Each File In Files
If File.State = NetState.Error Then
[Error] = New Exception("文件下载失败:" & File.LocalPath & vbCrLf & Join(
File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "(" & s.Url & ")")).ToList(),
vbCrLf), [Error])
File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "(" & s.Url & ")")), vbCrLf), [Error])
Exit For
End If
Next
@@ -1794,9 +1786,9 @@ Retry:
''' </summary>
Private SpeedLastDone As Long = 0
''' <summary>
''' 最近 10 次下载速度的记录,较新的在后面。间隔为 0.2 秒,故记录了 2 秒的速度。
''' 至多最近 30 次下载速度的记录,较新的在前面。
''' </summary>
Public SpeedLast As New List(Of Long) From {0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
Private SpeedLast As New List(Of Long)
'这些属性由 RefreshStat 刷新
''' <summary>
''' 当前的全局下载速度,单位为 Byte / 秒。
@@ -1808,28 +1800,29 @@ Retry:
#End Region
''' <summary>
''' 进度与下载速度由下载管理线程每隔约 0.2 秒刷新一次。
''' 进度与下载速度由下载管理线程每隔约 0.1 秒刷新一次。
''' </summary>
Private Sub RefreshStat()
Try
Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast
RefreshStatLast += DeltaTime
#Region "刷新整体速度"
'计算即时速度
'计算瞬时速度
Dim ActualSpeed As Double = Math.Max(0, (DownloadDone - SpeedLastDone) / (DeltaTime / 1000))
SpeedLast.Add(ActualSpeed)
SpeedLast.RemoveAt(0)
SpeedLast.Insert(0, ActualSpeed)
If SpeedLast.Count >= 31 Then SpeedLast.RemoveAt(30)
SpeedLastDone = DownloadDone
'计算用于显示的速度
'If SpeedLast(9) = 0 Then
' Speed = 0
'Else
Speed = (SpeedLast(9) + SpeedLast(8) * 0.9 + SpeedLast(7) * 0.8 + SpeedLast(6) * 0.7 + SpeedLast(5) * 0.6 + SpeedLast(4) * 0.5 + SpeedLast(3) * 0.4 + SpeedLast(2) * 0.3 + SpeedLast(1) * 0.2 + SpeedLast(0) * 0.1) / 5.5
'End If
Dim SpeedSum As Long = 0, SpeedDiv As Long = 0, Weight = SpeedLast.Count
For Each SpeedRecord In SpeedLast
SpeedSum += SpeedRecord * Weight
SpeedDiv += Weight
Weight -= 1
Next
Speed = If(SpeedDiv > 0, SpeedSum / SpeedDiv, 0)
'计算新的速度下限
SpeedLast.Add(ActualSpeed)
SpeedLast.RemoveAt(0)
Dim Limit As Long = Math.Min(Math.Min(Math.Min(Math.Min(SpeedLast(5), SpeedLast(6)), SpeedLast(7)), SpeedLast(8)), SpeedLast(9)) * 0.9
Dim Limit As Long = 0
If SpeedLast.Count >= 10 Then Limit = SpeedLast.Take(10).Average * 0.85 '取近 1 秒的平均速度的 85%
If Limit > NetTaskSpeedLimitLow Then
NetTaskSpeedLimitLow = Limit
Log("[Download] " & "速度下限已提升到 " & GetString(Limit))
@@ -1854,128 +1847,65 @@ Retry:
Private Sub StartManager()
If IsManagerStarted Then Exit Sub
IsManagerStarted = True
RunInNewThread(
Sub()
Dim ThreadStarter =
Sub(Id As Integer) '0 或 1
Try
Dim LastLoopTime As Long
While True
LastLoopTime = GetTimeTick()
Thread.Sleep(20)
'若已完成,则清空
If FileRemain = 0 AndAlso Files.Count > 0 Then
If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then
SyncLock LockFiles
Files.Clear()
End SyncLock
End If
'开启新线程
If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
'速度小于下限或剩余文件还贼多,尝试开启线程
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
'启动 Wait 的文件后立即会变成 Connect,导致第二次循环再次调用,所以需要先暂时存储进去……
'此外为了减少 LockFiles 的占用时间,所以先遍历列表再开始
Dim FilesWaiting As New List(Of NetFile)
Dim FilesLoading As New List(Of NetFile)
SyncLock LockFiles
For Each File As NetFile In Files.Values
If File.RandomCode Mod 2 = 0 Then Continue For
If File.State = NetState.WaitForDownload Then
FilesWaiting.Add(File)
ElseIf File.State < NetState.Merge Then
FilesLoading.Add(File)
End If
Next
End SyncLock
'为文件列表中的文件开始线程
For Each File As NetFile In FilesWaiting
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
'获取文件列表
Dim AllFiles As List(Of NetFile)
SyncLock LockFiles
AllFiles = Files.Values.ToList()
End SyncLock
Dim WaitingFiles As New List(Of NetFile)
Dim OngoingFiles As New List(Of NetFile)
For Each File As NetFile In AllFiles
If File.Uuid Mod 2 = Id Then Continue For
If File.State = NetState.WaitForDownload Then
WaitingFiles.Add(File)
ElseIf File.State < NetState.Merge Then
OngoingFiles.Add(File)
End If
Next
'为等待中的文件开始线程
For Each File As NetFile In WaitingFiles
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率,避免 Too Many Requests
Next
'为进行中的文件追加线程
If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够,无需新增
For Each File As NetFile In OngoingFiles
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
'线程种类计数
Dim PreparingCount = 0, DownloadingCount = 0
If File.Threads IsNot Nothing Then
For Each Thread As NetThread In File.Threads.ToList
If Thread.State < NetState.Download Then
PreparingCount += 1
ElseIf Thread.State = NetState.Download Then
DownloadingCount += 1
End If
Next
For Each File As NetFile In FilesLoading
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
End If
Next
'等待 40 ms:BMCLAPI 部分时候有 20QPS 的限制
Thread.Sleep(40)
Loop While NewThreadCount > 0 AndAlso IsSuccess
End If
'等待 40 ms
Thread.Sleep(40)
End If
'新增线程
If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程,不再新增
Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率,避免 Too Many Requests
Next
End While
Catch ex As Exception
Log(ex, "下载管理启动线程 1 出错", LogLevel.Assert)
Log(ex, $"下载管理启动线程 {Id} 出错", LogLevel.Assert)
End Try
End Sub, "NetManager ThreadStarter Single")
RunInNewThread(
Sub()
Try
Dim LastLoopTime As Long
While True
LastLoopTime = GetTimeTick()
'开启新线程
If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
'速度小于下限或剩余文件还贼多,尝试开启线程
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
'启动 Wait 的文件后立即会变成 Connect,导致第二次循环再次调用,所以需要先暂时存储进去……
'此外为了减少 LockFiles 的占用时间,所以先遍历列表再开始
Dim FilesWaiting As New List(Of NetFile)
Dim FilesLoading As New List(Of NetFile)
SyncLock LockFiles
For Each File As NetFile In Files.Values
If File.RandomCode Mod 2 = 1 Then Continue For
If File.State = NetState.WaitForDownload Then
FilesWaiting.Add(File)
ElseIf File.State < NetState.Merge Then
FilesLoading.Add(File)
End If
Next
End SyncLock
'为文件列表中的文件开始线程
For Each File As NetFile In FilesWaiting
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
End If
Next
For Each File As NetFile In FilesLoading
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
End If
Next
'等待 40 ms:BMCLAPI 部分时候有 20QPS 的限制
Thread.Sleep(40)
Loop While NewThreadCount > 0 AndAlso IsSuccess
End If
'等待 40 ms
Thread.Sleep(40)
End While
Catch ex As Exception
Log(ex, "下载管理启动线程 2 出错", LogLevel.Assert)
End Try
End Sub, "NetManager ThreadStarter Odd")
End Sub
RunInNewThread(Sub() ThreadStarter(0), "NetManager ThreadStarter 0")
RunInNewThread(Sub() ThreadStarter(1), "NetManager ThreadStarter 1")
RunInNewThread(
Sub()
Try
@@ -1989,8 +1919,8 @@ Retry:
NetTaskSpeedLimitLeftLast = TimeNow
'刷新公开属性
RefreshStat()
'等待直至 170 ms
Do While GetTimeTick() - LastLoopTime < 170
'等待直至 80 ms
Do While GetTimeTick() - LastLoopTime < 80
Thread.Sleep(10)
Loop
End While
@@ -76,7 +76,7 @@ Public Class ValidateHttp
Public Sub New()
End Sub '用于 XAML 初始化
Public Overrides Function Validate(Str As String) As String
If Str.EndsWith("/") Then Str = Str.Substring(0, Str.Length - 1)
If Str.EndsWithF("/") Then Str = Str.Substring(0, Str.Length - 1)
If Not RegexCheck(Str, "^(http[s]?)\://") Then Return "输入的网址无效!"
Return ""
End Function
@@ -149,7 +149,7 @@ Public Class ValidateExcept
End Sub
Public Overrides Function Validate(Str As String) As String
For Each Ch As String In Excepts
If Str.IndexOf(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then
If Str.IndexOfF(Ch, StringComparison.OrdinalIgnoreCase) >= 0 Then
If IsNothing(ErrorMessage) Then ErrorMessage = ""
Return ErrorMessage.Replace("%", Ch)
End If
@@ -220,13 +220,13 @@ Public Class ValidateFolderName
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查空格
If Str.StartsWith(" ") Then Return "文件夹名不能以空格开头!"
If Str.EndsWith(" ") Then Return "文件夹名不能以空格结尾!"
If Str.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
If Str.EndsWithF(" ") Then Return "文件夹名不能以空格结尾!"
'检查长度
LengthCheck = New ValidateLength(1, 100).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWith(".") Then Return "文件夹名不能以小数点结尾!"
If Str.EndsWithF(".") Then Return "文件夹名不能以小数点结尾!"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件夹名不可包含 % 字符!").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
@@ -273,13 +273,13 @@ Public Class ValidateFileName
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查空格
If Str.StartsWith(" ") Then Return "文件名不能以空格开头!"
If Str.EndsWith(" ") Then Return "文件名不能以空格结尾!"
If Str.StartsWithF(" ") Then Return "文件名不能以空格开头!"
If Str.EndsWithF(" ") Then Return "文件名不能以空格结尾!"
'检查长度
LengthCheck = New ValidateLength(1, 253).Validate(Str & If(ParentFolder, ""))
If Not LengthCheck = "" Then Return LengthCheck
'检查尾部小数点
If Str.EndsWith(".") Then Return "文件名不能以小数点结尾!"
If Str.EndsWithF(".") Then Return "文件名不能以小数点结尾!"
'检查特殊字符
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "文件名不可包含 % 字符!").Validate(Str)
If Not CharactCheck = "" Then Return CharactCheck
@@ -319,7 +319,7 @@ Public Class ValidateFolderPath
Public Overrides Function Validate(Str As String) As String
'去除尾部斜线,统一为 \
Str = Str.Replace("/", "\")
If Not Str.TrimEnd("\").EndsWith(":") Then Str = Str.TrimEnd("\")
If Not Str.TrimEnd("\").EndsWithF(":") Then Str = Str.TrimEnd("\")
'检查是否为空
Dim LengthCheck As String = New ValidateNullOrWhiteSpace().Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
@@ -327,15 +327,15 @@ Public Class ValidateFolderPath
LengthCheck = New ValidateLength(1, 254).Validate(Str)
If Not LengthCheck = "" Then Return LengthCheck
'检查开头
If Str.StartsWith("\\Mac\") Then GoTo Fin
If Str.StartsWithF("\\Mac\") Then GoTo Fin
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
If Str.ToUpper = Drive.Name Then Return ""
If Str.ToUpper.StartsWith(Drive.Name) Then GoTo Fin
If Str.StartsWithF(Drive.Name, True) Then GoTo Fin
Next
Return "文件夹路径头存在错误!"
Fin:
'对首层以外的路径检查
For i = If(Str.StartsWith("\\Mac\"), 2, 1) To Str.Split("\").Count - 1
For i = If(Str.StartsWithF("\\Mac\"), 2, 1) To Str.Split("\").Count - 1
Dim SubStr As String = Str.Split("\")(i)
'检查是否为空
Dim SubLengthCheck As String = New ValidateNullOrWhiteSpace().Validate(SubStr)
@@ -344,10 +344,10 @@ Fin:
Dim CharactCheck As String = New ValidateExcept(IO.Path.GetInvalidFileNameChars() & If(UseMinecraftCharCheck, "!;", ""), "路径中存在无效字符!").Validate(SubStr)
If Not CharactCheck = "" Then Return CharactCheck
'检查头部空格
If SubStr.StartsWith(" ") Then Return "文件夹名不能以空格开头!"
If SubStr.EndsWith(" ") Then Return "文件夹名不能以空格结尾!"
If SubStr.StartsWithF(" ") Then Return "文件夹名不能以空格开头!"
If SubStr.EndsWithF(" ") Then Return "文件夹名不能以空格结尾!"
'检查尾部小数点
If SubStr.EndsWith(".") Then Return "文件夹名不能以小数点结尾!"
If SubStr.EndsWithF(".") Then Return "文件夹名不能以小数点结尾!"
'检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!").Validate(SubStr)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck
@@ -55,7 +55,7 @@ Public Class MyBitmap
Public Sub New(FilePathOrResourceName As String)
Try
FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
If FilePathOrResourceName.StartsWith(PathImage) Then
If FilePathOrResourceName.StartsWithF(PathImage) Then
'使用缓存
If BitmapCache.ContainsKey(FilePathOrResourceName) Then
Pic = BitmapCache(FilePathOrResourceName).Pic
@@ -18,6 +18,7 @@
'https://docs.curseforge.com/?http#tocS_ModLoaderType
Any = 0
Forge = 1
LiteLoader = 3
Fabric = 4
Quilt = 5
NeoForge = 6
@@ -43,10 +44,10 @@
For Each EntryData As String In Line.Split("¨")
Dim Entry = New CompDatabaseEntry
Dim SplitedLine = EntryData.Split("|")
If SplitedLine(0).StartsWith("@") Then
If SplitedLine(0).StartsWithF("@") Then
Entry.CurseForgeSlug = Nothing
Entry.ModrinthSlug = SplitedLine(0).Replace("@", "")
ElseIf SplitedLine(0).EndsWith("@") Then
ElseIf SplitedLine(0).EndsWithF("@") Then
Entry.CurseForgeSlug = SplitedLine(0).TrimEnd("@")
Entry.ModrinthSlug = Entry.CurseForgeSlug
ElseIf SplitedLine(0).Contains("@") Then
@@ -247,12 +248,26 @@
LastUpdate = Data("dateReleased") '#1194
DownloadCount = Data("downloadCount")
If Data("logo").Count > 0 Then LogoUrl = Data("logo")("thumbnailUrl")
'FileIndexes / GameVersions
Dim Files = If(CType(Data("latestFilesIndexes"), JArray), New JArray).
Where(Function(i) i("gameVersion").ToString.Contains("1."))
CurseForgeFileIds = Files.Select(Of Integer)(Function(v) v("fileId")).Distinct.ToList
GameVersions = Files.Select(Of Integer)(Function(v) Val(v("gameVersion").ToString.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
'FileIndexes / GameVersions / ModLoaders
ModLoaders = New List(Of CompModLoaderType)
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
For Each File In If(Data("latestFiles"), New JArray)
Dim NewFile As New CompFile(File, Type)
If Not NewFile.Available Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders)
Dim GameVersions = File("gameVersions").ToObject(Of List(Of String))
If Not GameVersions.Any(Function(v) v.StartsWithF("1.")) Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions))
Next
For Each File In If(Data("latestFilesIndexes"), New JArray) '这俩玩意儿包含的文件不一样,见 #3599
If Not File("gameVersion").ToString.StartsWithF("1.") Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("fileId"), {File("gameVersion").ToString}.ToList))
Next
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")).
Select(Function(v) CInt(Val(v.Split(".")(1).Split("-").First))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Type
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
Type = CompType.Mod
@@ -309,15 +324,7 @@
'FUTURE: Res
End Select
Next
If Tags.Count = 0 Then Tags.Add("杂项")
'ModLoaders
ModLoaders = New List(Of CompModLoaderType)
For Each File In If(Data("latestFiles"), {})
Dim NewFile As New CompFile(File, Type)
If Not NewFile.Available Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders)
Next
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
If Not Tags.Any() Then Tags.Add("杂项")
#End Region
Else
#Region "Modrinth"
@@ -334,7 +341,7 @@
'GameVersions
'搜索结果的键为 versions,获取特定工程的键为 game_versions
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWith("1.")).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")).
Select(Of Integer)(Function(v) Val(v.Split(".")(1).Split("-").First)).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
'Type
@@ -383,7 +390,7 @@
'FUTURE: Res
End Select
Next
If Tags.Count = 0 Then Tags.Add("杂项")
If Not Tags.Any() Then Tags.Add("杂项")
Tags.Sort()
ModLoaders.Sort()
#End Region
@@ -407,10 +414,10 @@
Json("Website") = Website
If LastUpdate IsNot Nothing Then Json("LastUpdate") = LastUpdate
Json("DownloadCount") = DownloadCount
If ModLoaders IsNot Nothing AndAlso ModLoaders.Count > 0 Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
Json("Tags") = New JArray(Tags)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If GameVersions.Count > 0 Then Json("GameVersions") = New JArray(GameVersions)
If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions)
Json("CacheTime") = Date.Now '用于检查缓存时间
Return Json
End Function
@@ -562,7 +569,7 @@
End If
Next
'根据分类后的结果处理
If NormalNameList.Count = 0 OrElse SubtitleList.Count = 0 Then GoTo NoSubtitle
If Not NormalNameList.Any() OrElse Not SubtitleList.Any() Then GoTo NoSubtitle
'同时包含 NormalName 和 Subtitle
Title = NormalNameList.Join(" - ")
Else
@@ -589,7 +596,7 @@
SubtitleList = SubtitleList.Distinct().ToList()
'设置标题与描述
Dim Subtitle As String = ""
If SubtitleList.Count > 0 Then
If SubtitleList.Any Then
For Each Ex In SubtitleList
Dim IsModLoaderDescription As Boolean =
Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt")
@@ -683,8 +690,8 @@ NoSubtitle:
''' </summary>
Public ReadOnly Property CanContinue As Boolean
Get
If Tag.StartsWith("/") OrElse Not Source.HasFlag(CompSourceType.CurseForge) Then Storage.CurseForgeTotal = 0
If Tag.EndsWith("/") OrElse Not Source.HasFlag(CompSourceType.Modrinth) Then Storage.ModrinthTotal = 0
If Tag.StartsWithF("/") OrElse Not Source.HasFlag(CompSourceType.CurseForge) Then Storage.CurseForgeTotal = 0
If Tag.EndsWithF("/") OrElse Not Source.HasFlag(CompSourceType.Modrinth) Then Storage.ModrinthTotal = 0
If Storage.CurseForgeTotal = -1 OrElse Storage.ModrinthTotal = -1 Then Return True
Return Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
End Get
@@ -732,7 +739,7 @@ NoSubtitle:
''' </summary>
Public Function GetCurseForgeAddress() As String
If Not Source.HasFlag(CompSourceType.CurseForge) Then Return Nothing
If Tag.StartsWith("/") Then Storage.CurseForgeTotal = 0
If Tag.StartsWithF("/") Then Storage.CurseForgeTotal = 0
If Storage.CurseForgeTotal > -1 AndAlso Storage.CurseForgeTotal <= Storage.CurseForgeOffset Then Return Nothing
'应用筛选参数
Dim Address As String = $"https://api.curseforge.com/v1/mods/search?gameId=432&sortField=2&sortOrder=desc&pageSize={CompPageSize}"
@@ -756,7 +763,7 @@ NoSubtitle:
''' </summary>
Public Function GetModrinthAddress() As String
If Not Source.HasFlag(CompSourceType.Modrinth) Then Return Nothing
If Tag.EndsWith("/") Then Storage.ModrinthTotal = 0
If Tag.EndsWithF("/") Then Storage.ModrinthTotal = 0
If Storage.ModrinthTotal > -1 AndAlso Storage.ModrinthTotal <= Storage.ModrinthOffset Then Return Nothing
'应用筛选参数
Dim Address As String = $"https://api.modrinth.com/v2/search?limit={CompPageSize}&index=relevance"
@@ -828,7 +835,7 @@ NoSubtitle:
Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,多于所需的 {Task.Input.TargetResultCount} 个结果,结束处理")
Exit Sub
ElseIf Not Task.Input.CanContinue Then
If Task.Input.Storage.Results.Count = 0 Then
If Not Task.Input.Storage.Results.Any() Then
Throw New Exception("没有符合条件的结果")
Else
Log($"[Comp] 已有 {Task.Input.Storage.Results.Count} 个结果,少于所需的 {Task.Input.TargetResultCount} 个结果,但无法继续获取,结束处理")
@@ -867,7 +874,7 @@ NoSubtitle:
Next
'获取搜索结果
Dim SearchResults = Search(SearchEntries, Task.Input.SearchText, 3)
If SearchResults.Count = 0 Then Throw New Exception("无搜索结果,请尝试搜索英文名称")
If Not SearchResults.Any() Then Throw New Exception("无搜索结果,请尝试搜索英文名称")
Dim SearchResult As String = ""
For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的,也最多只要 5 个
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
@@ -880,7 +887,7 @@ NoSubtitle:
'去除常见连接词
Dim RealFilter As String = ""
For Each Word In SearchResult.Split(" ")
If {"the", "of", "a", "mod", "and"}.Contains(Word.ToLower) OrElse Val(Word) > 0 Then Continue For
If {"the", "of", "a", "mod", "and"}.Contains(Word.ToLowerInvariant) OrElse Val(Word) > 0 Then Continue For
If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For
RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " "
Next
@@ -904,15 +911,15 @@ NoSubtitle:
End If
RightKeywords.Add(Keyword)
Next
If RawFilter.Length > 0 AndAlso RightKeywords.Count = 0 Then
If RawFilter.Length > 0 AndAlso Not RightKeywords.Any() Then
Task.Input.SearchText = RawFilter '全都被过滤掉了
Else
Task.Input.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower
End If
'例外项:OptiForge、OptiFabric(拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod)
If RawFilter.Replace(" ", "").ToLower.Contains("optiforge") Then Task.Input.SearchText = "optiforge"
If RawFilter.Replace(" ", "").ToLower.Contains("optifabric") Then Task.Input.SearchText = "optifabric"
If RawFilter.Replace(" ", "").ContainsF("optiforge", True) Then Task.Input.SearchText = "optiforge"
If RawFilter.Replace(" ", "").ContainsF("optifabric", True) Then Task.Input.SearchText = "optifabric"
Log("[Comp] 工程列表搜索最终文本:" & Task.Input.SearchText, LogLevel.Debug)
Task.Progress = 0.1
@@ -1003,15 +1010,15 @@ Retry:
'确保存在结果
Storage.ErrorMessage = Nothing
If RawResults.Count = 0 Then
If Not RawResults.Any() Then
If [Error] IsNot Nothing Then
Throw [Error]
Else
If IsChineseSearch AndAlso Task.Input.Type <> CompType.Mod Then
Throw New Exception($"{If(Task.Input.Type = CompType.ModPack, "整合包", "资源包")}搜索仅支持英文")
ElseIf Task.Input.Source = CompSourceType.CurseForge AndAlso Task.Input.Tag.StartsWith("/") Then
ElseIf Task.Input.Source = CompSourceType.CurseForge AndAlso Task.Input.Tag.StartsWithF("/") Then
Throw New Exception("CurseForge 不兼容所选的类型")
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWith("/") Then
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
Throw New Exception("Modrinth 不兼容所选的类型")
Else
Throw New Exception("没有符合条件的结果")
@@ -1171,7 +1178,7 @@ Retry:
''' </summary>
Public ReadOnly Property Available As Boolean
Get
Return FileName IsNot Nothing
Return FileName IsNot Nothing AndAlso DownloadUrls IsNot Nothing
End Get
End Property
''' <summary>
@@ -1181,7 +1188,11 @@ Retry:
''' <summary>
''' 文件所有可能的下载源。
''' </summary>
Private ReadOnly DownloadAddress As String()
Public DownloadUrls As List(Of String)
''' <summary>
''' 文件的 SHA1 或 MD5。
''' </summary>
Public ReadOnly Hash As String = Nothing
''' <summary>
''' 该文件的所有依赖工程的原始 ID。
''' 这些 ID 可能没有加载,在加载后会添加到 Dependencies 中(主要是因为 Modrinth 返回的是字符串 ID 而非 Slug,导致 Project.Id 查询不到)。
@@ -1196,7 +1207,7 @@ Retry:
''' </summary>
''' <param name="LocalAddress">目标本地文件夹,或完整的文件路径。会自动判断类型。</param>
Public Function ToNetFile(LocalAddress As String) As NetFile
Return New NetFile(DownloadAddress, LocalAddress & If(LocalAddress.EndsWith("\"), FileName, ""), UseBrowserUserAgent:=True)
Return New NetFile(DownloadUrls, LocalAddress & If(LocalAddress.EndsWithF("\"), FileName, ""), New FileChecker(Hash:=Hash), UseBrowserUserAgent:=True)
End Function
'实例化
@@ -1206,94 +1217,136 @@ Retry:
''' </summary>
Public Sub New(Data As JObject, Type As CompType)
Me.Type = Type
FromCurseForge = Data.ContainsKey("gameId")
If FromCurseForge Then
#Region "CurseForge"
'简单信息
Id = Data("id")
DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
ReleaseDate = Data("fileDate")
Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
DownloadCount = Data("downloadCount")
FileName = Data("fileName")
'DownloadAddress
Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
DownloadAddress = {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"),
Url}.Distinct.ToArray
'Dependencies
If Type = CompType.Mod Then
RawDependencies = Data("dependencies").
Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖
d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API
Select(Function(d) d("modId").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
'ModLoaders
ModLoaders = New List(Of CompModLoaderType)
If RawVersions.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawVersions.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawVersions.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
If RawVersions.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
If Data.ContainsKey("FromCurseForge") Then
#Region "CompJson"
FromCurseForge = Data("FromCurseForge").ToObject(Of Boolean)
Id = Data("Id").ToString
DisplayName = Data("DisplayName").ToString
ReleaseDate = Data("ReleaseDate").ToObject(Of Date)
DownloadCount = Data("DownloadCount").ToObject(Of Integer)
Status = CType(Data("Status").ToObject(Of Integer), CompFileStatus)
If Data.ContainsKey("FileName") Then FileName = Data("FileName").ToString
If Data.ContainsKey("DownloadUrls") Then DownloadUrls = Data("DownloadUrls").ToObject(Of List(Of String))
If Data.ContainsKey("ModLoaders") Then ModLoaders = Data("ModLoaders").ToObject(Of List(Of CompModLoaderType))
If Data.ContainsKey("Hash") Then Hash = Data("Hash").ToString
If Data.ContainsKey("GameVersions") Then GameVersions = Data("GameVersions").ToObject(Of List(Of String))
If Data.ContainsKey("RawDependencies") Then RawDependencies = Data("RawDependencies").ToObject(Of List(Of String))
If Data.ContainsKey("Dependencies") Then Dependencies = Data("Dependencies").ToObject(Of List(Of String))
#End Region
Else
#Region "Modrinth"
'简单信息
Id = Data("id")
DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ")
ReleaseDate = Data("date_published")
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads")
'可能为空
If CType(Data("files"), JArray).Count > 0 Then
FileName = Data("files")(0)("filename")
DownloadAddress = {Data("files")(0)("url").ToString.Replace(FileName, FileName)}
End If
'Dependencies
If Type = CompType.Mod Then
RawDependencies = Data("dependencies").
Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖
d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API
d("project_id").ToString.Length > 0). '有时候真的会空……
Select(Function(d) d("project_id").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWith("1.") OrElse v.StartsWith("b1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWith("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then
'无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
'ModLoaders
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
ModLoaders = New List(Of CompModLoaderType)
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
FromCurseForge = Data.ContainsKey("gameId")
If FromCurseForge Then
#Region "CurseForge"
'简单信息
Id = Data("id")
DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
ReleaseDate = Data("fileDate")
Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
DownloadCount = Data("downloadCount")
FileName = Data("fileName")
Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 1)?("value")
If Hash Is Nothing Then Hash = CType(Data("hashes"), JArray).ToList.FirstOrDefault(Function(s) s("algo").ToObject(Of Integer) = 2)?("value")
'DownloadAddress
Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
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("://edge", "://media"),
Url}).Distinct().ToList()
'Dependencies
If Type = CompType.Mod Then
RawDependencies = Data("dependencies").
Where(Function(d) d("relationType").ToObject(Of Integer) = 3 AndAlso '种类为依赖
d("modId").ToObject(Of Integer) <> 306612 AndAlso d("modId").ToObject(Of Integer) <> 634179). '排除 Fabric API 和 Quilt API
Select(Function(d) d("modId").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
'ModLoaders
ModLoaders = New List(Of CompModLoaderType)
If RawVersions.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawVersions.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawVersions.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
If RawVersions.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
#End Region
Else
#Region "Modrinth"
'简单信息
Id = Data("id")
DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ")
ReleaseDate = Data("date_published")
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads")
'可能为空
If CType(Data("files"), JArray).Any() Then
Dim File As JToken = Data("files")(0)
FileName = File("filename")
DownloadUrls = New List(Of String) From {File("url")}
Hash = File("hashes")("sha1")
End If
'Dependencies
If Type = CompType.Mod Then
RawDependencies = Data("dependencies").
Where(Function(d) d("dependency_type") = "required" AndAlso '种类为依赖
d("project_id") <> "P7dR8mSH" AndAlso d("project_id") <> "qvIfYCYJ" AndAlso '排除 Fabric API 和 Quilt API
d("project_id").ToString.Length > 0). '有时候真的会空……
Select(Function(d) d("project_id").ToString).ToList
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
Select(Function(v) If(v.Contains("-"), v.Split("-").First & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then
'无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
'ModLoaders
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
ModLoaders = New List(Of CompModLoaderType)
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
#End Region
End If
End If
End Sub
''' <summary>
''' 将当前实例转为可用于保存缓存的 Json。
''' </summary>
Public Function ToJson() As JObject
Dim Json As New JObject
Json.Add("FromCurseForge", FromCurseForge)
Json.Add("Id", Id)
Json.Add("DisplayName", DisplayName)
Json.Add("ReleaseDate", ReleaseDate)
Json.Add("DownloadCount", DownloadCount)
Json.Add("ModLoaders", New JArray(ModLoaders.Select(Function(m) CInt(m))))
Json.Add("GameVersions", New JArray(GameVersions))
Json.Add("Status", CInt(Status))
If FileName IsNot Nothing Then Json.Add("FileName", FileName)
If DownloadUrls IsNot Nothing Then Json.Add("DownloadUrls", New JArray(DownloadUrls))
If Hash IsNot Nothing Then Json.Add("Hash", Hash)
Json.Add("RawDependencies", New JArray(RawDependencies))
Json.Add("Dependencies", New JArray(Dependencies))
Return Json
End Function
''' <summary>
''' 将当前文件信息实例化为控件。
''' </summary>
Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing,
@@ -1303,9 +1356,9 @@ Retry:
Dim Info As String = ""
Select Case Type
Case CompType.Mod
Info += If(ModLoaders.Count > 0,
Info += If(ModLoaders.Any,
"适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & ",", "")
Info += If(ModeDebug AndAlso Dependencies.Count > 0, Dependencies.Count & " 个前置 Mod,", "")
Info += If(ModeDebug AndAlso Dependencies.Any, Dependencies.Count & " 个前置 Mod,", "")
Case CompType.ModPack
If GameVersions.All(Function(v) v.Contains("w")) Then
Info += $"游戏版本 {Join(GameVersions, "、")},"
@@ -1399,7 +1452,7 @@ Retry:
SelectMany(Function(f) f.RawDependencies).Distinct().ToList
Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
'获取前置 Mod 工程信息
If UndoneDeps.Count > 0 Then
If UndoneDeps.Any Then
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}")
Dim Projects As JArray
If TargetProject.FromCurseForge Then
@@ -1414,7 +1467,7 @@ Retry:
Next
End If
'更新前置 Mod 信息
If Deps.Count > 0 Then
If Deps.Any Then
For Each DepProject In Deps.Select(Function(id) CompProjectCache(id))
For Each File In CompFilesCache(ProjectId)
If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
@@ -1434,7 +1487,7 @@ Retry:
'如果为整合包就不会有 Dependencies 信息,所以不用管
Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
Deps.Sort()
If Deps.Count = 0 Then Exit Sub
If Not Deps.Any() Then Exit Sub
Deps = Deps.Where(Function(dep)
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
Return CompProjectCache.ContainsKey(dep)
@@ -80,7 +80,7 @@
Log(ex, "确认崩溃日志时间失败(" & LogFile & ")")
End Try
Next
If RightLogs.Count = 0 Then Log("[Crash] 未发现可能可用的日志文件")
If Not RightLogs.Any() Then Log("[Crash] 未发现可能可用的日志文件")
'将可能可用的日志文件导出
For Each FilePath In RightLogs
@@ -94,7 +94,7 @@
Log(ex, "读取可能的崩溃日志文件失败(" & FilePath & ")")
End Try
Next
If LatestLog IsNot Nothing AndAlso LatestLog.Count > 0 Then
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
Dim RawOutput As String = Join(LatestLog, vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容:" & vbCrLf & RawOutput)
WriteFile(TempFolder & "RawOutput.log", RawOutput)
@@ -110,21 +110,20 @@
Public Sub Import(FilePath As String)
Log("[Crash] 步骤 1:自主导入日志文件")
'解压压缩包
'尝试视作压缩包解压
Try
Dim Info As New FileInfo(FilePath)
If Not Info.Exists OrElse Info.Length = 0 Then Exit Try
If Not FilePath.ToLower.EndsWith(".jar") AndAlso ExtractFile(FilePath, TempFolder & "Temp\") Then
'解压成功
If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then
ExtractFile(FilePath, TempFolder & "Temp\")
Log("[Crash] 已解压导入的日志文件:" & FilePath)
Else
'解压失败
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
Log("[Crash] 已复制导入的日志文件:" & FilePath)
GoTo Extracted
End If
Catch ex As Exception
Log(ex, "解压导入文件中的压缩包失败")
Catch
End Try
'并非压缩包
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
Log("[Crash] 已复制导入的日志文件:" & FilePath)
Extracted:
'导入其中的日志文件
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList()
@@ -132,7 +131,7 @@
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.ToLower
If Ext = ".log" OrElse Ext = ".txt" Then
If TargetFile.Name.StartsWith("crash-") Then
If TargetFile.Name.StartsWithF("crash-") Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
Else
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName, Encoding.UTF8).Split(vbCrLf.ToCharArray)))
@@ -169,10 +168,10 @@
For Each LogFile In AnalyzeRawFiles
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower
Dim TargetType As AnalyzeFileType
If MatchName.StartsWith("hs_err") Then
If MatchName.StartsWithF("hs_err") Then
TargetType = AnalyzeFileType.HsErr
DirectFile = LogFile
ElseIf MatchName.StartsWith("crash-") Then
ElseIf MatchName.StartsWithF("crash-") Then
TargetType = AnalyzeFileType.CrashReport
DirectFile = LogFile
ElseIf MatchName = "latest.log" OrElse MatchName = "latest log.txt" OrElse
@@ -187,13 +186,13 @@
Else
TargetType = AnalyzeFileType.ExtraLog
End If
ElseIf MatchName.EndsWith(".log") OrElse MatchName.EndsWith(".txt") Then
ElseIf MatchName.EndsWithF(".log", True) OrElse MatchName.EndsWithF(".txt", True) Then
TargetType = AnalyzeFileType.ExtraLog
Else
Log("[Crash] " & MatchName & " 分类为 Ignore")
Continue For
End If
If LogFile.Value.Count = 0 Then
If Not LogFile.Value.Any() Then
Log("[Crash] " & MatchName & " 由于内容为空跳过")
Else
TotalFiles.Add(New KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))(TargetType, LogFile))
@@ -208,7 +207,7 @@
For Each File In TotalFiles
If SelectType = File.Key Then SelectedFiles.Add(File.Value)
Next
If SelectedFiles.Count = 0 Then Continue For
If Not SelectedFiles.Any() Then Continue For
Try
'根据文件类别判断
Select Case SelectType
@@ -389,9 +388,9 @@
'1. 精准日志匹配,中/高优先级
AnalyzeCrit1()
If CrashReasons.Count > 0 Then GoTo Done
If CrashReasons.Any Then GoTo Done
AnalyzeCrit2()
If CrashReasons.Count > 0 Then GoTo Done
If CrashReasons.Any Then GoTo Done
'2. 堆栈分析
If LogAll.Contains("orge") OrElse LogAll.Contains("abric") OrElse LogAll.Contains("uilt") OrElse LogAll.Contains("iteloader") Then
@@ -406,7 +405,7 @@
If LogMc IsNot Nothing Then
Dim Fatals = RegexSearch(LogMc, "/FATAL] [\w\W]+?(?=[\n]+\[)")
Log("[Crash] 开始进行 Minecraft 日志堆栈分析,发现 " & Fatals.Count & " 个报错项")
If Fatals.Count > 0 Then
If Fatals.Any Then
For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next
@@ -419,7 +418,7 @@
Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
End If
'Mod 名称分析
If Keywords.Count > 0 Then
If Keywords.Any Then
Dim Names = AnalyzeModName(Keywords)
If Names Is Nothing Then
AppendReason(CrashReason.堆栈分析发现关键字, Keywords)
@@ -437,12 +436,12 @@
'输出到日志
Done:
If CrashReasons.Count = 0 Then
If Not CrashReasons.Any() Then
Log("[Crash] 步骤 3:分析崩溃原因完成,未找到可能的原因")
Else
Log("[Crash] 步骤 3:分析崩溃原因完成,找到 " & CrashReasons.Count & " 条可能的原因")
For Each Reason In CrashReasons
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Count > 0, "(" & Join(Reason.Value, ";") & ")", ""))
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "(" & Join(Reason.Value, ";") & ")", ""))
Next
End If
End Sub
@@ -458,7 +457,7 @@ Done:
Else
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
End If
Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Count > 0, "(" & Join(Additional, ";") & ")", ""))
Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "(" & Join(Additional, ";") & ")", ""))
End Sub
Private Sub AppendReason(Reason As CrashReason, Additional As String)
AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional}))
@@ -567,7 +566,6 @@ Done:
End If
End If
If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)})
End If
@@ -584,6 +582,7 @@ Done:
'常规信息
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
End If
@@ -611,6 +610,9 @@ Done:
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json)")
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
Else
'在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
'极短的程序输出
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
@@ -645,14 +647,14 @@ Done:
"org.lwjgl", "com.sun", "net.minecraftforge", "paulscode.sound", "com.mojang", "net.minecraft", "cpw.mods", "com.google", "org.apache", "org.spongepowered", "net.fabricmc", "com.mumfrey",
"com.electronwill.nightconfig", "it.unimi.dsi",
"MojangTricksIntelDriversForPerformance_javaw"}
If Stack.StartsWith(IgnoreStack) Then GoTo NextStack
If Stack.StartsWithF(IgnoreStack) Then GoTo NextStack
Next
PossibleStacks.Add(Stack.Trim) '.Split("$").First)
NextStack:
Next
PossibleStacks = PossibleStacks.Distinct.ToList
Log("[Crash] 找到 " & PossibleStacks.Count & " 条可能的堆栈信息")
If PossibleStacks.Count = 0 Then Return New List(Of String)
If Not PossibleStacks.Any() Then Return New List(Of String)
For Each Stack As String In PossibleStacks
Log("[Crash] - " & Stack)
Next
@@ -663,7 +665,7 @@ NextStack:
Dim Splited = Stack.Split(".")
For i = 0 To Math.Min(3, Splited.Count - 1) '最多取前 4 节
Dim Word As String = Splited(i)
If Word.Length <= 2 OrElse Word.StartsWith("func_") Then Continue For
If Word.Length <= 2 OrElse Word.StartsWithF("func_") Then Continue For
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty",
@@ -677,7 +679,7 @@ NextStack:
Next
PossibleWords = PossibleWords.Distinct.ToList
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
If PossibleWords.Count > 0 Then Log("[Crash] - " & Join(PossibleWords, ", "))
If PossibleWords.Any Then Log("[Crash] - " & Join(PossibleWords, ", "))
If PossibleWords.Count > 10 Then
Log("[Crash] 关键词过多,考虑匹配出错,不纳入考虑")
Return New List(Of String)
@@ -716,8 +718,8 @@ NextStack:
'[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf)
If Line.ToLower.Contains(".jar") OrElse
(IsFabricDetail AndAlso Line.StartsWith(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
If Line.ContainsF(".jar", True) OrElse
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
@@ -782,7 +784,7 @@ NextStack:
'输出
ModFileNames = ModFileNames.Distinct.ToList
If ModFileNames.Count = 0 Then
If Not ModFileNames.Any() Then
Return Nothing
Else
Log("[Crash] 找到 " & ModFileNames.Count & " 个可能的崩溃 Mod 文件名")
@@ -846,7 +848,7 @@ NextStack:
FileName = "游戏崩溃前的输出.txt"
End Select
If File.Exists(OutputFile) Then
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile)))
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*")))
End If
Next
'导出报告
@@ -866,7 +868,7 @@ NextStack:
Private Function GetAnalyzeResult(IsHandAnalyze As Boolean) As String
'没有结果的处理
If CrashReasons.Count = 0 Then
If Not CrashReasons.Any() Then
If IsHandAnalyze Then
Return "很抱歉,PCL 无法确定错误原因。"
Else
@@ -902,7 +904,7 @@ NextStack:
Results.Add("你正在使用 32 位的操作系统,这会导致 Minecraft 无法使用所需的内存,进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内,那或许只能换台电脑了……\h")
End If
Case CrashReason.Mod缺少前置或MC版本错误
If Additional.Count > 0 Then
If Additional.Any Then
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n未满足的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
@@ -1034,7 +1036,7 @@ NextStack:
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
Trim(vbCrLf.ToCharArray) &
If(Not Results.Any(Function(r) r.EndsWith("\h")) OrElse IsHandAnalyze, "",
If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" &
If(If(PageSetupSystem.IsLauncherNewest(), True), "",
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新到最新版可能会修复这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
@@ -57,9 +57,9 @@
#Region "下载支持库文件"
Dim LoadersLib As New List(Of LoaderBase) From {
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
}
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
}
'构造加载器
Loaders.Add(New LoaderCombo(Of String)("下载支持库文件(主加载器)", LoadersLib) With {.Block = False, .Show = False, .ProgressWeight = 16})
#End Region
@@ -71,19 +71,19 @@
Dim LoadersAssets As New List(Of LoaderBase)
'获取资源文件索引地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim IndexFile = DlClientAssetIndexGet(Version)
Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
Task.Output = New List(Of NetFile) From {IndexFile}
End If
Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex)
End Try
End Sub) With {.ProgressWeight = 0.5, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim IndexFile = DlClientAssetIndexGet(Version)
Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath)
If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
Task.Output = New List(Of NetFile) From {IndexFile}
End If
Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex)
End Try
End Sub) With {.ProgressWeight = 0.5, .Show = False})
'下载资源文件索引
LoadersAssets.Add(New LoaderDownload("下载资源文件索引", New List(Of NetFile)) With {.ProgressWeight = 2})
'要求独立更新索引
@@ -91,27 +91,29 @@
Dim LoadersAssetsUpdate As New List(Of LoaderBase)
Dim TempAddress As String = Nothing
Dim RealAddress As String = Nothing
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址", Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
BackAssetsFile.LocalPath = TempAddress
Task.Output = New List(Of NetFile) From {BackAssetsFile}
End Sub))
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version)
RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
BackAssetsFile.LocalPath = TempAddress
Task.Output = New List(Of NetFile) From {BackAssetsFile}
End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引", Sub(Task As LoaderTask(Of List(Of NetFile), String))
CopyFile(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功:" & TempAddress)
End Sub))
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
Sub(Task As LoaderTask(Of List(Of NetFile), String))
CopyFile(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功:" & TempAddress)
End Sub))
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
Log("[Download] 开始后台更新资源文件索引")
Updater.Start()
End If
'获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
'下载资源文件
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
'构造加载器
@@ -248,7 +250,7 @@
End Select
'确认版本格式标准
Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4
If Id <> "1.0" AndAlso Id.EndsWith(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
If Id <> "1.0" AndAlso Id.EndsWithF(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
'查找版本并开始
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then
@@ -306,7 +308,7 @@
Return _inherit
End Get
Set(value As String)
If value.EndsWith(".0") Then value = Left(value, value.Length - 2)
If value.EndsWithF(".0") Then value = Left(value, value.Length - 2)
_inherit = value
End Set
End Property
@@ -366,9 +368,9 @@
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ToLower.Contains("pre"),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ToLower.Contains("pre"), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
@@ -389,7 +391,7 @@
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "",
.IsPreview = Token("patch").ToString.ToLower.Contains("pre"),
.IsPreview = Token("patch").ToString.ContainsF("pre", True),
.Inherit = Token("mcversion").ToString,
.NameFile = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
@@ -601,7 +603,7 @@
Dim Versions As New List(Of DlForgeVersionEntry)
Try
'分割版本信息
Dim VersionCodes = Mid(Result, 1, Result.LastIndexOf("</table>")).Split("<td class=""download-version")
Dim VersionCodes = Mid(Result, 1, Result.LastIndexOfF("</table>")).Split("<td class=""download-version")
'获取所有版本信息
For i = 1 To VersionCodes.Count - 1
Dim VersionCode = VersionCodes(i)
@@ -626,17 +628,17 @@
Dim MD5 As String, Category As String
If VersionCode.Contains("classifier-installer""") Then
'类型为 installer.jar,支持范围 ~753 (~ 1.6.1 部分), 738~684 (1.5.2 全部)
VersionCode = VersionCode.Substring(VersionCode.IndexOf("installer.jar"))
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("installer.jar"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "installer"
ElseIf VersionCode.Contains("classifier-universal""") Then
'类型为 universal.zip,支持范围 751~449 (1.6.1 部分), 682~183 (1.5.1 ~ 1.3.2 部分)
VersionCode = VersionCode.Substring(VersionCode.IndexOf("universal.zip"))
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("universal.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "universal"
ElseIf VersionCode.Contains("client.zip") Then
'类型为 client.zip,支持范围 182~ (1.3.2 部分 ~)
VersionCode = VersionCode.Substring(VersionCode.IndexOf("client.zip"))
VersionCode = VersionCode.Substring(VersionCode.IndexOfF("client.zip"))
MD5 = RegexSeek(VersionCode, "(?<=MD5:</strong> )[^<]+")
Category = "client"
Else
@@ -652,7 +654,7 @@
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result & ")", ex)
End Try
If Versions.Count = 0 Then Throw New Exception("没有可用版本")
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
End Sub
@@ -708,7 +710,7 @@
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
End Try
If Versions.Count = 0 Then Throw New Exception("没有可用版本")
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
End Sub
@@ -799,7 +801,7 @@
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
For Each Pair As KeyValuePair(Of String, JToken) In Json
If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For
If Pair.Key.StartsWithF("1.6") OrElse Pair.Key.StartsWithF("1.5") Then Continue For
Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key,
@@ -827,7 +829,7 @@
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
For Each Pair As KeyValuePair(Of String, JToken) In Json
If Pair.Key.StartsWith("1.6") OrElse Pair.Key.StartsWith("1.5") Then Continue For
If Pair.Key.StartsWithF("1.6") OrElse Pair.Key.StartsWithF("1.5") Then Continue For
Dim RealEntry As JToken = If(Pair.Value("artefacts"), Pair.Value("snapshots"))("com.mumfrey:liteloader")("latest")
Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key,
@@ -62,7 +62,7 @@
Public ReadOnly Property HasEnvironment As Boolean
Get
If PathFolder Is Nothing OrElse PathEnv Is Nothing Then Return False
Return PathEnv.Replace("\", "").Replace("/", "").ToLower.Contains(PathFolder.Replace("\", "").ToLower)
Return PathEnv.Replace("\", "").Replace("/", "").ContainsF(PathFolder.Replace("\", ""), True)
End Get
End Property
@@ -78,8 +78,8 @@
''' </summary>
Public Overrides Function ToString() As String
Dim VersionString = Version.ToString
If VersionString.StartsWith("1.") Then VersionString = Mid(VersionString, 3)
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")," & If(Is64Bit, "64", "32") & " 位" & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3)
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")" & If(Is64Bit, "", ",32 位") & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
End Function
'构造
@@ -87,7 +87,7 @@
''' 输入 javaw.exe 文件所在文件夹的路径,不限制结尾。
''' </summary>
Public Sub New(Folder As String, IsUserImport As Boolean)
If Not Folder.EndsWith("\") Then Folder += "\"
If Not Folder.EndsWithF("\") Then Folder += "\"
PathFolder = Folder.Replace("/", "\")
Me.IsUserImport = IsUserImport
End Sub
@@ -116,8 +116,9 @@
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
'获取详细信息
Dim VersionString = If(RegexSeek(Output, "(?<=version "")[^""]+"), If(RegexSeek(Output, "(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First
If VersionString.Split(".").Count > 4 Then VersionString = VersionString.Replace(".0.", ".") '#3493,VersionString = "21.0.2.0.2"
Do While VersionString.Split(".").Count < 4
If VersionString.StartsWith("1.") Then
If VersionString.StartsWithF("1.") Then
VersionString = VersionString & ".0"
Else
VersionString = "1." & VersionString
@@ -184,7 +185,7 @@
JavaList.Add(JavaEntry.FromJson(JsonEntry))
Next
End If
If JavaList.Count = 0 Then
If Not JavaList.Any() Then
Log("[Java] 初始化未找到可用的 Java,将自动触发搜索", LogLevel.Developer)
JavaSearchLoader.Start(0)
Else
@@ -219,7 +220,7 @@
Next
'检查特定的 Java
If TargetJavaList.Count > 0 Then
If TargetJavaList.Any Then
TargetJavaList = JavaCheckList(TargetJavaList)
Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定路径下的 Java:")
For Each Java In TargetJavaList
@@ -232,7 +233,7 @@
Dim UserJava As JavaEntry = Nothing
'获取版本独立设置中指定的 Java
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWith("{") Then
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)))
UserJava.Check()
@@ -291,7 +292,7 @@ RetryGet:
Next
'若未找到适合的 Java,尝试触发搜索
If AllowedJavaList.Count = 0 AndAlso JavaSearchLoader.State = LoadState.Waiting Then
If Not AllowedJavaList.Any() AndAlso JavaSearchLoader.State = LoadState.Waiting Then
Log("[Java] 未找到满足条件的 Java,尝试进行搜索")
JavaSearchLoader.Start(IsForceRestart:=True)
GoTo RetryGet
@@ -352,7 +353,7 @@ ExitUserJavaCheck:
#End Region
'若依然未找到适合的 Java,直接返回
If AllowedJavaList.Count = 0 Then Return Nothing
If Not AllowedJavaList.Any() Then Return Nothing
'优先使用特定目录下的 Java
For Each Java In AllowedJavaList
@@ -445,11 +446,11 @@ NoUserJava:
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(New DirectoryInfo(Path).Parent, New DirectoryInfo(Path)).FullName
If PathMcFolder <> "" Then MinecraftPathParent = If(New DirectoryInfo(PathMcFolder).Parent, New DirectoryInfo(PathMcFolder)).FullName
If Left.PathFolder.StartsWith(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWith(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWith(ProgramPathParent) AndAlso Right.PathFolder.StartsWith(ProgramPathParent) Then Return False
If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
If PathMcFolder <> "" Then
If Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWith(MinecraftPathParent) Then Return True
If Not Left.PathFolder.StartsWith(MinecraftPathParent) AndAlso Right.PathFolder.StartsWith(MinecraftPathParent) Then Return False
If Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return False
End If
'2. 尽量使用 64 位
If Left.Is64Bit AndAlso Not Right.Is64Bit Then Return True
@@ -459,7 +460,7 @@ NoUserJava:
If Not Left.IsJre AndAlso Right.IsJre Then Return False
'4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20...
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21...
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28}
Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
End If
@@ -500,7 +501,7 @@ NoUserJava:
For Each PathInEnv As String In Split((PathEnv & ";" & PathJavaHome).Replace("\\", "\").Replace("/", "\"), ";")
PathInEnv = PathInEnv.Trim(" """.ToCharArray())
If PathInEnv = "" Then Continue For
If Not PathInEnv.EndsWith("\") Then PathInEnv += "\"
If Not PathInEnv.EndsWithF("\") Then PathInEnv += "\"
'粗略检查有效性
If File.Exists(PathInEnv & "javaw.exe") Then JavaPreList(PathInEnv) = False
Next
@@ -533,7 +534,7 @@ NoUserJava:
Log("[Java] 位于 " & Folder & " 的 Java 不含符号链接")
JavaWithoutReparse.Add(Pair.Key, Pair.Value)
Next
If JavaWithoutReparse.Count > 0 Then JavaPreList = JavaWithoutReparse
If JavaWithoutReparse.Any Then JavaPreList = JavaWithoutReparse
'若不全为特殊引用,则清除特殊引用的地址
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
@@ -545,7 +546,7 @@ NoUserJava:
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
End If
Next
If JavaWithoutInherit.Count > 0 Then JavaPreList = JavaWithoutInherit
If JavaWithoutInherit.Any Then JavaPreList = JavaWithoutInherit
#End Region
@@ -652,7 +653,7 @@ Wait:
'确认目录存在
If Not OriginalPath.Exists Then Exit Sub
Dim Path As String = OriginalPath.FullName.Replace("\\", "\")
If Not Path.EndsWith("\") Then Path += "\"
If Not Path.EndsWithF("\") Then Path += "\"
'若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹
@@ -715,7 +716,7 @@ Wait:
End Function
''' <summary>
''' 获取下载 Java 8/14/17 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' 获取下载 Java 8/14/17/21 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' </summary>
Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer)
Return New LoaderCombo(Of Integer)($"下载 Java {Version}", {
@@ -734,7 +735,7 @@ Wait:
Dim MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项(最新)
SelectMany(Function(e As JProperty) CType(e.Value, JArray).Select(Function(v) New KeyValuePair(Of String, JObject)(e.Name, v)))
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWith(Loader.Input))
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWithF(Loader.Input))
Dim Address As String = TargetEntry.Value("manifest")("url")
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}")
'获取文件列表
@@ -62,7 +62,7 @@ Public Module ModLaunch
''' 记录启动日志。
''' </summary>
Public Sub McLaunchLog(Text As String)
Text = SecretFilter(Text)
Text = SecretFilter(Text, "*")
RunInUi(Sub() FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text)
Log("[Launch] " & Text)
End Sub
@@ -101,10 +101,10 @@ Public Module ModLaunch
'正式加载
Try
'构造主加载器
Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False, .Show = False},
Dim Loaders As New List(Of LoaderBase) From {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
McLoginLoader,
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False, .Block = True},
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False},
New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
@@ -112,7 +112,12 @@ Public Module ModLaunch
New LoaderTask(Of Integer, Process)("启动进程", AddressOf McLaunchRun) With {.ProgressWeight = 2},
New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
}) With {.Show = False}
}
If Setup.Get("LaunchArgumentRam") Then
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
End If
Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False}
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
'等待加载器执行并更新 UI
McLaunchLoaderReal = LaunchLoader
@@ -143,7 +148,7 @@ Public Module ModLaunch
Catch ex As Exception
Dim CurrentEx = ex
NextInner:
If CurrentEx.Message.StartsWith("$") Then
If CurrentEx.Message.StartsWithF("$") Then
'若有以 $ 开头的错误信息,则以此为准显示提示
'若错误信息为 $$,则不提示
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
@@ -163,6 +168,28 @@ NextInner:
#End Region
#Region "内存优化"
Private Sub McLaunchMemoryOptimize(Loader As LoaderTask(Of Integer, Integer))
McLaunchLog("内存优化开始")
Dim Finished As Boolean = False
RunInNewThread(
Sub()
PageOtherTest.MemoryOptimize(False)
Finished = True
End Sub, "Launch Memory Optimize")
Do While Not Finished AndAlso Not Loader.IsAborted
If Loader.Progress < 0.7 Then
Loader.Progress += 0.007 '10s
Else
Loader.Progress += (0.95 - Loader.Progress) * 0.02 '最快 += 0.005
End If
Thread.Sleep(100)
Loop
End Sub
#End Region
#Region "预检测"
Private Sub McLaunchPrecheck()
@@ -247,7 +274,7 @@ NextInner:
''' </summary>
Public BaseUrl As String
''' <summary>
''' 登录所使用的标识符,如 “Mojang”、“Nide”,用于存储缓存等。
''' 登录所使用的标识符,目前只可能为 “Auth” 或 “Nide”,用于存储缓存等。
''' </summary>
Public Token As String
''' <summary>
@@ -526,7 +553,13 @@ SkipLogin:
McLaunchLog("登录方式:" & Input.Description & "(" & LogUsername & ")")
Data.Progress = 0.05
'尝试登录
If (Not Data.Input.ForceReselectProfile) AndAlso Setup.Get("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso Setup.Get("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso Not Setup.Get("Cache" & Input.Token & "Access") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Client") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Uuid") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Name") = "" Then
If (Not Data.Input.ForceReselectProfile) AndAlso
Setup.Get("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso
Setup.Get("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso
Setup.Get("Cache" & Input.Token & "Access") <> "" AndAlso
Setup.Get("Cache" & Input.Token & "Client") <> "" AndAlso
Setup.Get("Cache" & Input.Token & "Uuid") <> "" AndAlso
Setup.Get("Cache" & Input.Token & "Name") <> "" Then
'尝试验证登录
Try
If Data.IsAborted Then Throw New ThreadInterruptedException
@@ -752,7 +785,7 @@ LoginFinish:
End Select
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
Throw New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
ElseIf ex.Message.StartsWith("$") Then
ElseIf ex.Message.StartsWithF("$") Then
Throw
Else
Throw New Exception("登录失败:" & ex.Message, ex)
@@ -990,14 +1023,14 @@ SystemBrowser:
Case 1
'Steve
Do Until McSkinSex(Uuid) = "Steve"
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
Loop
Case 2
'Alex
Do Until McSkinSex(Uuid) = "Alex"
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
Loop
Case 3
'使用正版用户名
@@ -1013,7 +1046,7 @@ SystemBrowser:
Case 4
'自定义
Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
End Select
@@ -1057,7 +1090,12 @@ SystemBrowser:
Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
'MC 大版本检测
If (McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
If (McVersionCurrent.ReleaseTime >= New Date(2024, 4, 2) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
(McVersionCurrent.Version.McCodeMain > 20 AndAlso McVersionCurrent.Version.McCodeMain <> 99) OrElse
(McVersionCurrent.Version.McCodeMain = 20 AndAlso McVersionCurrent.Version.McCodeSub >= 5) Then
'1.20.5+(24w14a+):至少 Java 21
MinVer = New Version(1, 21, 0, 0)
ElseIf (McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16) AndAlso McVersionCurrent.Version.McCodeMain = 99) OrElse
(McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain <> 99) Then
'1.18 pre2+:至少 Java 17
MinVer = New Version(1, 17, 0, 0)
@@ -1091,22 +1129,25 @@ SystemBrowser:
If McVersionCurrent.Version.HasForge Then
If McVersionCurrent.Version.McName = "1.7.2" Then
'1.7.2:必须 Java 7
MinVer = New Version(1, 7, 0, 0) : MaxVer = New Version(1, 7, 999, 999)
MinVer = If(New Version(1, 7, 0, 0) > MinVer, New Version(1, 7, 0, 0), MinVer)
MaxVer = If(New Version(1, 7, 999, 999) < MaxVer, New Version(1, 7, 999, 999), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
'<=1.12:Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain >= 13 Then
'1.13 - 1.14:Java 8 - 10
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 10, 999, 999)
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
MaxVer = If(New Version(1, 10, 999, 999) < MaxVer, New Version(1, 10, 999, 999), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain = 15 Then
'1.15:Java 8 - 15
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999)
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
MaxVer = If(New Version(1, 15, 999, 999) < MaxVer, New Version(1, 15, 999, 999), MaxVer)
ElseIf VersionSortBoolean(McVersionCurrent.Version.ForgeVersion, "34.0.0") AndAlso VersionSortBoolean("36.2.25", McVersionCurrent.Version.ForgeVersion) Then
'1.16,Forge 34.X ~ 36.2.25:最高 Java 8u320
MaxVer = New Version(1, 8, 0, 320)
MaxVer = If(New Version(1, 8, 0, 320) < MaxVer, New Version(1, 8, 0, 320), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 19 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305
'1.18:若安装了 OptiFine,最高 Java 18
MaxVer = New Version(1, 18, 999, 999)
MaxVer = If(New Version(1, 18, 999, 999) < MaxVer, New Version(1, 18, 999, 999), MaxVer)
End If
End If
@@ -1114,10 +1155,10 @@ SystemBrowser:
If McVersionCurrent.Version.HasFabric Then
If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then
'1.15 - 1.16:Java 8+
MinVer = New Version(1, 8, 0, 0)
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 Then
'1.18+:Java 17+
MinVer = New Version(1, 17, 0, 0)
MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer)
End If
End If
@@ -1140,7 +1181,10 @@ SystemBrowser:
If Task.IsAborted Then Exit Sub '中断加载会导致 JavaSelect 异常地返回空值,误判找不到 Java
McLaunchLog("无合适的 Java,需要确认是否自动下载")
Dim JavaCode As String
If MinVer >= New Version(1, 9, 0, 0) Then
If MinVer >= New Version(1, 21, 0, 0) Then
JavaCode = 21
If Not JavaDownloadConfirm("Java 21") Then Throw New Exception("$$")
ElseIf MinVer >= New Version(1, 9, 0, 0) Then
JavaCode = 17
If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 0) Then
@@ -1194,17 +1238,20 @@ SystemBrowser:
''' </summary>
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
WriteFile(WrapperPath, GetResources("JavaWrapper"))
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
WriteFile(WrapperPath, GetResources("JavaWrapper"))
End SyncLock
Log("[Java] 已释放 Java Wrapper:" & WrapperPath)
Return WrapperPath
End Function
Private ExtractJavaWrapperLock As New Object
''' <summary>
''' 获取 Java Wrapper 所在的文件夹,不以 \ 结尾。
''' </summary>
Public Function GetJavaWrapperDir() As String
If Encoding.UTF8.GetByteCount(PathAppdata) = PathAppdata.Length Then
If PathAppdata.IsASCII() Then
Return PathAppdata.TrimEnd("\")
ElseIf Encoding.UTF8.GetByteCount(PathTemp) = PathTemp.Length Then
ElseIf PathTemp.IsASCII() Then
Log("[Java] Wrapper:AppData 路径中包含非 ASCII 字符,换用 Temp 目录")
Return PathTemp.TrimEnd("\")
Else
@@ -1268,9 +1315,7 @@ SystemBrowser:
'不包含端口号
Arguments += " --server " & Server & " --port 25565"
End If
If McVersionCurrent.Version.HasOptiFine Then 'OptiFine 警告
Hint("OptiFine 与自动进入服务器可能不兼容,有概率导致材质丢失甚至游戏崩溃!", HintType.Critical)
End If
If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容,有概率导致材质丢失甚至游戏崩溃!", HintType.Critical)
End If
End If
'自定义
@@ -1292,10 +1337,11 @@ SystemBrowser:
Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm")
If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理
DataList.Insert(0, ArgumentJvm) '可变 JVM 参数
DataList.Add("-Xmn256m")
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.5) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
DataList.Add("""-Djava.library.path=" & Version.Path & Version.Name & "-natives""")
DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """")
DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表
'统一通行证
@@ -1394,9 +1440,9 @@ NextVersion:
Dim DeDuplicateDataList As New List(Of String)
For i = 0 To DataList.Count - 1
Dim CurrentEntry As String = DataList(i)
If DataList(i).StartsWith("-") Then
If DataList(i).StartsWithF("-") Then
Do While i < DataList.Count - 1
If DataList(i + 1).StartsWith("-") Then
If DataList(i + 1).StartsWithF("-") Then
Exit Do
Else
i += 1
@@ -1407,6 +1453,9 @@ NextVersion:
DeDuplicateDataList.Add(CurrentEntry.Trim.Replace("McEmu= ", "McEmu="))
Next
'#3511 的清理
DeDuplicateDataList.Remove("-XX:MaxDirectMemorySize=256M")
'去重
Dim Result As String = Join(DeDuplicateDataList.Distinct.ToList, " ")
@@ -1487,9 +1536,9 @@ NextVersion:
Dim DeDuplicateDataList As New List(Of String)
For i = 0 To DataList.Count - 1
Dim CurrentEntry As String = DataList(i)
If DataList(i).StartsWith("-") Then
If DataList(i).StartsWithF("-") Then
Do While i < DataList.Count - 1
If DataList(i + 1).StartsWith("-") Then
If DataList(i + 1).StartsWithF("-") Then
Exit Do
Else
i += 1
@@ -1527,7 +1576,7 @@ NextVersion:
'基础参数
GameArguments.Add("${classpath_separator}", ";")
GameArguments.Add("${natives_directory}", Version.Path & Version.Name & "-natives")
GameArguments.Add("${natives_directory}", GetNativesFolder())
GameArguments.Add("${library_directory}", PathMcFolder & "libraries")
GameArguments.Add("${libraries_directory}", PathMcFolder & "libraries")
GameArguments.Add("${launcher_name}", "PCL")
@@ -1544,9 +1593,26 @@ NextVersion:
GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${user_type}", "msa") '#1221
Dim GameSize As Size = Setup.GetLaunchArgumentWindowSize()
GameArguments.Add("${resolution_width}", GameSize.Width)
GameArguments.Add("${resolution_height}", GameSize.Height)
'窗口尺寸参数
Dim GameSize As Size
Select Case Setup.Get("LaunchArgumentWindowType")
Case 2
Dim Result As Size
RunInUiWait(Sub() Result = New Size(GetPixelSize(FrmMain.PanForm.ActualWidth), GetPixelSize(FrmMain.PanForm.ActualHeight)))
GameSize = Result
Case 3
GameSize = New Size(Math.Max(100, Setup.Get("LaunchArgumentWindowWidth") - 2), Math.Max(100, Setup.Get("LaunchArgumentWindowHeight") - 2))
Case Else
GameSize = New Size(875 - 2, 540 - 2)
End Select
GameSize.Height -= 29.5 * DPI / 96 '标题栏高度
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 Then '修复 #3463:1.12.2-,JRE 8 下窗口大小为设置大小的 DPI% 倍
GameSize.Width /= DPI / 96
GameSize.Height /= DPI / 96
End If
GameArguments.Add("${resolution_width}", Math.Round(GameSize.Width))
GameArguments.Add("${resolution_height}", Math.Round(GameSize.Height))
'Assets 相关参数
GameArguments.Add("${game_assets}", PathMcFolder & "assets\virtual\legacy") '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
@@ -1578,7 +1644,8 @@ NextVersion:
Private Sub McLaunchNatives(Loader As LoaderTask(Of List(Of McLibToken), Integer))
'创建文件夹
Directory.CreateDirectory(McVersionCurrent.Path & McVersionCurrent.Name & "-natives")
Dim Target As String = GetNativesFolder() & "\"
Directory.CreateDirectory(Target)
'解压文件
McLaunchLog("正在解压 Natives 文件")
@@ -1595,9 +1662,9 @@ NextVersion:
End Try
For Each Entry In Zip.Entries
Dim FileName As String = Entry.FullName
If FileName.EndsWith(".dll") Then
If FileName.EndsWithF(".dll", True) Then
'实际解压文件的步骤
Dim FilePath As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives\" & FileName
Dim FilePath As String = Target & FileName
ExistFiles.Add(FilePath)
Dim OriginalFile As New FileInfo(FilePath)
If OriginalFile.Exists Then
@@ -1623,7 +1690,7 @@ NextVersion:
Next
'删除多余文件
For Each FileName As String In Directory.GetFiles(McVersionCurrent.Path & McVersionCurrent.Name & "-natives")
For Each FileName As String In Directory.GetFiles(Target)
If ExistFiles.Contains(FileName) Then Continue For
Try
McLaunchLog("删除:" & FileName)
@@ -1636,6 +1703,16 @@ NextVersion:
Next
End Sub
''' <summary>
''' 获取 Natives 文件夹路径,不以 \ 结尾。
''' </summary>
Private Function GetNativesFolder() As String
Dim Result As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives"
If IsGBKEncoding OrElse Result.IsASCII() Then Return Result
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
If Result.IsASCII() Then Return Result
Return OsDrive & "ProgramData\PCL\natives"
End Function
#End Region
@@ -1750,7 +1827,7 @@ NextVersion:
Select Case Setup.Get("LaunchArgumentWindowType")
Case 0 '全屏
WriteIni(SetupFileAddress, "fullscreen", "true")
Case 5 '保持默认
Case 1 '默认
Case Else '其他
WriteIni(SetupFileAddress, "fullscreen", "false")
End Select
@@ -1928,7 +2005,7 @@ IgnoreCustomSkin:
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString),
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成,强制结束启动过程")
@@ -2050,7 +2127,7 @@ IgnoreCustomSkin:
McLaunchLog("")
McLaunchLog("~ 基础参数 ~")
McLaunchLog("PCL 版本:" & VersionDisplayName & " (" & VersionCode & ")")
McLaunchLog("游戏版本:" & McVersionCurrent.Version.ToString & "(" & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & ")")
McLaunchLog("游戏版本:" & McVersionCurrent.Version.ToString & "(识别为 1." & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & ")")
McLaunchLog("资源版本:" & McAssetsGetIndexName(McVersionCurrent))
McLaunchLog("版本继承:" & If(McVersionCurrent.InheritVersion = "", "无", McVersionCurrent.InheritVersion))
McLaunchLog("分配的内存:" & PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) & " GB(" & Math.Round(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB)")
@@ -2060,6 +2137,7 @@ IgnoreCustomSkin:
McLaunchLog("HMCL 格式:" & McVersionCurrent.IsHmclFormatJson)
McLaunchLog("Java 信息:" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
McLaunchLog("环境变量:" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置"))
McLaunchLog("Natives 文件夹:" & GetNativesFolder())
McLaunchLog("")
McLaunchLog("~ 登录参数 ~")
McLaunchLog("玩家用户名:" & McLoginLoader.Output.Name)
@@ -65,7 +65,7 @@
'格式:TMZ 12>C://xxx/xx/|Test>D://xxx/xx/|名称>路径
For Each Folder As String In Setup.Get("LaunchFolders").Split("|")
If Folder = "" Then Continue For
If Not Folder.Contains(">") OrElse Not Folder.EndsWith("\") Then
If Not Folder.Contains(">") OrElse Not Folder.EndsWithF("\") Then
Hint("无效的 Minecraft 文件夹:" & Folder, HintType.Critical)
Continue For
End If
@@ -92,13 +92,13 @@
For Each Folder As McFolder In CacheMcFolderList
If Not Folder.Type = McFolderType.Original Then NewSetup.Add(Folder.Name & ">" & Folder.Path)
Next
If NewSetup.Count = 0 Then NewSetup.Add("") '防止 0 元素 Join 返回 Nothing
If Not NewSetup.Any() Then NewSetup.Add("") '防止 0 元素 Join 返回 Nothing
Setup.Set("LaunchFolders", Join(NewSetup, "|"))
#End Region
'若没有可用文件夹,则创建 .minecraft
If CacheMcFolderList.Count = 0 Then
If Not CacheMcFolderList.Any() Then
Directory.CreateDirectory(Path & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Path = Path & ".minecraft\", .Type = McFolderType.Original})
End If
@@ -149,7 +149,7 @@
#Region "版本处理"
Public Const McVersionCacheVersion As Integer = 26
Public Const McVersionCacheVersion As Integer = 27
Private _McVersionCurrent As McVersion
Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化
@@ -181,7 +181,7 @@
If AniControlEnabled = 0 AndAlso
Setup.Get("VersionServerAuthServer", Version:=value) <> Setup.Get("CacheAuthServerServer") AndAlso
Setup.Get("VersionServerLogin", Version:=value) = 4 Then
Setup.Set("CacheNideServer", "")
Setup.Set("CacheAuthAccess", "")
Log("[Launch] 服务器改变,要求重新登录 Authlib-Injector")
End If
If Setup.Get("VersionServerLogin", Version:=value) = 4 Then
@@ -216,8 +216,8 @@
'尚未判断
Dim ModFolder As New DirectoryInfo(Path & "mods\")
Dim SaveFolder As New DirectoryInfo(Path & "saves\")
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count > 0) OrElse
(SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Count > 0) Then
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse
(SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
'自动开启
Setup.Set("VersionArgumentIndie", 1, Version:=Me)
Log("[Setup] 已自动开启单版本隔离:" & Name)
@@ -418,7 +418,7 @@
End Try
VersionSearchFinish:
'获取版本号
If _Version.McName.StartsWith("1.") Then
If _Version.McName.StartsWithF("1.") Then
Dim SplitVersion = _Version.McName.Split(" "c, "_"c, "-"c, "."c)
Dim SplitResult As String
'分割获取信息
@@ -546,8 +546,8 @@ Recheck:
'处理 JumpLoader
If Text.Contains("minecraftforge") AndAlso File.Exists(PathIndie & "config\jumploader.json") Then
For Each ModFile In Directory.EnumerateFiles(PathIndie & "mods")
Dim FileName As String = GetFileNameFromPath(ModFile).ToLower
If FileName.EndsWith(".jar") AndAlso FileName.Contains("jumploader") Then
Dim FileName As String = GetFileNameFromPath(ModFile)
If FileName.EndsWithF(".jar", True) AndAlso FileName.ContainsF("jumploader", True) Then
Log("[Minecraft] 发现 JumpLoader 分支项:" & FileName)
HasJumpLoader = True
Exit For
@@ -612,7 +612,7 @@ Recheck:
Public Sub New(Path As String)
Me.Path = If(Path.Contains(":"), "", PathMcFolder & "versions\") & '补全完整路径
Path &
If(Path.EndsWith("\"), "", "\") '补全右划线
If(Path.EndsWithF("\"), "", "\") '补全右划线
End Sub
''' <summary>
@@ -684,7 +684,7 @@ Recheck:
'愚人节与快照版本
If If(JsonObject("type"), "").ToString = "fool" OrElse GetMcFoolName(Version.McName) <> "" Then
State = McVersionState.Fool
ElseIf Version.McName.ToLower.Contains("w") OrElse Name.ToLower.Contains("combat") OrElse Version.McName.ToLower.Contains("rc") OrElse Version.McName.ToLower.Contains("pre") OrElse Version.McName.Contains("experimental") OrElse If(JsonObject("type"), "").ToString = "snapshot" OrElse If(JsonObject("type"), "").ToString = "pending" Then
ElseIf Version.McName.ContainsF("w", True) OrElse Name.ContainsF("combat", True) OrElse Version.McName.ContainsF("rc", True) OrElse Version.McName.ContainsF("pre", True) OrElse Version.McName.ContainsF("experimental", True) OrElse If(JsonObject("type"), "").ToString = "snapshot" OrElse If(JsonObject("type"), "").ToString = "pending" Then
State = McVersionState.Snapshot
End If
'OptiFine
@@ -744,9 +744,9 @@ ExitDataLoad:
If CustomInfo = "" Then
Select Case State
Case McVersionState.Snapshot
If Version.McName.ToLower.Contains("pre") Then
If Version.McName.ContainsF("pre", True) Then
Info = "预发布版 " & Version.McName
ElseIf Version.McName.ToLower.Contains("rc") Then
ElseIf Version.McName.ContainsF("rc", True) Then
Info = "发布候选 " & Version.McName
ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then
Info = "实验性快照"
@@ -948,8 +948,8 @@ ExitDataLoad:
(Asc(CType(Left(OptiFineVersion.ToUpper, 1), Char)) - Asc("A"c) + 1) * 10000 + '第二段:字母编号(2 位),如 G2 中的 G(7)
Val(RegexSeek(Right(OptiFineVersion, OptiFineVersion.Length - 1), "[0-9]+")) * 100 '第三段:末尾数字(2 位),如 C5 beta4 中的 5
'第三段:测试标记
If OptiFineVersion.ToLower.Contains("pre") Then _SortCode += 50
If OptiFineVersion.ToLower.Contains("pre") OrElse OptiFineVersion.ToLower.Contains("beta") Then
If OptiFineVersion.ContainsF("pre", True) Then _SortCode += 50
If OptiFineVersion.ContainsF("pre", True) OrElse OptiFineVersion.ContainsF("beta", True) Then
If Val(Right(OptiFineVersion, 1)) = 0 AndAlso Right(OptiFineVersion, 1) <> "0" Then
_SortCode += 1 '为 pre 或 beta 结尾,视作 1
Else
@@ -981,9 +981,9 @@ ExitDataLoad:
''' </summary>
Public Function GetMcFoolName(Name As String) As String
Name = Name.ToLower
If Name.StartsWith("2.0") Then
If Name.StartsWithF("2.0") Then
Return "这个秘密计划了两年的更新将游戏推向了一个新高度!"
ElseIf Name.StartsWith("20w14inf") OrElse Name = "20w14∞" Then
ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
Return "我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
ElseIf Name = "15w14a" Then
Return "作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。"
@@ -994,7 +994,9 @@ ExitDataLoad:
ElseIf Name = "22w13oneblockatatime" Then
Return "一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!"
ElseIf Name = "23w13a_or_b" Then
Return "研究表明玩家喜欢作出选择——越多越好!"
Return "研究表明:玩家喜欢作出选择——越多越好!"
ElseIf Name = "24w14potato" Then
Return "毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
Else
Return ""
End If
@@ -1018,6 +1020,12 @@ ExitDataLoad:
''' </summary>
Public McVersionListLoader As New LoaderTask(Of String, Integer)("Minecraft Version List", AddressOf McVersionListLoad) With {.ReloadTimeout = 1}
''' <summary>
''' 是否为本次打开 PCL 后第一次加载版本列表。
''' 这会清理所有 .pclignore 文件,而非跳过这些对应版本。
''' </summary>
Private IsFirstMcVersionListLoad As Boolean = True
''' <summary>
''' 开始加载当前 Minecraft 文件夹的版本列表。
''' </summary>
@@ -1040,7 +1048,7 @@ ExitDataLoad:
End Try
End If
'没有可用版本
If FolderList.Count = 0 Then
If Not FolderList.Any() Then
WriteIni(Path & "PCL.ini", "VersionCache", "") '清空缓存
GoTo OnLoaded
End If
@@ -1062,6 +1070,7 @@ Reload:
WriteIni(Path & "PCL.ini", "VersionCache", FolderListCheck)
McVersionList = McVersionListLoadNoCache(Path)
End If
IsFirstMcVersionListLoad = False
If Loader.IsAborted Then Exit Sub
'改变当前选择的版本
@@ -1114,14 +1123,20 @@ OnLoaded:
'循环读取版本
For Each Folder As String In ReadIni(Path & "PCL.ini", "CardValue" & (i + 1), ":").Split(":")
If Folder = "" Then Continue For
If File.Exists(Path & "versions\" & Folder & "\.pclignore") Then
Log("[Minecraft] 跳过要求忽略的项目:" & Path & "versions\" & Folder)
Continue For
Dim VersionFolder As String = $"{Path}versions\{Folder}\"
If File.Exists(VersionFolder & ".pclignore") Then
If IsFirstMcVersionListLoad Then
Log("[Minecraft] 清理残留的忽略项目:" & VersionFolder) '#2781
File.Delete(VersionFolder & ".pclignore")
Else
Log("[Minecraft] 跳过要求忽略的项目:" & VersionFolder)
Continue For
End If
End If
Try
'读取单个版本
Dim Version As New McVersion(Path & "versions\" & Folder & "\")
Dim Version As New McVersion(VersionFolder)
VersionList.Add(Version)
Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "CustomInfo", "")
If Version.Info = "" Then Version.Info = ReadIni(Version.Path & "PCL\Setup.ini", "Info", Version.Info)
@@ -1193,11 +1208,17 @@ OnLoaded:
Log("[Minecraft] 跳过可能不是版本文件夹的项目:" & Folder.FullName)
Continue For
End If
If File.Exists(Folder.FullName & "\.pclignore") Then
Log("[Minecraft] 跳过要求忽略的项目:" & Folder.FullName)
Continue For
Dim VersionFolder As String = Folder.FullName & "\"
If File.Exists(VersionFolder & ".pclignore") Then
If IsFirstMcVersionListLoad Then
Log("[Minecraft] 清理残留的忽略项目:" & VersionFolder) '#2781
File.Delete(VersionFolder & ".pclignore")
Else
Log("[Minecraft] 跳过要求忽略的项目:" & VersionFolder)
Continue For
End If
End If
Dim Version As New McVersion(Folder.FullName & "\")
Dim Version As New McVersion(VersionFolder)
VersionList.Add(Version)
Version.Load()
Next
@@ -1213,7 +1234,7 @@ OnLoaded:
For Each Version As McVersion In VersionList
If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then StaredVersions.Add(Version)
Next
If StaredVersions.Count > 0 Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions)
If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions)
'预先筛选出愚人节的版本
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Error}, McVersionCardType.Error)
@@ -1287,8 +1308,8 @@ OnLoaded:
'将剩余的东西添加进去
VersionRubbish.AddRange(VersionList)
If VersionUseful.Count > 0 Then VersionListOriginal.Add(McVersionCardType.OriginalLike, VersionUseful)
If VersionRubbish.Count > 0 Then VersionListOriginal.Add(McVersionCardType.Rubbish, VersionRubbish)
If VersionUseful.Any Then VersionListOriginal.Add(McVersionCardType.OriginalLike, VersionUseful)
If VersionRubbish.Any Then VersionListOriginal.Add(McVersionCardType.Rubbish, VersionRubbish)
'按照自定义版本分类重新添加
For Each VersionPair In VersionListOriginal
@@ -1408,7 +1429,7 @@ OnLoaded:
NextVersion:
Next
'加入版本列表,并从剩余中删除
If KeepList.Count > 0 Then
If KeepList.Any Then
Target.Add(CardType, KeepList)
For Each Version As McVersion In KeepList
VersionList.Remove(Version)
@@ -1429,7 +1450,7 @@ NextVersion:
Next
NextVersion:
Next
If KeepList.Count > 0 Then
If KeepList.Any Then
For Each Version As McVersion In KeepList
VersionList.Remove(Version)
Next
@@ -1494,7 +1515,7 @@ NextVersion:
''' </summary>
Public Function McSkinGetAddress(Uuid As String, Type As String) As String
If Uuid = "" Then Throw New Exception("Uuid 为空。")
If Uuid.StartsWith("000000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。")
If Uuid.StartsWithF("00000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。")
'尝试读取缓存
Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid)
If Not CacheSkinAddress = "" Then Return CacheSkinAddress
@@ -1960,7 +1981,7 @@ NextVersion:
'获取 Url 的真实地址
Urls.Add(Token.Url)
If Token.Url.Contains("launcher.mojang.com/v1/objects") Then Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings
If Token.Url.Contains("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOf("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven"))
If Token.Url.Contains("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven"))
End If
If Token.LocalPath.Contains("transformer-discovery-service") Then
'Transformer 文件释放
@@ -1990,10 +2011,6 @@ NextVersion:
Public Function McLibGet(Original As String, Optional WithHead As Boolean = True, Optional IgnoreLiteLoader As Boolean = False, Optional CustomMcFolder As String = Nothing) As String
CustomMcFolder = If(CustomMcFolder, PathMcFolder)
Dim Splited = Original.Split(":")
'If Original.ToLower.Contains("xray") OrElse Original.ToLower.Contains("rift") OrElse Original.ToLower.Contains("mixin") OrElse Original.Contains("net.minecraftforge:forge") OrElse Splited(2).Contains("beta") OrElse (IgnoreLiteLoader AndAlso Original.Contains("liteloader")) Then
'ElseIf Splited(2).Contains("-") Then
' Log("[Launch] 可能存在分段问题的支持库:" & Original)
'End If
McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") &
Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar"
'判断 OptiFine 是否应该使用 installer
@@ -2031,8 +2048,7 @@ NextVersion:
If Version.InheritVersion = "" Then Exit Do
Version = New McVersion(PathMcFolder & "versions\" & Version.InheritVersion)
Loop
Catch ex As Exception
Log(ex, "获取资源文件索引下载地址失败")
Catch
End Try
'无法获取到下载地址
If ReturnLegacyOnError Then
@@ -2222,10 +2238,11 @@ NextVersion:
'弹窗结果
If MsgResult = 2 Then
'下载
RunInUi(Sub()
PageDownloadInstall.McVersionWaitingForSelect = VersionName
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End Sub)
RunInUi(
Sub()
PageDownloadInstall.McVersionWaitingForSelect = VersionName
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End Sub)
End If
Catch ex As Exception
@@ -2250,8 +2267,10 @@ NextVersion:
If Left = "未知版本" AndAlso Right = "未知版本" Then Return 0
If Left <> "未知版本" AndAlso Right = "未知版本" Then Return -1
End If
Dim Lefts = RegexSearch(Left.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.ToLower.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Left = Left.ToLowerInvariant
Right = Right.ToLowerInvariant
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
Dim i As Integer = 0
While True
'两边均缺失,感觉是一个东西
+283 -200
View File
@@ -48,7 +48,7 @@ Public Module ModMod
Load()
If Not IsFileAvailable Then
Return McModState.Unavaliable
ElseIf Path.EndsWith(".disabled") OrElse Path.EndsWith(".old") Then
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
Return McModState.Disabled
Else
Return McModState.Fine
@@ -76,7 +76,7 @@ Public Module ModMod
Return _Name
End Get
Set(value As String)
If _Name Is Nothing AndAlso value IsNot Nothing AndAlso
If _Name Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") AndAlso
value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
_Name = value
End If
@@ -113,12 +113,12 @@ Public Module ModMod
Return _Version
End Get
Set(value As String)
If _Version IsNot Nothing AndAlso (_Version.Contains(".") OrElse _Version.Contains("-")) Then Exit Property
If value IsNot Nothing AndAlso value.ToLower.Contains("version") Then value = "version" '需要修改的标识
If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
If value?.ContainsF("version", True) Then value = "version" '需要修改的标识
_Version = value
End Set
End Property
Private _Version As String = Nothing
Public _Version As String = Nothing
''' <summary>
''' 用于依赖检查的 ModID。
@@ -129,12 +129,12 @@ Public Module ModMod
Return _ModId
End Get
Set(value As String)
If value Is Nothing Then Exit Property
value = RegexSeek(value.ToLower, "[0-9a-z_-]+")
If value IsNot Nothing AndAlso value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
If _ModId Is Nothing Then _ModId = value
End If
If value Is Nothing Then Return
value = RegexSeek(value, "[0-9a-zA-Z_-]+")
If value Is Nothing OrElse value.Count <= 1 OrElse Val(value).ToString = value Then Return
If value.ContainsF("name", True) OrElse value.ContainsF("modid", True) Then Return
If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
If _ModId Is Nothing Then _ModId = value
End Set
End Property
Private _ModId As String = Nothing
@@ -152,7 +152,7 @@ Public Module ModMod
Return _Url
End Get
Set(value As String)
If _Url Is Nothing AndAlso value IsNot Nothing AndAlso value.StartsWith("http") Then
If _Url Is Nothing AndAlso value IsNot Nothing AndAlso value.StartsWithF("http") Then
_Url = value
End If
End Set
@@ -193,7 +193,7 @@ Public Module ModMod
If VersionRequirement Is Nothing OrElse ((Not VersionRequirement.Contains(".")) AndAlso (Not VersionRequirement.Contains("-"))) OrElse VersionRequirement.Contains("$") Then
VersionRequirement = Nothing
Else
If (Not VersionRequirement.StartsWith("[")) AndAlso (Not VersionRequirement.StartsWith("(")) AndAlso (Not VersionRequirement.EndsWith("]")) AndAlso (Not VersionRequirement.EndsWith(")")) Then VersionRequirement = "[" & VersionRequirement & ",)"
If (Not VersionRequirement.StartsWithF("[")) AndAlso (Not VersionRequirement.StartsWithF("(")) AndAlso (Not VersionRequirement.EndsWithF("]")) AndAlso (Not VersionRequirement.EndsWithF(")")) Then VersionRequirement = "[" & VersionRequirement & ",)"
End If
'向依赖项中添加
If _Dependencies.ContainsKey(ModID) Then
@@ -270,7 +270,6 @@ Public Module ModMod
_Dependencies = New Dictionary(Of String, String)
IsLoaded = False
_FileUnavailableReason = Nothing
IsInfoWithoutClassAvailable = False
IsInfoWithClassLoaded = False
IsInfoWithClassAvailable = False
End Sub
@@ -284,15 +283,12 @@ Public Module ModMod
Init()
Dim Jar As ZipArchive = Nothing
Try
'阶段 1:基础可用性检查、打开 Jar 文件
'基础可用性检查、打开 Jar 文件
If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径(" & If(Path, "null") & ")")
If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件(" & Path & ")")
Jar = New ZipArchive(New FileStream(Path, FileMode.Open))
If Jar.Entries.Count = 0 Then Throw New FileFormatException("文件内容为空")
'阶段 2:信息获取
LoadWithoutClass(Jar)
'阶段 3: Class 信息获取
If Not IsInfoWithoutClassAvailable Then LoadWithClass(Jar)
'信息获取
LookupMetadata(Jar)
Catch ex As UnauthorizedAccessException
Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer)
_FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL", ex)
@@ -307,9 +303,9 @@ Public Module ModMod
End Sub
''' <summary>
''' 进行不使用 .class 文件的信息获取。
''' 从 jar 文件中获取 Mod 信息。
''' </summary>
Private Sub LoadWithoutClass(Jar As ZipArchive)
Private Sub LookupMetadata(Jar As ZipArchive)
#Region "尝试使用 mcmod.info"
Try
@@ -341,13 +337,13 @@ Public Module ModMod
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Count > 0 Then Authors = Join(Author, ", ")
If Author.Any Then Authors = Join(Author, ", ")
End If
Dim Reqs As JArray = InfoObject("requiredMods")
If Reqs IsNot Nothing Then
For Each Token As String In Reqs
If Not String.IsNullOrEmpty(Token) Then
Token = Token.Substring(Token.IndexOf(":") + 1)
Token = Token.Substring(Token.IndexOfF(":") + 1)
If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else
@@ -360,7 +356,7 @@ Public Module ModMod
If Reqs IsNot Nothing Then
For Each Token As String In Reqs
If Not String.IsNullOrEmpty(Token) Then
Token = Token.Substring(Token.IndexOf(":") + 1)
Token = Token.Substring(Token.IndexOfF(":") + 1)
If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else
@@ -397,7 +393,7 @@ GotFabric:
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Count > 0 Then Authors = Join(Author, ", ")
If Author.Any Then Authors = Join(Author, ", ")
End If
'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
' '添加 Minecraft 依赖
@@ -407,8 +403,8 @@ GotFabric:
' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "")
' If Deps <> "" Then
' For Each Dep In Deps.Split(";")
' If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOf(":") + 1)
' If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
' If Dep.Contains("@") Then
' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
' Else
@@ -436,40 +432,40 @@ GotFabric:
'文件标准化:统一换行符为 vbLf,去除注释、头尾的空格、空行
Dim Lines As New List(Of String)
For Each Line In TomlText.Replace(vbCrLf, vbLf).Replace(vbCr, vbLf).Split(vbLf) '统一换行符
If Line.StartsWith("#") Then '去除注释
If Line.StartsWithF("#") Then '去除注释
Continue For
ElseIf Line.Contains("#") Then
Line = Line.Substring(0, Line.IndexOf("#"))
Line = Line.Substring(0, Line.IndexOfF("#"))
End If
Line = Line.Trim(New Char() {" "c, " "c, " "c}) '去除头尾的空格
If Line.Count > 0 Then Lines.Add(Line) '去除空行
If Line.Any Then Lines.Add(Line) '去除空行
Next
'读取文件数据
Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))}
For i = 0 To Lines.Count - 1
Dim Line As String = Lines(i)
If Line.StartsWith("[") AndAlso Line.EndsWith("]") Then
If Line.StartsWithF("[") AndAlso Line.EndsWithF("]") Then
'段落标记
Dim Header = Line.Trim("[]".ToCharArray)
TomlData.Add(New KeyValuePair(Of String, Dictionary(Of String, Object))(Header, New Dictionary(Of String, Object)))
ElseIf Line.Contains("=") Then
'字段标记
Dim Key As String = Line.Substring(0, Line.IndexOf("=")).TrimEnd(New Char() {" "c, " "c, " "c})
Dim RawValue As String = Line.Substring(Line.IndexOf("=") + 1).TrimStart(New Char() {" "c, " "c, " "c})
Dim Key As String = Line.Substring(0, Line.IndexOfF("=")).TrimEnd(New Char() {" "c, " "c, " "c})
Dim RawValue As String = Line.Substring(Line.IndexOfF("=") + 1).TrimStart(New Char() {" "c, " "c, " "c})
Dim Value As Object
If RawValue.StartsWith("""") AndAlso RawValue.EndsWith("""") Then
If RawValue.StartsWithF("""") AndAlso RawValue.EndsWithF("""") Then
'单行字符串
Value = RawValue.Trim("""")
ElseIf RawValue.StartsWith("'''") Then
ElseIf RawValue.StartsWithF("'''") Then
'多行字符串
Dim ValueLines As New List(Of String) From {RawValue.TrimStart("'")}
If ValueLines(0).EndsWith("'''") Then '把多行字符串按单行写法写的错误处理(#2732)
If ValueLines(0).EndsWithF("'''") Then '把多行字符串按单行写法写的错误处理(#2732)
ValueLines(0) = ValueLines(0).TrimEnd("'")
Else
Do Until i >= Lines.Count - 1
i += 1
Dim ValueLine As String = Lines(i)
If ValueLine.EndsWith("'''") Then
If ValueLine.EndsWithF("'''") Then
ValueLines.Add(ValueLine.TrimEnd("'"))
Exit Do
Else
@@ -575,8 +571,8 @@ Got:
Dim Deps As String = If(If(FmlObject("dependencies") IsNot Nothing, FmlObject("dependencies")("value"), ""), "")
If Deps <> "" Then
For Each Dep In Deps.Split(";")
If Dep = "" OrElse Not Dep.StartsWith("required-") Then Continue For
Dep = Dep.Substring(Dep.IndexOf(":") + 1)
If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
If Dep.Contains("@") Then
AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
Else
@@ -597,7 +593,7 @@ Finished:
If MetaEntry IsNot Nothing Then
Dim MetaString As String = ReadFile(MetaEntry.Open()).Replace(" :", ":").Replace(": ", ":")
If MetaString.Contains("Implementation-Version:") Then
MetaString = MetaString.Substring(MetaString.IndexOf("Implementation-Version:") + "Implementation-Version:".Count)
MetaString = MetaString.Substring(MetaString.IndexOfF("Implementation-Version:") + "Implementation-Version:".Count)
MetaString = MetaString.Substring(0, MetaString.IndexOfAny(vbCrLf.ToCharArray)).Trim
Version = MetaString
End If
@@ -610,97 +606,17 @@ Finished:
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
#End Region
IsInfoWithoutClassAvailable = _ModId IsNot Nothing AndAlso _Version IsNot Nothing
End Sub
''' <summary>
''' 进行使用 .class 文件的信息获取。
''' </summary>
Private Sub LoadWithClass(Jar As ZipArchive)
Try
'查找入口点文件
Dim ModClass As String = Nothing
Dim ModClassNotBest As String = Nothing '非完美匹配
For Each Entry In Jar.Entries
If Entry.Name.EndsWith(".class") Then
Dim Temp As String = ReadFile(Entry.Open()).ToLower
If Temp.Contains("#lnet/minecraftforge/fml/common/mod;") Then
ModClass = Temp
Exit For
ElseIf Temp.Contains("modid") Then
ModClassNotBest = Temp
End If
End If
Next
If ModClass Is Nothing Then ModClass = ModClassNotBest
If ModClass Is Nothing Then Throw New FileNotFoundException("未找到 Mod 入口点")
ModClass = ModClass.Replace("ljava/lang/string;", "")
If ModClass.Count > 3000 Then ModClass = ModClass.Substring(0, 3000) '如果文件过大,截取前 3000 Byte
Dim IndexHead As Integer, IndexTail As Integer, IncreaseCount As Integer
'获取 ModID
If _ModId Is Nothing Then
IndexHead = ModClass.IndexOf("modid") + "modid".Length + 1
IncreaseCount = 0
Do While Convert.ToInt32(ModClass(IndexHead)) < 32
IndexHead += 1
IncreaseCount += 1
If IncreaseCount > 10 Then Throw New Exception("ModID 头匹配失败")
Loop
IndexTail = IndexHead + 1
IncreaseCount = 0
Do Until Convert.ToInt32(ModClass(IndexTail)) < 32
IndexTail += 1
IncreaseCount += 1
If IncreaseCount > 50 Then Throw New Exception("ModID 尾匹配失败")
Loop
ModId = ModClass.Substring(IndexHead, IndexTail - IndexHead)
End If
'获取 Version
If _Version Is Nothing AndAlso ModClass.Contains("version") Then
IndexHead = ModClass.IndexOf("version") + "version".Length + 1
IncreaseCount = 0
Do While Convert.ToInt32(ModClass(IndexHead)) < 32
IndexHead += 1
IncreaseCount += 1
If IncreaseCount > 10 Then GoTo VersionFindFail
Loop
IndexTail = IndexHead + 1
IncreaseCount = 0
Do While ModClass(IndexTail) = "."c OrElse ModClass(IndexTail) = "-"c OrElse
(ModClass(IndexTail) >= "0"c AndAlso ModClass(IndexTail) <= "9"c) OrElse
(ModClass(IndexTail) >= "a"c AndAlso ModClass(IndexTail) <= "z"c)
IndexTail += 1
IncreaseCount += 1
If IncreaseCount > 50 Then GoTo VersionFindFail
Loop
_Version = ModClass.Substring(IndexHead, IndexTail - IndexHead)
End If
VersionFindFail:
'获取 Dependencies
IndexHead = ModClass.IndexOf("dependencies")
If IndexHead > 0 Then
If ModClass.Count >= IndexHead + 300 Then ModClass = ModClass.Substring(IndexHead, 299)
Dim Deps As List(Of String) = RegexSearch(ModClass, "(?<=required-((before|after|before-client|after-client)?):)[0-9a-z]+(@[\(\[]{1}[0-9.,]+[\)\]]{1})?")
For Each Token As String In Deps
If Not String.IsNullOrEmpty(Token) Then
If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else
AddDependency(Token)
End If
End If
Next
End If
Catch ex As Exception
Log(ex, "Mod Class 信息不可用(" & If(Path, "null") & ")", LogLevel.Normal)
End Try
IsInfoWithClassAvailable = _ModId IsNot Nothing AndAlso _Version IsNot Nothing
End Sub
#End Region
#Region "网络信息"
''' <summary>
''' 当任何网络信息更新时触发。
''' </summary>
Public Event OnCompUpdate(sender As McMod)
''' <summary>
''' 该 Mod 关联的网络项目。
''' </summary>
@@ -710,12 +626,70 @@ VersionFindFail:
End Get
Set(value As CompProject)
_Comp = value
RaiseEvent OnGetCompProject(Me)
RaiseEvent OnCompUpdate(Me)
End Set
End Property
Private _Comp As CompProject
Public IsCompFromModrinth = False
Public Event OnGetCompProject(sender As McMod)
''' <summary>
''' 本地文件对应的联网文件信息。
''' </summary>
Public CompFile As CompFile
''' <summary>
''' 该 Mod 对应的联网最新版本。
''' </summary>
Public Property UpdateFile As CompFile
Get
Return _UpdateFile
End Get
Set(value As CompFile)
_UpdateFile = value
RaiseEvent OnCompUpdate(Me)
End Set
End Property
Private _UpdateFile As CompFile
''' <summary>
''' 该 Mod 的更新日志网址。
''' </summary>
Public ChangelogUrls As New List(Of String)
''' <summary>
''' 所有网络信息是否已成功加载。
''' </summary>
Public CompLoaded As Boolean = False
''' <summary>
''' 将网络信息保存为 Json。
''' </summary>
Public Function ToJson() As JObject
Dim Json As New JObject
If Comp IsNot Nothing Then Json.Add("Comp", Comp.ToJson())
Json.Add("ChangelogUrls", New JArray(ChangelogUrls))
Json.Add("CompLoaded", CompLoaded)
If CompFile IsNot Nothing Then Json.Add("CompFile", CompFile.ToJson())
If UpdateFile IsNot Nothing Then Json.Add("UpdateFile", UpdateFile.ToJson())
Return Json
End Function
''' <summary>
''' 从 Json 中读取网络信息。
''' </summary>
Public Sub FromJson(Json As JObject)
CompLoaded = Json("CompLoaded")
If Json.ContainsKey("Comp") Then Comp = New CompProject(Json("Comp"))
If Json.ContainsKey("ChangelogUrls") Then ChangelogUrls = Json("ChangelogUrls").ToObject(Of List(Of String))
If Json.ContainsKey("CompFile") Then CompFile = New CompFile(Json("CompFile"), CompType.Mod)
If Json.ContainsKey("UpdateFile") Then UpdateFile = New CompFile(Json("UpdateFile"), CompType.Mod)
End Sub
''' <summary>
''' 该文件是否可以更新。
''' </summary>
Public ReadOnly Property CanUpdate As Boolean
Get
Return ChangelogUrls.Any()
End Get
End Property
''' <summary>
''' 获取用于 CurseForge 信息获取的 Hash 值(MurmurHash2)。
@@ -723,6 +697,14 @@ VersionFindFail:
Public ReadOnly Property CurseForgeHash As UInteger
Get
If _CurseForgeHash Is Nothing Then
'读取缓存
Dim Info As New FileInfo(Path)
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" Then
_CurseForgeHash = Cached
Return _CurseForgeHash
End If
'读取文件
Dim data As New List(Of Byte)
For Each b As Byte In File.ReadAllBytes(Path)
@@ -757,6 +739,8 @@ VersionFindFail:
h = (h * &H5BD1E995L) And &HFFFFFFFFL
h = h Xor (h >> 15)
_CurseForgeHash = h
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, h.ToString)
End If
Return _CurseForgeHash
End Get
@@ -769,7 +753,18 @@ VersionFindFail:
Public ReadOnly Property ModrinthHash As String
Get
If _ModrinthHash Is Nothing Then
'读取缓存
Dim Info As New FileInfo(Path)
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-M")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" Then
_ModrinthHash = Cached
Return _ModrinthHash
End If
'计算 SHA1
_ModrinthHash = GetFileSHA1(Path)
'写入缓存
WriteIni(PathTemp & "Cache\ModHash.ini", CacheKey, _ModrinthHash)
End If
Return _ModrinthHash
End Get
@@ -794,7 +789,7 @@ VersionFindFail:
''' 是否可能为前置 Mod。
''' </summary>
Public Function IsPresetMod() As Boolean
Return Dependencies.Count = 0 AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
Return Not Dependencies.Any() AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
End Function
''' <summary>
@@ -803,9 +798,9 @@ VersionFindFail:
Public Shared Function IsModFile(Path As String)
If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
Path = Path.ToLower
If Path.EndsWith(".jar") OrElse Path.EndsWith(".zip") OrElse Path.EndsWith(".litemod") OrElse
Path.EndsWith(".jar.disabled") OrElse Path.EndsWith(".zip.disabled") OrElse Path.EndsWith(".litemod.disabled") OrElse
Path.EndsWith(".jar.old") OrElse Path.EndsWith(".zip.old") OrElse Path.EndsWith(".litemod.old") Then Return True
If Path.EndsWithF(".jar", True) OrElse Path.EndsWithF(".zip", True) OrElse Path.EndsWithF(".litemod", True) OrElse
Path.EndsWithF(".jar.disabled", True) OrElse Path.EndsWithF(".zip.disabled", True) OrElse Path.EndsWithF(".litemod.disabled", True) OrElse
Path.EndsWithF(".jar.old", True) OrElse Path.EndsWithF(".zip.old", True) OrElse Path.EndsWithF(".litemod.old", True) Then Return True
Return False
End Function
@@ -817,6 +812,20 @@ VersionFindFail:
Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = False)
'等待 Mod 更新完成
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表")
Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod")
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input)
If Loader.IsAborted Then Exit Sub
Thread.Sleep(100)
Loop
Finally
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表")
End Try
End If
'获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo)
If Directory.Exists(Loader.Input) Then
@@ -846,7 +855,7 @@ VersionFindFail:
If CacheContent <> "" Then
Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息")
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug)
Cache = New JObject
End If
End If
@@ -859,7 +868,7 @@ VersionFindFail:
Dim ModList As New List(Of McMod)
Dim ModUpdateList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList
Loader.Progress += 0.95 / ModFileList.Count
Loader.Progress += 0.94 / ModFileList.Count
If Loader.IsAborted Then Exit Sub
'加载 McMod 对象
Dim ModEntry As New McMod(ModFile.FullName)
@@ -880,10 +889,9 @@ VersionFindFail:
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
Dim Hash = ModEntry.ModrinthHash
If Cache.ContainsKey(Hash) Then
ModEntry.Comp = New CompProject(Cache(Hash))
ModEntry.IsCompFromModrinth = Not ModEntry.Comp.FromCurseForge
ModEntry.FromJson(Cache(Hash))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
If Date.Now - Cache(Hash)("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
If ModEntry.CompLoaded AndAlso Date.Now - Cache(Hash)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If
ModUpdateList.Add(ModEntry)
Next
@@ -906,10 +914,10 @@ VersionFindFail:
'开始联网加载
If ModUpdateList.Any() Then
'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True)
End If
Loader.Progress = 1
Catch ex As Exception
Log(ex, "Mod 列表加载失败", LogLevel.Debug)
Throw
@@ -917,29 +925,31 @@ VersionFindFail:
End Sub
'联网加载 Mod 详情
Private Const LocalModCacheVersion As Integer = 1
Private Const LocalModCacheVersion As Integer = 3
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))
Dim Mods As List(Of McMod) = Loader.Input.Key
Dim Cache As JObject = Loader.Input.Value
'获取作为检查目标的加载器和版本
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
Dim ModLoaders As New List(Of String)
If TargetMcVersion.HasForge Then ModLoaders.Add("forge")
If TargetMcVersion.HasFabric Then ModLoaders.Add("fabric")
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add("liteloader")
If Not ModLoaders.Any() Then ModLoaders.AddRange({"forge", "fabric", "liteloader"})
Dim ModLoaders As New List(Of CompModLoaderType)
If TargetMcVersion.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If TargetMcVersion.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Dim McVersions As New List(Of String) From {TargetMcVersion.McName}
If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
McVersions.Add($"1.{TargetMcVersion.McCodeMain}")
For i = 1 To TargetMcVersion.McCodeSub
McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}")
Next
End If
McVersions = McVersions.Distinct().ToList()
'暂不向下扩展检查的 MC 小版本
'例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
'If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
' McVersions.Add($"1.{TargetMcVersion.McCodeMain}")
' For i = 1 To TargetMcVersion.McCodeSub
' McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}")
' Next
'End If
'McVersions = McVersions.Distinct().ToList()
'开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersions.Join("/")}")
Dim CompletedThread As Integer = 0
Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0
Dim MainThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
RunInNewThread(
@@ -947,25 +957,25 @@ VersionFindFail:
Try
'步骤 1:获取 Hash 与对应的工程 ID
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""")}""],""game_versions"": [""{McVersions.Join(""",""")}""]}}", "application/json")), JObject)
Log($"[Mod] 从 Modrinth 获取到 {ModrinthUpdate.Count} 个本地 Mod 的对应信息")
Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If ModrinthUpdate.Count = 0 Then Exit Sub
If ModrinthVersion.Count = 0 Then Exit Sub
Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
For Each ModEntity In Mods
If Not ModrinthUpdate.ContainsKey(ModEntity.ModrinthHash) Then Continue For
Dim ProjectId = ModrinthUpdate(ModEntity.ModrinthHash)("project_id").ToString
If CompProjectCache.ContainsKey(ProjectId) Then
ModEntity.Comp = CompProjectCache(ProjectId)
Else
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
ModrinthMapping(ProjectId).Add(ModEntity)
End If
For Each Entry In Mods
If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
If ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash Then Continue For
Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString
If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
ModrinthMapping(ProjectId).Add(Entry)
'记录对应的 CompFile
Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Log($"[Mod] 读取缓存后还需要从 Modrinth 获取 {ModrinthMapping.Count} 类本地 Mod 的工程信息")
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Exit Sub
Dim ModrinthProject = CType(GetJson(NetRequestRetry(
@@ -974,18 +984,37 @@ VersionFindFail:
For Each ProjectJson In ModrinthProject
Dim Project As New CompProject(ProjectJson)
For Each Entry In ModrinthMapping(Project.Id)
If Entry.Comp IsNot Nothing AndAlso Not Entry.IsCompFromModrinth Then
Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 加载不出来
End If
Entry.IsCompFromModrinth = True
If Entry.Comp IsNot Nothing AndAlso Entry.Comp.FromCurseForge Then Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 不是图片,如果可能,使用 CurseForge 的 Logo
Entry.Comp = Project
Next
Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersions.Join(""",""")}""]}}", "application/json")), JObject)
For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
If Not UpdateFile.Available Then Continue For
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 Modrinth 上的最新版为 {UpdateFile.FileName}")
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}")
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?{McVersions.Select(Function(v) $"g={v}&").Join("")}"}
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
SucceedThreadCount += 1
Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
Finally
CompletedThread += 1
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader Modrinth")
'从 CurseForge 获取信息
@@ -994,57 +1023,110 @@ VersionFindFail:
Try
'步骤 1:获取 Hash 与对应的工程 ID
Dim CurseForgeHashes As New List(Of UInteger)
For Each ModEntity In Mods
CurseForgeHashes.Add(ModEntity.CurseForgeHash)
For Each Entry In Mods
CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Next
Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If CurseForgeRaw.Count = 0 Then Exit Sub
If Not CurseForgeRaw.Any() Then Exit Sub
Dim CurseForgeMapping As New Dictionary(Of Integer, List(Of McMod))
For Each Project In CurseForgeRaw
Dim ProjectId = Project("id").ToString
Dim Hash As UInteger = Project("file")("fileFingerprint")
For Each Entry In Mods
If Entry.CurseForgeHash <> Hash Then Continue For
If CompProjectCache.ContainsKey(ProjectId) Then
Entry.Comp = CompProjectCache(ProjectId)
Else
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
CurseForgeMapping(ProjectId).Add(Entry)
End If
If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存,加快结果出现速度
If Not CurseForgeMapping.ContainsKey(ProjectId) Then CurseForgeMapping(ProjectId) = New List(Of McMod)
CurseForgeMapping(ProjectId).Add(Entry)
'记录对应的 CompFile
Dim File As New CompFile(Project("file"), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next
Next
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Log($"[Mod] 读取缓存后还需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Exit Sub
Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST",
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject
If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
'设置 Entry 中的工程信息
Dim Project As New CompProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Comp IsNot Nothing AndAlso Entry.IsCompFromModrinth Then
If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
Entry.Comp = Entry.Comp '再次触发修改事件
Continue For
End If
Entry.IsCompFromModrinth = False
Entry.Comp = Project
Next
'查找或许版本更新的文件列表
If ModLoaders.Count = 1 Then 'TODO: 结果有多个 ModLoader 时提示无法检测更新
Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes")
If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion")
If Not McVersions.Contains(IndexVersion) Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then
NewestVersion = IndexVersion
NewestFileIds.Clear()
End If
NewestFileIds.Add(IndexEntry("fileId").ToObject(Of Integer))
Next
For Each FileId In NewestFileIds
If Not UpdateFileIds.ContainsKey(FileId) Then UpdateFileIds(FileId) = New List(Of McMod)
UpdateFileIds(FileId).AddRange(CurseForgeMapping(Project.Id))
FileIdToProjectSlug(FileId) = Project.Slug
Next
End If
Next
Log($"[Mod] 从 CurseForge 获取本地 Mod 信息结束")
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息
If Not UpdateFileIds.Any() Then Exit Sub
Dim CurseForgeFiles = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST",
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
For Each FileJson In CurseForgeFiles
Dim File As New CompFile(FileJson, CompType.Mod)
If Not File.Available Then Continue For
For Each Entry As McMod In UpdateFileIds(File.Id)
If UpdateFiles.ContainsKey(Entry) AndAlso UpdateFiles(Entry).ReleaseDate >= File.ReleaseDate Then Continue For
UpdateFiles(Entry) = File
Next
Next
For Each Pair In UpdateFiles
Dim Entry As McMod = Pair.Key
Dim UpdateFile As CompFile = Pair.Value
If ModeDebug Then Log($"[Mod] 本地文件 {Entry.CompFile.FileName} 在 CurseForge 上的最新版为 {UpdateFile.FileName}")
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}")
Entry.UpdateFile.DownloadUrls.AddRange(UpdateFile.DownloadUrls) '合并下载源
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate > Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://www.curseforge.com/minecraft/mc-mods/{FileIdToProjectSlug(UpdateFile.Id)}/files/{UpdateFile.Id}"}
Entry.UpdateFile = UpdateFile
End If
Next
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
SucceedThreadCount += 1
Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
Finally
CompletedThread += 1
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader CurseForge")
'等待线程结束
Do Until CompletedThread = 2
Do Until EndedThreadCount = 2
If Loader.IsAborted Then Exit Sub
Thread.Sleep(10)
Loop
@@ -1052,8 +1134,9 @@ VersionFindFail:
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Exit Sub
For Each ModEntity In Mods
Cache(ModEntity.ModrinthHash) = ModEntity.Comp.ToJson()
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
Entry.CompLoaded = SucceedThreadCount = 2
Cache(Entry.ModrinthHash) = Entry.ToJson()
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
End Sub
@@ -1083,12 +1166,12 @@ VersionFindFail:
If CurrentDependencies.ContainsKey(PossibleModId) Then
If CurrentDependencies(PossibleModId)(2) = 1 Then
Result.Add("重复添加了相同的 Mod,请尝试删除其中一个(ModID:" & PossibleModId & ")。" & vbCrLf &
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1))
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1))
Else
Log("[Minecraft] 由于可能有多个 ModID,跳过疑似的重复项(ModID:" & PossibleModId & ")。" & vbCrLf &
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1), LogLevel.Developer)
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1), LogLevel.Developer)
End If
Else
CurrentDependencies.Add(PossibleModId, {ModEntity.Version, ModEntity.FileName, ModEntity.PossibleModId.Count})
@@ -1106,8 +1189,8 @@ VersionFindFail:
If Dependency.Value IsNot Nothing Then
'获取分段后的详细版本信息
Dim ReqVersion As String = Dependency.Value
Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWith("[")
Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWith("]")
Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWithF("[")
Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWithF("]")
Dim ReqVersionHead As String
Dim ReqVersionTail As String
If ReqVersion.Contains(",") Then
@@ -1121,8 +1204,8 @@ VersionFindFail:
ReqVersionTailCanEqual = False
End If
End If
If ReqVersionHead.StartsWith("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOf("-") + 1)
If ReqVersionTail.StartsWith("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOf("-") + 1)
If ReqVersionHead.StartsWithF("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOfF("-") + 1)
If ReqVersionTail.StartsWithF("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOfF("-") + 1)
'获取报错描述文本
Dim VersionRequire As String
If ReqVersionHead = ReqVersionTail Then
@@ -1150,7 +1233,7 @@ VersionFindFail:
Continue For
End If
Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0")
If CurrentVersion.StartsWith("1.") AndAlso CurrentVersion.Contains("-") Then CurrentVersion = CurrentVersion.Substring(CurrentVersion.LastIndexOf("-") + 1)
If CurrentVersion.StartsWithF("1.") AndAlso CurrentVersion.Contains("-") Then CurrentVersion = CurrentVersion.Substring(CurrentVersion.LastIndexOfF("-") + 1)
'对比前置 Mod 头部版本
If ReqVersionHead.Contains(".") Then
If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then
@@ -1179,7 +1262,7 @@ VersionFindFail:
Log(ex, "检查 Mod 时出错")
End Try
Next
If Result.Count = 0 Then
If Not Result.Any() Then
Log("[Minecraft] Mod 检查未发现异常")
Else
Log("[Minecraft] Mod 检查异常结果:" & vbCrLf & Join(Result, vbCrLf))
@@ -40,7 +40,7 @@ Public Module ModModpack
For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/")
ArchiveBaseFolder = FullNames(0) & "/"
If Entry.FullName.EndsWith("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包
If Entry.FullName.EndsWithF("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包
'确定为一级目录下
If FullNames.Count <> 2 Then Continue For
'判断是否为关键文件
@@ -61,7 +61,7 @@ Public Module ModModpack
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
ElseIf File.ToLower.EndsWith(".rar") Then
ElseIf File.EndsWithF(".rar", True) Then
Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
Return False
Else
@@ -186,7 +186,7 @@ Retry:
Dim FabricVersion As String = Nothing
For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.ToLower
If Id.StartsWith("forge-") Then
If Id.StartsWithF("forge-") Then
'Forge 指定
If Id.Contains("recommended") Then
Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint)
@@ -199,7 +199,7 @@ Retry:
Catch ex As Exception
Log(ex, "读取整合包 Forge 版本失败:" & Id)
End Try
ElseIf Id.StartsWith("fabric-") Then
ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定
Try
Log("[ModPack] 整合包 Fabric 版本:" & Id)
@@ -244,16 +244,17 @@ Retry:
ModList.Add(ModEntry("fileID"))
If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then ModOptionalList.Add(ModEntry("fileID"))
Next
If ModList.Count > 0 Then
If ModList.Any Then
Dim ModDownloadLoaders As New List(Of LoaderBase)
'获取 Mod 下载信息
InstallLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
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")
'如果文件已被删除,则 API 会跳过那一项
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除,因此无法完成整合包安装,请联系整合包作者更新整合包中的 Mod 版本")
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
'构造 NetFile
InstallLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
Dim FileList As New Dictionary(Of Integer, NetFile)
For Each ModJson In Task.Input
@@ -277,7 +278,7 @@ Retry:
IsResourcePack =
(Not ModuleNames.Contains("META-INF")) AndAlso (Not ModuleNames.Contains("mcmod.info")) AndAlso '不包含 META-INF 或 mcmod.info
ModuleNames.Contains("pack.mcmeta") AndAlso '包含 pack.mcmeta
(Not File.FileName.EndsWith(".jar")) '文件后缀不是 .jar
(Not File.FileName.EndsWithF(".jar", True)) '文件后缀不是 .jar
Else
IsResourcePack = False
End If
@@ -288,7 +289,10 @@ Retry:
Task.Output = FileList.Values.ToList
End Sub) With {.ProgressWeight = ModList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
'下载 Mod 文件
InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
ModDownloadLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
'构造加载器
InstallLoaders.Add(New LoaderCombo(Of Integer)("下载 Mod(主加载器)", ModDownloadLoaders) With
{.Show = False, .ProgressWeight = ModDownloadLoaders.Sum(Function(l) l.ProgressWeight)})
End If
'构造加载器
@@ -299,43 +303,35 @@ Retry:
.ForgeVersion = ForgeVersion,
.FabricVersion = FabricVersion
}
Dim InstallExpectTime As Double = 0
For Each InstallLoader In InstallLoaders
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
Next
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
'构造 Libraries 加载器
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 LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo:" & Logo)
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
File.Delete(Target)
End If
Next
End Sub) With {.ProgressWeight = 0.1, .Show = False})
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo:" & Logo)
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
File.Delete(Target)
End If
Next
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
@@ -438,10 +434,10 @@ Retry:
End If
'添加下载文件
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
Next
If FileList.Count > 0 Then
If FileList.Any Then
InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
End If
@@ -453,43 +449,35 @@ Retry:
.ForgeVersion = ForgeVersion,
.FabricVersion = FabricVersion
}
Dim InstallExpectTime As Double = 0
For Each InstallLoader In InstallLoaders
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
Next
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
'构造 Libraries 加载器
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 LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo:" & Logo)
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
File.Delete(Target)
End If
Next
End Sub) With {.ProgressWeight = 0.1, .Show = False})
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo:" & Logo)
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
File.Delete(Target)
End If
Next
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查
Dim LoaderName As String = "Modrinth 整合包安装:" & VersionName & " "
@@ -554,16 +542,8 @@ Retry:
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Json("gameVersion").ToString
}
Dim InstallExpectTime As Double = 0
For Each InstallLoader In InstallLoaders
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
Next
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)",
@@ -584,8 +564,8 @@ Retry:
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
'构造总加载器
Dim Loaders As New List(Of LoaderBase) From {
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime},
New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime},
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)},
New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)},
New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}
}
@@ -704,24 +684,16 @@ Retry:
End Select
Next
'构造加载器
Dim InstallExpectTime As Double = 0
For Each InstallLoader In InstallLoaders
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
Next
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
'构造 Libraries 加载器
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 LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
'重复任务检查
@@ -802,24 +774,16 @@ Retry:
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
}
Dim InstallExpectTime As Double = 0
For Each InstallLoader In InstallLoaders
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
Next
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
'构造 Libraries 加载器
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 LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
'重复任务检查
@@ -143,7 +143,7 @@
'输出文本
Dim Copyed As New List(Of String)
SyncLock WaitingLogLock
If WaitingLog.Count = 0 Then Exit Sub
If Not WaitingLog.Any() Then Exit Sub
Copyed = WaitingLog
WaitingLog = New List(Of String)(1000)
End SyncLock
@@ -192,7 +192,7 @@
If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then
WatcherLog("日志 2/5:游戏用户已设置") '仅确保支持 Minecraft 1.7+
LogProgress = 2
ElseIf LogProgress < 3 AndAlso Text.ToLower.Contains("lwjgl version") Then
ElseIf LogProgress < 3 AndAlso Text.ContainsF("lwjgl version", True) Then
WatcherLog("日志 3/5:LWJGL 版本已确认")
LogProgress = 3
ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then
@@ -269,24 +269,25 @@
If MinecraftWindow Is Nothing Then Exit Sub
Dim MinecraftWindowName = MinecraftWindow.Value.Value, MinecraftWindowHandle = MinecraftWindow.Value.Key
'已找到窗口
If Not MinecraftWindowName.StartsWith("FML") Then
If Not MinecraftWindowName.StartsWithF("FML") Then
'已找到 Minecraft 窗口
WindowHandle = MinecraftWindowHandle
WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})")
IsWindowFinished = True
'最大化
If Setup.Get("LaunchArgumentWindowType") = 4 Then
RunInNewThread(Sub()
Try
'如果最大化导致屏幕渲染大小不对,那是 MC 的 Bug,不是我的 Bug
'……虽然我很想这样说,但总有人反馈,算了
Thread.Sleep(2000)
ShowWindow(WindowHandle, 3)
WatcherLog($"已最大化 Minecraft 窗口:{MinecraftWindowHandle.ToInt64}")
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
End Try
End Sub, "MinecraftWindowMaximize")
RunInNewThread(
Sub()
Try
'如果最大化导致屏幕渲染大小不对,那是 MC 的 Bug,不是我的 Bug
'……虽然我很想这样说,但总有人反馈,算了
Thread.Sleep(2000)
ShowWindow(WindowHandle, 3)
WatcherLog($"已最大化 Minecraft 窗口:{MinecraftWindowHandle.ToInt64}")
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
End Try
End Sub, "MinecraftWindowMaximize")
End If
ElseIf Not IsWindowAppeared Then
'已找到 FML 窗口
@@ -317,7 +318,7 @@
Dim WindowText As String = str.ToString
'有的 Mod 可以修改窗口标题,所以不能检测是否为 Minecraft 打头,这并不准确
'部分版本会搞个 GLFW message window 出来所以得反选
If Not (WindowText.StartsWith("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWith("GLFW")) Then Exit Sub
If Not (WindowText.StartsWithF("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWithF("GLFW")) Then Exit Sub
'获取窗口关联的进程
Dim ProcessId As Integer
GetWindowThreadProcessId(hwnd, ProcessId)
@@ -14,11 +14,11 @@
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.ToLower.StartsWith("http") Then
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[Comp] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
@@ -1,8 +1,9 @@
<Grid x:Class="MyLocalModItem"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
x:Name="PanBack" Height="44"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL;assembly="
x:Name="PanBack" Height="44"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="6" />
<ColumnDefinition Width="34" />
@@ -19,7 +20,7 @@
</Grid.RowDefinitions>
<!-- Logo -->
<Border Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False" SnapsToDevicePixels="True" UseLayoutRounding="True"
HorizontalAlignment="Right" VerticalAlignment="Center" Width="34" Height="34">
HorizontalAlignment="Right" VerticalAlignment="Center" Width="34" Height="34">
<Border.Clip>
<RectangleGeometry Rect="0,0,34,34" RadiusX="6" RadiusY="6" />
</Border.Clip>
@@ -27,10 +28,26 @@
</Border>
<!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
SnapsToDevicePixels="False" UseLayoutRounding="False">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" IsHitTestVisible="False"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<!-- 更新按钮 -->
<local:MyIconButton Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
</StackPanel>
<!--<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Grid.Column="0" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Grid.Column="1"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<local:MyIconTextButton Grid.Column="2" Text="更新" />
</Grid>-->
<!-- Tag 与 详情 -->
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False">
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
@@ -16,11 +16,11 @@ Public Class MyLocalModItem
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.ToLower.StartsWith("http") Then
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
ElseIf _Logo.ToLower.EndsWith(".webp") Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
Log($"[LocalModItem] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
Else
@@ -190,6 +190,39 @@ RetryStart:
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
End Sub
'滑动选中
Private Shared SwipeStart As Integer, SwipeEnd As Integer
Private Shared Swiping As Boolean = False
Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值
Private Sub Button_MouseSwipeStart(sender As Object, e As Object) Handles Me.MouseLeftButtonDown
'开始滑动
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
SwipeStart = Index
SwipeEnd = Index
Swiping = True
SwipToState = Not Checked
FrmVersionMod.CardSelect.IsHitTestVisible = False '暂时禁用下边栏
End Sub
Private Sub Button_MouseSwipe(sender As Object, e As Object) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonUp
'结束滑动
If Mouse.LeftButton <> MouseButtonState.Pressed OrElse Not Swiping Then
Swiping = False
FrmVersionMod.CardSelect.IsHitTestVisible = True
Exit Sub
End If
'计算滑动范围
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
SwipeStart = Math.Min(SwipeStart, Index)
SwipeEnd = Math.Max(SwipeEnd, Index)
'勾选所有范围中的项
If SwipeStart = SwipeEnd Then Exit Sub
For i = SwipeStart To SwipeEnd
Dim Item As MyLocalModItem = CType(Parent, StackPanel).Children(i)
Item.InitLate(Item, e)
Item.Checked = SwipToState
Next
End Sub
'勾选状态
Public Event Check(sender As Object, e As RouteEventArgs)
Public Event Changed(sender As Object, e As RouteEventArgs)
@@ -201,10 +234,10 @@ RetryStart:
Set(value As Boolean)
Try
'触发属性值修改
Dim ChangedEventArgs As New RouteEventArgs(False)
Dim RawValue = _Checked
If value = _Checked Then Exit Property
_Checked = value
Dim ChangedEventArgs As New RouteEventArgs(False)
If IsInitialized Then
RaiseEvent Changed(Me, ChangedEventArgs)
If ChangedEventArgs.Handled Then
@@ -310,7 +343,7 @@ RetryStart:
Children.Remove(ButtonStack)
ButtonStack = Nothing
End If
If value.Count = 0 Then Exit Property
If Not value.Any() Then Exit Property
'添加新 Stack
ButtonStack = New StackPanel With {.Opacity = 0, .Margin = New Thickness(0, 0, 5, 0), .SnapsToDevicePixels = False, .Orientation = Orientation.Horizontal,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Center, .UseLayoutRounding = False}
@@ -347,6 +380,30 @@ RetryStart:
Public Sub Refresh()
RunInUi(
Sub()
'更新
If Entry.CanUpdate Then
BtnUpdate.Visibility = Visibility.Visible
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
'简化名称对比
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
Dim NewestSegs = NewestName.Split("-"c).ToList()
Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For
CurrentSegs.Remove(Seg)
NewestSegs.Remove(Seg)
Shortened = True
Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentName = Join(CurrentSegs, "-")
NewestName = Join(NewestSegs, "-")
Entry._Version = CurrentName '使用网络信息作为显示的版本号
End If
BtnUpdate.ToolTip = $"当前版本:{CurrentName} ({Entry.CompFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}最新版本:{NewestName} ({Entry.UpdateFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}点击以更新,右键查看更新日志。"
Else
BtnUpdate.Visibility = Visibility.Collapsed
End If
'标题
If Entry.Comp Is Nothing Then
Title = Entry.Name
@@ -390,9 +447,9 @@ RetryStart:
Else
If ImgState Is Nothing Then
ImgState = New Image With {
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
}
.Width = 20, .Height = 20, .Margin = New Thickness(0, 0, -5, -3), .IsHitTestVisible = False,
.HorizontalAlignment = HorizontalAlignment.Right, .VerticalAlignment = VerticalAlignment.Bottom
}
RenderOptions.SetBitmapScalingMode(ImgState, BitmapScalingMode.HighQuality)
SetColumn(ImgState, 1) : SetRow(ImgState, 1) : SetRowSpan(ImgState, 2)
Children.Add(ImgState)
@@ -409,11 +466,7 @@ RetryStart:
End Sub
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed
'按钮虚拟化检测
If ButtonHandler IsNot Nothing Then
ButtonHandler(sender, e)
ButtonHandler = Nothing
End If
InitLate(sender, e)
'触发颜色动画
Dim Time As Integer = If(IsMouseOver, 120, 180)
Dim Ani As New List(Of AniData)
@@ -422,19 +475,19 @@ RetryStart:
If IsMouseOver Then
Ani.Add(AaOpacity(ButtonStack, 1 - ButtonStack.Opacity, Time * 0.7, Time * 0.3))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
5 + Buttons.Count * 25 - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7))
5 + Buttons.Count * 25 - ColumnPaddingRight.Width.Value, Time * 0.3, Time * 0.7))
Else
Ani.Add(AaOpacity(ButtonStack, -ButtonStack.Opacity, Time * 0.4))
Ani.Add(AaDouble(Sub(i) ColumnPaddingRight.Width = New GridLength(Math.Max(0, ColumnPaddingRight.Width.Value + i)),
4 - ColumnPaddingRight.Width.Value, Time * 0.4))
4 - ColumnPaddingRight.Width.Value, Time * 0.4))
End If
End If
'RectBack
If IsMouseOver OrElse Checked Then
Ani.AddRange({
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
AaColor(RectBack, Border.BackgroundProperty, If(IsMouseDown, "ColorBrush6", "ColorBrushBg1"), Time),
AaOpacity(RectBack, 1 - RectBack.Opacity, Time,, New AniEaseOutFluent)
})
If IsMouseDown Then
Ani.Add(AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time * 1.2,, New AniEaseOutFluent))
Else
@@ -442,12 +495,42 @@ RetryStart:
End If
Else
Ani.AddRange({
AaOpacity(RectBack, -RectBack.Opacity, Time),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
AaOpacity(RectBack, -RectBack.Opacity, Time),
AaScaleTransform(RectBack, 0.996 - CType(RectBack.RenderTransform, ScaleTransform).ScaleX, Time,, New AniEaseOutFluent),
AaScaleTransform(RectBack, -0.196, 1,,, True)
})
End If
AniStart(Ani, "LocalModItem Color " & Uuid)
End Sub
'触发虚拟化内容
Private Sub InitLate(sender As Object, e As EventArgs)
If ButtonHandler IsNot Nothing Then
ButtonHandler(sender, e)
ButtonHandler = Nothing
End If
End Sub
'显示更新日志
Private Sub ShowUpdateLog(sender As Object, e As MouseButtonEventArgs) Handles BtnUpdate.PreviewMouseRightButtonUp
e.Handled = True
Dim CurseForgeUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("curseforge.com"))
Dim ModrinthUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("modrinth.com"))
If CurseForgeUrl Is Nothing OrElse ModrinthUrl Is Nothing Then
OpenWebsite(Entry.ChangelogUrls.First)
Else
Select Case MyMsgBox("要在哪个网站上查看更新日志?", "查看更新日志", "Modrinth", "CurseForge", "取消")
Case 1
OpenWebsite(ModrinthUrl)
Case 2
OpenWebsite(CurseForgeUrl)
End Select
End If
End Sub
'触发更新
Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
FrmVersionMod.UpdateMods({Entry})
End Sub
End Class
+4 -4
View File
@@ -13,7 +13,7 @@
Case "打开网页"
Data(0) = Data(0).Replace("\", "/")
If Not Data(0).Contains("://") OrElse Data(0).ToLower.StartsWith("file") Then '为了支持更多协议(#2200)
If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200)
MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
Exit Sub
End If
@@ -78,7 +78,7 @@
Case "下载文件"
Data(0) = Data(0).Replace("\", "/")
If Not (Data(0).StartsWith("http://") OrElse Data(0).StartsWith("https://")) Then
If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Exit Sub
End If
@@ -99,7 +99,7 @@
Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String()
'网页确认
If RelativeUrl.ToLower.StartsWith("http") Then
If RelativeUrl.StartsWithF("http", True) Then
If RunInUi() Then
Throw New Exception("MyListItem 在界面初始化时就需要获取帮助标题等信息,这会导致程序在网络请求时卡死。" & vbCrLf &
"因此,请换用 MyListItem 以外的控件(例如 MyButton)作为联网帮助页面的入口!")
@@ -108,7 +108,7 @@
Dim RawFileName As String
Try
RawFileName = GetFileNameFromPath(RelativeUrl)
If Not RawFileName.ToLower.EndsWith(".json") Then Throw New Exception("未指向 .json 后缀的文件")
If Not RawFileName.EndsWithF(".json", True) Then Throw New Exception("未指向 .json 后缀的文件")
Catch ex As Exception
Throw New Exception("联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
"例如:" & vbCrLf &
+14 -8
View File
@@ -1,4 +1,6 @@
Public Module ModMusic
Imports System.Security.Cryptography
Public Module ModMusic
#Region "播放列表"
@@ -31,7 +33,7 @@
End If
'打乱顺序播放
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
If Not IgnoreFirst = "" AndAlso Not MusicWaitingList.Count = 0 AndAlso MusicWaitingList(0) = IgnoreFirst Then
If Not IgnoreFirst = "" AndAlso Not Not MusicWaitingList.Any() AndAlso MusicWaitingList(0) = IgnoreFirst Then
'若需要避免成为第一项的为第一项,则将它放在最后
MusicWaitingList.RemoveAt(0)
MusicWaitingList.Add(IgnoreFirst)
@@ -45,11 +47,11 @@
''' </summary>
Private Function DequeueNextMusicAddress() As String
'初始化,确保存在音乐
If MusicAllList Is Nothing OrElse MusicAllList.Count = 0 OrElse MusicWaitingList.Count = 0 Then MusicListInit(False)
If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False)
'出列下一个音乐,如果出列结束则生成新列表
DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
If MusicWaitingList.Count = 0 Then MusicListInit(False, DequeueNextMusicAddress)
If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress)
End Function
#End Region
@@ -63,7 +65,7 @@
RunInUi(Sub()
Try
If MusicAllList.Count = 0 Then
If Not MusicAllList.Any() Then
'无背景音乐
FrmMain.BtnExtraMusic.Show = False
Else
@@ -160,7 +162,7 @@
Try
MusicListInit(True)
If MusicAllList.Count = 0 Then
If Not MusicAllList.Any() Then
If MusicNAudio Is Nothing Then
If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Critical)
Else
@@ -264,12 +266,16 @@
Thread.Sleep(100)
End While
'当前音乐已播放结束,继续下一曲
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress)
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception
Log("[Music] 播放音乐失败的文件完整路径:" & MusicCurrent)
If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Critical)
Thread.Sleep(1000000000)
End If
If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
ElseIf Not (MusicCurrent.ToLower.EndsWith(".wav") OrElse MusicCurrent.ToLower.EndsWith(".mp3") OrElse MusicCurrent.ToLower.EndsWith(".flac")) Then
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
@@ -8,11 +8,11 @@ Imports System.Runtime.InteropServices
'查看程序集特性的值
<Assembly: AssemblyTitle("Plain Craft Launcher 2 启动器")>
<Assembly: AssemblyTitle("Plain Craft Launcher 启动器")>
<Assembly: AssemblyDescription("Minecraft 启动器 (制作:龙腾猫跃)")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("Plain Craft Launcher 2")>
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016-2024. All Rights Reserved.")>
<Assembly: AssemblyProduct("Plain Craft Launcher")>
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016. All Rights Reserved.")>
<Assembly: AssemblyConfiguration("PCL2 Config Mark")>
<Assembly: ComVisible(False)>
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.6.15.0")>
<Assembly: AssemblyFileVersion("2.6.15.0")>
<Assembly: AssemblyVersion("2.7.2.0")>
<Assembly: AssemblyFileVersion("2.7.2.0")>
<Assembly: NeutralResourcesLanguage("")>
@@ -120,49 +120,49 @@ Public Module ModDownloadLib
'下载版本 Json 文件
If JsonUrl Is Nothing Then
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取原版 json 文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim JsonAddress As String = DlClientListGet(Id)
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JsonAddress), VersionFolder & VersionName & ".json")}
End Sub) With {.ProgressWeight = 2, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim JsonAddress As String = DlClientListGet(Id)
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JsonAddress), VersionFolder & VersionName & ".json")}
End Sub) With {.ProgressWeight = 2, .Show = False})
End If
Loaders.Add(New LoaderDownload(McDownloadClientJsonName, New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(If(JsonUrl, "")), VersionFolder & VersionName & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 3})
New NetFile(DlSourceLauncherOrMetaGet(If(JsonUrl, "")), VersionFolder & VersionName & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 3})
'下载支持库文件
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)))
Log("[Download] 开始分析原版支持库文件:" & VersionFolder)
Task.Output = McLibFix(New McVersion(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Log("[Download] 开始分析原版支持库文件:" & VersionFolder)
Task.Output = McLibFix(New McVersion(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载原版支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 13, .Show = False})
Loaders.Add(New LoaderCombo(Of String)(McDownloadClientLibName, LoadersLib) With {.Block = False, .ProgressWeight = 14})
'下载资源文件
Dim LoadersAssets As New List(Of LoaderBase)
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim Version As New McVersion(VersionFolder)
Task.Output = New List(Of NetFile) From {DlClientAssetIndexGet(Version)}
Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex)
End Try
'顺手添加 Json 项目
Try
Dim VersionJson As JObject = GetJson(ReadFile(VersionFolder & VersionName & ".json"))
VersionJson.Add("clientVersion", Id)
WriteFile(VersionFolder & VersionName & ".json", VersionJson.ToString)
Catch ex As Exception
Throw New Exception("添加客户端版本失败", ex)
End Try
End Sub) With {.ProgressWeight = 1, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim Version As New McVersion(VersionFolder)
Task.Output = New List(Of NetFile) From {DlClientAssetIndexGet(Version)}
Catch ex As Exception
Throw New Exception("分析资源文件索引地址失败", ex)
End Try
'顺手添加 Json 项目
Try
Dim VersionJson As JObject = GetJson(ReadFile(VersionFolder & VersionName & ".json"))
VersionJson.Add("clientVersion", Id)
WriteFile(VersionFolder & VersionName & ".json", VersionJson.ToString)
Catch ex As Exception
Throw New Exception("添加客户端版本失败", ex)
End Try
End Sub) With {.ProgressWeight = 1, .Show = False})
LoadersAssets.Add(New LoaderDownload("下载资源文件索引(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 3, .Show = False})
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析所需资源文件(副加载器)",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(New McVersion(VersionFolder)), True, Task)
End Sub) With {.ProgressWeight = 3, .Show = False})
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(New McVersion(VersionFolder)), True, Task)
End Sub) With {.ProgressWeight = 3, .Show = False})
LoadersAssets.Add(New LoaderDownload("下载资源文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 14, .Show = False})
Loaders.Add(New LoaderCombo(Of String)("下载原版资源文件", LoadersAssets) With {.Block = False, .ProgressWeight = 21})
@@ -283,7 +283,7 @@ Public Module ModDownloadLib
WikiName = "Java版Combat_Test_8c"
ElseIf Id = "1.0.0-rc2-2" Then
WikiName = "Java版RC2"
ElseIf Id.StartsWith("1.19_deep_dark_experimental_snapshot-") OrElse Id.StartsWith("1_19_deep_dark_experimental_snapshot-") Then
ElseIf Id.StartsWithF("1.19_deep_dark_experimental_snapshot-") OrElse Id.StartsWithF("1_19_deep_dark_experimental_snapshot-") Then
WikiName = Id.Replace("1_19", "1.19").Replace("1.19_deep_dark_experimental_snapshot-", "Java版Deep_Dark_Experimental_Snapshot_")
ElseIf Id = "b1.9-pre6" Then
WikiName = "Java版Beta_1.9_Prerelease_6"
@@ -291,19 +291,19 @@ Public Module ModDownloadLib
WikiName = "Java版Beta_1.9_Prerelease"
ElseIf VersionJson("type") = "release" OrElse VersionJson("type") = "snapshot" OrElse VersionJson("type") = "special" Then
WikiName = If(Id.Contains("w"), "", "Java版") & Id.Replace(" Pre-Release ", "-pre")
ElseIf Id.StartsWith("b") Then
ElseIf Id.StartsWithF("b") Then
WikiName = "Java版" & Id.TrimEnd("a", "b", "c", "d", "e").Replace("b", "Beta_")
ElseIf Id.StartsWith("a") Then
ElseIf Id.StartsWithF("a") Then
WikiName = "Java版" & Id.TrimEnd("a", "b", "c", "d", "e").Replace("a", "Alpha_v")
ElseIf Id = "inf-20100618" Then
WikiName = "Java版Infdev_20100618"
ElseIf Id = "c0.30_01c" OrElse Id = "c0.30_survival" OrElse Id.Contains("生存测试") Then
WikiName = "Java版Classic_0.30(生存模式)"
ElseIf Id.StartsWith("c0.31") Then
ElseIf Id.StartsWithF("c0.31") Then
WikiName = "Java版Indev_0.31_20100130"
ElseIf Id.StartsWith("c") Then
ElseIf Id.StartsWithF("c") Then
WikiName = "Java版" & Id.Replace("c", "Classic_")
ElseIf Id.StartsWith("rd-") Then
ElseIf Id.StartsWithF("rd-") Then
WikiName = "Java版Pre-classic_" & Id
Else
Log("[Error] 未知的版本格式:" & Id & "。", LogLevel.Feedback)
@@ -428,52 +428,54 @@ Public Module ModDownloadLib
Dim LastResult As String = ""
Using outputWaitHandle As New AutoResetEvent(False)
Using errorWaitHandle As New AutoResetEvent(False)
AddHandler process.OutputDataReceived, Function(sender, e)
Try
If e.Data Is Nothing Then
outputWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器信息失败")
End Try
Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
End Try
Return Nothing
End Function
AddHandler process.ErrorDataReceived, Function(sender, e)
Try
If e.Data Is Nothing Then
errorWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
End Try
Return Nothing
End Function
AddHandler process.OutputDataReceived,
Function(sender, e)
Try
If e.Data Is Nothing Then
outputWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器信息失败")
End Try
Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
End Try
Return Nothing
End Function
AddHandler process.ErrorDataReceived,
Function(sender, e)
Try
If e.Data Is Nothing Then
errorWaitHandle.[Set]()
Else
LastResult = e.Data
If ModeDebug Then Log("[Installer] " & LastResult)
TotalLength += 1
Task.Progress += 0.9 / 7000
End If
Catch ex As ObjectDisposedException
Catch ex As Exception
Log(ex, "读取 OptiFine 安装器错误信息失败")
End Try
Try
If Task.State = LoadState.Aborted AndAlso Not process.HasExited Then
Log("[Installer] 由于任务取消,已中止 OptiFine 安装")
process.Kill()
End If
Catch
End Try
Return Nothing
End Function
process.Start()
process.BeginOutputReadLine()
process.BeginErrorReadLine()
@@ -485,7 +487,7 @@ Public Module ModDownloadLib
outputWaitHandle.WaitOne(10000)
errorWaitHandle.WaitOne(10000)
process.Dispose()
If TotalLength < 1000 Then Throw New Exception("安装器运行出错,末行为 " & LastResult)
If TotalLength < 1000 OrElse LastResult.Contains("at ") Then Throw New Exception("安装器运行出错,末行为 " & LastResult)
End Using
End Using
End SyncLock
@@ -536,7 +538,7 @@ Public Module ModDownloadLib
'OptiFine 中文镜像源
Sources.Add("https://optifine.cn/download/" & DownloadInfo.NameFile)
'构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=64 * 1024))}
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))}
End Sub) With {.ProgressWeight = 8})
Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载",
@@ -546,8 +548,8 @@ Public Module ModDownloadLib
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Count > 0 Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
If TargetLoaders.Any Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
@@ -558,12 +560,10 @@ Public Module ModDownloadLib
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile(ClientFolder & ClientName & ".json",
McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
CopyFile($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json")
End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile(ClientFolder & ClientName & ".jar",
McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
CopyFile($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar")
End If
End SyncLock
End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -1010,7 +1010,7 @@ Retry:
End If
Exit Sub
End If
If DownloadInfo.Category = "universal" OrElse DownloadInfo.Inherit.StartsWith("1.5") Then '对该版本自动安装的支持将在之后加入
If DownloadInfo.Category = "universal" OrElse DownloadInfo.Inherit.StartsWithF("1.5") Then '对该版本自动安装的支持将在之后加入
If MyMsgBox("该 Forge 版本过于古老,PCL 暂不支持该版本的自动安装。" & vbCrLf &
"若你仍然希望继续,PCL 将把安装程序下载到你指定的位置,但不会进行安装。",
"版本过老", "继续", "取消") = 1 Then
@@ -1214,9 +1214,9 @@ Retry:
End SyncLock
End Sub
Private Sub ForgeInjectorLine(Content As String, Task As LoaderTask(Of Boolean, Boolean))
If Content.StartsWith(" Data") OrElse Content.StartsWith(" Slim") Then
If Content.StartsWithF(" Data") OrElse Content.StartsWithF(" Slim") Then
If ModeDebug Then Log("[Installer] " & Content)
ElseIf Content.StartsWith(" Reading patch ") Then
ElseIf Content.StartsWithF(" Reading patch ") Then
If ModeDebug Then Log("[Installer] " & Content)
Task.Progress = 0.86
Else
@@ -1265,7 +1265,7 @@ Retry:
'参数初始化
McFolder = If(McFolder, PathMcFolder)
If Version.StartsWith("1.") AndAlso Version.Contains("-") Then
If Version.StartsWithF("1.") AndAlso Version.Contains("-") Then
'类似 1.19.3-41.2.8 格式,优先使用 Version 中要求的版本而非 Inherit(例如 1.19.3 却使用了 1.19 的 Forge)
Inherit = Version.Split("-").First
Version = Version.Split("-").Last
@@ -1281,20 +1281,20 @@ Retry:
'获取下载信息
If DownloadInfo Is Nothing Then
Loaders.Add(New LoaderTask(Of String, String)("获取 Mod 加载器详细信息",
Sub(Task As LoaderTask(Of String, String))
'获取 Forge 版本列表
Dim ForgeLoader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("McDownloadForgeLoader " & Inherit, AddressOf DlForgeVersionMain)
ForgeLoader.WaitForExit(Inherit)
Task.Progress = 0.8
'查找对应版本
For Each ForgeVersion In ForgeLoader.Output
If ForgeVersion.Version = Version Then
DownloadInfo = ForgeVersion
Exit Sub
End If
Next
Throw New Exception("未能找到 Forge " & Inherit & "-" & Version & " 的详细信息!")
End Sub) With {.ProgressWeight = 3})
Sub(Task As LoaderTask(Of String, String))
'获取 Forge 版本列表
Dim ForgeLoader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("McDownloadForgeLoader " & Inherit, AddressOf DlForgeVersionMain)
ForgeLoader.WaitForExit(Inherit)
Task.Progress = 0.8
'查找对应版本
For Each ForgeVersion In ForgeLoader.Output
If ForgeVersion.Version = Version Then
DownloadInfo = ForgeVersion
Exit Sub
End If
Next
Throw New Exception("未能找到 Forge " & Inherit & "-" & Version & " 的详细信息!")
End Sub) With {.ProgressWeight = 3})
End If
'下载 Forge 主文件
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("准备 Mod 加载器下载",
@@ -1345,8 +1345,8 @@ Retry:
Task.Progress = 0.8
'去除其中的原始 Forge 项
For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & ".jar") OrElse
Libs(i).LocalPath.EndsWith("forge-" & Inherit & "-" & Version & "-client.jar") Then
If Libs(i).LocalPath.EndsWithF("forge-" & Inherit & "-" & Version & ".jar") OrElse
Libs(i).LocalPath.EndsWithF("forge-" & Inherit & "-" & Version & "-client.jar") Then
Log("[Download] 已从待下载 Forge 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
Libs.RemoveAt(i)
Exit For
@@ -1381,8 +1381,8 @@ Retry:
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Count > 0 Then Log("[Download] Forge 安装正在等待原版文件下载完成")
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
If TargetLoaders.Any Then Log("[Download] Forge 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
@@ -1439,7 +1439,7 @@ Retry:
End Try
'拷贝新增的版本 Json
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
If DeltaList.Count > 1 Then
'它可能和 OptiFine 安装同时运行,导致增加的文件不止一个(这导致了 #151)
'也可能是因为 Forge 安装器的 Bug,生成了一个名字错误的文件夹,所以需要检查文件夹是否为空
@@ -1535,7 +1535,7 @@ Retry:
Public Sub ForgeDownloadListItemPreload(Stack As StackPanel, Entrys As List(Of DlForgeVersionEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean)
'获取推荐版本与最新版本
Dim FreshVersion As DlForgeVersionEntry = Nothing
If Entrys.Count > 0 Then
If Entrys.Any Then
FreshVersion = Entrys(0)
Else
Log("[System] 未找到可用的 Forge 版本", LogLevel.Debug)
@@ -1644,7 +1644,7 @@ Retry:
For Each Version As JObject In ResultJson
If Version("name") Is Nothing OrElse Version("build") Is Nothing Then Continue For
Dim Name As String = Version("name")
If Not Name.EndsWith("-recommended") Then Continue For
If Not Name.EndsWithF("-recommended") Then Continue For
'内容为:"1.15.2":"31.2.0"
RecommendedList.Add("""" & Name.Replace("-recommended", """:""" & Version("build")("version").ToString & """"))
Next
@@ -1974,9 +1974,9 @@ Retry:
Request.OptiFineEntry = New DlOptiFineListEntry With {
.NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"),
.Inherit = Request.MinecraftName,
.IsPreview = Request.OptiFineVersion.ToLower.Contains("pre"),
.IsPreview = Request.OptiFineVersion.ContainsF("pre", True),
.NameVersion = Request.MinecraftName & "-OptiFine_" & Request.OptiFineVersion,
.NameFile = If(Request.OptiFineVersion.ToLower.Contains("pre"), "preview_", "") &
.NameFile = If(Request.OptiFineVersion.ContainsF("pre", True), "preview_", "") &
"OptiFine_" & Request.MinecraftName & "_" & Request.OptiFineVersion & ".jar"
}
End If
@@ -2012,7 +2012,7 @@ Retry:
Dim LoaderList As New List(Of LoaderBase)
'添加忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(OutputFolder & ".pclignore", "该文件会使得该文件夹不在 PCL 的版本列表中显示")) With {.Show = False, .Block = False})
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(OutputFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
'Fabric API
If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False})
@@ -2083,36 +2083,36 @@ Retry:
Dim OutputJsonPath As String, MinecraftJsonPath As String, OptiFineJsonPath As String = Nothing, ForgeJsonPath As String = Nothing, LiteLoaderJsonPath As String = Nothing, FabricJsonPath As String = Nothing
Dim OutputJar As String, MinecraftJar As String
#Region "初始化路径信息"
If Not OutputFolder.EndsWith("\") Then OutputFolder += "\"
If Not OutputFolder.EndsWithF("\") Then OutputFolder += "\"
OutputName = GetFolderNameFromPath(OutputFolder)
OutputJsonPath = OutputFolder & OutputName & ".json"
OutputJar = OutputFolder & OutputName & ".jar"
If Not MinecraftFolder.EndsWith("\") Then MinecraftFolder += "\"
If Not MinecraftFolder.EndsWithF("\") Then MinecraftFolder += "\"
MinecraftName = GetFolderNameFromPath(MinecraftFolder)
MinecraftJsonPath = MinecraftFolder & MinecraftName & ".json"
MinecraftJar = MinecraftFolder & MinecraftName & ".jar"
If HasOptiFine Then
If Not OptiFineFolder.EndsWith("\") Then OptiFineFolder += "\"
If Not OptiFineFolder.EndsWithF("\") Then OptiFineFolder += "\"
OptiFineName = GetFolderNameFromPath(OptiFineFolder)
OptiFineJsonPath = OptiFineFolder & OptiFineName & ".json"
End If
If HasForge Then
If Not ForgeFolder.EndsWith("\") Then ForgeFolder += "\"
If Not ForgeFolder.EndsWithF("\") Then ForgeFolder += "\"
ForgeName = GetFolderNameFromPath(ForgeFolder)
ForgeJsonPath = ForgeFolder & ForgeName & ".json"
End If
If HasLiteLoader Then
If Not LiteLoaderFolder.EndsWith("\") Then LiteLoaderFolder += "\"
If Not LiteLoaderFolder.EndsWithF("\") Then LiteLoaderFolder += "\"
LiteLoaderName = GetFolderNameFromPath(LiteLoaderFolder)
LiteLoaderJsonPath = LiteLoaderFolder & LiteLoaderName & ".json"
End If
If HasFabric Then
If Not FabricFolder.EndsWith("\") Then FabricFolder += "\"
If Not FabricFolder.EndsWithF("\") Then FabricFolder += "\"
FabricName = GetFolderNameFromPath(FabricFolder)
FabricJsonPath = FabricFolder & FabricName & ".json"
End If
@@ -2121,30 +2121,30 @@ Retry:
Dim OutputJson As JObject, MinecraftJson As JObject, OptiFineJson As JObject = Nothing, ForgeJson As JObject = Nothing, LiteLoaderJson As JObject = Nothing, FabricJson As JObject = Nothing
#Region "读取文件并检查文件是否合规"
Dim MinecraftJsonText As String = ReadFile(MinecraftJsonPath)
If Not MinecraftJsonText.StartsWith("{") Then Throw New Exception("Minecraft json 有误,地址:" & MinecraftJsonPath & ",前段内容:" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000)))
If Not MinecraftJsonText.StartsWithF("{") Then Throw New Exception("Minecraft json 有误,地址:" & MinecraftJsonPath & ",前段内容:" & MinecraftJsonText.Substring(0, Math.Min(MinecraftJsonText.Length, 1000)))
MinecraftJson = GetJson(MinecraftJsonText)
If HasOptiFine Then
Dim OptiFineJsonText As String = ReadFile(OptiFineJsonPath)
If Not OptiFineJsonText.StartsWith("{") Then Throw New Exception("OptiFine json 有误,地址:" & OptiFineJsonPath & ",前段内容:" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000)))
If Not OptiFineJsonText.StartsWithF("{") Then Throw New Exception("OptiFine json 有误,地址:" & OptiFineJsonPath & ",前段内容:" & OptiFineJsonText.Substring(0, Math.Min(OptiFineJsonText.Length, 1000)))
OptiFineJson = GetJson(OptiFineJsonText)
End If
If HasForge Then
Dim ForgeJsonText As String = ReadFile(ForgeJsonPath)
If Not ForgeJsonText.StartsWith("{") Then Throw New Exception("Forge json 有误,地址:" & ForgeJsonPath & ",前段内容:" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000)))
If Not ForgeJsonText.StartsWithF("{") Then Throw New Exception("Forge json 有误,地址:" & ForgeJsonPath & ",前段内容:" & ForgeJsonText.Substring(0, Math.Min(ForgeJsonText.Length, 1000)))
ForgeJson = GetJson(ForgeJsonText)
End If
If HasLiteLoader Then
Dim LiteLoaderJsonText As String = ReadFile(LiteLoaderJsonPath)
If Not LiteLoaderJsonText.StartsWith("{") Then Throw New Exception("LiteLoader json 有误,地址:" & LiteLoaderJsonPath & ",前段内容:" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000)))
If Not LiteLoaderJsonText.StartsWithF("{") Then Throw New Exception("LiteLoader json 有误,地址:" & LiteLoaderJsonPath & ",前段内容:" & LiteLoaderJsonText.Substring(0, Math.Min(LiteLoaderJsonText.Length, 1000)))
LiteLoaderJson = GetJson(LiteLoaderJsonText)
End If
If HasFabric Then
Dim FabricJsonText As String = ReadFile(FabricJsonPath)
If Not FabricJsonText.StartsWith("{") Then Throw New Exception("Fabric json 有误,地址:" & FabricJsonPath & ",前段内容:" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000)))
If Not FabricJsonText.StartsWithF("{") Then Throw New Exception("Fabric json 有误,地址:" & FabricJsonPath & ",前段内容:" & FabricJsonText.Substring(0, Math.Min(FabricJsonText.Length, 1000)))
FabricJson = GetJson(FabricJsonText)
End If
#End Region
@@ -2160,9 +2160,9 @@ Retry:
Dim RawArguments As List(Of String) = AllArguments.Split(" ").Where(Function(l) l <> "").Select(Function(l) l.Trim).ToList
Dim SplitArguments As New List(Of String)
For i = 0 To RawArguments.Count - 1
If RawArguments(i).StartsWith("-") Then
If RawArguments(i).StartsWithF("-") Then
SplitArguments.Add(RawArguments(i))
ElseIf SplitArguments.Count > 0 AndAlso SplitArguments.Last.StartsWith("-") AndAlso Not SplitArguments.Last.Contains(" ") Then
ElseIf SplitArguments.Any AndAlso SplitArguments.Last.StartsWithF("-") AndAlso Not SplitArguments.Last.Contains(" ") Then
SplitArguments(SplitArguments.Count - 1) = SplitArguments.Last & " " & RawArguments(i)
Else
SplitArguments.Add(RawArguments(i))
@@ -2170,6 +2170,7 @@ Retry:
Next
Dim RealArguments As String = Join(SplitArguments.Distinct.ToList, " ")
'合并
'相关讨论见 #2801
OutputJson = MinecraftJson
If HasOptiFine Then
'合并 OptiFine
@@ -39,7 +39,7 @@
Version("id") = "20w14∞"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b"
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato"
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
@@ -77,7 +77,7 @@
PanMain.Children.Add(CardInfo)
'添加其他版本
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -88,7 +88,7 @@
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(Project.Type = CompType.ModPack, 9, 8)} 'FUTURE: Res
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -210,10 +210,10 @@
If Project.Type = CompType.Mod Then
'获取 Mod 所需的加载器种类
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
If File.ModLoaders.Count > 0 Then '从文件中获取
If File.ModLoaders.Any Then '从文件中获取
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge)
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
ElseIf Project.ModLoaders.Count > 0 Then '从工程中获取
ElseIf Project.ModLoaders.Any Then '从工程中获取
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge)
AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric)
End If
@@ -252,7 +252,7 @@
For Each Version As McVersion In McVersionList.Values.SelectMany(Function(l) l)
If IsVersionSuitable(Version) Then SuitableVersions.Add(Version)
Next
If SuitableVersions.Count = 0 Then
If Not SuitableVersions.Any() Then
DefaultFolder = PathMcFolder
If NeedLoad Then
Hint("当前 MC 文件夹中没有找到适合这个 Mod 的版本!")
@@ -20,7 +20,6 @@
<StackPanel Margin="25,37,25,15">
<local:MyHint Text="你尚未选择安装 Fabric API,这会导致大多数 Mod 无法使用!" Margin="0,1,0,7" x:Name="HintFabricAPI" IsWarn="True" />
<local:MyHint Text="你尚未选择安装 OptiFabric,这会导致 OptiFine 无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabric" IsWarn="True" />
<local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabricOld" IsWarn="False" />
<Grid Margin="0,0,0,11">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
@@ -32,7 +32,7 @@
#Region "页面切换"
'页面切换动画
Private IsInSelectPage As Boolean = False
Public IsInSelectPage As Boolean = False
Private IsFirstLoaded As Boolean = False
Private Sub EnterSelectPage()
If IsInSelectPage Then Exit Sub
@@ -273,11 +273,13 @@
End If
End Sub
Private IsReloading As Boolean = False '#3742 中,LoadOptiFineGetError 会初始化 LoadOptiFine,触发事件 LoadOptiFine.StateChanged,导致再次调用 SelectReload
''' <summary>
''' 重载已选择的项目的显示。
''' </summary>
Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
If SelectedMinecraftId Is Nothing Then Exit Sub
If SelectedMinecraftId Is Nothing OrElse IsReloading Then Exit Sub
IsReloading = True
'主预览
SelectNameUpdate()
ItemSelect.Title = TextSelectName.Text
@@ -385,17 +387,12 @@
'主警告
HintFabricAPI.Visibility = If(SelectedFabric IsNot Nothing AndAlso SelectedFabricApi Is Nothing, Visibility.Visible, Visibility.Collapsed)
If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then
HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Visible
Else
HintOptiFabric.Visibility = Visibility.Visible
HintOptiFabricOld.Visibility = Visibility.Collapsed
End If
HintOptiFabric.Visibility = Visibility.Visible
Else
HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Collapsed
End If
'结束
IsReloading = False
End Sub
''' <summary>
''' 清空已选择的项目。
@@ -523,7 +520,7 @@
Version("id") = "20w14∞"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b"
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato"
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
@@ -562,7 +559,7 @@
PanMinecraft.Children.Insert(0, CardInfo)
'添加其他版本
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 7}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -656,7 +653,7 @@
If SelectedForge IsNot Nothing AndAlso Not IsOptiFineSuitForForge(Version, SelectedForge) Then Continue For
If Version.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
'排序
Versions = Sort(Versions, Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
@@ -724,7 +721,7 @@
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
If Version.Inherit = SelectedMinecraftId Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
'可视化
PanLiteLoader.Children.Clear()
For Each Version In Versions
@@ -804,7 +801,7 @@
'获取要显示的版本
Dim Versions As New List(Of DlForgeVersionEntry)
Versions.AddRange(Loader.Output) '复制数组,以免 Output 在实例化后变空
If Loader.Output.Count = 0 Then Exit Sub
If Not Loader.Output.Any() Then Exit Sub
PanForge.Children.Clear()
Versions = Sort(Versions, Function(a, b) New Version(a.Version) > New Version(b.Version)).
Where(Function(v)
@@ -870,7 +867,7 @@
If DlFabricListLoader.State <> LoadState.Finished Then Exit Sub
'获取版本列表
Dim Versions As JArray = DlFabricListLoader.Output.Value("loader")
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
'可视化
PanFabric.Children.Clear()
PanFabric.Tag = Versions
@@ -983,7 +980,7 @@
Versions.Add(Version)
End If
Next
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate)
'可视化
PanFabricApi.Children.Clear()
@@ -1037,7 +1034,6 @@
''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadOptiFabricGetError() As String
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric,请手动下载 OptiFabric Origins"
If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFabric.State, Object).Error.Message
If DlOptiFabricLoader.Output Is Nothing Then
@@ -1073,7 +1069,7 @@
For Each Version In DlOptiFabricLoader.Output
If IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Versions.Add(Version)
Next
If Versions.Count = 0 Then Exit Sub
If Not Versions.Any() Then Exit Sub
'排序
Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate)
'可视化
@@ -28,7 +28,7 @@
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlLiteLoaderListEntry)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 10}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -33,22 +33,19 @@
<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:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.3" />
<local:MyComboBoxItem Content="1.20.2" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.20" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.13.2" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.9.4" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
@@ -32,7 +32,7 @@
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlOptiFineListEntry)) In Dict
If Pair.Value.Count = 0 Then Continue For
If Not Pair.Value.Any() Then Continue For
'增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key & " (" & Pair.Value.Count & ")", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 3}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
@@ -32,22 +32,19 @@
<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:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.3" />
<local:MyComboBoxItem Content="1.20.2" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.20" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.13.2" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.9.4" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
@@ -19,51 +19,53 @@
RefreshButtonsUI()
'加载版本
RunInNewThread(Sub()
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
'无效的文件夹
If PathMcFolder = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹")
Else
Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & PathMcFolder, LogLevel.Debug)
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion
If Selection = "" Then
Version = Nothing
Else
Version = New McVersion(Selection)
End If
If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
'无效的版本
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), ",没有有效版本", ":" & 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 McVersionList.Count = 0 OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Launch] 无可用 Minecraft 版本")
Else
Version = McVersionList.First.Value(0)
Setup.Set("LaunchVersionSelect", Version.Name)
Log("[Launch] 自动选择 Minecraft 版本:" & Version.Path)
End If
End If
RunInUi(Sub()
McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
IsLoadFinished = True
RefreshButtonsUI()
RefreshPage(False, False) '有可能选择的版本变化了,需要重新刷新
If McLoginAble() = "" Then McLoginLoader.Start() '自动登录
End Sub)
End Sub, "Version Check", ThreadPriority.AboveNormal)
RunInNewThread(
Sub()
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
'无效的文件夹
If PathMcFolder = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹")
Else
Log("[Launch] Minecraft 文件夹无效,该文件夹已不存在:" & PathMcFolder, LogLevel.Debug)
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
End If
Log("[Launch] Minecraft 文件夹:" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion
If Selection = "" Then
Version = Nothing
Else
Version = New McVersion(Selection)
End If
If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
'无效的版本
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), ",没有有效版本", ":" & 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 McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Launch] 无可用 Minecraft 版本")
Else
Version = McVersionList.First.Value(0)
Setup.Set("LaunchVersionSelect", Version.Name)
Log("[Launch] 自动选择 Minecraft 版本:" & Version.Path)
End If
End If
RunInUi(
Sub()
McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
IsLoadFinished = True
RefreshButtonsUI()
RefreshPage(False, False) '有可能选择的版本变化了,需要重新刷新
If McLoginAble() = "" Then McLoginLoader.Start() '自动登录
End Sub)
End Sub, "Version Check", ThreadPriority.AboveNormal)
'改变页面
Dim LoginType As McLoginType = Setup.Get("LoginType")
@@ -67,7 +67,7 @@ Download:
End If
Case 3
Select Case Setup.Get("UiCustomPreset")
Case 0 '你知道吗
Case 0
Log("[Page] 主页预设:你知道吗")
Content = "
<local:MyCard Title=""你知道吗?"" Margin=""0,0,0,15"">
@@ -76,7 +76,7 @@ Download:
EventType=""刷新主页"" EventData=""/""
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
</local:MyCard>"
Case 1 '回声洞
Case 1
Log("[Page] 主页预设:回声洞")
Content = "
<local:MyCard Title=""回声洞"" Margin=""0,0,0,15"">
@@ -85,17 +85,17 @@ Download:
EventType=""刷新主页"" EventData=""/""
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
</local:MyCard>"
Case 2 '新闻
Case 2
Log("[Page] 主页预设:Minecraft 新闻")
Url = "http://pcl.mcnews.thestack.top"
GoTo Download
Case 3 '简单主页
Case 3
Log("[Page] 主页预设:简单主页")
Url = "https://gitee.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml"
GoTo Download
Case 4 '历史上的今天
Log("[Page] 主页预设:历史上的今天")
Url = "https://pclnews.52chye.cn/custom.xaml"
Case 4
Log("[Page] 主页预设:每日整合包推荐")
Url = "https://pclsub.sodamc.com/"
GoTo Download
End Select
End Select
@@ -85,50 +85,51 @@
Hint("正在更改皮肤……")
IsChanging = True
'开始实际获取
RunInNewThread(Async Sub()
Try
RunInNewThread(
Async Sub()
Try
Retry:
If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束
Dim AccessToken As String = Setup.Get("CacheMsAccess")
Dim Uuid As String = Setup.Get("CacheMsUuid")
If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束
Dim AccessToken As String = Setup.Get("CacheMsAccess")
Dim Uuid As String = Setup.Get("CacheMsUuid")
Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)}
Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken)
Client.DefaultRequestHeaders.Accept.Add(New Net.Http.Headers.MediaTypeWithQualityHeaderValue("*/*"))
Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1"))
Dim Contents As New Net.Http.MultipartFormDataContent From {
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
{New Net.Http.ByteArrayContent(File.ReadAllBytes(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
If Result.Contains("request requires user authentication") Then
Hint("正在登录,将在登录完成后继续更改皮肤……")
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
GoTo Retry
ElseIf Result.Contains("""error""") Then
Hint("更改皮肤失败:" & GetJson(Result)("error"), HintType.Critical)
Exit Sub
End If
'获取新皮肤地址
Log("[Skin] 皮肤修改返回值:" & vbCrLf & Result)
Dim ResultJson As JObject = GetJson(Result)
For Each Skin As JObject In ResultJson("skins")
If Skin("state").ToString = "ACTIVE" Then
MySkin.ReloadCache(Skin("url"))
Exit Sub
End If
Next
Throw New Exception("未知错误(" & Result & ")")
Catch ex As Exception
If ex.GetType.Equals(GetType(Tasks.TaskCanceledException)) Then
Hint("更改皮肤失败:与 Mojang 皮肤服务器的连接超时,请检查你的网络是否通畅!", HintType.Critical)
Else
Log(ex, "更改皮肤失败", LogLevel.Hint)
End If
Finally
IsChanging = False
End Try
End Sub, "Ms Skin Upload")
Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)}
Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken)
Client.DefaultRequestHeaders.Accept.Add(New Net.Http.Headers.MediaTypeWithQualityHeaderValue("*/*"))
Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1"))
Dim Contents As New Net.Http.MultipartFormDataContent From {
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
{New Net.Http.ByteArrayContent(File.ReadAllBytes(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
If Result.Contains("request requires user authentication") Then
Hint("正在登录,将在登录完成后继续更改皮肤……")
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
GoTo Retry
ElseIf Result.Contains("""error""") Then
Hint("更改皮肤失败:" & GetJson(Result)("error"), HintType.Critical)
Exit Sub
End If
'获取新皮肤地址
Log("[Skin] 皮肤修改返回值:" & vbCrLf & Result)
Dim ResultJson As JObject = GetJson(Result)
For Each Skin As JObject In ResultJson("skins")
If Skin("state").ToString = "ACTIVE" Then
MySkin.ReloadCache(Skin("url"))
Exit Sub
End If
Next
Throw New Exception("未知错误(" & Result & ")")
Catch ex As Exception
If ex.GetType.Equals(GetType(Tasks.TaskCanceledException)) Then
Hint("更改皮肤失败:与 Mojang 皮肤服务器的连接超时,请检查你的网络是否通畅!", HintType.Critical)
Else
Log(ex, "更改皮肤失败", LogLevel.Hint)
End If
Finally
IsChanging = False
End Try
End Sub, "Ms Skin Upload")
End Sub
'保存皮肤
@@ -258,7 +258,7 @@ Public Class PageLinkIoi
Public Function GetDescription() As String
Return If(Progress < 1,
"正在连接," & Math.Round(Progress * 100) & "%",
"已连接," & If(PingRecord.Count = 0, "检查延迟中", Math.Round(PingRecord.Average) & "ms"))
"已连接," & If(Not PingRecord.Any(), "检查延迟中", Math.Round(PingRecord.Average) & "ms"))
End Function
Public Function ToListItem() As MyListItem
Dim Item As New MyListItem With {
@@ -149,7 +149,7 @@
'进行搜索,构造列表
Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=5, MinBlurSimilarity:=0.08)
PanSearchList.Children.Clear()
If SearchResult.Count = 0 Then
If Not SearchResult.Any() Then
PanSearch.Title = "无搜索结果"
PanSearchList.Visibility = Visibility.Collapsed
Else
@@ -129,7 +129,7 @@
Exit Sub
End If
Next
If McFolderList.Count = 0 Then
If Not McFolderList.Any() Then
Throw New ArgumentNullException("没有可用的 Minecraft 文件夹")
Else
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
@@ -237,7 +237,7 @@
If Not Version.Modable Then Continue For
'4. 该版本的隔离文件夹下不存在 mods
Dim ModIndieFolder As New DirectoryInfo(Version.Path & "mods\")
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Count > 0 Then Exit Sub
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Exit Sub
'满足以上全部条件则视为根目录整合包
Setup.Set("VersionArgumentIndie", 2, Version:=Version)
Log("[Setup] 已自动关闭单版本隔离:" & Version.Name, LogLevel.Debug)
@@ -301,7 +301,7 @@
End If
Next
'保存
Setup.Set("LaunchFolders", If(Folders.Count = 0, "", Join(Folders.ToArray, "|")))
Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
Hint(If(Folder.Type = McFolderType.Custom, "文件夹 " & Name & " 已从列表中移除!", "文件夹名称已复原!"), HintType.Finish)
McFolderListLoader.Start(IsForceRestart:=True)
@@ -325,7 +325,7 @@
Exit For
End If
Next
Setup.Set("LaunchFolders", If(Folders.Count = 0, "", Join(Folders.ToArray, "|")))
Setup.Set("LaunchFolders", If(Not Folders.Any(), "", Join(Folders.ToArray, "|")))
End If
RunInNewThread(Sub()
'删除文件夹
@@ -115,7 +115,7 @@
<local:MyComboBoxItem Content="中(平衡)" IsSelected="True" />
<local:MyComboBoxItem Content="低(优先保证其他程序运行,但可能让游戏卡顿,适合挂机时使用)" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="10" HorizontalAlignment="Left" Text="游戏窗口" Margin="0,0,25,0" />
<TextBlock VerticalAlignment="Center" Grid.Row="10" HorizontalAlignment="Left" Text="窗口大小" Margin="0,0,25,0" />
<Grid x:Name="PanArgumentWindow" Grid.Row="10" Grid.ColumnSpan="2" Grid.Column="1">
<Grid.ColumnDefinitions>
<ColumnDefinition />
@@ -125,11 +125,10 @@
</Grid.ColumnDefinitions>
<local:MyComboBox x:Name="ComboArgumentWindowType" Tag="LaunchArgumentWindowType">
<local:MyComboBoxItem Content="全屏" />
<local:MyComboBoxItem Content="默认大小" IsSelected="True" ToolTip="以 854×480 的默认窗口大小启动 Minecraft" />
<local:MyComboBoxItem Content="与启动器窗口大小一致" />
<local:MyComboBoxItem Content="自定义大小" ToolTip="注意:Forge 1.12 存在 Bug,会导致高度设定无效" />
<local:MyComboBoxItem Content="默认" IsSelected="True" />
<local:MyComboBoxItem Content="与启动器尺寸一致" />
<local:MyComboBoxItem Content="自定义尺寸" ToolTip="Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" />
<local:MyComboBoxItem Content="最大化" />
<local:MyComboBoxItem Content="保持游戏默认" />
</local:MyComboBox>
<local:MyTextBox Padding="0,0,5,0" Visibility="Collapsed" Grid.Column="1" Margin="50,0,0,0" x:Name="TextArgumentWindowWidth" Tag="LaunchArgumentWindowWidth" Width="60" HorizontalContentAlignment="Center" Text="854">
<local:MyTextBox.ValidateRules>
@@ -138,7 +137,7 @@
</local:MyTextBox>
<TextBlock x:Name="LabArgumentWindowMiddle" Visibility="Collapsed" Grid.Column="2" Text=" × " VerticalAlignment="Center" FontSize="18" />
<local:MyTextBox Padding="0,0,5,0" Visibility="Collapsed" Grid.Column="3" Width="60" HorizontalContentAlignment="Center" x:Name="TextArgumentWindowHeight" Tag="LaunchArgumentWindowHeight" Text="480"
ToolTip="注意:Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5">
ToolTip="Forge 1.12.2 等个别版本存在 Bug,会导致高度设定无效" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5">
<local:MyTextBox.ValidateRules>
<local:ValidateInteger Min="1" Max="9999" />
</local:MyTextBox.ValidateRules>
@@ -175,11 +174,16 @@
<RowDefinition Height="Auto" />
<RowDefinition Height="9" />
<RowDefinition Height="Auto" />
<RowDefinition Height="9" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<local:MyRadioBox Text="自动配置" Width="110" Checked="True" x:Name="RadioRamType0" Tag="LaunchRamType/0" Margin="0,0,20,0"
ToolTip="根据安装的 Mod 量与电脑剩余内存,动态调整为游戏分配的内存" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="-10" ToolTipService.VerticalOffset="-3" />
<local:MyRadioBox Grid.Row="2" Text="自定义" x:Name="RadioRamType1" Tag="LaunchRamType/1" Margin="0,0,20,0" />
<local:MySlider Grid.Row="2" Grid.Column="1" IsEnabled="False" x:Name="SliderRamCustom" Tag="LaunchRamCustom" MaxValue="49" Value="13" />
<local:MyCheckBox Grid.Row="4" Grid.ColumnSpan="3" Text="启动游戏前进行内存优化" Height="22" x:Name="CheckArgumentRam" Tag="LaunchArgumentRam"
ToolTipService.Placement="Left" ToolTipService.HorizontalOffset="525" ToolTipService.VerticalOffset="-30"
ToolTip="内存优化能将当前物理内存占用降低约 1/3,不仅限于 MC!&#xa;如果使用机械硬盘,这还可能会导致一小段时间的严重卡顿。&#xa;使用 --memory 参数启动 PCL 可以静默执行内存优化。" />
<!--<local:MyTextBox Grid.Row="2" Grid.Column="3" Width="100" VerticalAlignment="Center" Margin="30,0,0,0" Text="2048 MB" />-->
</Grid>
<Grid x:Name="PanRamDisplay" Margin="0,11,2,0" SnapsToDevicePixels="True" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="1">
@@ -229,7 +233,7 @@
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数头" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" Text="-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true"
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" MaxLength="4000"
Height="57" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数尾" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如输入 --demo 则会以试玩模式启动游戏。" />
@@ -38,6 +38,7 @@
ComboArgumentWindowType.SelectedIndex = Setup.Get("LaunchArgumentWindowType")
TextArgumentWindowWidth.Text = Setup.Get("LaunchArgumentWindowWidth")
TextArgumentWindowHeight.Text = Setup.Get("LaunchArgumentWindowHeight")
CheckArgumentRam.Checked = Setup.Get("LaunchArgumentRam")
RefreshJavaComboBox()
'游戏内存
@@ -71,6 +72,7 @@
Setup.Reset("LaunchArgumentWindowWidth")
Setup.Reset("LaunchArgumentWindowHeight")
Setup.Reset("LaunchArgumentPriority")
Setup.Reset("LaunchArgumentRam")
Setup.Reset("LaunchRamType")
Setup.Reset("LaunchRamCustom")
Setup.Reset("LaunchSkinType")
@@ -108,7 +110,7 @@
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged, ComboArgumentVisibie.SelectionChanged, ComboArgumentWindowType.SelectionChanged, ComboArgumentPriority.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change, CheckAdvanceJava.Change, CheckAdvanceRunWait.Change
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change, CheckAdvanceJava.Change, CheckAdvanceRunWait.Change, CheckArgumentRam.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub
@@ -352,19 +354,19 @@
'可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0)
RamMininum = 0.4 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 100
RamTarget2 = 3 + ModCount / 60
RamTarget3 = 6 + ModCount / 30
RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90
RamTarget2 = 2.7 + ModCount / 50
RamTarget3 = 4.5 + ModCount / 25
ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then
'OptiFine 版本
RamMininum = 0.3
RamMininum = 0.5
RamTarget1 = 1.5
RamTarget2 = 3
RamTarget3 = 6
RamTarget3 = 5
Else
'普通版本
RamMininum = 0.3
RamMininum = 0.5
RamTarget1 = 1.5
RamTarget2 = 2.5
RamTarget3 = 4
@@ -372,27 +374,23 @@
Dim RamDelta As Double
'预分配内存,阶段一,0 ~ T1,100%
RamDelta = RamTarget1
RamAvailable = Math.Max(0, RamAvailable - 0.1)
RamGive += Math.Min(RamAvailable * 1, RamDelta)
RamAvailable -= RamDelta / 1 + 0.1
RamGive += Math.Min(RamAvailable, RamDelta)
RamAvailable -= RamDelta
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存,阶段二,T1 ~ T2,80%
'预分配内存,阶段二,T1 ~ T2,70%
RamDelta = RamTarget2 - RamTarget1
RamAvailable = Math.Max(0, RamAvailable - 0.1)
RamGive += Math.Min(RamAvailable * 0.8, RamDelta)
RamAvailable -= RamDelta / 0.8 + 0.1
RamGive += Math.Min(RamAvailable * 0.7, RamDelta)
RamAvailable -= RamDelta / 0.7
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存,阶段三,T2 ~ T3,60%
'预分配内存,阶段三,T2 ~ T3,40%
RamDelta = RamTarget3 - RamTarget2
RamAvailable = Math.Max(0, RamAvailable - 0.2)
RamGive += Math.Min(RamAvailable * 0.6, RamDelta)
RamAvailable -= RamDelta / 0.6 + 0.2
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存,阶段四,T3 ~ T3 * 2,40%
RamDelta = RamTarget3
RamAvailable = Math.Max(0, RamAvailable - 0.3)
RamGive += Math.Min(RamAvailable * 0.4, RamDelta)
RamAvailable -= RamDelta / 0.4 + 0.3
RamAvailable -= RamDelta / 0.4
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存,阶段四,T3 ~ T3 * 2,15%
RamDelta = RamTarget3
RamGive += Math.Min(RamAvailable * 0.15, RamDelta)
RamAvailable -= RamDelta / 0.15
If RamAvailable < 0.1 Then GoTo PreFin
PreFin:
'不低于最低值
@@ -444,7 +442,7 @@ PreFin:
Log(ex, "更新设置 Java 下拉框失败", LogLevel.Feedback)
End Try
'更新选择项
If SelectedItem Is Nothing AndAlso JavaList.Count > 0 Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择”
If SelectedItem Is Nothing AndAlso JavaList.Any Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择”
ComboArgumentJava.SelectedItem = SelectedItem
'结束处理
If SelectedItem Is Nothing Then
@@ -515,15 +513,16 @@ PreFin:
Hint("正在搜索 Java,请稍候!", HintType.Critical)
Exit Sub
End If
RunInThread(Sub()
Hint("正在搜索 Java!")
JavaSearchLoader.WaitForExit(IsForceRestart:=True)
If JavaList.Count = 0 Then
Hint("未找到可用的 Java!", HintType.Critical)
Else
Hint("已找到 " & JavaList.Count & " 个 Java,请检查下拉框查看列表!", HintType.Finish)
End If
End Sub)
RunInThread(
Sub()
Hint("正在搜索 Java!")
JavaSearchLoader.WaitForExit(IsForceRestart:=True)
If Not JavaList.Any() Then
Hint("未找到可用的 Java!", HintType.Critical)
Else
Hint("已找到 " & JavaList.Count & " 个 Java,请检查下拉框查看列表!", HintType.Finish)
End If
End Sub)
End Sub
#End Region
@@ -548,12 +547,24 @@ PreFin:
If AniControlEnabled <> 0 Then Exit Sub
If ComboArgumentVisibie.SelectedIndex = 0 Then
If MyMsgBox("若在游戏启动后立即关闭启动器,崩溃检测、更改游戏标题等功能将失效。" & vbCrLf &
"如果想保留这些功能,可以选择让启动器在游戏启动后隐藏,游戏退出后自动关闭。", "提示", "继续", "取消") = 2 Then
"如果想保留这些功能,可以选择让启动器在游戏启动后隐藏,游戏退出后自动关闭。", "提醒", "继续", "取消") = 2 Then
ComboArgumentVisibie.SelectedItem = e.RemovedItems(0)
End If
End If
End Sub
'开启自动内存优化的警告
Private Sub CheckArgumentRam_Change() Handles CheckArgumentRam.Change
If AniControlEnabled <> 0 Then Exit Sub
If Not CheckArgumentRam.Checked Then Return
If MyMsgBox("内存优化耗时较长,这会拖慢游戏的启动过程,建议仅在电脑内存不充裕时开启此选项。" & vbCrLf &
"如果你在使用机械硬盘,这还可能会导致一小段时间的严重卡顿。" &
If(IsAdmin(), "", $"{vbCrLf}{vbCrLf}每次启动游戏,PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限,可以右键 PCL,打开 属性 → 兼容性 → 以管理员身份运行此程序。"),
"提醒", "确定", "取消") = 2 Then
CheckArgumentRam.Checked = False
End If
End Sub
#End Region
#Region "高级设置"
@@ -126,23 +126,21 @@
'滑动条
Private Sub SliderLoad()
SliderDownloadThread.GetHintText = Function(Value As Integer)
Return Value + 1
End Function
SliderDownloadSpeed.GetHintText = Function(Value As Integer)
If Value <= 14 Then
Return (Value + 1) * 0.1 & " M/s"
ElseIf Value <= 31 Then
Return (Value - 11) * 0.5 & " M/s"
ElseIf Value <= 41 Then
Return (Value - 21) & " M/s"
Else
Return "无限制"
End If
End Function
SliderDebugAnim.GetHintText = Function(Value As Integer)
Return If(Value > 29, "关闭", (Value / 10 + 0.1) & "x")
End Function
SliderDownloadThread.GetHintText = Function(v) v + 1
SliderDownloadSpeed.GetHintText =
Function(v)
Select Case v
Case Is <= 14
Return (v + 1) * 0.1 & " M/s"
Case Is <= 31
Return (v - 11) * 0.5 & " M/s"
Case Is <= 41
Return (v - 21) & " M/s"
Case Else
Return "无限制"
End Select
End Function
SliderDebugAnim.GetHintText = Function(v) If(v > 29, "关闭", (v / 10 + 0.1) & "x")
End Sub
Private Sub SliderDownloadThread_PreviewChange(sender As Object, e As RouteEventArgs) Handles SliderDownloadThread.PreviewChange
If SliderDownloadThread.Value < 100 Then Exit Sub
@@ -36,7 +36,7 @@
Try
#Region "更新左边栏"
If LoaderTaskbar.Count = 0 Then
If Not LoaderTaskbar.Any() Then
'无任务
LabProgress.Text = "100 %"
LabSpeed.Text = "0 B/s"
@@ -214,13 +214,14 @@
End Sub
Public Sub TaskRemove(Loader As Object)
If RightCards.ContainsKey(Loader.Name) Then
RunInUiWait(Sub()
'移除已有的卡片
Dim Card As Grid = RightCards(Loader.Name)
FrmSpeedRight.PanMain.Children.Remove(Card)
RightCards.Remove(Loader.Name)
Log($"[Watcher] 移除下载管理卡片:{Loader.Name}")
End Sub)
RunInUiWait(
Sub()
'移除已有的卡片
Dim Card As Grid = RightCards(Loader.Name)
FrmSpeedRight.PanMain.Children.Remove(Card)
RightCards.Remove(Loader.Name)
Log($"[Watcher] 移除下载管理卡片:{Loader.Name}")
End Sub)
End If
End Sub
@@ -47,6 +47,8 @@
</local:MyCard.RenderTransform>
<TextBlock x:Name="LabSelect" Text="已选择 8 个文件" HorizontalAlignment="Center" VerticalAlignment="Top" Margin="9" Foreground="{DynamicResource ColorBrush2}" />
<StackPanel Orientation="Horizontal" Margin="5,28,5,5">
<local:MyIconTextButton x:Name="BtnSelectUpdate" Text="更新"
LogoScale="1" Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
<local:MyIconTextButton x:Name="BtnSelectEnable" Text="启用"
LogoScale="1.05" Logo="M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z" />
<local:MyIconTextButton x:Name="BtnSelectDisable" Text="禁用"
@@ -1,6 +1,4 @@
Imports System.Security.Principal
Public Class PageVersionMod
Public Class PageVersionMod
#Region "初始化"
@@ -27,7 +25,6 @@ Public Class PageVersionMod
''' 刷新 Mod 列表。
''' </summary>
Public Sub RefreshList(Optional ForceReload As Boolean = False)
If McModLoader.State = LoadState.Loading Then Exit Sub
If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then
Log("[System] 已刷新 Mod 列表")
PanBack.ScrollToHome()
@@ -82,7 +79,7 @@ Public Class PageVersionMod
AniControlEnabled += 1
Dim NewItem As New MyLocalModItem With {.SnapsToDevicePixels = True, .Entry = Entry,
.ButtonHandler = AddressOf McModContent, .Checked = SelectedMods.Contains(Entry.RawFileName)}
AddHandler Entry.OnGetCompProject, AddressOf NewItem.Refresh
AddHandler Entry.OnCompUpdate, AddressOf NewItem.Refresh
NewItem.Refresh()
AniControlEnabled -= 1
Return NewItem
@@ -104,17 +101,14 @@ Public Class PageVersionMod
ToolTipService.SetVerticalOffset(BtnCont, 30)
ToolTipService.SetHorizontalOffset(BtnCont, 2)
AddHandler BtnCont.Click, AddressOf Info_Click
AddHandler sender.MouseRightButtonDown, AddressOf Info_Click
AddHandler sender.MouseRightButtonUp, AddressOf Info_Click
Dim BtnDelete As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonDelete, .Tag = sender}
BtnDelete.ToolTip = "删除"
ToolTipService.SetPlacement(BtnDelete, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnDelete, 30)
ToolTipService.SetHorizontalOffset(BtnDelete, 2)
AddHandler BtnDelete.Click, AddressOf Delete_Click
Dim BtnED As New MyIconButton With {.LogoScale = 1, .Logo = If(sender.Entry.State = McMod.McModState.Fine,
"M508 990.4c-261.6 0-474.4-212-474.4-474.4S246.4 41.6 508 41.6s474.4 212 474.4 474.4S769.6 990.4 508 990.4zM508 136.8c-209.6 0-379.2 169.6-379.2 379.2 0 209.6 169.6 379.2 379.2 379.2s379.2-169.6 379.2-379.2C887.2 306.4 717.6 136.8 508 136.8zM697.6 563.2 318.4 563.2c-26.4 0-47.2-21.6-47.2-47.2 0-26.4 21.6-47.2 47.2-47.2l379.2 0c26.4 0 47.2 21.6 47.2 47.2C744.8 542.4 724 563.2 697.6 563.2z",
"M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z"),
.Tag = sender}
Dim BtnED As New MyIconButton With {.LogoScale = 1, .Logo = If(sender.Entry.State = McMod.McModState.Fine, Logo.IconButtonStop, Logo.IconButtonCheck), .Tag = sender}
BtnED.ToolTip = If(sender.Entry.State = McMod.McModState.Fine, "禁用", "启用")
ToolTipService.SetPlacement(BtnED, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnED, 30)
@@ -183,7 +177,7 @@ Public Class PageVersionMod
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try
Dim Result = McModCheck(PageVersionLeft.Version, McModLoader.Output)
If Result.Count > 0 Then
If Result.Any Then
MyMsgBox(Join(Result, vbCrLf & vbCrLf), "Mod 检查结果")
Else
Hint("Mod 检查完成,未发现任何问题!", HintType.Finish)
@@ -242,10 +236,12 @@ Public Class PageVersionMod
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
@@ -255,9 +251,9 @@ Public Class PageVersionMod
Next
BtnSelectDisable.IsEnabled = HasEnabled
BtnSelectEnable.IsEnabled = HasDisabled
BtnSelectUpdate.IsEnabled = HasUpdate
End If
'更新显示状态
CardSelect.IsHitTestVisible = Selected
If AniControlEnabled = 0 Then
If Selected Then
'仅在数量增加时播放出现/跳跃动画
@@ -374,7 +370,7 @@ Public Class PageVersionMod
End Try
'更改 Loader 中的列表
Dim NewModEntity As New McMod(NewPath)
NewModEntity.Comp = ModEntity.Comp
NewModEntity.FromJson(ModEntity.ToJson)
Dim IndexOfLoader As Integer = McModLoader.Output.IndexOf(ModEntity)
McModLoader.Output.RemoveAt(IndexOfLoader)
McModLoader.Output.Insert(IndexOfLoader, NewModEntity)
@@ -395,10 +391,128 @@ Public Class PageVersionMod
End If
End Sub
'更新
Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click
UpdateMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate))
End Sub
''' <summary>
''' 记录正在进行 Mod 更新的 mods 文件夹路径。
''' </summary>
Public Shared UpdatingVersions As New List(Of String)
Public Sub UpdateMods(ModList As IEnumerable(Of McMod))
'更新前警告
If Not Setup.Get("HintUpdateMod") Then
If MyMsgBox($"新版本 Mod 可能不兼容老版本的存档或者其他 Mod,这可能导致游戏崩溃,甚至存档损坏!{vbCrLf}除非整合包作者要求你更新,否则不要私自更新整合包里的 Mod!{vbCrLf}在更新 Mod 前,请先备份存档,并检查它的更新日志!{vbCrLf}更新时,老版本的 Mod 会被移动到回收站,以防万一。{vbCrLf}{vbCrLf}请在认真阅读上述警告后再继续!", "Mod 更新警告", "我已了解上述风险,继续更新", "取消", IsWarn:=True) = 1 Then
Setup.Set("HintUpdateMod", True)
Else
Exit Sub
End If
End If
Try
'构造下载信息
ModList = ModList.ToList() '防止刷新影响迭代器
Dim FileList As New List(Of NetFile)
Dim FileCopyList As New Dictionary(Of String, String)
For Each Entry As McMod In ModList
Dim File As CompFile = Entry.UpdateFile
If Not File.Available Then Continue For
'确认更新后的文件名
Dim CurrentReplaceName = Entry.CompFile.FileName.Replace(".jar", "").Replace(".old", "").Replace(".disabled", "")
Dim NewestReplaceName = Entry.UpdateFile.FileName.Replace(".jar", "").Replace(".old", "").Replace(".disabled", "")
Dim CurrentSegs = CurrentReplaceName.Split("-"c).ToList()
Dim NewestSegs = NewestReplaceName.Split("-"c).ToList()
Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For
CurrentSegs.Remove(Seg)
NewestSegs.Remove(Seg)
Shortened = True
Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentReplaceName = Join(CurrentSegs, "-")
NewestReplaceName = Join(NewestSegs, "-")
End If
'添加到下载列表
Dim TempAddress As String = PathTemp & "DownloadedMods\" & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName)
Dim RealAddress As String = GetPathFromFullPath(Entry.Path) & Entry.FileName.Replace(CurrentReplaceName, NewestReplaceName)
FileList.Add(File.ToNetFile(TempAddress))
FileCopyList(TempAddress) = RealAddress
Next
'构造加载器
Dim InstallLoaders As New List(Of LoaderBase)
Dim FinishedFileNames As New List(Of String)
InstallLoaders.Add(New LoaderDownload("下载新版 Mod 文件", FileList) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
InstallLoaders.Add(New LoaderTask(Of Integer, Integer)("替换旧版 Mod 文件",
Sub()
Try
For Each Entry As McMod In ModList
If File.Exists(Entry.Path) Then
My.Computer.FileSystem.DeleteFile(Entry.Path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
Else
Log($"[Mod] 未找到更新前的 Mod 文件,跳过对它的删除:{Entry.Path}", LogLevel.Debug)
End If
Next
For Each Entry As KeyValuePair(Of String, String) In FileCopyList
If File.Exists(Entry.Value) Then
My.Computer.FileSystem.DeleteFile(Entry.Value, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
Log($"[Mod] 更新后的 Mod 文件已存在,将会把它放入回收站:{Entry.Value}", LogLevel.Debug)
End If
If Directory.Exists(GetPathFromFullPath(Entry.Value)) Then
File.Move(Entry.Key, Entry.Value)
FinishedFileNames.Add(GetFileNameFromPath(Entry.Value))
Else
Log($"[Mod] 更新后的目标文件夹已被删除:{Entry.Value}", LogLevel.Debug)
End If
Next
Catch ex As OperationCanceledException
Log(ex, "替换旧版 Mod 文件时被主动取消")
End Try
End Sub))
'结束处理
Dim Loader As New LoaderCombo(Of IEnumerable(Of McMod))("Mod 更新:" & PageVersionLeft.Version.Name, InstallLoaders)
Dim PathMods As String = PageVersionLeft.Version.PathIndie & "mods\"
Loader.OnStateChanged =
Sub()
'结果提示
Select Case Loader.State
Case LoadState.Finished
Hint(If(FinishedFileNames.Count > 1, $"已成功更新 {FinishedFileNames.Count} 个 Mod!", $"已成功更新:{FinishedFileNames.Single}"), HintType.Finish)
Case LoadState.Failed
Hint("Mod 更新失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint("Mod 更新已中止!", HintType.Info)
Case Else
Exit Sub
End Select
UpdatingVersions.Remove(PathMods)
'清理缓存
RunInNewThread(
Sub()
Try
For Each TempFile In FileCopyList.Keys
If File.Exists(TempFile) Then File.Delete(TempFile)
Next
Catch ex As Exception
Log(ex, "清理 Mod 更新缓存失败")
End Try
End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal)
End Sub
'启动加载器
Log($"[Mod] 开始更新 {ModList.Count} 个 Mod")
UpdatingVersions.Add(PathMods)
Loader.Start()
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
RefreshList(True)
Catch ex As Exception
Log(ex, "初始化 Mod 更新失败")
End Try
End Sub
'删除
Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click
Dim DeleteList As List(Of McMod) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)).ToList()
DeleteMods(DeleteList)
DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)))
End Sub
Private Sub DeleteMods(ModList As IEnumerable(Of McMod))
Try
@@ -506,13 +620,13 @@ Public Class PageVersionMod
If ModEntry.ModId IsNot Nothing Then
DebugInfo.Add("Mod ID:" & ModEntry.ModId)
End If
If ModEntry.Dependencies.Count > 0 Then
If ModEntry.Dependencies.Any Then
DebugInfo.Add("依赖于:")
For Each Dep In ModEntry.Dependencies
DebugInfo.Add(" - " & Dep.Key & If(Dep.Value Is Nothing, "", ",版本:" & Dep.Value))
Next
End If
If DebugInfo.Count > 0 Then
If DebugInfo.Any Then
ContentLines.Add("")
ContentLines.AddRange(DebugInfo)
End If
@@ -191,7 +191,7 @@
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数头" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;若留空,则使用全局设置的值。" HintText="使用全局设置"
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="VersionAdvanceJvm" Grid.Column="1" MaxLength="4000" ToolTip="启动 Minecraft 时使用的额外 JVM 参数,在没有确定把握的情况下请不要尝试修改。&#xa;若留空,则使用全局设置的值。" HintText="使用全局设置"
Height="57" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数尾" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="VersionAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如输入 --demo 则会以试玩模式启动游戏。&#xa;若留空,则使用全局设置的值。" HintText="使用全局设置" />
@@ -33,7 +33,7 @@
If Indie = -1 Then
Dim ModFolder As New DirectoryInfo(PageVersionLeft.Version.Path & "mods\")
Dim SaveFolder As New DirectoryInfo(PageVersionLeft.Version.Path & "saves\")
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count > 0) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Count > 0) Then
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
'自动开启
Setup.Set("VersionArgumentIndie", 1, Version:=PageVersionLeft.Version)
Log("[Setup] 已自动开启单版本隔离:" & PageVersionLeft.Version.Name)
@@ -438,7 +438,7 @@ PreFin:
Log(ex, "更新版本设置 Java 下拉框失败", LogLevel.Feedback)
End Try
'更新选择项
If SelectedItem Is Nothing AndAlso JavaList.Count > 0 Then
If SelectedItem Is Nothing AndAlso JavaList.Any Then
If SelectedBySetup = "" Then
SelectedItem = ComboArgumentJava.Items(1) '选中 “自动选择”
Else
Binary file not shown.
+1 -1
View File
@@ -3648,7 +3648,7 @@ vpn-blocker|禁用VPN (VPN Blocker)
premium-wood@
tenshilib¨tenshilib-fabric
randomportals|随意传送门 (RandomPortals)
configured|配置界面* - Forge¨configured-fabric|配置界面 (Configured) - Fabric
configured|配置界面*¨configured-fabric|配置界面 (Configured) - Fabric
jellyfishing@|抓水母*
accurate-block-placement
+3 -3
View File
@@ -29,8 +29,8 @@
<!-- Windows Vista -->
<!--<supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" />-->
<!-- Windows 7 -->
<supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />
<!-- Windows 7 --><!--
<supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />-->
<!-- Windows 8 -->
<!--<supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" />-->
@@ -38,7 +38,7 @@
<!-- Windows 8.1 -->
<!--<supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}" />-->
<!-- Windows 10 -->
<!-- Windows 10+ -->
<supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" />
</application>
+16 -8
View File
@@ -1,21 +1,29 @@
## Plain Craft Launcher 2 源代码库
# Plain Craft Launcher 源代码库
[![Stars](https://img.shields.io/github/stars/Hex-Dragon/PCL2?style=flat&logo=data:image/svg%2bxml;base64,PHN2ZyB4bWxucz0iaHR0cDovL3d3dy53My5vcmcvMjAwMC9zdmciIHZlcnNpb249IjEiIHdpZHRoPSIxNiIgaGVpZ2h0PSIxNiI+PHBhdGggZD0iTTggLjI1YS43NS43NSAwIDAgMSAuNjczLjQxOGwxLjg4MiAzLjgxNSA0LjIxLjYxMmEuNzUuNzUgMCAwIDEgLjQxNiAxLjI3OWwtMy4wNDYgMi45Ny43MTkgNC4xOTJhLjc1MS43NTEgMCAwIDEtMS4wODguNzkxTDggMTIuMzQ3bC0zLjc2NiAxLjk4YS43NS43NSAwIDAgMS0xLjA4OC0uNzlsLjcyLTQuMTk0TC44MTggNi4zNzRhLjc1Ljc1IDAgMCAxIC40MTYtMS4yOGw0LjIxLS42MTFMNy4zMjcuNjY4QS43NS43NSAwIDAgMSA4IC4yNVoiIGZpbGw9IiNlYWM1NGYiLz48L3N2Zz4=&logoSize=auto&label=Stars&labelColor=666666&color=eac54f)](https://github.com/Hex-Dragon/PCL2/)
[![Issues](https://img.shields.io/github/issues/Hex-Dragon/PCL2?style=flat&label=Issues&labelColor=666666&color=1a7f37)](https://github.com/Hex-Dragon/PCL2/issues)
[![爱发电](https://img.shields.io/badge/赞助-%E7%88%B1%E5%8F%91%E7%94%B5-946ce6?style=flat&labelColor=666666&logoSize=auto)](https://afdian.net/@LTCat)
<br/>
## 介绍
这里提供了 PCL 的大多数源代码,包括 UI 库、动画模块、下载模块、Minecraft 启动模块等!
PCL 的代码绝大多数其实都是几年前学生时代的产物了……那时候英语还不过关……所以经常出现奇葩命名,还有令人高血压的高耦合啊,没做单例啊,瞎勾八乱糊啊之类的问题……额,我也不可能把这一堆玩意儿再从头写一次,各位就基于能跑就行的原则凑合凑合着看吧,求求别喷了(run
PCL 的代码绝大多数其实都是几年前学生时代的产物了……那时候英语还不过关……所以经常出现奇葩命名,还有令人高血压的高耦合啊,没做单例啊,瞎勾八乱糊啊之类的问题……额,我也不可能把这一堆玩意儿再从头写一次,各位就基于能跑就行的原则凑合凑合着看吧,求求别喷了……
你也可以丢 Pull Request,虽然这个源代码库并不能直接编译,但一些简单的修改应该还是没问题的……
 
<br/>
**相关内容:**
## 相关内容
- [PCL 功能投票](https://github.com/Hex-Dragon/PCL2/discussions/2):来参加投票吧,开发者会优先处理票数较高的帖子!
- [程序下载](https://afdian.net/p/0164034c016c11ebafcb52540025c377):下载免费的正式版 PCL。
- [帮助文档库](https://github.com/LTCatt/PCL2Help):PCL 帮助文档在 GitHub 上的存储库(是的,帮助库在另一个 Repo……)
 
<br/>
**一些无趣的小细节:**
- 别想在这里面找到解密游戏的线索,那部分的代码被我抠掉了(笑)
- 哦,对,解锁隐藏主题的相关代码也都被抠掉了,所以别想着用翻源代码这种歪门邪道来绕过解密了.jpg
## 一些无趣的小细节
- 别想在这里面找到解密游戏的线索,那部分的代码被我抠掉了
- 解锁隐藏主题的相关代码也被抠掉了,所以别想着用翻源代码这种歪门邪道来绕过解密了.jpg
- 源代码库并不是即时更新的,而是在每次 PCL 发布更新时(手动)同步一次
Binary file not shown.