Merge branch 'main' into #6703

This commit is contained in:
wyc-26
2026-04-03 22:16:10 +08:00
committed by GitHub
177 changed files with 12499 additions and 32299 deletions
+1 -1
View File
@@ -1,3 +1,3 @@
# These are supported funding model platforms # These are supported funding model platforms
custom: ['https://afdian.com/a/LTCat'] custom: ['https://meloong.com/afd/a/LTCat']
+1 -1
View File
@@ -12,7 +12,7 @@ body:
required: false required: false
- label: "**我已尝试使用 HMCL 启动,HMCL 没有出现问题。** 如果 HMCL 也无法启动就不是 PCL 导致的问题,请 **不要** 提交反馈。[下载 HMCL](https://hmcl.huangyuhui.net/download)" - label: "**我已尝试使用 HMCL 启动,HMCL 没有出现问题。** 如果 HMCL 也无法启动就不是 PCL 导致的问题,请 **不要** 提交反馈。[下载 HMCL](https://hmcl.huangyuhui.net/download)"
required: true required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。" - label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true required: true
- type: textarea - type: textarea
id: "yml-2" id: "yml-2"
+1 -1
View File
@@ -12,7 +12,7 @@ body:
required: false required: false
- label: "我知晓大多数此类问题都是网络环境不佳导致的,但我确实认为我的问题可能是 PCL 导致的,和网络环境无关。" - label: "我知晓大多数此类问题都是网络环境不佳导致的,但我确实认为我的问题可能是 PCL 导致的,和网络环境无关。"
required: true required: true
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。" - label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true required: true
- type: textarea - type: textarea
id: "yml-2" id: "yml-2"
+1 -1
View File
@@ -8,7 +8,7 @@ body:
label: "检查项" label: "检查项"
description: "请逐个检查下列项目,并勾选确认。" description: "请逐个检查下列项目,并勾选确认。"
options: options:
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。" - label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一 Bug 未被提交过。"
required: true required: true
- type: textarea - type: textarea
id: "yml-2" id: "yml-2"
+2 -2
View File
@@ -8,9 +8,9 @@ body:
label: "检查项" label: "检查项"
description: "请逐个检查下列项目,并勾选确认。" description: "请逐个检查下列项目,并勾选确认。"
options: options:
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一建议未被提交过。" - label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一建议未被提交过。"
required: true required: true
- label: "我已查看 [功能投票页面](https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一建议未在投票列表中。" - label: "我已查看 [功能投票页面](https://github.com/Meloong-Git/PCL/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一建议未在投票列表中。"
required: true required: true
- type: textarea - type: textarea
id: "yml-2" id: "yml-2"
+3 -3
View File
@@ -1,14 +1,14 @@
blank_issues_enabled: false blank_issues_enabled: false
contact_links: contact_links:
- name: 主页预设反馈 - name: 主页预设反馈
url: https://github.com/Hex-Dragon/PCL2/discussions/categories/自定义主页 url: https://github.com/Meloong-Git/PCL/discussions/categories/自定义主页
about: 提交与预设的主页(设置 → 个性化 → 主页预设)中的具体内容相关的反馈 about: 提交与预设的主页(设置 → 个性化 → 主页预设)中的具体内容相关的反馈
- name: 帮助文档反馈 - name: 帮助文档反馈
url: https://github.com/LTCatt/PCL2Help/issues url: https://github.com/LTCatt/PCL2Help/issues
about: 提交与 PCL 帮助文档(更多 → 帮助)中的具体内容相关的反馈 about: 提交与 PCL 帮助文档(更多 → 帮助)中的具体内容相关的反馈
- name: 提问 - name: 提问
url: https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E6%8F%90%E9%97%AE url: https://github.com/Meloong-Git/PCL/discussions/new?category=%E6%8F%90%E9%97%AE
about: 我想问一些 PCL 相关的问题…… about: 我想问一些 PCL 相关的问题……
- name: 讨论 - name: 讨论
url: https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E8%AE%A8%E8%AE%BA url: https://github.com/Meloong-Git/PCL/discussions/new?category=%E8%AE%A8%E8%AE%BA
about: 我想讨论一些 PCL 相关的事情…… about: 我想讨论一些 PCL 相关的事情……
+2 -2
View File
@@ -8,9 +8,9 @@ body:
label: "检查项" label: "检查项"
description: "请逐个检查下列项目,并勾选确认。" description: "请逐个检查下列项目,并勾选确认。"
options: options:
- label: "我已在 [Issues 页面](https://github.com/Hex-Dragon/PCL2/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Hex-Dragon/PCL2/discussions/1930) 中搜索,确认了这一提案未被提交过。" - label: "我已在 [Issues 页面](https://github.com/Meloong-Git/PCL/issues?q=is%3Aissue+) 和 [常见&难检反馈及问题列表](https://github.com/Meloong-Git/PCL/discussions/1930) 中搜索,确认了这一提案未被提交过。"
required: true required: true
- label: "我已查看 [功能投票页面](https://github.com/Hex-Dragon/PCL2/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一提案未在投票列表中。" - label: "我已查看 [功能投票页面](https://github.com/Meloong-Git/PCL/discussions/categories/%E5%8A%9F%E8%83%BD%E6%8A%95%E7%A5%A8/),确认了这一提案未在投票列表中。"
required: true required: true
- label: "我知晓还没做的新功能真的太多了,忙不过来,所以新功能提案几乎不会被处理,也不建议再提交新功能提案 qwq……" - label: "我知晓还没做的新功能真的太多了,忙不过来,所以新功能提案几乎不会被处理,也不建议再提交新功能提案 qwq……"
required: true required: true
+2 -2
View File
@@ -51,8 +51,8 @@ jobs:
- name: Replace - name: Replace
run: | run: |
(gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const OAuthClientId As String = ""', 'Public Const OAuthClientId As String = "${{ secrets.CLIENT_ID }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb" (gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "")', 'Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "${{ secrets.CLIENT_ID }}")' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb"
(gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public Const CurseForgeAPIKey As String = ""', 'Public Const CurseForgeAPIKey As String = "${{ secrets.CURSEFORGE_API_KEY }}"' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb" (gc "Plain Craft Launcher 2\Modules\ModSecret.vb") -replace 'Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "")', 'Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "${{ secrets.CURSEFORGE_API_KEY }}")' | Out-File "Plain Craft Launcher 2\Modules\ModSecret.vb"
(gc "Plain Craft Launcher 2\Modules\Base\ModBase.vb") -replace 'Public Const CommitHash As String = ""', 'Public Const CommitHash As String = "${{ github.sha }}"' | Out-File "Plain Craft Launcher 2\Modules\Base\ModBase.vb" (gc "Plain Craft Launcher 2\Modules\Base\ModBase.vb") -replace 'Public Const CommitHash As String = ""', 'Public Const CommitHash As String = "${{ github.sha }}"' | Out-File "Plain Craft Launcher 2\Modules\Base\ModBase.vb"
- name: Build - name: Build
+3 -3
View File
@@ -31,8 +31,8 @@
2、您的内容的名称必须以 Plain Craft Launcher (PCL) 开头,并在其后添加足以表现其由第三方修改的后缀。 2、您的内容的名称必须以 Plain Craft Launcher (PCL) 开头,并在其后添加足以表现其由第三方修改的后缀。
 允许的示例:PCL 某服务器魔改版、PCL PR Collection、PCL (XX Bug Fix)、PCL XXX修改版。  允许的示例:PCL 某服务器魔改版、PCL PR Collection、PCL (XX Bug Fix)、PCL XXX修改版。
 禁止的示例:PCL 某服务器特供版(暗示由官方提供)、PCL 3、PCL 手机版、PCL++、PCL Pro(这像是官方的后续作品)。  禁止的示例:PCL 某服务器特供版(暗示由官方提供)、PCL 3、PCL 手机版、PCL++、PCL Pro(这像是官方的后续作品)。
3、在关于页面的首位给出龙腾猫跃的署名及对应的赞助链接,公开源代码,且继续使用本文件作为指南(可参考 CC BY-SC 协议)。 3、在关于页面的首位给出龙腾猫跃的署名及对应的赞助链接,公开源代码,且继续使用本文件作为指南(可参考 CC BY-SA 协议)。
4、软件若有 Minecraft 启动功能,则应实现与 McLaunchPrecheck 函数一致的 Minecraft 正版购买弹窗与赞助弹窗。 4、软件若有 Minecraft 启动功能,则应实现与 McLaunchPrecheck 函数一致(或更激进)的 Minecraft 正版购买劝导与赞助劝导。
5、软件在 Windows 系统上运行时,不应有与 PCL 的赞助解锁功能类似的功能或表现。 5、软件在 Windows 系统上运行时,不应有与 PCL 的赞助解锁功能类似的功能或表现。
 例如:界面的主要色相必须为蓝色(即使没有修改功能,改为其他色相也和需要赞助解锁的主题功能类似)。  例如:界面的主要色相必须为蓝色(即使没有修改功能,改为其他色相也和需要赞助解锁的主题功能类似)。
@@ -44,6 +44,6 @@
这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧! 这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
如果你只是参考了一小段代码,署个名就行啦,不用担心。 如果你只是参考了一小段代码,署个名就行啦,不用担心。
如果对具体细节有疑问,欢迎在 https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E6%8F%90%E9%97%AE 发帖询问! 如果对具体细节有疑问,欢迎在 https://github.com/Meloong-Git/PCL/discussions/new?category=%E6%8F%90%E9%97%AE 发帖询问!
多谢大家啦! 多谢大家啦!
+4
View File
@@ -30,6 +30,10 @@
<assemblyIdentity name="System.ValueTuple" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/> <assemblyIdentity name="System.ValueTuple" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/> <bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</dependentAssembly> </dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="Newtonsoft.Json" publicKeyToken="30ad4fe6b2a6aeed" culture="neutral"/>
<bindingRedirect oldVersion="0.0.0.0-6.0.0.0" newVersion="13.0.0.0"/>
</dependentAssembly>
</assemblyBinding> </assemblyBinding>
</runtime> </runtime>
</configuration> </configuration>
+4 -1
View File
@@ -1,6 +1,7 @@
<Application x:Class="Application" <Application x:Class="Application"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:behaviors="clr-namespace:PCL.Controls.Behaviors"
xmlns:local="clr-namespace:PCL" xmlns:local="clr-namespace:PCL"
xmlns:sys="clr-namespace:System;assembly=mscorlib" xmlns:sys="clr-namespace:System;assembly=mscorlib"
StartupUri="FormMain.xaml" StartupUri="FormMain.xaml"
@@ -302,6 +303,7 @@
</ControlTemplate> </ControlTemplate>
</Setter.Value> </Setter.Value>
</Setter> </Setter>
<Setter Property="behaviors:ClipboardInterceptor.EnableSafeClipboard" Value="True" />
</Style> </Style>
<Style TargetType="PasswordBox"> <Style TargetType="PasswordBox">
<Setter Property="FontSize" Value="13" /> <Setter Property="FontSize" Value="13" />
@@ -343,6 +345,7 @@
</ControlTemplate> </ControlTemplate>
</Setter.Value> </Setter.Value>
</Setter> </Setter>
<Setter Property="behaviors:ClipboardInterceptor.EnableSafeClipboard" Value="True" />
</Style> </Style>
<!-- ComboBox --> <!-- ComboBox -->
@@ -362,7 +365,7 @@
<Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" /> <Setter Property="Background" Value="{StaticResource ColorBrushHalfWhite}" />
<Setter Property="FocusVisualStyle" Value="{x:Null}" /> <Setter Property="FocusVisualStyle" Value="{x:Null}" />
<Setter Property="FontSize" Value="13" /> <Setter Property="FontSize" Value="13" />
<Setter Property="MaxDropDownHeight" Value="160" /> <Setter Property="MaxDropDownHeight" Value="320" />
<Setter Property="Template"> <Setter Property="Template">
<Setter.Value> <Setter.Value>
<ControlTemplate TargetType="ComboBox"> <ControlTemplate TargetType="ComboBox">
+66 -87
View File
@@ -19,6 +19,9 @@ Public Class Application
'开始 '开始
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
Try Try
'动态 DLL 调用(必须尽量在前面,否则模块加载 CacheCow 等 DLL 就可能导致崩溃)
AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
'开始
SecretOnApplicationStart() SecretOnApplicationStart()
'检查参数调用 '检查参数调用
If e.Args.Length > 0 Then If e.Args.Length > 0 Then
@@ -48,15 +51,6 @@ Public Class Application
Else Else
Environment.Exit((My.Computer.Info.AvailablePhysicalMemory - Ram) / 1024) '返回清理的内存量(K) Environment.Exit((My.Computer.Info.AvailablePhysicalMemory - Ram) / 1024) '返回清理的内存量(K)
End If End If
#If DEBUG Then
'制作更新包
ElseIf e.Args(0) = "--edit1" Then
ExeEdit(e.Args(1), True)
Environment.Exit(ProcessReturnValues.TaskDone)
ElseIf e.Args(0) = "--edit2" Then
ExeEdit(e.Args(1), False)
Environment.Exit(ProcessReturnValues.TaskDone)
#End If
End If End If
End If End If
'初始化文件结构 '初始化文件结构
@@ -67,15 +61,14 @@ Public Class Application
If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限") If Not CheckPermission(PathTemp) Then Throw New Exception("PCL 没有对 " & PathTemp & " 的访问权限")
Catch ex As Exception Catch ex As Exception
If PathTemp = IO.Path.GetTempPath() & "PCL\" Then If PathTemp = IO.Path.GetTempPath() & "PCL\" Then
MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用") MyMsgBox("PCL 无法访问缓存文件夹,可能导致程序出错或无法正常使用!" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
Else Else
MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & "错误原因:" & GetExceptionDetail(ex), "缓存文件夹不可用") MyMsgBox("手动设置的缓存文件夹不可用,PCL 将使用默认缓存文件夹。" & vbCrLf & vbCrLf & "错误原因:" & ex.GetDetail(), "缓存文件夹不可用")
Setup.Set("SystemSystemCache", "") Settings.Set("SystemSystemCache", "")
PathTemp = IO.Path.GetTempPath() & "PCL\" PathTemp = IO.Path.GetTempPath() & "PCL\"
End If End If
End Try End Try
Directory.CreateDirectory(PathTemp & "Cache") Directory.CreateDirectory(PathTemp & "Cache")
Directory.CreateDirectory(PathTemp & "Download")
Directory.CreateDirectory(PathAppdata) Directory.CreateDirectory(PathAppdata)
'检测单例 '检测单例
#If Not DEBUG Then #If Not DEBUG Then
@@ -104,45 +97,41 @@ WaitRetry:
ToolTipService.PlacementProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(Primitives.PlacementMode.Bottom)) ToolTipService.PlacementProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(Primitives.PlacementMode.Bottom))
ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0)) ToolTipService.HorizontalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(8.0))
ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0)) ToolTipService.VerticalOffsetProperty.OverrideMetadata(GetType(DependencyObject), New FrameworkPropertyMetadata(4.0))
'设置网络配置默认值
ServicePointManager.Expect100Continue = False
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
ServicePointManager.DefaultConnectionLimit = 10000
ServicePointManager.UseNagleAlgorithm = False
ServicePointManager.EnableDnsRoundRobin = True
ServicePointManager.ReusePort = True
'设置初始窗口 '设置初始窗口
If Setup.Get("UiLauncherLogo") Then If Settings.Get("UiLauncherLogo") Then
FrmStart = New SplashScreen("Images\icon.ico") FrmStart = New SplashScreen("Images\icon.ico")
FrmStart.Show(False, True) FrmStart.Show(False, True)
End If End If
'动态 DLL 调用
AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
'日志初始化 '日志初始化
LogStart() LogStart()
'添加日志 '添加日志
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})") Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
#If RELEASE Then #If RELEASE Then
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",正式版", "")}") Log($"[Start] 识别码:{Identify}{If(ThemeCheckOne(9), ",正式版", "")}")
#Else #Else
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}") Log($"[Start] 识别码:{Identify}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
#End If #End If
Log($"[Start] 程序路径:{PathWithName}") Log($"[Start] 程序路径:{PathWithName}")
Log($"[Start] 系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})") Log($"[Start] 系统编码:{Encoding.Default.HeaderName} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
Log($"[Start] 管理员权限:{IsAdmin()}") Log($"[Start] 管理员权限:{IsAdmin()}")
'检测异常环境 '检测异常环境
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("请将 PCL 从压缩包中解压之后再使用!" & vbCrLf & "在当前环境下运行可能会导致丢失游戏存档或设置,部分功能也可能无法使用!", "环境警告", "我知道了", IsWarn:=True) MyMsgBox("请将 PCL 从压缩包中解压后再使用!" & vbCrLf & "如果不会解压,可以在网上寻找教程。", "需要解压!", "我知道了", IsWarn:=True, ForceWait:=True)
FormMain.EndProgramForce(ProcessReturnValues.Cancel)
End If End If
If Is32BitSystem Then If Is32BitSystem Then
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True) MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True)
End If End If
'设置初始化
Setup.Load("SystemDebugMode")
Setup.Load("SystemDebugAnim")
Setup.Load("ToolDownloadThread")
Setup.Load("ToolDownloadCert")
Setup.Load("ToolDownloadSpeed")
'网络配置初始化
ServicePointManager.Expect100Continue = True
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
ServicePointManager.DefaultConnectionLimit = 1024
'计时 '计时
Log("[Start] 第一阶段加载用时:" & GetTimeTick() - ApplicationStartTick & " ms") Log("[Start] 第一阶段加载用时:" & GetTimeMs() - ApplicationStartTick & " ms")
ApplicationStartTick = GetTimeTick() ApplicationStartTick = GetTimeMs()
'执行测试 '执行测试
#If DEBUG Then #If DEBUG Then
Test() Test()
@@ -154,23 +143,33 @@ WaitRetry:
FilePath = PathWithName FilePath = PathWithName
Catch Catch
End Try End Try
MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误") MsgBox(ex.GetDetail(True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
FormMain.EndProgramForce(ProcessReturnValues.Exception) FormMain.EndProgramForce(ProcessReturnValues.Exception)
End Try End Try
End Sub End Sub
'结束 '结束
Private Sub Application_SessionEnding(sender As Object, e As SessionEndingCancelEventArgs) Handles Me.SessionEnding Private Sub Application_SessionEnding(sender As Object, e As SessionEndingCancelEventArgs) Handles Me.SessionEnding
FrmMain.EndProgram(False) FrmMain?.EndProgram(False)
End Sub End Sub
'异常 '异常
Private Sub Application_DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs) Handles Me.DispatcherUnhandledException Private Sub Application_DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs) Handles Me.DispatcherUnhandledException
On Error Resume Next On Error Resume Next
'触发页面的 Dispatcher
If FrmMain?.PageLeft IsNot Nothing AndAlso TypeOf FrmMain.PageLeft Is IDispatcherUnhandledException Then
CType(FrmMain.PageLeft, IDispatcherUnhandledException).DispatcherUnhandledException(sender, e)
If e.Handled Then Return
End If
If FrmMain?.PageRight IsNot Nothing AndAlso TypeOf FrmMain.PageRight Is IDispatcherUnhandledException Then
CType(FrmMain.PageRight, IDispatcherUnhandledException).DispatcherUnhandledException(sender, e)
If e.Handled Then Return
End If
'正常处理
e.Handled = True e.Handled = True
If IsProgramEnded Then Return If IsProgramEnded Then Return
FeedbackInfo() FeedbackInfo()
Dim Detail As String = GetExceptionDetail(e.Exception, True) Dim Detail As String = e.Exception.GetDetail(True)
If Detail.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse Detail.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse Detail.Contains("未能加载文件或程序集") OrElse If Detail.Contains("System.Windows.Threading.Dispatcher.Invoke") OrElse Detail.Contains("MS.Internal.AppModel.ITaskbarList.HrInit") OrElse Detail.Contains("未能加载文件或程序集") OrElse
Detail.Contains(".NET Framework") Then ' “自动错误判断” 的结果分析 Detail.Contains(".NET Framework") Then ' “自动错误判断” 的结果分析
OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer") OpenWebsite("https://dotnet.microsoft.com/zh-cn/download/dotnet-framework/thank-you/net462-offline-installer")
@@ -181,89 +180,69 @@ WaitRetry:
End Sub End Sub
'动态 DLL 调用 '动态 DLL 调用
Private Shared AssemblyNAudio As Assembly
Private Shared AssemblyJson As Assembly
Private Shared AssemblyDialog As Assembly
Private Shared AssemblyImazenWebp As Assembly
Private Shared ReadOnly AssemblyNAudioLock As New Object
Private Shared ReadOnly AssemblyJsonLock As New Object
Private Shared ReadOnly AssemblyDialogLock As New Object
Private Shared ReadOnly AssemblyImazenWebpLock As New Object
Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean Private Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
Public Shared Function AssemblyResolve(sender As Object, args As ResolveEventArgs) As Assembly Public Shared Function AssemblyResolve(sender As Object, Args As ResolveEventArgs) As Assembly
If args.Name.StartsWithF("NAudio") Then '缓存
SyncLock AssemblyNAudioLock Static Prefixes As String() = {"NAudio", "Newtonsoft.Json", "Ookii.Dialogs.Wpf", "Imazen.WebP", "CacheCow.Common", "CacheCow.Client.FileStore", "CacheCow.Client", "System.Net.Http.Formatting", "System.ValueTuple"}
If AssemblyNAudio Is Nothing Then Static Locks As New Dictionary(Of String, Object)(StringComparer.Ordinal)
Log("[Start] 加载 DLL:NAudio") Static LoadedAssembly As New Dictionary(Of String, Assembly)(StringComparer.Ordinal)
AssemblyNAudio = Assembly.Load(GetResources("NAudio")) '查找对应的 DLL
End If Dim Prefix As String = Prefixes.FirstOrDefault(Function(p) Args.Name.StartsWithF(p))
Return AssemblyNAudio If Prefix Is Nothing Then Return Nothing
End SyncLock '加载 DLL
ElseIf args.Name.StartsWithF("Newtonsoft.Json") Then If Not Locks.ContainsKey(Prefix) Then Locks(Prefix) = New Object()
SyncLock AssemblyJsonLock SyncLock Locks(Prefix)
If AssemblyJson Is Nothing Then If Not LoadedAssembly.ContainsKey(Prefix) Then
Log("[Start] 加载 DLL:Json") Log($"[Start] 加载 DLL:{Prefix}")
AssemblyJson = Assembly.Load(GetResources("Json")) LoadedAssembly(Prefix) = Assembly.Load(GetResources(Prefix))
End If 'WebP 特判
Return AssemblyJson If Prefix = "Imazen.WebP" Then
End SyncLock SetDllDirectory(PathPure.TrimEnd("\"c))
ElseIf args.Name.StartsWithF("Ookii.Dialogs.Wpf") Then Try
SyncLock AssemblyDialogLock
If AssemblyDialog Is Nothing Then
Log("[Start] 加载 DLL:Dialogs")
AssemblyDialog = Assembly.Load(GetResources("Dialogs"))
End If
Return AssemblyDialog
End SyncLock
ElseIf args.Name.StartsWithF("Imazen.WebP") Then
SyncLock AssemblyImazenWebpLock
If AssemblyImazenWebp Is Nothing Then
Log("[Start] 加载 DLL:Imazen.WebP")
AssemblyImazenWebp = Assembly.Load(GetResources("Imazen_WebP"))
SetDllDirectory(PathPure.TrimEnd("\"))
WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64")) WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64"))
Catch ex As Exception
Log(ex, "写入 libwebp.dll 失败") '防止同时加载多个图片时,同时写入文件导致文件占用,进而导致崩溃
End Try
End If End If
Return AssemblyImazenWebp End If
Return LoadedAssembly(Prefix)
End SyncLock End SyncLock
Else
Return Nothing
End If
End Function End Function
'切换窗口 '切换窗口
'控件模板事件 '控件模板事件
Private Sub MyIconButton_Click(sender As Object, e As EventArgs) Private Sub MyIconButton_Click(sender As Object, e As EventArgs)
Select Case Setup.Get("LoginType") Select Case Settings.Get("LoginType")
Case McLoginType.Ms Case McLoginType.Ms
'微软 '微软
Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson")) Dim MsJson As JObject = GetJson(Settings.Get("LoginMsJson"))
MsJson.Remove(sender.Tag) MsJson.Remove(sender.Tag)
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None)) Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0 If FrmLoginMs.ComboAccounts.SelectedItem Is sender.Parent Then FrmLoginMs.ComboAccounts.SelectedIndex = 0
FrmLoginMs.ComboAccounts.Items.Remove(sender.Parent) FrmLoginMs.ComboAccounts.Items.Remove(sender.Parent)
Case McLoginType.Legacy Case McLoginType.Legacy
'离线 '离线
Dim Names As New List(Of String) Dim Names As New List(Of String)
Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨")) Names.AddRange(Settings.Get("LoginLegacyName").ToString.Split("¨"))
Names.Remove(sender.Tag) Names.Remove(sender.Tag)
Setup.Set("LoginLegacyName", Join(Names, "¨")) Settings.Set("LoginLegacyName", Names.Join("¨"c))
FrmLoginLegacy.ComboName.ItemsSource = Names FrmLoginLegacy.ComboName.ItemsSource = Names
FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "") FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
Case Else Case Else
'第三方 '第三方
Dim Token As String = GetStringFromEnum(Setup.Get("LoginType")) Dim Token As String = GetStringFromEnum(Settings.Get("LoginType"))
Dim Dict As New Dictionary(Of String, String) Dim Dict As New Dictionary(Of String, String)
Dim Names As New List(Of String) Dim Names As New List(Of String)
Dim Passs As New List(Of String) Dim Passs As New List(Of String)
If Not Setup.Get("Login" & Token & "Email") = "" Then Names.AddRange(Setup.Get("Login" & Token & "Email").ToString.Split("¨")) If Not Settings.Get("Login" & Token & "Email") = "" Then Names.AddRange(Settings.Get("Login" & Token & "Email").ToString.Split("¨"))
If Not Setup.Get("Login" & Token & "Pass") = "" Then Passs.AddRange(Setup.Get("Login" & Token & "Pass").ToString.Split("¨")) If Not Settings.Get("Login" & Token & "Pass") = "" Then Passs.AddRange(Settings.Get("Login" & Token & "Pass").ToString.Split("¨"))
For i = 0 To Names.Count - 1 For i = 0 To Names.Count - 1
Dict.Add(Names(i), Passs(i)) Dict.Add(Names(i), Passs(i))
Next Next
Dict.Remove(sender.Tag) Dict.Remove(sender.Tag)
Setup.Set("Login" & Token & "Email", Join(Dict.Keys, "¨")) Settings.Set("Login" & Token & "Email", Dict.Keys.Join("¨"c))
Setup.Set("Login" & Token & "Pass", Join(Dict.Values, "¨")) Settings.Set("Login" & Token & "Pass", Dict.Values.Join("¨"c))
Select Case Token Select Case Token
Case "Nide" Case "Nide"
FrmLoginNide.ComboName.ItemsSource = Dict.Keys FrmLoginNide.ComboName.ItemsSource = Dict.Keys
@@ -0,0 +1,192 @@
' Author: uye (owner of the MaaAssistantArknights team)
' Original Source: MaaAssistantArknights project - https://github.com/MaaAssistantArknights/MaaAssistantArknights
' License: Apache License 2.0 (this file only)
'
' This file is originally developed for MaaAssistantArknights and licensed under AGPL v3.0.
' As the original author and copyright holder,
' I hereby re-license this file under the Apache License 2.0 for use in the Plain Craft Launcher project.
'
' This file is contributed under the spirit of good faith and open cooperation.
' It does not implement any core launcher functions of PCL.
'
' Description:
' Provides a WPF clipboard handling fix to avoid OpenClipboard exceptions
' in TextBox, RichTextBox, and DataGrid under Windows focus issues or clipboard hooks.
'
' Date: 2025-07-03
Imports System.Windows
Imports System.Windows.Controls
Imports System.Windows.Input
Imports System.Windows.Documents
Imports System.Linq
Namespace Controls.Behaviors
Public NotInheritable Class ClipboardInterceptor
Private Sub New()
End Sub
Public Shared ReadOnly EnableSafeClipboardProperty As DependencyProperty =
DependencyProperty.RegisterAttached("EnableSafeClipboard", GetType(Boolean), GetType(ClipboardInterceptor),
New PropertyMetadata(False, AddressOf OnEnableSafeClipboardChanged))
Public Shared Sub SetEnableSafeClipboard(element As DependencyObject, value As Boolean)
element.SetValue(EnableSafeClipboardProperty, value)
End Sub
Public Shared Function GetEnableSafeClipboard(element As DependencyObject) As Boolean
Return element.GetValue(EnableSafeClipboardProperty)
End Function
Private Shared Sub OnEnableSafeClipboardChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
If TypeOf d Is TextBox AndAlso CBool(e.NewValue) Then
AddCommandBindingsToTextBox(DirectCast(d, TextBox))
ElseIf TypeOf d Is RichTextBox AndAlso CBool(e.NewValue) Then
AddCommandBindingsToRichTextBox(DirectCast(d, RichTextBox))
ElseIf TypeOf d Is DataGrid AndAlso CBool(e.NewValue) Then
AddCommandBindingsToDataGrid(DirectCast(d, DataGrid))
End If
End Sub
Private Shared Sub AddCommandBindingsToTextBox(tb As TextBox)
tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyTextBox))
tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Cut, AddressOf OnCutTextBox))
tb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Paste, AddressOf OnPasteTextBox))
End Sub
Private Shared Sub AddCommandBindingsToRichTextBox(rtb As RichTextBox)
rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyRichTextBox))
rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Cut, AddressOf OnCutRichTextBox))
rtb.CommandBindings.Add(New CommandBinding(ApplicationCommands.Paste, AddressOf OnPasteRichTextBox))
End Sub
Private Shared Sub AddCommandBindingsToDataGrid(dg As DataGrid)
dg.CommandBindings.Add(New CommandBinding(ApplicationCommands.Copy, AddressOf OnCopyDataGrid))
End Sub
Private Shared Sub OnCopyTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim tb = TryCast(sender, TextBox)
If tb Is Nothing OrElse tb.SelectionLength <= 0 Then Return
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(tb.SelectedText, True)
Catch
End Try
e.Handled = True
End Sub
Private Shared Sub OnCutTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim tb = TryCast(sender, TextBox)
If tb Is Nothing OrElse tb.SelectionLength <= 0 Then Return
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(tb.SelectedText, True)
Catch
End Try
tb.SelectedText = String.Empty
e.Handled = True
End Sub
Private Shared Sub OnPasteTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim tb = TryCast(sender, TextBox)
If tb Is Nothing Then Return
If Forms.Clipboard.ContainsText() Then
Dim pasteText = Forms.Clipboard.GetText()
'将换行符替换为空格(#7825)
If Not tb.AcceptsReturn Then pasteText = pasteText.Replace(vbCrLf, " ").Replace(vbCr, " ").Replace(vbLf, " ")
Dim start = tb.SelectionStart
tb.SelectedText = pasteText
tb.CaretIndex = start + pasteText.Length
tb.SelectionLength = 0
End If
e.Handled = True
End Sub
Private Shared Sub OnCopyRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim rtb = TryCast(sender, RichTextBox)
If rtb Is Nothing Then Return
Dim textRange = New TextRange(rtb.Selection.Start, rtb.Selection.End)
If String.IsNullOrEmpty(textRange.Text) Then Return
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(textRange.Text, True)
Catch
End Try
e.Handled = True
End Sub
Private Shared Sub OnCutRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim rtb = TryCast(sender, RichTextBox)
If rtb Is Nothing Then Return
Dim selection = New TextRange(rtb.Selection.Start, rtb.Selection.End)
If String.IsNullOrEmpty(selection.Text) Then Return
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(selection.Text, True)
Catch
End Try
selection.Text = String.Empty
e.Handled = True
End Sub
Private Shared Sub OnPasteRichTextBox(sender As Object, e As ExecutedRoutedEventArgs)
Dim rtb = TryCast(sender, RichTextBox)
If rtb Is Nothing Then Return
If Not Forms.Clipboard.ContainsText() Then Return
Dim pasteText = Forms.Clipboard.GetText()
Dim selection = rtb.Selection
selection.Text = pasteText
Dim caretPos = selection.End
rtb.CaretPosition = caretPos
rtb.Selection.Select(caretPos, caretPos)
e.Handled = True
End Sub
Private Shared Sub OnCopyDataGrid(sender As Object, e As ExecutedRoutedEventArgs)
Dim dg = TryCast(sender, DataGrid)
If dg Is Nothing OrElse dg.SelectedCells Is Nothing OrElse dg.SelectedCells.Count = 0 Then Return
Dim sb = New StringBuilder
Dim rowGroups = dg.SelectedCells.GroupBy(Function(c) c.Item)
For Each row In rowGroups
Dim rowText = String.Join(vbTab, row.Select(
Function(cell)
Dim tb = TryCast(cell.Column.GetCellContent(cell.Item), TextBlock)
Return If(tb IsNot Nothing, tb.Text, "")
End Function))
sb.AppendLine(rowText)
Next
Dim sbStr = sb.ToString().TrimEnd(ControlChars.Cr, ControlChars.Lf)
Try
Forms.Clipboard.Clear()
Forms.Clipboard.SetDataObject(sbStr, True)
Catch
End Try
e.Handled = True
End Sub
End Class
End Namespace
@@ -0,0 +1,23 @@
Imports System.Windows.Threading
''' <summary>
''' 指示页面可以通过按下 F5 或以其他方式刷新。
''' </summary>
Public Interface IRefreshable
Sub Refresh()
End Interface
''' <summary>
''' 指示页面可以处理未捕获的异常。
''' </summary>
Public Interface IDispatcherUnhandledException
Sub DispatcherUnhandledException(sender As Object, e As DispatcherUnhandledExceptionEventArgs)
End Interface
''' <summary>
''' 指示该控件是可勾选的。
''' </summary>
Public Interface IMyRadio
Event Check(sender As Object, e As RouteEventArgs)
Event Changed(sender As Object, e As RouteEventArgs)
End Interface
@@ -0,0 +1,46 @@
Public Class LazyLoadBehavior
''' <summary>
''' 指定首次进入 ScrollViewer 的可视范围时执行的操作。
''' </summary>
Public Shared Sub OnFirstEnterScrollViewerViewport(obj As DependencyObject, value As Action)
obj.SetValue(IsInViewportProperty, value)
End Sub
Private Shared ReadOnly IsInViewportProperty As DependencyProperty =
DependencyProperty.RegisterAttached("IsInViewport", GetType(Action), GetType(LazyLoadBehavior),
New PropertyMetadata(Nothing, AddressOf OnIsInViewportChanged))
Private Shared Sub OnIsInViewportChanged(d As DependencyObject, e As DependencyPropertyChangedEventArgs)
Dim Element = TryCast(d, FrameworkElement)
If Element Is Nothing OrElse e.NewValue Is Nothing Then Return
Dim Handled As Boolean = False
Dim Handler As EventHandler =
Sub()
If Handled Then Return
'判断元素是否可见
If Element.RenderSize.Width < Double.Epsilon Then Return
If Not Element.IsVisible Then Return
'判断是否在 ScrollViewer 的可视区域内
Dim Scroll = FindParentScrollViewer(Element)
If Scroll Is Nothing Then Return
If Not New Rect(0, 0, Scroll.ViewportWidth, Scroll.ViewportHeight).IntersectsWith(
Element.TransformToAncestor(Scroll).TransformBounds(New Rect(New Point(0, 0), Element.RenderSize))) Then Return
'执行
Handled = True
CType(e.NewValue, Action).Invoke()
RemoveHandler Element.LayoutUpdated, Handler
End Sub
AddHandler Element.LayoutUpdated, Handler
End Sub
Private Shared Function FindParentScrollViewer(d As DependencyObject) As ScrollViewer
While d IsNot Nothing
If TypeOf d Is ScrollViewer Then Return CType(d, ScrollViewer)
d = VisualTreeHelper.GetParent(d)
End While
Return Nothing
End Function
End Class
@@ -1,4 +0,0 @@
Public Interface IMyRadio
Event Check(sender As Object, e As RouteEventArgs)
Event Changed(sender As Object, e As RouteEventArgs)
End Interface
@@ -140,39 +140,14 @@ Public Class MyButton
End Try End Try
End Sub End Sub
'实现自定义事件 '鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsMouseDown As Boolean = False
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return If Not IsMouseDown Then Return
Log("[Control] 按下按钮:" & Text) Log("[Control] 按下按钮:" & Text)
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
If Not String.IsNullOrEmpty(Tag) Then RaiseCustomEvent() '自定义事件
If Tag.ToString.StartsWithF("链接-") OrElse Tag.ToString.StartsWithF("启动-") Then
Hint("主页自定义按钮语法已更新,且不再兼容老版本语法,请查看新的自定义示例!")
End If
End If
ModEvent.TryStartEvent(EventType, EventData)
End Sub End Sub
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyButton), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyButton), New PropertyMetadata(Nothing))
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
IsMouseDown = True IsMouseDown = True
Focus() Focus()
+67 -64
View File
@@ -90,8 +90,9 @@
MainGrid.Children.Add(MainSwap) MainGrid.Children.Add(MainSwap)
End If End If
'改变默认的折叠 '改变默认的折叠
If IsSwaped AndAlso SwapControl IsNot Nothing Then If IsSwapped AndAlso SwapControl IsNot Nothing Then
MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0)) MainSwap.RenderTransform = New RotateTransform(If(SwapLogoRight, 270, 0))
SwapControl.Visibility = Visibility.Collapsed
'取消由于高度变化被迫触发的高度动画 '取消由于高度变化被迫触发的高度动画
Dim RawUseAnimation As Boolean = UseAnimation Dim RawUseAnimation As Boolean = UseAnimation
UseAnimation = False UseAnimation = False
@@ -109,28 +110,24 @@
'这一部分的代码是好几年前留下的究极屎坑,当时还不知道该咋正确调用这种方法,就写了这么一坨屎 '这一部分的代码是好几年前留下的究极屎坑,当时还不知道该咋正确调用这种方法,就写了这么一坨屎
'但是现在……反正勉强能用……懒得改了就这样吧.jpg '但是现在……反正勉强能用……懒得改了就这样吧.jpg
'别骂了别骂了.jpg '别骂了别骂了.jpg
If IsNothing(Stack.Tag) Then Return If Stack.Tag Is Nothing Then Return
'排序 '排序
Dim HasDuplicates As Boolean = False
Select Case Type Select Case Type
Case 3 Case 3
Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).Sort(Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay)) Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).SortByComparison(Function(a, b) CompareVersionGE(a.DisplayName, b.DisplayName))
Case 4, 10 Case 4, 10
Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).Sort(Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit)) Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).SortByComparison(Function(a, b) CompareVersionGE(a.Inherit, b.Inherit))
Case 6 Case 6
Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).Sort(Function(a, b) a.Version > b.Version) Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).OrderByDescending(Function(a) a).ToList
Case 8, 9 Case 8, 9
Stack.Tag = CType(Stack.Tag, List(Of CompFile)).Sort(Function(a, b) a.ReleaseDate > b.ReleaseDate) Stack.Tag = CType(Stack.Tag, List(Of CompFile)).SortByComparison(Function(a, b) a.ReleaseDate > b.ReleaseDate)
HasDuplicates =
CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <>
CType(Stack.Tag, List(Of CompFile)).Count
End Select End Select
'控件转换 '控件转换
Select Case Type Select Case Type
Case 5
Dim LoadingPickaxe As New MyLoading With {.Text = "正在获取版本列表", .Margin = New Thickness(5)}
Dim Loader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Main", AddressOf DlForgeVersionMain)
LoadingPickaxe.State = Loader
Loader.Start(Stack.Tag)
AddHandler LoadingPickaxe.StateChanged, AddressOf FrmDownloadForge.Forge_StateChanged
AddHandler LoadingPickaxe.Click, AddressOf FrmDownloadForge.Forge_Click
Stack.Children.Add(LoadingPickaxe)
Case 6 Case 6
ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True) ForgeDownloadListItemPreload(Stack, Stack.Tag, AddressOf ForgeSave_Click, True)
Case 8 Case 8
@@ -140,37 +137,24 @@
For Each Data As Object In Stack.Tag For Each Data As Object In Stack.Tag
Select Case Type Select Case Type
Case 0 Case 0
Stack.Children.Add(PageSelectRight.McVersionListItem(Data)) Stack.Children.Add(CType(Data, McInstance).ToListItem(AddressOf PageSelectRight.McInstanceListContent))
Case 2 Case 2
Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True)) Stack.Children.Add(McDownloadListItem(Data, AddressOf McDownloadMenuSave, True))
Case 3 Case 3
Stack.Children.Add(OptiFineDownloadListItem(Data, AddressOf OptiFineSave_Click, True)) Stack.Children.Add(OptiFineDownloadListItem(Data, AddressOf OptiFineSave_Click, True))
Case 4
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf FrmDownloadLiteLoader.DownloadStart, False))
Case 5
Case 6 Case 6
Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True)) Stack.Children.Add(ForgeDownloadListItem(Data, AddressOf ForgeSave_Click, True))
Case 7 Case 7
'不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug '不能使用 AddressOf,这导致了 #535,原因完全不明,疑似是编译器 Bug
Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False)) Stack.Children.Add(McDownloadListItem(Data, Sub(sender, e) FrmDownloadInstall.MinecraftSelected(sender, e), False))
Case 8 Case 8
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <> '若存在重复的版本名,则显示文件名而非版本名(#1344)
CType(Stack.Tag, List(Of CompFile)).Count Then Stack.Children.Add(CType(Data, CompFile).ToListItem(
'存在重复的名称(#1344) AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
Else
'不存在重复的名称,正常加载
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Save_Click))
End If
Case 9 Case 9
If CType(Stack.Tag, List(Of CompFile)).Distinct(Function(a, b) a.DisplayName = b.DisplayName).Count <> '若存在重复的版本名,则显示文件名而非版本名(#1344)
CType(Stack.Tag, List(Of CompFile)).Count Then Stack.Children.Add(CType(Data, CompFile).ToListItem(
'存在重复的名称(#1344) AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=HasDuplicates))
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click, BadDisplayName:=True))
Else
'不存在重复的名称,正常加载
Stack.Children.Add(CType(Data, CompFile).ToListItem(AddressOf FrmDownloadCompDetail.Install_Click, AddressOf FrmDownloadCompDetail.Save_Click))
End If
Case 10 Case 10
Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True)) Stack.Children.Add(LiteLoaderDownloadListItem(Data, AddressOf LiteLoaderSave_Click, True))
Case 11 Case 11
@@ -224,7 +208,7 @@
Private ActualUsedHeight As Double '回滚实际高度(例如 NaN) Private ActualUsedHeight As Double '回滚实际高度(例如 NaN)
Private Sub MySizeChanged(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged Private Sub MySizeChanged(sender As Object, e As SizeChangedEventArgs) Handles Me.SizeChanged
If Not UseAnimation Then Return If Not UseAnimation Then Return
Dim DeltaHeight As Double = If(IsSwaped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height Dim DeltaHeight As Double = If(IsSwapped, SwapedHeight, e.NewSize.Height) - e.PreviousSize.Height
'卡片的进入时动画已被页面通用切换动画替代 '卡片的进入时动画已被页面通用切换动画替代
If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Return If e.PreviousSize.Height = 0 OrElse IsHeightAnimating OrElse Math.Abs(DeltaHeight) < 1 OrElse ActualHeight = 0 Then Return
StartHeightAnimation(DeltaHeight, e.PreviousSize.Height, False) StartHeightAnimation(DeltaHeight, e.PreviousSize.Height, False)
@@ -269,18 +253,18 @@
Sub() Sub()
IsHeightAnimating = False IsHeightAnimating = False
Height = ActualUsedHeight Height = ActualUsedHeight
If IsSwaped AndAlso SwapControl IsNot Nothing Then SwapControl.Visibility = Visibility.Collapsed If IsSwapped AndAlso SwapControl IsNot Nothing Then SwapControl.Visibility = Visibility.Collapsed
End Sub,, True)) End Sub,, True))
AniStart(AnimList, "MyCard Height " & Uuid) AniStart(AnimList, "MyCard Height " & Uuid)
IsHeightAnimating = True IsHeightAnimating = True
ActualUsedHeight = If(IsSwaped, SwapedHeight, Height) ActualUsedHeight = If(IsSwapped, SwapedHeight, Height)
Height = PreviousHeight Height = PreviousHeight
End Sub End Sub
''' <summary> ''' <summary>
''' 通知 MyCard,控件内容已改变,需要中断动画并更新高度。 ''' 通知 MyCard,控件内容已改变,需要中断动画并瞬间更新高度。
''' </summary> ''' </summary>
Public Sub TriggerForceResize() Public Sub TriggerForceResize()
Height = If(IsSwaped, SwapedHeight, Double.NaN) Height = If(IsSwapped, SwapedHeight, Double.NaN)
AniStop("MyCard Height " & Uuid) AniStop("MyCard Height " & Uuid)
IsHeightAnimating = False IsHeightAnimating = False
End Sub End Sub
@@ -291,7 +275,7 @@
'若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠 '若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠
'这是因为不能直接在 XAML 中设置 SwapControl '这是因为不能直接在 XAML 中设置 SwapControl
Public SwapControl As Object Public SwapControl As FrameworkElement
Public Property CanSwap As Boolean = False Public Property CanSwap As Boolean = False
''' <summary> ''' <summary>
''' 被折叠的种类,用于控件虚拟化。 ''' 被折叠的种类,用于控件虚拟化。
@@ -300,59 +284,78 @@
''' <summary> ''' <summary>
''' 是否已被折叠。 ''' 是否已被折叠。
''' </summary> ''' </summary>
Public Property IsSwaped As Boolean Public Property IsSwapped As Boolean
Get Get
Return _IsSwaped Return _IsSwapped
End Get End Get
Set(value As Boolean) Set(value As Boolean)
If _IsSwaped = value Then Return If _IsSwapped = value Then Return
_IsSwaped = value _IsSwapped = value
If SwapControl Is Nothing Then Return If SwapControl Is Nothing Then Return
'展开 '展开
If Not IsSwaped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title) If Not IsSwapped AndAlso TypeOf SwapControl Is StackPanel Then StackInstall(SwapControl, SwapType, Title)
'若尚未加载,会在 Loaded 事件中触发无动画的折叠,不需要在这里进行 '若尚未加载,会在 Loaded 事件中触发无动画的折叠,不需要在这里进行
If Not IsLoaded Then Return If Not IsLoaded Then Return
'更新高度 '更新高度
SwapControl.Visibility = Visibility.Visible SwapControl.Visibility = Visibility.Visible
TriggerForceResize() TriggerForceResize()
'改变箭头 '改变箭头
AniStart(AaRotateTransform(MainSwap, If(_IsSwaped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 250,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), "MyCard Swap " & Uuid, True) AniStart(AaRotateTransform(MainSwap, If(_IsSwapped, If(SwapLogoRight, 270, 0), 180) - CType(MainSwap.RenderTransform, RotateTransform).Angle, 250,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), "MyCard Swap " & Uuid, True)
End Set End Set
End Property End Property
Private _IsSwaped As Boolean = False Private _IsSwapped As Boolean = False
<Obsolete("IsSwaped 存在拼写错误,请换用 IsSwapped 属性。")>
Public Property IsSwaped As Boolean
Get
Return GetValue(IsSwapedProperty)
End Get
Set(value As Boolean)
SetValue(IsSwapedProperty, value)
End Set
End Property
Public Shared ReadOnly IsSwapedProperty As DependencyProperty = DependencyProperty.Register("IsSwaped", GetType(Boolean), GetType(MyCard), New PropertyMetadata(False,
Sub(sender, e) If sender IsNot Nothing AndAlso TypeOf sender Is MyCard Then CType(sender, MyCard).IsSwapped = CType(e.NewValue, Boolean)))
Public Property SwapLogoRight As Boolean = False Public Property SwapLogoRight As Boolean = False
Private IsMouseDown As Boolean = False Private IsSwapMouseDown As Boolean = False '用于触发卡片展开/折叠的 MouseDown
Private IsCustomMouseDown As Boolean = False '用于触发自定义事件的 MouseDown
Public Event PreviewSwap(sender As Object, e As RouteEventArgs) Public Event PreviewSwap(sender As Object, e As RouteEventArgs)
Public Event Swap(sender As Object, e As RouteEventArgs) Public Event Swap(sender As Object, e As RouteEventArgs)
Public Const SwapedHeight As Integer = 40 Public Const SwapedHeight As Integer = 40
Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown Private Sub MyCard_MouseLeftButtonDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
Dim Pos As Double = Mouse.GetPosition(Me).Y Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso If Not IsSwapped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判 (Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return
IsMouseDown = True IsCustomMouseDown = True
If Not IsSwapped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
IsSwapMouseDown = True
End Sub End Sub
Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp Private Sub MyCard_MouseLeftButtonUp() Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return If Not IsCustomMouseDown Then Return
IsMouseDown = False IsCustomMouseDown = False
RaiseCustomEvent() '触发自定义事件
If Not IsSwapMouseDown Then Return
IsSwapMouseDown = False
Dim Pos As Double = Mouse.GetPosition(Me).Y Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso If Not IsSwapped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判 (SwapControl Is Nothing OrElse Pos > If(IsSwapped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Return '检测点击位置;或已经不在可视树上的误判
Dim ee = New RouteEventArgs(True) Dim e = New RouteEventArgs(True)
RaiseEvent PreviewSwap(Me, ee) RaiseEvent PreviewSwap(Me, e)
If ee.Handled Then If e.Handled Then
IsMouseDown = False IsSwapMouseDown = False
Return Return
End If End If
IsSwaped = Not IsSwaped IsSwapped = Not IsSwapped
Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title)) Log("[Control] " & If(IsSwapped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title))
RaiseEvent Swap(Me, ee) RaiseEvent Swap(Me, e)
End Sub End Sub
Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave Private Sub MyCard_MouseLeave_Swap(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
IsMouseDown = False IsSwapMouseDown = False
End Sub End Sub
#End Region #End Region
@@ -2,6 +2,7 @@
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
Public Class MyCheckBox Public Class MyCheckBox
Implements ISettingControl
'基础 '基础
@@ -12,9 +13,6 @@ Public Class MyCheckBox
''' <param name="user">是否为用户手动改变的勾选状态。</param> ''' <param name="user">是否为用户手动改变的勾选状态。</param>
Public Event Change(sender As Object, user As Boolean) Public Event Change(sender As Object, user As Boolean)
Public Event PreviewChange(sender As Object, e As RouteEventArgs) Public Event PreviewChange(sender As Object, e As RouteEventArgs)
Public Sub RaiseChange()
RaiseEvent Change(Me, False)
End Sub '使外部程序引发本控件的 Change 事件
'自定义属性 '自定义属性
Public Property Checked As Boolean Public Property Checked As Boolean
@@ -59,6 +57,7 @@ Public Class MyCheckBox
'更改动画 '更改动画
SyncUI() SyncUI()
RaiseCustomEvent()
Catch ex As Exception Catch ex As Exception
Log(ex, "设置 Checked 失败") Log(ex, "设置 Checked 失败")
End Try End Try
@@ -74,7 +73,7 @@ Public Class MyCheckBox
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True) AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid) }, "MyCheckBox Scale " & Uuid)
AniStart({ AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray4"), AnimationTimeOfCheck) AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray5"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid) }, "MyCheckBox BorderColor " & Uuid)
AniStart({ AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2) AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
@@ -87,7 +86,7 @@ Public Class MyCheckBox
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True) AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid) }, "MyCheckBox Scale " & Uuid)
AniStart({ AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfCheck) AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid) }, "MyCheckBox BorderColor " & Uuid)
AniStart({ AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2) AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
@@ -101,11 +100,11 @@ Public Class MyCheckBox
If Checked Then If Checked Then
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4")) ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray5"))
Else Else
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0 CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4")) ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
End If End If
End If End If
End Sub End Sub
@@ -180,18 +179,18 @@ Public Class MyCheckBox
Else Else
'不可用 '不可用
AniStart({ AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, ColorGray4 - ShapeBorder.BorderBrush, AnimationTimeOfMouseOut) AaColor(ShapeBorder, Border.BorderBrushProperty, ColorGray5 - ShapeBorder.BorderBrush, AnimationTimeOfMouseOut)
}, "MyCheckBox BorderColor " & Uuid) }, "MyCheckBox BorderColor " & Uuid)
AniStart({ AniStart({
AaColor(LabText, TextBlock.ForegroundProperty, ColorGray4 - LabText.Foreground, AnimationTimeOfMouseOut) AaColor(LabText, TextBlock.ForegroundProperty, ColorGray5 - LabText.Foreground, AnimationTimeOfMouseOut)
}, "MyCheckBox TextColor " & Uuid) }, "MyCheckBox TextColor " & Uuid)
End If End If
Else Else
'无动画 '无动画
AniStop("MyCheckBox TextColor " & Uuid) AniStop("MyCheckBox TextColor " & Uuid)
AniStop("MyCheckBox BorderColor " & Uuid) AniStop("MyCheckBox BorderColor " & Uuid)
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4")) LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"))
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4")) ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
End If End If
End Sub End Sub
Private Sub Checkbox_MouseEnterAnimation() Handles Me.MouseEnter Private Sub Checkbox_MouseEnterAnimation() Handles Me.MouseEnter
@@ -205,11 +204,27 @@ Public Class MyCheckBox
Private Sub Checkbox_MouseLeaveAnimation() Handles Me.MouseLeave Private Sub Checkbox_MouseLeaveAnimation() Handles Me.MouseLeave
If Not IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误 If Not IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
AniStart({ AniStart({
AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut) AaColor(LabText, TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"), AnimationTimeOfMouseOut)
}, "MyCheckBox TextColor " & Uuid) }, "MyCheckBox TextColor " & Uuid)
AniStart({ AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut) AaColor(ShapeBorder, Border.BorderBrushProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfMouseOut)
}, "MyCheckBox BorderColor " & Uuid) }, "MyCheckBox BorderColor " & Uuid)
End Sub End Sub
#Region "设置"
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
Checked = Boolean.Parse(NewValue)
End Sub
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
Return Checked.ToString
End Function
Private Sub SaveSetting() Handles Me.Change
SettingService.SaveSetting(Me)
End Sub
#End Region
End Class End Class
+46 -2
View File
@@ -1,5 +1,6 @@
Public Class MyComboBox Public Class MyComboBox
Inherits ComboBox Inherits ComboBox
Implements ISettingControl
Public Event TextChanged(sender As Object, e As TextChangedEventArgs) Public Event TextChanged(sender As Object, e As TextChangedEventArgs)
'基础 '基础
@@ -117,7 +118,7 @@
Private IsTextChanging As Boolean = False Private IsTextChanging As Boolean = False
Private Sub MyComboBox_TextChanged(sender As Object, e As TextChangedEventArgs) Handles Me.TextChanged Private Sub MyComboBox_TextChanged(sender As Object, e As TextChangedEventArgs) Handles Me.TextChanged
If IsTextChanging OrElse Not IsEditable Then Return If IsTextChanging OrElse Not IsEditable Then Return
If SelectedItem IsNot Nothing AndAlso Text <> SelectedItem.ToString Then If SelectedItem Is Nothing OrElse Text = SelectedItem.ToString Then Return
Dim RawText As String = Text Dim RawText As String = Text
Dim RawSelectionStart As Integer = TextBox.SelectionStart Dim RawSelectionStart As Integer = TextBox.SelectionStart
IsTextChanging = True IsTextChanging = True
@@ -125,7 +126,6 @@
Text = RawText Text = RawText
TextBox.SelectionStart = RawSelectionStart TextBox.SelectionStart = RawSelectionStart
IsTextChanging = False IsTextChanging = False
End If
End Sub End Sub
Public ReadOnly Property ContentPresenter As ContentPresenter Public ReadOnly Property ContentPresenter As ContentPresenter
@@ -134,4 +134,48 @@
End Get End Get
End Property End Property
Private Sub MyComboBox_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles Me.SelectionChanged
If IsLoaded AndAlso AniControlEnabled = 0 Then RaiseCustomEvent()
End Sub
#Region "设置"
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
Dim TargetItem = Items.OfType(Of DependencyObject)().FirstOrDefault(Function(i) Val(If(SettingService.GetValue(i), -1)) = NewValue)
If TargetItem IsNot Nothing Then
SelectedItem = TargetItem
ElseIf Items.Count > NewValue Then
SelectedIndex = NewValue
Else
Log($"[Setting] 尝试显示设置 {SettingService.GetKey(Me)},但没有找到设置值 {NewValue} 的对应项", LogLevel.Debug)
SelectedIndex = -1
SelectedItem = Nothing
'Dim Key As String = SettingService.GetKey(Me)
'Dim DefaultValue = Settings.GetDefault(Key)
'If DefaultValue = NewValue Then
' Log($"[Setting] 尝试显示设置 {Key},但没有找到设置值 {NewValue} 的对应项,这可能是因为程序版本太老了", LogLevel.Hint)
'Else
' Log($"[Setting] 尝试显示设置 {Key},但没有找到设置值 {NewValue} 的对应项,已重置该设置", LogLevel.Debug)
' Settings.Reset(Key)
' RefreshSetting(DefaultValue)
'End If
End If
End Sub
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
If SelectedItem Is Nothing Then Return Nothing
If TypeOf SelectedItem Is DependencyObject Then
Return Val(If(SettingService.GetValue(SelectedItem), SelectedIndex))
Else
Return SelectedIndex
End If
End Function
Private Sub SaveSetting() Handles Me.SelectionChanged
If SelectedItem Is Nothing Then Return
SettingService.SaveSetting(Me)
End Sub
#End Region
End Class End Class
@@ -53,7 +53,8 @@
Set(value As Boolean) Set(value As Boolean)
If _Show = value Then Return If _Show = value Then Return
_Show = value _Show = value
RunInUi(Sub() RunInUi(
Sub()
If value Then If value Then
'有了 '有了
Visibility = Visibility.Visible Visibility = Visibility.Visible
@@ -137,6 +138,7 @@
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack) AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraButton Scale " & Uuid) }, "MyExtraButton Scale " & Uuid)
End If End If
If IsLeftMouseHeld Then RaiseCustomEvent()
IsLeftMouseHeld = False IsLeftMouseHeld = False
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub End Sub
@@ -199,7 +201,8 @@
''' 发出一圈波浪效果提示。 ''' 发出一圈波浪效果提示。
''' </summary> ''' </summary>
Public Sub Ribble() Public Sub Ribble()
RunInUi(Sub() RunInUi(
Sub()
Dim Shape As New Border With {.CornerRadius = New CornerRadius(1000), .BorderThickness = New Thickness(0.001), .Opacity = 0.5, .RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransform = New ScaleTransform()} Dim Shape As New Border With {.CornerRadius = New CornerRadius(1000), .BorderThickness = New Thickness(0.001), .Opacity = 0.5, .RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransform = New ScaleTransform()}
Shape.SetResourceReference(Border.BackgroundProperty, "ColorBrush5") Shape.SetResourceReference(Border.BackgroundProperty, "ColorBrush5")
PanScale.Children.Insert(0, Shape) PanScale.Children.Insert(0, Shape)
@@ -81,12 +81,12 @@ Public Class MyExtraTextButton
'触发点击事件 '触发点击事件
Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
If IsLeftMouseHeld Then If Not IsLeftMouseHeld Then Return
Log("[Control] 按下附加图标按钮:" & Text) Log("[Control] 按下附加图标按钮:" & Text)
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
e.Handled = True e.Handled = True
RaiseCustomEvent()
Button_LeftMouseUp() Button_LeftMouseUp()
End If
End Sub End Sub
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行) '鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
+6 -21
View File
@@ -99,21 +99,24 @@ Public Class MyHint
End Property End Property
Public Property RelativeSetup As String = "" Public Property RelativeSetup As String = ""
Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded Private Sub MyHint_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
If CanClose AndAlso Setup.Get(RelativeSetup) Then Visibility = Visibility.Collapsed If CanClose AndAlso Settings.Get(RelativeSetup) Then Visibility = Visibility.Collapsed
End Sub End Sub
Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click Private Sub BtnClose_Click(sender As Object, e As EventArgs) Handles BtnClose.Click
Setup.Set(RelativeSetup, True) Settings.SetSafe(RelativeSetup, True)
AniDispose(Me, False) AniDispose(Me, False)
End Sub End Sub
'触发点击事件 '触发点击事件
Public Event Click(sender As Object, e As MouseButtonEventArgs)
Private IsMouseDown As Boolean = False Private IsMouseDown As Boolean = False
Private Sub MyHint_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp Private Sub MyHint_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return If Not IsMouseDown Then Return
IsMouseDown = False IsMouseDown = False
Log("[Control] 按下提示条" & If(String.IsNullOrEmpty(Name), "", ":" & Name)) Log("[Control] 按下提示条" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
RaiseEvent Click(sender, e)
If e.Handled Then Return
e.Handled = True e.Handled = True
ModEvent.TryStartEvent(EventType, EventData) RaiseCustomEvent() '自定义事件
End Sub End Sub
Private Sub MyHint_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown Private Sub MyHint_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
IsMouseDown = True IsMouseDown = True
@@ -121,24 +124,6 @@ Public Class MyHint
Private Sub MyHint_MouseLeave() Handles Me.MouseLeave Private Sub MyHint_MouseLeave() Handles Me.MouseLeave
IsMouseDown = False IsMouseDown = False
End Sub End Sub
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyHint), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyHint), New PropertyMetadata(Nothing))
End Class End Class
Partial Public Module ModAnimation Partial Public Module ModAnimation
@@ -48,36 +48,16 @@
End Set End Set
End Property End Property
'触发点击事件 '鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsMouseDown As Boolean = False
Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp Private Sub Button_MouseUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If Not IsMouseDown Then Return If Not IsMouseDown Then Return
Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", ":" & Name)) Log("[Control] 按下图标按钮" & If(String.IsNullOrEmpty(Name), "", ":" & Name))
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
e.Handled = True e.Handled = True
Button_MouseUp() Button_MouseUp()
ModEvent.TryStartEvent(EventType, EventData) RaiseCustomEvent() '自定义事件
End Sub End Sub
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyIconButton), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyIconButton), New PropertyMetadata(Nothing))
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsMouseDown As Boolean = False
Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown Private Sub Button_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
IsMouseDown = True IsMouseDown = True
Focus() Focus()
@@ -102,7 +82,6 @@
RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave RefreshAnim() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub End Sub
'自定义事件
'务必放在 IsMouseDown 更新之后 '务必放在 IsMouseDown 更新之后
Private Const AnimationColorIn As Integer = 120 Private Const AnimationColorIn As Integer = 120
Private Const AnimationColorOut As Integer = 150 Private Const AnimationColorOut As Integer = 150
@@ -8,9 +8,6 @@ Public Class MyIconTextButton
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
Public Event Check(sender As Object, raiseByMouse As Boolean) Public Event Check(sender As Object, raiseByMouse As Boolean)
Public Event Change(sender As Object, raiseByMouse As Boolean) Public Event Change(sender As Object, raiseByMouse As Boolean)
Public Sub RaiseChange()
RaiseEvent Change(Me, False)
End Sub '使外部程序可以引发本控件的 Change 事件
'自定义属性 '自定义属性
@@ -76,7 +73,7 @@ Public Class MyIconTextButton
Log("[Control] 按下带图标按钮:" & Text) Log("[Control] 按下带图标按钮:" & Text)
IsMouseDown = False IsMouseDown = False
RaiseEvent Click(Me, New RouteEventArgs(True)) RaiseEvent Click(Me, New RouteEventArgs(True))
ModEvent.TryStartEvent(EventType, EventData) RaiseCustomEvent() '自定义事件
RefreshColor() RefreshColor()
End Sub End Sub
Private Sub MyIconTextButton_MouseDown() Handles Me.MouseLeftButtonDown Private Sub MyIconTextButton_MouseDown() Handles Me.MouseLeftButtonDown
@@ -87,24 +84,6 @@ Public Class MyIconTextButton
IsMouseDown = False IsMouseDown = False
RefreshColor() RefreshColor()
End Sub End Sub
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyIconTextButton), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyIconTextButton), New PropertyMetadata(Nothing))
'动画 '动画
+26 -59
View File
@@ -25,7 +25,7 @@
''' <summary> ''' <summary>
''' 与 Image 的 Source 类似。 ''' 与 Image 的 Source 类似。
''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示,图片会保存为本地缓存。 ''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示;若 EnableCache 设为 True,图片还会保存为本地缓存。
''' 支持 WebP 格式的图片。 ''' 支持 WebP 格式的图片。
''' </summary> ''' </summary>
Public Shadows Property Source As String '覆写 Image 的 Source 属性 Public Shadows Property Source As String '覆写 Image 的 Source 属性
@@ -46,7 +46,7 @@
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyImage).Source = e.NewValue.ToString()))) Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyImage).Source = e.NewValue.ToString())))
''' <summary> ''' <summary>
''' 当 Source 首次下载失败时,会从该备用地址加载图片。 ''' 若 Source 是一个网络图片,该地址将作为第二图片源。
''' </summary> ''' </summary>
Public Property FallbackSource As String Public Property FallbackSource As String
Get Get
@@ -85,8 +85,8 @@
If _ActualSource = value Then Return If _ActualSource = value Then Return
_ActualSource = value _ActualSource = value
Try Try
Dim Bitmap As MyBitmap = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件 Dim Bitmap As ImageSource = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件
RunInUiWait(Sub() MyBase.Source = Bitmap) RunInUi(Sub() MyBase.Source = Bitmap)
Catch ex As Exception Catch ex As Exception
Log(ex, $"加载图片失败({value})") Log(ex, $"加载图片失败({value})")
Try Try
@@ -111,79 +111,46 @@
Return Return
End If End If
'从缓存加载网络图片 '从缓存加载网络图片
Dim Url As String = Source
Dim Retried As Boolean = False
Dim TempPath As String = GetTempPath(Url)
Dim TempFile As New FileInfo(TempPath)
Dim EnableCache As Boolean = Me.EnableCache Dim EnableCache As Boolean = Me.EnableCache
Dim TempPath As String = $"{PathTemp}MyImage\{GetHash(Source)}.png{If(EnableCache, "", GetUuid())}" '不启用缓存时在末尾加上随机字符串,避免冲突
Dim TempFile As New FileInfo(TempPath)
If EnableCache AndAlso TempFile.Exists Then If EnableCache AndAlso TempFile.Exists Then
ActualSource = TempPath ActualSource = TempPath '显示缓存的图片
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存 If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Return '无需刷新缓存
Else
ActualSource = LoadingSource '显示加载中图片
End If End If
RunInNewThread( RunInNewThread(
Sub() Sub()
Dim TempDownloadingPath As String = Nothing Dim IsLocalFallback As Boolean = Not String.IsNullOrEmpty(FallbackSource) AndAlso Not FallbackSource.StartsWithF("http")
Try Try
RetryStart:
'下载 '下载
ActualSource = LoadingSource '显示加载中图片 NetDownloadByLoader(
TempDownloadingPath = TempPath & RandomInteger(0, 10000000) If(FallbackSource IsNot Nothing AndAlso FallbackSource.StartsWithF("http") AndAlso Source <> FallbackSource,
Directory.CreateDirectory(GetPathFromFullPath(TempPath)) '重新实现下载,以避免携带 Header(#5072) {Source, FallbackSource}, {Source}),
Using Client As New Net.WebClient TempPath, SimulateBrowserHeaders:=True)
Client.DownloadFile(Url, TempDownloadingPath) ActualSource = TempPath
End Using If Not EnableCache Then File.Delete(TempPath)
If Url <> Source AndAlso Url <> FallbackSource Then
'已经更换了地址
File.Delete(TempDownloadingPath)
ElseIf EnableCache Then
'保存缓存并显示
If File.Exists(TempPath) Then File.Delete(TempPath)
FileSystem.Rename(TempDownloadingPath, TempPath)
RunInUi(Sub() ActualSource = TempPath)
Else
'直接显示
RunInUiWait(Sub() ActualSource = TempDownloadingPath)
File.Delete(TempDownloadingPath)
End If
Catch ex As Exception Catch ex As Exception
Try Try
If TempPath IsNot Nothing Then File.Delete(TempPath) If TempPath IsNot Nothing Then File.Delete(TempPath)
If TempDownloadingPath IsNot Nothing Then File.Delete(TempDownloadingPath)
Catch Catch
End Try End Try
If Not Retried Then '加载本地备用图片
'更换备用地址 If IsLocalFallback Then
Log(ex, $"下载图片可重试地失败({Url})", LogLevel.Developer) Try
Retried = True ActualSource = FallbackSource
Url = If(FallbackSource, Source) Log(ex, $"下载图片失败,使用本地备用图片({Source})")
'空
If Url Is Nothing Then
ActualSource = Nothing
Return Return
End If Catch exx As Exception
'本地图片 Log(ex, $"下载图片失败({Source})", LogLevel.Hint)
If Not Url.StartsWithF("http") Then Log(exx, $"加载备用图片失败({FallbackSource})", LogLevel.Hint)
ActualSource = Url End Try
Return
End If
'从缓存加载网络图片
TempPath = GetTempPath(Url)
TempFile = New FileInfo(TempPath)
If EnableCache AndAlso TempFile.Exists() Then
ActualSource = TempPath
If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Return '无需刷新缓存
End If
'下载
If Source = Url Then Thread.Sleep(1000) '延迟 1s 重试
GoTo RetryStart
Else Else
Log(ex, $"下载图片失败({Url})", LogLevel.Hint) Log(ex, $"下载图片失败({Source},备用:{FallbackSource})", LogLevel.Hint)
End If End If
End Try End Try
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal) End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
End Sub End Sub
Public Shared Function GetTempPath(Url As String) As String
Return $"{PathTemp}MyImage\{GetHash(Url)}.png"
End Function
End Class End Class
@@ -396,6 +396,7 @@ Public Class MyListItem
Dim CheckedCount As Integer = 0 Dim CheckedCount As Integer = 0
'收集控件列表与选中个数 '收集控件列表与选中个数
For Each Control In CType(Parent, Object).Children For Each Control In CType(Parent, Object).Children
Control = MyVirtualizingElement.TryInit(Control)
If TypeOf Control Is MyListItem AndAlso CType(Control, MyListItem).Type = CheckType.RadioBox Then If TypeOf Control Is MyListItem AndAlso CType(Control, MyListItem).Type = CheckType.RadioBox Then
RadioboxList.Add(Control) RadioboxList.Add(Control)
If Control.Checked Then CheckedCount += 1 If Control.Checked Then CheckedCount += 1
@@ -506,8 +507,8 @@ Public Class MyListItem
RaiseEvent Click(sender, e) RaiseEvent Click(sender, e)
If e.Handled Then Return If e.Handled Then Return
'触发自定义事件 '触发自定义事件
If Not String.IsNullOrEmpty(EventType) Then If CustomEventService.GetEventType(sender) <> CustomEvent.EventType.None Then
ModEvent.TryStartEvent(EventType, EventData) RaiseCustomEvent()
e.Handled = True e.Handled = True
End If End If
If e.Handled Then Return If e.Handled Then Return
@@ -537,26 +538,6 @@ Public Class MyListItem
If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True If ButtonStack IsNot Nothing Then ButtonStack.IsHitTestVisible = True
End Sub End Sub
'实现自定义事件
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyListItem), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyListItem), New PropertyMetadata(Nothing))
#End Region #End Region
Private StateLast As String Private StateLast As String
@@ -564,7 +545,7 @@ Public Class MyListItem
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
'菜单虚拟化检测 '菜单虚拟化检测
If ContentHandler IsNot Nothing Then If ContentHandler IsNot Nothing Then
ContentHandler(sender, e) ContentHandler(Me, e)
ContentHandler = Nothing ContentHandler = Nothing
End If End If
'判断当前颜色 '判断当前颜色
@@ -657,13 +638,14 @@ Public Class MyListItem
SetResourceReference(ForegroundProperty, "ColorBrush1") SetResourceReference(ForegroundProperty, "ColorBrush1")
End If End If
ColumnPaddingRight.Width = New GridLength(MinPaddingRight) ColumnPaddingRight.Width = New GridLength(MinPaddingRight)
If EventType = "打开帮助" AndAlso Not (Title <> "" AndAlso Info <> "") Then '#3266 If CustomEventService.GetEventType(Me) = CustomEvent.EventType.打开帮助 AndAlso Not (Title <> "" AndAlso Info <> "") Then '#3266
Try Try
Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me) Dim Entry As New HelpEntry(CustomEvent.GetAbsoluteUrls(CustomEventService.GetEventData(Me), CustomEventService.GetEventType(Me))(0))
Entry.SetToListItem(Me)
Catch ex As Exception Catch ex As Exception
Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox) Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox)
EventType = Nothing CustomEventService.SetEventType(Me, CustomEvent.EventType.None)
EventData = Nothing CustomEventService.SetEventData(Me, "")
End Try End Try
End If End If
End Sub End Sub
@@ -79,11 +79,7 @@ Public Class MyLoading
Do While Ex.InnerException IsNot Nothing Do While Ex.InnerException IsNot Nothing
Ex = Ex.InnerException Ex = Ex.InnerException
Loop Loop
LabText.Text = StrTrim(Ex.Message) LabText.Text = If(Ex.IsNetworkRelated(), "网络环境不佳,请稍后再试,或使用 VPN 改善网络环境", StrTrim(Ex.Message))
If {"远程主机强迫关闭了", "远程方已关闭传输流", "未能解析此远程名称", "由于目标计算机积极拒绝",
"操作已超时", "操作超时", "服务器超时", "连接超时"}.Any(Function(s) LabText.Text.Contains(s)) Then
LabText.Text = "网络环境不佳,请稍后重试,或使用 VPN 以改善网络环境"
End If
End If End If
Else Else
LabText.Text = TextError LabText.Text = TextError
@@ -190,7 +186,8 @@ Public Class MyLoading
AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)), AaRotateTransform(PathPickaxe, -20 - CType(PathPickaxe.RenderTransform, RotateTransform).Angle, 350, 250, New AniEaseInBack(AniEasePower.Weak)),
AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True), AaRotateTransform(PathPickaxe, 50, 900,, New AniEaseOutFluent, True),
AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)), AaRotateTransform(PathPickaxe, 25, 900,, New AniEaseOutElastic(AniEasePower.Weak)),
AaCode(Sub() AaCode(
Sub()
PathLeft.Opacity = 1 PathLeft.Opacity = 1
PathLeft.Margin = New Thickness(7, 41, 0, 0) PathLeft.Margin = New Thickness(7, 41, 0, 0)
PathRight.Opacity = 1 PathRight.Opacity = 1
@@ -203,14 +200,12 @@ Public Class MyLoading
AaOpacity(PathRight, -1, 100, 50), AaOpacity(PathRight, -1, 100, 50),
AaX(PathRight, 5, 180,, New AniEaseOutFluent), AaX(PathRight, 5, 180,, New AniEaseOutFluent),
AaY(PathRight, -6, 180,, New AniEaseOutFluent), AaY(PathRight, -6, 180,, New AniEaseOutFluent),
AaCode(Sub() AaCode(
Sub()
IsLooping = False IsLooping = False
AniLoop() AniLoop()
End Sub,, True) End Sub,, True)
}, "MyLoader Loop " & Uuid & "/" & GetUuid()) }, "MyLoader Loop " & Uuid & "/" & GetUuid())
If ShowProgress Then
End If
End Sub End Sub
''' <summary> ''' <summary>
@@ -7,7 +7,7 @@
If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon) If IconControl IsNot Nothing Then IconControl.Data = (New GeometryConverter).ConvertFromString(Icon)
End If End If
'对父级设置透明度 '对父级设置透明度
CType(Parent, ContextMenu).Opacity = Setup.Get("UiLauncherTransparent") / 1000 + 0.4 CType(Parent, ContextMenu).Opacity = Settings.Get("UiLauncherTransparent") / 1000 + 0.4
End Sub End Sub
'基础 '基础
@@ -54,4 +54,7 @@
End If End If
End Sub End Sub
Private Sub MyMenuItem_Click(sender As Object, e As RoutedEventArgs) Handles Me.Click
RaiseCustomEvent()
End Sub
End Class End Class
@@ -21,7 +21,9 @@
ShapeLine.StrokeThickness = GetWPFSize(1) ShapeLine.StrokeThickness = GetWPFSize(1)
'添加选择控件 '添加选择控件
Btn1.IsEnabled = False Btn1.IsEnabled = False
For Each Selection As IMyRadio In Converter.Content For Each Content In Converter.Content
Content = MyVirtualizingElement.TryInit(Content)
Dim Selection As IMyRadio = Content
PanSelection.Children.Add(Selection) PanSelection.Children.Add(Selection)
AddHandler Selection.Check, AddressOf OnChecked AddHandler Selection.Check, AddressOf OnChecked
If TypeOf Selection Is MyListItem Then If TypeOf Selection Is MyListItem Then
@@ -3,15 +3,15 @@
Private Uuid As Integer = GetUuid() Private Uuid As Integer = GetUuid()
'执行逐个进入动画的控件 '执行逐个进入动画的控件
Public Property AnimatedControl As FrameworkElement Public Property AnimatedControl As String '需要在 Loaded 之后才能获取到控件,所以不能用 Binding 直接绑定(#6664)
Get Get
Return GetValue(AnimatedControlProperty) Return GetValue(AnimatedControlProperty)
End Get End Get
Set(value As FrameworkElement) Set(value As String)
SetValue(AnimatedControlProperty, value) SetValue(AnimatedControlProperty, value)
End Set End Set
End Property End Property
Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.Register("AnimatedControl", GetType(FrameworkElement), GetType(MyPageLeft), New PropertyMetadata(Nothing)) Public Shared ReadOnly AnimatedControlProperty As DependencyProperty = DependencyProperty.Register("AnimatedControl", GetType(String), GetType(MyPageLeft), New PropertyMetadata(Nothing))
Public Sub TriggerShowAnimation() Public Sub TriggerShowAnimation()
If AnimatedControl Is Nothing Then If AnimatedControl Is Nothing Then
@@ -30,6 +30,7 @@
Dim AniList As New List(Of AniData) Dim AniList As New List(Of AniData)
Dim Id As Integer = 0, Delay As Integer = 0 Dim Id As Integer = 0, Delay As Integer = 0
For Each Element As FrameworkElement In GetAllAnimControls(True) For Each Element As FrameworkElement In GetAllAnimControls(True)
Element = MyVirtualizingElement.TryInit(Element)
If Element.Visibility = Visibility.Collapsed Then If Element.Visibility = Visibility.Collapsed Then
'还原之前的隐藏动画可能导致的改变(#2436) '还原之前的隐藏动画可能导致的改变(#2436)
Element.Opacity = 1 Element.Opacity = 1
@@ -84,7 +85,7 @@
'遍历获取所有需要生成动画的控件 '遍历获取所有需要生成动画的控件
Private Function GetAllAnimControls(Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement) Private Function GetAllAnimControls(Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement)
Dim AllControls As New List(Of FrameworkElement) Dim AllControls As New List(Of FrameworkElement)
GetAllAnimControls(AnimatedControl, AllControls, IgnoreInvisibility) GetAllAnimControls(FindName(AnimatedControl), AllControls, IgnoreInvisibility)
Return AllControls Return AllControls
End Function End Function
Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean) Private Sub GetAllAnimControls(Element As FrameworkElement, ByRef AllControls As List(Of FrameworkElement), IgnoreInvisibility As Boolean)
@@ -105,7 +106,3 @@
End Sub End Sub
End Class End Class
Public Interface IRefreshable
Sub Refresh()
End Interface
+19 -14
View File
@@ -3,16 +3,16 @@
Public PageUuid As Integer = GetUuid() Public PageUuid As Integer = GetUuid()
'“返回顶部” 按钮检测的滚动区域 '“返回顶部” 按钮检测的滚动区域
Public Property PanScroll As MyScrollViewer Public Property PanScroll As String '需要在 Loaded 之后才能获取到控件,所以不能用 Binding 直接绑定(#6664)
Get Get
Return GetValue(PanScrollProperty) Return GetValue(PanScrollProperty)
End Get End Get
Set(value As MyScrollViewer) Set(value As String)
SetValue(PanScrollProperty, value) SetValue(PanScrollProperty, value)
End Set End Set
End Property End Property
Private Shared ReadOnly PanScrollProperty = Private Shared ReadOnly PanScrollProperty =
DependencyProperty.Register("PanScroll", GetType(MyScrollViewer), GetType(MyPageRight), New PropertyMetadata(Nothing)) DependencyProperty.Register("PanScroll", GetType(String), GetType(MyPageRight), New PropertyMetadata(Nothing))
'当前状态 '当前状态
Public Enum PageStates Public Enum PageStates
@@ -129,30 +129,31 @@
RaiseEvent PageEnter() RaiseEvent PageEnter()
Select Case PageState Select Case PageState
Case PageStates.Empty Case PageStates.Empty
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Aborted Then If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Interrupted Then
'如果加载器在进入页面时不启动(例如 HiPer 联机),那么在此时就会有 State = Waiting '如果加载器在进入页面时不启动(例如联机),那么在此时就会有 State = Waiting
PageState = PageStates.ContentEnter PageState = PageStates.ContentEnter
TriggerEnterAnimation(PanAlways, If(PanContent, Child)) TriggerEnterAnimation(PanAlways, If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then ElseIf PageLoader.State = LoadState.Loading Then
PageState = PageStates.LoaderWait PageState = PageStates.LoaderWait
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid) AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
Else 'PageLoader.State = LoadState.Failed Else 'PageLoader.State = LoadState.Failed
PageState = PageStates.LoaderEnter PageState = PageStates.LoaderEnter
TriggerEnterAnimation(PanAlways, PanLoader) TriggerEnterAnimation(PanAlways, PanLoader)
End If End If
Case PageStates.ContentExit Case PageStates.ContentExit
'和上面的一样,但是不管 PanAlways '和上面的一样,但是不管 PanAlways
If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Aborted Then If PageLoader Is Nothing OrElse PageLoader.State = LoadState.Finished OrElse PageLoader.State = LoadState.Waiting OrElse PageLoader.State = LoadState.Interrupted Then
PageState = PageStates.ContentEnter PageState = PageStates.ContentEnter
TriggerEnterAnimation(If(PanContent, Child)) TriggerEnterAnimation(If(PanContent, Child))
ElseIf PageLoader.State = LoadState.Loading Then ElseIf PageLoader.State = LoadState.Loading Then
PageState = PageStates.LoaderWait PageState = PageStates.LoaderWait
AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 200), "PageRight PageChange " & PageUuid) AniStart(AaCode(AddressOf PageOnLoaderWaitFinished, 400), "PageRight PageChange " & PageUuid)
Else 'PageLoader.State = LoadState.Failed Else 'PageLoader.State = LoadState.Failed
PageState = PageStates.LoaderEnter PageState = PageStates.LoaderEnter
TriggerEnterAnimation(PanLoader) TriggerEnterAnimation(PanLoader)
End If End If
Case PageStates.ContentEnter '重复调用 PageOnEnter,直接忽略 Case PageStates.ContentEnter
'重复调用 PageOnEnter,直接忽略
Case Else Case Else
Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnter 事件。") Throw New Exception("在状态为 " & GetStringFromEnum(PageState) & " 时触发了 PageOnEnter 事件。")
End Select End Select
@@ -207,8 +208,8 @@
Public Sub PageOnContentExit() Public Sub PageOnContentExit()
If ModeDebug Then Log("[UI] 已触发 PageOnContentExit") If ModeDebug Then Log("[UI] 已触发 PageOnContentExit")
If PageLoader IsNot Nothing AndAlso PageLoader.State = LoadState.Loading Then If PageLoader IsNot Nothing AndAlso PageLoader.State = LoadState.Loading Then
Throw New Exception("在调用 PageOnContentExit 时,加载器不能为 Loading 状态")
'Loading 的加载器可能触发进一步变化,难以预测会触发子页面的动画还是加载器完成的动画 'Loading 的加载器可能触发进一步变化,难以预测会触发子页面的动画还是加载器完成的动画
Throw New Exception("在调用 PageOnContentExit 时,加载器不能为 Loading 状态")
End If End If
Select Case PageState Select Case PageState
Case PageStates.ContentEnter, PageStates.ContentStay Case PageStates.ContentEnter, PageStates.ContentStay
@@ -219,8 +220,12 @@
Case PageStates.LoaderEnter, PageStates.LoaderStayForce, PageStates.LoaderStay Case PageStates.LoaderEnter, PageStates.LoaderStayForce, PageStates.LoaderStay
PageState = PageStates.ContentExit PageState = PageStates.ContentExit
TriggerExitAnimation(PanLoader) TriggerExitAnimation(PanLoader)
Case PageStates.LoaderWait, PageStates.Empty Case PageStates.LoaderWait
PageOnEnter() PageOnEnter()
Case PageStates.Empty
'可能是在离开页面后,其他后台线程调用了本函数,此时不应触发 PageOnEnter()
'例如:在加入联机房间后,切换到其他页面,然后联机房间被解散
If IsLoaded Then PageOnEnter()
End Select End Select
End Sub End Sub
@@ -313,9 +318,9 @@
Case PageStates.LoaderExit Case PageStates.LoaderExit
PageState = PageStates.ContentExit PageState = PageStates.ContentExit
End Select End Select
Case LoadState.Finished, LoadState.Aborted, LoadState.Waiting Case LoadState.Finished, LoadState.Interrupted, LoadState.Waiting
If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return If Not (OldState = LoadState.Failed OrElse OldState = LoadState.Loading) Then Return
If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Abort)") If ModeDebug Then Log("[UI] 已触发 PageLoaderState (Stop/Interrupt)")
'运行结束 '运行结束
'需要从 LoaderWait 切换到 ContentEnter,或从 LoaderStay 切换到 LoaderExit '需要从 LoaderWait 切换到 ContentEnter,或从 LoaderStay 切换到 LoaderExit
Select Case PageState Select Case PageState
@@ -373,7 +378,7 @@
End If End If
'结束 '结束
AniList.Add(AaCode(Sub() PageOnEnterAnimationFinished(),, True)) AniList.Add(AaCode(Sub() PageOnEnterAnimationFinished(),, True))
AniStart(AniList, "PageRight PageChange " & PageUuid) AniStart(AniList, "PageRight PageChange " & PageUuid, True)
End Sub End Sub
'逐个退出动画 '逐个退出动画
@@ -2,7 +2,7 @@
<ContentProperty("Inlines")> <ContentProperty("Inlines")>
Public Class MyRadioBox Public Class MyRadioBox
Implements IMyRadio Implements IMyRadio, ISettingControl
'基础 '基础
@@ -89,14 +89,15 @@ Public Class MyRadioBox
End If End If
End Select End Select
'触发事件
If IsChanged Then If IsChanged Then
'触发事件
If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user)) If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
RaiseEvent Changed(Me, New RouteEventArgs(user)) RaiseEvent Changed(Me, New RouteEventArgs(user))
End If RaiseCustomEvent()
'更改动画 '更改动画
SyncUI() SyncUI()
End If
Catch ex As Exception Catch ex As Exception
Log(ex, "单选框勾选改变错误", LogLevel.Hint) Log(ex, "单选框勾选改变错误", LogLevel.Hint)
End Try End Try
@@ -115,7 +116,7 @@ Public Class MyRadioBox
AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6) AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6)
}, "MyRadioBox Dot " & Uuid) }, "MyRadioBox Dot " & Uuid)
AniStart({ AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray4")), AnimationTimeOfCheck) AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray5")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid) }, "MyRadioBox BorderColor " & Uuid)
Else Else
'由有变无 '由有变无
@@ -127,7 +128,7 @@ Public Class MyRadioBox
AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2) AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2)
}, "MyRadioBox Dot " & Uuid) }, "MyRadioBox Dot " & Uuid)
AniStart({ AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray4")), AnimationTimeOfCheck) AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray5")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid) }, "MyRadioBox BorderColor " & Uuid)
End If End If
Else Else
@@ -140,13 +141,13 @@ Public Class MyRadioBox
ShapeDot.Height = 9 ShapeDot.Height = 9
ShapeDot.Opacity = 1 ShapeDot.Opacity = 1
ShapeDot.Margin = New Thickness(5.5, 0, 0, 0) ShapeDot.Margin = New Thickness(5.5, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4")) ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray5"))
Else Else
ShapeDot.Width = 0 ShapeDot.Width = 0
ShapeDot.Height = 0 ShapeDot.Height = 0
ShapeDot.Opacity = 0 ShapeDot.Opacity = 0
ShapeDot.Margin = New Thickness(10, 0, 0, 0) ShapeDot.Margin = New Thickness(10, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4")) ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
End If End If
End If End If
End Sub End Sub
@@ -208,15 +209,15 @@ Public Class MyRadioBox
Radiobox_MouseLeaveAnimation() Radiobox_MouseLeaveAnimation()
Else Else
'不可用 '不可用
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, ColorGray4 - ShapeBorder.Stroke, AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid) AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, ColorGray5 - ShapeBorder.Stroke, AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, ColorGray4 - LabText.Foreground, AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid) AniStart(AaColor(LabText, TextBlock.ForegroundProperty, ColorGray5 - LabText.Foreground, AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
End If End If
Else Else
'无动画 '无动画
AniStop("MyRadioBox BorderColor " & Uuid) AniStop("MyRadioBox BorderColor " & Uuid)
AniStop("MyRadioBox TextColor " & Uuid) AniStop("MyRadioBox TextColor " & Uuid)
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray4")) LabText.SetResourceReference(TextBlock.ForegroundProperty, If(Me.IsEnabled, "ColorBrush1", "ColorBrushGray5"))
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4")) ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(Me.IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
End If End If
End Sub End Sub
Private Sub Radiobox_MouseEnterAnimation() Handles Me.MouseEnter Private Sub Radiobox_MouseEnterAnimation() Handles Me.MouseEnter
@@ -226,14 +227,30 @@ Public Class MyRadioBox
Private Sub Radiobox_MouseLeaveAnimation() Handles Me.MouseLeave Private Sub Radiobox_MouseLeaveAnimation() Handles Me.MouseLeave
If Not Me.IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误 If Not Me.IsEnabled Then Return 'MouseLeave 比 IsEnabledChanged 后执行,所以如果自定义事件修改了 IsEnabled,将导致显示错误
If IsLoaded AndAlso AniControlEnabled = 0 Then If IsLoaded AndAlso AniControlEnabled = 0 Then
AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid) AniStart(AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"), AnimationTimeOfMouseOut), "MyRadioBox BorderColor " & Uuid)
AniStart(AaColor(LabText, TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"), AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid) AniStart(AaColor(LabText, TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"), AnimationTimeOfMouseOut), "MyRadioBox TextColor " & Uuid)
Else Else
AniStop("MyRadioBox BorderColor " & Uuid) AniStop("MyRadioBox BorderColor " & Uuid)
AniStop("MyRadioBox TextColor " & Uuid) AniStop("MyRadioBox TextColor " & Uuid)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray4")) ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, If(Checked, "ColorBrush2", "ColorBrush1"), "ColorBrushGray5"))
LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4")) LabText.SetResourceReference(TextBlock.ForegroundProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray5"))
End If End If
End Sub End Sub
#Region "设置"
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
Checked = NewValue = SettingService.GetValue(Me)
End Sub
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
Return If(Checked, SettingService.GetValue(Me), Nothing)
End Function
Private Sub SaveSetting() Handles Me.Check
SettingService.SaveSetting(Me)
End Sub
#End Region
End Class End Class
@@ -7,10 +7,6 @@ Public Class MyRadioButton
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
Public Event Check(sender As Object, raiseByMouse As Boolean) Public Event Check(sender As Object, raiseByMouse As Boolean)
Public Event Change(sender As Object, raiseByMouse As Boolean)
Public Sub RaiseChange()
RaiseEvent Change(Me, False)
End Sub '使外部程序可以引发本控件的 Change 事件
'自定义属性 '自定义属性
@@ -46,23 +42,22 @@ Public Class MyRadioButton
''' 手动设置 Checked 属性。 ''' 手动设置 Checked 属性。
''' </summary> ''' </summary>
''' <param name="value">新的 Checked 属性。</param> ''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param> ''' <param name="raiseByMouse">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param> ''' <param name="anime">是否执行动画。</param>
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean) Public Sub SetChecked(value As Boolean, raiseByMouse As Boolean, anime As Boolean)
Try Try
'自定义属性基础 '自定义属性基础
Dim IsChanged As Boolean = False Dim IsChanged As Boolean = False
If IsLoaded AndAlso Not value = _Checked Then RaiseEvent Change(Me, user) If _Checked <> value Then
If Not value = _Checked Then
_Checked = value _Checked = value
IsChanged = True IsChanged = True
End If End If
'保证只有一个单选框选中 '保证只有一个单选框选中
If IsNothing(Parent) Then Return If Parent Is Nothing Then Return
Dim RadioboxList As New List(Of MyRadioButton) Dim RadioboxList As New List(Of MyRadioButton)
Dim CheckedCount As Integer = 0 Dim CheckedCount As Integer = 0
'收集控件列表与选中个数 '收集控件列表与选中个数
@@ -105,7 +100,8 @@ Public Class MyRadioButton
RefreshColor(Nothing, anime) RefreshColor(Nothing, anime)
'触发事件 '触发事件
If Checked Then RaiseEvent Check(Me, user) If Checked Then RaiseEvent Check(Me, raiseByMouse)
RaiseCustomEvent()
Catch ex As Exception Catch ex As Exception
Log(ex, "单选按钮勾选改变错误", LogLevel.Hint) Log(ex, "单选按钮勾选改变错误", LogLevel.Hint)
@@ -39,4 +39,7 @@
TextBox.Focus() TextBox.Focus()
End Sub End Sub
Private Sub MySearchBox_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
If e.Key = Key.Enter Then RaiseCustomEvent()
End Sub
End Class End Class
@@ -1,4 +1,5 @@
Public Class MySlider Public Class MySlider
Implements ISettingControl
'基础 '基础
@@ -188,4 +189,20 @@
End If End If
End Sub End Sub
#Region "设置"
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
Value = Val(NewValue)
End Sub
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
Return Value
End Function
Private Sub SaveSetting() Handles Me.Change
SettingService.SaveSetting(Me)
End Sub
#End Region
End Class End Class
+30 -2
View File
@@ -1,5 +1,6 @@
Public Class MyTextBox Public Class MyTextBox
Inherits TextBox Inherits TextBox
Implements ISettingControl
'自定义属性 '自定义属性
@@ -44,7 +45,13 @@
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
Public Shared Event ValidateChanged(sender As Object, e As EventArgs) Public Shared Event ValidateChanged(sender As Object, e As EventArgs)
Public ChangedEventList As New List(Of RoutedEventHandler) Private _ChangedEventList As List(Of RoutedEventHandler)
Public ReadOnly Property ChangedEventList As List(Of RoutedEventHandler)
Get
If _ChangedEventList Is Nothing Then _ChangedEventList = New List(Of RoutedEventHandler)
Return _ChangedEventList
End Get
End Property
Public Custom Event ValidatedTextChanged As RoutedEventHandler Public Custom Event ValidatedTextChanged As RoutedEventHandler
AddHandler(value As RoutedEventHandler) AddHandler(value As RoutedEventHandler)
ChangedEventList.Add(value) ChangedEventList.Add(value)
@@ -264,7 +271,7 @@
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画 '有动画
AniStart({ AniStart({
AaColor(Me, BorderBrushProperty, ForeColorName, AnimationTime), AaColor(Me, BorderBrushProperty, ForeColorName, AnimationTime),
AaColor(Me, BackgroundProperty, BackColorName, AnimationTime) AaColor(Me, BackgroundProperty, BackColorName, AnimationTime)
}, "MyTextBox Color " & Uuid) }, "MyTextBox Color " & Uuid)
Else Else
@@ -291,4 +298,25 @@
End If End If
End Sub End Sub
'在按下回车时触发自定义事件
Private Sub MyTextBox_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
If e.Key = Key.Enter Then RaiseCustomEvent()
End Sub
#Region "设置"
Private Sub RefreshSetting(NewValue As String) Implements ISettingControl.RefreshSetting
Text = NewValue
End Sub
Private Function GetCurrentSetting() As String Implements ISettingControl.GetCurrentSetting
Return Text
End Function
Private Sub SaveSetting() Handles Me.ValidatedTextChanged
SettingService.SaveSetting(Me)
End Sub
#End Region
End Class End Class
@@ -22,14 +22,14 @@
End Set End Set
End Property End Property
Public Shared ReadOnly TextProperty As DependencyProperty = Public Shared ReadOnly TextProperty As DependencyProperty =
DependencyProperty.Register("Text", GetType(String), GetType(MyTextButton), New PropertyMetadata("", Sub(sender As MyTextButton, e As DependencyPropertyChangedEventArgs) DependencyProperty.Register("Text", GetType(String), GetType(MyTextButton), New PropertyMetadata("",
If Not e.OldValue = e.NewValue Then Sub(sender As MyTextButton, e As DependencyPropertyChangedEventArgs)
If e.OldValue = e.NewValue Then Return
AniStart({ AniStart({
AaOpacity(sender, -sender.Opacity, 50), AaOpacity(sender, -sender.Opacity, 50),
AaCode(Sub() sender.Content = e.NewValue,, True), AaCode(Sub() sender.Content = e.NewValue,, True),
AaOpacity(sender, 1, 170) AaOpacity(sender, 1, 170)
}, "MyTextButton Text " & sender.Uuid) }, "MyTextButton Text " & sender.Uuid)
End If
End Sub)) End Sub))
'鼠标事件 '鼠标事件
@@ -43,13 +43,12 @@
IsMouseDown = False IsMouseDown = False
End Sub End Sub
Private Sub MyTextButton_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp Private Sub MyTextButton_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.PreviewMouseLeftButtonUp
If IsMouseDown Then If Not IsMouseDown Then Return
IsMouseDown = False IsMouseDown = False
Log("[Control] 按下文本按钮:" & Text) Log("[Control] 按下文本按钮:" & Text)
RaiseEvent Click(Me, Nothing) RaiseEvent Click(Me, Nothing)
ModEvent.TryStartEvent(EventType, EventData) RaiseCustomEvent()
e.Handled = True e.Handled = True
End If
End Sub End Sub
'指向动画 '指向动画
@@ -57,7 +56,7 @@
Private Const AnimationTimeIn As Integer = 100 Private Const AnimationTimeIn As Integer = 100
Private Const AnimationTimeOut As Integer = 200 Private Const AnimationTimeOut As Integer = 200
Private ColorName As String Private ColorName As String
Private Sub RefreshColor() Handles Me.MouseEnter, Me.MouseLeave, Me.IsEnabledChanged, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp Private Sub RefreshColor() Handles Me.MouseEnter, Me.MouseLeave, Me.IsEnabledChanged, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp
'判断当前颜色 '判断当前颜色
Dim ForeName As String Dim ForeName As String
Dim Time As Integer Dim Time As Integer
@@ -85,26 +84,4 @@
End If End If
End Sub End Sub
'实现自定义事件
Public Property EventType As String
Get
Return GetValue(EventTypeProperty)
End Get
Set(value As String)
SetValue(EventTypeProperty, value)
End Set
End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register(
"EventType", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
Public Property EventData As String
Get
Return GetValue(EventDataProperty)
End Get
Set(value As String)
SetValue(EventDataProperty, value)
End Set
End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register(
"EventData", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
End Class End Class
@@ -0,0 +1,70 @@
Public Class MyVirtualizingElement(Of T As FrameworkElement)
Inherits FrameworkElement
Private Initializer As Func(Of T)
Public Sub New(Initializer As Func(Of T))
Me.Initializer = Initializer
LazyLoadBehavior.OnFirstEnterScrollViewerViewport(Me, AddressOf Init)
End Sub
''' <summary>
''' 实例化此控件。
''' </summary>
Public Function Init() As T
Dim Element As T = Initializer()
If Parent IsNot Nothing Then
If TypeOf Parent IsNot Panel Then Throw New Exception("MyVirtualizingElement 的父级必须是一个 Panel")
Dim ParentPanel As Panel = Parent
Dim CurrentIndex As Integer = ParentPanel.Children.IndexOf(Me)
ParentPanel.Children.RemoveAt(CurrentIndex)
ParentPanel.Children.Insert(CurrentIndex, Element)
End If
Return Element
End Function
Public Shared Widening Operator CType(Virtualized As MyVirtualizingElement(Of T)) As T
Return Virtualized.Init()
End Operator
End Class
'非泛型形式
Public Class MyVirtualizingElement
Inherits FrameworkElement
Private Initializer As Func(Of FrameworkElement)
Public Sub New(Initializer As Func(Of FrameworkElement))
Me.Initializer = Initializer
LazyLoadBehavior.OnFirstEnterScrollViewerViewport(Me, AddressOf Init)
End Sub
''' <summary>
''' 实例化此控件。
''' </summary>
Public Function Init() As FrameworkElement
Dim Element As FrameworkElement = Initializer()
If Parent IsNot Nothing Then
If TypeOf Parent IsNot Panel Then Throw New Exception("MyVirtualizingElement 的父级必须是一个 Panel")
Dim ParentPanel As Panel = Parent
Dim CurrentIndex As Integer = ParentPanel.Children.IndexOf(Me)
ParentPanel.Children.RemoveAt(CurrentIndex)
ParentPanel.Children.Insert(CurrentIndex, Element)
End If
Return Element
End Function
''' <summary>
''' 获取实例化后的控件。
''' 如果该控件没有实例化,则会立即实例化。
''' 如果类型错误,则返回原值。
''' </summary>
Public Shared Function TryInit(Element As FrameworkElement) As FrameworkElement
If GetType(MyVirtualizingElement(Of )).IsInstanceOfGenericType(Element) Then
Return CType(Element, Object).Init()
ElseIf TypeOf Element Is MyVirtualizingElement Then
Return CType(Element, MyVirtualizingElement).Init()
Else
Return Element
End If
End Function
End Class
+2 -1
View File
@@ -95,7 +95,8 @@
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
<RowDefinition /> <RowDefinition />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<Canvas x:Name="ImgBack" IsHitTestVisible="False" Grid.Row="1" RenderOptions.BitmapScalingMode="LowQuality" /> <Canvas x:Name="ImgBack" IsHitTestVisible="False" Grid.Row="1" RenderOptions.BitmapScalingMode="LowQuality"
HorizontalAlignment="Stretch" VerticalAlignment="Stretch" />
<Grid x:Name="PanTitle" Height="48"> <Grid x:Name="PanTitle" Height="48">
<Grid.Background> <Grid.Background>
<LinearGradientBrush EndPoint="1,0" StartPoint="0,0"> <LinearGradientBrush EndPoint="1,0" StartPoint="0,0">
File diff suppressed because it is too large Load Diff
Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 KiB

@@ -8,7 +8,12 @@ Public Module ModAnimation
''' <summary> ''' <summary>
''' 动画速度。最大为 200。 ''' 动画速度。最大为 200。
''' </summary> ''' </summary>
Public AniSpeed As Double = 1 Public ReadOnly Property AniSpeed As Double
Get
Dim Setting = PCL.Settings.Get("SystemDebugAnim")
Return If(Setting >= 30, 200, MathClamp(Setting * 0.1 + 0.1, 0.1, 3))
End Get
End Property
''' <summary> ''' <summary>
''' 动画组列表。 ''' 动画组列表。
''' </summary> ''' </summary>
@@ -467,7 +472,7 @@ Public Module ModAnimation
''' 按照 WPF 方式旋转控件的动画。 ''' 按照 WPF 方式旋转控件的动画。
''' </summary> ''' </summary>
''' <param name="Obj">动画的对象。它必须已经拥有了单一的 ScaleTransform 值。</param> ''' <param name="Obj">动画的对象。它必须已经拥有了单一的 ScaleTransform 值。</param>
''' <param name="Value">大小改变的百分比(如-0.6)。</param> ''' <param name="Value">旋转角度(度)。</param>
''' <param name="Time">动画长度(毫秒)。</param> ''' <param name="Time">动画长度(毫秒)。</param>
''' <param name="Delay">动画延迟执行的时间(毫秒)。</param> ''' <param name="Delay">动画延迟执行的时间(毫秒)。</param>
''' <param name="Ease">插值器类型。</param> ''' <param name="Ease">插值器类型。</param>
@@ -743,9 +748,9 @@ Public Module ModAnimation
''' <param name="AniGroup">由 Aa 开头的函数初始化的 AniData 对象集合。</param> ''' <param name="AniGroup">由 Aa 开头的函数初始化的 AniData 对象集合。</param>
''' <param name="Name">动画组的名称。如果重复会直接停止同名动画组。</param> ''' <param name="Name">动画组的名称。如果重复会直接停止同名动画组。</param>
Public Sub AniStart(AniGroup As IList, Optional Name As String = "", Optional RefreshTime As Boolean = False) Public Sub AniStart(AniGroup As IList, Optional Name As String = "", Optional RefreshTime As Boolean = False)
If RefreshTime Then AniLastTick = GetTimeTick() '避免处理动画时已经造成了极大的延迟,导致动画突然结束 If RefreshTime Then AniLastTick = GetTimeMs() '避免处理动画时已经造成了极大的延迟,导致动画突然结束
'添加到正在执行的动画组 '添加到正在执行的动画组
Dim NewEntry As New AniGroupEntry With {.Data = GetFullList(Of AniData)(AniGroup), .StartTick = GetTimeTick()} Dim NewEntry As New AniGroupEntry With {.Data = GetFullList(Of AniData)(AniGroup), .StartTick = GetTimeMs()}
If Name = "" Then If Name = "" Then
Name = NewEntry.Uuid Name = NewEntry.Uuid
Else Else
@@ -788,18 +793,19 @@ Public Module ModAnimation
''' </summary> ''' </summary>
Public Sub AniStart() Public Sub AniStart()
'初始化计时器 '初始化计时器
AniLastTick = GetTimeTick() AniLastTick = GetTimeMs()
AniFPSTimer = AniLastTick AniFPSTimer = AniLastTick
AniRunning = True '标记动画执行开始 AniRunning = True '标记动画执行开始
RunInNewThread(Sub() RunInNewThread(
Sub()
Try Try
Log("[Animation] 动画线程开始") Log("[Animation] 动画线程开始")
Do While True Do While True
'两帧之间的间隔时间 '两帧之间的间隔时间
Dim DeltaTime As Long = MathClamp(GetTimeTick() - AniLastTick, 0, 100000) Dim DeltaTime As Long = MathClamp(GetTimeMs() - AniLastTick, 0, 100000)
If DeltaTime < 3 Then GoTo Sleeper If DeltaTime < 3 Then GoTo Sleeper
AniLastTick = GetTimeTick() AniLastTick = GetTimeMs()
'记录 FPS '记录 FPS
If ModeDebug Then If ModeDebug Then
If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then If MathClamp(AniLastTick - AniFPSTimer, 0, 100000) >= 500 Then
@@ -810,7 +816,8 @@ Public Module ModAnimation
AniFPSCounter += 2 AniFPSCounter += 2
End If End If
'执行动画 '执行动画
RunInUiWait(Sub() RunInUiWait(
Sub()
AniCount = 0 AniCount = 0
AniTimer(DeltaTime * AniSpeed) AniTimer(DeltaTime * AniSpeed)
'#If DEBUG Then '#If DEBUG Then
@@ -838,7 +845,7 @@ Sleeper:
Public Sub AniTimer(DeltaTick As Integer) Public Sub AniTimer(DeltaTick As Integer)
Try Try
If DeltaTick / AniSpeed > 200 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", LogLevel.Developer) If DeltaTick / AniSpeed > 100 Then Log("[Animation] 两个动画帧间隔 " & DeltaTick & " ms", LogLevel.Developer)
Dim i As Integer = -1 Dim i As Integer = -1
'循环每个动画组 '循环每个动画组
Do While i + 1 < AniGroups.Count Do While i + 1 < AniGroups.Count
@@ -996,7 +1003,7 @@ NextAni:
Case AniType.ScaleTransform Case AniType.ScaleTransform
Dim Obj As FrameworkElement = Ani.Obj Dim Obj As FrameworkElement = Ani.Obj
If TypeOf Obj.RenderTransform IsNot ScaleTransform Then If TypeOf Obj.RenderTransform IsNot ScaleTransform Then
Obj.RenderTransformOrigin = New Point(0.5, 0.5) If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
Obj.RenderTransform = New ScaleTransform(1, 1) Obj.RenderTransform = New ScaleTransform(1, 1)
End If End If
Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
@@ -1006,7 +1013,7 @@ NextAni:
Case AniType.RotateTransform Case AniType.RotateTransform
Dim Obj As FrameworkElement = Ani.Obj Dim Obj As FrameworkElement = Ani.Obj
If TypeOf Obj.RenderTransform IsNot RotateTransform Then If TypeOf Obj.RenderTransform IsNot RotateTransform Then
Obj.RenderTransformOrigin = New Point(0.5, 0.5) If Obj.RenderTransformOrigin = New Point(0, 0) Then Obj.RenderTransformOrigin = New Point(0.5, 0.5)
Obj.RenderTransform = New RotateTransform(0) Obj.RenderTransform = New RotateTransform(0)
End If End If
Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent)) Dim Delta As Double = MathPercent(0, Ani.Value, Ani.Ease.GetDelta(Ani.TimeFinished / Ani.TimeTotal, Ani.TimePercent))
File diff suppressed because it is too large Load Diff
@@ -8,6 +8,7 @@
Implements ILoadingTrigger Implements ILoadingTrigger
Public ReadOnly Property IsLoader As Boolean = True Implements ILoadingTrigger.IsLoader Public ReadOnly Property IsLoader As Boolean = True Implements ILoadingTrigger.IsLoader
Protected Shared LogBlackList As String() = {"EasyTier CLI"}
'基础属性 '基础属性
''' <summary> ''' <summary>
@@ -87,9 +88,9 @@
Set(value As LoadState) Set(value As LoadState)
If _State = value Then Return If _State = value Then Return
Dim OldState = _State Dim OldState = _State
If value = LoadState.Finished AndAlso Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000)) If value = LoadState.Finished AndAlso Settings.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
_State = value _State = value
Log("[Loader] 加载器 " & Name & " 状态改变:" & GetStringFromEnum(value)) If Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载器 {Name} 状态改变:{GetStringFromEnum(value)}")
'实现 ILoadingTrigger 接口与 OnStateChanged 回调 '实现 ILoadingTrigger 接口与 OnStateChanged 回调
RunInUi( RunInUi(
Sub() Sub()
@@ -148,7 +149,7 @@
Case LoadState.Waiting Case LoadState.Waiting
Return 0 Return 0
Case LoadState.Loading Case LoadState.Loading
Return If(_Progress = -1, 0.02, _Progress) Return If(_Progress = -1, 0, _Progress)
Case Else Case Else
Return 1 Return 1
End Select End Select
@@ -169,7 +170,8 @@
'状态变化 '状态变化
Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) Public MustOverride Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
Public MustOverride Sub Abort() Public MustOverride Sub Interrupt()
Public MustOverride Sub Failed(Ex As Exception)
'等待结束 '等待结束
Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。" Public Const WaitForExitTimeoutMessage As String = "等待加载器执行超时。"
@@ -185,7 +187,7 @@
Loop Loop
If State = LoadState.Finished Then If State = LoadState.Finished Then
Return Return
ElseIf State = LoadState.Aborted Then ElseIf State = LoadState.Interrupted Then
Throw New ThreadInterruptedException("加载器执行已中断。") Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf IsNothing([Error]) Then ElseIf IsNothing([Error]) Then
Throw New Exception("未知错误!") Throw New Exception("未知错误!")
@@ -208,7 +210,7 @@
Loop Loop
If State = LoadState.Finished Then If State = LoadState.Finished Then
Return Return
ElseIf State = LoadState.Aborted Then ElseIf State = LoadState.Interrupted Then
Throw New ThreadInterruptedException("加载器执行已中断。") Throw New ThreadInterruptedException("加载器执行已中断。")
ElseIf IsNothing([Error]) Then ElseIf IsNothing([Error]) Then
Throw New Exception("未知错误!") Throw New Exception("未知错误!")
@@ -239,16 +241,16 @@
''' <summary> ''' <summary>
''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断,不可跨线程调用。 ''' 当前执行线程是否应当中断。只应用在加载器的工作线程中判断,不可跨线程调用。
''' </summary> ''' </summary>
Public ReadOnly Property IsAborted As Boolean Public ReadOnly Property IsInterrupted As Boolean
Get Get
Return IsAbortedWithThread(Thread.CurrentThread) Return IsInterruptedWithThread(Thread.CurrentThread)
End Get End Get
End Property End Property
''' <summary> ''' <summary>
''' 当前执行线程是否应当中断。需要手动提供加载器线程,用于需要跨线程检查的情况。 ''' 当前执行线程是否应当中断。需要手动提供加载器线程,用于需要跨线程检查的情况。
''' </summary> ''' </summary>
Public Function IsAbortedWithThread(Thread As Thread) As Boolean Public Function IsInterruptedWithThread(Thread As Thread) As Boolean
Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Aborted Return LastRunningThread Is Nothing OrElse Not ReferenceEquals(Thread, LastRunningThread) OrElse State = LoadState.Interrupted
End Function End Function
''' <summary> ''' <summary>
''' 在输入相同时使用原有结果的超时,单位为毫秒。 ''' 在输入相同时使用原有结果的超时,单位为毫秒。
@@ -290,18 +292,20 @@
'检验输入以确定情况 '检验输入以确定情况
If IsForceRestart Then Return True '强制要求重启 If IsForceRestart Then Return True '强制要求重启
If ((Input Is Nothing) <> (Me.Input Is Nothing)) OrElse (Input IsNot Nothing AndAlso Not Input.Equals(Me.Input)) Then Return True '输入不同 If ((Input Is Nothing) <> (Me.Input Is Nothing)) OrElse (Input IsNot Nothing AndAlso Not Input.Equals(Me.Input)) Then Return True '输入不同
If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时 If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束…
Return False '则不重试 (IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse
LastFinishedTime = 0 OrElse GetTimeMs() - LastFinishedTime < ReloadTimeout) Then '…且没有超时…
Return False '…则不重试
Else Else
Return True '需要开始 Return True '否则需要重启
End If End If
End Function End Function
Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False) Public Overrides Sub Start(Optional Input As Object = Nothing, Optional IsForceRestart As Boolean = False)
'确认是否开始加载 '确认是否开始加载
If ShouldStart(Input, IsForceRestart) Then If ShouldStart(Input, IsForceRestart) Then
'输入不同或失败,开始加载 '输入不同或失败,开始加载
If State = LoadState.Loading Then TriggerThreadAbort() If State = LoadState.Loading Then TriggerThreadInterrupt()
Me.Input = Input Me.Input = Input
SyncLock LockState SyncLock LockState
State = LoadState.Loading State = LoadState.Loading
@@ -315,44 +319,57 @@
Sub() Sub()
Try Try
IsForceRestarting = IsForceRestart IsForceRestarting = IsForceRestart
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动") If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
LoadDelegate(Me) LoadDelegate(Me)
If IsAborted Then If IsInterrupted Then
Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer) Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已中断但线程正常运行至结束,输出被弃用(最新线程:{If(LastRunningThread Is Nothing, -1, LastRunningThread.ManagedThreadId)})", LogLevel.Developer)
Return Return
End If End If
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成") If ModeDebug AndAlso Not LogBlackList.Contains(Name) Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已完成")
RaisePreviewFinish() RaisePreviewFinish()
State = LoadState.Finished State = LoadState.Finished
LastFinishedTime = GetTimeTick() '未中断,本次输出有效 LastFinishedTime = GetTimeMs() '未中断,本次输出有效
Catch ex As CancelledException Catch ex As CancelledException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断,已完成 {Math.Round(Progress * 100)}%") If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断,已完成 {Math.Round(Progress * 100)}%")
If Not IsAborted Then State = LoadState.Aborted If Not IsInterrupted Then State = LoadState.Interrupted
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断,已完成 {Math.Round(Progress * 100)}%") If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断,已完成 {Math.Round(Progress * 100)}%")
'如果线程是因为判断到 IsAborted 而提前中止,则代表已有新线程被重启,此时不应当改为 Aborted '如果线程是因为判断到 IsInterrupted 而提前中止,则代表已有新线程被重启,此时不应当改为 Interrupted
'如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Aborted '如果线程是在没有 IsInterrupted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Interrupted
If Not IsAborted Then State = LoadState.Aborted If Not IsInterrupted Then State = LoadState.Interrupted
Catch ex As Exception Catch ex As Exception
If IsAborted Then Return Failed(ex)
Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer) End Try
[Error] = ex End Sub) With {.Name = "L/" & Name, .Priority = ThreadPriority}
State = LoadState.Failed Try
LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsInterrupted
Catch ex As ThreadStateException '若遇到偶发的 “线程正在运行或被终止”,则等待后重试
Thread.Sleep(500)
LastRunningThread.Start()
End Try End Try
End Sub) With {.Name = Name, .Priority = ThreadPriority}
LastRunningThread.Start() '不能使用 RunInNewThread,否则在函数返回前线程就会运行完,导致误判 IsAborted
End Sub End Sub
Public Overrides Sub Abort() Public Overrides Sub Failed(ex As Exception)
If State <> LoadState.Loading Then Return [Error] = ex
SyncLock LockState SyncLock LockState
State = LoadState.Aborted If IsInterrupted OrElse State >= LoadState.Finished Then Return
State = LoadState.Failed
End SyncLock End SyncLock
TriggerThreadAbort() Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
TriggerThreadInterrupt()
End Sub End Sub
Private Sub TriggerThreadAbort() Public Overrides Sub Interrupt()
SyncLock LockState
If State <> LoadState.Loading Then Return
State = LoadState.Interrupted
End SyncLock
TriggerThreadInterrupt()
End Sub
Private Sub TriggerThreadInterrupt()
If LastRunningThread Is Nothing Then Return If LastRunningThread Is Nothing Then Return
If LastRunningThread.IsAlive Then
LastRunningThread.Interrupt()
If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断") If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
If LastRunningThread.IsAlive Then LastRunningThread.Interrupt() End If
LastRunningThread = Nothing LastRunningThread = Nothing
End Sub End Sub
@@ -434,11 +451,11 @@
End If End If
RunInThread(AddressOf Update) RunInThread(AddressOf Update)
End Sub End Sub
Public Overrides Sub Abort() Public Overrides Sub Interrupt()
'改变状态 '改变状态
SyncLock LockState SyncLock LockState
If State = LoadState.Loading OrElse State = LoadState.Waiting Then If State = LoadState.Loading OrElse State = LoadState.Waiting Then
State = LoadState.Aborted State = LoadState.Interrupted
Else Else
Return Return
End If End If
@@ -447,10 +464,21 @@
Sub() Sub()
'中断加载器 '中断加载器
For Each Loader In Loaders For Each Loader In Loaders
Loader.Abort() Loader.Interrupt()
Next Next
End Sub) End Sub)
End Sub End Sub
Public Overrides Sub Failed(Ex As Exception)
[Error] = Ex '先设置错误再调整状态,防止父加载器获取不到异常
SyncLock LockState
If State >= LoadState.Finished Then Return
State = LoadState.Failed
End SyncLock
For Each Loader In Loaders
Loader.Interrupt()
Next
FrmMain.BtnExtraDownload.ShowRefresh()
End Sub
''' <summary> ''' <summary>
''' 子任务状态变更。 ''' 子任务状态变更。
@@ -465,28 +493,19 @@
Case LoadState.Finished Case LoadState.Finished
'正常结束,触发刷新 '正常结束,触发刷新
Update() Update()
Case LoadState.Aborted Case LoadState.Interrupted
'被中断,这个任务也中断 '被中断,这个任务也中断
Abort() Interrupt()
Case Else Case LoadState.Failed
'完蛋,出错了 '完蛋,出错了
SyncLock LockState Failed(New Exception(Loader.Name & "失败", Loader.Error))
If State >= LoadState.Finished Then Return
[Error] = New Exception(Loader.Name & "失败", Loader.Error)
State = Loader.State
End SyncLock
For Each Loader In Loaders
Loader.Abort()
Next
FrmMain.BtnExtraDownload.ShowRefresh()
Return
End Select End Select
End Sub End Sub
''' <summary> ''' <summary>
''' 触发一次更新,以启动新加载器或完成。 ''' 触发一次更新,以启动新加载器或完成。
''' </summary> ''' </summary>
Private Sub Update() Private Sub Update()
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Return If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Interrupted Then Return
Dim IsFinished As Boolean = True Dim IsFinished As Boolean = True
Dim Blocked As Boolean = False Dim Blocked As Boolean = False
Dim Input As Object = Me.Input Dim Input As Object = Me.Input
@@ -588,7 +607,7 @@ Restart:
'若单个任务已中止,或全部任务已完成,则刷新并移除 '若单个任务已中止,或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar For Each Task In LoaderTaskbar
If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse If LoaderTaskbar.All(Function(l) l.State <> LoadState.Loading) OrElse
(Task.State = LoadState.Waiting OrElse Task.State = LoadState.Aborted) Then (Task.State = LoadState.Waiting OrElse Task.State = LoadState.Interrupted) Then
FrmSpeedLeft?.TaskRefresh(Task) FrmSpeedLeft?.TaskRefresh(Task)
LoaderTaskbar.Remove(Task) LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表") Log($"[Taskbar] {Task.Name} 已移出任务列表")
File diff suppressed because it is too large Load Diff
@@ -114,10 +114,10 @@ Public Class ValidateInteger
End Sub End Sub
Public Overrides Function Validate(Str As String) As String Public Overrides Function Validate(Str As String) As String
If Str.Length > 9 Then Return "请输入一个大小合理的数字!" If Str.Length > 9 Then Return "请输入一个大小合理的数字!"
Dim Valed As Integer = Val(Str) Dim Valed As Integer
If Valed.ToString <> Str Then Return "请输入一个整数!" If Not Integer.TryParse(Str, Valed) Then Return "请输入一个整数!"
If Val(Str) > Max Then Return "不可超过 " & Max & "!" If Valed > Max Then Return "不可超过 " & Max & "!"
If Val(Str) < Min Then Return "不可低于 " & Min & "!" If Valed < Min Then Return "不可低于 " & Min & "!"
Return "" Return ""
End Function End Function
End Class End Class
@@ -148,7 +148,7 @@ End Class
''' </summary> ''' </summary>
Public Class ValidateExcept Public Class ValidateExcept
Inherits Validate Inherits Validate
Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String) Public Property Excepts As New ObjectModel.Collection(Of String)
Public Property ErrorMessage As String Public Property ErrorMessage As String
Public Sub New() Public Sub New()
ErrorMessage = "输入内容不能包含 %" ErrorMessage = "输入内容不能包含 %"
@@ -157,12 +157,15 @@ Public Class ValidateExcept
Me.Excepts = Excepts Me.Excepts = Excepts
Me.ErrorMessage = ErrorMessage Me.ErrorMessage = ErrorMessage
End Sub End Sub
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能包含 %") Public Sub New(Excepts As IEnumerable(Of String), Optional ErrorMessage As String = "输入内容不能包含 %")
Me.Excepts = New ObjectModel.Collection(Of String) Me.New(
Me.ErrorMessage = ErrorMessage New ObjectModel.Collection(Of String)(New List(Of String)(Excepts)),
For Each Data As String In Excepts ErrorMessage)
Me.Excepts.Add(Data) End Sub
Next Public Sub New(Excepts As IEnumerable(Of Char), Optional ErrorMessage As String = "输入内容不能包含 %")
Me.New(
New ObjectModel.Collection(Of String)(Excepts.Select(Function(c) c.ToString).ToList),
ErrorMessage)
End Sub End Sub
Public Overrides Function Validate(Str As String) As String Public Overrides Function Validate(Str As String) As String
For Each Ch As String In Excepts For Each Ch As String In Excepts
@@ -181,7 +184,7 @@ End Class
''' </summary> ''' </summary>
Public Class ValidateExceptSame Public Class ValidateExceptSame
Inherits Validate Inherits Validate
Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String) Public Property Excepts As New ObjectModel.Collection(Of String)
Public Property ErrorMessage As String Public Property ErrorMessage As String
Public Property IgnoreCase As Boolean = False Public Property IgnoreCase As Boolean = False
Public Sub New() Public Sub New()
@@ -191,19 +194,21 @@ Public Class ValidateExceptSame
Me.ErrorMessage = ErrorMessage Me.ErrorMessage = ErrorMessage
Me.IgnoreCase = IgnoreCase Me.IgnoreCase = IgnoreCase
End Sub End Sub
Public Sub New(Excepts As IEnumerable, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False) Public Sub New(Excepts As IEnumerable(Of String), Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
Me.Excepts = New ObjectModel.Collection(Of String) Me.New(
For Each Data As String In Excepts New ObjectModel.Collection(Of String)(New List(Of String)(Excepts)),
Me.Excepts.Add(Data) ErrorMessage, IgnoreCase)
Next End Sub
Me.ErrorMessage = ErrorMessage Public Sub New(Except As String, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
Me.IgnoreCase = IgnoreCase Me.New(
New ObjectModel.Collection(Of String) From {Except},
ErrorMessage, IgnoreCase)
End Sub End Sub
Public Overrides Function Validate(Str As String) As String Public Overrides Function Validate(Str As String) As String
If Str Is Nothing Then Return ErrorMessage.Replace("%", "null") If Str Is Nothing Then Return ErrorMessage.Replace("%", "null")
For Each Ch As String In Excepts For Each Ch As String In Excepts
If IgnoreCase Then If IgnoreCase Then
If Str.ToLower = Ch.ToLower Then Return ErrorMessage.Replace("%", Ch) If Str.Lower = Ch.Lower Then Return ErrorMessage.Replace("%", Ch)
Else Else
If Str.Equals(Ch) Then Return ErrorMessage.Replace("%", Ch) '使用 = 不确定是否会忽略大小写 If Str.Equals(Ch) Then Return ErrorMessage.Replace("%", Ch) '使用 = 不确定是否会忽略大小写
End If End If
@@ -213,6 +218,27 @@ Public Class ValidateExceptSame
End Class End Class
''' <summary>
''' 必须为特定字符串。
''' </summary>
Public Class ValidateSame
Inherits Validate
Public Property Required As String
Public Property ErrorMessage As String
Public Property IgnoreCase As Boolean = False
Public Sub New()
End Sub
Public Sub New(Required As String, Optional ErrorMessage As String = "输入内容有误", Optional IgnoreCase As Boolean = False)
Me.Required = Required
Me.ErrorMessage = ErrorMessage
Me.IgnoreCase = IgnoreCase
End Sub
Public Overrides Function Validate(Str As String) As String
Return If(String.Compare(Str, Required, IgnoreCase) = 0, "", ErrorMessage)
End Function
End Class
''' <summary> ''' <summary>
''' 对文件夹名的粗略的特化检测。 ''' 对文件夹名的粗略的特化检测。
''' </summary> ''' </summary>
@@ -350,7 +376,7 @@ Public Class ValidateFolderPath
'检查开头 '检查开头
If Str.StartsWithF("\\Mac\") Then GoTo Fin If Str.StartsWithF("\\Mac\") Then GoTo Fin
For Each Drive As DriveInfo In My.Computer.FileSystem.Drives For Each Drive As DriveInfo In My.Computer.FileSystem.Drives
If Str.ToUpper = Drive.Name Then Return "" If Str.Upper = Drive.Name Then Return ""
If Str.StartsWithF(Drive.Name, True) Then GoTo Fin If Str.StartsWithF(Drive.Name, True) Then GoTo Fin
Next Next
Return "文件夹路径头存在错误!" Return "文件夹路径头存在错误!"
+19 -16
View File
@@ -4,11 +4,6 @@ Imports System.Drawing.Imaging
Public Class MyBitmap Public Class MyBitmap
''' <summary>
''' 位图缓存。
''' </summary>
Public Shared BitmapCache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
''' <summary> ''' <summary>
''' 存储的图片 ''' 存储的图片
''' </summary> ''' </summary>
@@ -30,14 +25,17 @@ Public Class MyBitmap
End Operator End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource Public Shared Widening Operator CType(Image As MyBitmap) As ImageSource
If Image Is Nothing Then Return Nothing If Image Is Nothing Then Return Nothing
Dim Bitmap = Image.Pic Dim BitmapPic As System.Drawing.Bitmap = Image.Pic
Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height) Dim rect = New System.Drawing.Rectangle(0, 0, BitmapPic.Width, BitmapPic.Height)
Dim bitmapData = Bitmap.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb) Dim bitmapData = BitmapPic.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
Try Try
Dim size = rect.Width * rect.Height * 4 Dim Result = BitmapSource.Create(BitmapPic.Width, BitmapPic.Height, BitmapPic.HorizontalResolution, BitmapPic.VerticalResolution,
Return BitmapSource.Create(Bitmap.Width, Bitmap.Height, Bitmap.HorizontalResolution, Bitmap.VerticalResolution, PixelFormats.Bgra32, Nothing, bitmapData.Scan0, size, bitmapData.Stride) PixelFormats.Bgra32, Nothing, bitmapData.Scan0,
rect.Width * rect.Height * 4, bitmapData.Stride)
Result.Freeze()
Return Result
Finally Finally
Bitmap.UnlockBits(bitmapData) BitmapPic.UnlockBits(bitmapData)
End Try End Try
End Operator End Operator
Public Shared Widening Operator CType(Image As System.Drawing.Bitmap) As MyBitmap Public Shared Widening Operator CType(Image As System.Drawing.Bitmap) As MyBitmap
@@ -65,15 +63,16 @@ Public Class MyBitmap
FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage) FilePathOrResourceName = FilePathOrResourceName.Replace("pack://application:,,,/images/", PathImage)
If FilePathOrResourceName.StartsWithF(PathImage) Then If FilePathOrResourceName.StartsWithF(PathImage) Then
'使用缓存 '使用缓存
If BitmapCache.ContainsKey(FilePathOrResourceName) Then Static Cache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
Pic = BitmapCache(FilePathOrResourceName).Pic If Cache.ContainsKey(FilePathOrResourceName) Then
Pic = Cache(FilePathOrResourceName).Pic
Else Else
Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource)) Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource))
BitmapCache.TryAdd(FilePathOrResourceName, Pic) Cache.TryAdd(FilePathOrResourceName, Pic)
End If End If
Else Else
'使用这种自己接管 FileStream 的方法加载才能解除文件占用 '使用这种自己接管 FileStream 的方法加载才能解除文件占用
Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open) Using InputStream As New FileStream(FilePathOrResourceName, FileMode.Open, FileAccess.Read, FileShare.Read)
'判断是否为 WebP 文件头 '判断是否为 WebP 文件头
Dim Header(1) As Byte Dim Header(1) As Byte
InputStream.Read(Header, 0, 2) InputStream.Read(Header, 0, 2)
@@ -92,7 +91,11 @@ Public Class MyBitmap
Pic = My.Application.TryFindResource(FilePathOrResourceName) Pic = My.Application.TryFindResource(FilePathOrResourceName)
If Pic Is Nothing Then If Pic Is Nothing Then
Pic = New System.Drawing.Bitmap(1, 1) Pic = New System.Drawing.Bitmap(1, 1)
Throw New Exception($"加载 MyBitmap 失败({FilePathOrResourceName})", ex) If TypeOf ex Is ArgumentException Then
Throw New Exception($"图片格式不支持,或图片文件损坏({FilePathOrResourceName})", ex)
Else
Throw New Exception($"加载 MyBitmap 意外失败({FilePathOrResourceName})", ex)
End If
Else Else
Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", LogLevel.Developer) Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", LogLevel.Developer)
Exit Try Exit Try
File diff suppressed because it is too large Load Diff
@@ -2,7 +2,9 @@
'构造函数 '构造函数
Private TempFolder As String Private TempFolder As String
Public Sub New(UUID As Integer) Private TargetInstance As McInstance
Public Sub New(Optional TargetInstance As McInstance = Nothing)
Me.TargetInstance = TargetInstance
'构建文件结构 '构建文件结构
TempFolder = RequestTaskTempFolder() TempFolder = RequestTaskTempFolder()
Directory.CreateDirectory(TempFolder & "Temp\") Directory.CreateDirectory(TempFolder & "Temp\")
@@ -77,7 +79,7 @@
End Try End Try
Next Next
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
Dim RawOutput As String = Join(LatestLog, vbCrLf) Dim RawOutput As String = LatestLog.Join(vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容:" & vbCrLf & RawOutput) Log("[Crash] 以下为游戏输出的最后一段内容:" & vbCrLf & RawOutput)
WriteFile(TempFolder & "RawOutput.log", RawOutput) WriteFile(TempFolder & "RawOutput.log", RawOutput)
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray)) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TempFolder & "RawOutput.log", LatestLog.ToArray))
@@ -96,7 +98,7 @@
Try Try
Dim Info As New FileInfo(FilePath) Dim Info As New FileInfo(FilePath)
If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then
ExtractFile(FilePath, TempFolder & "Temp\") ExtractCompressedFile(FilePath, TempFolder & "Temp\")
Log("[Crash] 已解压导入的日志文件:" & FilePath) Log("[Crash] 已解压导入的日志文件:" & FilePath)
GoTo Extracted GoTo Extracted
End If End If
@@ -111,7 +113,7 @@ Extracted:
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList() For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList()
Try Try
If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For If Not TargetFile.Exists OrElse TargetFile.Length = 0 Then Continue For
Dim Ext As String = TargetFile.Extension.ToLower Dim Ext As String = TargetFile.Extension.Lower
If Ext = ".log" OrElse Ext = ".txt" Then If Ext = ".log" OrElse Ext = ".txt" Then
AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray))) AnalyzeRawFiles.Add(New KeyValuePair(Of String, String())(TargetFile.FullName, ReadFile(TargetFile.FullName).Split(vbCrLf.ToCharArray)))
Else Else
@@ -145,7 +147,7 @@ Extracted:
DirectFile = Nothing DirectFile = Nothing
Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String()))) Dim AllFiles As New List(Of KeyValuePair(Of AnalyzeFileType, KeyValuePair(Of String, String())))
For Each LogFile In AnalyzeRawFiles For Each LogFile In AnalyzeRawFiles
Dim MatchName As String = GetFileNameFromPath(LogFile.Key).ToLower Dim MatchName As String = GetFileNameFromPath(LogFile.Key).Lower
Dim TargetType As AnalyzeFileType Dim TargetType As AnalyzeFileType
If MatchName.StartsWithF("hs_err") Then If MatchName.StartsWithF("hs_err") Then
TargetType = AnalyzeFileType.HsErr TargetType = AnalyzeFileType.HsErr
@@ -227,7 +229,7 @@ Extracted:
'创建文件名词典 '创建文件名词典
Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String())) Dim FileNameDict As New Dictionary(Of String, KeyValuePair(Of String, String()))
For Each SelectedFile In SelectedFiles For Each SelectedFile In SelectedFiles
FileNameDict(GetFileNameFromPath(SelectedFile.Key).ToLower) = SelectedFile FileNameDict(GetFileNameFromPath(SelectedFile.Key).Lower) = SelectedFile
OutputFiles.Add(SelectedFile.Key) OutputFiles.Add(SelectedFile.Key)
Log("[Crash] 输出报告:" & SelectedFile.Key & ",作为 Minecraft 或启动器日志") Log("[Crash] 输出报告:" & SelectedFile.Key & ",作为 Minecraft 或启动器日志")
Next Next
@@ -305,7 +307,7 @@ Extracted:
''' 输出字符串的前后某些行,并统一行尾为 vbLf (正则 \n)、删除空行和重复行。 ''' 输出字符串的前后某些行,并统一行尾为 vbLf (正则 \n)、删除空行和重复行。
''' </summary> ''' </summary>
Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String Private Function GetHeadTailLines(Raw As String(), HeadLines As Integer, TailLines As Integer) As String
If Raw.Length <= HeadLines + TailLines Then Return Join(Raw.Distinct, vbLf) If Raw.Length <= HeadLines + TailLines Then Return Raw.Distinct.Join(vbLf)
Dim Lines As New List(Of String) Dim Lines As New List(Of String)
Dim RealHeadLines As Integer = 0, ViewedLines As Integer Dim RealHeadLines As Integer = 0, ViewedLines As Integer
For ViewedLines = 0 To Raw.Length - 1 For ViewedLines = 0 To Raw.Length - 1
@@ -339,6 +341,7 @@ Extracted:
''' 导致崩溃的原因枚举。 ''' 导致崩溃的原因枚举。
''' </summary> ''' </summary>
Private Enum CrashReason Private Enum CrashReason
Java虚拟机参数有误
Mod文件被解压 Mod文件被解压
MixinBootstrap缺失 MixinBootstrap缺失
内存不足 内存不足
@@ -388,7 +391,7 @@ Extracted:
''' <summary> ''' <summary>
''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。 ''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。
''' </summary> ''' </summary>
Public Sub Analyze(Optional Version As McVersion = Nothing) Public Sub Analyze()
Log("[Crash] 步骤 3:分析崩溃原因") Log("[Crash] 步骤 3:分析崩溃原因")
LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "") LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "")
@@ -445,7 +448,7 @@ Done:
Else Else
Log("[Crash] 步骤 3:分析崩溃原因完成,找到 " & CrashReasons.Count & " 条可能的原因") Log("[Crash] 步骤 3:分析崩溃原因完成,找到 " & CrashReasons.Count & " 条可能的原因")
For Each Reason In CrashReasons For Each Reason In CrashReasons
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "(" & Join(Reason.Value, ";") & ")", "")) Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "(" & Reason.Value.Join(";"c) & ")", ""))
Next Next
End If End If
End Sub End Sub
@@ -461,7 +464,7 @@ Done:
Else Else
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {}))) CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
End If End If
Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "(" & Join(Additional, ";") & ")", "")) Log("[Crash] 可能的崩溃原因:" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "(" & Additional.Join(";"c) & ")", ""))
End Sub End Sub
Private Sub AppendReason(Reason As CrashReason, Additional As String) Private Sub AppendReason(Reason As CrashReason, Additional As String)
AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional})) AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional}))
@@ -482,10 +485,12 @@ Done:
'崩溃报告分析,高优先级 '崩溃报告分析,高优先级
If LogCrash IsNot Nothing Then If LogCrash IsNot Nothing Then
If LogCrash.Contains("Unable to make protected final java.lang.Class java.lang.ClassLoader.defineClass") Then AppendReason(CrashReason.Java版本过高) If LogCrash.Contains("Unable to make protected final java.lang.Class java.lang.ClassLoader.defineClass") Then AppendReason(CrashReason.Java版本过高)
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)}) '#7071
End If End If
'游戏日志分析 '游戏日志分析
If LogMc IsNot Nothing Then If LogMc IsNot Nothing Then
If LogMc.Contains("Unrecognized option:") Then AppendReason(CrashReason.Java虚拟机参数有误)
If LogMc.Contains("Found multiple arguments for option fml.forgeVersion, but you asked for only one") Then AppendReason(CrashReason.版本Json中存在多个Forge) If LogMc.Contains("Found multiple arguments for option fml.forgeVersion, but you asked for only one") Then AppendReason(CrashReason.版本Json中存在多个Forge)
If LogMc.Contains("The driver does not appear to support OpenGL") Then AppendReason(CrashReason.显卡不支持OpenGL) If LogMc.Contains("The driver does not appear to support OpenGL") Then AppendReason(CrashReason.显卡不支持OpenGL)
If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK) If LogMc.Contains("java.lang.ClassCastException: java.base/jdk") Then AppendReason(CrashReason.使用JDK)
@@ -508,13 +513,13 @@ Done:
If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式) If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
If LogMc.Contains("java.lang.OutOfMemoryError") OrElse LogMc.Contains("an out of memory error") Then AppendReason(CrashReason.内存不足) If LogMc.Contains("java.lang.OutOfMemoryError") OrElse LogMc.Contains("an out of memory error") Then AppendReason(CrashReason.内存不足)
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与OptiFine同时安装) If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与OptiFine同时安装)
If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容) If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") OrElse LogMc.Contains("java.lang.NoSuchMethodError: 'void sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容)
If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误) If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误)
If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf)) If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf))
If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足) If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足)
If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界) If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界)
If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容) If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容)
If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") Then AppendReason(CrashReason.NightConfig的Bug) If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") AndAlso Not CrashReasons.ContainsKey(CrashReason.Mod配置文件导致游戏崩溃) Then AppendReason(CrashReason.NightConfig的Bug)
If LogMc.Contains("Cannot find launch target fmlclient, unable to launch") Then AppendReason(CrashReason.Forge安装不完整) If LogMc.Contains("Cannot find launch target fmlclient, unable to launch") Then AppendReason(CrashReason.Forge安装不完整)
If LogMc.Contains("Invalid paths argument, contained no existing paths") AndAlso LogMc.Contains("libraries\net\minecraftforge\fmlcore") Then AppendReason(CrashReason.Forge安装不完整) If LogMc.Contains("Invalid paths argument, contained no existing paths") AndAlso LogMc.Contains("libraries\net\minecraftforge\fmlcore") Then AppendReason(CrashReason.Forge安装不完整)
If LogMc.Contains("Invalid module name: '' is not a Java identifier") Then AppendReason(CrashReason.Mod名称包含特殊字符) If LogMc.Contains("Invalid module name: '' is not a Java identifier") Then AppendReason(CrashReason.Mod名称包含特殊字符)
@@ -533,12 +538,12 @@ Done:
'确定的 Mod 导致崩溃 '确定的 Mod 导致崩溃
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray))) If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'Mod 重复 / 前置问题 'Mod 重复 / 前置问题
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList) If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase)) If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Incompatible mods found!") Then '#5006 If LogMc.Contains("Incompatible mods found!") Then '#5006, #5115
AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), "")) AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), "").BeforeFirst("更多信息:").Replace("Some of your mods are incompatible with the game or each other!", "").Trim((vbCrLf & " ").ToCharArray))
End If End If
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
AppendReason(CrashReason.Mod缺少前置或MC版本错误, AppendReason(CrashReason.Mod缺少前置或MC版本错误,
@@ -602,7 +607,7 @@ Done:
Return True Return True
End If End If
'JSON 名称匹配 'JSON 名称匹配
For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(]{1})[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline) For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(])[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
AppendReason(CrashReason.ModMixin失败, AppendReason(CrashReason.ModMixin失败,
TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", ""))) TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
Return True Return True
@@ -618,9 +623,9 @@ Done:
Dim IsMixin As Boolean = MixinAnalyze(LogMc) Dim IsMixin As Boolean = MixinAnalyze(LogMc)
'常规信息 '常规信息
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("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)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf)) If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(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)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf)) If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+"), vbLf)) If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)(\s+ - [^\n]+\n)+"), ""), "(?<=\s+)[^\n]+").Join(vbLf))
If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败 If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray))) AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If End If
@@ -654,7 +659,7 @@ Done:
End If End If
'Mod 解析错误(常见于 Fabric 前置校验失败) 'Mod 解析错误(常见于 Fabric 前置校验失败)
If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错) If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错)
'Mixin 失败可以导致大量 Mod 实例创建失败 'Mixin 失败可以导致大量 Mod 实例创建失败,因此需要放到低优先级中
If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf))) If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf)))
'注意:Fabric 的 Warnings were found! 不一定是崩溃原因,它可能是单纯的警报 '注意:Fabric 的 Warnings were found! 不一定是崩溃原因,它可能是单纯的警报
End If End If
@@ -707,20 +712,20 @@ NextStack:
Dim Word As String = Splited(i) Dim Word As String = Splited(i)
If Word.Length <= 2 OrElse Word.StartsWithF("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", "mcp", If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp",
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", "impl", "data", "pool", "task", "core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "fake", "oshi", "impl", "data", "pool", "task",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", "lwjgl", "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", "lwjgl", "fakes",
"gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events", "fabric", "gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "script", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service", "preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service", "scripts", "network",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge", "fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge", "external",
"injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft", "injection", "listeners", "scheduler", "minecraft", "universal", "multipart", "neoforged", "microsoft",
"transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill" "transformer", "transformers", "minecraftforge", "blockentity", "spongepowered", "electronwill", "concurrent"
}.Contains(Word.ToLower) Then Continue For }.Contains(Word.Lower) Then Continue For
PossibleWords.Add(Word.Trim) PossibleWords.Add(Word.Trim)
Next Next
Next Next
PossibleWords = PossibleWords.Distinct.ToList PossibleWords = PossibleWords.Distinct.ToList
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词") Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
If PossibleWords.Any Then Log("[Crash] - " & Join(PossibleWords, ", ")) If PossibleWords.Any Then Log("[Crash] - " & PossibleWords.Join(", "))
If PossibleWords.Count > 10 Then If PossibleWords.Count > 10 Then
Log("[Crash] 关键词过多,考虑匹配出错,不纳入考虑") Log("[Crash] 关键词过多,考虑匹配出错,不纳入考虑")
Return New List(Of String) Return New List(Of String)
@@ -768,8 +773,8 @@ NextStack:
Dim HintLines As New List(Of String) Dim HintLines As New List(Of String)
For Each KeyWord As String In Keywords For Each KeyWord As String In Keywords
For Each ModString As String In ModNameLines For Each ModString As String In ModNameLines
Dim RealModString As String = ModString.ToLower.Replace("_", "") Dim RealModString As String = ModString.Lower.Replace("_", "")
If Not RealModString.Contains(KeyWord.ToLower.Replace("_", "")) Then Continue For If Not RealModString.Contains(KeyWord.Lower.Replace("_", "")) Then Continue For
If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For If RealModString.Contains("minecraft.jar") OrElse RealModString.Contains(" forge-") OrElse RealModString.Contains(" mixin-") Then Continue For
HintLines.Add(ModString.Trim(vbCrLf.ToCharArray)) HintLines.Add(ModString.Trim(vbCrLf.ToCharArray))
Exit For Exit For
@@ -856,20 +861,21 @@ NextStack:
''' <summary> ''' <summary>
''' 弹出崩溃弹窗,并指导导出崩溃报告。 ''' 弹出崩溃弹窗,并指导导出崩溃报告。
''' </summary> ''' </summary>
Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing) Public Sub Output(IsManualAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
'弹窗提示 '弹窗提示
FrmMain.ShowWindowToTop() FrmMain.ShowWindowToTop()
Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"), Dim Detail As String = GetAnalyzeResult(IsManualAnalyze)
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"), Select Case MyMsgBox(Detail, If(IsManualAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, "确定", If(IsManualAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsManualAnalyze, "", "导出错误报告"),
Button2Action:=If(IsManualAnalyze OrElse DirectFile Is Nothing, Nothing,
Sub() Sub()
'弹窗选择:查看日志 '弹窗选择:查看日志
If File.Exists(DirectFile.Value.Key) Then If File.Exists(DirectFile.Value.Key) Then
ShellOnly(DirectFile.Value.Key) StartProcess(DirectFile.Value.Key)
Else Else
Dim FilePath As String = PathTemp & "Crash.txt" Dim FilePath As String = PathTemp & "Crash.txt"
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf)) WriteFile(FilePath, DirectFile.Value.Value.Join(vbCrLf))
ShellOnly(FilePath) StartProcess(FilePath)
End If End If
End Sub)) End Sub))
Case 3 Case 3
@@ -902,8 +908,7 @@ NextStack:
If File.Exists(OutputFile) Then If File.Exists(OutputFile) Then
If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile)) If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
Dim FileContent As String = ReadFile(OutputFile, FileEncoding) Dim FileContent As String = ReadFile(OutputFile, FileEncoding)
FileContent = FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")) FileContent = FilterUserName(FilterAccessToken(FileContent, If(FileName = "启动脚本.bat", "F", "*")), "*")
FileContent = FilterUserName(FileContent, "*")
WriteFile(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding) WriteFile(TempFolder & "Report\" & FileName, FileContent, Encoding:=FileEncoding)
Log($"[Crash] 导出文件:{FileName},编码:{FileEncoding.HeaderName}") Log($"[Crash] 导出文件:{FileName},编码:{FileEncoding.HeaderName}")
End If End If
@@ -911,13 +916,18 @@ NextStack:
'导出报告 '导出报告
Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress) Compression.ZipFile.CreateFromDirectory(TempFolder & "Report\", FileAddress)
DeleteDirectory(TempFolder & "Report\") DeleteDirectory(TempFolder & "Report\")
Hint("错误报告已导出!", HintType.Finish) Hint("错误报告已导出!", HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, "导出错误报告失败", LogLevel.Feedback) Log(ex, "导出错误报告失败", LogLevel.Feedback)
Return Return
End Try End Try
OpenExplorer(FileAddress) OpenExplorer(FileAddress)
End Select End Select
'上报
If IsManualAnalyze Then Return
Telemetry("Minecraft 崩溃",
"Version", If(TargetInstance Is Nothing, "null", TargetInstance.VersionDisplayName),
"Detail", FilterUserName(Detail, "*"))
End Sub End Sub
''' <summary> ''' <summary>
''' 获取崩溃分析的结果描述。 ''' 获取崩溃分析的结果描述。
@@ -938,6 +948,8 @@ NextStack:
For Each Reason In CrashReasons For Each Reason In CrashReasons
Dim Additional As List(Of String) = Reason.Value Dim Additional As List(Of String) = Reason.Value
Select Case Reason.Key Select Case Reason.Key
Case CrashReason.Java虚拟机参数有误
Results.Add("由于 Java 参数有误,导致游戏无法继续运行。\n请检查高级选项中的 Java 虚拟机参数和游戏参数设置是否有误。")
Case CrashReason.Mod文件被解压 Case CrashReason.Mod文件被解压
Results.Add("由于 Mod 文件被解压了,导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可,若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod,然后再启动游戏。") Results.Add("由于 Mod 文件被解压了,导致游戏无法继续运行。\n直接把整个 Mod 文件放进 Mod 文件夹中即可,若解压就会导致游戏出错。\n\n请删除 Mod 文件夹中已被解压的 Mod,然后再启动游戏。")
Case CrashReason.内存不足 Case CrashReason.内存不足
@@ -962,35 +974,35 @@ NextStack:
End If End If
Case CrashReason.Mod缺少前置或MC版本错误 Case CrashReason.Mod缺少前置或MC版本错误
If Additional.Any Then If Additional.Any Then
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n缺失的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n缺失的依赖项:\n - " & Additional.Join("\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.堆栈分析发现关键字 Case CrashReason.堆栈分析发现关键字
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("你的游戏遇到了一些问题,PCL 为此找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h") Results.Add("你的游戏遇到了一些问题,PCL 为此找到了一个可疑的关键词:" & Additional.First & "。\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
Else Else
Results.Add("你的游戏遇到了一些问题,PCL 为此找到了以下可疑的关键词:\n - " & Join(Additional, ", ") & "\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h") Results.Add("你的游戏遇到了一些问题,PCL 为此找到了以下可疑的关键词:\n - " & Additional.Join(", ") & "\n\n如果你知道某个关键词对应的 Mod,那么有可能就是它引起的错误,你也可以查看错误报告获取详情。\h")
End If End If
Case CrashReason.堆栈分析发现Mod名称, CrashReason.怀疑Mod导致游戏崩溃 Case CrashReason.堆栈分析发现Mod名称, CrashReason.怀疑Mod导致游戏崩溃
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("PCL 怀疑名为 " & Additional.First & " 的 Mod 导致了游戏出错,但不能完全确定。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("PCL 怀疑名为 " & Additional.First & " 的 Mod 导致了游戏出错,但不能完全确定。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("PCL 怀疑以下 Mod 导致了游戏出错,但不能完全确定:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("PCL 怀疑以下 Mod 导致了游戏出错,但不能完全确定:\n - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.确定Mod导致游戏崩溃 Case CrashReason.确定Mod导致游戏崩溃
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("以下 Mod 导致了游戏出错:\n - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.ModMixin失败 Case CrashReason.ModMixin失败
If Additional.Count = 0 Then If Additional.Count = 0 Then
Results.Add("部分 Mod 注入失败,导致游戏出错。\n这一般代表着部分 Mod 与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试逐步禁用 Mod,然后观察游戏是否还会崩溃,以此定位导致崩溃的 Mod。\n\e\h") Results.Add("部分 Mod 注入失败,导致游戏出错。\n这一般代表着部分 Mod 与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试逐步禁用 Mod,然后观察游戏是否还会崩溃,以此定位导致崩溃的 Mod。\n\e\h")
ElseIf Additional.Count = 1 Then ElseIf Additional.IsSingle Then
Results.Add("名为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("名为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("以下 Mod 导致了游戏出错:\n - " & Additional.Join("\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.Mod配置文件导致游戏崩溃 Case CrashReason.Mod配置文件导致游戏崩溃
If Additional(1) Is Nothing Then If Additional(1) Is Nothing Then
@@ -999,28 +1011,36 @@ NextStack:
Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。") Results.Add("名为 " & Additional.First & " 的 Mod 导致了游戏出错:\n其配置文件 " & Additional(1) & " 存在异常,无法读取。")
End If End If
Case CrashReason.Mod初始化失败 Case CrashReason.Mod初始化失败
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
Else Else
Results.Add("以下 Mod 初始化失败,导致游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("以下 Mod 初始化失败,导致游戏出错:\n - " & Additional.Join("\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.特定方块导致崩溃 Case CrashReason.特定方块导致崩溃
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是该方块导致出错,你或许需要使用一些方式删除此方块。\n - 若仍然出错,问题就可能来自其他原因……\h") Results.Add("游戏似乎因为方块 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是该方块导致出错,你或许需要使用一些方式删除此方块。\n - 若仍然出错,问题就可能来自其他原因……\h")
Else Else
Results.Add("游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是某些方块导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h") Results.Add("游戏似乎因为世界中的某些方块出现了问题。\n\n你可以创建一个新世界,并观察游戏的运行情况:\n - 若正常运行,则是某些方块导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h")
End If End If
Case CrashReason.Mod重复安装 Case CrashReason.Mod重复安装
If Additional.Count >= 2 Then If Additional.Count >= 2 Then
Results.Add("你重复安装了多个相同的 Mod:\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。") Results.Add("你重复安装了多个相同的 Mod:\n - " & Additional.Join("\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。")
Else Else
Results.Add("你可能重复安装了多个相同的 Mod,导致游戏出错。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h") Results.Add("你可能重复安装了多个相同的 Mod,导致游戏出错。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
End If End If
Case CrashReason.特定实体导致崩溃 Case CrashReason.特定实体导致崩溃
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("游戏似乎因为实体 " & Additional.First & " 出现了问题。\n\n你可以创建一个新世界,并生成一个该实体,然后观察游戏的运行情况:\n - 若正常运行,则是该实体导致出错,你或许需要使用一些方式删除此实体。\n - 若仍然出错,问题就可能来自其他原因……\h") If Additional.First.Contains("minecraft:player") Then
If Additional.First.Contains(" ") Then
Results.Add($"游戏因为位于 {Additional.First.AfterFirst(" ")} 的玩家实体导致了崩溃。\h")
Else Else
Results.Add("游戏似乎因为世界中的某些实体出现了问题。\n\n你可以创建一个新世界,并生成各种实体,观察游戏的运行情况:\n - 若正常运行,则是某些实体导致出错,你或许需要删除该世界。\n - 若仍然出错,问题就可能来自其他原因……\h") Results.Add($"游戏因为玩家实体导致了崩溃。\h")
End If
Else
Results.Add($"游戏因为实体 {Additional.First} 导致了崩溃。\h")
End If
Else
Results.Add($"游戏因为下列实体导致了崩溃:{Additional.Join("、"c)}\h")
End If End If
Case CrashReason.OptiFine与Forge不兼容 Case CrashReason.OptiFine与Forge不兼容
Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。") Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。")
@@ -1057,31 +1077,31 @@ NextStack:
Case CrashReason.Forge安装不完整 Case CrashReason.Forge安装不完整
Results.Add("由于安装的 Forge 文件丢失,导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge,然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h") Results.Add("由于安装的 Forge 文件丢失,导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge,然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h")
Case CrashReason.Fabric报错 Case CrashReason.Fabric报错
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.Mod互不兼容 Case CrashReason.Mod互不兼容
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("你所安装的 Mod 不兼容:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("你所安装的 Mod 不兼容:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("你所安装的 Mod 不兼容,Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("你所安装的 Mod 不兼容,Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.Mod加载器报错 Case CrashReason.Mod加载器报错
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.Fabric报错并给出解决方案 Case CrashReason.Fabric报错并给出解决方案
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.Forge报错 Case CrashReason.Forge报错
If Additional.Count = 1 Then If Additional.IsSingle Then
Results.Add("Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h") Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
@@ -1093,7 +1113,7 @@ NextStack:
End Select End Select
Next Next
Return Join(Results, "\n\n此外,"). Return Results.Join("\n\n此外,").
Replace("\n", vbCrLf). Replace("\n", vbCrLf).
Replace("\h", ""). Replace("\h", "").
Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")). Replace("\e", If(IsHandAnalyze, "", vbCrLf & "你可以查看错误报告了解错误具体是如何发生的。")).
@@ -1102,7 +1122,7 @@ NextStack:
If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "", If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
vbCrLf & "如果要寻求帮助,请把错误报告文件发给对方,而不是发送这个窗口的照片或者截图。" & vbCrLf & "如果要寻求帮助,请把错误报告文件发给对方,而不是发送这个窗口的照片或者截图。" &
If(If(PageSetupSystem.IsLauncherNewest(), True), "", If(If(PageSetupSystem.IsLauncherNewest(), True), "",
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。")) vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 [设置 → 其他 → 启动器 → 检查更新] 更新 PCL。"))
End Function End Function
End Class End Class
@@ -6,40 +6,40 @@
''' 返回某 Minecraft 版本对应的原版主 Jar 文件的下载信息,要求对应依赖版本已存在。 ''' 返回某 Minecraft 版本对应的原版主 Jar 文件的下载信息,要求对应依赖版本已存在。
''' 失败则抛出异常,不需要下载则返回 Nothing。 ''' 失败则抛出异常,不需要下载则返回 Nothing。
''' </summary> ''' </summary>
Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile Public Function DlClientJarGet(Instance As McInstance, ReturnNothingOnFileUseable As Boolean) As NetFile
'获取底层继承版本 '获取底层继承版本
Try Try
Do While Not String.IsNullOrEmpty(Version.InheritVersion) Do While Not String.IsNullOrEmpty(Instance.InheritName)
Version = New McVersion(Version.InheritVersion) Instance = New McInstance(Instance.InheritName)
Loop Loop
Catch ex As Exception Catch ex As Exception
Log(ex, "获取底层继承版本失败") Log(ex, "获取底层继承版本失败")
End Try End Try
'检查 Json 是否标准 '检查 Json 是否标准
If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("client") Is Nothing OrElse Instance.JsonObject("downloads")("client")("url") Is Nothing Then
Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息") Throw New Exception("底层版本 " & Instance.Name & " 中无 jar 文件下载信息")
End If End If
'检查文件 '检查文件
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1")) Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Instance.JsonObject("downloads")("client")("size"), -1), Hash:=Instance.JsonObject("downloads")("client")("sha1"))
If ReturnNothingOnFileUseable AndAlso Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验 If ReturnNothingOnFileUseable AndAlso Checker.Check(Instance.PathVersion & Instance.Name & ".jar") Is Nothing Then Return Nothing '通过校验
'返回下载信息 '返回下载信息
Dim JarUrl As String = Version.JsonObject("downloads")("client")("url") Dim JarUrl As String = Instance.JsonObject("downloads")("client")("url")
Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker) Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Instance.PathVersion & Instance.Name & ".jar", Checker)
End Function End Function
''' <summary> ''' <summary>
''' 返回某 Minecraft 版本对应的原版主 AssetIndex 文件的下载信息,要求对应依赖版本已存在。 ''' 返回某 Minecraft 版本对应的原版主 AssetIndex 文件的下载信息,要求对应依赖版本已存在。
''' 若未找到,则会返回 Legacy 资源文件或 Nothing。 ''' 若未找到,则会返回 Legacy 资源文件或 Nothing。
''' </summary> ''' </summary>
Public Function DlClientAssetIndexGet(Version As McVersion) As NetFile Public Function DlClientAssetIndexGet(Instance As McInstance) As NetFile
'获取底层继承版本 '获取底层继承版本
Do While Not String.IsNullOrEmpty(Version.InheritVersion) Do While Not String.IsNullOrEmpty(Instance.InheritName)
Version = New McVersion(Version.InheritVersion) Instance = New McInstance(Instance.InheritName)
Loop Loop
'获取信息 '获取信息
Dim IndexInfo = McAssetsGetIndex(Version, True, True) Dim IndexInfo = McAssetsGetIndex(Instance, True, True)
Dim IndexAddress As String = PathMcFolder & "assets\indexes\" & IndexInfo("id").ToString & ".json" Dim IndexAddress As String = McFolderSelected & "assets\indexes\" & IndexInfo("id").ToString & ".json"
Log("[Download] 版本 " & Version.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString) Log("[Download] 版本 " & Instance.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString)
Dim IndexUrl As String = If(IndexInfo("url"), "") Dim IndexUrl As String = If(IndexInfo("url"), "")
If IndexUrl = "" Then If IndexUrl = "" Then
Return Nothing Return Nothing
@@ -51,12 +51,12 @@
''' <summary> ''' <summary>
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。 ''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
''' </summary> ''' </summary>
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase) Public Function DlClientFix(Instance As McInstance, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
#Region "下载支持库文件" #Region "下载支持库文件"
Dim LoadersLib As New List(Of LoaderBase) From { 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 LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibNetFilesFromInstance(Instance)) With {.ProgressWeight = 1},
New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15} New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
} }
'构造加载器 '构造加载器
@@ -64,7 +64,7 @@
#End Region #End Region
#Region "下载资源文件" #Region "下载资源文件"
If ShouldIgnoreFileCheck(Version) Then If ShouldIgnoreFileCheck(Instance) Then
Log("[Download] 已跳过所有 Assets 检查") Log("[Download] 已跳过所有 Assets 检查")
Else Else
Dim LoadersAssets As New List(Of LoaderBase) Dim LoadersAssets As New List(Of LoaderBase)
@@ -72,9 +72,11 @@
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址", LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try Try
Dim IndexFile = DlClientAssetIndexGet(Version) Dim IndexFile = DlClientAssetIndexGet(Instance)
Dim IndexFileInfo As New FileInfo(IndexFile.LocalPath) If IndexFile Is Nothing Then
If AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then Task.Output = New List(Of NetFile)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug)
ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile) Task.Output = New List(Of NetFile)
Else Else
Task.Output = New List(Of NetFile) From {IndexFile} Task.Output = New List(Of NetFile) From {IndexFile}
@@ -92,7 +94,12 @@
Dim RealAddress As String = Nothing Dim RealAddress As String = Nothing
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址", LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Version) Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
If BackAssetsFile Is Nothing Then
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址,游戏 assets 可能缺失", LogLevel.Debug)
Task.Interrupt()
Throw New ThreadInterruptedException
End If
RealAddress = BackAssetsFile.LocalPath RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
BackAssetsFile.LocalPath = TempAddress BackAssetsFile.LocalPath = TempAddress
@@ -100,7 +107,7 @@
'检查是否需要更新:每天只更新一次 '检查是否需要更新:每天只更新一次
If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then
Log("[Download] 无需更新资源文件索引,取消") Log("[Download] 无需更新资源文件索引,取消")
Task.Abort() Task.Interrupt()
End If End If
End Sub)) End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile))) LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
@@ -114,14 +121,12 @@
Updater.Start() Updater.Start()
End If End If
'获取资源文件地址 '获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件", LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("获取资源文件列表",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task) Task.Output = McAssetsFixList(Instance, CheckAssetsHash, Task)) With {.ProgressWeight = 0.01})
Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
'下载资源文件 '下载资源文件
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25}) LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
'构造加载器 '构造加载器
Loaders.Add(New LoaderCombo(Of String)("下载资源文件(主加载器)", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 30.5}) Loaders.Add(New LoaderCombo(Of String)("下载资源文件(主加载器)", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 27})
End If End If
#End Region #End Region
@@ -146,6 +151,25 @@
#Region "DlClientList | Minecraft 客户端 版本列表" #Region "DlClientList | Minecraft 客户端 版本列表"
''' <summary>
''' 所有正式版的 Minecraft Drop 序数。
''' 若从未完成过获取,返回 Nothing;否则必定存在元素,且从高到低排列。
''' </summary>
Public Property AllDrops As List(Of Integer)
Get
If _AllDrops Is Nothing Then
_AllDrops = Settings.Get("CacheDrops").ToString.
Split(",".ToCharArray, StringSplitOptions.RemoveEmptyEntries).Select(Function(d) CInt(Val(d))).ToList()
End If
Return If(_AllDrops.Any, _AllDrops, Nothing) '不要将 _AllDrops 再设为 Nothing,以防止反复获取设置尝试初始化
End Get
Set(value As List(Of Integer))
_AllDrops = value
Settings.Set("CacheDrops", value.Join(","c))
End Set
End Property
Private _AllDrops As List(Of Integer) = Nothing
'主加载器 '主加载器
Public Structure DlClientListResult Public Structure DlClientListResult
''' <summary> ''' <summary>
@@ -160,10 +184,6 @@
''' 获取到的 Json 数据。 ''' 获取到的 Json 数据。
''' </summary> ''' </summary>
Public Value As JObject Public Value As JObject
'''' <summary>
'''' 官方源的失败原因。若没有则为 Nothing。
'''' </summary>
'Public OfficialError As Exception
End Structure End Structure
''' <summary> ''' <summary>
''' Minecraft 客户端 版本列表,主加载器。 ''' Minecraft 客户端 版本列表,主加载器。
@@ -171,7 +191,7 @@
''' </summary> ''' </summary>
Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain) Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult)) Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
@@ -188,6 +208,14 @@
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60) New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
End Select End Select
'提取所有 Drop 序数
Dim Drops As New List(Of Integer)
For Each Version As JObject In Loader.Output.Value("versions")
Dim Drop As Integer = McVersion.VersionToDrop(Version("id"))
If Drop = 209 Then Continue For
Drops.Add(Drop)
Next
AllDrops = Drops.Distinct.OrderByDescending(Function(d) d).ToList()
End Sub End Sub
'各个下载源的分加载器 '各个下载源的分加载器
@@ -195,16 +223,15 @@
''' Minecraft 客户端 版本列表,Mojang 官方源加载器。 ''' Minecraft 客户端 版本列表,Mojang 官方源加载器。
''' </summary> ''' </summary>
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain) Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private IsNewClientVersionHinted As Boolean = False
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult)) Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim StartTime As Long = GetTimeTick() Dim StartTime As Long = GetTimeMs()
Dim Json As JObject = NetGetCodeByRequestRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", IsJson:=True) Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
Try Try
Dim Versions As JArray = Json("versions") Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")") If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
'确定官方源是否可用 '确定官方源是否可用
If Not DlPreferMojang Then If Not DlPreferMojang Then
Dim DeltaTime = GetTimeTick() - StartTime Dim DeltaTime = GetTimeMs() - StartTime
DlPreferMojang = DeltaTime < 4000 DlPreferMojang = DeltaTime < 4000
Log($"[Download] Mojang 官方源加载耗时:{DeltaTime}ms,{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}") Log($"[Download] Mojang 官方源加载耗时:{DeltaTime}ms,{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
End If End If
@@ -212,20 +239,25 @@
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json"))) If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
'返回 '返回
Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json} Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
'解析更新提示(Release) 'MC 更新提示
Dim Version As String = Json("latest")("release") Static IsHinted As Boolean = False
If Setup.Get("ToolUpdateRelease") AndAlso Not Setup.Get("ToolUpdateReleaseLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateReleaseLast") = Version Then Dim Version As String
McDownloadClientUpdateHint(Version, Json) '快照版
IsNewClientVersionHinted = True
End If
McVersionHighest = Version.Split(".")(1)
Setup.Set("ToolUpdateReleaseLast", Version)
'解析更新提示(Snapshot)
Version = Json("latest")("snapshot") Version = Json("latest")("snapshot")
If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = Version AndAlso Not IsNewClientVersionHinted Then If Settings.Get("ToolUpdateSnapshot") AndAlso Not Settings.Get("ToolUpdateSnapshotLast") = "" AndAlso
Settings.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json) McDownloadClientUpdateHint(Version, Json)
End If End If
Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing")) Settings.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
'正式版
Version = Json("latest")("release")
If Settings.Get("ToolUpdateRelease") AndAlso Not Settings.Get("ToolUpdateReleaseLast") = "" AndAlso
Settings.Get("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json)
End If
Settings.Set("ToolUpdateReleaseLast", Version)
Catch ex As Exception Catch ex As Exception
Throw New Exception("Minecraft 官方源版本列表解析失败", ex) Throw New Exception("Minecraft 官方源版本列表解析失败", ex)
End Try End Try
@@ -235,7 +267,7 @@
''' </summary> ''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain) Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult)) Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", IsJson:=True) Dim Json As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True))
Try Try
Dim Versions As JArray = Json("versions") Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")") If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
@@ -274,7 +306,7 @@
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True) DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
Case LoadState.Loading Case LoadState.Loading
DlClientListLoader.WaitForExit(Id) DlClientListLoader.WaitForExit(Id)
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting Case LoadState.Failed, LoadState.Interrupted, LoadState.Waiting
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True) DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
End Select End Select
'重新查找版本 '重新查找版本
@@ -312,15 +344,15 @@
''' <summary> ''' <summary>
''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。 ''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。
''' </summary> ''' </summary>
Public NameDisplay As String Public DisplayName As String
''' <summary> ''' <summary>
''' 原始文件名称,如“preview_OptiFine_1.11_HD_U_E1_pre.jar”。 ''' 原始文件名称,如“preview_OptiFine_1.11_HD_U_E1_pre.jar”。
''' </summary> ''' </summary>
Public NameFile As String Public FileName As String
''' <summary> ''' <summary>
''' 对应的版本名称,如“1.13.2-OptiFine_HD_U_E6”。 ''' 对应的版本名称,如“1.13.2-OptiFine_HD_U_E6”。
''' </summary> ''' </summary>
Public NameVersion As String Public InstanceName As String
''' <summary> ''' <summary>
''' 是否为测试版。 ''' 是否为测试版。
''' </summary> ''' </summary>
@@ -353,7 +385,7 @@
''' </summary> ''' </summary>
Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain) Public DlOptiFineListLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Main", AddressOf DlOptiFineListMain)
Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult)) Private Sub DlOptiFineListMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30),
@@ -377,7 +409,7 @@
''' </summary> ''' </summary>
Public DlOptiFineListOfficialLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Official", AddressOf DlOptiFineListOfficialMain) Public DlOptiFineListOfficialLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Official", AddressOf DlOptiFineListOfficialMain)
Private Sub DlOptiFineListOfficialMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult)) Private Sub DlOptiFineListOfficialMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default) Dim Result As String = NetRequestByClientRetry("https://optifine.net/downloads", Encoding:=Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")") If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
Try Try
'获取所有版本信息 '获取所有版本信息
@@ -392,14 +424,14 @@
For i = 0 To ReleaseTime.Count - 1 For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ") Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With { Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "), .DisplayName = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"), .ReleaseTime = {ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}.Join("/"c),
.IsPreview = Name(i).ContainsF("pre", True), .IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0), .Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar", .FileName = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")} .RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "") Entry.InstanceName = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry) Versions.Add(Entry)
Next Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions} Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
@@ -413,20 +445,20 @@
''' </summary> ''' </summary>
Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain) Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult)) Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList", IsJson:=True) Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True))
Try Try
Dim Versions As New List(Of DlOptiFineListEntry) Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json For Each Token As JObject In Json
Dim Entry As New DlOptiFineListEntry With { Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "), .DisplayName = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "", .ReleaseTime = "",
.IsPreview = Token("patch").ToString.ContainsF("pre", True), .IsPreview = Token("patch").ToString.ContainsF("pre", True),
.Inherit = Token("mcversion").ToString, .Inherit = Token("mcversion").ToString,
.NameFile = Token("filename").ToString, .FileName = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "") .RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
} }
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "") Entry.InstanceName = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry) Versions.Add(Entry)
Next Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions} Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
@@ -459,7 +491,7 @@
''' </summary> ''' </summary>
Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain) Public DlForgeListLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Main", AddressOf DlForgeListMain)
Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult)) Private Sub DlForgeListMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30),
@@ -483,10 +515,10 @@
''' </summary> ''' </summary>
Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain) Public DlForgeListOfficialLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Official", AddressOf DlForgeListOfficialMain)
Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult)) Private Sub DlForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As String = NetGetCodeByRequestRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding.Default, "text/html", UseBrowserUserAgent:=True) Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", SimulateBrowserHeaders:=True)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")") If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息 '获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)") Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+((_pre|[_-]snapshot[_-]?)[0-9]?)?(?=.html)")
Names.Add("1.2.4") '1.2.4 不会被匹配上 Names.Add("1.2.4") '1.2.4 不会被匹配上
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")") If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names} Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names}
@@ -497,11 +529,10 @@
''' </summary> ''' </summary>
Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain) Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult)) Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default) Dim Result As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")") Encoding:=Encoding.Default, RequireJson:=True))
'获取所有版本信息 Dim Names As List(Of String) = Result.Select(Function(v) v.ToString).ToList
Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?") If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足")
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names} Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names}
End Sub End Sub
@@ -510,60 +541,47 @@
#Region "DlForgeVersion | Forge 版本列表" #Region "DlForgeVersion | Forge 版本列表"
Public MustInherit Class DlForgelikeEntry Public MustInherit Class DlForgelikeEntry
Implements IComparable(Of DlForgelikeEntry)
Public IsNeoForge As Boolean Public IsNeoForge As Boolean
''' <summary> ''' <summary>
''' 加载器名称。Forge 或 NeoForge。 ''' 加载器名称。Forge 或 NeoForge。
''' </summary> ''' </summary>
Public ReadOnly Property LoaderName As String Public MustOverride ReadOnly Property LoaderName As String
Get
Return If(IsNeoForge, "NeoForge", "Forge")
End Get
End Property
''' <summary> ''' <summary>
''' 文件扩展名。不以小数点开头。 ''' 文件扩展名。不以小数点开头。
''' </summary> ''' </summary>
Public ReadOnly Property FileExtension As String Public MustOverride ReadOnly Property FileExtension As String
Get
If IsNeoForge Then
Return "jar"
Else
Return If(CType(Me, DlForgeVersionEntry).Category = "installer", "jar", "zip")
End If
End Get
End Property
''' <summary> ''' <summary>
''' Forge:MC 版本是否小于 1.13。 ''' 标准化后的版本号,仅可用于比较与排序,且 NeoForge 项不包含 alpha/beta 编号!
''' NeoForge:MC 版本是否为 1.20.1。
''' </summary>
Public ReadOnly Property IsLegacy As Boolean
Get
'虽然很抽象,但确实可以这样判断
'Forge:1.13+ 的版本号首位都大于 20
'NeoForge:1.20.1 的版本号首位人为规定为 19 开头
Return Version.Major < 20
End Get
End Property
''' <summary>
''' 标准化后的版本号,仅可用于比较与排序。
''' 格式:Major.Minor.Build.Revision ''' 格式:Major.Minor.Build.Revision
''' Forge:如 “50.1.9.0”(最后一位固定为 0)、“14.22.1.2478”(Legacy)。 ''' Forge:如 “50.1.9.0”(最后一位固定为 0)、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30.0”(最后一位固定为 0)、“19.47.1.99”(Legacy:第一位固定为 19)。 ''' NeoForge:如 “20.4.30.0”(最后一位固定为 0)、“19.47.1.99”(Legacy:第一位固定为 19)。
''' </summary> ''' </summary>
Public Version As Version Public Version As Version
''' <summary> ''' <summary>
''' 可对玩家显示的非格式化版本名。 ''' 可读的非格式化版本名。
''' Forge:如 “50.1.9”、“14.22.1.2478”(Legacy)。 ''' Forge:如 “50.1.9”、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30-beta”、“47.1.99”(Legacy)。 ''' NeoForge:如 “20.4.30-beta”、“47.1.99”(Legacy)。
''' </summary> ''' </summary>
Public VersionName As String Public VersionName As String
''' <summary> ''' <summary>
''' 对应的 Minecraft 版本,如“1.12.2”。 ''' 对应的 Minecraft 版本,如 1.12.2、26.1-snapshot-1。
''' </summary> ''' </summary>
Public Inherit As String Public Inherit As String
Public Function CompareTo(other As DlForgelikeEntry) As Integer Implements IComparable(Of DlForgelikeEntry).CompareTo
If Version <> other.Version Then
Return Version.CompareTo(other.Version)
Else
Return CompareVersion(VersionName, other.VersionName)
End If
End Function
End Class End Class
Public Class DlForgeVersionEntry Public Class DlForgeVersionEntry
Inherits DlForgelikeEntry Inherits DlForgelikeEntry
''' <summary> ''' <summary>
''' 发布时间,格式为“yyyy/MM/dd HH:mm”。 ''' 发布时间,格式为“yyyy/MM/dd HH:mm”。
''' </summary> ''' </summary>
@@ -585,6 +603,23 @@
''' </summary> ''' </summary>
Public FileVersion As String Public FileVersion As String
''' <summary>
''' 加载器名称。Forge 或 NeoForge。
''' </summary>
Public Overrides ReadOnly Property LoaderName As String
Get
Return "Forge"
End Get
End Property
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public Overrides ReadOnly Property FileExtension As String
Get
Return If(Category = "installer", "jar", "zip")
End Get
End Property
Public Sub New(Version As String, Branch As String, Inherit As String) Public Sub New(Version As String, Branch As String, Inherit As String)
'司马版本的特殊处理 '司马版本的特殊处理
If Version = "11.15.1.2318" OrElse Version = "11.15.1.1902" OrElse Version = "11.15.1.1890" Then Branch = "1.8.9" If Version = "11.15.1.2318" OrElse Version = "11.15.1.1902" OrElse Version = "11.15.1.1890" Then Branch = "1.8.9"
@@ -594,8 +629,9 @@
VersionName = Version VersionName = Version
Me.Version = New Version(Version) Me.Version = New Version(Version)
Me.Inherit = Inherit Me.Inherit = Inherit
FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch) FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
End Sub End Sub
End Class End Class
''' <summary> ''' <summary>
@@ -604,7 +640,7 @@
Public Sub DlForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) Public Sub DlForgeVersionMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim DlForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Official", AddressOf DlForgeVersionOfficialMain) Dim DlForgeVersionOfficialLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Official", AddressOf DlForgeVersionOfficialMain)
Dim DlForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Bmclapi", AddressOf DlForgeVersionBmclapiMain) Dim DlForgeVersionBmclapiLoader As New LoaderTask(Of String, List(Of DlForgeVersionEntry))("DlForgeVersion Bmclapi", AddressOf DlForgeVersionBmclapiMain)
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30),
@@ -629,12 +665,12 @@
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String Dim Result As String
Try Try
Result = NetGetCodeByLoader("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Result = NetRequestByLoader("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4,#4057 Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4,#4057
".html", UseBrowserUserAgent:=True) ".html", SimulateBrowserHeaders:=True)
Catch ex As Exception Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then If ex.GetBrief().Contains("(404)") Then
Throw New Exception("不可用") Throw New Exception("无")
Else Else
Throw Throw
End If End If
@@ -692,7 +728,7 @@
Catch ex As Exception Catch ex As Exception
Throw New Exception("Forge 官方源版本列表解析失败(" & Result & ")", ex) Throw New Exception("Forge 官方源版本列表解析失败(" & Result & ")", ex)
End Try End Try
If Not Versions.Any() Then Throw New Exception("不可用") If Not Versions.Any() Then Throw New Exception("无")
Loader.Output = Versions Loader.Output = Versions
End Sub End Sub
@@ -700,9 +736,8 @@
''' Forge 版本列表,BMCLAPI。 ''' Forge 版本列表,BMCLAPI。
''' </summary> ''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry))) Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), '兼容 Forge 1.7.10-pre4,#4057 Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4,#4057
IsJson:=True)
Dim Versions As New List(Of DlForgeVersionEntry) Dim Versions As New List(Of DlForgeVersionEntry)
Try Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input) Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -747,7 +782,7 @@
Catch ex As Exception Catch ex As Exception
Throw New Exception("Forge BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex) Throw New Exception("Forge BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try End Try
If Not Versions.Any() Then Throw New Exception("不可用") If Not Versions.Any() Then Throw New Exception("无")
Loader.Output = Versions Loader.Output = Versions
End Sub End Sub
@@ -772,6 +807,7 @@
Public Class DlNeoForgeListEntry Public Class DlNeoForgeListEntry
Inherits DlForgelikeEntry Inherits DlForgelikeEntry
''' <summary> ''' <summary>
''' 是否是 Beta 版。 ''' 是否是 Beta 版。
''' </summary> ''' </summary>
@@ -785,23 +821,51 @@
''' </summary> ''' </summary>
Public ReadOnly Property UrlBase As String Public ReadOnly Property UrlBase As String
Get Get
Dim PackageName As String = If(IsLegacy, "forge", "neoforge") Dim PackageName As String = If(Inherit = "1.20.1", "forge", "neoforge")
Return $"https://maven.neoforged.net/releases/net/neoforged/{PackageName}/{ApiName}/{PackageName}-{ApiName}" Return $"https://maven.neoforged.net/releases/net/neoforged/{PackageName}/{ApiName}/{PackageName}-{ApiName}"
End Get End Get
End Property End Property
''' <summary>
''' 加载器名称。Forge 或 NeoForge。
''' </summary>
Public Overrides ReadOnly Property LoaderName As String
Get
Return "NeoForge"
End Get
End Property
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public Overrides ReadOnly Property FileExtension As String
Get
Return "jar"
End Get
End Property
Public Sub New(ApiName As String) Public Sub New(ApiName As String)
IsNeoForge = True IsNeoForge = True
Me.ApiName = ApiName Me.ApiName = ApiName
IsBeta = ApiName.Contains("beta") IsBeta = ApiName.ContainsF("beta", True) OrElse ApiName.ContainsF("alpha", True)
If ApiName.Contains("1.20.1") Then '1.20.1-47.1.99 If ApiName.Contains("1.20.1") Then '1.20.1-47.1.99
VersionName = ApiName.Replace("1.20.1-", "") VersionName = ApiName.Replace("1.20.1-", "")
Version = New Version("19." & VersionName) Version = New Version("19." & VersionName)
Inherit = "1.20.1" Inherit = "1.20.1"
Else '20.4.30-beta ElseIf ApiName.StartsWithF("0.") Then '0.25w14craftmine.3-beta
VersionName = ApiName
Dim Segments = ApiName.BeforeFirst("-").Split("."c)
Version = New Version(0, 0, Segments.Last)
Inherit = Segments(1)
Else '20.4.30-beta;26.1.0.0-alpha.1+snapshot-1
VersionName = ApiName VersionName = ApiName
Version = New Version(ApiName.BeforeFirst("-")) Version = New Version(ApiName.BeforeFirst("-"))
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor) If Version.Major >= 24 Then
Inherit = $"{Version.Major}.{Version.Minor}.{Version.Build}"
Else
Inherit = $"1.{Version.Major}.{Version.Minor}"
End If
If Inherit.EndsWithF(".0") Then Inherit = Left(Inherit, Inherit.Length - 2)
If VersionName.Contains("+") Then Inherit &= "-" & VersionName.AfterFirst("+")
End If End If
End Sub End Sub
End Class End Class
@@ -811,7 +875,7 @@
''' </summary> ''' </summary>
Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain) Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain)
Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult)) Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
@@ -836,8 +900,8 @@
Public DlNeoForgeListOfficialLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Official", AddressOf DlNeoForgeListOfficialMain) Public DlNeoForgeListOfficialLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Official", AddressOf DlNeoForgeListOfficialMain)
Private Sub DlNeoForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult)) Private Sub DlNeoForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON '获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByLoader("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True) Dim ResultLatest As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", RequireJson:=True)
Dim ResultLegacy As String = NetGetCodeByLoader("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True) Dim ResultLegacy As String = NetRequestByClientRetry("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", RequireJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")") If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析 '解析
Try Try
@@ -854,8 +918,8 @@
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain) Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain)
Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult)) Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON '获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByLoader("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True) Dim ResultLatest As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", RequireJson:=True)
Dim ResultLegacy As String = NetGetCodeByLoader("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True) Dim ResultLegacy As String = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", RequireJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")") If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析 '解析
Try Try
@@ -868,12 +932,12 @@
Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry) Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry)
Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson, Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson,
"(?<="")(1\.20\.1-)?\d+\.\d+\.\d+(-beta)?(?="")") '我寻思直接正则就行.jpg "(?<="")(1\.20\.1-)?\d+\.[^\.]+\.\d+(\.\d+)?(-(beta|alpha)(\.\d+)?)?(\+snapshot-\d+)?(?="")")
Dim Versions = VersionNames. Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中,但不能下载 Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中,但不能下载
Select(Function(name) New DlNeoForgeListEntry(name)).ToList Select(Function(name) New DlNeoForgeListEntry(name)).
If Not Versions.Any() Then Throw New Exception("不可用") OrderByDescending(Function(a) a).ToList
Versions = Versions.OrderByDescending(Function(a) a.Version).ToList If Not Versions.Any() Then Throw New Exception("无")
Return Versions Return Versions
End Function End Function
@@ -936,7 +1000,7 @@
''' </summary> ''' </summary>
Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain) Public DlLiteLoaderListLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Main", AddressOf DlLiteLoaderListMain)
Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult)) Private Sub DlLiteLoaderListMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30),
@@ -960,7 +1024,7 @@
''' </summary> ''' </summary>
Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain) Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult)) Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://dl.liteloader.com/versions/versions.json", IsJson:=True) Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True))
Try Try
Dim Json As JObject = Result("versions") Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry) Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -970,7 +1034,7 @@
Versions.Add(New DlLiteLoaderListEntry With { Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key, .Inherit = Pair.Key,
.IsLegacy = Pair.Key.Split(".")(1) < 8, .IsLegacy = Pair.Key.Split(".")(1) < 8,
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot", .IsPreview = RealEntry("stream").ToString.Lower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar", .FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"), .MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"), .ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
@@ -988,7 +1052,7 @@
''' </summary> ''' </summary>
Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain) Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult)) Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", IsJson:=True) Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True))
Try Try
Dim Json As JObject = Result("versions") Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry) Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -998,7 +1062,7 @@
Versions.Add(New DlLiteLoaderListEntry With { Versions.Add(New DlLiteLoaderListEntry With {
.Inherit = Pair.Key, .Inherit = Pair.Key,
.IsLegacy = Pair.Key.Split(".")(1) < 8, .IsLegacy = Pair.Key.Split(".")(1) < 8,
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot", .IsPreview = RealEntry("stream").ToString.Lower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar", .FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"), .MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"), .ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy'/'MM'/'dd HH':'mm"),
@@ -1035,7 +1099,7 @@
''' </summary> ''' </summary>
Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain) Public DlFabricListLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Main", AddressOf DlFabricListMain)
Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult)) Private Sub DlFabricListMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Settings.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30),
@@ -1059,7 +1123,7 @@
''' </summary> ''' </summary>
Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain) Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain)
Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult)) Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://meta.fabricmc.net/v2/versions", IsJson:=True) Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True))
Try Try
Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result} Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项") If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1074,7 +1138,7 @@
''' </summary> ''' </summary>
Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain) Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult)) Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", IsJson:=True) Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True))
Try Try
Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result} Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项") If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1101,72 +1165,37 @@
#Region "DlMod | Mod 镜像源请求" #Region "DlMod | Mod 镜像源请求"
''' <summary> ''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。 ''' 对可能涉及 Mod 镜像源的请求进行处理,返回 JToken。
''' 调用 NetGetCodeByRequest,会进行重试。
''' </summary>
Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
'Dim McimUrl As String = DlSourceModGet(Url)
'If McimUrl <> Url Then
' Select Case Setup.Get("ToolDownloadMod")
' Case 0
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
' Case 1
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' Case Else
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' End Select
'End If
Dim Exs As String = ""
For Each Source In Urls
Try
Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000, IsJson:=IsJson, UseBrowserUserAgent:=True)
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
Next
Throw New Exception(Exs)
End Function
''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理。
''' 调用 NetRequest,会进行重试。 ''' 调用 NetRequest,会进行重试。
''' </summary> ''' </summary>
Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String) As String Public Function DlModRequest(Url As String, Optional Method As HttpMethod = Nothing,
Optional Content As String = Nothing, Optional ContentType As String = Nothing) As JToken
Dim Urls As New List(Of KeyValuePair(Of String, Integer)) Dim Urls As New List(Of KeyValuePair(Of String, Integer))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) Dim McimUrl As String = DlSourceModGet(Url)
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20)) If McimUrl <> Url Then
'Dim McimUrl As String = DlSourceModGet(Url) Select Case Settings.Get("ToolDownloadMod")
'If McimUrl <> Url Then Case 0
' Select Case Setup.Get("ToolDownloadMod") Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' Case 0 Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) Case 1
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10))) '至少 20s,要不然 Modrinth 返回不过来
' Case 1 Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5)) Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15)) Case Else
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10)))
' Case Else Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15)) End Select
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10)) Else
' End Select Urls.Add(New KeyValuePair(Of String, Integer)(Url, If(Url.Contains("modrinth"), 20, 10)))
'End If Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
End If
Dim Exs As String = "" Dim Exs As String = ""
For Each Source In Urls For Each Source In Urls
Try Try
Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000) Return GetJson(NetRequestByClient(Source.Key, Method, Content, ContentType, Timeout:=Source.Value * 1000, Encoding:=Encoding.UTF8, RequireJson:=True))
Catch ex As Exception Catch ex As Exception
Exs += ex.Message + vbCrLf Exs += ex.Message + vbCrLf
End Try End Try
@@ -1184,7 +1213,7 @@
''' </summary> ''' </summary>
Public ReadOnly Property DlSourcePreferMojang As Boolean Public ReadOnly Property DlSourcePreferMojang As Boolean
Get Get
Return Setup.Get("ToolDownloadSource") = 2 OrElse (Setup.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang) Return Settings.Get("ToolDownloadSource") = 2 OrElse (Settings.Get("ToolDownloadSource") = 1 AndAlso DlPreferMojang)
End Get End Get
End Property End Property
''' <summary> ''' <summary>
@@ -1198,7 +1227,7 @@
''' </summary> ''' </summary>
Public ReadOnly Property DlVersionListPreferMojang As Boolean Public ReadOnly Property DlVersionListPreferMojang As Boolean
Get Get
Return Setup.Get("ToolDownloadVersion") = 2 OrElse (Setup.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang) Return Settings.Get("ToolDownloadVersion") = 2 OrElse (Settings.Get("ToolDownloadVersion") = 1 AndAlso DlPreferMojang)
End Get End Get
End Property End Property
''' <summary> ''' <summary>
@@ -1269,7 +1298,14 @@
'Mod 下载源 'Mod 下载源
Public Function DlSourceModGet(Original As String) As String Public Function DlSourceModGet(Original As String) As String
Return Original Return Original.
Replace("api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("cdn.modrinth.com", "mod.mcimirror.top").
Replace("api.curseforge.com", "mod.mcimirror.top/curseforge").
Replace("edge.forgecdn.net", "mod.mcimirror.top").
Replace("mediafilez.forgecdn.net", "mod.mcimirror.top").
Replace("media.forgecdn.net", "mod.mcimirror.top")
End Function End Function
'Loader 自动切换 'Loader 自动切换
@@ -1290,7 +1326,7 @@
If SubLoader.Key.State = LoadState.Finished Then If SubLoader.Key.State = LoadState.Finished Then
'检查加载器成功 '检查加载器成功
MainLoader.Output = SubLoader.Key.Output MainLoader.Output = SubLoader.Key.Output
DlSourceLoaderAbort(LoaderList) DlSourceLoaderInterrupt(LoaderList)
Return Return
ElseIf BeforeLoadersAllFailed Then ElseIf BeforeLoadersAllFailed Then
'此前的加载器全部失败,直接启动后续加载器 '此前的加载器全部失败,直接启动后续加载器
@@ -1316,13 +1352,13 @@
For ii = 0 To LoaderList.Count - 1 For ii = 0 To LoaderList.Count - 1
LoaderList(ii).Key.Input = Nothing '重置输入,以免以同样的输入“重试加载”时直接失败 LoaderList(ii).Key.Input = Nothing '重置输入,以免以同样的输入“重试加载”时直接失败
If LoaderList(ii).Key.Error IsNot Nothing Then If LoaderList(ii).Key.Error IsNot Nothing Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("不可用") Then If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message = "无" Then
ErrorInfo = LoaderList(ii).Key.Error ErrorInfo = LoaderList(ii).Key.Error
End If End If
End If End If
Next Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时") If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderAbort(LoaderList) DlSourceLoaderInterrupt(LoaderList)
Throw ErrorInfo Throw ErrorInfo
End If End If
Exit For Exit For
@@ -1331,15 +1367,15 @@
Thread.Sleep(10) Thread.Sleep(10)
WaitCycle += 1 WaitCycle += 1
'检查父加载器中断 '检查父加载器中断
If MainLoader.IsAborted Then If MainLoader.IsInterrupted Then
DlSourceLoaderAbort(LoaderList) DlSourceLoaderInterrupt(LoaderList)
Return Return
End If End If
Loop Loop
End Sub End Sub
Private Sub DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer))) Private Sub DlSourceLoaderInterrupt(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
For Each Loader In LoaderList For Each Loader In LoaderList
If Loader.Key.State = LoadState.Loading Then Loader.Key.Abort() If Loader.Key.State = LoadState.Loading Then Loader.Key.Interrupt()
Next Next
End Sub End Sub
@@ -10,7 +10,7 @@
'路径 '路径
''' <summary> ''' <summary>
''' Java.exe 文件的完整路径。 ''' java.exe 文件的完整路径。
''' </summary> ''' </summary>
Public ReadOnly Property PathJava As String Public ReadOnly Property PathJava As String
Get Get
@@ -18,15 +18,7 @@
End Get End Get
End Property End Property
''' <summary> ''' <summary>
''' Javaw.exe 文件的完整路径。 ''' java.exe 文件所在文件夹的路径,以 \ 结尾。
''' </summary>
Public ReadOnly Property PathJavaw As String
Get
Return PathFolder & "javaw.exe"
End Get
End Property
''' <summary>
''' Javaw.exe 文件所在文件夹的路径,以 \ 结尾。
''' </summary> ''' </summary>
Public PathFolder As String Public PathFolder As String
''' <summary> ''' <summary>
@@ -43,7 +35,7 @@
''' <summary> ''' <summary>
''' Java 的大版本号。 ''' Java 的大版本号。
''' </summary> ''' </summary>
Public ReadOnly Property VersionCode As Integer Public ReadOnly Property MajorVersion As Integer
Get Get
Return Version.Minor Return Version.Minor
End Get End Get
@@ -79,7 +71,7 @@
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Dim VersionString = Version.ToString Dim VersionString = Version.ToString
If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3) If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3)
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")" & If(Is64Bit, "", ",32 位") & If(IsUserImport, ",手动导入", "") & ":" & PathFolder Return If(IsJre, "JRE ", "JDK ") & MajorVersion & " (" & VersionString & ")" & If(Is64Bit, "", ",32 位") & If(IsUserImport, ",手动导入", "") & ":" & PathFolder
End Function End Function
'构造 '构造
@@ -102,21 +94,16 @@
Dim Output As String = Nothing Dim Output As String = Nothing
Try Try
'确定文件存在 '确定文件存在
If Not File.Exists(PathJavaw) Then If Not File.Exists(PathJava) Then Throw New FileNotFoundException("未找到 java.exe 文件", PathJava)
Throw New FileNotFoundException("未找到 javaw.exe 文件", PathJavaw) If {"finalshell", "Paranoia File"}.Any(Function(n) PathJava.ContainsF(n, True)) Then Throw New Exception("不兼容该精简版 Java") '#2249、#8080
End If If File.Exists(PathFolder & "pdf-bookmark") Then Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
If Not File.Exists(PathFolder & "java.exe") Then
Throw New FileNotFoundException("未找到 java.exe 文件", PathFolder & "java.exe")
End If
If File.Exists(PathFolder & "pdf-bookmark") Then
Throw New Exception("不兼容 PDF Bookmark 的 Java") '#5326
End If
IsJre = Not File.Exists(PathFolder & "javac.exe") IsJre = Not File.Exists(PathFolder & "javac.exe")
'运行 -version '运行 -version
Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 15000).ToLower Output = StartProcessAndGetOutput(PathJava, "-version", 15000).Lower
If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败") If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
If ModeDebug Then Log("[Java] Java 检查输出:" & PathFolder & "java.exe" & vbCrLf & Output) If ModeDebug Then Log("[Java] Java 检查输出:" & PathJava & vbCrLf & Output)
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试") If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
If Output.Contains("a fatal error") Then Throw New ApplicationException("无法运行该 Java,该 Java 或系统存在问题")
'获取详细信息 '获取详细信息
Dim VersionString = If(RegexSeek(Output, "(?<=version "")[^""]+"), If(RegexSeek(Output, "(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First 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" If VersionString.Split(".").Count > 4 Then VersionString = VersionString.Replace(".0.", ".") '#3493,VersionString = "21.0.2.0.2"
@@ -135,17 +122,15 @@
End If End If
Is64Bit = Output.Contains("64-bit") Is64Bit = Output.Contains("64-bit")
If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败,获取的版本为 " & Version.ToString) If Version.Minor <= 4 OrElse Version.Minor >= 100 Then Throw New ApplicationException("分析详细信息失败,获取的版本为 " & Version.ToString)
'基于 #3649,在 64 位系统上禁用 32 位 Java '#3649:在 64 位系统上禁用 32 位 Java
If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本,请安装 64 位的 Java") If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本,请安装 64 位的 Java")
'基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败,干脆禁用更多版本的 JRE
If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差,因此不再允许使用。你可以使用对应版本的 JDK,而非 JRE!")
Catch ex As ApplicationException Catch ex As ApplicationException
Throw ex Throw ex
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw ex Throw ex
Catch ex As Exception Catch ex As Exception
Log("[Java] 检查失败的 Java 输出:" & PathFolder & "java.exe" & vbCrLf & If(Output, "无程序输出")) Log("[Java] 检查失败的 Java 输出:" & If(PathJava, "Nothing") & vbCrLf & If(Output, "无程序输出"))
Throw New Exception("检查 Java 失败(" & If(PathJavaw, "Nothing") & ")", ex) Throw New Exception("检查 Java 失败(" & If(PathJava, "Nothing") & ")", ex)
End Try End Try
IsChecked = True IsChecked = True
End Sub End Sub
@@ -180,13 +165,13 @@
Public Sub JavaListInit() Public Sub JavaListInit()
JavaList = New List(Of JavaEntry) JavaList = New List(Of JavaEntry)
Try Try
If Setup.Get("CacheJavaListVersion") < JavaListCacheVersion Then If Settings.Get("CacheJavaListVersion") < JavaListCacheVersion Then
'不使用缓存 '不使用缓存
Log("[Java] 要求 Java 列表缓存更新") Log("[Java] 要求 Java 列表缓存更新")
Setup.Set("CacheJavaListVersion", JavaListCacheVersion) Settings.Set("CacheJavaListVersion", JavaListCacheVersion)
Else Else
'使用缓存 '使用缓存
For Each JsonEntry In GetJson(Setup.Get("LaunchArgumentJavaAll")) For Each JsonEntry In GetJson(Settings.Get("LaunchArgumentJavaAll"))
JavaList.Add(JavaEntry.FromJson(JsonEntry)) JavaList.Add(JavaEntry.FromJson(JsonEntry))
Next Next
End If End If
@@ -199,7 +184,7 @@
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化 Java 列表失败", LogLevel.Feedback) Log(ex, "初始化 Java 列表失败", LogLevel.Feedback)
Setup.Set("LaunchArgumentJavaAll", "[]") Settings.Set("LaunchArgumentJavaAll", "[]")
End Try End Try
End Sub End Sub
@@ -213,19 +198,19 @@
''' 必须在工作线程调用,且必须包括 SyncLock JavaLock。 ''' 必须在工作线程调用,且必须包括 SyncLock JavaLock。
''' </summary> ''' </summary>
Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing, Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing,
Optional RelatedVersion As McVersion = Nothing) As JavaEntry Optional GameInstance As McInstance = Nothing) As JavaEntry
Try Try
Dim AllowedJavaList As New List(Of JavaEntry) Dim AllowedJavaList As New List(Of JavaEntry)
'添加特定的 Java '添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean) Dim JavaPreList As New Dictionary(Of String, Boolean)
If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then If McFolderSelected.Split("\").Count > 3 AndAlso Not McFolderSelected.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录或 %APPDATA% 的话) JavaSearchFolder(GetPathFromFullPath(McFolderSelected), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录或 %APPDATA% 的话)
End If End If
JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹 JavaSearchFolder(McFolderSelected, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")). JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java(#4286) ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java(#4286)
If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹 If GameInstance IsNot Nothing Then JavaSearchFolder(GameInstance.PathVersion, JavaPreList, False, True) '所选版本文件夹
Dim TargetJavaList As New List(Of JavaEntry) Dim TargetJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList For Each Entry In JavaPreList
TargetJavaList.Add(New JavaEntry(Entry.Key, Entry.Value)) TargetJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
@@ -246,8 +231,8 @@
'获取版本独立设置中指定的 Java '获取版本独立设置中指定的 Java
Dim VersionSelect As String = "" Dim VersionSelect As String = ""
If RelatedVersion IsNot Nothing Then If GameInstance IsNot Nothing Then
VersionSelect = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion) VersionSelect = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If VersionSelect.StartsWithF("{") Then If VersionSelect.StartsWithF("{") Then
Try Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect)) UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
@@ -256,22 +241,22 @@
Throw Throw
Catch ex As Exception Catch ex As Exception
UserJava = Nothing UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion) Settings.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint) Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try End Try
End If End If
End If End If
'获取全局设置中指定的 Java '获取全局设置中指定的 Java
If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Settings.Get("LaunchArgumentJavaSelect") <> "" Then
Try Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("LaunchArgumentJavaSelect"))) UserJava = JavaEntry.FromJson(GetJson(Settings.Get("LaunchArgumentJavaSelect")))
UserJava.Check() UserJava.Check()
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As Exception Catch ex As Exception
UserJava = Nothing UserJava = Nothing
Setup.Reset("LaunchArgumentJavaSelect") Settings.Reset("LaunchArgumentJavaSelect")
Log(ex, "全局设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint) Log(ex, "全局设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try End Try
End If End If
@@ -290,7 +275,7 @@ RetryGet:
Select Case JavaSearchLoader.State Select Case JavaSearchLoader.State
Case LoadState.Failed Case LoadState.Failed
Throw JavaSearchLoader.Error Throw JavaSearchLoader.Error
Case LoadState.Aborted Case LoadState.Interrupted
Throw New ThreadInterruptedException("Java 搜索加载器已中断") Throw New ThreadInterruptedException("Java 搜索加载器已中断")
End Select End Select
@@ -344,8 +329,8 @@ RetryGet:
Dim Right As String = MaxVersion.Minor & If(ShowRevision, "." & MaxVersion.MajorRevision & "." & MaxVersion.MinorRevision, "") Dim Right As String = MaxVersion.Minor & If(ShowRevision, "." & MaxVersion.MajorRevision & "." & MaxVersion.MinorRevision, "")
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right) Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If End If
Dim JavaCurrent As String = UserJava.VersionCode & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "") Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion) Then If GameInstance IsNot Nothing AndAlso Settings.Get("VersionAdvanceJava", GameInstance) Then
'直接跳过弹窗 '直接跳过弹窗
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug) Log("[Java] 设置中指定了使用 Java " & JavaCurrent & ",但当前版本" & Requirement & ",这可能会导致游戏崩溃!", LogLevel.Debug)
AllowedJavaList = New List(Of JavaEntry) From {UserJava} AllowedJavaList = New List(Of JavaEntry) From {UserJava}
@@ -386,7 +371,7 @@ ExitUserJavaCheck:
UserPass: UserPass:
'对适合的 Java 进行排序 '对适合的 Java 进行排序
AllowedJavaList = AllowedJavaList.Sort(AddressOf JavaSorter) AllowedJavaList = AllowedJavaList.SortByComparison(AddressOf JavaSorter)
Log($"[Java] 排序后的 Java 优先顺序:") Log($"[Java] 排序后的 Java 优先顺序:")
For Each Java In AllowedJavaList For Each Java In AllowedJavaList
Log($"[Java] - {Java}") Log($"[Java] - {Java}")
@@ -422,12 +407,12 @@ UserPass:
''' <summary> ''' <summary>
''' 是否强制指定了 64 位 Java。如果没有强制指定,返回是否安装了 64 位 Java。 ''' 是否强制指定了 64 位 Java。如果没有强制指定,返回是否安装了 64 位 Java。
''' </summary> ''' </summary>
Public Function JavaIs64Bit(Optional RelatedVersion As McVersion = Nothing) As Boolean Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean
Try Try
'检查强制指定 '检查强制指定
Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect") Dim UserSetup As String = Settings.Get("LaunchArgumentJavaSelect")
If RelatedVersion IsNot Nothing Then If GameInstance IsNot Nothing Then
Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion) Dim UserSetupVersion As String = Settings.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion
End If End If
If UserSetup <> "" Then If UserSetup <> "" Then
@@ -436,7 +421,7 @@ UserPass:
UserJava = JavaEntry.FromJson(GetJson(UserSetup)) UserJava = JavaEntry.FromJson(GetJson(UserSetup))
Catch ex As Exception Catch ex As Exception
Log(ex, "版本指定的 Java 信息已损坏,已重置版本设置中指定的 Java") Log(ex, "版本指定的 Java 信息已损坏,已重置版本设置中指定的 Java")
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=RelatedVersion) Settings.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance)
GoTo NoUserJava GoTo NoUserJava
End Try End Try
For Each Java In JavaList For Each Java In JavaList
@@ -451,7 +436,7 @@ NoUserJava:
Return False Return False
Catch ex As Exception Catch ex As Exception
Log(ex, "检查 Java 类别时出错", LogLevel.Feedback) Log(ex, "检查 Java 类别时出错", LogLevel.Feedback)
Setup.Set("LaunchArgumentJavaSelect", "") Settings.Set("LaunchArgumentJavaSelect", "")
Return True Return True
End Try End Try
End Function End Function
@@ -459,13 +444,15 @@ NoUserJava:
''' 将 Java 按照适用性排序。 ''' 将 Java 按照适用性排序。
''' </summary> ''' </summary>
Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
Dim PathInfo As New DirectoryInfo(Path)
Dim PathMcInfo As New DirectoryInfo(McFolderSelected)
'1. 尽量在当前文件夹或当前 Minecraft 文件夹 '1. 尽量在当前文件夹或当前 Minecraft 文件夹
Dim ProgramPathParent As String, MinecraftPathParent As String = "" Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(New DirectoryInfo(Path).Parent, New DirectoryInfo(Path)).FullName ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName
If PathMcFolder <> "" Then MinecraftPathParent = If(New DirectoryInfo(PathMcFolder).Parent, New DirectoryInfo(PathMcFolder)).FullName If McFolderSelected <> "" Then MinecraftPathParent = If(PathMcInfo.Parent, PathMcInfo).FullName
If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True 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 Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
If PathMcFolder <> "" Then If McFolderSelected <> "" Then
If Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return True 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 If Not Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return False
End If End If
@@ -476,10 +463,11 @@ NoUserJava:
If Left.IsJre AndAlso Not Right.IsJre Then Return True If Left.IsJre AndAlso Not Right.IsJre Then Return True
If Not Left.IsJre AndAlso Right.IsJre Then Return False If Not Left.IsJre AndAlso Right.IsJre Then Return False
'4. Java 大版本 '4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then If Left.MajorVersion <> Right.MajorVersion Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23... ' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18} Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17} '更高的版本指定为 20,且越低越好
Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode) Return If(Left.MajorVersion > 20, 20 - Left.MajorVersion * 0.0001, Weight.ElementAtOrDefault(Left.MajorVersion)) >=
If(Right.MajorVersion > 20, 20 - Right.MajorVersion * 0.0001, Weight.ElementAtOrDefault(Right.MajorVersion))
End If End If
'5. 最次级版本号更接近 51 '5. 最次级版本号更接近 51
Return Math.Abs(Left.Version.Revision - 51) <= Math.Abs(Right.Version.Revision - 51) Return Math.Abs(Left.Version.Revision - 51) <= Math.Abs(Right.Version.Revision - 51)
@@ -499,11 +487,11 @@ NoUserJava:
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub) End Sub)
End If End If
If FrmVersionSetup IsNot Nothing Then If FrmInstanceSetup IsNot Nothing Then
RunInUiWait( RunInUiWait(
Sub() Sub()
FrmVersionSetup.ComboArgumentJava.Items.Clear() FrmInstanceSetup.ComboArgumentJava.Items.Clear()
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) FrmInstanceSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub) End Sub)
End If End If
@@ -529,15 +517,14 @@ NoUserJava:
If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器(#3705) If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器(#3705)
JavaSearchFolder(Disk.Name, JavaPreList, False) JavaSearchFolder(Disk.Name, JavaPreList, False)
Next Next
'查找 APPDATA 文件夹中的 Java '查找用户文件夹中的 Java
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\", JavaPreList, False) JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile), JavaPreList, False)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) & "\", JavaPreList, False) JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.jdks\", JavaPreList, False, IsFullSearch:=True)
JavaSearchFolder(Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) & "\.sdkman\candidates\java\", JavaPreList, False, IsFullSearch:=True)
'查找启动器目录中的 Java '查找启动器目录中的 Java
JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True) JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
'查找所选 Minecraft 文件夹中的 Java '查找所选 Minecraft 文件夹中的 Java
If Not String.IsNullOrWhiteSpace(PathMcFolder) AndAlso Path <> PathMcFolder Then If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso Path <> McFolderSelected Then JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
JavaSearchFolder(PathMcFolder, JavaPreList, False, IsFullSearch:=True)
End If
'若不全为符号链接,则清除符号链接的地址 '若不全为符号链接,则清除符号链接的地址
Dim JavaWithoutReparse As New Dictionary(Of String, Boolean) Dim JavaWithoutReparse As New Dictionary(Of String, Boolean)
@@ -571,7 +558,7 @@ NoUserJava:
#Region "添加玩家手动导入的 Java" #Region "添加玩家手动导入的 Java"
Dim ImportedJava As String = Setup.Get("LaunchArgumentJavaAll") Dim ImportedJava As String = Settings.Get("LaunchArgumentJavaAll")
Try Try
For Each JavaJsonObject In GetJson(ImportedJava) For Each JavaJsonObject In GetJson(ImportedJava)
Dim Entry = JavaEntry.FromJson(JavaJsonObject) Dim Entry = JavaEntry.FromJson(JavaJsonObject)
@@ -579,24 +566,24 @@ NoUserJava:
Next Next
Catch ex As Exception Catch ex As Exception
Log(ex, "Java 列表已损坏", LogLevel.Feedback) Log(ex, "Java 列表已损坏", LogLevel.Feedback)
Setup.Set("LaunchArgumentJavaAll", "[]") Settings.Set("LaunchArgumentJavaAll", "[]")
End Try End Try
#End Region #End Region
'确保可用并获取详细信息,转入正式列表 '确保可用并获取详细信息,转入正式列表
Dim NewJavaList As New List(Of JavaEntry) Dim NewJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794 For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.Lower = b.Key.Lower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value)) NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next Next
NewJavaList = JavaCheckList(NewJavaList).Sort(AddressOf JavaSorter) NewJavaList = JavaCheckList(NewJavaList).SortByComparison(AddressOf JavaSorter)
'修改设置项 '修改设置项
Dim AllList As New JArray Dim AllList As New JArray
For Each Java In NewJavaList For Each Java In NewJavaList
AllList.Add(Java.ToJson) AllList.Add(Java.ToJson)
Next Next
Setup.Set("LaunchArgumentJavaAll", AllList.ToString(Newtonsoft.Json.Formatting.None)) Settings.Set("LaunchArgumentJavaAll", AllList.ToString(Newtonsoft.Json.Formatting.None))
JavaList = NewJavaList JavaList = NewJavaList
Catch ex As Exception Catch ex As Exception
@@ -605,8 +592,8 @@ NoUserJava:
End Try End Try
Log("[Java] Java 搜索完成,发现 " & JavaList.Count & " 个 Java") Log("[Java] Java 搜索完成,发现 " & JavaList.Count & " 个 Java")
If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.RefreshJavaComboBox()) If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.UpdateJavaComboBox())
If FrmVersionSetup IsNot Nothing Then RunInUi(Sub() FrmVersionSetup.RefreshJavaComboBox()) If FrmInstanceSetup IsNot Nothing Then RunInUi(Sub() FrmInstanceSetup.RefreshJavaComboBox())
End Sub End Sub
''' <summary> ''' <summary>
@@ -656,7 +643,7 @@ Wait:
Private Sub JavaSearchFolder(OriginalPath As String, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False) Private Sub JavaSearchFolder(OriginalPath As String, ByRef Results As Dictionary(Of String, Boolean), Source As Boolean, Optional IsFullSearch As Boolean = False)
Try Try
Log("[Java] 开始" & If(IsFullSearch, "完全", "部分") & "遍历查找:" & OriginalPath) Log("[Java] 开始" & If(IsFullSearch, "完全", "部分") & "遍历查找:" & OriginalPath)
JavaSearchFolder(New DirectoryInfo(ShortenPath(OriginalPath)), Results, Source, IsFullSearch) JavaSearchFolder(New DirectoryInfo(OriginalPath), Results, Source, IsFullSearch)
Catch ex As UnauthorizedAccessException Catch ex As UnauthorizedAccessException
Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹:" & OriginalPath) Log("[Java] 遍历查找 Java 时遭遇无权限的文件夹:" & OriginalPath)
Catch ex As Exception Catch ex As Exception
@@ -677,19 +664,19 @@ Wait:
'若该目录有 Java,则加入结果 '若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹 '查找其下的所有文件夹
'不应使用网易的 Java:https://github.com/Hex-Dragon/PCL2/issues/1279#issuecomment-2761489121 '不应使用网易的 Java:https://github.com/Meloong-Git/PCL/issues/1279#issuecomment-2761489121
Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon", Static Keywords As String() = {
"soft", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net", "java", "jdk", "jre", "env", "环境", "run", "软件", "mc", "dragon", "well", "bin", "sdk", "candidate", "current",
"software", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
"游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合", "游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
"应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot", "应用", "运行", "前置", "mojang", "官启", "官方", "新建文件夹", "eclipse", "microsoft", "hotspot",
"runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清", "runtime", "x86", "x64", "arm", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "forge", "fabric",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages", "download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages", "4297127d64ec6", "1.", "启动", "jbr"}
"4297127d64ec6", "1.", "启动"}
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接 If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串 Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).Lower '用于搜索的字符串
If IsFullSearch OrElse If IsFullSearch OrElse
OriginalPath.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then OriginalPath.Name.Lower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
JavaSearchFolder(FolderInfo, Results, Source) JavaSearchFolder(FolderInfo, Results, Source)
End If End If
Next Next
@@ -705,34 +692,18 @@ Wait:
#Region "下载" #Region "下载"
''' <summary> ''' <summary>
''' 提示 Java 缺失,并弹窗确认是否自动下载。返回玩家选择是否下载。 ''' 获取下载 Java 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' </summary> ''' </summary>
Public Function JavaDownloadConfirm(VersionDescription As String, Optional ForcedManualDownload As Boolean = False) As Boolean Public Function GetJavaDownloadLoader() As LoaderCombo(Of String)
If ForcedManualDownload Then
MyMsgBox($"PCL 未找到 {VersionDescription}。" & vbCrLf &
$"请自行搜索并安装 {VersionDescription},安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。",
"未找到 Java")
Return False
Else
Return MyMsgBox($"PCL 未找到 {VersionDescription},是否需要 PCL 自动下载?" & vbCrLf &
$"如果你已经安装了 {VersionDescription},可以在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"自动下载 Java?", "自动下载", "取消") = 1
End If
End Function
''' <summary>
''' 获取下载 Java 8/14/17/21 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' </summary>
Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer)
Dim JavaDownloadLoader As New LoaderDownload("下载 Java 文件", New List(Of NetFile)) With {.ProgressWeight = 10} Dim JavaDownloadLoader As New LoaderDownload("下载 Java 文件", New List(Of NetFile)) With {.ProgressWeight = 10}
Dim Loader = New LoaderCombo(Of Integer)($"下载 Java {Version}", { Dim Loader = New LoaderCombo(Of String)($"下载 Java", {
New LoaderTask(Of Integer, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2}, New LoaderTask(Of String, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2},
JavaDownloadLoader, JavaDownloadLoader,
JavaSearchLoader JavaSearchLoader
}) })
AddHandler JavaDownloadLoader.OnStateChangedThread, AddHandler JavaDownloadLoader.OnStateChangedThread,
Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState) Sub(Raw As LoaderBase, NewState As LoadState, OldState As LoadState)
If (NewState = LoadState.Failed OrElse NewState = LoadState.Aborted) AndAlso LastJavaBaseDir IsNot Nothing Then If (NewState = LoadState.Failed OrElse NewState = LoadState.Interrupted) AndAlso LastJavaBaseDir IsNot Nothing Then
Log($"[Java] 由于下载未完成,清理未下载完成的 Java 文件:{LastJavaBaseDir}", LogLevel.Debug) Log($"[Java] 由于下载未完成,清理未下载完成的 Java 文件:{LastJavaBaseDir}", LogLevel.Debug)
DeleteDirectory(LastJavaBaseDir) DeleteDirectory(LastJavaBaseDir)
ElseIf NewState = LoadState.Finished Then ElseIf NewState = LoadState.Finished Then
@@ -743,22 +714,29 @@ Wait:
Return Loader Return Loader
End Function End Function
Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹,防止残留只下了一半但 -version 能跑的 Java Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹,防止残留只下了一半但 -version 能跑的 Java
Private Sub JavaFileList(Loader As LoaderTask(Of Integer, List(Of NetFile))) Private Sub JavaFileList(Loader As LoaderTask(Of String, List(Of NetFile)))
Log("[Java] 开始获取 Java 下载信息") Log("[Java] 开始获取 Java 下载信息")
Dim IndexFileStr As String = NetGetCodeByLoader(DlVersionListOrder( Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder(
{"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}, {"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"} {"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}
), IsJson:=True) ), IsJson:=True)
'获取下载地址 '查找要下载的目标 Java
Dim MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}") Dim TargetEntry As JProperty = Nothing
Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项(最新) Dim Components As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
SelectMany(Function(e As JProperty) CType(e.Value, JArray).Select(Function(v) New KeyValuePair(Of String, JObject)(e.Name, v))) If Components.ContainsKey(Loader.Input) Then '精确匹配
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWithF(Loader.Input)) TargetEntry = Components.Property(Loader.Input)
Dim Address As String = TargetEntry.Value("manifest")("url") Else '模糊匹配
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}") TargetEntry = Components.Properties.FirstOrDefault(
Function(c) c.Value IsNot Nothing AndAlso c.Value.ToArray.FirstOrDefault()?("version")("name").ToString.StartsWithF(Loader.Input))
If TargetEntry Is Nothing Then Throw New Exception($"未能找到所需的 Java {Loader.Input}")
End If
Dim TargetComponent = TargetEntry.Value.ToArray.FirstOrDefault
If TargetComponent Is Nothing Then Throw New Exception($"Mojang 未提供所需的 Java {Loader.Input}")
'获取文件列表 '获取文件列表
Dim ListFileStr As String = NetGetCodeByLoader(DlSourceOrder({Address}, {Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com")}), IsJson:=True) Dim Address As String = TargetComponent("manifest")("url")
LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\" McLaunchLog($"准备下载 Java {TargetComponent("version")("name")}({TargetEntry.Name}):{Address}")
Dim ListFileStr As String = NetRequestByLoader(DlSourceOrder({Address}, {Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com")}), IsJson:=True)
LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Name & "\"
Dim Results As New List(Of NetFile) Dim Results As New List(Of NetFile)
For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files") For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files")
If CType(File.Value, JObject)("downloads")?("raw") Is Nothing Then Continue For If CType(File.Value, JObject)("downloads")?("raw") Is Nothing Then Continue For
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
+121 -521
View File
@@ -1,7 +1,7 @@
Imports System.IO.Compression Imports System.IO.Compression
Public Module ModMod Public Module ModMod
Private Const LocalModCacheVersion As Integer = 7 Private Const LocalModCacheVersion As Integer = 13
Public Class McMod Public Class McMod
@@ -46,10 +46,7 @@ Public Module ModMod
''' </summary> ''' </summary>
Public ReadOnly Property State As McModState Public ReadOnly Property State As McModState
Get Get
Load() If Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
If Not IsFileAvailable Then
Return McModState.Unavailable
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
Return McModState.Disabled Return McModState.Disabled
Else Else
Return McModState.Fine Return McModState.Fine
@@ -59,7 +56,6 @@ Public Module ModMod
Public Enum McModState As Integer Public Enum McModState As Integer
Fine = 0 Fine = 0
Disabled = 1 Disabled = 1
Unavailable = 2
End Enum End Enum
#End Region #End Region
@@ -67,18 +63,23 @@ Public Module ModMod
#Region "信息项" #Region "信息项"
''' <summary> ''' <summary>
''' Mod 的名称。若不可用则为 ModID 或无扩展的文件名。 ''' 当任何信息在初始化后更新时触发。
''' </summary> ''' </summary>
Public Property Name As String Public Event OnUpdate(sender As McMod)
''' <summary>
''' Mod 的可读名称。
''' 可能为无扩展的文件名,但不会是 Nothing。
''' </summary>
Public Property DisplayName As String
Get Get
If _Name Is Nothing Then Load() If _Name Is Nothing Then _Name = CompFile?.DisplayName
If _Name Is Nothing Then _Name = _ModId If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path)
If _Name Is Nothing Then _Name = GetFileNameWithoutExtentionFromPath(Path)
Return _Name Return _Name
End Get End Get
Set(value As String) Set(value As String)
If _Name Is Nothing AndAlso value IsNot Nothing AndAlso Not value.Contains("modname") 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 value.Lower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
_Name = value _Name = value
End If End If
End Set End Set
@@ -87,226 +88,67 @@ Public Module ModMod
''' <summary> ''' <summary>
''' Mod 的描述信息。 ''' Mod 的描述信息。
''' 可能为 Nothing。
''' </summary> ''' </summary>
Public Property Description As String Public Property Description As String
Get Get
If _Description Is Nothing Then Load()
If _Description Is Nothing AndAlso FileUnavailableReason IsNot Nothing Then _Description = FileUnavailableReason.Message
'If _Description Is Nothing Then _Description = Path
Return _Description Return _Description
End Get End Get
Set(value As String) Set(value As String)
If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then If _Description Is Nothing AndAlso value IsNot Nothing AndAlso value.Count > 2 Then
_Description = value.ToString.Trim(vbLf) _Description = value.ToString.Trim(vbLf)
'优化显示:若以 [a-zA-Z0-9] 结尾,加上小数点句号 '优化显示:若以 [a-zA-Z0-9] 结尾,加上小数点句号
If _Description.ToLower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "." If _Description.Lower.LastIndexOfAny("qwertyuiopasdfghjklzxcvbnm0123456789") = _Description.Count - 1 Then _Description += "."
End If End If
End Set End Set
End Property End Property
Private _Description As String = Nothing Private _Description As String = Nothing
''' <summary> ''' <summary>
''' Mod 的版本,不保证符合版本格式规范。 ''' Mod 的版本。
''' 不保证符合版本格式规范,且可能为 Nothing。
''' </summary> ''' </summary>
Public Property Version As String Public Property Version As String
Get Get
If _Version Is Nothing Then Load() If _Version Is Nothing Then _Version = CompFile?.Version
Return _Version Return _Version
End Get End Get
Set(value As String) Set(value As String)
If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return If _Version IsNot Nothing AndAlso RegexCheck(_Version, "[0-9.\-]+") Then Return
If value?.ContainsF("version", True) Then value = "version" '需要修改的标识 If value IsNot Nothing AndAlso value.ContainsF("version", True) Then value = "version" '需要修改的标识
_Version = value _Version = value
End Set End Set
End Property End Property
Public _Version As String = Nothing Public _Version As String = Nothing
''' <summary>
''' 用于依赖检查的 ModID。
''' </summary>
Public Property ModId As String
Get
If _ModId Is Nothing Then Load()
Return _ModId
End Get
Set(value As String)
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
''' <summary>
''' 其他可能的 ModID。
''' </summary>
Public PossibleModId As New List(Of String)
''' <summary>
''' Mod 的主页。
''' </summary>
Public Property Url As String
Get
If _Url Is Nothing Then Load()
Return _Url
End Get
Set(value As String)
If _Url Is Nothing AndAlso value IsNot Nothing AndAlso value.StartsWithF("http") Then
_Url = value
End If
End Set
End Property
Private _Url As String = Nothing
''' <summary>
''' Mod 的作者列表。
''' </summary>
Public Property Authors As String
Get
If _Authors Is Nothing Then Load()
Return _Authors
End Get
Set(value As String)
If _Authors Is Nothing AndAlso Not String.IsNullOrWhiteSpace(value) Then
_Authors = value
End If
End Set
End Property
Private _Authors As String = Nothing
''' <summary>
''' 依赖项,其中包括了 Minecraft 的版本要求。格式为 ModID - VersionRequirement,若无版本要求则为 Nothing。
''' </summary>
Public ReadOnly Property Dependencies As Dictionary(Of String, String)
Get
Load()
Return _Dependencies
End Get
End Property
Private _Dependencies As New Dictionary(Of String, String)
Private Sub AddDependency(ModID As String, Optional VersionRequirement As String = Nothing)
'确保信息正确
If ModID Is Nothing OrElse ModID.Count < 2 Then Return
ModID = ModID.ToLower
If ModID = "name" OrElse Val(ModID).ToString = ModID Then Return '跳过 name 与纯数字 id
If VersionRequirement Is Nothing OrElse ((Not VersionRequirement.Contains(".")) AndAlso (Not VersionRequirement.Contains("-"))) OrElse VersionRequirement.Contains("$") Then
VersionRequirement = Nothing
Else
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
If _Dependencies(ModID) Is Nothing Then _Dependencies(ModID) = VersionRequirement
Else
_Dependencies.Add(ModID, VersionRequirement)
End If
End Sub
#End Region #End Region
#Region "加载步骤标记" #Region "从 JAR 获取信息"
'1. 进行文件可用性检查
' 成功:继续第二步。
' 失败:标记 FileUnavailableReason, 并停止后续加载。
''' <summary>
''' 是否已进行 Mod 文件的基础加载。(这包括第一步和第二步)
''' </summary>
Private IsLoaded As Boolean = False
''' <summary>
''' Mod 文件是否可被正常读取。
''' </summary>
Public ReadOnly Property IsFileAvailable As Boolean
Get
Load()
Return FileUnavailableReason Is Nothing
End Get
End Property
''' <summary>
''' Mod 文件出错的原因。若无错误,则为 Nothing。
''' </summary>
Public ReadOnly Property FileUnavailableReason As Exception
Get
Load()
Return _FileUnavailableReason
End Get
End Property
Private _FileUnavailableReason As Exception = Nothing
'2. 进行 .class 以外的信息获取
' 成功:标记 IsInfoWithoutClassAvailable。
' 失败:什么也不干。如果需要补充信息的话,检测到 IsInfoWithoutClassAvailable 为 False,会自动继续加载。
''' <summary>
''' 是否已在不获取 .class 文件的前提下完成了所需信息的加载。
''' </summary>
Private IsInfoWithoutClassAvailable As Boolean = False
'3. 尝试从 .class 文件中获取信息
' 成功:标记 IsInfoWithClassAvailable。
' 失败:什么也不干。
''' <summary>
''' 是否已进行 .class 文件的信息获取。
''' </summary>
Private IsInfoWithClassLoaded As Boolean = False
''' <summary>
''' 是否已在 .class 文件中完成了所需信息的加载。
''' </summary>
Private IsInfoWithClassAvailable As Boolean = False
#End Region
#Region "加载"
''' <summary> ''' <summary>
''' 初始化所有数据。 ''' 从 JAR 文件中获取 Mod 信息。
''' </summary> ''' </summary>
Private Sub Init() Public Sub LoadMetadataFromJar()
_Name = Nothing Static IsLoaded As Boolean = False
_Description = Nothing If IsLoaded Then Return
_Version = Nothing IsLoaded = True
_ModId = Nothing
PossibleModId = New List(Of String)
_Dependencies = New Dictionary(Of String, String)
IsLoaded = False
_FileUnavailableReason = Nothing
IsInfoWithClassLoaded = False
IsInfoWithClassAvailable = False
End Sub
''' <summary>
''' 进行文件可用性检查与 .class 以外的信息获取。
''' </summary>
Public Sub Load(Optional ForceReload As Boolean = False)
If IsLoaded AndAlso Not ForceReload Then Return
'初始化
Init()
Dim Jar As ZipArchive = Nothing Dim Jar As ZipArchive = Nothing
Try Try
'基础可用性检查、打开 Jar 文件 '基础可用性检查、打开 Jar 文件
If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径(" & If(Path, "null") & ")") If Path.Length < 2 Then Throw New FileNotFoundException("错误的 Mod 文件路径(" & If(Path, "null") & ")")
If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件(" & Path & ")") If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件(" & Path & ")")
Jar = New ZipArchive(New FileStream(Path, FileMode.Open)) Jar = New ZipArchive(New FileStream(Path, FileMode.Open, FileAccess.Read, FileShare.Read))
'信息获取 '信息获取
LookupMetadata(Jar) LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException Catch ex As UnauthorizedAccessException
Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer) Log(ex, "Mod 文件由于无权限无法打开(" & Path & ")", LogLevel.Developer)
_FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限,请尝试右键以管理员身份运行 PCL", ex)
Catch ex As Exception Catch ex As Exception
Log(ex, "Mod 文件无法打开(" & Path & ")", LogLevel.Developer) Log(ex, "Mod 文件无法打开(" & Path & ")", LogLevel.Developer)
_FileUnavailableReason = ex
Finally Finally
If Jar IsNot Nothing Then Jar.Dispose() If Jar IsNot Nothing Then Jar.Dispose()
End Try End Try
'完成标记
IsLoaded = True
End Sub End Sub
Private Sub LoadMetadataFromJar(Jar As ZipArchive)
''' <summary>
''' 从 jar 文件中获取 Mod 信息。
''' </summary>
Private Sub LookupMetadata(Jar As ZipArchive)
#Region "尝试使用 mcmod.info" #Region "尝试使用 mcmod.info"
Try Try
@@ -327,45 +169,9 @@ Public Module ModMod
InfoObject = JsonObject("modList")(0) InfoObject = JsonObject("modList")(0)
End If End If
'从文件中获取 Mod 信息项 '从文件中获取 Mod 信息项
Name = InfoObject("name") DisplayName = InfoObject("name")
Description = InfoObject("description") Description = InfoObject("description")
Version = InfoObject("version") Version = InfoObject("version")
Url = InfoObject("url")
ModId = InfoObject("modid")
Dim AuthorJson As JArray = InfoObject("authorList")
If AuthorJson IsNot Nothing Then
Dim Author As New List(Of String)
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
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.IndexOfF(":") + 1)
If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else
AddDependency(Token)
End If
End If
Next
End If
Reqs = InfoObject("dependancies")
If Reqs IsNot Nothing Then
For Each Token As String In Reqs
If Not String.IsNullOrEmpty(Token) Then
Token = Token.Substring(Token.IndexOfF(":") + 1)
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 Catch ex As Exception
Log(ex, "读取 mcmod.info 时出现未知错误(" & Path & ")", LogLevel.Developer) Log(ex, "读取 mcmod.info 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try End Try
@@ -383,37 +189,9 @@ Public Module ModMod
Dim FabricObject As JObject = GetJson(FabricText) Dim FabricObject As JObject = GetJson(FabricText)
GotFabric: GotFabric:
'从文件中获取 Mod 信息项 '从文件中获取 Mod 信息项
If FabricObject.ContainsKey("name") Then Name = FabricObject("name") If FabricObject.ContainsKey("name") Then DisplayName = FabricObject("name")
If FabricObject.ContainsKey("version") Then Version = FabricObject("version") If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
If FabricObject.ContainsKey("description") Then Description = FabricObject("description") If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
If FabricObject.ContainsKey("id") Then ModId = FabricObject("id")
If FabricObject.ContainsKey("contact") Then Url = If(FabricObject("contact")("homepage"), "")
Dim AuthorJson As JArray = FabricObject("authors")
If AuthorJson IsNot Nothing Then
Dim Author As New List(Of String)
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Any Then Authors = Join(Author, ", ")
End If
'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
' '添加 Minecraft 依赖
' Dim DepMinecraft As String = If(If(FabricObject("acceptedMinecraftVersions") IsNot Nothing, FabricObject("acceptedMinecraftVersions")("value"), ""), "")
' If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
' '添加其他依赖
' 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.StartsWithF("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
' If Dep.Contains("@") Then
' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
' Else
' AddDependency(Dep)
' End If
' Next
' End If
'End If
'加载成功 '加载成功
GoTo Finished GoTo Finished
Catch ex As Exception Catch ex As Exception
@@ -474,10 +252,10 @@ GotFabric:
End If End If
Loop Loop
End If End If
Value = Join(ValueLines, vbLf).Trim(vbLf).Replace(vbLf, vbCrLf) Value = ValueLines.Join(vbLf).Trim(vbLf).Replace(vbLf, vbCrLf)
ElseIf RawValue.ToLower = "true" OrElse RawValue.ToLower = "false" Then ElseIf RawValue.Lower = "true" OrElse RawValue.Lower = "false" Then
'布尔型 '布尔型
Value = (RawValue.ToLower = "true") Value = (RawValue.Lower = "true")
ElseIf Val(RawValue).ToString = RawValue Then ElseIf Val(RawValue).ToString = RawValue Then
'数字型 '数字型
Value = Val(RawValue) Value = Val(RawValue)
@@ -500,22 +278,9 @@ GotFabric:
End If End If
Next Next
If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try
ModId = ModEntry("modId") If ModEntry.ContainsKey("displayName") Then DisplayName = ModEntry("displayName")
If _ModId Is Nothing Then Exit Try '设置了无效的 ModID
If ModEntry.ContainsKey("displayName") Then Name = ModEntry("displayName")
If ModEntry.ContainsKey("description") Then Description = ModEntry("description") If ModEntry.ContainsKey("description") Then Description = ModEntry("description")
If ModEntry.ContainsKey("version") Then Version = ModEntry("version") If ModEntry.ContainsKey("version") Then Version = ModEntry("version")
If TomlData(0).Value.ContainsKey("displayURL") Then Url = TomlData(0).Value("displayURL")
If TomlData(0).Value.ContainsKey("authors") Then Authors = TomlData(0).Value("authors")
For Each TomlSubData In TomlData
If TomlSubData.Key.ToLower = $"dependencies.{ModId.ToLower}" Then
Dim DepEntry As Dictionary(Of String, Object) = TomlSubData.Value
If DepEntry.ContainsKey("modId") AndAlso DepEntry.ContainsKey("mandatory") AndAlso DepEntry("mandatory") AndAlso
DepEntry.ContainsKey("side") AndAlso Not DepEntry("side").ToString.ToLower = "server" Then
AddDependency(DepEntry("modId"), If(DepEntry.ContainsKey("versionRange"), DepEntry("versionRange"), Nothing))
End If
End If
Next
'加载成功 '加载成功
GoTo Finished GoTo Finished
Catch ex As Exception Catch ex As Exception
@@ -551,41 +316,16 @@ GotFabric:
Exit Try Exit Try
Got: Got:
'从文件中获取 Mod 信息项 '从文件中获取 Mod 信息项
If FmlObject.ContainsKey("useMetadata") AndAlso If(FmlObject("useMetadata")("value"), "").ToString.ToLower = "true" Then If FmlObject.ContainsKey("name") Then DisplayName = FmlObject("name")("value")
'要求使用 mcmod.info 中的信息
Dim value As String = FmlObject("modid")("value")
If value Is Nothing Then Exit Try
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)
End If
Exit Try
End If
If FmlObject.ContainsKey("name") Then Name = FmlObject("name")("value")
If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value") If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value")
If FmlObject.ContainsKey("modid") Then ModId = FmlObject("modid")("value") '加载成功
If (Not FmlObject.ContainsKey("serverSideOnly")) OrElse FmlObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then GoTo Finished
'添加 Minecraft 依赖
Dim DepMinecraft As String = If(If(FmlObject("acceptedMinecraftVersions") IsNot Nothing, FmlObject("acceptedMinecraftVersions")("value"), ""), "")
If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
'添加其他依赖
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.StartsWithF("required-") Then Continue For
Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
If Dep.Contains("@") Then
AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
Else
AddDependency(Dep)
End If
Next
End If
End If
Catch ex As Exception Catch ex As Exception
Log(ex, "读取 fml_cache_annotation.json 时出现未知错误(" & Path & ")", LogLevel.Developer) Log(ex, "读取 fml_cache_annotation.json 时出现未知错误(" & Path & ")", LogLevel.Developer)
End Try End Try
#End Region #End Region
Return '没能成功获取任何信息
Finished: Finished:
#Region "将 Version 代号转换为 META-INF 中的版本" #Region "将 Version 代号转换为 META-INF 中的版本"
If _Version = "version" Then If _Version = "version" Then
@@ -606,6 +346,7 @@ Finished:
End If End If
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
#End Region #End Region
RaiseEvent OnUpdate(Me)
End Sub End Sub
@@ -613,11 +354,6 @@ Finished:
#Region "网络信息" #Region "网络信息"
''' <summary>
''' 当任何网络信息更新时触发。
''' </summary>
Public Event OnCompUpdate(sender As McMod)
''' <summary> ''' <summary>
''' 该 Mod 关联的网络项目。 ''' 该 Mod 关联的网络项目。
''' </summary> ''' </summary>
@@ -627,7 +363,7 @@ Finished:
End Get End Get
Set(value As CompProject) Set(value As CompProject)
_Comp = value _Comp = value
RaiseEvent OnCompUpdate(Me) RaiseEvent OnUpdate(Me)
End Set End Set
End Property End Property
Private _Comp As CompProject Private _Comp As CompProject
@@ -646,7 +382,7 @@ Finished:
End Get End Get
Set(value As CompFile) Set(value As CompFile)
_UpdateFile = value _UpdateFile = value
RaiseEvent OnCompUpdate(Me) RaiseEvent OnUpdate(Me)
End Set End Set
End Property End Property
Private _UpdateFile As CompFile Private _UpdateFile As CompFile
@@ -688,7 +424,7 @@ Finished:
''' </summary> ''' </summary>
Public ReadOnly Property CanUpdate As Boolean Public ReadOnly Property CanUpdate As Boolean
Get Get
Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso ChangelogUrls.Any() Return Not Settings.Get("UiHiddenFunctionModUpdate") AndAlso Not Settings.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso UpdateFile IsNot Nothing
End Get End Get
End Property End Property
@@ -787,10 +523,10 @@ Finished:
#End Region #End Region
''' <summary> ''' <summary>
''' 是否可能为前置 Mod。 ''' 是否可能为前置 Mod。目前非常不准确。
''' </summary> ''' </summary>
Public Function IsPresetMod() As Boolean Public Function IsPresetMod() As Boolean
Return Not Dependencies.Any() AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib")) Return DisplayName IsNot Nothing AndAlso (DisplayName.Lower.Contains("core") OrElse DisplayName.Lower.Contains("lib"))
End Function End Function
''' <summary> ''' <summary>
@@ -798,7 +534,7 @@ Finished:
''' </summary> ''' </summary>
Public Shared Function IsModFile(Path As String) Public Shared Function IsModFile(Path As String)
If Path Is Nothing OrElse Not Path.Contains(".") Then Return False If Path Is Nothing OrElse Not Path.Contains(".") Then Return False
Path = Path.ToLower Path = Path.Lower
If Path.EndsWithF(".jar", True) OrElse Path.EndsWithF(".zip", True) OrElse Path.EndsWithF(".litemod", True) OrElse 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.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 Path.EndsWithF(".jar.old", True) OrElse Path.EndsWithF(".zip.old", True) OrElse Path.EndsWithF(".litemod.old", True) Then Return True
@@ -811,33 +547,33 @@ Finished:
Public McModLoader As New LoaderTask(Of String, List(Of McMod))("Mod List Loader", AddressOf McModLoad) Public McModLoader As New LoaderTask(Of String, List(Of McMod))("Mod List Loader", AddressOf McModLoad)
Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of McMod))) Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of McMod)))
Try Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = False) RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.ShowProgress = False)
'等待 Mod 更新完成 '等待 Mod 更新完成
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then If PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表:" & Loader.Input) Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表:" & Loader.Input)
Try Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod") RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input) Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
Thread.Sleep(100) Thread.Sleep(100)
Loop Loop
Finally Finally
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表") RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在加载 Mod 列表")
End Try End Try
FrmVersionMod.LoaderRun(LoaderFolderRunType.UpdateOnly) FrmInstanceMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
End If End If
'获取 Mod 文件夹下的可用文件列表 '获取 Mod 文件夹下的可用文件列表
Dim ModFileList As New List(Of FileInfo) Dim ModFileList As New List(Of FileInfo)
If Directory.Exists(Loader.Input) Then If Directory.Exists(Loader.Input) Then
Dim RawName As String = Loader.Input.ToLower Dim RawName As String = Loader.Input.Lower
For Each File As FileInfo In EnumerateFiles(Loader.Input) For Each File As FileInfo In EnumerateFiles(Loader.Input)
If File.DirectoryName.ToLower & "\" <> RawName Then If File.DirectoryName.Lower & "\" <> RawName Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod '仅当 Forge 1.13- 且文件夹名与版本号相同时,才加载该子文件夹下的 Mod
If Not (PageVersionLeft.Version IsNot Nothing AndAlso PageVersionLeft.Version.Version.HasForge AndAlso If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
PageVersionLeft.Version.Version.McCodeMain < 13 AndAlso PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
File.Directory.Name = $"1.{PageVersionLeft.Version.Version.McCodeMain}.{PageVersionLeft.Version.Version.McCodeSub}") Then File.Directory.Name = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then
Continue For Continue For
End If End If
End If End If
@@ -845,10 +581,6 @@ Finished:
Next Next
End If End If
'确定是否显示进度
Loader.Progress = 0.05
If ModFileList.Count > 50 Then RunInUi(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = True)
'获取本地文件缓存 '获取本地文件缓存
Dim CachePath As String = PathTemp & "Cache\LocalMod.json" Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
Dim Cache As New JObject Dim Cache As New JObject
@@ -869,14 +601,10 @@ Finished:
'加载 Mod 列表 '加载 Mod 列表
Dim ModList As New List(Of McMod) Dim ModList As New List(Of McMod)
Dim ModUpdateList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList For Each ModFile As FileInfo In ModFileList
Loader.Progress += 0.94 / ModFileList.Count If Loader.IsInterrupted Then Return
If Loader.IsAborted Then Return
'加载 McMod 对象
Dim ModEntry As New McMod(ModFile.FullName) Dim ModEntry As New McMod(ModFile.FullName)
ModEntry.Load() Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName) '存在两个文件,名称相同,但一个启用一个禁用
Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName)
If DumpMod IsNot Nothing Then If DumpMod IsNot Nothing Then
Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry) Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry)
Log($"[Mod] 重复的 Mod 文件:{DumpMod.FileName} 与 {ModEntry.FileName},已忽略 {DisabledMod.FileName}", LogLevel.Debug) Log($"[Mod] 重复的 Mod 文件:{DumpMod.FileName} 与 {ModEntry.FileName},已忽略 {DisabledMod.FileName}", LogLevel.Debug)
@@ -884,42 +612,22 @@ Finished:
Continue For Continue For
Else Else
ModList.Remove(DisabledMod) ModList.Remove(DisabledMod)
ModUpdateList.Remove(DisabledMod)
End If End If
End If End If
ModList.Add(ModEntry) ModList.Add(ModEntry)
'读取 Comp 缓存
If ModEntry.State = McMod.McModState.Unavailable Then Continue For
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If
ModUpdateList.Add(ModEntry)
Next Next
Loader.Progress = 0.99 Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
Log($"[Mod] 共有 {ModList.Count} 个 Mod,其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息,{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息")
'排序 '排序
ModList = ModList.Sort( ModList = ModList.OrderBy(Function(m) m.FileName).ToList
Function(Left As McMod, Right As McMod) As Boolean
If (Left.State = McMod.McModState.Unavailable) <> (Right.State = McMod.McModState.Unavailable) Then
Return Left.State = McMod.McModState.Unavailable
Else
Return Not Right.FileName.CompareTo(Left.FileName)
End If
End Function)
'回设 '回设
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
Loader.Output = ModList Loader.Output = ModList
'开始联网加载 '开始联网加载
If ModUpdateList.Any() Then
'TODO: 添加信息获取中提示 'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True) McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModList, Cache), IsForceRestart:=True)
End If
Catch ex As Exception Catch ex As Exception
Log(ex, "Mod 列表加载失败", LogLevel.Debug) Log(ex, "Mod 列表加载失败", LogLevel.Debug)
@@ -929,15 +637,31 @@ Finished:
'联网加载 Mod 详情 '联网加载 Mod 详情
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad) Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)) Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key Dim Mods As New List(Of McMod)
Dim Cache As JObject = Loader.Input.Value Dim Cache As JObject = Loader.Input.Value
'读取 Comp 缓存,获取需要更新的 Mod 列表
For Each ModEntry As McMod In Loader.Input.Key
If Loader.IsInterrupted Then Return
Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If
Mods.Add(ModEntry)
Next
Log($"[Mod] 有 {Mods.Where(Function(m) m.Comp Is Nothing).Count} 个 Mod 需要联网获取信息,{Mods.Where(Function(m) m.Comp IsNot Nothing).Count} 个 Mod 需要更新信息")
If Not Mods.Any Then
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForEach(Sub(m) m.LoadMetadataFromJar()) '从 JAR 中获取缺失的版本信息(下面有另一个分支)
Return
End If
'获取作为检查目标的加载器和版本 '获取作为检查目标的加载器和版本
'此处不应向下扩展检查的 MC 小版本,例如 Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2 '此处不应向下扩展检查的 MC 小版本,例如 Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version Dim TargetMcVersion As McVersion = PageInstanceLeft.Instance.Version
Dim ModLoaders = GetTargetModLoaders() Dim ModLoaders = GetTargetModLoaders()
Dim McVersion = TargetMcVersion.McName Dim VanillaVersion = TargetMcVersion.VanillaName
'开始网络获取 '开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}") Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{VanillaVersion}")
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim CurrentTaskThread As Thread = Thread.CurrentThread Dim CurrentTaskThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息 '从 Modrinth 获取信息
@@ -946,8 +670,8 @@ Finished:
Try Try
'步骤 1:获取 Hash 与对应的工程 ID '步骤 1:获取 Hash 与对应的工程 ID
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList() Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
Dim ModrinthVersion = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST", Dim ModrinthVersion As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject) $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息") Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系 '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If ModrinthVersion.Count = 0 Then Return If ModrinthVersion.Count = 0 Then Return
@@ -961,15 +685,18 @@ Finished:
ModrinthMapping(ProjectId).Add(Entry) ModrinthMapping(ProjectId).Add(Entry)
'记录对应的 CompFile '记录对应的 CompFile
Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod) 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 If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then
Entry.CompFile = File
Else
Entry.CompFile.Version = File.Version '使用来自 Modrinth 的版本号
End If
Next Next
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息") Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not ModrinthMapping.Any() Then Return If Not ModrinthMapping.Any() Then Return
Dim ModrinthProject = CType(GetJson(DlModRequest( Dim ModrinthProject As JArray = DlModRequest(
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]", $"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]")
"GET", "", "application/json")), JArray)
For Each ProjectJson In ModrinthProject For Each ProjectJson In ModrinthProject
Dim Project As New CompProject(ProjectJson) Dim Project As New CompProject(ProjectJson)
For Each Entry In ModrinthMapping(Project.Id) For Each Entry In ModrinthMapping(Project.Id)
@@ -978,9 +705,9 @@ Finished:
Next Next
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息") Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
'步骤 4:获取更新信息 '步骤 4:获取更新信息
Dim ModrinthUpdate = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files/update", "POST", Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"", $"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")), JObject) ""loaders"": [""{ModLoaders.Join(""",""").Lower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
For Each Entry In Mods For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod) Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
@@ -989,11 +716,11 @@ Finished:
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For 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 '合并 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?g={McVersion}") Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}")
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源 UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件 Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换 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?g={McVersion}"} Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}"}
Entry.UpdateFile = UpdateFile Entry.UpdateFile = UpdateFile
End If End If
Next Next
@@ -1013,10 +740,10 @@ Finished:
Dim CurseForgeHashes As New List(Of UInteger) Dim CurseForgeHashes As New List(Of UInteger)
For Each Entry In Mods For Each Entry In Mods
CurseForgeHashes.Add(Entry.CurseForgeHash) CurseForgeHashes.Add(Entry.CurseForgeHash)
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Next Next
Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST", Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432", HttpMethod.Post,
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer) $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息") Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系 '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If Not CurseForgeRaw.Any() Then Return If Not CurseForgeRaw.Any() Then Return
@@ -1034,12 +761,12 @@ Finished:
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
Next Next
Next Next
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return If Loader.IsInterruptedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息") Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Return If Not CurseForgeMapping.Any() Then Return
Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST", Dim CurseForgeProject = DlModRequest("https://api.curseforge.com/v1/mods", HttpMethod.Post,
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data") $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表 Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String) Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject For Each ProjectJson In CurseForgeProject
@@ -1054,15 +781,15 @@ Finished:
Entry.Comp = Project Entry.Comp = Project
Next Next
'查找或许版本更新的文件列表 '查找或许版本更新的文件列表
If ModLoaders.Count = 1 Then If ModLoaders.IsSingle Then
Dim NewestVersion As String = Nothing Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer) Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes") For Each IndexEntry In ProjectJson("latestFilesIndexes")
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配 If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion") Dim IndexVersion As String = IndexEntry("gameVersion")
If IndexVersion <> McVersion Then Continue For 'MC 版本匹配 If IndexVersion <> VanillaVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件 '由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本 If NewestVersion IsNot Nothing AndAlso CompareVersion(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then If NewestVersion <> IndexVersion Then
NewestVersion = IndexVersion NewestVersion = IndexVersion
NewestFileIds.Clear() NewestFileIds.Clear()
@@ -1079,8 +806,8 @@ Finished:
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息") Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
'步骤 4:获取更新文件信息 '步骤 4:获取更新文件信息
If Not UpdateFileIds.Any() Then Return If Not UpdateFileIds.Any() Then Return
Dim CurseForgeFiles = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", Dim CurseForgeFiles = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post,
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data") $"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")("data")
Dim UpdateFiles As New Dictionary(Of McMod, CompFile) Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
For Each FileJson In CurseForgeFiles For Each FileJson In CurseForgeFiles
Dim File As New CompFile(FileJson, CompType.Mod) Dim File As New CompFile(FileJson, CompType.Mod)
@@ -1112,10 +839,12 @@ Finished:
EndedThreadCount += 1 EndedThreadCount += 1
End Try End Try
End Sub, "Mod List Detail Loader CurseForge") End Sub, "Mod List Detail Loader CurseForge")
'从 JAR 中获取缺失的版本信息(上面有另一个分支)
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForEach(Sub(m) m.LoadMetadataFromJar())
'等待线程结束 '等待线程结束
Do Until EndedThreadCount = 2 Do Until EndedThreadCount = 2
If Loader.IsAborted Then Return
Thread.Sleep(10) Thread.Sleep(10)
If Loader.IsInterrupted Then Return
Loop Loop
'保存缓存 '保存缓存
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList() Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
@@ -1123,154 +852,25 @@ Finished:
If Not Mods.Any() Then Return If Not Mods.Any() Then Return
For Each Entry In Mods For Each Entry In Mods
Entry.CompLoaded = Not IsFailed Entry.CompLoaded = Not IsFailed
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson() Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = Entry.ToJson()
Next Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏 '刷新边栏
If FrmVersionMod?.Filter = PageVersionMod.FilterType.CanUpdate Then If Loader.IsInterrupted Then Return
RunInUi(Sub() FrmVersionMod?.RefreshUI()) '同步 “可更新” 列表 (#4677) If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else Else
RunInUi(Sub() FrmVersionMod?.RefreshBars()) RunInUi(Sub() FrmInstanceMod?.RefreshBars())
End If End If
End Sub End Sub
Public Function GetTargetModLoaders() As List(Of CompModLoaderType) Public Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType) Dim ModLoaders As New List(Of CompModLoaderType)
If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge) If PageInstanceLeft.Instance.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge) If PageInstanceLeft.Instance.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageVersionLeft.Version.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric) If PageInstanceLeft.Instance.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If PageVersionLeft.Version.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader) If PageInstanceLeft.Instance.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt}) If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Return ModLoaders Return ModLoaders
End Function End Function
#If DEBUG Then
''' <summary>
''' 检查 Mod 列表中存在的错误,返回错误信息的集合。
''' </summary>
Public Function McModCheck(Version As McVersion, Mods As List(Of McMod)) As List(Of String)
Dim Result As New List(Of String)
'令所有 Mod 进行基础检查,并归纳需要检查的 Mod
Dim CurrentModList As New List(Of McMod)
For Each ModEntity In Mods
If Not ModEntity.IsFileAvailable Then
Result.Add("无法读取的 Mod 文件。" & vbCrLf & " - " & ModEntity.Path)
Continue For
End If
If ModEntity.State = McMod.McModState.Fine AndAlso ModEntity.ModId IsNot Nothing Then CurrentModList.Add(ModEntity)
Next
'添加默认依赖
Dim CurrentDependencies As New Dictionary(Of String, String()) '{DependencyVersion, Path}
If Version.State = McVersionState.Forge Then CurrentDependencies.Add("forge", {Version.Version.ForgeVersion, "Forge"})
CurrentDependencies.Add("minecraft", {Version.Version.McName, "Minecraft"})
'检查重复的 Mod,并添加对应的依赖
For Each ModEntity In CurrentModList
For Each PossibleModId In ModEntity.PossibleModId
If CurrentDependencies.ContainsKey(PossibleModId) Then
If CurrentDependencies(PossibleModId)(2) = 1 Then
Result.Add("重复添加了相同的 Mod,请尝试删除其中一个(ModID:" & PossibleModId & ")。" & vbCrLf &
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1))
Else
Log("[Minecraft] 由于可能有多个 ModID,跳过疑似的重复项(ModID:" & PossibleModId & ")。" & vbCrLf &
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1), LogLevel.Developer)
End If
Else
CurrentDependencies.Add(PossibleModId, {ModEntity.Version, ModEntity.FileName, ModEntity.PossibleModId.Count})
End If
Next
Next
'检查依赖
For Each ModEntity In CurrentModList
Try
For Each Dependency In ModEntity.Dependencies
Dim ReqId As String = Dependency.Key
If ReqId.Count < 2 Then Continue For '确保正常
If ReqId = ModEntity.ModId Then Continue For '跳过自体引用
If ReqId = "forgemultipartcbe" Then Continue For '跳过莫名其妙的引用
If Dependency.Value IsNot Nothing Then
'获取分段后的详细版本信息
Dim ReqVersion As String = Dependency.Value
Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWithF("[")
Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWithF("]")
Dim ReqVersionHead As String
Dim ReqVersionTail As String
If ReqVersion.Contains(",") Then
ReqVersionHead = ReqVersion.Split(",")(0).Trim("([ ".ToCharArray())
ReqVersionTail = ReqVersion.Split(",")(1).Trim("]) ".ToCharArray())
Else
ReqVersionHead = ReqVersion.Trim("([]) ".ToCharArray())
ReqVersionTail = ReqVersionHead
If ReqId = "minecraft" AndAlso ReqVersionHead.Split(".").Count = 2 Then
ReqVersionTail = ReqVersionHead.Split(".")(0) & "." & (Val(ReqVersionHead.Split(".")(1)) + 1)
ReqVersionTailCanEqual = False
End If
End If
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
VersionRequire = "应为 " & ReqVersionHead
ElseIf ReqVersionHead.Contains(".") AndAlso ReqVersionTail.Contains(".") Then
VersionRequire = "应为 " & ReqVersionHead & " 至 " & ReqVersionTail
ElseIf ReqVersionHead.Contains(".") Then
If ReqVersionHeadCanEqual Then
VersionRequire = "最低应为 " & ReqVersionHead
Else
VersionRequire = "应高于 " & ReqVersionHead
End If
ElseIf ReqVersionTail.Contains(".") Then
If ReqVersionTailCanEqual Then
VersionRequire = "最高应为 " & ReqVersionHead
Else
VersionRequire = "应低于 " & ReqVersionHead
End If
Else
VersionRequire = ""
End If
'检查前置 Mod 是否存在,并获取其版本
If Not CurrentDependencies.ContainsKey(ReqId) Then
Result.Add("缺少前置 Mod:" & ReqId & If(VersionRequire = "", "", ",其版本" & VersionRequire) & "。" & vbCrLf & " - " & ModEntity.FileName)
Continue For
End If
Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0")
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
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过低,其版本" & VersionRequire & ",而当前版本为 " & CurrentVersion & "。" & vbCrLf &
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置:" & CurrentDependencies(ReqId)(1), ""))
Continue For
End If
End If
'对比前置 Mod 尾部版本
If ReqVersionTail.Contains(".") Then
If VersionSortInteger(CurrentVersion, ReqVersionTail) > If(ReqVersionTailCanEqual, 0, -1) Then
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过高,其版本" & VersionRequire & ",而当前版本为 " & CurrentVersion & "。" & vbCrLf &
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", vbCrLf & " - 前置:" & CurrentDependencies(ReqId)(1), ""))
Continue For
End If
End If
Else
If Not CurrentDependencies.ContainsKey(Dependency.Key) Then
Result.Add("缺少前置 Mod:" & Dependency.Key & "。" & vbCrLf & " - " & ModEntity.FileName)
Continue For
End If
End If
Next
Catch ex As Exception
Result.Add("检查 Mod 时出错:" & GetExceptionSummary(ex) & vbCrLf & " - " & ModEntity.FileName)
Log(ex, "检查 Mod 时出错")
End Try
Next
If Not Result.Any() Then
Log("[Minecraft] Mod 检查未发现异常")
Else
Log("[Minecraft] Mod 检查异常结果:" & vbCrLf & Join(Result, vbCrLf))
End If
Return Result
End Function
#End If
End Module End Module
@@ -24,14 +24,14 @@ Public Module ModModpack
''' 必须在工作线程执行。 ''' 必须在工作线程执行。
''' </summary> ''' </summary>
''' <exception cref="CancelledException" /> ''' <exception cref="CancelledException" />
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String) Public Function ModpackInstall(File As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Log("[ModPack] 整合包安装请求:" & If(File, "null")) Log("[ModPack] 整合包安装请求:" & If(File, "null"))
Dim Archive As ZipArchive = Nothing Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = "" Dim ArchiveBaseFolder As String = ""
Try Try
'字符校验 '字符校验
Dim TargetFolder As String = $"{PathMcFolder}versions\{VersionName}\" Dim TargetFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号:" & TargetFolder, HintType.Critical) : Throw New CancelledException If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号:" & TargetFolder, HintType.Red) : Throw New CancelledException
'获取整合包种类与关键 Json '获取整合包种类与关键 Json
Dim PackType As Integer = -1 Dim PackType As Integer = -1
Try Try
@@ -72,7 +72,7 @@ Public Module ModModpack
If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包 If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
Next Next
Catch ex As Exception Catch ex As Exception
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then If ex.GetDetail(True).Contains("Error.WinIOError") Then
Throw New Exception("打开整合包文件失败", ex) Throw New Exception("打开整合包文件失败", ex)
ElseIf File.EndsWithF(".rar", True) Then ElseIf File.EndsWithF(".rar", True) Then
Throw New Exception("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", ex) Throw New Exception("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", ex)
@@ -84,7 +84,7 @@ Public Module ModModpack
Select Case PackType Select Case PackType
Case 0 Case 0
Log("[ModPack] 整合包种类:CurseForge") Log("[ModPack] 整合包种类:CurseForge")
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo) Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 1 Case 1
Log("[ModPack] 整合包种类:HMCL") Log("[ModPack] 整合包种类:HMCL")
Return InstallPackHMCL(File, Archive, ArchiveBaseFolder) Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
@@ -93,10 +93,10 @@ Public Module ModModpack
Return InstallPackMMC(File, Archive, ArchiveBaseFolder) Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
Case 3 Case 3
Log("[ModPack] 整合包种类:MCBBS") Log("[ModPack] 整合包种类:MCBBS")
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName) Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, InstanceName)
Case 4 Case 4
Log("[ModPack] 整合包种类:Modrinth") Log("[ModPack] 整合包种类:Modrinth")
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo) Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 9 Case 9
Log("[ModPack] 整合包种类:带启动器的压缩包") Log("[ModPack] 整合包种类:带启动器的压缩包")
Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder) Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
@@ -112,19 +112,14 @@ Public Module ModModpack
Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, ProgressIncrement As Double) Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, ProgressIncrement As Double)
'解压文件 '解压文件
Dim RetryCount As Integer = 1 Dim RetryCount As Integer = 1
Dim Encode = Encoding.GetEncoding("GB18030")
Dim InitialProgress = Loader.Progress Dim InitialProgress = Loader.Progress
Try Try
Retry: Retry:
Loader.Progress = InitialProgress Loader.Progress = InitialProgress
DeleteDirectory(InstallTemp) DeleteDirectory(InstallTemp)
ExtractFile(FileAddress, InstallTemp, Encode, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * ProgressIncrement) ExtractCompressedFile(FileAddress, InstallTemp, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * ProgressIncrement)
Catch ex As Exception Catch ex As Exception
Log(ex, "第 " & RetryCount & " 次解压尝试失败") Log(ex, "第 " & RetryCount & " 次解压尝试失败")
If TypeOf ex Is ArgumentException Then
Encode = Encoding.UTF8
Log("[ModPack] 已切换压缩包解压编码为 UTF8")
End If
'完全不知道为啥会出现文件正在被另一进程使用的问题,总之加个重试 '完全不知道为啥会出现文件正在被另一进程使用的问题,总之加个重试
If RetryCount < 5 Then If RetryCount < 5 Then
Thread.Sleep(RetryCount * 2000) Thread.Sleep(RetryCount * 2000)
@@ -158,6 +153,7 @@ Retry:
If File.Exists(OverridesIni) Then If File.Exists(OverridesIni) Then
WriteIni(OverridesIni, "VersionArgumentIndie", 1) '开启版本隔离 WriteIni(OverridesIni, "VersionArgumentIndie", 1) '开启版本隔离
WriteIni(OverridesIni, "VersionArgumentIndieV2", True) WriteIni(OverridesIni, "VersionArgumentIndieV2", True)
WriteIni(OverridesIni, "IsStar", False)
CopyFile(OverridesIni, VersionIni) '覆写已有的 ini CopyFile(OverridesIni, VersionIni) '覆写已有的 ini
Else Else
WriteIni(VersionIni, "VersionArgumentIndie", 1) '开启版本隔离 WriteIni(VersionIni, "VersionArgumentIndie", 1) '开启版本隔离
@@ -165,12 +161,21 @@ Retry:
End If End If
IniClearCache(VersionIni) '重置缓存,避免被安装过程中写入的 ini 覆盖 IniClearCache(VersionIni) '重置缓存,避免被安装过程中写入的 ini 覆盖
End Sub End Sub
''' <summary>
''' 弹窗提示整合包中存在不兼容的加载器。
''' 如果取消,则抛出 CancelledException。
''' </summary>
''' <exception cref="CancelledException" />
Private Sub NotifyIncompatibleLoader(LoaderName As String)
If MyMsgBox($"整合包中存在不兼容的加载器:{LoaderName}{vbCrLf}如果你知道如何手动安装它,可以先选择跳过,然后在整合包下载结束后手动安装。",
"不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New CancelledException
End Sub
#Region "不同类型整合包的安装方法" #Region "不同类型整合包的安装方法"
'CurseForge 'CurseForge
Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String) Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
@@ -182,12 +187,12 @@ Retry:
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息") If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息")
'获取版本名 '获取版本名
If VersionName Is Nothing Then If InstanceName Is Nothing Then
VersionName = If(Json("name"), "") InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
End If End If
'获取 Mod API 版本信息 '获取 Mod API 版本信息
@@ -195,7 +200,7 @@ Retry:
Dim NeoForgeVersion As String = Nothing Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing Dim FabricVersion As String = Nothing
For Each Entry In If(Json("minecraft")("modLoaders"), {}) For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.ToLower Dim Id As String = If(Entry("id"), "").ToString.Lower
If Id.StartsWithF("forge-") Then If Id.StartsWithF("forge-") Then
'Forge 指定 'Forge 指定
If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老,已不支持进行安装!") If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老,已不支持进行安装!")
@@ -210,7 +215,8 @@ Retry:
Log("[ModPack] 整合包 Fabric 版本:" & Id) Log("[ModPack] 整合包 Fabric 版本:" & Id)
FabricVersion = Id.Replace("fabric-", "") FabricVersion = Id.Replace("fabric-", "")
Else Else
Log("[ModPack] 未知 Mod 加载器:" & Id) 'ElseIf Id.StartsWithF("quilt-") Then
NotifyIncompatibleLoader(Id)
End If End If
Next Next
'解压 '解压
@@ -223,7 +229,7 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613 InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
$"{PathMcFolder}versions\{VersionName}", $"{McFolderSelected}versions\{InstanceName}",
Task, 0.4) Task, 0.4)
End Sub) With { End Sub) With {
.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s .ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
@@ -244,7 +250,7 @@ Retry:
'获取 Mod 下载信息 '获取 Mod 下载信息
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息", ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray)) Sub(Task As LoaderTask(Of Integer, JArray))
Task.Output = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data") Task.Output = DlModRequest("https://api.curseforge.com/v1/mods/files", HttpMethod.Post, "{""fileIds"": [" & ModList.Join(",") & "]}", "application/json")("data")
'如果文件已被删除,则 API 会跳过那一项 '如果文件已被删除,则 API 会跳过那一项
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除,所以没法继续安装了,请向整合包作者反馈该问题") If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除,所以没法继续安装了,请向整合包作者反馈该问题")
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
@@ -267,7 +273,7 @@ Retry:
If ModJson("modules").Any Then 'modules 可能返回 null(#1006) If ModJson("modules").Any Then 'modules 可能返回 null(#1006)
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
ModJson?("FileName")?.ToString?.EndsWithF(".jar", True) Then ModJson?("FileName")?.ToString.EndsWithF(".jar", True) Then
TargetFolder = "mods" : Type = CompType.Mod TargetFolder = "mods" : Type = CompType.Mod
ElseIf ModuleNames.Contains("pack.mcmeta") Then ElseIf ModuleNames.Contains("pack.mcmeta") Then
TargetFolder = "resourcepacks" : Type = CompType.ResourcePack TargetFolder = "resourcepacks" : Type = CompType.ResourcePack
@@ -281,7 +287,7 @@ Retry:
Dim File As New CompFile(ModJson, Type) Dim File As New CompFile(ModJson, Type)
If Not File.Available Then Continue For If Not File.Available Then Continue For
'实际的添加 '实际的添加
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{TargetFolder}\")) FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\"))
Task.Progress += 1 / (1 + ModList.Count) Task.Progress += 1 / (1 + ModList.Count)
Next Next
Task.Output = FileList.Values.ToList Task.Output = FileList.Values.ToList
@@ -295,8 +301,8 @@ Retry:
'构造加载器 '构造加载器
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .NewInstanceName = InstanceName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("minecraft")("version").ToString, .MinecraftName = Json("minecraft")("version").ToString,
.ForgeVersion = ForgeVersion, .ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion, .NeoForgeVersion = NeoForgeVersion,
@@ -310,7 +316,7 @@ Retry:
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件", Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String)) Sub(Task As LoaderTask(Of String, String))
'设置图标 '设置图标
Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\" Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True) File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png") WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -324,22 +330,22 @@ Retry:
File.Delete(Target) File.Delete(Target)
End If End If
Next Next
If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件:" & FileAddress) Log("[ModPack] 删除安装整合包文件:" & FileAddress)
File.Delete(FileAddress) File.Delete(FileAddress)
End If End If
End Sub) With {.ProgressWeight = 0.1, .Show = False}) End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查 '重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " " Dim LoaderName As String = "CurseForge 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New CancelledException
End If End If
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -347,7 +353,7 @@ Retry:
End Function End Function
'Modrinth 'Modrinth
Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String) Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
@@ -363,7 +369,7 @@ Retry:
Dim NeoForgeVersion As String = Nothing Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing Dim FabricVersion As String = Nothing
For Each Entry As JProperty In If(Json("dependencies"), {}) For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.ToLower Select Case Entry.Name.Lower
Case "minecraft" Case "minecraft"
MinecraftVersion = Entry.Value.ToString MinecraftVersion = Entry.Value.ToString
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0 Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
@@ -375,21 +381,18 @@ Retry:
Case "fabric-loader" 'eg. 0.14.14 Case "fabric-loader" 'eg. 0.14.14
FabricVersion = Entry.Value.ToString FabricVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion) Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
Case "quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Throw New CancelledException
Case Else Case Else
Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical) 'Case "quilt-loader" 'eg. 1.0.0
Throw New CancelledException NotifyIncompatibleLoader(Entry.Name)
End Select End Select
Next Next
'获取版本名 '获取版本名
If VersionName Is Nothing Then If InstanceName Is Nothing Then
VersionName = If(Json("name"), "") InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
End If End If
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
@@ -399,11 +402,11 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides", InstallTemp & ArchiveBaseFolder & "overrides",
PathMcFolder & "versions\" & VersionName, McFolderSelected & "versions\" & InstanceName,
Task, 0.4) Task, 0.4)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "client-overrides", InstallTemp & ArchiveBaseFolder & "client-overrides",
PathMcFolder & "versions\" & VersionName, McFolderSelected & "versions\" & InstanceName,
Task, 0.1) Task, 0.1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表 '获取下载文件列表
@@ -425,8 +428,8 @@ Retry:
Dim Urls = File("downloads").SelectMany(Function(t) CompFile.HandleCurseForgeDownloadUrls(t.ToString)).ToList Dim Urls = File("downloads").SelectMany(Function(t) CompFile.HandleCurseForgeDownloadUrls(t.ToString)).ToList
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList) Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = Urls.Distinct.ToList() Urls = Urls.Distinct.ToList()
Dim TargetPath As String = $"{PathMcFolder}versions\{VersionName}\{File("path")}" Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{PathMcFolder}versions\{VersionName}\", True) Then If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹,请向整合包作者反馈此问题!" & vbCrLf & "错误的文件:" & TargetPath, "文件路径校验失败", IsWarn:=True) MyMsgBox($"整合包的文件路径超出了版本文件夹,请向整合包作者反馈此问题!" & vbCrLf & "错误的文件:" & TargetPath, "文件路径校验失败", IsWarn:=True)
Throw New CancelledException Throw New CancelledException
End If End If
@@ -439,8 +442,8 @@ Retry:
'构造加载器 '构造加载器
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .NewInstanceName = InstanceName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = MinecraftVersion, .MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion, .ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion, .NeoForgeVersion = NeoForgeVersion,
@@ -454,7 +457,7 @@ Retry:
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件", Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String)) Sub(Task As LoaderTask(Of String, String))
'设置图标 '设置图标
Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\" Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True) File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png") WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -468,22 +471,22 @@ Retry:
File.Delete(Target) File.Delete(Target)
End If End If
Next Next
If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then If File.Exists(FileAddress) AndAlso IO.Path.GetFileNameWithoutExtension(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件:" & FileAddress) Log("[ModPack] 删除安装整合包文件:" & FileAddress)
File.Delete(FileAddress) File.Delete(FileAddress)
End If End If
End Sub) With {.ProgressWeight = 0.1, .Show = False}) End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查 '重复任务检查
Dim LoaderName As String = $"Modrinth 整合包安装:{VersionName} " Dim LoaderName As String = $"Modrinth 整合包安装:{InstanceName} "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New CancelledException
End If End If
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -500,11 +503,11 @@ Retry:
Throw New Exception("HMCL 整合包安装信息存在问题", ex) Throw New Exception("HMCL 整合包安装信息存在问题", ex)
End Try End Try
'获取版本名 '获取版本名
Dim VersionName As String = If(Json("name"), "") Dim InstanceName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
@@ -513,14 +516,14 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "minecraft", InstallTemp & ArchiveBaseFolder & "minecraft",
PathMcFolder & "versions\" & VersionName, McFolderSelected & "versions\" & InstanceName,
Task, 0.4) Task, 0.4)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造游戏本体安装加载器 '构造游戏本体安装加载器
If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息,无法安装!") If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息,无法安装!")
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .NewInstanceName = InstanceName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("gameVersion").ToString .MinecraftName = Json("gameVersion").ToString
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
@@ -530,14 +533,14 @@ Retry:
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)} New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}
} }
'重复任务检查 '重复任务检查
Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " " Dim LoaderName As String = "HMCL 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New CancelledException
End If End If
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -555,21 +558,21 @@ Retry:
Throw New Exception("MMC 整合包安装信息存在问题", ex) Throw New Exception("MMC 整合包安装信息存在问题", ex)
End Try End Try
'获取版本名 '获取版本名
Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "") Dim InstanceName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini" Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer)) Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & ".minecraft", InstallTemp & ArchiveBaseFolder & ".minecraft",
PathMcFolder & "versions\" & VersionName, McFolderSelected & "versions\" & InstanceName,
Task, 0.4) Task, 0.4)
'读取 MMC 设置文件(#2655) '读取 MMC 设置文件(#2655)
Try Try
@@ -581,7 +584,7 @@ Retry:
If Not Line.Contains("=") Then Continue For If Not Line.Contains("=") Then Continue For
Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("=")) Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
Next Next
WriteFile(MMCSetupFile, Join(Lines, vbCrLf)) WriteFile(MMCSetupFile, Lines.Join(vbCrLf))
'读取文件 '读取文件
If ReadIni(MMCSetupFile, "OverrideCommands", False) Then If ReadIni(MMCSetupFile, "OverrideCommands", False) Then
Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand") Dim PreLaunchCommand As String = ReadIni(MMCSetupFile, "PreLaunchCommand")
@@ -608,7 +611,7 @@ Retry:
If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True) WriteIni(SetupFile, "LogoCustom", True)
WriteIni(SetupFile, "Logo", "PCL\Logo.png") WriteIni(SetupFile, "Logo", "PCL\Logo.png")
CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{PathMcFolder}versions\{VersionName}\PCL\Logo.png") CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png")
Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)") Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)")
End If End If
'JVM 参数 'JVM 参数
@@ -618,7 +621,7 @@ Retry:
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs) WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(覆盖):" & JvmArgs) Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(覆盖):" & JvmArgs)
Else Else
JvmArgs += " " & Setup.Get("LaunchAdvanceJvm") JvmArgs += " " & Settings.Get("LaunchAdvanceJvm")
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs) WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(追加):" & JvmArgs) Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(追加):" & JvmArgs)
End If End If
@@ -630,11 +633,11 @@ Retry:
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造版本安装请求 '构造版本安装请求
If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息,无法安装!") If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息,无法安装!")
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"} Dim Request As New McInstallRequest With {.NewInstanceName = InstanceName, .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\"}
For Each Component In PackJson("components") For Each Component As JObject In PackJson("components")
Select Case If(Component("uid"), "").ToString If Not Component.ContainsKey("uid") Then Continue For
Case "org.lwjgl" Dim UID As String = Component("uid").ToString
Log("[ModPack] 已跳过 LWJGL 项") Select Case UID
Case "net.minecraft" Case "net.minecraft"
Request.MinecraftName = Component("version") Request.MinecraftName = Component("version")
Case "net.minecraftforge" Case "net.minecraftforge"
@@ -643,9 +646,13 @@ Retry:
Request.NeoForgeVersion = Component("version") Request.NeoForgeVersion = Component("version")
Case "net.fabricmc.fabric-loader" Case "net.fabricmc.fabric-loader"
Request.FabricVersion = Component("version") Request.FabricVersion = Component("version")
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0 'Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical) Case Else
Throw New CancelledException If UID.StartsWithF("org.lwjgl") Then '#8210
Log("[ModPack] 已跳过 LWJGL 项:" & UID)
Else
NotifyIncompatibleLoader(UID)
End If
End Select End Select
Next Next
'构造加载器 '构造加载器
@@ -656,15 +663,15 @@ Retry:
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}) Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
'重复任务检查 '重复任务检查
Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " " Dim LoaderName As String = "MMC 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New CancelledException
End If End If
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -673,7 +680,7 @@ Retry:
'MCBBS 'MCBBS
Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing) As LoaderCombo(Of String) Optional InstanceName As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件 '读取 Json 文件
Dim Json As JObject Dim Json As JObject
Try Try
@@ -683,23 +690,23 @@ Retry:
Throw New Exception("MCBBS 整合包安装信息存在问题", ex) Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
End Try End Try
'获取版本名 '获取版本名
If VersionName Is Nothing Then If InstanceName Is Nothing Then
VersionName = If(Json("name"), "") InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
End If End If
'解压 '解压
Dim InstallTemp As String = RequestTaskTempFolder() Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini" Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer)) Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory( CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides", InstallTemp & ArchiveBaseFolder & "overrides",
PathMcFolder & "versions\" & VersionName, McFolderSelected & "versions\" & InstanceName,
Task, 0.4) Task, 0.4)
'JVM 参数 'JVM 参数
If Json("launchInfo") IsNot Nothing Then If Json("launchInfo") IsNot Nothing Then
@@ -716,12 +723,12 @@ Retry:
Next Next
If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息,无法安装!") If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息,无法安装!")
If Addons.ContainsKey("quilt") Then If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical) Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Red)
Throw New CancelledException Throw New CancelledException
End If End If
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .NewInstanceName = InstanceName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Addons("game"), .MinecraftName = Addons("game"),
.OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing), .OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing), .ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
@@ -735,16 +742,16 @@ Retry:
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}) Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
'重复任务检查 '重复任务检查
Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " " Dim LoaderName As String = "MCBBS 整合包安装:" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical) Hint("该整合包正在安装中!", HintType.Red)
Throw New CancelledException Throw New CancelledException
End If End If
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState} Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件” 'If Archive IsNot Nothing Then Archive.Dispose() '解除占用,以免在加载器中触发 “正由另一进程使用,因此该进程无法访问此文件”
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -757,7 +764,7 @@ Retry:
MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True) MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)") Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Red) : Throw New CancelledException
'解压 '解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", { Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包", New LoaderTask(Of String, Integer)("解压压缩包",
@@ -786,7 +793,7 @@ Retry:
Log("[Modpack] 找到压缩包中附带的启动器:" & Launcher) Log("[Modpack] 找到压缩包中附带的启动器:" & Launcher)
If MyMsgBox($"整合包里似乎自带了启动器,是否换用它继续安装?{vbCrLf}即将打开:{Launcher}", "换用整合包启动器?", "换用", "不换用") = 1 Then If MyMsgBox($"整合包里似乎自带了启动器,是否换用它继续安装?{vbCrLf}即将打开:{Launcher}", "换用整合包启动器?", "换用", "不换用") = 1 Then
OpenExplorer(TargetFolder) OpenExplorer(TargetFolder)
ShellOnly(Launcher, "--wait") '要求等待已有的 PCL 退出 StartProcess(Launcher, "--wait") '要求等待已有的 PCL 退出
Log("[Modpack] 为换用整合包中的启动器启动,强制结束程序") Log("[Modpack] 为换用整合包中的启动器启动,强制结束程序")
FrmMain.EndProgram(False) FrmMain.EndProgram(False)
Return Return
@@ -796,11 +803,11 @@ Retry:
End If End If
OpenExplorer(TargetFolder) OpenExplorer(TargetFolder)
'加入文件夹列表 '加入文件夹列表
Dim VersionName As String = GetFolderNameFromPath(TargetFolder) Dim InstanceName As String = GetFolderNameFromPath(TargetFolder)
Directory.CreateDirectory(TargetFolder & ".minecraft\") Directory.CreateDirectory(TargetFolder & ".minecraft\")
PageSelectLeft.AddFolder( PageSelectLeft.AddFolder(
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串) TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
VersionName, False) InstanceName, False)
'调用 modpack 文件进行安装 '调用 modpack 文件进行安装
Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
Log("[Modpack] 调用 modpack 文件继续安装:" & ModpackFile) Log("[Modpack] 调用 modpack 文件继续安装:" & ModpackFile)
@@ -826,16 +833,15 @@ Retry:
Exit For Exit For
End If End If
Next Next
If Match Is Nothing Then Throw New Exception("未能找到适合的文件结构,这可能不是一个 MC 压缩包") '没有匹配 If Match Is Nothing Then Throw New Exception("文件结构不匹配,这可能不是 Minecraft 客户端压缩包?") '没有匹配
Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如:包裹文件夹\.minecraft\(最短为空字符串) Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
Dim VersionName As String = Match.Groups(1).Value Log("[ModPack] 检测到压缩包的 .minecraft 根目录:" & ArchiveBaseFolder & ",命中的版本名:" & Match.Groups(1).Value)
Log("[ModPack] 检测到压缩包的 .minecraft 根目录:" & ArchiveBaseFolder & ",命中的版本名:" & VersionName)
'获取解压路径 '获取解压路径
MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True) MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)") Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Throw New CancelledException If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Red) : Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Red) : Throw New CancelledException
'解压 '解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", { Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包", New LoaderTask(Of String, Integer)("解压压缩包",
@@ -844,7 +850,7 @@ Retry:
'加入文件夹列表 '加入文件夹列表
PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False) PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
Thread.Sleep(400) '避免文件争用 Thread.Sleep(400) '避免文件争用
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.VersionSelect)) RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.InstanceSelect))
End Sub) End Sub)
}) With {.OnStateChanged = AddressOf McInstallState} }) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(TargetFolder) Loader.Start(TargetFolder)
@@ -33,13 +33,13 @@
HasRunningMinecraft = False HasRunningMinecraft = False
FrmMain.BtnExtraShutdown.ShowRefresh() FrmMain.BtnExtraShutdown.ShowRefresh()
'音乐播放 '音乐播放
If Setup.Get("UiMusicStop") Then If Settings.Get("UiMusicStop") Then
RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置,在结束后开始音乐播放")) RunInUi(Sub() If MusicResume() Then Log("[Music] 已根据设置,在结束后开始音乐播放"))
ElseIf Setup.Get("UiMusicStart") Then ElseIf Settings.Get("UiMusicStart") Then
RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置,在结束后暂停音乐播放")) RunInUi(Sub() If MusicPause() Then Log("[Music] 已根据设置,在结束后暂停音乐播放"))
End If End If
'启动器可见性 '启动器可见性
Select Case Setup.Get("LaunchArgumentVisible") Select Case Settings.Get("LaunchArgumentVisible")
Case 2 Case 2
'直接关闭 '直接关闭
If TriggerLauncherShutdown Then If TriggerLauncherShutdown Then
@@ -58,13 +58,13 @@
'初始化 '初始化
Public GameProcess As Process Public GameProcess As Process
Public Version As McVersion Public Instance As McInstance
Private WindowTitle As String = "" Private WindowTitle As String = ""
Private PID As Integer Private PID As Integer
Public Loader As LoaderTask(Of Process, Integer) Public Loader As LoaderTask(Of Process, Integer)
Public Sub New(Loader As LoaderTask(Of Process, Integer), Version As McVersion, WindowTitle As String) Public Sub New(Loader As LoaderTask(Of Process, Integer), Instance As McInstance, WindowTitle As String)
Me.Loader = Loader Me.Loader = Loader
Me.Version = Version Me.Instance = Instance
Me.WindowTitle = WindowTitle Me.WindowTitle = WindowTitle
Me.PID = Loader.Input.Id Me.PID = Loader.Input.Id
WatcherLog("开始 Minecraft 日志监控") WatcherLog("开始 Minecraft 日志监控")
@@ -91,13 +91,13 @@
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Interrupted
TimerWindow() TimerWindow()
TimerLog() TimerLog()
'设置窗口标题 '设置窗口标题
For i = 1 To 3 For i = 1 To 3
If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss")) Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy'/'M'/'d")).Replace("{time}", Date.Now.ToString("HH':'mm':'ss"))
SetWindowText(WindowHandle, RealTitle.ToCharArray) SetWindowText(WindowHandle, RealTitle.ToCharArray)
End If End If
Thread.Sleep(64) Thread.Sleep(64)
@@ -164,7 +164,7 @@
'窗口未出现 '窗口未出现
WatcherLog("Minecraft 尚未加载完成,可能已崩溃") WatcherLog("Minecraft 尚未加载完成,可能已崩溃")
Crashed() Crashed()
ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Version.ReleaseTime.Year >= 2012 Then ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Instance.ReleaseTime.Year >= 2012 Then
'返回值不为 0 且未结束 '返回值不为 0 且未结束
WatcherLog("Minecraft 返回值异常,可能已崩溃") WatcherLog("Minecraft 返回值异常,可能已崩溃")
Crashed() Crashed()
@@ -277,7 +277,7 @@
WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})") WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})")
IsWindowFinished = True IsWindowFinished = True
'最大化 '最大化
If Setup.Get("LaunchArgumentWindowType") = 4 Then If Settings.Get("LaunchArgumentWindowType") = 4 Then
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
@@ -349,19 +349,19 @@
State = MinecraftState.Crashed State = MinecraftState.Crashed
'崩溃分析 '崩溃分析
WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析") WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
Hint("检测到 Minecraft 出现错误,错误分析已开始……") Hint("检测到 Minecraft 出现错误,错误分析已开始……", HintType.Red)
FeedbackInfo() FeedbackInfo()
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
Thread.Sleep(2000) Thread.Sleep(2000)
WatcherLog("崩溃分析开始") WatcherLog("崩溃分析开始")
Dim Analyzer As New CrashAnalyzer(PID) Dim Analyzer As New CrashAnalyzer(Instance)
Analyzer.Collect(Version.PathIndie, LatestLog.ToList) Analyzer.Collect(Instance.PathIndie, LatestLog.ToList)
Analyzer.Prepare() Analyzer.Prepare()
Analyzer.Analyze(Version) Analyzer.Analyze()
Analyzer.Output(False, New List(Of String) From Analyzer.Output(False, New List(Of String) From
{Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"}) {Instance.PathVersion & Instance.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
Catch ex As Exception Catch ex As Exception
Log(ex, "崩溃分析失败", LogLevel.Feedback) Log(ex, "崩溃分析失败", LogLevel.Feedback)
End Try End Try
+299 -74
View File
@@ -1,125 +1,334 @@
Public Module ModEvent 
#Region "附加属性"
Public Sub TryStartEvent(Type As String, Data As String) ''' <summary>
If String.IsNullOrWhiteSpace(Type) Then Return ''' 用于在 XAML 中初始化列表对象。
Dim RealData As String() = {""} ''' 附加属性无法在 XAML 中为每个对象初始化独立的列表对象,因此需要一个包装类,然后在 XAML 中显式初始化。
If Data IsNot Nothing Then RealData = Data.Split("|") ''' </summary>
StartEvent(Type, RealData) <Markup.ContentProperty("Events")>
Public Class CustomEventCollection
Implements IEnumerable(Of CustomEvent)
Dim _Events As New List(Of CustomEvent)
Public ReadOnly Property Events As List(Of CustomEvent)
Get
Return _Events
End Get
End Property
Public Function GetEnumerator() As IEnumerator(Of CustomEvent) Implements IEnumerable(Of CustomEvent).GetEnumerator
Return DirectCast(Events, IEnumerable(Of CustomEvent)).GetEnumerator()
End Function
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return DirectCast(Events, IEnumerable).GetEnumerator()
End Function
End Class
''' <summary>
''' 提供自定义事件的附加属性。
''' </summary>
Public Class CustomEventService
'Events
Public Shared ReadOnly EventsProperty As DependencyProperty =
DependencyProperty.RegisterAttached("Events", GetType(CustomEventCollection), GetType(CustomEventService), New PropertyMetadata(Nothing))
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Public Shared Sub SetEvents(d As DependencyObject, value As CustomEventCollection)
d.SetValue(EventsProperty, value)
End Sub End Sub
Public Sub StartEvent(Type As String, Data As String()) <AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Try Public Shared Function GetEvents(d As DependencyObject) As CustomEventCollection
Log("[Control] 执行自定义事件:" & Type & ", " & Join(Data, ", ")) If d.GetValue(EventsProperty) Is Nothing Then d.SetValue(EventsProperty, New CustomEventCollection)
Select Case Type Return d.GetValue(EventsProperty)
End Function
Case "打开网页" 'EventType
Data(0) = Data(0).Replace("\", "/") Public Shared ReadOnly EventTypeProperty As DependencyProperty =
If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议(#2200) DependencyProperty.RegisterAttached("EventType", GetType(CustomEvent.EventType), GetType(CustomEventService), New PropertyMetadata(Nothing))
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Public Shared Sub SetEventType(d As DependencyObject, value As CustomEvent.EventType)
d.SetValue(EventTypeProperty, value)
End Sub
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Public Shared Function GetEventType(d As DependencyObject) As CustomEvent.EventType
Return d.GetValue(EventTypeProperty)
End Function
'EventData
Public Shared ReadOnly EventDataProperty As DependencyProperty =
DependencyProperty.RegisterAttached("EventData", GetType(String), GetType(CustomEventService), New PropertyMetadata(Nothing))
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Public Shared Sub SetEventData(d As DependencyObject, value As String)
d.SetValue(EventDataProperty, value)
End Sub
<AttachedPropertyBrowsableForType(GetType(DependencyObject))>
Public Shared Function GetEventData(d As DependencyObject) As String
Return d.GetValue(EventDataProperty)
End Function
End Class
Partial Public Module ModMain
''' <summary>
''' 触发该控件上的自定义事件。
''' 事件会在新线程中执行。
''' </summary>
<Runtime.CompilerServices.Extension>
Public Sub RaiseCustomEvent(Control As DependencyObject)
'收集事件列表
Dim Events = CustomEventService.GetEvents(Control).ToList
Dim EventType = CustomEventService.GetEventType(Control)
If EventType <> CustomEvent.EventType.None Then Events.Add(New CustomEvent(EventType, CustomEventService.GetEventData(Control)))
'执行事件
If Not Events.Any Then Return
RunInNewThread(
Sub()
For Each e In Events
e.Raise()
Next
End Sub, "执行自定义事件 " & GetUuid())
End Sub
End Module
#End Region
''' <summary>
''' 自定义事件。
''' </summary>
Public Class CustomEvent
Inherits DependencyObject
#Region "属性与触发"
Public Property Type As EventType
Get
Dim Value As EventType = EventType.None
RunInUiWait(Sub() Value = GetValue(TypeProperty))
Return Value
End Get
Set(value As EventType)
SetValue(TypeProperty, value)
End Set
End Property
Public Shared ReadOnly TypeProperty As DependencyProperty =
DependencyProperty.Register("Type", GetType(EventType), GetType(CustomEvent), New PropertyMetadata(EventType.None))
Public Property Data As String
Get
Dim Value As String = Nothing
RunInUiWait(Sub() Value = GetValue(DataProperty))
Return Value
End Get
Set(value As String)
SetValue(DataProperty, value)
End Set
End Property
Public Shared ReadOnly DataProperty As DependencyProperty =
DependencyProperty.Register("Data", GetType(String), GetType(CustomEvent), New PropertyMetadata(Nothing))
Public Sub New()
End Sub
Public Sub New(Type As EventType, Data As String)
Me.Type = Type
Me.Data = Data
End Sub
''' <summary>
''' 在当前线程中触发该自定义事件。
''' </summary>
Public Sub Raise()
Raise(Type, Data)
End Sub
#End Region
Public Enum EventType
None = 0
打开网页
打开文件
打开帮助
执行命令
启动游戏
复制文本
刷新主页
刷新页面
刷新帮助
今日人品
内存优化
清理垃圾
弹出窗口
弹出提示
切换页面
导入整合包
安装整合包
下载文件
修改设置
写入设置
修改变量
写入变量
加入房间
检查更新
End Enum
''' <summary>
''' 在当前线程中触发一个自定义事件。
''' </summary>
Public Shared Sub Raise(Type As EventType, Arg As String)
If Type = EventType.None Then Return
Log($"[Control] 执行自定义事件:{Type}, {Arg}")
If Arg Is Nothing Then Arg = ""
Dim Args As String() = Arg.Split("|")
Try
Select Case Type
Case EventType.打开网页
Arg = Arg.Replace("\", "/")
If Not Arg.Contains("://") OrElse Arg.StartsWithF("file", True) Then '为了支持更多协议(#2200)
MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败") MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序,请将 EventType 改为 打开文件。", "事件执行失败")
Return Return
End If End If
Hint("正在开启中,请稍候……") Hint("正在开启中,请稍候:" & Arg)
OpenWebsite(Data(0)) RunInThread(Sub() OpenWebsite(Arg))
Case "打开文件", "打开帮助", "执行命令" Case EventType.打开文件, EventType.打开帮助, EventType.执行命令
RunInThread( RunInThread(
Sub() Sub()
Try Try
'确认实际路径 '确认实际路径
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type) Dim ActualPaths = GetAbsoluteUrls(Args(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1) Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}") Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
'执行 '执行
If Type = "打开帮助" Then If Type = EventType.打开帮助 Then
PageOtherHelp.EnterHelpPage(Location) PageOtherHelp.EnterHelpPage(Location)
Else Else
If Not Setup.Get("HintCustomCommand") Then If Not EventSafetyConfirm("即将执行:" & Location & If(Args.Length >= 2, " " & Args(1), "")) Then Return
Select Case MyMsgBox(
"即将执行:" & Location & If(Data.Length >= 2, " " & Data(1), "") & vbCrLf &
"请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
Case 2
Setup.Set("HintCustomCommand", True)
Case 3
Return
End Select
End If
Dim Info As New ProcessStartInfo With { Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""), .Arguments = If(Args.Length >= 2, Args(1), ""),
.FileName = Location, .FileName = Location,
.WorkingDirectory = ShortenPath(WorkingDir) .WorkingDirectory = WorkingDir
} }
Process.Start(Info) StartProcess(Info)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox) Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
End Try End Try
End Sub) End Sub)
Case "启动游戏" Case EventType.启动游戏
If Data(0) = "\current" Then If Args(0) = "\current" Then
If McVersionCurrent Is Nothing Then If McInstanceSelected Is Nothing Then
Hint("请先选择一个 Minecraft 版本!", HintType.Critical) Hint("请先选择一个 Minecraft 版本!", HintType.Red)
Return Return
Else Else
Data(0) = McVersionCurrent.Name Args(0) = McInstanceSelected.Name
End If End If
End If End If
RunInUi(
Sub()
If McLaunchStart(New McLaunchOptions With If McLaunchStart(New McLaunchOptions With
{.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then {.ServerIp = If(Args.Length >= 2, Args(1), Nothing), .Instance = New McInstance(Args(0))}) Then
Hint("正在启动 " & Data(0) & "……") Hint($"正在启动 {Args(0)}……")
End If
End Sub)
Case EventType.复制文本
ClipboardSet(Arg)
Case EventType.刷新主页
RunInUi(
Sub()
FrmLaunchRight.ForceRefresh()
If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
End Sub)
Case EventType.刷新页面
If TypeOf FrmMain.PageRight Is IRefreshable Then
RunInUiWait(Sub() CType(FrmMain.PageRight, IRefreshable).Refresh())
If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
Else
Hint("当前页面不支持刷新操作!", HintType.Red)
End If End If
Case "复制文本" Case EventType.刷新帮助
ClipboardSet(Join(Data, "|")) RunInUiWait(Sub() PageOtherLeft.RefreshHelp())
If String.IsNullOrEmpty(Arg) Then Hint("已刷新!", HintType.Green)
Case "刷新主页" Case EventType.今日人品
FrmLaunchRight.ForceRefresh()
If Data(0) = "" Then Hint("已刷新主页!", HintType.Finish)
Case "刷新帮助"
PageOtherLeft.RefreshHelp()
Case "今日人品"
PageOtherTest.Jrrp() PageOtherTest.Jrrp()
Case "内存优化" Case EventType.内存优化
RunInThread(Sub() PageOtherTest.MemoryOptimize(True)) RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
Case "清理垃圾" Case EventType.清理垃圾
RunInThread(Sub() PageOtherTest.RubbishClear()) RunInThread(Sub() PageOtherTest.RubbishClear())
Case "弹出窗口" Case EventType.弹出窗口
MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf)) If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 弹窗标题|弹窗内容")
MyMsgBox(Args(1).Replace("\n", vbCrLf), Args(0).Replace("\n", vbCrLf), If(Args.Length > 2, Args(2), "确定"))
Case "切换页面" Case EventType.弹出提示
FrmMain.PageChange(Val(Data(0)), Val(Data(1))) Hint(Args(0).Replace("\n", vbCrLf), If(Args.Length = 1, HintType.Blue, Args(1).ParseToEnum(Of HintType)))
Case "导入整合包", "安装整合包" Case EventType.切换页面
RunInUi(Sub() FrmMain.PageChange(
Args(0).ParseToEnum(Of FormMain.PageType),
If(Args.Length = 1, FormMain.PageSubType.Default, Args(1).ParseToEnum(Of FormMain.PageSubType))))
Case EventType.导入整合包, EventType.安装整合包
RunInUi(Sub() ModpackInstall()) RunInUi(Sub() ModpackInstall())
Case "下载文件" Case EventType.下载文件
Data(0) = Data(0).Replace("\", "/") Args(0) = Args(0).Replace("\", "/")
If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then If Not (Args(0).StartsWithF("http://", True) OrElse Args(0).StartsWithF("https://", True)) Then
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败") MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Return Return
End If End If
If Not EventSafetyConfirm("即将从该网址下载文件:" & vbCrLf & Args(0)) Then Return
RunInUi(
Sub()
Try Try
Select Case Data.Length Select Case Args.Length
Case 1 Case 1
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0))) PageOtherTest.StartCustomDownload(Args(0), GetFileNameFromPath(Args(0)))
Case 2 Case 2
PageOtherTest.StartCustomDownload(Data(0), Data(1)) PageOtherTest.StartCustomDownload(Args(0), Args(1))
Case Else Case Else
PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2)) PageOtherTest.StartCustomDownload(Args(0), Args(1), Args(2))
End Select End Select
Catch Catch
PageOtherTest.StartCustomDownload(Data(0), "未知") PageOtherTest.StartCustomDownload(Args(0), "未知")
End Try End Try
End Sub)
Case EventType.修改设置, EventType.写入设置
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 UiLauncherTransparent|400")
Settings.SetSafe(Args(0), Args(1), Instance:=McInstanceSelected)
If Args.Length = 2 Then Hint($"已写入设置:{Args(0)} → {Args(1)}", HintType.Green)
Case EventType.修改变量, EventType.写入变量
If Args.Length = 1 Then Throw New Exception($"EventType {Type} 需要至少 2 个以 | 分割的参数,例如 VariableName|SomeValue")
WriteReg("CustomEvent" & Args(0), Args(1))
If Args.Length = 2 Then Hint($"已写入变量:{Args(0)} → {Args(1)}", HintType.Green)
Case EventType.加入房间
RunInUi(
Sub()
If String.IsNullOrWhiteSpace(Arg) Then
PageLinkMain.Join()
Else
If Not EventSafetyConfirm("即将加入第三方联机房间。") Then Return
PageLinkMain.Join(Arg)
End If
End Sub)
Case EventType.检查更新
UpdateCheckByButton()
Case Else Case Else
MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败") MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
End Select End Select
Catch ex As Exception Catch ex As Exception
Log(ex, "事件执行失败", LogLevel.Msgbox) Log(ex, $"事件执行失败({Type}, {Arg})", LogLevel.Msgbox)
End Try End Try
End Sub End Sub
@@ -127,7 +336,7 @@
''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。 ''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
''' 失败会抛出异常。 ''' 失败会抛出异常。
''' </summary> ''' </summary>
Public Function GetEventAbsoluteUrls(RelativeUrl As String, EventType As String) As String() Public Shared Function GetAbsoluteUrls(RelativeUrl As String, Type As EventType) As String()
'网页确认 '网页确认
If RelativeUrl.StartsWithF("http", True) Then If RelativeUrl.StartsWithF("http", True) Then
@@ -160,7 +369,7 @@
End Try End Try
RelativeUrl = LocalTemp RelativeUrl = LocalTemp
End If End If
RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\") RelativeUrl = RelativeUrl.Replace("/", "\").Lower.TrimStart("\")
'确认实际路径 '确认实际路径
Dim Location As String, WorkingDir As String = Path & "PCL" Dim Location As String, WorkingDir As String = Path & "PCL"
@@ -168,25 +377,25 @@
If RelativeUrl.Contains(":\") Then If RelativeUrl.Contains(":\") Then
'绝对路径 '绝对路径
Location = RelativeUrl Location = RelativeUrl
Log("[Control] 自定义事件中由绝对路径" & EventType & ":" & Location) Log("[Control] 自定义事件中由绝对路径" & Type & ":" & Location)
ElseIf File.Exists(Path & "PCL\" & RelativeUrl) Then ElseIf File.Exists(Path & "PCL\" & RelativeUrl) Then
'相对 PCL 文件夹的路径 '相对 PCL 文件夹的路径
Location = Path & "PCL\" & RelativeUrl Location = Path & "PCL\" & RelativeUrl
Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & EventType & ":" & Location) Log("[Control] 自定义事件中由相对 PCL 文件夹的路径" & Type & ":" & Location)
ElseIf File.Exists(Path & "PCL\Help\" & RelativeUrl) Then ElseIf File.Exists(Path & "PCL\Help\" & RelativeUrl) Then
'相对 PCL 本地帮助文件夹的路径 '相对 PCL 本地帮助文件夹的路径
Location = Path & "PCL\Help\" & RelativeUrl Location = Path & "PCL\Help\" & RelativeUrl
WorkingDir = Path & "PCL\Help\" WorkingDir = Path & "PCL\Help\"
Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & EventType & ":" & Location) Log("[Control] 自定义事件中由相对 PCL 本地帮助文件夹的路径" & Type & ":" & Location)
ElseIf EventType = "打开帮助" AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then ElseIf Type = EventType.打开帮助 AndAlso File.Exists(PathTemp & "Help\" & RelativeUrl) Then
'相对 PCL 自带帮助文件夹的路径 '相对 PCL 自带帮助文件夹的路径
Location = PathTemp & "Help\" & RelativeUrl Location = PathTemp & "Help\" & RelativeUrl
WorkingDir = PathTemp & "Help\" WorkingDir = PathTemp & "Help\"
Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & ":" & Location) Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & Type & ":" & Location)
ElseIf EventType = "打开文件" OrElse EventType = "执行命令" Then ElseIf Type = EventType.打开文件 OrElse Type = EventType.执行命令 Then
'直接使用原有路径启动程序 '直接使用原有路径启动程序
Location = RelativeUrl Location = RelativeUrl
Log("[Control] 自定义事件中直接" & EventType & ":" & Location) Log("[Control] 自定义事件中直接" & Type & ":" & Location)
Else Else
'打开帮助,但是格式不对劲 '打开帮助,但是格式不对劲
Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件:" & RelativeUrl, RelativeUrl) Throw New FileNotFoundException("未找到 EventData 指向的本地 xaml 文件:" & RelativeUrl, RelativeUrl)
@@ -195,4 +404,20 @@
Return {Location, WorkingDir} Return {Location, WorkingDir}
End Function End Function
End Module ''' <summary>
''' 弹出安全确认弹窗。返回是否继续执行。
''' </summary>
Private Shared Function EventSafetyConfirm(Message As String) As Boolean
If Settings.Get("HintCustomCommand") Then Return True
Select Case MyMsgBox(Message & vbCrLf & "请在确认没有安全隐患后再继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
Case 1
Return True
Case 2
Settings.Set("HintCustomCommand", True)
Return True
Case Else
Return False
End Select
End Function
End Class
+154 -99
View File
@@ -7,23 +7,12 @@ Public Module ModMain
''' <summary> ''' <summary>
''' 提示信息的种类。 ''' 提示信息的种类。
''' 该枚举在自定义事件中使用,是公开 API 的一部分。
''' </summary> ''' </summary>
Public Enum HintType Public Enum HintType
''' <summary> Blue
''' 信息,通常是蓝色的“i”。 Green
''' </summary> Red
''' <remarks></remarks>
Info
''' <summary>
''' 已完成,通常是绿色的“√”。
''' </summary>
''' <remarks></remarks>
Finish
''' <summary>
''' 错误,通常是红色的“×”。
''' </summary>
''' <remarks></remarks>
Critical
End Enum End Enum
Private Structure HintMessage Private Structure HintMessage
Public Text As String Public Text As String
@@ -38,7 +27,7 @@ Public Module ModMain
''' <summary> ''' <summary>
''' 在窗口左下角弹出提示文本。 ''' 在窗口左下角弹出提示文本。
''' </summary> ''' </summary>
Public Sub Hint(Text As String, Optional Type As HintType = HintType.Info, Optional Log As Boolean = True) Public Sub Hint(Text As String, Optional Type As HintType = HintType.Blue, Optional Log As Boolean = True)
If HintWaiting Is Nothing Then HintWaiting = New SafeList(Of HintMessage) If HintWaiting Is Nothing Then HintWaiting = New SafeList(Of HintMessage)
HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log}) HintWaiting.Add(New HintMessage With {.Text = If(Text, ""), .Type = Type, .Log = Log})
End Sub End Sub
@@ -68,13 +57,13 @@ Public Module ModMain
Dim TargetColor0, TargetColor1 As MyColor Dim TargetColor0, TargetColor1 As MyColor
Dim Percent As Double = 0.3 Dim Percent As Double = 0.3
Select Case CurrentHint.Type Select Case CurrentHint.Type
Case HintType.Info Case HintType.Blue
TargetColor0 = New MyColor(215, 37, 155, 252) TargetColor0 = New MyColor(215, 37, 155, 252)
TargetColor1 = New MyColor(215, 10, 142, 252) TargetColor1 = New MyColor(215, 10, 142, 252)
Case HintType.Finish Case HintType.Green
TargetColor0 = New MyColor(215, 33, 177, 33) TargetColor0 = New MyColor(215, 33, 177, 33)
TargetColor1 = New MyColor(215, 29, 160, 29) TargetColor1 = New MyColor(215, 29, 160, 29)
Case Else 'HintType.Critical Case Else 'HintType.Red
TargetColor0 = New MyColor(215, 255, 53, 11) TargetColor0 = New MyColor(215, 255, 53, 11)
TargetColor1 = New MyColor(215, 255, 43, 0) TargetColor1 = New MyColor(215, 255, 43, 0)
End Select End Select
@@ -177,7 +166,7 @@ EndHint:
Public Text As String Public Text As String
''' <summary> ''' <summary>
''' 输入模式:文本框的文本。 ''' 输入模式:文本框的文本。
''' 选择模式:需要放进去的 List(Of MyListItem)。 ''' 选择模式:需要放进去的 IEnumberable(Of IMyRadio)。
''' 登录模式:登录步骤 1 中返回的 JSON。 ''' 登录模式:登录步骤 1 中返回的 JSON。
''' </summary> ''' </summary>
Public Content As Object Public Content As Object
@@ -248,10 +237,6 @@ EndHint:
'将弹窗列入队列 '将弹窗列入队列
Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Text, .Button1 = Button1, .Button2 = Button2, .Button3 = Button3, .Text = Caption, .IsWarn = IsWarn, .Title = Title, .HighLight = HighLight, .ForceWait = True, .Button1Action = Button1Action, .Button2Action = Button2Action, .Button3Action = Button3Action} Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Text, .Button1 = Button1, .Button2 = Button2, .Button3 = Button3, .Text = Caption, .IsWarn = IsWarn, .Title = Title, .HighLight = HighLight, .ForceWait = True, .Button1Action = Button1Action, .Button2Action = Button2Action, .Button3Action = Button3Action}
WaitingMyMsgBox.Add(Converter) WaitingMyMsgBox.Add(Converter)
If RunInUi() Then
'若为 UI 线程,立即执行弹窗刻, 避免快速(连点器)点击时多次弹窗
MyMsgBoxTick()
End If
If Button2.Length > 0 OrElse ForceWait Then If Button2.Length > 0 OrElse ForceWait Then
'若有多个按钮则开始等待 '若有多个按钮则开始等待
If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then If FrmMain Is Nothing OrElse FrmMain.PanMsg Is Nothing AndAlso RunInUi() Then
@@ -275,6 +260,7 @@ EndHint:
Else Else
Try Try
FrmMain.DragStop() FrmMain.DragStop()
If RunInUi() Then MyMsgBoxTick()
ComponentDispatcher.PushModal() ComponentDispatcher.PushModal()
Dispatcher.PushFrame(Converter.WaitFrame) Dispatcher.PushFrame(Converter.WaitFrame)
Finally Finally
@@ -306,6 +292,7 @@ EndHint:
'虽然我也不知道这是啥但是能用就成了 :) '虽然我也不知道这是啥但是能用就成了 :)
Try Try
If FrmMain IsNot Nothing Then FrmMain.DragStop() If FrmMain IsNot Nothing Then FrmMain.DragStop()
If RunInUi() Then MyMsgBoxTick()
ComponentDispatcher.PushModal() ComponentDispatcher.PushModal()
Dispatcher.PushFrame(Converter.WaitFrame) Dispatcher.PushFrame(Converter.WaitFrame)
Finally Finally
@@ -321,13 +308,14 @@ EndHint:
''' <param name="Button1">显示的第一个按钮,默认为 “确定”。</param> ''' <param name="Button1">显示的第一个按钮,默认为 “确定”。</param>
''' <param name="Button2">显示的第二个按钮,默认为空。</param> ''' <param name="Button2">显示的第二个按钮,默认为空。</param>
''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param> ''' <param name="IsWarn">是否为警告弹窗,若为 True,弹窗配色和背景会变为红色。</param>
Public Function MyMsgBoxSelect(Selections As List(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer? Public Function MyMsgBoxSelect(Selections As IEnumerable(Of IMyRadio), Optional Title As String = "提示", Optional Button1 As String = "确定", Optional Button2 As String = "", Optional IsWarn As Boolean = False) As Integer?
'将弹窗列入队列 '将弹窗列入队列
Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Select, .Button1 = Button1, .Button2 = Button2, .Content = Selections, .IsWarn = IsWarn, .Title = Title} Dim Converter As New MyMsgBoxConverter With {.Type = MyMsgBoxType.Select, .Button1 = Button1, .Button2 = Button2, .Content = Selections, .IsWarn = IsWarn, .Title = Title}
WaitingMyMsgBox.Add(Converter) WaitingMyMsgBox.Add(Converter)
'虽然我也不知道这是啥但是能用就成了 :) '虽然我也不知道这是啥但是能用就成了 :)
Try Try
If FrmMain IsNot Nothing Then FrmMain.DragStop() If FrmMain IsNot Nothing Then FrmMain.DragStop()
If RunInUi() Then MyMsgBoxTick()
ComponentDispatcher.PushModal() ComponentDispatcher.PushModal()
Dispatcher.PushFrame(Converter.WaitFrame) Dispatcher.PushFrame(Converter.WaitFrame)
Finally Finally
@@ -350,7 +338,7 @@ EndHint:
ElseIf WaitingMyMsgBox.Any Then ElseIf WaitingMyMsgBox.Any Then
'没有弹窗,显示一个等待的弹窗 '没有弹窗,显示一个等待的弹窗
FrmMain.PanMsg.Visibility = Visibility.Visible FrmMain.PanMsg.Visibility = Visibility.Visible
Select Case CType(WaitingMyMsgBox(0), MyMsgBoxConverter).Type Select Case WaitingMyMsgBox(0).Type
Case MyMsgBoxType.Input Case MyMsgBoxType.Input
FrmMain.PanMsg.Children.Add(New MyMsgInput(WaitingMyMsgBox(0))) FrmMain.PanMsg.Children.Add(New MyMsgInput(WaitingMyMsgBox(0)))
Case MyMsgBoxType.Select Case MyMsgBoxType.Select
@@ -363,7 +351,7 @@ EndHint:
WaitingMyMsgBox.RemoveAt(0) WaitingMyMsgBox.RemoveAt(0)
Else Else
'没有弹窗,没有等待的弹窗 '没有弹窗,没有等待的弹窗
If Not FrmMain.PanMsg.Visibility = Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed If FrmMain.PanMsg.Visibility <> Visibility.Collapsed Then FrmMain.PanMsg.Visibility = Visibility.Collapsed
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "处理等待中的弹窗失败", LogLevel.Feedback) Log(ex, "处理等待中的弹窗失败", LogLevel.Feedback)
@@ -388,21 +376,11 @@ EndHint:
Public FrmSpeedRight As PageSpeedRight Public FrmSpeedRight As PageSpeedRight
'联机页面声明 '联机页面声明
Public FrmLinkLeft As PageLinkLeft Public FrmLinkMain As PageLinkMain
Public FrmLinkIoi As PageLinkIoi
Public FrmLinkHiper As PageLinkHiper
Public FrmLinkHelp As PageOtherHelpDetail
Public FrmLinkFeedback As PageLinkFeedback
'下载页面声明 '下载页面声明
Public FrmDownloadLeft As PageDownloadLeft Public FrmDownloadLeft As PageDownloadLeft
Public FrmDownloadInstall As PageDownloadInstall Public FrmDownloadInstall As PageDownloadInstall
Public FrmDownloadClient As PageDownloadClient
Public FrmDownloadOptiFine As PageDownloadOptiFine
Public FrmDownloadLiteLoader As PageDownloadLiteLoader
Public FrmDownloadForge As PageDownloadForge
Public FrmDownloadNeoForge As PageDownloadNeoForge
Public FrmDownloadFabric As PageDownloadFabric
Public FrmDownloadMod As PageDownloadMod Public FrmDownloadMod As PageDownloadMod
Public FrmDownloadPack As PageDownloadPack Public FrmDownloadPack As PageDownloadPack
Public FrmDownloadDataPack As PageDownloadDataPack Public FrmDownloadDataPack As PageDownloadDataPack
@@ -432,12 +410,12 @@ EndHint:
Public FrmLoginMsSkin As PageLoginMsSkin Public FrmLoginMsSkin As PageLoginMsSkin
'版本设置页面声明 '版本设置页面声明
Public FrmVersionLeft As PageVersionLeft Public FrmInstanceLeft As PageInstanceLeft
Public FrmVersionOverall As PageVersionOverall Public FrmInstanceOverall As PageInstanceOverall
Public FrmVersionMod As PageVersionMod Public FrmInstanceMod As PageInstanceMod
Public FrmVersionModDisabled As PageVersionModDisabled Public FrmInstanceModDisabled As PageInstanceModDisabled
Public FrmVersionSetup As PageVersionSetup Public FrmInstanceSetup As PageInstanceSetup
Public FrmVersionExport As PageVersionExport Public FrmInstanceExport As PageInstanceExport
'资源信息分页声明 '资源信息分页声明
Public FrmDownloadCompDetail As PageDownloadCompDetail Public FrmDownloadCompDetail As PageDownloadCompDetail
@@ -496,7 +474,7 @@ EndHint:
''' 是否为 “执行事件”。 ''' 是否为 “执行事件”。
''' </summary> ''' </summary>
Public IsEvent As Boolean Public IsEvent As Boolean
Public EventType As String Public EventType As CustomEvent.EventType
Public EventData As String Public EventData As String
''' <summary> ''' <summary>
''' 若非执行事件,其对应的 .xaml 本地文件内容。 ''' 若非执行事件,其对应的 .xaml 本地文件内容。
@@ -510,7 +488,7 @@ EndHint:
''' </summary> ''' </summary>
Public Sub New(FilePath As String) Public Sub New(FilePath As String)
RawPath = FilePath RawPath = FilePath
Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath))) Dim JsonData As JObject = GetJson(ArgumentReplace(ReadFile(FilePath), AddressOf EscapeXML))
If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, FilePath) If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, FilePath)
'加载常规信息 '加载常规信息
If JsonData("Title") IsNot Nothing Then If JsonData("Title") IsNot Nothing Then
@@ -530,12 +508,11 @@ EndHint:
Next Next
'加载事件信息 '加载事件信息
If If(JsonData("IsEvent"), False) Then If If(JsonData("IsEvent"), False) Then
EventType = JsonData("EventType") EventType = [Enum].Parse(GetType(CustomEvent.EventType), JsonData("EventType").ToString)
If EventType Is Nothing Then Throw New ArgumentException("未找到 EventType 项")
EventData = If(JsonData("EventData"), "") EventData = If(JsonData("EventData"), "")
IsEvent = True IsEvent = True
Else Else
Dim XamlAddress As String = FilePath.ToLower.Replace(".json", ".xaml") Dim XamlAddress As String = FilePath.Lower.Replace(".json", ".xaml")
If File.Exists(XamlAddress) Then If File.Exists(XamlAddress) Then
XamlContent = ReadFile(XamlAddress) XamlContent = ReadFile(XamlAddress)
IsEvent = False IsEvent = False
@@ -556,7 +533,7 @@ EndHint:
Public Function SetToListItem(Item As MyListItem) As MyListItem Public Function SetToListItem(Item As MyListItem) As MyListItem
Dim Logo As String Dim Logo As String
If IsEvent Then If IsEvent Then
If EventType = "弹出窗口" Then If EventType = CustomEvent.EventType.弹出窗口 Then
Logo = PathImage & "Blocks/GrassPath.png" Logo = PathImage & "Blocks/GrassPath.png"
Else Else
Logo = PathImage & "Blocks/CommandBlock.png" Logo = PathImage & "Blocks/CommandBlock.png"
@@ -573,9 +550,9 @@ EndHint:
.Height = 42 .Height = 42
.Type = MyListItem.CheckType.Clickable .Type = MyListItem.CheckType.Clickable
.Tag = Me .Tag = Me
.EventType = Nothing
.EventData = Nothing
End With End With
CustomEventService.SetEventType(Item, CustomEvent.EventType.None) '清空自定义事件属性,它们会被下面的点击事件处理
CustomEventService.SetEventData(Item, Nothing)
'项目的点击事件 '项目的点击事件
AddHandler Item.Click, Sub(sender, e) PageOtherHelp.OnItemClick(sender.Tag) AddHandler Item.Click, Sub(sender, e) PageOtherHelp.OnItemClick(sender.Tag)
Return Item Return Item
@@ -602,7 +579,7 @@ EndHint:
'读取自定义文件 '读取自定义文件
If Directory.Exists(Path & "PCL\Help\") Then If Directory.Exists(Path & "PCL\Help\") Then
For Each File In EnumerateFiles(Path & "PCL\Help\") For Each File In EnumerateFiles(Path & "PCL\Help\")
Select Case File.Extension.ToLower Select Case File.Extension.Lower
Case ".helpignore" Case ".helpignore"
'加载忽略列表 '加载忽略列表
Log("[Help] 发现 .helpignore 文件:" & File.FullName) Log("[Help] 发现 .helpignore 文件:" & File.FullName)
@@ -621,7 +598,7 @@ EndHint:
'读取自带文件 '读取自带文件
For Each File In EnumerateFiles(PathTemp & "Help") For Each File In EnumerateFiles(PathTemp & "Help")
'跳过非 json 文件与以 . 开头的文件夹 '跳过非 json 文件与以 . 开头的文件夹
If File.Extension.ToLower <> ".json" OrElse File.Directory.FullName.Replace(PathTemp & "Help", "").Contains("\.") Then Continue For If File.Extension.Lower <> ".json" OrElse File.Directory.FullName.Replace(PathTemp & "Help", "").Contains("\.") Then Continue For
'检查忽略列表 '检查忽略列表
Dim RealPath As String = File.FullName.Replace(PathTemp & "Help\", "") Dim RealPath As String = File.FullName.Replace(PathTemp & "Help\", "")
For Each Ignore In IgnoreList For Each Ignore In IgnoreList
@@ -637,7 +614,7 @@ NextFile:
Catch ex As Exception Catch ex As Exception
Log(ex, "检查帮助文件夹失败", LogLevel.Msgbox) Log(ex, "检查帮助文件夹失败", LogLevel.Msgbox)
End Try End Try
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
'将文件实例化 '将文件实例化
Dim Dict As New List(Of HelpEntry) Dim Dict As New List(Of HelpEntry)
@@ -653,7 +630,7 @@ NextFile:
'回设 '回设
If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏") If Not Dict.Any() Then Throw New Exception("未找到可用的帮助;若不需要帮助页面,可以在 设置 → 个性化 → 功能隐藏 中将其隐藏")
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
Loader.Output = Dict Loader.Output = Dict
Catch ex As Exception Catch ex As Exception
@@ -666,34 +643,33 @@ NextFile:
''' 尝试解压内置帮助文件。 ''' 尝试解压内置帮助文件。
''' </summary> ''' </summary>
Public Sub HelpTryExtract() Public Sub HelpTryExtract()
If Setup.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then If Settings.Get("SystemHelpVersion") <> VersionCode OrElse Not File.Exists(PathTemp & "Help\启动器\备份设置.xaml") Then
DeleteDirectory(PathTemp & "Help") DeleteDirectory(PathTemp & "Help")
Directory.CreateDirectory(PathTemp & "Help") Directory.CreateDirectory(PathTemp & "Help")
WriteFile(PathTemp & "Cache\Help.zip", GetResources("Help")) WriteFile(PathTemp & "Cache\Help.zip", GetResources("Help"))
ExtractFile(PathTemp & "Cache\Help.zip", PathTemp & "Help", Encoding.UTF8) ExtractCompressedFile(PathTemp & "Cache\Help.zip", PathTemp & "Help")
Setup.Set("SystemHelpVersion", VersionCode) Settings.Set("SystemHelpVersion", VersionCode)
Log("[Help] 已解压内置帮助文件,目前状态:" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug) Log("[Help] 已解压内置帮助文件,目前状态:" & File.Exists(PathTemp & "Help\启动器\备份设置.xaml"), LogLevel.Debug)
End If End If
End Sub End Sub
''' <summary>
''' 对帮助文件约定的替换标记进行处理,如果遇到需要转义的字符会进行转义。
''' </summary>
Public Function HelpArgumentReplace(Xaml As String) As String
Dim Result = Xaml.Replace("{path}", EscapeXML(Path))
Result = Result.RegexReplaceEach("\{hint\}", Function() EscapeXML(PageOtherTest.GetRandomHint()))
Result = Result.RegexReplaceEach("\{cave\}", Function() EscapeXML(PageOtherTest.GetRandomCave()))
Return Result
End Function
#End Region #End Region
#Region "愚人节" #Region "愚人节"
Public IsAprilEnabled As Boolean = Date.Now.Month = 4 AndAlso Date.Now.Day = 1 Private _IsAprilEnabled As Boolean? = Nothing
Public ReadOnly Property IsAprilEnabled As Boolean
Get
If _IsAprilEnabled Is Nothing Then
_IsAprilEnabled =
Date.Now.Month = 4 AndAlso Date.Now.Day = 1 AndAlso
Settings.Get("AprilDoneYear") <> Date.Now.Year '成功后同年内则不再触发
End If
Return _IsAprilEnabled.Value
End Get
End Property
Public IsAprilGiveup As Boolean = False Public IsAprilGiveup As Boolean = False
Private AprilSpeed As New Vector(0, 0) Private AprilDifficultiedDistance As Integer = 0
Private AprilIdieCount As Integer = 0, AprilMousePosLast As New Point(0, 0)
Private AprilDistance As Integer = 0
Private Sub TimerFool() Private Sub TimerFool()
Try Try
If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Return If FrmLaunchLeft Is Nothing OrElse FrmLaunchLeft.AprilPosTrans Is Nothing OrElse FrmMain.lastMouseArg Is Nothing Then Return
@@ -701,11 +677,13 @@ NextFile:
'计算是否空闲 '计算是否空闲
Dim MousePos = FrmMain.lastMouseArg.GetPosition(FrmMain) Dim MousePos = FrmMain.lastMouseArg.GetPosition(FrmMain)
If MousePos = AprilMousePosLast Then Static IdieCount As Integer = 0
AprilIdieCount += 1 Static MousePosLast As New Point(0, 0)
If MousePos = MousePosLast Then
IdieCount += 1
Else Else
AprilMousePosLast = MousePos MousePosLast = MousePos
AprilIdieCount = 0 IdieCount = 0
End If End If
'计算躲避移动 '计算躲避移动
Dim Direction As Vector Dim Direction As Vector
@@ -717,9 +695,11 @@ NextFile:
Direction = -Dir Direction = -Dir
Distance = New Vector(Math.Max(0, Math.Abs(Vec.X) - ButtonWidth), Math.Max(0, Math.Abs(Vec.Y) - ButtonHeight)).Length Distance = New Vector(Math.Max(0, Math.Abs(Vec.X) - ButtonWidth), Math.Max(0, Math.Abs(Vec.Y) - ButtonHeight)).Length
Dim BreathScale = Math.Sin(Timer150Count / 37.5 * Math.PI) Dim BreathScale = Math.Sin(Timer150Count / 37.5 * Math.PI)
Dim Acc = Math.Max(0, BreathScale * 0.25 - 0.65 - Math.Log((Distance + 0.4) / 200)) * Direction '加速度 Dim Difficulty As Double = 1 / (1 + (AprilDifficultiedDistance / 6000) ^ 2) + 0.25 '难度,初始为 1.25x,6000 距离为 0.75x,12000 为 0.5x,24000 为 0.256x,最低 0.25x
'计算回归移动 Dim Acc = Math.Max(0, -0.65 - Math.Log((Distance / Difficulty + 0.4) / 200)) * Direction * Difficulty '加速度
If AprilIdieCount >= 64 * 5 Then 'FrmMain.Title = CInt(AprilTotalDistance) & " - " & Difficulty
'5s 不动时回到起始点
If IdieCount >= 64 * 5 Then
Dim SafeDist As Vector = FrmMain.lastMouseArg.GetPosition(FrmMain.PanMain) - New Vector(ButtonWidth, FrmMain.PanMain.ActualHeight - ButtonHeight * 3) Dim SafeDist As Vector = FrmMain.lastMouseArg.GetPosition(FrmMain.PanMain) - New Vector(ButtonWidth, FrmMain.PanMain.ActualHeight - ButtonHeight * 3)
Dim Back As New Vector(FrmLaunchLeft.AprilPosTrans.X, FrmLaunchLeft.AprilPosTrans.Y) Dim Back As New Vector(FrmLaunchLeft.AprilPosTrans.X, FrmLaunchLeft.AprilPosTrans.Y)
If SafeDist.Length > 250 AndAlso Back.Length > 0.4 Then If SafeDist.Length > 250 AndAlso Back.Length > 0.4 Then
@@ -729,10 +709,11 @@ NextFile:
End If End If
End If End If
'回到边界 '回到边界
Static Speed As New Vector(0, 0)
Dim Relative As Point = FrmLaunchLeft.BtnLaunch.TranslatePoint(New Point(0, 0), FrmMain.PanForm) Dim Relative As Point = FrmLaunchLeft.BtnLaunch.TranslatePoint(New Point(0, 0), FrmMain.PanForm)
If Relative.X < -ButtonWidth * 2 Then If Relative.X < -ButtonWidth * 2 Then
FrmLaunchLeft.AprilPosTrans.X += FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开左边界 FrmLaunchLeft.AprilPosTrans.X += FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开左边界
AprilSpeed.X -= 80 Speed.X -= 80
If Relative.Y < 0 Then If Relative.Y < 0 Then
FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5 FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
@@ -740,7 +721,7 @@ NextFile:
End If End If
ElseIf Relative.X > FrmMain.PanForm.ActualWidth Then ElseIf Relative.X > FrmMain.PanForm.ActualWidth Then
FrmLaunchLeft.AprilPosTrans.X -= FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开右边界 FrmLaunchLeft.AprilPosTrans.X -= FrmMain.PanForm.ActualWidth + ButtonWidth * 2 '离开右边界
AprilSpeed.X += 80 Speed.X += 80
If Relative.Y < 0 Then If Relative.Y < 0 Then
FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5 FrmLaunchLeft.AprilPosTrans.Y += ButtonHeight * 2.5
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then ElseIf Relative.Y > FrmMain.PanForm.ActualHeight - ButtonHeight * 2 Then
@@ -748,7 +729,7 @@ NextFile:
End If End If
ElseIf Relative.Y < -ButtonHeight * 2 Then ElseIf Relative.Y < -ButtonHeight * 2 Then
FrmLaunchLeft.AprilPosTrans.Y += FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开上边界 FrmLaunchLeft.AprilPosTrans.Y += FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开上边界
AprilSpeed.Y -= 25 Speed.Y -= 25
If Relative.X < 0 Then If Relative.X < 0 Then
FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2 FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
@@ -756,7 +737,7 @@ NextFile:
End If End If
ElseIf Relative.Y > FrmMain.PanForm.ActualHeight Then ElseIf Relative.Y > FrmMain.PanForm.ActualHeight Then
FrmLaunchLeft.AprilPosTrans.Y -= FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开下边界 FrmLaunchLeft.AprilPosTrans.Y -= FrmMain.PanForm.ActualHeight + ButtonHeight * 2 '离开下边界
AprilSpeed.Y += 25 Speed.Y += 25
If Relative.X < 0 Then If Relative.X < 0 Then
FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2 FrmLaunchLeft.AprilPosTrans.X += ButtonWidth * 2
ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then ElseIf Relative.X > FrmMain.PanForm.ActualWidth - ButtonWidth * 2 Then
@@ -764,29 +745,31 @@ NextFile:
End If End If
End If End If
'移动 '移动
AprilSpeed = AprilSpeed * 0.8 + Acc Speed = Speed * 0.8 + Acc
Dim SpeedValue = Math.Min(60, AprilSpeed.Length) Dim SpeedValue = Math.Min(60, Speed.Length)
If SpeedValue < 0.01 Then Return If SpeedValue < 0.01 Then Return
AprilSpeed.Normalize() Speed.Normalize()
AprilSpeed *= SpeedValue Speed *= SpeedValue
AprilDistance += SpeedValue AprilDifficultiedDistance += SpeedValue
FrmLaunchLeft.AprilPosTrans.X += AprilSpeed.X FrmLaunchLeft.AprilPosTrans.X += Speed.X
FrmLaunchLeft.AprilPosTrans.Y += AprilSpeed.Y FrmLaunchLeft.AprilPosTrans.Y += Speed.Y
'大小改变 '大小改变
FrmLaunchLeft.AprilScaleTrans.ScaleX = MathClamp(1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160), 0.2, 1.8) FrmLaunchLeft.AprilScaleTrans.ScaleX = MathClamp(1 - (Math.Abs(Direction.X) - Math.Abs(Direction.Y)) * (SpeedValue / 160), 0.2, 1.8)
FrmLaunchLeft.AprilScaleTrans.ScaleY = MathClamp(1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100), 0.2, 1.8) FrmLaunchLeft.AprilScaleTrans.ScaleY = MathClamp(1 - (Math.Abs(Direction.Y) - Math.Abs(Direction.X)) * (SpeedValue / 100), 0.2, 1.8)
'放弃提示 '放弃提示
If AprilDistance > 4000 Then Static GiveUpDistance As Double = -1500
AprilDistance = -4000 GiveUpDistance += SpeedValue
If GiveUpDistance > 2500 Then
GiveUpDistance = 0
Select Case RandomInteger(0, 3) Select Case RandomInteger(0, 3)
Case 0 Case 0
Hint("放弃吧!只需要点一下右下角的小白旗……") Hint("放弃吧!只需要点一下右下角的小白旗……", HintType.Red)
Case 1 Case 1
Hint("看到右下角的那面小白旗了吗?") Hint("看到右下角的那面小白旗了吗?", HintType.Red)
Case 2 Case 2
Hint("这里建议点一下右下角的小白旗投降呢.jpg") Hint("这里建议点一下右下角的小白旗投降呢.jpg", HintType.Red)
Case 3 Case 3
Hint("右下角的小白旗永远等着你……") Hint("右下角的小白旗永远等着你……", HintType.Red)
End Select End Select
End If End If
@@ -824,8 +807,7 @@ NextFile:
'查看现有设置 '查看现有设置
Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False) Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False)
If ReadOnlyKey IsNot Nothing Then If ReadOnlyKey IsNot Nothing Then
Dim CurrentValue = ReadOnlyKey.GetValue(Executeable) If REG_VALUE = ReadOnlyKey.GetValue(Executeable)?.ToString() Then
If REG_VALUE = CurrentValue?.ToString() Then
Log($"[System] 无需调整显卡设置:{Executeable}") Log($"[System] 无需调整显卡设置:{Executeable}")
Return Return
End If End If
@@ -842,6 +824,79 @@ NextFile:
End Using End Using
End Sub End Sub
''' <summary>
''' 对替换标记进行处理。会对替换内容使用 EscapeHandler 进行转义。
''' </summary>
Public Function ArgumentReplace(Text As String, Optional EscapeHandler As Func(Of String, String) = Nothing, Optional ReplaceTime As Boolean = True) As String
'预处理
If Text Is Nothing Then Return Nothing
Dim Replacer =
Function(s As String) As String
If s Is Nothing Then Return ""
If EscapeHandler Is Nothing Then Return s
If s.Contains(":\") Then s = ShortenPath(s)
Return EscapeHandler(s)
End Function
'基础
Text = Text.Replace("{pcl_version}", Replacer(VersionBaseName))
Text = Text.Replace("{pcl_version_code}", Replacer(VersionCode))
Text = Text.Replace("{pcl_version_branch}", Replacer(VersionBranchName))
Text = Text.Replace("{pcl_branch}", Replacer(VersionBranchMain))
Text = Text.Replace("{identify}", Replacer(Identify))
Text = Text.Replace("{path}", Replacer(Path))
Text = Text.Replace("{path_with_name}", Replacer(PathWithName))
Text = Text.Replace("{path_temp}", Replacer(PathTemp))
'时间
If ReplaceTime Then '在窗口标题中,时间会被后续动态替换,所以此时不应该替换
Text = Text.Replace("{date}", Replacer(Date.Now.ToString("yyyy'/'M'/'d")))
Text = Text.Replace("{time}", Replacer(Date.Now.ToString("HH':'mm':'ss")))
End If
'Minecraft
Text = Text.Replace("{java}", Replacer(McLaunchJavaSelected?.PathFolder))
Text = Text.Replace("{minecraft}", Replacer(McFolderSelected))
If McInstanceSelected?.IsLoaded Then
Text = Text.Replace("{version_path}", Replacer(McInstanceSelected.PathVersion)) : Text = Text.Replace("{verpath}", Replacer(McInstanceSelected.PathVersion))
Text = Text.Replace("{version_indie}", Replacer(McInstanceSelected.PathIndie)) : Text = Text.Replace("{verindie}", Replacer(McInstanceSelected.PathIndie))
Text = Text.Replace("{name}", Replacer(McInstanceSelected.Name))
If {"unknown", "old", "pending"}.Contains(McInstanceSelected.Version.VanillaName.Lower) Then
Text = Text.Replace("{version}", Replacer(McInstanceSelected.Name))
Else
Text = Text.Replace("{version}", Replacer(McInstanceSelected.Version.VanillaName))
End If
Else
Text = Text.Replace("{version_path}", Replacer(Nothing)) : Text = Text.Replace("{verpath}", Replacer(Nothing))
Text = Text.Replace("{version_indie}", Replacer(Nothing)) : Text = Text.Replace("{verindie}", Replacer(Nothing))
Text = Text.Replace("{name}", Replacer(Nothing))
Text = Text.Replace("{version}", Replacer(Nothing))
End If
'登录信息
If McLoginLoader.State = LoadState.Finished Then
Text = Text.Replace("{user}", Replacer(McLoginLoader.Output.Name))
Text = Text.Replace("{uuid}", Replacer(McLoginLoader.Output.Uuid?.Lower))
Select Case McLoginLoader.Input.Type
Case McLoginType.Legacy
Text = Text.Replace("{login}", Replacer("离线"))
Case McLoginType.Ms
Text = Text.Replace("{login}", Replacer("正版"))
Case McLoginType.Nide
Text = Text.Replace("{login}", Replacer("统一通行证"))
Case McLoginType.Auth
Text = Text.Replace("{login}", Replacer("Authlib-Injector"))
End Select
Else
Text = Text.Replace("{user}", Replacer(Nothing))
Text = Text.Replace("{uuid}", Replacer(Nothing))
Text = Text.Replace("{login}", Replacer(Nothing))
End If
'高级
Text = Text.RegexReplaceEach("\{hint\}", Function() Replacer(PageOtherTest.GetRandomHint()))
Text = Text.RegexReplaceEach("\{cave\}", Function() Replacer(PageOtherTest.GetRandomCave()))
Text = Text.RegexReplaceEach("\{setup:([a-zA-Z0-9]+)\}", Function(m) Replacer(Settings.GetSafe(m.Groups(1).Value, McInstanceSelected)))
Text = Text.RegexReplaceEach("\{varible:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Text = Text.RegexReplaceEach("\{variable:([^:\}]+)(?::([^\}]+))?\}", Function(m) Replacer(ReadReg("CustomEvent" & m.Groups(1).Value, m.Groups(2).Value)))
Return Text
End Function
#End Region #End Region
#Region "任务缓存" #Region "任务缓存"
@@ -931,7 +986,7 @@ NextFile:
Timer150Count = 0 Timer150Count = 0
Try Try
#Region "每 7.5s 执行一次的代码" #Region "每 7.5s 执行一次的代码"
If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDistance <> 0 Then FrmMain.BtnExtraApril.Ribble() If FrmMain.BtnExtraApril_ShowCheck AndAlso AprilDifficultiedDistance <> 0 Then FrmMain.BtnExtraApril.Ribble()
'以未知原因窗口被丢到一边去的修复(Top、Left = -25600),还有 #745 '以未知原因窗口被丢到一边去的修复(Top、Left = -25600),还有 #745
RunInUi( RunInUi(
Sub() Sub()
+27 -23
View File
@@ -24,13 +24,13 @@
Directory.CreateDirectory(Path & "PCL\Musics\") Directory.CreateDirectory(Path & "PCL\Musics\")
For Each File In EnumerateFiles(Path & "PCL\Musics\") For Each File In EnumerateFiles(Path & "PCL\Musics\")
'文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的 '文件夹可能会被加入 .ini 文件夹配置文件、一些乱七八糟的 .jpg 文件啥的
Dim Ext As String = File.Extension.ToLower Dim Ext As String = File.Extension.Lower
If {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(Ext) Then Continue For If {".ini", ".jpg", ".txt", ".cfg", ".lrc", ".db", ".png"}.Contains(Ext) Then Continue For
MusicAllList.Add(File.FullName) MusicAllList.Add(File.FullName)
Next Next
End If End If
'打乱顺序播放 '打乱顺序播放
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList)) MusicWaitingList = If(Settings.Get("UiMusicRandom"), New List(Of String)(MusicAllList).Shuffle().ToList, New List(Of String)(MusicAllList))
If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then
'若需要避免成为第一项的为第一项,则将它放在最后 '若需要避免成为第一项的为第一项,则将它放在最后
MusicWaitingList.RemoveAt(0) MusicWaitingList.RemoveAt(0)
@@ -79,7 +79,7 @@
If MusicState = MusicStates.Pause Then If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8 FrmMain.BtnExtraMusic.LogoScale = 0.8
ToolTipText = "已暂停:" & GetFileNameWithoutExtentionFromPath(MusicCurrent) ToolTipText = "已暂停:" & IO.Path.GetFileNameWithoutExtension(MusicCurrent)
If MusicAllList.Count > 1 Then If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。" ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
Else Else
@@ -88,7 +88,7 @@
Else Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1 FrmMain.BtnExtraMusic.LogoScale = 1
ToolTipText = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent) ToolTipText = "正在播放:" & IO.Path.GetFileNameWithoutExtension(MusicCurrent)
If MusicAllList.Count > 1 Then If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。" ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
Else Else
@@ -111,7 +111,7 @@
''' </summary> ''' </summary>
Public Sub MusicControlPause() Public Sub MusicControlPause()
If MusicNAudio Is Nothing Then If MusicNAudio Is Nothing Then
Hint("音乐播放尚未开始!", HintType.Critical) Hint("音乐播放尚未开始!", HintType.Red)
Else Else
Select Case MusicState Select Case MusicState
Case MusicStates.Pause Case MusicStates.Pause
@@ -129,16 +129,16 @@
''' 播放下一曲,并显示提示文本。 ''' 播放下一曲,并显示提示文本。
''' </summary> ''' </summary>
Public Sub MusicControlNext() Public Sub MusicControlNext()
If MusicAllList.Count = 1 Then If MusicAllList.IsSingle Then
MusicStartPlay(MusicCurrent) MusicStartPlay(MusicCurrent)
Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Finish) Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Green)
Else Else
Dim Address As String = DequeueNextMusicAddress() Dim Address As String = DequeueNextMusicAddress()
If Address Is Nothing Then If Address Is Nothing Then
Hint("没有可以播放的音乐!", HintType.Critical) Hint("没有可以播放的音乐!", HintType.Red)
Else Else
MusicStartPlay(Address) MusicStartPlay(Address)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish) Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Green)
End If End If
End If End If
MusicRefreshUI() MusicRefreshUI()
@@ -182,19 +182,19 @@
MusicListInit(True) MusicListInit(True)
If Not MusicAllList.Any() Then If Not MusicAllList.Any() Then
If MusicNAudio Is Nothing Then If MusicNAudio Is Nothing Then
If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Critical) If ShowHint Then Hint("未检测到可用的背景音乐!", HintType.Red)
Else Else
MusicNAudio = Nothing MusicNAudio = Nothing
If ShowHint Then Hint("背景音乐已清除!", HintType.Finish) If ShowHint Then Hint("背景音乐已清除!", HintType.Green)
End If End If
Else Else
Dim Address As String = DequeueNextMusicAddress() Dim Address As String = DequeueNextMusicAddress()
If Address Is Nothing Then If Address Is Nothing Then
If ShowHint Then Hint("没有可以播放的音乐!", HintType.Critical) If ShowHint Then Hint("没有可以播放的音乐!", HintType.Red)
Else Else
Try Try
MusicStartPlay(Address, IsFirstLoad) MusicStartPlay(Address, IsFirstLoad)
If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Finish, False) If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Green, False)
Catch Catch
End Try End Try
End If End If
@@ -247,7 +247,7 @@
Log("[Music] 已恢复播放") Log("[Music] 已恢复播放")
Try Try
MusicNAudio?.Play() MusicNAudio?.Play()
Catch 'https://github.com/Hex-Dragon/PCL2/pull/5415#issuecomment-2751135223 Catch 'https://github.com/Meloong-Git/PCL/pull/5415#issuecomment-2751135223
MusicNAudio?.Stop() MusicNAudio?.Stop()
MusicNAudio?.Play() MusicNAudio?.Play()
End Try End Try
@@ -261,6 +261,7 @@
''' <summary> ''' <summary>
''' 当前正在播放的 NAudio.Wave.WaveOutEvent。 ''' 当前正在播放的 NAudio.Wave.WaveOutEvent。
''' 如果为它赋了类别,则会没有必要地加载 NAudio.dll。
''' </summary> ''' </summary>
Public MusicNAudio = Nothing Public MusicNAudio = Nothing
''' <summary> ''' <summary>
@@ -279,18 +280,23 @@
CurrentWave = New NAudio.Wave.WaveOutEvent() CurrentWave = New NAudio.Wave.WaveOutEvent()
MusicNAudio = CurrentWave MusicNAudio = CurrentWave
CurrentWave.DeviceNumber = -1 CurrentWave.DeviceNumber = -1
Try
Reader = New NAudio.Wave.AudioFileReader(MusicCurrent) Reader = New NAudio.Wave.AudioFileReader(MusicCurrent)
Catch ex As Exception
Log(ex, "使用 AudioFileReader 加载音频文件失败,换用 MediaFoundationReader 重试", LogLevel.Developer)
Reader = New NAudio.Wave.MediaFoundationReader(MusicCurrent)
End Try
CurrentWave.Init(Reader) CurrentWave.Init(Reader)
CurrentWave.Play() CurrentWave.Play()
'第一次打开的暂停 '第一次打开的暂停
If IsFirstLoad AndAlso Not Setup.Get("UiMusicAuto") Then CurrentWave.Pause() If IsFirstLoad AndAlso Not Settings.Get("UiMusicAuto") Then CurrentWave.Pause()
MusicRefreshUI() MusicRefreshUI()
'停止条件:播放完毕或变化 '停止条件:播放完毕或变化
Dim PreviousVolume = 0 Dim PreviousVolume = 0
While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped While CurrentWave.Equals(MusicNAudio) AndAlso Not CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped
If Setup.Get("UiMusicVolume") <> PreviousVolume Then If Settings.Get("UiMusicVolume") <> PreviousVolume Then
'更新音量 '更新音量
PreviousVolume = Setup.Get("UiMusicVolume") PreviousVolume = Settings.Get("UiMusicVolume")
CurrentWave.Volume = PreviousVolume / 1000 CurrentWave.Volume = PreviousVolume / 1000
End If End If
'更新进度条 '更新进度条
@@ -303,18 +309,16 @@
Catch ex As Exception Catch ex As Exception
Log(ex, "播放音乐出现内部错误(" & MusicCurrent & ")", LogLevel.Developer) Log(ex, "播放音乐出现内部错误(" & MusicCurrent & ")", LogLevel.Developer)
If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then
Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL,才能恢复音乐播放功能!", HintType.Critical) Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL,才能恢复音乐播放功能!", HintType.Red)
Thread.Sleep(1000000000) Thread.Sleep(1000000000)
End If End If
If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Critical) Hint("由于音频设备变更,音乐播放功能在重启 PCL 后才能恢复!", HintType.Red)
Thread.Sleep(1000000000) Thread.Sleep(1000000000)
End If End If
If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then If Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
ex.Message.Contains("0xC00D36C4") Then '#5096:不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4) ex.Message.Contains("0xC00D36C4") Then '#5096:不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical) Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Red)
Else Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint) Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
End If End If
+35 -27
View File
@@ -1,18 +1,21 @@
'由于包含加解密等安全信息,本文件中的部分代码已被删除 '由于包含加解密等安全信息,本文件中的部分代码已被删除
Imports System.Net.Http
Imports System.Security.Cryptography Imports System.Security.Cryptography
Friend Module ModSecret Friend Module ModSecret
#Region "杂项" #Region "杂项"
'标注 PCL 的不同分支,仅用于替换标记
Public Const VersionBranchMain As String = "OpenSource"
'在开源版的注册表与常规版的注册表隔离,以防数据冲突 '在开源版的注册表与常规版的注册表隔离,以防数据冲突
Public Const RegFolder As String = "PCLDebug" Public Const RegFolder As String = "PCLDebug"
'用于微软登录的 ClientId '用于微软登录的 ClientId
Public Const OAuthClientId As String = "" Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "")
'CurseForge API Key 'CurseForge API Key
Public Const CurseForgeAPIKey As String = "" Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "")
'用于匿名数据收集的腾讯云日志服务上报 URL,形如 https://{region}.cls.tencentcs.com/track?topic_id={topic_id}
Public Const ClsBaseUrl As String = ""
Friend Sub SecretOnApplicationStart() Friend Sub SecretOnApplicationStart()
'提升 UI 线程优先级 '提升 UI 线程优先级
@@ -55,43 +58,35 @@ Friend Module ModSecret
''' <summary> ''' <summary>
''' 获取设备标识码。 ''' 获取设备标识码。
''' </summary> ''' </summary>
Friend Function SecretGetUniqueAddress() As String Friend Function SecretGetIdentify() As String
Return "0000-0000-0000-0000" Return "0000-0000-0000-0000"
End Function End Function
Friend Sub SecretLaunchJvmArgs(ByRef DataList As List(Of String))
Dim DataJvmCustom As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
DataList.Insert(0, If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom)) '可变 JVM 参数
McLaunchLog("当前剩余内存:" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & "m")
If Not DataList.Any(Function(d) d.Contains("-Dlog4j2.formatMsgNoLookups=true")) Then DataList.Add("-Dlog4j2.formatMsgNoLookups=true")
End Sub
#End Region #End Region
#Region "网络鉴权" #Region "网络鉴权"
Friend Function SecretCdnSign(UrlWithMark As String) Friend Function SecretCdnSign(UrlWithMark As String) As String
If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark
Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20") Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20")
End Function End Function
''' <summary> ''' <summary>
''' 设置 Headers 的 UA、Referer。 ''' 设置 Headers 的 UA、Referer。
''' </summary> ''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional UseBrowserUserAgent As Boolean = False) Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional SimulateBrowserHeaders As Boolean = False)
If Not Req.Headers.UserAgent.Any Then
If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
Req.Headers.Add("User-Agent", "LogStatistic") '#4951 Req.Headers.Add("User-Agent", "LogStatistic") '#4951
ElseIf UseBrowserUserAgent Then ElseIf SimulateBrowserHeaders Then
Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36") Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{VersionBranchCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
Else Else
Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode}") Req.Headers.Add("User-Agent", $"PCL2/{VersionBaseName}.{VersionBranchCode}")
End If End If
Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/") End If
If Not SimulateBrowserHeaders Then Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
If Url.Contains("api.curseforge.com") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey) If Url.Contains("api.curseforge.com") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey)
End Sub End Sub
#End Region #End Region
#Region "字符串加解密" #Region "字符串加解密"
@@ -213,13 +208,19 @@ Friend Module ModSecret
If Not FrmMain.IsLoaded Then Return If Not FrmMain.IsLoaded Then Return
'顶部条背景 '顶部条背景
Dim Brush = New LinearGradientBrush With {.EndPoint = New Point(1, 0), .StartPoint = New Point(0, 0)} Dim Brush = New LinearGradientBrush With {.EndPoint = New Point(1, 0), .StartPoint = New Point(0, 0)}
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - 21, ColorSat, 53 + ColorLightAdjust)}) If TypeOf ColorHueTopbarDelta Is Integer Then
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.33, .Color = New MyColor().FromHSL2(ColorHue - 7, ColorSat, 47 + ColorLightAdjust)}) Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.67, .Color = New MyColor().FromHSL2(ColorHue + 7, ColorSat, 47 + ColorLightAdjust)}) Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 54 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + 21, ColorSat, 53 + ColorLightAdjust)}) Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
Else
Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(0), ColorSat, 48 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(1), ColorSat, 54 + ColorLightAdjust)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(2), ColorSat, 48 + ColorLightAdjust)})
End If
FrmMain.PanTitle.Background = Brush FrmMain.PanTitle.Background = Brush
FrmMain.PanTitle.Background.Freeze()
'主页面背景 '主页面背景
If Setup.Get("UiBackgroundColorful") Then If Settings.Get("UiBackgroundColorful") Then
Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)} Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)}
Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 15, ColorSat * 0.8, 91)}) Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 15, ColorSat * 0.8, 91)})
Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.8, 91)}) Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.8, 91)})
@@ -271,9 +272,16 @@ Friend Module ModSecret
#End Region #End Region
#Region "联网通知" #Region "联网配置"
Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 服务", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal) ''' <summary>
''' 联网获取的配置信息。
''' 若获取失败或仍在获取中,可能为 Nothing。
''' </summary>
Public ServerConfig As JObject
Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 配置更新", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal) With
{.ReloadTimeout = 1000 * 60 * 60} '超时 1 小时
#End Region #End Region
@@ -1,59 +0,0 @@
Imports System.Net
Public Class CookieWebClient
Inherits WebClient
Public Sub New(container As CookieContainer, Headers As Dictionary(Of String, String))
Me.New(container)
For Each keyVal In Headers
Me.Headers(keyVal.Key) = keyVal.Value
Next
End Sub
Public Sub New()
Me.New(New CookieContainer())
End Sub
Public Sub New(container As CookieContainer)
Me.container = container
End Sub
Private Shadows ReadOnly container As New CookieContainer()
''' <summary>
''' 以毫秒为单位的超时。
''' </summary>
Public Timeout As Integer = 600000
Protected Overrides Function GetWebRequest(address As Uri) As WebRequest
Dim r As WebRequest = MyBase.GetWebRequest(address)
Dim request = TryCast(r, HttpWebRequest)
If request IsNot Nothing Then
request.CookieContainer = container
request.Timeout = Timeout
End If
Return r
End Function
Protected Overrides Function GetWebResponse(request As WebRequest, result As IAsyncResult) As WebResponse
Dim response As WebResponse = MyBase.GetWebResponse(request, result)
ReadCookies(response)
Return response
End Function
Protected Overrides Function GetWebResponse(request As WebRequest) As WebResponse
Dim response As WebResponse = MyBase.GetWebResponse(request)
ReadCookies(response)
Return response
End Function
Private Sub ReadCookies(r As WebResponse)
Dim response = TryCast(r, HttpWebResponse)
If response IsNot Nothing Then
Dim cookies As CookieCollection = response.Cookies
container.Add(cookies)
End If
End Sub
End Class
+151
View File
@@ -0,0 +1,151 @@
'来源:https://blog.csdn.net/simpleman2000/article/details/140952294
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Imports System.Windows.Interop
Public Class DragHelper
Public Event DragDrop As EventHandler
Public Property DropFilePaths As String()
Get
Return _DropFilePathsBackingField
End Get
Private Set(value As String())
_DropFilePathsBackingField = value
End Set
End Property
Private _DropFilePathsBackingField As String()
Public Property DropPoint As POINT
Get
Return _DropPointBackingField
End Get
Private Set(value As POINT)
_DropPointBackingField = value
End Set
End Property
Private _DropPointBackingField As POINT
Public Property HwndIntPtrSource As HwndSource
Public Sub AddHook()
RemoveDragHook()
HwndIntPtrSource.AddHook(AddressOf WndProc)
Dim handle As IntPtr = HwndIntPtrSource.Handle
If IsUserAnAdmin() Then RevokeDragDrop(handle)
DragAcceptFiles(handle, True)
ChangeMessageFilter(handle)
End Sub
Public Sub RemoveDragHook()
HwndIntPtrSource.RemoveHook(AddressOf WndProc)
DragAcceptFiles(HwndIntPtrSource.Handle, False)
End Sub
Private Function WndProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr
Dim filePaths As String() = Nothing
Dim point As New POINT()
If TryGetDropInfo(msg, wParam, filePaths, point) Then
DropPoint = point
DropFilePaths = filePaths
RaiseEvent DragDrop(Me, EventArgs.Empty)
handled = True
End If
Return IntPtr.Zero
End Function
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function ChangeWindowMessageFilterEx(hWnd As IntPtr, msg As UInteger, action As UInteger, ByRef pChangeFilterStruct As CHANGEFILTERSTRUCT) As Boolean
End Function
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function ChangeWindowMessageFilter(msg As UInteger, flags As UInteger) As Boolean
End Function
<DllImport("shell32.dll")>
Private Shared Sub DragAcceptFiles(hWnd As IntPtr, fAccept As Boolean)
End Sub
<DllImport("shell32.dll", CharSet:=CharSet.Unicode)>
Private Shared Function DragQueryFile(hWnd As IntPtr, iFile As UInteger, lpszFile As StringBuilder, cch As Integer) As UInteger
End Function
<DllImport("shell32.dll")>
Private Shared Function DragQueryPoint(hDrop As IntPtr, ByRef lppt As POINT) As Boolean
End Function
<DllImport("shell32.dll")>
Private Shared Sub DragFinish(hDrop As IntPtr)
End Sub
<DllImport("ole32.dll")>
Private Shared Function RevokeDragDrop(hWnd As IntPtr) As Integer
End Function
<DllImport("shell32.dll")>
Private Shared Function IsUserAnAdmin() As Boolean
End Function
<StructLayout(LayoutKind.Sequential)>
Public Structure POINT
Public X As Integer
Public Y As Integer
End Structure
<StructLayout(LayoutKind.Sequential)>
Private Structure CHANGEFILTERSTRUCT
Public cbSize As UInteger
Public ExtStatus As UInteger
End Structure
Private Const WM_COPYGLOBALDATA As UInteger = &H49
Private Const WM_COPYDATA As UInteger = &H4A
Private Const WM_DROPFILES As UInteger = &H233
Private Const MSGFLT_ALLOW As UInteger = 1
Private Const MSGFLT_ADD As UInteger = 1
Private Const MAX_PATH As Integer = 260
Private Shared Sub ChangeMessageFilter(handle As IntPtr)
Dim ver As Version = Environment.OSVersion.Version
Dim isVistaOrHigher As Boolean = ver >= New Version(6, 0)
Dim isNt61OrHiger As Boolean = ver >= New Version(6, 1)
If isVistaOrHigher Then
Dim status As New CHANGEFILTERSTRUCT With {.cbSize = 8}
For Each msg As UInteger In New UInteger() {WM_DROPFILES, WM_COPYGLOBALDATA, WM_COPYDATA}
Dim [error] As Boolean = False
If isNt61OrHiger Then
[error] = Not ChangeWindowMessageFilterEx(handle, msg, MSGFLT_ALLOW, status)
Else
[error] = Not ChangeWindowMessageFilter(msg, MSGFLT_ADD)
End If
If [error] Then Throw New Win32Exception(Marshal.GetLastWin32Error())
Next
End If
End Sub
Private Shared Function TryGetDropInfo(msg As Integer, wParam As IntPtr, ByRef dropFilePaths As String(), ByRef dropPoint As POINT) As Boolean
dropFilePaths = Nothing
dropPoint = New POINT()
If msg <> WM_DROPFILES Then Return False
Dim fileCount As UInteger = DragQueryFile(wParam, UInteger.MaxValue, Nothing, 0)
ReDim dropFilePaths(CInt(fileCount) - 1)
For i As UInteger = 0 To CInt(fileCount) - 1
Dim sb As New StringBuilder(MAX_PATH)
Dim result As UInteger = DragQueryFile(wParam, i, sb, sb.Capacity)
If result > 0 Then dropFilePaths(i) = sb.ToString()
Next
DragQueryPoint(wParam, dropPoint)
DragFinish(wParam)
Return True
End Function
End Class
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.10.3.0")> <Assembly: AssemblyVersion("2.12.6.2")>
<Assembly: AssemblyFileVersion("2.10.3.0")> <Assembly: AssemblyFileVersion("2.12.6.2")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
+69 -9
View File
@@ -63,9 +63,9 @@ Namespace My.Resources
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
Friend ReadOnly Property Custom() As Byte() Friend ReadOnly Property CacheCow_Client() As Byte()
Get Get
Dim obj As Object = ResourceManager.GetObject("Custom", resourceCulture) Dim obj As Object = ResourceManager.GetObject("CacheCow.Client", resourceCulture)
Return CType(obj,Byte()) Return CType(obj,Byte())
End Get End Get
End Property End Property
@@ -73,9 +73,29 @@ Namespace My.Resources
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
Friend ReadOnly Property Dialogs() As Byte() Friend ReadOnly Property CacheCow_Client_FileStore() As Byte()
Get Get
Dim obj As Object = ResourceManager.GetObject("Dialogs", resourceCulture) Dim obj As Object = ResourceManager.GetObject("CacheCow.Client.FileStore", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property CacheCow_Common() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("CacheCow.Common", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Custom() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Custom", resourceCulture)
Return CType(obj,Byte()) Return CType(obj,Byte())
End Get End Get
End Property End Property
@@ -105,7 +125,7 @@ Namespace My.Resources
'''</summary> '''</summary>
Friend ReadOnly Property Imazen_WebP() As Byte() Friend ReadOnly Property Imazen_WebP() As Byte()
Get Get
Dim obj As Object = ResourceManager.GetObject("Imazen_WebP", resourceCulture) Dim obj As Object = ResourceManager.GetObject("Imazen.WebP", resourceCulture)
Return CType(obj,Byte()) Return CType(obj,Byte())
End Get End Get
End Property End Property
@@ -123,9 +143,9 @@ Namespace My.Resources
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
Friend ReadOnly Property Json() As Byte() Friend ReadOnly Property libwebp64() As Byte()
Get Get
Dim obj As Object = ResourceManager.GetObject("Json", resourceCulture) Dim obj As Object = ResourceManager.GetObject("libwebp64", resourceCulture)
Return CType(obj,Byte()) Return CType(obj,Byte())
End Get End Get
End Property End Property
@@ -133,9 +153,9 @@ Namespace My.Resources
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
Friend ReadOnly Property libwebp64() As Byte() Friend ReadOnly Property LUA() As Byte()
Get Get
Dim obj As Object = ResourceManager.GetObject("libwebp64", resourceCulture) Dim obj As Object = ResourceManager.GetObject("LUA", resourceCulture)
Return CType(obj,Byte()) Return CType(obj,Byte())
End Get End Get
End Property End Property
@@ -160,6 +180,46 @@ Namespace My.Resources
End Get End Get
End Property End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Newtonsoft_Json() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Newtonsoft.Json", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Ookii_Dialogs_Wpf() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Ookii.Dialogs.Wpf", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property System_Net_Http_Formatting() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("System.Net.Http.Formatting", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property System_ValueTuple() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("System.ValueTuple", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
@@ -118,36 +118,54 @@
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader> </resheader>
<assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" /> <assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" />
<data name="CacheCow.Client" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\CacheCow.Client.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="CacheCow.Client.FileStore" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\CacheCow.Client.FileStore.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="CacheCow.Common" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\CacheCow.Common.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Custom" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="Custom" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\resources\custom.xaml;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\resources\custom.xaml;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="Dialogs" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\resources\ookii.dialogs.wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="ForgeInstaller" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="ForgeInstaller" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\forge-installer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\forge-installer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="Help" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="Help" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Help.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\Help.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="Imazen_WebP" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="Imazen.WebP" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="JavaWrapper" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="JavaWrapper" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\java-wrapper.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\java-wrapper.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="libwebp64" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="libwebp64" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\libwebp64.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\libwebp64.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="LUA" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\lwjgl-unsafe-agent.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="ModData" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\ModData.txt;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\moddata.zip;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="NAudio" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="NAudio" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\NAudio.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\NAudio.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="Newtonsoft.Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Ookii.Dialogs.Wpf" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\resources\ookii.dialogs.wpf.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="System.Net.Http.Formatting" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\System.Net.Http.Formatting.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="System.ValueTuple" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\System.ValueTuple.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
@@ -3,16 +3,6 @@
#Region "基础属性" #Region "基础属性"
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
'Logo
Public Property Logo As String
Get
Return PathLogo.Source
End Get
Set(value As String)
PathLogo.Source = value
End Set
End Property
'标题 '标题
Public Property Title As String Public Property Title As String
Get Get
@@ -64,17 +54,17 @@
'Tag 'Tag
Public WriteOnly Property Tags As List(Of String) Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String)) Set(Tags As List(Of String))
PanTags.Children.Clear() PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed) PanTags.Visibility = If(Tags.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value For Each TagText In Tags
Dim NewTag = GetObjectFromXML( Dim BorderTag As New Border With {
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" .Background = New MyColor("#11000000"), .Padding = New Thickness(3, 1, 3, 1), .CornerRadius = New CornerRadius(3),
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0"" .Margin = New Thickness(0, 0, 3, 0), .SnapsToDevicePixels = True, .UseLayoutRounding = False}
SnapsToDevicePixels=""True"" UseLayoutRounding=""False""> Dim LabTag As New TextBlock With {
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" /> .Text = TagText, .Foreground = New MyColor("#868686"), .FontSize = 11}
</Border>") BorderTag.Child = LabTag
PanTags.Children.Add(NewTag) PanTags.Children.Add(BorderTag)
Next Next
End Set End Set
End Property End Property
@@ -97,43 +87,43 @@
Dim Titles As New List(Of String) Dim Titles As New List(Of String)
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
For Each Card As MyCard In FrmDownloadCompDetail.PanResults.Children For Each Card As MyCard In FrmDownloadCompDetail.PanResults.Children
If Card.Title <> "" AndAlso Not Card.IsSwaped Then Titles.Add(Card.Title) If Card.Title <> "" AndAlso Not Card.IsSwapped Then Titles.Add(Card.Title)
Next Next
Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles)) Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles))
FrmMain.PageCurrent.Additional(1) = Titles FrmMain.PageCurrent.Additional(1) = Titles
End If End If
'打开详情页 '打开详情页
Dim TargetType As CompType Dim TargetType As CompType
Dim TargetVersion As String = Nothing Dim TargetInstance As String = Nothing
Dim TargetLoader As CompModLoaderType = CompModLoaderType.Any Dim TargetLoader As CompModLoaderType = CompModLoaderType.Any
If FrmMain.PageCurrent.Page = FormMain.PageType.Download Then If FrmMain.PageCurrent.Page = FormMain.PageType.Download Then
'从下载页进入 '从下载页进入
Select Case FrmMain.PageCurrentSub Select Case FrmMain.PageCurrentSub
Case FormMain.PageSubType.DownloadMod Case FormMain.PageSubType.DownloadMod
TargetType = CompType.Mod TargetType = CompType.Mod
TargetVersion = FrmDownloadMod.Content.Loader.Input.GameVersion TargetInstance = FrmDownloadMod.Content.Loader.Input.GameVersion
TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoader TargetLoader = FrmDownloadMod.Content.Loader.Input.ModLoader
Case FormMain.PageSubType.DownloadPack Case FormMain.PageSubType.DownloadPack
TargetType = CompType.ModPack TargetType = CompType.ModPack
TargetVersion = FrmDownloadPack.Content.Loader.Input.GameVersion TargetInstance = FrmDownloadPack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadDataPack Case FormMain.PageSubType.DownloadDataPack
TargetType = CompType.DataPack TargetType = CompType.DataPack
TargetVersion = FrmDownloadDataPack.Content.Loader.Input.GameVersion TargetInstance = FrmDownloadDataPack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadResourcePack Case FormMain.PageSubType.DownloadResourcePack
TargetType = CompType.ResourcePack TargetType = CompType.ResourcePack
TargetVersion = FrmDownloadResourcePack.Content.Loader.Input.GameVersion TargetInstance = FrmDownloadResourcePack.Content.Loader.Input.GameVersion
Case FormMain.PageSubType.DownloadShader Case FormMain.PageSubType.DownloadShader
TargetType = CompType.Shader TargetType = CompType.Shader
TargetVersion = FrmDownloadShader.Content.Loader.Input.GameVersion TargetInstance = FrmDownloadShader.Content.Loader.Input.GameVersion
End Select End Select
Else Else
'从详情页进入(查看前置) '从详情页进入(查看前置)
TargetType = CompType.Any '允许任意类别 TargetType = CompType.Any '允许任意类别
TargetVersion = FrmMain.PageCurrent.Additional(2) TargetInstance = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3) TargetLoader = FrmMain.PageCurrent.Additional(3)
End If End If
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail, FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.CompDetail,
.Additional = {sender.Tag, New List(Of String), TargetVersion, TargetLoader, TargetType}}) .Additional = {sender.Tag, New List(Of String), TargetInstance, TargetLoader, TargetType}})
End Sub End Sub
'鼠标点击判定 '鼠标点击判定
@@ -32,22 +32,21 @@
<local:MyComboBoxItem Content="Modrinth" Tag="2" /> <local:MyComboBoxItem Content="Modrinth" Tag="2" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320"> <local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" /> <local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.5" /> <local:MyComboBoxItem Content="26.1" />
<local:MyComboBoxItem Content="1.21.11" />
<local:MyComboBoxItem Content="1.21.8" />
<local:MyComboBoxItem Content="1.21.4" />
<local:MyComboBoxItem Content="1.21.1" /> <local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.1" /> <local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" /> <local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" /> <local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.16.5" /> <local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.12.2" /> <local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" /> <local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox> </local:MyComboBox>
<local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" MaxDropDownHeight="320" Margin="10,0,0,0"> <local:MyComboBox x:Name="ComboSearchLoader" Visibility="Collapsed" Grid.Row="2" Grid.Column="2" Margin="10,0,0,0">
<local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" /> <local:MyComboBoxItem Content="任意 Mod 加载器" IsSelected="True" Tag="0" />
<local:MyComboBoxItem Content="Forge" Tag="1" /> <local:MyComboBoxItem Content="Forge" Tag="1" />
<local:MyComboBoxItem Content="NeoForge" Tag="6" /> <local:MyComboBoxItem Content="NeoForge" Tag="6" />
@@ -55,7 +54,7 @@
<local:MyComboBoxItem Content="Quilt" Tag="5" /> <local:MyComboBoxItem Content="Quilt" Tag="5" />
</local:MyComboBox> </local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" /> <TextBlock VerticalAlignment="Center" Grid.Column="4" Grid.Row="2" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" MaxDropDownHeight="320" /> <local:MyComboBox x:Name="ComboSearchTag" Grid.Column="5" Grid.Row="2" />
</Grid> </Grid>
<Grid Margin="0,4,0,6" Height="35"> <Grid Margin="0,4,0,6" Height="35">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
@@ -71,7 +70,7 @@
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
<StackPanel x:Name="PanContent"> <StackPanel x:Name="PanContent">
<local:MyHint x:Name="HintError" HasBorder="True" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。&#xa;请稍后重试,或使用 VPN 以改善网络环境。" Theme="Yellow" Margin="0,0,0,15" /> <local:MyHint x:Name="HintError" HasBorder="True" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,搜索结果可能不全。&#xa;请稍后再试,或使用 VPN 改善网络环境。" Theme="Yellow" Margin="0,0,0,15" />
<local:MyCard x:Name="CardProjects" UseAnimation="False"> <local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" /> <StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard> </local:MyCard>
@@ -89,7 +88,7 @@
</local:MyCard> </local:MyCard>
</StackPanel> </StackPanel>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50"> <local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取XXX列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" /> <local:MyLoading Text="正在获取XXX列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" ShowProgress="True" />
</local:MyCard> </local:MyCard>
</StackPanel> </StackPanel>
</local:MyScrollViewer> </local:MyScrollViewer>
@@ -67,7 +67,7 @@ Public Class PageComp
''' <summary> ''' <summary>
''' 在切换到页面时,应自动将筛选项设置为与该目标 MC 版本和加载器相同。 ''' 在切换到页面时,应自动将筛选项设置为与该目标 MC 版本和加载器相同。
''' </summary> ''' </summary>
Public Shared TargetVersion As McVersion = Nothing Public Shared TargetInstance As McInstance = Nothing
''' <summary> ''' <summary>
''' 在切换到该页面时自动设置的搜索框内的内容。 ''' 在切换到该页面时自动设置的搜索框内的内容。
''' </summary> ''' </summary>
@@ -76,13 +76,13 @@ Public Class PageComp
'在点击 MyCompItem 时会获取 Loader 的输入,以使资源详情页面可以应用相同的筛选项 '在点击 MyCompItem 时会获取 Loader 的输入,以使资源详情页面可以应用相同的筛选项
Public Loader As New LoaderTask(Of CompProjectRequest, Integer)("社区资源获取:XXX", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000} Public Loader As New LoaderTask(Of CompProjectRequest, Integer)("社区资源获取:XXX", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Private IsLoaderInited As Boolean = False
Private Sub PageCompControls_Inited(sender As Object, e As EventArgs) Handles Me.Loaded Private Sub PageCompControls_Inited(sender As Object, e As EventArgs) Handles Me.Loaded
Static IsFirstLoaded As Boolean = False
'不知道从 Initialized 改成 Loaded 会不会有问题,但用 Initialized 会导致初始的筛选器修改被覆盖回默认值 '不知道从 Initialized 改成 Loaded 会不会有问题,但用 Initialized 会导致初始的筛选器修改被覆盖回默认值
If TargetVersion IsNot Nothing Then If TargetInstance IsNot Nothing Then
'设置目标 '设置目标
ResetFilter() '重置筛选器 ResetFilter() '重置筛选器
TextSearchVersion.Text = TargetVersion.Version.McName TextSearchVersion.Text = TargetInstance.Version.VanillaName
Dim GetTargetItemByName = Dim GetTargetItemByName =
Function(Name As String) As MyComboBoxItem Function(Name As String) As MyComboBoxItem
For Each Item As MyComboBoxItem In ComboSearchLoader.Items For Each Item As MyComboBoxItem In ComboSearchLoader.Items
@@ -90,31 +90,36 @@ Public Class PageComp
Next Next
Return ComboSearchLoader.Items(0) Return ComboSearchLoader.Items(0)
End Function End Function
If TargetVersion.Version.HasForge Then If TargetInstance.Version.HasForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Forge") ComboSearchLoader.SelectedItem = GetTargetItemByName("Forge")
ElseIf TargetVersion.Version.HasFabric Then ElseIf TargetInstance.Version.HasFabric Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Fabric") ComboSearchLoader.SelectedItem = GetTargetItemByName("Fabric")
ElseIf TargetVersion.Version.HasNeoForge Then ElseIf TargetInstance.Version.HasNeoForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("NeoForge") ComboSearchLoader.SelectedItem = GetTargetItemByName("NeoForge")
End If End If
TargetVersion = Nothing TargetInstance = Nothing
If TargetName IsNot Nothing Then If TargetName IsNot Nothing Then
'设置搜索框内容
TextSearchName.Text = TargetName TextSearchName.Text = TargetName
TargetName = Nothing TargetName = Nothing
End If End If
'如果已经完成请求,则重新开始 '如果已经完成请求,则重新开始
If IsLoaderInited Then StartNewSearch() If IsFirstLoaded Then StartNewSearch()
ScrollToHome() ScrollToHome()
End If End If
'加载器初始化 '加载器初始化
If IsLoaderInited Then Return If IsFirstLoaded Then Return
IsLoaderInited = True IsFirstLoaded = True
CType(Parent, MyPageRight).PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput) CType(Parent, MyPageRight).PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput)
If McVersionHighest = -1 Then McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1))) '将最高 Drop 加入筛选
If AllDrops IsNot Nothing AndAlso AllDrops.First > 250 Then
Dim HighestVersion As String = McVersion.DropToVersion(AllDrops.First)
If CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString <> HighestVersion Then '0 是全部
TextSearchVersion.Items.Insert(1, New MyComboBoxItem With {.Content = HighestVersion})
End If
End If
End Sub End Sub
Private Function LoaderInput() As CompProjectRequest Private Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(PageType, Storage, (Page + 1) * PageSize) Dim Request As New CompProjectRequest(PageType, Storage, (Page + 1) * PAGE_SIZE)
Dim GameVersion As String = If(TextSearchVersion.Text = "全部 (也可自行输入)", Nothing, Dim GameVersion As String = If(TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w"), TextSearchVersion.Text, Nothing)) If(TextSearchVersion.Text.Contains(".") OrElse TextSearchVersion.Text.Contains("w"), TextSearchVersion.Text, Nothing))
With Request With Request
@@ -122,7 +127,7 @@ Public Class PageComp
.GameVersion = GameVersion .GameVersion = GameVersion
.Tag = ComboSearchTag.SelectedItem.Tag .Tag = ComboSearchTag.SelectedItem.Tag
.ModLoader = If(PageType = CompType.Mod, Val(ComboSearchLoader.SelectedItem.Tag), CompModLoaderType.Any) .ModLoader = If(PageType = CompType.Mod, Val(ComboSearchLoader.SelectedItem.Tag), CompModLoaderType.Any)
.Source = CType(Val(ComboSearchSource.SelectedItem.Tag), CompSourceType) .Sources = CType(Val(ComboSearchSource.SelectedItem.Tag), CompSourceType)
End With End With
Return Request Return Request
End Function End Function
@@ -133,7 +138,7 @@ Public Class PageComp
''' <summary> ''' <summary>
''' 每页展示的结果数量。 ''' 每页展示的结果数量。
''' </summary> ''' </summary>
Public Const PageSize = 40 Public Const PAGE_SIZE = 40
Public Page As Integer = 0 Public Page As Integer = 0
'结果 UI 化 '结果 UI 化
@@ -142,8 +147,9 @@ Public Class PageComp
Log($"[Comp] 开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页") Log($"[Comp] 开始可视化{TypeNameSpaced}列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
'列表项 '列表项
PanProjects.Children.Clear() PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1) Dim Index As Integer = Math.Min(Page * PAGE_SIZE, Storage.Results.Count - 1)
PanProjects.Children.Add(Storage.Results(i).ToCompItem( For Each Result In Storage.Results.GetRange(Index, Math.Min(Storage.Results.Count - Index, PAGE_SIZE))
PanProjects.Children.Add(Result.ToCompItem(
ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing, ShowMcVersionDesc:=Loader.Input.GameVersion Is Nothing,
ShowLoaderDesc:=Loader.Input.ModLoader = CompModLoaderType.Any AndAlso (PageType = CompType.Mod OrElse PageType = CompType.ModPack))) ShowLoaderDesc:=Loader.Input.ModLoader = CompModLoaderType.Any AndAlso (PageType = CompType.Mod OrElse PageType = CompType.ModPack)))
Next Next
@@ -157,7 +163,7 @@ Public Class PageComp
BtnPageLeft.IsEnabled = Page > 0 BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(Page > 0, 1, 0.2) BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319) Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
Storage.Results.Count > PageSize * (Page + 1) OrElse Storage.Results.Count > PAGE_SIZE * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2) BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadCompDetail" mc:Ignorable="d" x:Class="PageDownloadCompDetail"
PanScroll="{Binding ElementName=PanBack}"> PanScroll="PanBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<Grid Margin="25,25,25,10"> <Grid Margin="25,25,25,10">
<Grid.RowDefinitions> <Grid.RowDefinitions>
@@ -20,6 +20,7 @@
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
<StackPanel Grid.Row="1" Grid.RowSpan="2" Name="PanMain" Grid.IsSharedSizeScope="True"> <StackPanel Grid.Row="1" Grid.RowSpan="2" Name="PanMain" Grid.IsSharedSizeScope="True">
<local:MyHint x:Name="HintAlternative" Theme="Blue" Margin="0,0,0,15" />
<local:MyCard Margin="0,0,0,15" x:Name="CardFilter"> <local:MyCard Margin="0,0,0,15" x:Name="CardFilter">
<StackPanel x:Name="PanFilter" Margin="10,10,0,10" Orientation="Horizontal" VerticalAlignment="Top" HorizontalAlignment="Left" /> <StackPanel x:Name="PanFilter" Margin="10,10,0,10" Orientation="Horizontal" VerticalAlignment="Top" HorizontalAlignment="Left" />
</local:MyCard> </local:MyCard>
@@ -8,7 +8,7 @@
Sub(Task) Sub(Task)
LoadTargetFromAdditional() LoadTargetFromAdditional()
Dim Result = CompFilesGet(Project.Id, Project.FromCurseForge) Dim Result = CompFilesGet(Project.Id, Project.FromCurseForge)
If Task.IsAborted Then Return If Task.IsInterrupted Then Return
Task.Output = Result Task.Output = Result
End Sub) End Sub)
@@ -19,16 +19,17 @@
End Sub End Sub
Public Sub LoadTargetFromAdditional() Handles Me.Loaded Public Sub LoadTargetFromAdditional() Handles Me.Loaded
Project = FrmMain.PageCurrent.Additional(0) Project = FrmMain.PageCurrent.Additional(0)
TargetVersion = FrmMain.PageCurrent.Additional(2) TargetInstance = FrmMain.PageCurrent.Additional(2)
TargetLoader = FrmMain.PageCurrent.Additional(3) TargetLoader = FrmMain.PageCurrent.Additional(3)
PageType = FrmMain.PageCurrent.Additional(4) TargetType = FrmMain.PageCurrent.Additional(4)
End Sub End Sub
Private Project As CompProject Private Project As CompProject
Private TargetVersion As String, TargetLoader As CompModLoaderType Private TargetInstance As String, TargetLoader As CompModLoaderType
''' <summary> ''' <summary>
''' 当前页面应展示的内容类别。可能为 Any。 ''' 当前页面应展示的内容类别。
''' 若当前页面是在查看前置时进入,则也可能为 Any。
''' </summary> ''' </summary>
Private PageType As CompType Private TargetType As CompType
'自动重试 '自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case CompFileLoader.State Select Case CompFileLoader.State
@@ -52,16 +53,16 @@
If x = Topmost Then Return -1 If x = Topmost Then Return -1
If y = Topmost Then Return 1 If y = Topmost Then Return 1
'特殊版本 '特殊版本
Dim IsXSpecial As Boolean = x.EndsWithF("版本") Dim IsXSpecial As Boolean = Not x.Contains(".")
Dim IsYSpecial As Boolean = y.EndsWithF("版本") Dim IsYSpecial As Boolean = Not y.Contains(".")
If IsXSpecial AndAlso IsYSpecial Then Return x.CompareTo(y) If IsXSpecial AndAlso IsYSpecial Then Return x.CompareTo(y)
If IsXSpecial Then Return 1 If IsXSpecial Then Return 1
If IsYSpecial Then Return -1 If IsYSpecial Then Return -1
'比较版本号 '比较版本号
Dim VersionCodeSort = -VersionSortInteger(x.Replace(x.BeforeFirst(" ") & " ", ""), y.Replace(y.BeforeFirst(" ") & " ", "")) Dim VersionCodeSort = -CompareVersion(x.Replace(x.BeforeFirst(" ") & " ", ""), y.Replace(y.BeforeFirst(" ") & " ", ""))
If VersionCodeSort <> 0 Then Return VersionCodeSort If VersionCodeSort <> 0 Then Return VersionCodeSort
'比较全部 '比较全部
Return -VersionSortInteger(x, y) Return -CompareVersion(x, y)
End Function End Function
Public Sub New(Optional Topmost As String = "") Public Sub New(Optional Topmost As String = "")
Me.Topmost = If(Topmost, "") Me.Topmost = If(Topmost, "")
@@ -69,49 +70,59 @@
End Class End Class
Private VersionFilter As String Private VersionFilter As String
Private IsMajorVersionFilter As Boolean '是否按大版本号筛选(1.21 / 1.20 / 1.19 / ...)而非小版本号(1.21.1 / 1.21 / 1.20.4 / ...) Private GroupedDrop As Boolean '是否按 Drop 筛选(1.21 / 1.20 / 1.19 / ...)而非小版本号(1.21.1 / 1.21 / 1.20.4 / ...)
Private GroupedOld As Boolean '是否折叠远古版本为一个选项
'筛选类型相同的结果(Modrinth 会返回 Mod、服务端插件、数据包混合的列表) '筛选类型相同的结果(Modrinth 会返回 Mod、服务端插件、数据包混合的列表)
Private Function GetResults() As List(Of CompFile) Private Function GetResults() As List(Of CompFile)
Dim Results As List(Of CompFile) = CompFileLoader.Output Dim Results As List(Of CompFile) = CompFileLoader.Output
If PageType = CompType.Any Then Select Case TargetType
Case CompType.Any
Results = Results.Where(Function(r) r.Type <> CompType.Plugin).ToList Results = Results.Where(Function(r) r.Type <> CompType.Plugin).ToList
ElseIf PageType = CompType.Shader OrElse PageType = CompType.ResourcePack Then Case CompType.Shader, CompType.ResourcePack
Results = Results.ToList '不筛选光影和资源包,否则原版光影会因为是资源包格式而被过滤(#6473)
Else Case Else
Results = Results.Where(Function(r) r.Type = PageType).ToList Results = Results.Where(Function(r) r.Type = TargetType).ToList
End If End Select
Return Results Return Results
End Function End Function
Private Sub Load_OnFinish() Private Sub Load_OnFinish()
Dim Results = GetResults() Dim Results = GetResults()
'初始化筛选器 '初始化筛选器
Dim VersionFilters As List(Of String) Dim Filters As List(Of String) = Nothing
Dim UpdateFilters =
Sub()
Filters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld)).
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
End Sub
'按小版本号筛选? '确定分组方式
IsMajorVersionFilter = False GroupedDrop = False : GroupedOld = False
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)). UpdateFilters()
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList If Filters.Count < 9 Then GoTo GroupDone
'按大版本号筛选? GroupedDrop = True : GroupedOld = False
If VersionFilters.Count >= 9 Then UpdateFilters()
IsMajorVersionFilter = True If Filters.Count < 9 Then GoTo GroupDone
VersionFilters = Results.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)). GroupedDrop = False : GroupedOld = True
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList UpdateFilters()
End If If Filters.Count < 9 Then GoTo GroupDone
GroupedDrop = True : GroupedOld = True
UpdateFilters()
GroupDone:
'UI 化筛选器 'UI 化筛选器
PanFilter.Children.Clear() PanFilter.Children.Clear()
If VersionFilters.Count < 2 Then If Filters.Count < 2 Then
CardFilter.Visibility = Visibility.Collapsed CardFilter.Visibility = Visibility.Collapsed
VersionFilter = Nothing VersionFilter = Nothing
Else Else
CardFilter.Visibility = Visibility.Visible CardFilter.Visibility = Visibility.Visible
VersionFilters.Insert(0, "全部") Filters.Insert(0, "全部")
'转化为按钮 '转化为按钮
For Each Version As String In VersionFilters For Each Version As String In Filters
Dim NewButton As New MyRadioButton With { Dim NewButton As New MyRadioButton With {
.Text = Version, .Margin = New Thickness(2, 0, 2, 0), .ColorType = MyRadioButton.ColorState.Highlight} .Text = Version, .Margin = New Thickness(2, 0, 2, 0), .ColorType = MyRadioButton.ColorState.Highlight}
NewButton.LabText.Margin = New Thickness(-2, 0, 8, 0) NewButton.LabText.Margin = New Thickness(-2, 0, 10, 0)
AddHandler NewButton.Check, AddHandler NewButton.Check,
Sub(sender As MyRadioButton, raiseByMouse As Boolean) Sub(sender As MyRadioButton, raiseByMouse As Boolean)
VersionFilter = If(sender.Text = "全部", Nothing, sender.Text) VersionFilter = If(sender.Text = "全部", Nothing, sender.Text)
@@ -121,10 +132,10 @@
Next Next
'自动选择 '自动选择
Dim ToCheck As MyRadioButton = Nothing Dim ToCheck As MyRadioButton = Nothing
If TargetVersion <> "" Then If TargetInstance <> "" Then
Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion)) Dim TargetFile = Results.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetInstance))
If TargetFile IsNot Nothing Then If TargetFile IsNot Nothing Then
Dim TargetGroup = GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True) Dim TargetGroup = GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld)
For Each Button As MyRadioButton In PanFilter.Children For Each Button As MyRadioButton In PanFilter.Children
If Button.Text <> TargetGroup Then Continue For If Button.Text <> TargetGroup Then Continue For
ToCheck = Button ToCheck = Button
@@ -142,26 +153,26 @@
Private Sub UpdateFilterResult() Private Sub UpdateFilterResult()
Dim Results = GetResults() Dim Results = GetResults()
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any, Dim TargetCardName As String = If(TargetInstance <> "" OrElse TargetLoader <> CompModLoaderType.Any,
$"所选版本:{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "") $"{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetInstance}(所选版本)", "")
'归类到卡片下 '归类到卡片下
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName)) Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New CardSorter(TargetCardName))
Dict.Add("其他版本", New List(Of CompFile)) Dict.Add("其他", New List(Of CompFile))
Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType))) Dim SupportedLoaders As New List(Of Integer)([Enum].GetValues(GetType(CompModLoaderType)))
For Each Version As CompFile In Results For Each Version As CompFile In Results
For Each GameVersion In Version.GameVersions For Each GameVersion In Version.GameVersions
'检查是否符合版本筛选器 '检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso If VersionFilter IsNot Nothing AndAlso
GetGroupedVersionName(GameVersion, IsMajorVersionFilter, True) <> VersionFilter Then Continue For GetGroupedVersionName(GameVersion, GroupedDrop, GroupedOld) <> VersionFilter Then Continue For
'决定添加到哪个卡片 '决定添加到哪个卡片
Dim VerName As String = GetGroupedVersionName(GameVersion, False, False) Dim VerName As String = GetGroupedVersionName(GameVersion, False, False)
'遍历加入的加载器列表 '遍历加入的加载器列表
Dim Loaders As New List(Of String) Dim Loaders As New List(Of String)
If Project.ModLoaders.Count > 1 AndAlso '工程至少有两个加载器 If Project.ModLoaders.Count > 1 AndAlso '工程至少有两个加载器
Version.Type = CompType.Mod AndAlso '是 Mod Version.Type = CompType.Mod AndAlso '是 Mod
VerName.StartsWith("1.") Then '不是 “快照版本” 之类的 McVersion.IsFormatFit(VerName) Then '不是 “快照版本” 之类的
For Each Loader In Version.ModLoaders For Each Loader In Version.ModLoaders
If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For If Loader = CompModLoaderType.Quilt AndAlso Settings.Get("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ") If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
Next Next
End If End If
@@ -175,14 +186,14 @@
Next Next
Next Next
'添加筛选的版本的卡片 '添加筛选的版本的卡片
If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True).StartsWithF(VersionFilter)) Then If TargetCardName <> "" AndAlso (VersionFilter Is Nothing OrElse GetGroupedVersionName(TargetInstance, GroupedDrop, GroupedOld).StartsWithF(VersionFilter)) Then
Dict.Add(TargetCardName, New List(Of CompFile)) Dict.Add(TargetCardName, New List(Of CompFile))
For Each Version As CompFile In Results For Each Version As CompFile In Results
If Version.GameVersions.Contains(TargetVersion) AndAlso If Version.GameVersions.Contains(TargetInstance) AndAlso
(TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then (TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then
'检查是否符合版本筛选器 '检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso If VersionFilter IsNot Nothing AndAlso
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True) = VersionFilter) Then Continue For Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, GroupedDrop, GroupedOld) = VersionFilter) Then Continue For
If Not Dict(TargetCardName).Contains(Version) Then Dict(TargetCardName).Add(Version) If Not Dict(TargetCardName).Contains(Version) Then Dict(TargetCardName).Add(Version)
End If End If
Next Next
@@ -192,8 +203,9 @@
PanResults.Children.Clear() PanResults.Children.Clear()
For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict For Each Pair As KeyValuePair(Of String, List(Of CompFile)) In Dict
If Not Pair.Value.Any() Then Continue For If Not Pair.Value.Any() Then Continue For
If Pair.Key = TargetCardName.Replace("(所选版本)", "") Then Continue For
'增加卡片 '增加卡片
Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(PageType = CompType.ModPack, 9, 8)} '9 是安装,8 是另存为 Dim NewCard As New MyCard With {.Title = Pair.Key, .Margin = New Thickness(0, 0, 0, 15), .SwapType = If(TargetType = CompType.ModPack, 9, 8)} '9 是安装,8 是另存为
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value} Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack) NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack NewCard.SwapControl = NewStack
@@ -202,32 +214,43 @@
If Pair.Key = TargetCardName OrElse If Pair.Key = TargetCardName OrElse
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761 (FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then CType(FrmMain.PageCurrent.Additional(1), List(Of String)).Contains(NewCard.Title)) Then
MyCard.StackInstall(NewStack, If(PageType = CompType.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为 MyCard.StackInstall(NewStack, If(TargetType = CompType.ModPack, 9, 8), Pair.Key) '9 是安装,8 是另存为
Else Else
NewCard.IsSwaped = True NewCard.IsSwapped = True
End If End If
'增加提示 '增加提示
If Pair.Key = "其他版本" Then If Pair.Key = "其他" Then
NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢,可能无法识别刚更新的 MC 版本。几天后即可正常识别。", .Theme = MyHint.Themes.Yellow, .Margin = New Thickness(5, 0, 0, 8)}) NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢,可能无法识别刚更新的 MC 版本。几天后即可正常识别。", .Theme = MyHint.Themes.Yellow, .Margin = New Thickness(5, 0, 0, 8)})
End If End If
Next Next
'如果只有一张卡片,展开第一张卡片 '如果只有一张卡片,展开第一张卡片
If PanResults.Children.Count = 1 Then If PanResults.Children.Count = 1 Then
CType(PanResults.Children(0), MyCard).IsSwaped = False CType(PanResults.Children(0), MyCard).IsSwapped = False
End If
'替代提示
If Project.Types = CompType.ModOrDataPack AndAlso (TargetType = CompType.Mod OrElse TargetType = CompType.DataPack) Then
HintAlternative.Visibility = Visibility.Visible
HintAlternative.Text = If(TargetType = CompType.Mod,
"以下是该项目的 Mod 版本。点击这里查看其数据包版本。", "以下是该项目的数据包版本。点击这里查看其 Mod 版本。")
Else
HintAlternative.Visibility = Visibility.Collapsed
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "可视化工程下载列表出错", LogLevel.Feedback) Log(ex, "可视化工程下载列表出错", LogLevel.Feedback)
End Try End Try
End Sub End Sub
Private Function GetGroupedVersionName(Name As String, MajorOnly As Boolean, FoldOldRelease As Boolean) As String Private Function GetGroupedVersionName(Name As String, GroupedByDrop As Boolean, FoldOld As Boolean) As String
Dim Drop = McVersion.VersionToDrop(Name)
If Name Is Nothing Then If Name Is Nothing Then
Return "其他版本" Return "其他"
ElseIf Name.Contains("w") Then ElseIf Name.Contains("w") OrElse Drop = 209 Then
Return "快照版本" Return "快照版"
ElseIf Name.StartsWith("1.0") OrElse Not Name.StartsWith("1.") OrElse (FoldOldRelease AndAlso Val(Name.Split(".")(1)) < 10) Then ElseIf Not McVersion.IsFormatFit(Name) OrElse (FoldOld AndAlso Drop < 120) Then
Return "远古版本" Return "远古版"
ElseIf GroupedByDrop Then
Return McVersion.DropToVersion(Drop)
Else Else
Return If(MajorOnly, "1." & Name.Split(".")(1).BeforeFirst(" "), Name) Return Name
End If End If
End Function End Function
@@ -249,7 +272,7 @@
'放置当前工程 '放置当前工程
If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem) If CompItem IsNot Nothing Then PanIntro.Children.Remove(CompItem)
CompItem = Project.ToCompItem(True, True) CompItem = Project.ToCompItem(True, True).Init()
CompItem.CanInteraction = False CompItem.CanInteraction = False
CompItem.Margin = New Thickness(-7, -7, 0, 8) CompItem.Margin = New Thickness(-7, -7, 0, 8)
PanIntro.Children.Insert(0, CompItem) PanIntro.Children.Insert(0, CompItem)
@@ -271,33 +294,33 @@
'获取版本名 '获取版本名
Dim PackName As String = Project.TranslatedName.Replace(".zip", "").Replace(".rar", "").Replace(".mrpack", "").Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":") Dim PackName As String = Project.TranslatedName.Replace(".zip", "").Replace(".rar", "").Replace(".mrpack", "").Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(PackName) <> "" Then PackName = "" If Validate.Validate(PackName) <> "" Then PackName = ""
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate}) Dim InstanceName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return If String.IsNullOrEmpty(InstanceName) Then Return
'构造步骤加载器 '构造步骤加载器
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
Dim Target As String = $"{PathMcFolder}versions\{VersionName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}" Dim Target As String = $"{McFolderSelected}versions\{InstanceName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo) Dim LogoFileAddress As String = CompItem.PathLogo.ActualSource
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True}) Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包", Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() ModpackInstall(Target, VersionName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1}) Sub() ModpackInstall(Target, InstanceName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
Sub(MyLoader) Sub(MyLoader)
Select Case MyLoader.State Select Case MyLoader.State
Case LoadState.Failed Case LoadState.Failed
Hint(MyLoader.Name & "失败:" & GetExceptionSummary(MyLoader.Error), HintType.Critical) Hint(MyLoader.Name & "失败:" & MyLoader.Error.GetBrief(), HintType.Red)
Case LoadState.Aborted Case LoadState.Interrupted
Hint(MyLoader.Name & "已取消!", HintType.Info) Hint(MyLoader.Name & "已取消!", HintType.Blue)
Case LoadState.Loading Case LoadState.Loading
Return '不重新加载版本列表 Return '不重新加载版本列表
End Select End Select
McInstallFailedClearFolder(MyLoader) McInstallFailedClearFolder(MyLoader)
End Sub} End Sub}
Loader.Start(PathMcFolder & "versions\" & VersionName & "\") Loader.Start(McFolderSelected & "versions\" & InstanceName & "\")
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
@@ -307,7 +330,7 @@
End Try End Try
End Sub End Sub
'资源下载;整合包另存为 '资源下载;整合包另存为
Public Shared CachedFolder As String = Nothing '仅在本次缓存的下载文件夹 Public Shared CachedFolder As New Dictionary(Of CompType, String) '仅在本次缓存的下载文件夹
Public Sub Save_Click(sender As Object, e As EventArgs) Public Sub Save_Click(sender As Object, e As EventArgs)
Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag Dim File As CompFile = If(TypeOf sender Is MyListItem, sender, sender.Parent).Tag
RunInNewThread( RunInNewThread(
@@ -325,13 +348,13 @@
Dim DefaultFolder As String = Nothing Dim DefaultFolder As String = Nothing
If File.Type <> CompType.ModPack Then If File.Type <> CompType.ModPack Then
Dim SubFolder As String = Nothing Dim SubFolder As String = Nothing
Select Case Project.Type Select Case File.Type
Case CompType.Mod : SubFolder = "mods\" Case CompType.Mod : SubFolder = "mods\"
Case CompType.ResourcePack : SubFolder = "resourcepacks\" Case CompType.ResourcePack : SubFolder = "resourcepacks\"
Case CompType.Shader : SubFolder = "shaderpacks\" Case CompType.Shader : SubFolder = "shaderpacks\"
Case CompType.DataPack : SubFolder = "" '导航到版本根目录 Case CompType.DataPack : SubFolder = "" '导航到版本根目录
End Select End Select
Dim IsVersionSuitable As Func(Of McVersion, Boolean) = Nothing Dim IsInstanceSuitable As Func(Of McInstance, Boolean) = Nothing
'获取资源所需的加载器 '获取资源所需的加载器
Dim AllowedLoaders As New List(Of CompModLoaderType) Dim AllowedLoaders As New List(Of CompModLoaderType)
If File.ModLoaders.Any Then If File.ModLoaders.Any Then
@@ -341,51 +364,81 @@
End If End If
Log($"[Comp] {Desc}要求的加载器种类:" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求")) Log($"[Comp] {Desc}要求的加载器种类:" & If(AllowedLoaders.Any(), AllowedLoaders.Join(" / "), "无要求"))
'判断某个版本是否符合资源要求 '判断某个版本是否符合资源要求
IsVersionSuitable = IsInstanceSuitable =
Function(Version) Function(Instance As McInstance)
If Not Version.IsLoaded Then Version.Load() If Not Instance.IsLoaded Then Instance.Load()
'只对 Mod 和数据包进行版本检测 '只对 Mod 和数据包进行版本检测
If Project.Type = CompType.Mod OrElse Project.Type = CompType.DataPack Then If File.Type = CompType.Mod OrElse File.Type = CompType.DataPack Then
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso If Not File.GameVersions.Any( '判断是否有任何一个版本匹配
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False Function(FileVersion)
Dim FileIsSnapshot As Boolean = FileVersion.Contains("预览版") OrElse Not FileVersion.Contains(".")
Dim InstanceIsSnapshot As Boolean = Instance.Version.VanillaName.Contains("snapshot") OrElse Not Instance.Version.VanillaName.Contains(".")
If FileIsSnapshot <> InstanceIsSnapshot Then
'只有一种是预览版
Return False
ElseIf Not FileIsSnapshot AndAlso Not InstanceIsSnapshot Then
'都不是预览版
Return FileVersion = Instance.Version.VanillaName
Else
'都是预览版
Dim FileIsNewFormat As Boolean = FileVersion.Contains(".") AndAlso Val(FileVersion.BeforeFirst(".")) > 1
Dim InstanceIsNewFormat As Boolean = Instance.Version.Drop > 250
If FileIsNewFormat <> InstanceIsNewFormat Then
'只有一种是新格式快照
Return False
ElseIf FileIsNewFormat AndAlso InstanceIsNewFormat Then
'都是新格式快照
Return FileVersion.BeforeFirst(" ") = Instance.Version.VanillaName.BeforeFirst("-")
Else
'都是旧格式快照
If FileVersion.Contains("w") AndAlso Instance.Version.VanillaName.Contains("w") Then
'都是 w 快照
Return FileVersion = Instance.Version.VanillaName
Else
'不全是 w 快照
Return True '只能假定相同,无法判断
End If
End If
End If
End Function) Then Return False
End If End If
'加载器 '加载器
If Not AllowedLoaders.Any() Then Return True '无要求 If Not AllowedLoaders.Any() Then Return True '无要求
If AllowedLoaders.Contains(CompModLoaderType.Forge) AndAlso Version.Version.HasForge Then Return True If AllowedLoaders.Contains(CompModLoaderType.Forge) AndAlso Instance.Version.HasForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.Fabric) AndAlso Version.Version.HasFabric Then Return True If AllowedLoaders.Contains(CompModLoaderType.Fabric) AndAlso Instance.Version.HasFabric Then Return True
If AllowedLoaders.Contains(CompModLoaderType.NeoForge) AndAlso Version.Version.HasNeoForge Then Return True If AllowedLoaders.Contains(CompModLoaderType.NeoForge) AndAlso Instance.Version.HasNeoForge Then Return True
If AllowedLoaders.Contains(CompModLoaderType.LiteLoader) AndAlso Version.Version.HasLiteLoader Then Return True If AllowedLoaders.Contains(CompModLoaderType.LiteLoader) AndAlso Instance.Version.HasLiteLoader Then Return True
Return False Return False
End Function End Function
'获取常规资源默认下载位置 '获取常规资源默认下载位置
If CachedFolder IsNot Nothing Then If CachedFolder.ContainsKey(File.Type) Then
DefaultFolder = CachedFolder DefaultFolder = CachedFolder(File.Type)
Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}") Log($"[Comp] 使用上次下载时的文件夹作为默认下载位置:{DefaultFolder}")
ElseIf McVersionCurrent IsNot Nothing AndAlso IsVersionSuitable(McVersionCurrent) Then ElseIf McInstanceSelected IsNot Nothing AndAlso IsInstanceSuitable(McInstanceSelected) Then
DefaultFolder = $"{McVersionCurrent.PathIndie}{SubFolder}" DefaultFolder = $"{McInstanceSelected.PathIndie}{SubFolder}"
Directory.CreateDirectory(DefaultFolder) Directory.CreateDirectory(DefaultFolder)
Log($"[Comp] 使用当前版本作为默认下载位置:{DefaultFolder}") Log($"[Comp] 使用当前版本作为默认下载位置:{DefaultFolder}")
Else Else
'查找所有可能的版本 '查找所有可能的版本
Dim NeedLoad As Boolean = McVersionListLoader.State <> LoadState.Finished Dim NeedLoad As Boolean = McInstanceListLoader.State <> LoadState.Finished
If NeedLoad Then If NeedLoad Then
Hint("正在查找适合的游戏版本……") Hint("正在查找适合的游戏版本……")
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True) LoaderFolderRun(McInstanceListLoader, McFolderSelected, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
End If End If
Dim SuitableVersions = McVersionList.Values.SelectMany(Function(l) l).Where(Function(v) IsVersionSuitable(v)). Dim SuitableInstanceList = McInstanceList.Values.SelectMany(Function(l) l).Where(Function(v) IsInstanceSuitable(v)).
Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}")) Select(Function(v) New DirectoryInfo($"{v.PathIndie}{SubFolder}"))
If SuitableVersions.Any Then If SuitableInstanceList.Any Then
Dim SelectedVersion = SuitableVersions. Dim SelectedInstance = SuitableInstanceList.
OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序 OrderByDescending(Function(Dir) If(Dir.Exists, Dir.LastWriteTimeUtc, Date.MinValue)). '先按文件夹更改时间降序
ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序 ThenByDescending(Function(Dir) If(Dir.Exists, Dir.GetFiles().Length, -1)). '再按文件夹中的文件数量降序
First() First()
DefaultFolder = SelectedVersion.FullName DefaultFolder = SelectedInstance.FullName
Directory.CreateDirectory(DefaultFolder) Directory.CreateDirectory(DefaultFolder)
Log($"[Comp] 使用适合的游戏版本作为默认下载位置:{DefaultFolder}") Log($"[Comp] 使用适合的游戏版本作为默认下载位置:{DefaultFolder}")
Else Else
DefaultFolder = PathMcFolder DefaultFolder = McFolderSelected
If NeedLoad Then If NeedLoad Then
Hint("当前 MC 文件夹中没有找到适合此资源的版本!") Hint($"当前 MC 文件夹中没有找到合适的版本!")
Else Else
Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置") Log("[Comp] 由于当前版本不兼容,使用当前的 MC 文件夹作为默认下载位置")
End If End If
@@ -399,7 +452,7 @@
Else Else
Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - "). Dim ChineseName As String = Project.TranslatedName.BeforeFirst(" (").BeforeFirst(" - ").
Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":") Replace("\", "\").Replace("/", "/").Replace("|", "|").Replace(":", ":").Replace("<", "<").Replace(">", ">").Replace("*", "*").Replace("?", "?").Replace("""", "").Replace(": ", ":")
Select Case Setup.Get("ToolDownloadTranslateV2") Select Case Settings.Get("ToolDownloadTranslateV2")
Case 0 Case 0
FileName = $"【{ChineseName}】{File.FileName}" FileName = $"【{ChineseName}】{File.FileName}"
Case 1 Case 1
@@ -412,6 +465,7 @@
FileName = File.FileName FileName = File.FileName
End Select End Select
End If End If
If File.Type = CompType.Mod Then FileName = FileName.Replace("~", "-") '~ 会导致 Mixin 加载失败
RunInUi( RunInUi(
Sub() Sub()
'弹窗要求选择保存位置 '弹窗要求选择保存位置
@@ -419,12 +473,12 @@
Target = SelectSaveFile("选择保存位置", FileName, Target = SelectSaveFile("选择保存位置", FileName,
Desc & "文件|" & Desc & "文件|" &
If(File.Type = CompType.Mod, If(File.Type = CompType.Mod,
If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"), If(File.FileName.EndsWithF(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder) If(File.FileName.EndsWithF(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Return If Not Target.Contains("\") Then Return
'构造步骤加载器 '构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & GetFileNameWithoutExtentionFromPath(Target) & " " Dim LoaderName As String = Desc & "下载:" & IO.Path.GetFileNameWithoutExtension(Target) & " "
If Target <> DefaultFolder AndAlso File.Type = CompType.Mod Then CachedFolder = GetPathFromFullPath(Target) If Target <> DefaultFolder Then CachedFolder(File.Type) = GetPathFromFullPath(Target)
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True}) Loaders.Add(New LoaderDownload("下载文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 6, .Block = True})
'启动 '启动
@@ -450,4 +504,11 @@
ClipboardSet(CompItem.LabTitle.Text & CompItem.LabTitleRaw.Text) ClipboardSet(CompItem.LabTitle.Text & CompItem.LabTitleRaw.Text)
End Sub End Sub
'Mod / 数据包 互相跳转
Private Sub HintAlternative_Click() Handles HintAlternative.Click
TargetType = If(TargetType = CompType.Mod, CompType.DataPack, CompType.Mod)
FrmMain.PageCurrent.Additional(4) = TargetType '加载器会从这里重新拿数据
PageLoaderRestart(IsForceRestart:=True)
End Sub
End Class End Class
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadDataPack" mc:Ignorable="d" x:Class="PageDownloadDataPack"
PanScroll="{Binding ElementName=Content}"> PanScroll="Content">
<local:PageComp x:Name="Content" PageType="DataPack" TypeName="数据包" TypeNameSpaced="数据包"> <local:PageComp x:Name="Content" PageType="DataPack" TypeName="数据包" TypeNameSpaced="数据包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" /> <local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Content="世界元素" Tag="/worldgen" /> <local:MyComboBoxItem Content="世界元素" Tag="/worldgen" />
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadMod" mc:Ignorable="d" x:Class="PageDownloadMod"
PanScroll="{Binding ElementName=Content}"> PanScroll="Content">
<local:PageComp x:Name="Content" PageType="Mod" TypeName="Mod" TypeNameSpaced=" Mod "> <local:PageComp x:Name="Content" PageType="Mod" TypeName="Mod" TypeNameSpaced=" Mod ">
<local:MyComboBoxItem Content="全部" Tag="" IsSelected="True" /> <local:MyComboBoxItem Content="全部" Tag="" IsSelected="True" />
<local:MyComboBoxItem Content="世界元素" Tag="406/worldgen" /> <local:MyComboBoxItem Content="世界元素" Tag="406/worldgen" />
@@ -27,7 +27,8 @@
<local:MyComboBoxItem Content="生物" Tag="411/mobs" /> <local:MyComboBoxItem Content="生物" Tag="411/mobs" />
<local:MyComboBoxItem Content="实用" Tag="5191/utility" /> <local:MyComboBoxItem Content="实用" Tag="5191/utility" />
<local:MyComboBoxItem Content="装备与工具" Tag="434/equipment" /> <local:MyComboBoxItem Content="装备与工具" Tag="434/equipment" />
<local:MyComboBoxItem Content="性能优化" Tag="/optimization" /> <local:MyComboBoxItem Content="创造模式" Tag="9026/" />
<local:MyComboBoxItem Content="性能优化" Tag="6814/optimization" />
<local:MyComboBoxItem Content="信息显示" Tag="423/" /> <local:MyComboBoxItem Content="信息显示" Tag="423/" />
<local:MyComboBoxItem Content="服务器" Tag="435/social" /> <local:MyComboBoxItem Content="服务器" Tag="435/social" />
<local:MyComboBoxItem Content="支持库" Tag="421/library" /> <local:MyComboBoxItem Content="支持库" Tag="421/library" />
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadPack" mc:Ignorable="d" x:Class="PageDownloadPack"
PanScroll="{Binding ElementName=Content}"> PanScroll="Content">
<local:PageComp x:Name="Content" PageType="ModPack" TypeName="整合包" TypeNameSpaced="整合包"> <local:PageComp x:Name="Content" PageType="ModPack" TypeName="整合包" TypeNameSpaced="整合包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" /> <local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Tag="4484/" Content="多人" /> <local:MyComboBoxItem Tag="4484/" Content="多人" />
@@ -17,7 +17,7 @@
<local:MyComboBoxItem Tag="/kitchen-sink" Content="水槽包" /> <local:MyComboBoxItem Tag="/kitchen-sink" Content="水槽包" />
<local:MyComboBoxItem Tag="4476/" Content="探索" /> <local:MyComboBoxItem Tag="4476/" Content="探索" />
<local:MyComboBoxItem Tag="4477/" Content="小游戏" /> <local:MyComboBoxItem Tag="4477/" Content="小游戏" />
<local:MyComboBoxItem Tag="4471/" Content="科幻" /> <local:MyComboBoxItem Tag="4474/" Content="科幻" />
<local:MyComboBoxItem Tag="4736/" Content="空岛" /> <local:MyComboBoxItem Tag="4736/" Content="空岛" />
<local:MyComboBoxItem Tag="5128/" Content="原版改良" /> <local:MyComboBoxItem Tag="5128/" Content="原版改良" />
<local:MyComboBoxItem Tag="4487/" Content="FTB" ToolTip="由 FTB 官方发布" ToolTipService.HorizontalOffset="70" /> <local:MyComboBoxItem Tag="4487/" Content="FTB" ToolTip="由 FTB 官方发布" ToolTipService.HorizontalOffset="70" />
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadResourcePack" mc:Ignorable="d" x:Class="PageDownloadResourcePack"
PanScroll="{Binding ElementName=Content}"> PanScroll="Content">
<local:PageComp x:Name="Content" PageType="ResourcePack" TypeName="资源包" TypeNameSpaced="资源包"> <local:PageComp x:Name="Content" PageType="ResourcePack" TypeName="资源包" TypeNameSpaced="资源包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" /> <local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadShader" mc:Ignorable="d" x:Class="PageDownloadShader"
PanScroll="{Binding ElementName=Content}"> PanScroll="Content">
<local:PageComp x:Name="Content" PageType="Shader" TypeName="光影包" TypeNameSpaced="光影包"> <local:PageComp x:Name="Content" PageType="Shader" TypeName="光影包" TypeNameSpaced="光影包">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" /> <local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
File diff suppressed because it is too large Load Diff
@@ -1,31 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadClient"
PanScroll="{Binding ElementName=PanBack}">
<Grid>
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<!--<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="自动安装提示" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Margin="0,0,0,2" Text="本页只提供需要在下载后手动进行安装的游戏 jar 与 json 下载。" TextWrapping="Wrap" />
<TextBlock Margin="0,0,0,11" Text="如果你想要进行自动安装,在游戏安装页选择游戏版本,然后直接安装即可。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
<local:MyButton x:Name="BtnInstall" Grid.Column="1" MinWidth="140" Text="转到游戏安装页" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid>
</StackPanel>
</local:MyCard>-->
<StackPanel Name="PanMain" Margin="20,20,20,5" Grid.IsSharedSizeScope="True" />
</StackPanel>
</local:MyScrollViewer>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" Margin="40,0" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False">
<local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</Grid>
</local:MyPageRight>
@@ -1,111 +0,0 @@
Public Class PageDownloadClient
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanBack, Nothing, DlClientListLoader, AddressOf Load_OnFinish)
End Sub
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
End Sub
Private Sub Load_OnFinish()
'结果数据化
Try
'归类
Dim Dict As New Dictionary(Of String, List(Of JObject)) From {
{"正式版", New List(Of JObject)}, {"预览版", New List(Of JObject)}, {"远古版", New List(Of JObject)}, {"愚人节版", New List(Of JObject)}
}
Dim Versions As JArray = DlClientListLoader.Output.Value("versions")
For Each Version As JObject In Versions
'确定分类
Dim Type As String = Version("type")
Select Case Type
Case "release"
Type = "正式版"
Case "snapshot"
Type = "预览版"
'Mojang 误分类
If Version("id").ToString.StartsWith("1.") AndAlso
Not Version("id").ToString.ToLower.Contains("combat") AndAlso
Not Version("id").ToString.ToLower.Contains("rc") AndAlso
Not Version("id").ToString.ToLower.Contains("experimental") AndAlso
Not Version("id").ToString.ToLower.Contains("pre") Then
Type = "正式版"
Version("type") = "release"
End If
'愚人节版本
Select Case Version("id").ToString.ToLower
Case "20w14infinite", "20w14∞"
Type = "愚人节版"
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", "24w14potato", "25w14craftmine"
Type = "愚人节版"
Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id")))
Case Else '4/1 自动视作愚人节版
Dim ReleaseDate = Version("releaseTime").Value(Of Date).ToUniversalTime().AddHours(2)
If ReleaseDate.Month = 4 AndAlso ReleaseDate.Day = 1 Then
Type = "愚人节版"
Version("type") = "special"
End If
End Select
Case "special"
'已被处理的愚人节版
Type = "愚人节版"
Case Else
Type = "远古版"
End Select
'加入辞典
Dict(Type).Add(Version)
Next
'排序
For i = 0 To Dict.Keys.Count - 1
Dict(Dict.Keys(i)) = Dict.Values(i).OrderByDescending(Function(v) v("releaseTime").Value(Of Date)).ToList
Next
'清空当前
PanMain.Children.Clear()
'添加最新版本
Dim CardInfo As New MyCard With {.Title = "最新版本", .Margin = New Thickness(0, 0, 0, 15), .SwapType = 2}
Dim TopestVersions As New List(Of JObject)
Dim Release As JObject = Dict("正式版")(0).DeepClone()
Release("lore") = "最新正式版,发布于 " & Release("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Release)
If Dict("正式版")(0)("releaseTime").Value(Of Date) < Dict("预览版")(0)("releaseTime").Value(Of Date) Then
Dim Snapshot As JObject = Dict("预览版")(0).DeepClone()
Snapshot("lore") = "最新预览版,发布于 " & Snapshot("releaseTime").Value(Of Date).ToString("yyyy'/'MM'/'dd HH':'mm")
TopestVersions.Add(Snapshot)
End If
Dim PanInfo As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = TopestVersions}
MyCard.StackInstall(PanInfo, 2)
CardInfo.Children.Add(PanInfo)
PanMain.Children.Add(CardInfo)
'添加其他版本
For Each Pair As KeyValuePair(Of String, List(Of JObject)) In Dict
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}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
NewCard.IsSwaped = True
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化 MC 版本列表出错", LogLevel.Feedback)
End Try
End Sub
Public Sub DownloadStart(sender As MyListItem, e As Object)
McDownloadClient(NetPreDownloadBehaviour.HintWhileExists, sender.Title, sender.Tag("url").ToString)
End Sub
''介绍栏
'Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
' OpenWebsite("https://www.minecraft.net/zh-hans")
'End Sub
'Private Sub BtnInstall_Click(sender As Object, e As EventArgs) Handles BtnInstall.Click
' FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
'End Sub
End Class
@@ -1,28 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadFabric"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="Fabric 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Margin="0,0,0,11" Text="Fabric Loader 是新版 Minecraft 下的轻量化 Mod 加载器,你需要先安装它才能安装各种 Fabric 模组。&#xa;本页面提供 Fabric 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard x:Name="CardVersions" Margin="20,15,20,20" Title="版本列表">
<StackPanel x:Name="PanVersions" Margin="20,40,18,20" />
</local:MyCard>
<local:MyCard HorizontalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取 Fabric 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -1,32 +0,0 @@
Public Class PageDownloadFabric
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, CardVersions, CardTip, DlFabricListLoader, AddressOf Load_OnFinish)
End Sub
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
End Sub
Private Sub Load_OnFinish()
'结果数据化
Try
Dim Versions As JArray = DlFabricListLoader.Output.Value("installer")
PanVersions.Children.Clear()
For Each Version In Versions
PanVersions.Children.Add(FabricDownloadListItem(Version, AddressOf Fabric_Selected))
Next
CardVersions.Title = "版本列表 (" & Versions.Count & ")"
Catch ex As Exception
Log(ex, "可视化 Fabric 版本列表出错", LogLevel.Feedback)
End Try
End Sub
Private Sub Fabric_Selected(sender As MyListItem, e As EventArgs)
McDownloadFabricLoaderSave(sender.Tag)
End Sub
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://www.fabricmc.net")
End Sub
End Class
@@ -1,26 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadForge"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="Forge 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Name="LabConnect" Margin="0,0,0,11" Text="Forge 是一个 Mod 加载器,你需要先安装 Forge 才能安装各种 Forge 模组。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel Name="PanMain" Margin="20,15,20,5" Grid.IsSharedSizeScope="True" />
<local:MyCard HorizontalAlignment="Center" Margin="40,50" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False">
<local:MyLoading Text="正在获取 Forge 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -1,61 +0,0 @@
Public Class PageDownloadForge
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlForgeListLoader, AddressOf Load_OnFinish)
End Sub
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
End Sub
Private Sub Load_OnFinish()
'结果数据化
Try
'清空当前
PanMain.Children.Clear()
'转化为 UI
For Each Version As String In DlForgeListLoader.Output.Value.Sort(AddressOf VersionSortBoolean)
'增加卡片
Dim NewCard As New MyCard With {.Title = Version.Replace("_p", " P"), .Margin = New Thickness(0, 0, 0, 15), .SwapType = 5}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Version}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
NewCard.IsSwaped = True
PanMain.Children.Add(NewCard)
Next
''非官方源警示
'If Setup.Get("ToolDownloadOutOfDate") AndAlso Not DlForgeListLoader.Output.IsOfficial Then
' Dim CardWarn As New MyCard With {.Title = "过期提示", .Margin = New Thickness(0, 0, 0, 15)}
' CardWarn.Children.Add(New TextBlock With {
' .Margin = New Thickness(25, MyCard.SwapedHeight, 15, 15), .VerticalAlignment = VerticalAlignment.Top, .HorizontalAlignment = HorizontalAlignment.Left, .TextTrimming = TextTrimming.None, .TextWrapping = TextWrapping.Wrap,
' .Text = "获取官方源失败,正在使用 " & DlForgeListLoader.Output.SourceName & " 镜像源,版本列表可能并非最新。" & vbCrLf & "官方源错误原因:" & If(DlForgeListLoader.Output.OfficialError, New Exception("连接服务器超时")).Message})
' PanMain.Children.Insert(0, CardWarn)
'End If
Catch ex As Exception
Log(ex, "可视化 Forge 版本列表出错", LogLevel.Feedback)
End Try
End Sub
'Forge 版本列表加载
Public Sub Forge_Click(sender As MyLoading, e As MouseButtonEventArgs)
If sender.State.LoadingState = MyLoading.MyLoadingState.Error Then
CType(sender.State, LoaderTask(Of String, List(Of DlForgeVersionEntry))).Start(IsForceRestart:=True)
End If
End Sub
Public Sub Forge_StateChanged(sender As MyLoading, newState As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState)
If newState <> MyLoading.MyLoadingState.Stop Then Return
Dim Card As MyCard = CType(sender.Parent, FrameworkElement).Parent
Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = sender.State
'载入列表
Card.SwapControl.Children.Clear()
Card.SwapControl.Tag = Loader.Output
Card.SwapType = 6
Card.StackInstall()
End Sub
'介绍栏
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://files.minecraftforge.net")
End Sub
End Class
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadInstall" mc:Ignorable="d" x:Class="PageDownloadInstall"
PanScroll="{Binding ElementName=PanBack}"> PanScroll="PanBack">
<Grid> <Grid>
<Grid Name="PanAllBack"> <Grid Name="PanAllBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
@@ -27,7 +27,7 @@
<local:MyHint Text="必须安装 OptiFabric 才能正常使用 OptiFine!" Margin="0,10,0,0" x:Name="HintOptiFabric" Theme="Red" /> <local:MyHint Text="必须安装 OptiFabric 才能正常使用 OptiFine!" Margin="0,10,0,0" x:Name="HintOptiFabric" Theme="Red" />
<local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,10,0,0" x:Name="HintOptiFabricOld" Theme="Yellow" /> <local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,10,0,0" x:Name="HintOptiFabricOld" Theme="Yellow" />
<local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,10,0,0" x:Name="HintModOptiFine" Theme="Yellow" /> <local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,10,0,0" x:Name="HintModOptiFine" Theme="Yellow" />
<local:MyCard Title="Forge" Height="40" Margin="0,12,0,0" x:Name="CardForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True"> <local:MyCard Title="Forge" Height="40" Margin="0,12,0,0" x:Name="CardForge" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanForge" /> <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanForge" />
<Grid x:Name="PanForgeInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True"> <Grid x:Name="PanForgeInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform> <Grid.RenderTransform>
@@ -45,7 +45,7 @@
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard Title="NeoForge" Height="40" Margin="0,12,0,0" x:Name="CardNeoForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True"> <local:MyCard Title="NeoForge" Height="40" Margin="0,12,0,0" x:Name="CardNeoForge" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanNeoForge" /> <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanNeoForge" />
<Grid x:Name="PanNeoForgeInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True"> <Grid x:Name="PanNeoForgeInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform> <Grid.RenderTransform>
@@ -63,7 +63,7 @@
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard Title="Fabric" Height="40" Margin="0,12,0,0" x:Name="CardFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True"> <local:MyCard Title="Fabric" Height="40" Margin="0,12,0,0" x:Name="CardFabric" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanFabric" /> <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanFabric" />
<Grid x:Name="PanFabricInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True"> <Grid x:Name="PanFabricInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform> <Grid.RenderTransform>
@@ -81,7 +81,7 @@
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard Title="Fabric API" Height="40" Margin="0,12,0,0" x:Name="CardFabricApi" IsSwaped="True" CanSwap="True" SwapLogoRight="True"> <local:MyCard Title="Fabric API" Height="40" Margin="0,12,0,0" x:Name="CardFabricApi" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanFabricApi" /> <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanFabricApi" />
<Grid x:Name="PanFabricApiInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True"> <Grid x:Name="PanFabricApiInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform> <Grid.RenderTransform>
@@ -99,7 +99,7 @@
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard Title="OptiFine" Height="40" Margin="0,12,0,0" x:Name="CardOptiFine" IsSwaped="True" CanSwap="True" SwapLogoRight="True"> <local:MyCard Title="OptiFine" Height="40" Margin="0,12,0,0" x:Name="CardOptiFine" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top"> <StackPanel Margin="20,40,18,15" VerticalAlignment="Top">
<StackPanel Name="PanOptiFine" /> <StackPanel Name="PanOptiFine" />
</StackPanel> </StackPanel>
@@ -119,7 +119,7 @@
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard Title="OptiFabric" Height="40" Margin="0,12,0,0" x:Name="CardOptiFabric" IsSwaped="True" CanSwap="True" SwapLogoRight="True"> <local:MyCard Title="OptiFabric" Height="40" Margin="0,12,0,0" x:Name="CardOptiFabric" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanOptiFabric" /> <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanOptiFabric" />
<Grid x:Name="PanOptiFabricInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True"> <Grid x:Name="PanOptiFabricInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform> <Grid.RenderTransform>
@@ -137,7 +137,7 @@
Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> Data="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard Title="LiteLoader" Height="40" Margin="0,12,0,0" x:Name="CardLiteLoader" IsSwaped="True" CanSwap="True" SwapLogoRight="True"> <local:MyCard Title="LiteLoader" Height="40" Margin="0,12,0,0" x:Name="CardLiteLoader" IsSwapped="True" CanSwap="True" SwapLogoRight="True">
<StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanLiteLoader" /> <StackPanel Margin="20,40,18,15" VerticalAlignment="Top" Name="PanLiteLoader" />
<Grid x:Name="PanLiteLoaderInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True"> <Grid x:Name="PanLiteLoaderInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform> <Grid.RenderTransform>
File diff suppressed because it is too large Load Diff
@@ -1,114 +1,59 @@
<local:MyPageLeft x:Class="PageDownloadLeft" <local:MyPageLeft x:Class="PageDownloadLeft"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}"> xmlns:local="clr-namespace:PCL" AnimatedControl="PanItem">
<local:MyScrollViewer PanningMode="VerticalOnly" HorizontalScrollBarVisibility="Disabled" VerticalScrollBarVisibility="Auto" Style="{StaticResource ScrollViewerFullMargin}"> <local:MyScrollViewer PanningMode="VerticalOnly" HorizontalScrollBarVisibility="Disabled" VerticalScrollBarVisibility="Auto" Style="{StaticResource ScrollViewerFullMargin}">
<StackPanel Margin="0,12,0,0" Name="PanItem"> <StackPanel Margin="0,12,0,0" Name="PanItem">
<TextBlock x:Name="LabGame" Text="Minecraft" Margin="13,6,5,4" Opacity="0.6" FontSize="12" /> <local:MyListItem x:Name="ItemInstall" Checked="True" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="0" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="原版游戏"
<local:MyListItem x:Name="ItemInstall" Checked="True" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="1" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="游戏下载" Logo="m351.9,801.7c-8.6,0-17-3-23.7-8.4L18.9,614.7c-12.5-7.2-19.7-20.5-18.8-34.9V221c-.7-15,6.6-28.8,19.2-36L325.2,8.3c6.6-5.3,15.1-8.3,24-8.3s17.3,2.9,23.9,8.2l308.3,178c.2.1.5.3.8.5h0c12,6.7,19.4,19.8,19.4,34.1,0,13.9-7.1,26-18.7,32.5l-290.1,167.5v276l234-135.1v-168.9c0-20.8,17-37.8,37.8-37.8s37.8,17,37.8,37.8v191.7c0,16.4-10.9,31.2-26.5,36.1l-299.4,172.8c-6.7,5.4-15.1,8.3-23.7,8.3h-.9Zm-34.8-101.9v-276l-241.4-139.4v276l241.4,139.4Zm35.3-342.8l236.8-136.7-240-138.6L112.4,218.3l240,138.6Z">
Logo="M12 0l-11 6v12.131l11 5.869 11-5.869v-12.066l-11-6.065zm-1 21.2l-6.664-3.555 4.201-2.801c1.08-.719-.066-2.359-1.243-1.575l-4.294 2.862v-7.901l8 4.363v8.607zm-6.867-14.63l6.867-3.746v4.426c0 1.323 2 1.324 2 0v-4.415l6.91 3.811-7.905 4.218-7.872-4.294zm8.867 6.03l8-4.269v7.8l-4.263-2.842c-1.181-.785-2.323.855-1.245 1.574l4.172 2.781-6.664 3.556v-8.6z">
<local:MyListItem.Buttons> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="1" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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:MyIconButton Tag="0" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<local:MyListItem x:Name="ItemHand" IsScaleAnimationEnabled="False" Type="RadioBox" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="手动安装包" <TextBlock Text="社区资源" Margin="13,20,5,4" Opacity="0.6" FontSize="12" />
Logo="M1000 241c-2-5-4-11-6-17-0-6-4-12-8-17-7-9-18-15-31-15-6 0-13 1-19 5l-15 15-17 17-21 21L749 381c-14 14-38 14-52 0l-54-54c-14-14-14-38 0-52l132-132 14-14 20-20 16-16c3-5 5-11 5-19 0-12-5-24-16-32-5-4-11-6-18-7-5-2-10-4-16-5-36-12-76-19-117-19-7 0-14 0-22 0-188 11-337 168-337 360 0 16 0 32 3 48L56 663c-73 74-73 193 0 267l33 33c73 73 193 73 267 0l240-241c21 4 42 5 64 5 190 0 346-146 360-333 0-8 0-17 0-27 0-44-6-86-21-125zM658 639c-28 0-54-4-79-11-4 7-10 14-16 21l-258 258c-43 43-115 43-158 0l-29-29c-43-44-43-115 0-158l212-212 46-46c5-5 12-11 19-15-8-26-12-54-12-83v-1c0-152 123-275 276-275 18 0 37 1 55 5L597 207c-52 52-52 137 0 189l29 29c52 52 137 52 189 0L930 312c2 16 4 33 4 50 0 152-123 276-276 276z" /> <local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="2" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod"
<TextBlock x:Name="LabHand" Visibility="Collapsed" Text="▼ 手动安装包" Padding="11,18,5,4" Opacity="0.6" FontSize="12" /> LogoScale="0.97" Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">
<local:MyListItem x:Name="ItemClient" Visibility="Collapsed" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Minecraft" <local:MyListItem.Buttons>
LogoScale="0.98" Logo="M989.7 510.8l-202.3-101c-10.8-5.4-17.7-16.5-17.7-28.6V172.7c0-26.7-16.6-50.6-41.6-59.9L550.5 46.3c-24.2-9-50.8-9-74.9 0.1l-176.9 66.8c-24.9 9.4-41.4 33.2-41.4 59.9v207.1c0 12.1-6.9 23.2-17.7 28.6l-204 101.9C13.9 521.6 0.1 543.8 0.2 568.1l0.5 226c0 23.2 12.6 44.5 32.9 55.8l223.8 124.6 1.2 0.7c18.9 10.5 41.9 10.4 60.8-0.2l2-1.1L497 873.2c9.9-5.7 22.1-5.6 32 0.1l176.7 102.5c18.9 10.7 42 10.8 61 0.3l3-1.7L992.4 851c20.4-11.3 33-32.8 33-56l-0.3-226.9c0-24.3-13.7-46.5-35.4-57.3zM321 192l115.3 46.1c27 10.8 44.7 36.9 44.7 66v163c0 5.9-6.2 9.8-11.6 7.2L339 409.5c-10.9-5.4-17.7-16.5-17.8-28.6L321 192z m-63.7 703.4L82.5 809.6c-10.9-5.4-17.9-16.5-17.9-28.7l-0.4-189.5L217.9 668c24.1 12 39.4 36.7 39.4 63.6v163.8z m64-274.3c-20.1 10.1-43.7 10-63.8 0l-0.2-0.1-149.1-75 149.1-74.4 16.8-8.4c9.2-4.6 20-4.5 29.1 0.3l18.1 9.4 129.8 64.3c5.8 2.9 6 11.1 0.2 14.2l-130 69.7z m141.9 203.8l-141.8 70.6-0.8-163.6c-0.1-27 15.1-51.8 39.2-63.9l108.8-54.5c5.3-2.7 11.6 1.2 11.6 7.1l0.8 175.6c0 12.1-6.9 23.2-17.8 28.7zM385 144l128-48 128 48-103 38.6c-16.1 6-33.8 6-49.9 0L385 144z m320 48l0.6 187.8c0 12.2-6.8 23.3-17.7 28.7l-131.4 65.7c-5.3 2.7-11.6-1.2-11.6-7.2V304.1c0-29.1 17.7-55.2 44.7-66L705 192z m0.7 710.3l-143.8-77.2c-10.4-5.6-16.9-16.4-16.9-28.2v-176c0-5.9 6.3-9.8 11.6-7.2l109.3 54.6c24 12 39.2 36.5 39.3 63.4l0.5 170.6z m-2-280.5l-129.2-70.5c-5.7-3.1-5.5-11.3 0.3-14.2l131-65.3 16.1-8.5c9.1-4.8 19.9-4.9 29.1-0.3l18.7 9.3L916.9 546l-146.2 76.4c-21.1 11-46.2 10.8-67-0.6z m66 279.4l-0.6-169.1c-0.1-27 15.1-51.7 39.3-63.8L961 592v188.7c0 11.9-6.6 22.7-17 28.3l-174.3 92.2z"> <x:Array Type="{x:Type local:MyIconButton}">
<!--Logo="M469.333333 213.333333V128a42.666667 42.666667 0 1 1 85.333334 0v85.333333h127.829333C847.722667 213.333333 981.333333 347.029333 981.333333 512.149333v319.936A106.496 106.496 0 0 1 874.730667 938.666667h-85.461334c-48.661333 0-107.221333-29.290667-136.469333-68.266667l-64-85.333333c-6.144-8.170667-23.957333-17.066667-34.24-17.066667h-85.12c-10.282667 0-28.096 8.896-34.24 17.066667l-64 85.333333c-29.226667 38.976-87.808 68.266667-136.469333 68.266667H149.269333A106.496 106.496 0 0 1 42.666667 832.085333V512.149333C42.666667 347.029333 176.277333 213.333333 341.504 213.333333H469.333333z m213.162667 85.333334H341.504A213.333333 213.333333 0 0 0 128 512.149333v319.936c0 11.818667 9.450667 21.248 21.269333 21.248h85.461334c21.802667 0 55.082667-16.64 68.202666-34.133333l64-85.333333c22.272-29.696 65.408-51.2 102.506667-51.2h85.12c37.098667 0 80.213333 21.504 102.506667 51.2l64 85.333333c13.12 17.493333 46.4 34.133333 68.202666 34.133333h85.461334a21.162667 21.162667 0 0 0 21.269333-21.248V512.149333A213.333333 213.333333 0 0 0 682.496 298.666667zM362.666667 469.333333h42.666666a42.666667 42.666667 0 1 1 0 85.333334h-42.666666v42.666666a42.666667 42.666667 0 1 1-85.333334 0v-42.666666h-42.666666a42.666667 42.666667 0 1 1 0-85.333334h42.666666v-42.666666a42.666667 42.666667 0 1 1 85.333334 0v42.666666z m341.333333-21.333333a42.666667 42.666667 0 1 1 0-85.333333 42.666667 42.666667 0 0 1 0 85.333333z m0 213.333333a42.666667 42.666667 0 1 1 0-85.333333 42.666667 42.666667 0 0 1 0 85.333333z m-106.666667-106.666666a42.666667 42.666667 0 1 1 0-85.333334 42.666667 42.666667 0 0 1 0 85.333334z m213.333334 0a42.666667 42.666667 0 1 1 0-85.333334 42.666667 42.666667 0 0 1 0 85.333334z">--> <local:MyIconButton Tag="2" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="3" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="整合包"
LogoScale="0.98" Logo="M511 995a128 128 0 0 1-57-13L70 791a126 126 0 0 1-70-113V311a126 126 0 0 1 15-60V248c1-2 3-5 5-8a127 127 0 0 1 49-42L454 13a128 128 0 0 1 112 0l383 190a126 126 0 0 1 72 113v360a126 126 0 0 1-70 115L568 984c-17 7-37 11-57 11z m42-470v370l360-178c14-7 23-21 23-38v-335L554 524zM85 330v347a42 42 0 0 0 23 38l360 178V523L85 330zM135 260l375 189 137-65L286 188 135 260z m245-118l363 197 150-71-365-180a42 42 0 0 0-37 0l-111 53z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="3" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemDataPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="数据包"
LogoScale="0.96" Logo="M445 545c18 0 33 14 33 33v149a182 182 0 1 1-182-182z m282 0a182 182 0 1 1-182 182v-149c0-18 14-33 33-33zM412 611H296a116 116 0 1 0 116 116V611z m315 0H611v116a116 116 0 1 0 116-116zM296 113a182 182 0 0 1 182 182v149a33 33 0 0 1-33 33H296a182 182 0 0 1 0-365z m431 0a182 182 0 0 1 0 365h-149a33 33 0 0 1-33-33V296A182 182 0 0 1 727 113zM296 180a116 116 0 0 0 0 232H412V296c0-62-48-112-109-115z m431 0a116 116 0 0 0-116 116V412h116c62 0 112-48 115-109l0-6a116 116 0 0 0-116-116z">
<local:MyListItem.Buttons> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="4" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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:MyIconButton Tag="4" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<local:MyListItem x:Name="ItemOptiFine" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="5" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="OptiFine" <local:MyListItem x:Name="ItemResourcePack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="5" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="资源包"
LogoScale="1.00" Logo="M439.667 538.133l-323.311-174.763c-6.554-3.641-13.836-5.098-20.389-5.098-23.301 0-45.147 20.389-45.147 48.788v341.516c0 35.681 18.205 67.721 48.060 83.741l323.311 174.763c6.554 3.641 13.836 5.825 20.389 5.825 23.301 0 45.147-21.117 45.147-49.516v-341.516c0-34.953-18.205-67.721-48.060-83.741zM414.909 920.427l-281.805-152.189c-4.369-2.913-9.467-9.467-9.467-19.661v-298.553l281.805 152.189c5.825 3.641 9.467 11.651 9.467 19.661v298.553zM952.304 358.274c-6.554 0-13.836 1.456-20.389 5.098l-323.311 175.491c-29.855 16.020-48.060 48.788-48.060 84.468v340.059c0 28.399 21.845 49.516 45.147 49.516 6.554 0 13.836-1.456 20.389-5.098l323.311-175.491c29.127-16.020 48.060-48.060 48.060-83.741v-341.516c0-28.399-21.845-48.788-45.147-48.788zM924.634 747.849c0 10.194-5.098 17.476-9.467 19.661l-281.805 152.917v-297.097c0-10.194 5.098-17.476 9.467-19.661l281.805-153.646v297.825zM902.060 283.272c15.292-8.010 22.574-21.845 21.117-34.953 1.456-13.836-5.825-26.943-21.117-34.953l-329.136-171.85c-14.563-8.010-31.312-11.651-48.788-11.651 0 0 0 0 0 0 0 0 0 0 0 0s-34.224 3.641-49.516 11.651l-329.865 171.122c-15.292 8.010-21.845 21.845-21.117 35.681-0.729 13.107 5.825 26.943 21.117 34.953l329.136 171.122c14.563 8.010 32.039 11.651 49.516 11.651 0 0 0 0 0.729 0 0 0 0 0 0.729 0s34.224-3.641 49.516-11.651l327.68-171.122zM523.407 393.227c-5.825 0-11.651-1.456-16.020-3.641l-272.338-141.266 272.338-141.995c4.369-2.185 10.194-3.641 16.748-3.641 5.825 0 11.651 1.456 16.020 3.641l272.338 141.995-273.067 141.266c-3.641 2.185-9.467 3.641-16.020 3.641z"> LogoScale="0.81" Logo="M884.4 130.6H140.6c-41.9 0-76 34.1-76 76v613.3c0 41.9 34.1 76 76 76h743.8c41.9 0 76-34.1 76-76V206.6c0-41.9-34.1-76-76-76z m-743.8 72h743.8c2.2 0 4 1.8 4 4v371.3L796 461.7c-21.7-27.3-54.1-43.7-88.8-45-34.7-1.3-68.1 12.7-91.7 38.3L454 630c-2.8 3-7.2 3.5-10.5 1.3l-103-70.3c-31.5-21.5-72.8-22.5-105.3-2.7l-98.6 60.1V206.6c0-2.2 1.8-4 4-4z m743.8 621.3H140.6c-2.2 0-4-1.8-4-4V702.7l136.1-83c8.4-5.1 19.1-4.8 27.2 0.7l103 70.3c15.9 10.8 35.1 15.6 54.2 13.4 19-2.2 36.7-11.2 49.8-25.3l161.6-175c9.5-10.3 22.3-15.7 36.2-15.1 13.9 0.5 26.3 6.8 35.1 17.8l148.7 187v126.3c-0.1 2.3-1.9 4.1-4.1 4.1z M231.8 400.6a69.6 69.6 0 1 0 98.4-98.4 69.6 69.6 0 1 0-98.4 98.4Z">
<!--Logo="M12 0l-11 6v12.131l11 5.869 11-5.869v-12.066l-11-6.065zm-1 21.2l-6.664-3.555 4.201-2.801c1.08-.719-.066-2.359-1.243-1.575l-4.294 2.862v-7.901l8 4.363v8.607zm-6.867-14.63l6.867-3.746v4.426c0 1.323 2 1.324 2 0v-4.415l6.91 3.811-7.905 4.218-7.872-4.294zm8.867 6.03l8-4.269v7.8l-4.263-2.842c-1.181-.785-2.323.855-1.245 1.574l4.172 2.781-6.664 3.556v-8.6z">-->
<local:MyListItem.Buttons> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="5" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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:MyIconButton Tag="5" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<local:MyListItem x:Name="ItemForge" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="6" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Forge" <local:MyListItem x:Name="ItemShader" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="6" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="光影包"
LogoScale="1.00" Logo="M402.807089 481.189274c-12.040221-6.991228-27.412326-2.797719-34.397415 9.242502l-8.387018 14.512529c-6.987135 12.035104-2.793626 27.40721 9.246595 34.392298 12.040221 6.985088 27.408233 2.797719 34.393321-9.242502l8.387018-14.511505C418.930301 503.437997 414.842193 488.063845 402.807089 481.189274L402.807089 481.189274zM495.028467 919.955342 59.056024 919.955342c-18.485003 0-33.532721 15.046694-33.532721 33.536814 0 18.485003 15.046694 33.532721 33.532721 33.532721l435.972443 0c18.49012 0 33.537837-15.046694 33.537837-33.532721C528.566304 935.002037 513.518586 919.955342 495.028467 919.955342L495.028467 919.955342zM997.431901 660.155295 590.482469 446.039729l90.935082-157.474544c18.485003-32.031531 7.520277-73.090669-24.51023-91.581812L395.496589 46.070268c-32.031531-18.485003-73.094762-7.520277-91.579765 24.51023L18.74697 564.277644c-18.485003 32.031531-7.521301 73.089645 24.51023 91.579765l261.408685 150.907988c32.031531 18.491143 73.095785 7.526417 91.581812-24.505114l91.364871-158.330028 392.332527 239.48128c16.016789 9.247618 36.544311 3.76372 45.792952-12.249999l83.838454-145.219429C1019.033895 689.930435 1013.444597 669.39882 997.431901 660.155295L997.431901 660.155295zM355.078041 719.704552c-9.242502 16.012695-29.774117 21.497617-45.787836 12.251022L105.923448 614.57826c-16.016789-9.242502-21.497617-29.774117-12.255115-45.787836l251.522524-435.653171c9.246595-16.012695 29.774117-21.497617 45.792952-12.249999l203.25624 117.376291c16.018835 9.242502 21.497617 29.774117 12.255115 45.786813L355.078041 719.704552 355.078041 719.704552zM884.568391 788.601712 522.115382 564.492538l33.537837-58.048067L934.875147 701.539844 884.568391 788.601712 884.568391 788.601712zM520.184403 277.8174c-12.040221-6.987135-27.41335-2.792603-34.399461 9.246595l-75.456552 130.702807c-6.985088 12.040221-2.791579 27.412326 9.242502 34.397415 12.040221 6.987135 27.412326 2.791579 34.397415-9.242502l75.458599-130.706901C536.307615 300.174594 532.219507 284.807604 520.184403 277.8174L520.184403 277.8174zM520.184403 277.8174"> LogoScale="1.04" Logo="M512 0c25 0 42 17 42 42v85c0 25-17 42-42 42s-42-17-42-42V42c0-25 17-42 42-42zM512 853c25 0 42 17 42 42v85c0 25-17 42-42 42s-42-17-42-42v-85c0-25 17-42 42-42zM209 149c-17-17-42-17-59 0-17 17-17 42 0 59l59 59c17 17 42 17 59 0 17-17 17-42 0-59L209 149zM755 755c17-17 42-17 59 0l59 59c17 17 17 42 0 59s-42 17-59 0l-59-59c-17-17-17-46 0-59zM42 469c-25 0-42 17-42 42s17 42 42 42h85c25 0 42-17 42-42s-17-42-42-42H42zM853 512c0-25 17-42 42-42h85c25 0 42 17 42 42s-17 42-42 42h-85c-25 0-42-17-42-42zM149 814c-17 17-17 42 0 59 17 17 42 17 59 0l59-59c17-17 17-42 0-59-17-17-42-17-59 0l-59 59zM755 268c-17-17-17-42 0-59l59-59c17-17 42-17 59 0s17 42 0 59l-59 59c-17 17-46 17-59 0z M512 213c-166 0-298 132-298 298s132 298 298 298 298-132 298-298-132-298-298-298z m0 512c-119 0-213-93-213-213s93-213 213-213 213 93 213 213-93 213-213 213z">
<!--Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">-->
<local:MyListItem.Buttons> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="6" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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:MyIconButton Tag="6" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<local:MyListItem x:Name="ItemNeoForge" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="7" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="NeoForge"
LogoScale="0.95" Logo="M544.6 921.2l-23.7 32.6c14.1 10.2 33.3 10.2 47.5 0l-23.7-32.6zM114.6 608.5l-23.9 32.5 0.2 0.1 23.6-32.6z m-12.0-38.0l38.3 12.7v-0.2l-38.3-12.4z m49.2-152.6l-38.4-12.4 38.4 12.4zM250.2 114.4l-37.6-14.6a40.2 40.2 0 0 0-0.7 2.1l38.4 12.4z m4.3-6.4l27.0 29.9 0.2-0.2-27.2-29.7z m11.7-4.5V63.0v40.4z m11.7 4.5l28.0-29.0a40.5 40.5 0 0 0-0.8-0.8l-27.2 29.8z m4.4 7.3l-38.6 11.7a40.5 40.5 0 0 0 0.2 0.7l38.3-12.4zM381.0 417.7l-38.4 12.5a40.3 40.3 0 0 0 38.4 27.8v-40.3z m327.0 0v40.3c17.5 0 32.9-11.2 38.4-27.8L708.1 417.7z m98.5-303.3l-37.6-14.6a38.4 38.4 0 0 0-0.7 2.1l38.4 12.4z m4.3-6.4l27.1 29.9 0.1-0.2-27.2-29.7z m11.7-4.5v0z m11.7 4.5l28.0-29.0a38.4 38.4 0 0 0-0.8-0.8l-27.2 29.8z m4.3 7.3l-38.6 11.7a47.5 47.5 0 0 0 0.2 0.7l38.4-12.4z m98.5 303.3l-38.4 12.4 0.1 0.5 38.2-12.9z m51.2 151.9l38.7-11.3a34.5 34.5 0 0 0-0.5-1.6l-38.1 12.9z m-37.8 5.2l-430.0 312.6 47.5 65.3 429.9-312.6-47.5-65.3z m-382.5 312.6L138.3 575.8l-47.5 65.3L520.9 953.9l47.3-65.3zM138.5 576a6.4 6.4 0 0 1 2.3 3.2l-76.9 24.5c4.7 14.9 14.1 28.0 26.7 37.3l47.8-65.0z m2.3 3.2a6.4 6.4 0 0 1 0 4.0L64.1 557.9a74.3 74.3 0 0 0-0.2 45.8l76.9-24.5z m0 3.7l49.2-152.6-76.8-24.8L64.0 558.2l76.8 24.8z m49.2-152.5l98.5-303.3-76.8-25.0L113.3 405.3l76.8 25.0z m97.7-301.3a23.4 23.4 0 0 1-6.1 8.9L227.6 78.0a57.3 57.3 0 0 0-15.0 21.8l75.3 29.1z m-5.9 8.7a23.0 23.0 0 0 1-15.5 6.0V63.0a57.7 57.7 0 0 0-38.9 15.1l54.4 59.6z m-15.5 6.0a23.0 23.0 0 0 1-15.5-6.0l54.4-59.6A57.7 57.7 0 0 0 266.4 63.0v80.8z m-16.3-6.8a23.4 23.4 0 0 1-6.1-10.0l77.3-23.4a57.3 57.3 0 0 0-15.0-24.5l-56.1 58.0z m-5.8-9.2l98.4 302.5 76.8-25.0-98.5-302.5-76.8 25.0z m136.8 330.4H708.1V377.5H381.2v80.7z m365.4-27.8l98.5-303.3-76.8-25.0L669.6 405.3l76.8 25.0z m97.7-301.3a23.4 23.4 0 0 1-6.1 8.9l-54.1-59.9a57.3 57.3 0 0 0-15.0 21.8l75.3 29.1z m-5.9 8.7a23.0 23.0 0 0 1-15.5 6.0V63.0a57.7 57.7 0 0 0-38.9 15.1l54.4 59.6z m-15.5 6.0a23.0 23.0 0 0 1-15.5-6.0l54.4-59.6a57.7 57.7 0 0 0-38.9-15.1v80.8z m-16.3-6.8a23.4 23.4 0 0 1-6.1-10.0l77.3-23.4a57.4 57.4 0 0 0-14.9-24.5l-56.1 58.0z m-5.8-9.2l98.5 303.3 76.8-25.0-98.5-303.3-76.8 25.0z m98.6 303.8l51.2 151.9 76.5-25.8-51.2-151.9-76.5 25.8z m50.7 150.2a6.5 6.5 0 0 1 0.1-4.0l75.6 28.1c5.5-14.9 6.2-31.3 1.6-46.7l-77.5 22.6z m0.1-4.0a6.4 6.4 0 0 1 2.4-3.2l43.8 67.8c13.4-8.7 23.6-21.5 29.2-36.4l-75.6-28.1z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="7" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemFabric" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="8" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Fabric"
LogoScale="1.02" Logo="M826.453333 170.666667c-100.266667-93.866667-248.96-76.373333-256-75.52a31.786667 31.786667 0 0 0-26.666666 22.613333c-1.066667 3.2-101.546667 330.666667-426.666667 445.013333a29.013333 29.013333 0 0 0-7.893333 4.48l-1.493334 1.066667a29.44 29.44 0 0 0-5.973333 6.613333 31.786667 31.786667 0 0 0-3.626667 7.68 5.333333 5.333333 0 0 1 0 1.493334 30.506667 30.506667 0 0 0 0 8.96c7.466667 116.266667 45.013333 204.586667 112 262.826666a303.36 303.36 0 0 0 194.773334 71.466667h11.52a32.426667 32.426667 0 0 0 27.093333-19.626667 694.186667 694.186667 0 0 1 159.36-234.666666l-7.68 55.466666A31.786667 31.786667 0 0 0 621.44 768h4.48a32.213333 32.213333 0 0 0 31.786667-27.733333l15.573333-112.426667 112.426667 8.32a32 32 0 1 0 4.693333-64l-56.96-4.266667c36.48-25.813333 74.026667-50.56 112-75.52l51.626667-34.133333a31.573333 31.573333 0 0 0 14.08-24.746667c6.186667-115.2-21.76-203.306667-84.693334-262.826666zM620.8 573.013333l-1.706667 1.493334a219.093333 219.093333 0 0 0-87.466666-116.693334 222.933333 222.933333 0 0 0-95.146667-33.28c18.986667-21.333333 36.266667-42.666667 51.626667-64a198.613333 198.613333 0 0 1 202.453333 158.08c-20.053333 14.506667-39.893333 29.44-59.52 45.226667a29.866667 29.866667 0 0 0-10.24 9.173333z m-228.693333 292.266667a238.72 238.72 0 0 1-141.44-55.893333 213.333333 213.333333 0 0 1-34.986667-39.466667 123.946667 123.946667 0 0 0 44.373333 8.106667 168.533333 168.533333 0 0 0 69.12-16.213334 29.44 29.44 0 0 0 7.04-4.266666l106.666667-85.333334a32 32 0 1 0-39.893333-49.92L298.666667 704a78.293333 78.293333 0 0 1-69.546667 1.706667c-32.426667-17.066667-52.693333-61.653333-62.506667-93.44a709.333333 709.333333 0 0 0 202.453334-123.733334 187.52 187.52 0 0 1 128 21.333334 171.946667 171.946667 0 0 1 68.906666 109.653333 756.48 756.48 0 0 0-173.866666 245.76zM810.666667 438.4l-64 42.666667A256 256 0 0 0 529.706667 298.666667a810.666667 810.666667 0 0 0 69.12-140.8c37.973333-1.066667 123.946667 4.053333 183.68 59.946666 45.866667 42.666667 67.84 108.8 65.493333 195.84z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="8" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemLiteLoader" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="9" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="LiteLoader"
LogoScale="1.06" Logo="M517.41 186.99l22.45 83.78h-55.04l-18.76-70.02c-2.85-10.63-13.78-16.95-24.42-14.1-10.63 2.85-16.95 13.78-14.1 24.42l16 59.71H388.5l-12.31-45.95c-10.45-38.99 12.69-79.08 51.69-89.52s79.08 12.68 89.53 51.68z M538.58 98c40.37 0 73.1 32.73 73.1 73.1v79.74h-53.16V171.1c0-11.01-8.93-19.94-19.94-19.94-11.01 0-19.94 8.93-19.94 19.94v79.74h-53.16V171.1c0-40.37 32.73-73.1 73.1-73.1z M512 224.26c191.58 0 346.88 155.3 346.88 346.88v61.8c0 28.85 3.33 59.94 9.98 93.27l1.29 6.28c12.43 59.1-21.15 118.2-78.28 137.78C691.18 904.75 597.9 922 512 922c-83.94 0-174.95-16.47-273.01-49.41l-6.85-2.32c-56.4-19.32-89.85-77.16-78.74-135.5l0.46-2.27c7.51-35.71 11.27-68.89 11.27-99.55v-61.8c0-189.66 152.21-343.77 341.14-346.83l5.73-0.06z m-4.64 66.49c-151.21 2.45-273.32 124.58-275.75 275.8l-0.04 4.59v61.8l-0.04 5.93c-0.45 33.74-4.7 69.49-12.65 107.3-5.53 26.27 9.4 52.53 34.79 61.23 94.08 32.23 180.19 48.15 258.32 48.15s164.25-15.92 258.32-48.15c25.39-8.7 40.32-34.97 34.79-61.23-7.95-37.81-12.2-73.56-12.65-107.3l-0.04-5.93v-61.8c0-153.33-123.05-277.91-275.79-280.39l-4.64-0.04-4.62 0.04z M500.66 717.38l-53.28-87.19c-3.83-6.26-1.85-14.44 4.41-18.27 0.76-0.46 1.56-0.85 2.39-1.15L512 589.74l57.82 21.03c6.9 2.51 10.46 10.13 7.95 17.03-0.3 0.83-0.69 1.63-1.15 2.39l-53.28 87.19c-3.83 6.26-12.01 8.24-18.27 4.41-1.8-1.1-3.31-2.61-4.41-4.41z M684.77 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z M339.23 689.42m-46.52 0a46.52 46.52 0 1 0 93.04 0 46.52 46.52 0 1 0-93.04 0Z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="9" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<TextBlock Text="社区资源" Margin="13,30,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemMod" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="11" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Mod"
LogoScale="0.97" Logo="M789.504 912.896h-195.072a35.328 35.328 0 0 1-34.816-35.328v-77.312a39.936 39.936 0 0 0-40.448-39.936H481.28a40.448 40.448 0 0 0-40.448 39.936v77.312a34.816 34.816 0 0 1-34.816 35.328H204.8a41.984 41.984 0 0 1-40.448-42.496v-200.192a35.328 35.328 0 0 1 35.328-35.328h72.704a39.936 39.936 0 0 0 39.936-39.936v-37.888a39.936 39.936 0 0 0-39.936-40.448H199.68a35.328 35.328 0 0 1-35.328-35.328V287.744A41.984 41.984 0 0 1 204.8 245.76h176.64v-32.768a102.4 102.4 0 0 1 102.4-102.4h33.792a102.4 102.4 0 0 1 102.4 102.4v32.768h170.496a41.984 41.984 0 0 1 41.984 41.984V460.8h28.672a102.4 102.4 0 0 1 102.4 102.4v33.792a102.4 102.4 0 0 1-102.4 102.4h-28.672V870.4a41.984 41.984 0 0 1-43.008 42.496z m-159.744-70.144h131.584V665.6a34.304 34.304 0 0 1 34.816-34.816h64a31.744 31.744 0 0 0 31.744-31.744V563.2a31.744 31.744 0 0 0-31.744-31.744h-64a34.816 34.816 0 0 1-34.816-35.328V316.416h-177.152a35.328 35.328 0 0 1-35.328-35.328V212.992a31.744 31.744 0 0 0-31.744-31.744h-33.792a31.744 31.744 0 0 0-31.744 31.744v68.096a35.328 35.328 0 0 1-34.816 35.328H234.496v130.048h37.888a110.592 110.592 0 0 1 110.08 110.592v37.888a110.592 110.592 0 0 1-110.08 110.592h-37.888v137.216h136.192v-42.496a110.592 110.592 0 0 1 110.592-110.08h37.888a110.592 110.592 0 0 1 110.592 110.08z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="11" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="12" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="整合包"
LogoScale="0.98" Logo="M511 995a128 128 0 0 1-57-13L70 791a126 126 0 0 1-70-113V311a126 126 0 0 1 15-60V248c1-2 3-5 5-8a127 127 0 0 1 49-42L454 13a128 128 0 0 1 112 0l383 190a126 126 0 0 1 72 113v360a126 126 0 0 1-70 115L568 984c-17 7-37 11-57 11z m42-470v370l360-178c14-7 23-21 23-38v-335L554 524zM85 330v347a42 42 0 0 0 23 38l360 178V523L85 330zM135 260l375 189 137-65L286 188 135 260z m245-118l363 197 150-71-365-180a42 42 0 0 0-37 0l-111 53z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="12" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemDataPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="13" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="数据包"
LogoScale="0.96" Logo="M445 545c18 0 33 14 33 33v149a182 182 0 1 1-182-182z m282 0a182 182 0 1 1-182 182v-149c0-18 14-33 33-33zM412 611H296a116 116 0 1 0 116 116V611z m315 0H611v116a116 116 0 1 0 116-116zM296 113a182 182 0 0 1 182 182v149a33 33 0 0 1-33 33H296a182 182 0 0 1 0-365z m431 0a182 182 0 0 1 0 365h-149a33 33 0 0 1-33-33V296A182 182 0 0 1 727 113zM296 180a116 116 0 0 0 0 232H412V296c0-62-48-112-109-115z m431 0a116 116 0 0 0-116 116V412h116c62 0 112-48 115-109l0-6a116 116 0 0 0-116-116z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="13" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemResourcePack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="14" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="资源包"
LogoScale="0.81" Logo="M884.4 130.6H140.6c-41.9 0-76 34.1-76 76v613.3c0 41.9 34.1 76 76 76h743.8c41.9 0 76-34.1 76-76V206.6c0-41.9-34.1-76-76-76z m-743.8 72h743.8c2.2 0 4 1.8 4 4v371.3L796 461.7c-21.7-27.3-54.1-43.7-88.8-45-34.7-1.3-68.1 12.7-91.7 38.3L454 630c-2.8 3-7.2 3.5-10.5 1.3l-103-70.3c-31.5-21.5-72.8-22.5-105.3-2.7l-98.6 60.1V206.6c0-2.2 1.8-4 4-4z m743.8 621.3H140.6c-2.2 0-4-1.8-4-4V702.7l136.1-83c8.4-5.1 19.1-4.8 27.2 0.7l103 70.3c15.9 10.8 35.1 15.6 54.2 13.4 19-2.2 36.7-11.2 49.8-25.3l161.6-175c9.5-10.3 22.3-15.7 36.2-15.1 13.9 0.5 26.3 6.8 35.1 17.8l148.7 187v126.3c-0.1 2.3-1.9 4.1-4.1 4.1z M231.8 400.6a69.6 69.6 0 1 0 98.4-98.4 69.6 69.6 0 1 0-98.4 98.4Z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="14" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
<local:MyListItem x:Name="ItemShader" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="15" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="光影包"
LogoScale="1.04" Logo="M512 0c25 0 42 17 42 42v85c0 25-17 42-42 42s-42-17-42-42V42c0-25 17-42 42-42zM512 853c25 0 42 17 42 42v85c0 25-17 42-42 42s-42-17-42-42v-85c0-25 17-42 42-42zM209 149c-17-17-42-17-59 0-17 17-17 42 0 59l59 59c17 17 42 17 59 0 17-17 17-42 0-59L209 149zM755 755c17-17 42-17 59 0l59 59c17 17 17 42 0 59s-42 17-59 0l-59-59c-17-17-17-46 0-59zM42 469c-25 0-42 17-42 42s17 42 42 42h85c25 0 42-17 42-42s-17-42-42-42H42zM853 512c0-25 17-42 42-42h85c25 0 42 17 42 42s-17 42-42 42h-85c-25 0-42-17-42-42zM149 814c-17 17-17 42 0 59 17 17 42 17 59 0l59-59c17-17 17-42 0-59-17-17-42-17-59 0l-59 59zM755 268c-17-17-17-42 0-59l59-59c17-17 42-17 59 0s17 42 0 59l-59 59c-17 17-46 17-59 0z M512 213c-166 0-298 132-298 298s132 298 298 298 298-132 298-298-132-298-298-298z m0 512c-119 0-213-93-213-213s93-213 213-213 213 93 213 213-93 213-213 213z">
<local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}">
<local:MyIconButton Tag="15" ToolTip="刷新" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="200" ToolTipService.VerticalOffset="-1" LogoScale="0.85" Click="Refresh" 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" />
</x:Array>
</local:MyListItem.Buttons>
</local:MyListItem>
</StackPanel> </StackPanel>
</local:MyScrollViewer> </local:MyScrollViewer>
</local:MyPageLeft> </local:MyPageLeft>
@@ -11,7 +11,7 @@
''' <summary> ''' <summary>
''' 勾选事件改变页面。 ''' 勾选事件改变页面。
''' </summary> ''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemInstall.Check, ItemClient.Check, ItemOptiFine.Check, ItemForge.Check, ItemNeoForge.Check, ItemLiteLoader.Check, ItemMod.Check, ItemFabric.Check, ItemPack.Check, ItemResourcePack.Check, ItemShader.Check, ItemDataPack.Check Private Sub PageCheck(sender As FrameworkElement, e As RouteEventArgs) Handles ItemInstall.Check, ItemMod.Check, ItemPack.Check, ItemResourcePack.Check, ItemShader.Check, ItemDataPack.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0 '尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False) '若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -23,24 +23,6 @@
Case FormMain.PageSubType.DownloadInstall Case FormMain.PageSubType.DownloadInstall
If FrmDownloadInstall Is Nothing Then FrmDownloadInstall = New PageDownloadInstall If FrmDownloadInstall Is Nothing Then FrmDownloadInstall = New PageDownloadInstall
Return FrmDownloadInstall Return FrmDownloadInstall
Case FormMain.PageSubType.DownloadClient
If FrmDownloadClient Is Nothing Then FrmDownloadClient = New PageDownloadClient
Return FrmDownloadClient
Case FormMain.PageSubType.DownloadOptiFine
If FrmDownloadOptiFine Is Nothing Then FrmDownloadOptiFine = New PageDownloadOptiFine
Return FrmDownloadOptiFine
Case FormMain.PageSubType.DownloadForge
If FrmDownloadForge Is Nothing Then FrmDownloadForge = New PageDownloadForge
Return FrmDownloadForge
Case FormMain.PageSubType.DownloadNeoForge
If FrmDownloadNeoForge Is Nothing Then FrmDownloadNeoForge = New PageDownloadNeoForge
Return FrmDownloadNeoForge
Case FormMain.PageSubType.DownloadLiteLoader
If FrmDownloadLiteLoader Is Nothing Then FrmDownloadLiteLoader = New PageDownloadLiteLoader
Return FrmDownloadLiteLoader
Case FormMain.PageSubType.DownloadFabric
If FrmDownloadFabric Is Nothing Then FrmDownloadFabric = New PageDownloadFabric
Return FrmDownloadFabric
Case FormMain.PageSubType.DownloadMod Case FormMain.PageSubType.DownloadMod
If FrmDownloadMod Is Nothing Then FrmDownloadMod = New PageDownloadMod If FrmDownloadMod Is Nothing Then FrmDownloadMod = New PageDownloadMod
Return FrmDownloadMod Return FrmDownloadMod
@@ -163,24 +145,6 @@
FrmDownloadDataPack.PageLoaderRestart() FrmDownloadDataPack.PageLoaderRestart()
End If End If
ItemDataPack.Checked = True ItemDataPack.Checked = True
Case FormMain.PageSubType.DownloadClient
DlClientListLoader.Start(IsForceRestart:=True)
ItemClient.Checked = True
Case FormMain.PageSubType.DownloadOptiFine
DlOptiFineListLoader.Start(IsForceRestart:=True)
ItemOptiFine.Checked = True
Case FormMain.PageSubType.DownloadForge
DlForgeListLoader.Start(IsForceRestart:=True)
ItemForge.Checked = True
Case FormMain.PageSubType.DownloadNeoForge
DlNeoForgeListLoader.Start(IsForceRestart:=True)
ItemNeoForge.Checked = True
Case FormMain.PageSubType.DownloadLiteLoader
DlLiteLoaderListLoader.Start(IsForceRestart:=True)
ItemLiteLoader.Checked = True
Case FormMain.PageSubType.DownloadFabric
DlFabricListLoader.Start(IsForceRestart:=True)
ItemFabric.Checked = True
End Select End Select
Hint("正在刷新……", Log:=False) Hint("正在刷新……", Log:=False)
End Sub End Sub
@@ -191,55 +155,4 @@
FrmDownloadInstall.ExitSelectPage() FrmDownloadInstall.ExitSelectPage()
End Sub End Sub
'展开手动安装
Private Sub ItemHand_Click(sender As Object, e As RouteEventArgs) Handles ItemHand.Changed
If ItemHand.Checked = False Then Return
e.Handled = True
AniControlEnabled += 1
If Not Setup.Get("HintHandInstall") Then
Setup.Set("HintHandInstall", True)
If MyMsgBox("手动安装包功能提供了 OptiFine、Forge 等组件的 .jar 安装文件下载,但无法自动安装。" & vbCrLf &
"在自动安装页面先选择 MC 版本,然后就可以选择 OptiFine、Forge 等组件,让 PCL 自动进行安装了。", "自动安装提示", "返回自动安装", "继续下载手动安装包") = 1 Then
FrmMain.PageChange(New FormMain.PageStackData With {.Page = FormMain.PageType.Download}, FormMain.PageSubType.DownloadInstall)
AniControlEnabled -= 1
Return
End If
End If
ItemHand.Visibility = Visibility.Collapsed
LabGame.Visibility = Visibility.Collapsed
LabHand.Visibility = Visibility.Visible
ItemClient.Visibility = Visibility.Visible
ItemOptiFine.Visibility = Visibility.Visible
ItemFabric.Visibility = Visibility.Visible
ItemForge.Visibility = Visibility.Visible
ItemNeoForge.Visibility = Visibility.Visible
ItemLiteLoader.Visibility = Visibility.Visible
RunInThread(
Sub()
Thread.Sleep(20)
RunInUiWait(Sub() ItemClient.SetChecked(True, True, True))
AniControlEnabled -= 1
End Sub)
End Sub
'折叠手动安装
Private Sub LabHand_Click(sender As Object, e As MouseButtonEventArgs) Handles LabHand.MouseLeftButtonUp
e.Handled = True
AniControlEnabled += 1
ItemHand.Visibility = Visibility.Visible
LabGame.Visibility = Visibility.Visible
LabHand.Visibility = Visibility.Collapsed
ItemClient.Visibility = Visibility.Collapsed
ItemOptiFine.Visibility = Visibility.Collapsed
ItemNeoForge.Visibility = Visibility.Collapsed
ItemFabric.Visibility = Visibility.Collapsed
ItemForge.Visibility = Visibility.Collapsed
ItemLiteLoader.Visibility = Visibility.Collapsed
RunInThread(
Sub()
Thread.Sleep(20)
RunInUiWait(Sub() ItemInstall.SetChecked(True, True, True))
AniControlEnabled -= 1
End Sub)
End Sub
End Class End Class
@@ -1,26 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadLiteLoader"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="LiteLoader 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Name="LabConnect" Margin="0,0,0,11" Text="与 Forge 类似,LiteLoader 可以用于加载老版本 Minecraft 中的 LiteLoader 模组。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel Name="PanMain" Margin="20,15,20,5" Grid.IsSharedSizeScope="True" />
<local:MyCard HorizontalAlignment="Center" Margin="40,50" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False">
<local:MyLoading Text="正在获取 LiteLoader 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -1,52 +0,0 @@
Public Class PageDownloadLiteLoader
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlLiteLoaderListLoader, AddressOf Load_OnFinish)
End Sub
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
End Sub
Private Sub Load_OnFinish()
'结果数据化
Try
'归类
Dim Dict As New Dictionary(Of String, List(Of DlLiteLoaderListEntry))
For VersionCode As Integer = 30 To 0 Step -1
Dict.Add("1." & VersionCode, New List(Of DlLiteLoaderListEntry))
Next
Dict.Add("未知版本", New List(Of DlLiteLoaderListEntry))
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
Dim MainVersion As String = "1." & Version.Inherit.Split(".")(1)
If Dict.ContainsKey(MainVersion) Then
Dict(MainVersion).Add(Version)
Else
Dict("未知版本").Add(Version)
End If
Next
'清空当前
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlLiteLoaderListEntry)) In Dict
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}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
NewCard.IsSwaped = True
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化 LiteLoader 版本列表出错", LogLevel.Feedback)
End Try
End Sub
Public Sub DownloadStart(sender As MyListItem, e As Object)
McDownloadLiteLoader(sender.Tag)
End Sub
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://www.liteloader.com")
End Sub
End Class
@@ -1,27 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadNeoForge"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="NeoForge 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Margin="0,0,0,11" Text="NeoForge 是 Minecraft 1.20.1+ 的 Mod 加载器,你需要先安装它才能安装各种 NeoForge 模组,它也兼容一些 Forge 模组。&#xa;本页面提供 NeoForge 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight"
EventType="打开网页" EventData="https://neoforged.net/" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel Name="PanMain" Margin="20,15,20,5" Grid.IsSharedSizeScope="True" />
<local:MyCard HorizontalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取 NeoForge 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -1,34 +0,0 @@
Public Class PageDownloadNeoForge
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlNeoForgeListLoader, AddressOf Load_OnFinish)
End Sub
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
End Sub
Private Sub Load_OnFinish()
'结果数据化
Try
'归类
Dim Dict = DlNeoForgeListLoader.Output.Value.GroupBy(Function(d) d.Inherit).OrderByDescending(Function(g) g.Key).
ToDictionary(Function(g) g.Key, Function(g) g.ToList())
'清空当前
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlNeoForgeListEntry)) In Dict
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 = 13}
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
NewCard.IsSwaped = True
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化 NeoForge 版本列表出错", LogLevel.Feedback)
End Try
End Sub
End Class
@@ -1,26 +0,0 @@
<local:MyPageRight
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageDownloadOptiFine"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="OptiFine 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20">
<TextBlock Name="LabConnect" Margin="0,0,0,11" Text="OptiFine 又称为高清修复,以允许安装光影、使用高清材质、提高游戏性能,但与 Mod 的兼容性不佳。" TextWrapping="Wrap" />
<Grid Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnWeb" Grid.Column="0" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel Name="PanMain" Margin="20,15,20,5" Grid.IsSharedSizeScope="True" />
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取 OptiFine 列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -1,53 +0,0 @@
Public Class PageDownloadOptiFine
Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(Load, PanLoad, PanMain, CardTip, DlOptiFineListLoader, AddressOf Load_OnFinish)
End Sub
Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome()
End Sub
Private Sub Load_OnFinish()
'结果数据化
Try
'归类
Dim Dict As New Dictionary(Of String, List(Of DlOptiFineListEntry))
Dict.Add("快照版本", New List(Of DlOptiFineListEntry))
For VersionCode As Integer = 50 To 0 Step -1
Dict.Add("1." & VersionCode, New List(Of DlOptiFineListEntry))
Next
For Each Version As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
If Version.Inherit.StartsWith("1.") Then
Dim MainVersion As String = "1." & Version.NameDisplay.Split(".")(1).Split(" ")(0)
If Dict.ContainsKey(MainVersion) Then
Dict(MainVersion).Add(Version)
Else
Dict("快照版本").Add(Version)
End If
Else
Dict("快照版本").Add(Version)
End If
Next
'清空当前
PanMain.Children.Clear()
'转化为 UI
For Each Pair As KeyValuePair(Of String, List(Of DlOptiFineListEntry)) In Dict
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}
NewCard.Children.Add(NewStack)
NewCard.SwapControl = NewStack
NewCard.IsSwaped = True
PanMain.Children.Add(NewCard)
Next
Catch ex As Exception
Log(ex, "可视化 OptiFine 版本列表出错", LogLevel.Feedback)
End Try
End Sub
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://www.optifine.net/")
End Sub
End Class
@@ -5,16 +5,6 @@ Public Class MyLocalModItem
#Region "基础属性" #Region "基础属性"
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
'Logo
Public Property Logo As String
Get
Return PathLogo.Source
End Get
Set(value As String)
PathLogo.Source = value
End Set
End Property
'标题 '标题
Private _Title As String Private _Title As String
Public Property Title As String Public Property Title As String
@@ -28,9 +18,6 @@ Public Class MyLocalModItem
LabTitle.TextDecorations = Nothing LabTitle.TextDecorations = Nothing
Case McMod.McModState.Disabled Case McMod.McModState.Disabled
LabTitle.TextDecorations = TextDecorations.Strikethrough LabTitle.TextDecorations = TextDecorations.Strikethrough
Case McMod.McModState.Unavailable
LabTitle.TextDecorations = TextDecorations.Strikethrough
value &= " [错误]"
End Select End Select
If LabTitle.Text = value Then Return If LabTitle.Text = value Then Return
LabTitle.Text = value LabTitle.Text = value
@@ -63,17 +50,17 @@ Public Class MyLocalModItem
'Tag 'Tag
Public WriteOnly Property Tags As List(Of String) Public WriteOnly Property Tags As List(Of String)
Set(value As List(Of String)) Set(Tags As List(Of String))
PanTags.Children.Clear() PanTags.Children.Clear()
PanTags.Visibility = If(value.Any(), Visibility.Visible, Visibility.Collapsed) PanTags.Visibility = If(Tags.Any(), Visibility.Visible, Visibility.Collapsed)
For Each TagText In value For Each TagText In Tags
Dim NewTag = GetObjectFromXML( Dim BorderTag As New Border With {
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" .Background = New MyColor("#0A000000"), .Padding = New Thickness(3, 1, 3, 1), .CornerRadius = New CornerRadius(3),
Background=""#0C000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0"" .Margin = New Thickness(0, 0, 3, 0), .SnapsToDevicePixels = True, .UseLayoutRounding = False}
SnapsToDevicePixels=""True"" UseLayoutRounding=""False""> Dim LabTag As New TextBlock With {
<TextBlock Text=""" & TagText & """ Foreground=""#88000000"" FontSize=""11"" /> .Text = TagText, .Foreground = New MyColor("#B0B0B0"), .FontSize = 11}
</Border>") BorderTag.Child = LabTag
PanTags.Children.Add(NewTag) PanTags.Children.Add(BorderTag)
Next Next
End Set End Set
End Property End Property
@@ -123,7 +110,7 @@ Public Class MyLocalModItem
End Get End Get
Set(value As Boolean) Set(value As Boolean)
_Swiping = value _Swiping = value
FrmVersionMod.CardSelect.IsHitTestVisible = Not value FrmInstanceMod.CardSelect.IsHitTestVisible = Not value
End Set End Set
End Property End Property
Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值 Private Shared SwipToState As Boolean '被滑动到的目标应将 Checked 改为此值
@@ -313,11 +300,11 @@ Public Class MyLocalModItem
#End Region #End Region
Private Function GetUpdateCompareDescription() As String Private Function GetUpdateCompareDescription() As String
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "") Dim CurrentName = If(Entry.CompFile.Version, Entry.CompFile.DisplayName).Replace(".jar", "")
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "") Dim NewestName = If(Entry.UpdateFile.Version, Entry.UpdateFile.DisplayName).Replace(".jar", "")
'简化名称对比 '简化名称对比
Dim CurrentSegs = CurrentName.Split("-"c).ToList() Dim CurrentSegs = CurrentName.Split("-_+ ".ToCharArray).ToList()
Dim NewestSegs = NewestName.Split("-"c).ToList() Dim NewestSegs = NewestName.Split("-_+ ".ToCharArray).ToList()
Dim Shortened As Boolean = False Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList() For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For If Not NewestSegs.Contains(Seg) Then Continue For
@@ -326,15 +313,25 @@ Public Class MyLocalModItem
Shortened = True Shortened = True
Next Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentName = Join(CurrentSegs, "-") CurrentName = CurrentSegs.Join("-")
NewestName = Join(NewestSegs, "-") NewestName = NewestSegs.Join("-")
Entry._Version = CurrentName '使用网络信息作为显示的版本号 Entry._Version = CurrentName '使用网络信息作为显示的版本号
End If End If
Return $"当前版本:{CurrentName}({GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}){vbCrLf}最新版本:{NewestName}({GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)})" Return $"当前版本:{CurrentName}({GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}){vbCrLf}最新版本:{NewestName}({GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)})"
End Function End Function
Public Sub Refresh() Handles Me.Loaded
RunInUi( '懒加载
Sub() Public Sub New()
InitializeComponent()
LazyLoadBehavior.OnFirstEnterScrollViewerViewport(Me, AddressOf FirstEnterScrollViewerViewport)
End Sub
Private HasEnteredViewport As Boolean = False
Private Sub FirstEnterScrollViewerViewport()
HasEnteredViewport = True
Refresh()
End Sub
Public Sub Refresh()
If Not HasEnteredViewport Then Return '避免在未显示时因为 Comp 更新而加载内容
'更新 '更新
If Entry.CanUpdate Then If Entry.CanUpdate Then
BtnUpdate.Visibility = Visibility.Visible BtnUpdate.Visibility = Visibility.Visible
@@ -344,26 +341,23 @@ Public Class MyLocalModItem
End If End If
'标题与描述 '标题与描述
Dim DescFileName As String Dim DescFileName As String
Select Case Entry.State If Entry.State = McMod.McModState.Fine OrElse Entry.State = McMod.McModState.Disabled Then
Case McMod.McModState.Fine DescFileName = IO.Path.GetFileNameWithoutExtension(Entry.Path)
DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path) Else
Case McMod.McModState.Disabled
DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
Case Else 'McMod.McModState.Unavailable
DescFileName = GetFileNameFromPath(Entry.Path) DescFileName = GetFileNameFromPath(Entry.Path)
End Select End If
Dim NewDescription As String Dim NewDescription As String
If Setup.Get("ToolModLocalNameStyle") = 1 Then If Settings.Get("ToolModLocalNameStyle") = 1 Then
'标题显示文件名,详情显示译名 '标题显示文件名,详情显示译名
'标题 '标题
Title = DescFileName Title = DescFileName
SubTitle = "" SubTitle = ""
'描述 '描述
If Entry.Comp Is Nothing Then If Entry.Comp Is Nothing Then
NewDescription = Entry.Name NewDescription = Entry.DisplayName
Else Else
Dim Titles = Entry.Comp.GetControlTitle(False) Dim Titles = Entry.Comp.GetControlTitle(False)
NewDescription = Titles.Key & Titles.Value NewDescription = Titles.Title & Titles.SubTitle
End If End If
NewDescription = NewDescription.Replace(" | ", " / ") NewDescription = NewDescription.Replace(" | ", " / ")
If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})" If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})"
@@ -371,12 +365,12 @@ Public Class MyLocalModItem
'标题显示译名,详情显示文件名 '标题显示译名,详情显示文件名
'标题 '标题
If Entry.Comp Is Nothing Then If Entry.Comp Is Nothing Then
Title = Entry.Name Title = Entry.DisplayName
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version) SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else Else
Dim Titles = Entry.Comp.GetControlTitle(False) Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key Title = Titles.Title
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version) SubTitle = Titles.SubTitle & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If End If
'描述 '描述
NewDescription = DescFileName NewDescription = DescFileName
@@ -385,8 +379,6 @@ Public Class MyLocalModItem
NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "") NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Entry.Description IsNot Nothing Then ElseIf Entry.Description IsNot Nothing Then
NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "") NewDescription += ": " & Entry.Description.Replace(vbCr, "").Replace(vbLf, "")
ElseIf Not Entry.IsFileAvailable Then
NewDescription += ": " & "存在错误,无法获取信息"
End If End If
Description = NewDescription Description = NewDescription
If Checked Then If Checked Then
@@ -395,7 +387,11 @@ Public Class MyLocalModItem
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4")) LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If End If
'主 Logo '主 Logo
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo()) If Entry.Comp IsNot Nothing Then
Entry.Comp.ApplyLogoToMyImage(PathLogo)
Else
PathLogo.Source = PathImage & "Icons/NoIcon.png"
End If
'图标右下角的 Logo '图标右下角的 Logo
If Entry.State = McMod.McModState.Fine Then If Entry.State = McMod.McModState.Fine Then
If ImgState IsNot Nothing Then If ImgState IsNot Nothing Then
@@ -420,7 +416,6 @@ Public Class MyLocalModItem
End If End If
'标签 '标签
If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags If Entry.Comp IsNot Nothing Then Tags = Entry.Comp.Tags
End Sub)
End Sub End Sub
Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed Public Sub RefreshColor(sender As Object, e As EventArgs) Handles Me.MouseEnter, Me.MouseLeave, Me.MouseLeftButtonDown, Me.MouseLeftButtonUp, Me.Changed
@@ -491,9 +486,9 @@ Public Class MyLocalModItem
'触发更新 '触发更新
Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
Select Case MyMsgBox($"是否要更新 {Entry.Name}?{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消") Select Case MyMsgBox($"是否要更新 {Entry.DisplayName}?{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
Case 1 '更新 Case 1 '更新
FrmVersionMod.UpdateMods({Entry}) FrmInstanceMod.UpdateMods({Entry})
Case 2 '查看更新日志 Case 2 '查看更新日志
ShowUpdateLog() ShowUpdateLog()
Case 3 '取消 Case 3 '取消
@@ -3,8 +3,8 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:System="clr-namespace:System;assembly=mscorlib" xmlns:System="clr-namespace:System;assembly=mscorlib"
mc:Ignorable="d" x:Class="PageVersionExport" mc:Ignorable="d" x:Class="PageInstanceExport"
PanScroll="{Binding ElementName=PanBack}"> PanScroll="PanBack">
<Grid x:Name="PanAllBack"> <Grid x:Name="PanAllBack">
<Grid.Resources> <Grid.Resources>
<Style TargetType="local:MyCheckBox"> <Style TargetType="local:MyCheckBox">
@@ -94,7 +94,7 @@
<local:ExportOption <local:ExportOption
Title="整合包重要数据" Title="整合包重要数据"
Description="脚本文件、内置资源包、数据包等" Description="脚本文件、内置资源包、数据包等"
Rules="addons/|multiblocked/|modpack-update-checker/|global_packs/|global_resource_packs/|global_data_packs/|optional_data_packs/|maps/|icon.png|mods-resourcepacks/|matmos/|resource_assorts/|resource_assorts.json|patchouli_books/|datapacks/|kubejs*/|!kubejs*/probe/|!kubejs*/exported/|!kubejs*/jsconfig.json|!kubejs*/README.txt|openloader/|worldshape/|resources/|scripts/|structures/|fontfiles/|oresources/|packmenu/|craftpresence/|pointblanks/|template*/|!template*/playerdata/|!template*/stats/" Rules="hotai/|bansoukou/|addons/|multiblocked/|modpack-update-checker/|global_packs/|global_resource_packs/|global_data_packs/|optional_data_packs/|moonlight-global-datapacks/|maps/|icon.png|mods-resourcepacks/|matmos/|resource_assorts/|resource_assorts.json|patchouli_books/|datapacks/|kubejs*/|!kubejs*/probe/|!kubejs*/exported/|!kubejs*/jsconfig.json|!kubejs*/README.txt|openloader/|worldshape/|resources/|scripts/|structures/|fontfiles/|oresources/|packmenu/|craftpresence/|pointblanks/|template*/|!template*/playerdata/|!template*/stats/"
DefaultChecked="True" /> DefaultChecked="True" />
</local:MyCheckBox.Tag> </local:MyCheckBox.Tag>
</local:MyCheckBox> </local:MyCheckBox>
@@ -102,7 +102,23 @@
<local:MyCheckBox.Tag> <local:MyCheckBox.Tag>
<local:ExportOption <local:ExportOption
Title="Mod 设置" Title="Mod 设置"
Rules="config/|!config/jei/world/|!config/worldedit/|config/worldedit/worldedit.properties|!config/spark/|config/spark/config.json|defaultconfigs/|journeymap/config/|journeymap/server/|TrashSlotSaveState.json|customfov.txt|gg.essential.mod/|essential/|!essential/*/|!essential/*.jar*|!essential/screenshot-checksum-caches.json|!essential/microsoft_accounts.json|paragliderSettings.nbt|local/client_config.json|local/ftbl.json|local/client/sidebar_buttons.json|local/client/ftbutilities.cfg|local/client/ftblib.cfg|local/client/xencraft.cfg|liteloader.properties|default_reference.xml|CustomSkinLoader/CustomSkinLoader.json" Rules="config/|!config/jei/world/|!config/worldedit/|config/worldedit/worldedit.properties|!config/spark/|config/spark/config.json|defaultconfigs/|journeymap/config/|journeymap/server/|TrashSlotSaveState.json|customfov.txt|gg.essential.mod/|essential/|!essential/*/|!essential/*.jar*|!essential/screenshot-checksum-caches.json|!essential/microsoft_accounts.json|paragliderSettings.nbt|local/client_config.json|local/ftbl.json|local/client/sidebar_buttons.json|local/client/ftbutilities.cfg|local/client/ftblib.cfg|local/client/xencraft.cfg|liteloader.properties|default_reference.xml|CustomSkinLoader/CustomSkinLoader.json|!config/tacz/custom"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="TaCZ 枪包"
Rules="tacz/|config/tacz/custom/"
DefaultChecked="True" />
</local:MyCheckBox.Tag>
</local:MyCheckBox>
<local:MyCheckBox>
<local:MyCheckBox.Tag>
<local:ExportOption
Title="已上传的沉浸画"
Rules="immersive_paintings/"
DefaultChecked="True" /> DefaultChecked="True" />
</local:MyCheckBox.Tag> </local:MyCheckBox.Tag>
</local:MyCheckBox> </local:MyCheckBox>
@@ -235,14 +251,14 @@
</StackPanel> </StackPanel>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
<local:MyCard Title="高级选项" Margin="0,0,0,15" CanSwap="True" IsSwaped="True"> <local:MyCard Title="高级选项" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
<StackPanel Margin="25,37,23,20"> <StackPanel Margin="25,37,23,20">
<local:MyHint Text="建议仅在无法稳定连接 CurseForge 或 Modrinth 时才打包资源文件。&#xa;请不要公开发布含资源文件的整合包,这会违反部分 Mod 的使用协议!" <local:MyHint Text="建议仅在无法稳定连接 CurseForge 或 Modrinth 时才打包资源文件。&#xa;请不要公开发布含资源文件的整合包,这会违反部分 Mod 的使用协议!"
Theme="Yellow" Margin="0,2,0,8" Visibility="{Binding Checked, ElementName=CheckAdvancedInclude, Converter={StaticResource BooleanToVisibilityConverter}}" /> Theme="Yellow" Margin="0,2,0,8" Visibility="{Binding Checked, ElementName=CheckAdvancedInclude, Converter={StaticResource BooleanToVisibilityConverter}}" />
<local:MyCheckBox Text="打包资源文件,以避免在导入时下载" x:Name="CheckAdvancedInclude" <local:MyCheckBox Text="打包资源文件,以避免在导入时下载" x:Name="CheckAdvancedInclude"
ToolTip="将 Mod、资源包、光影包的文件直接放入整合包中,这样在导入时就无需联网下载它们。&#xa;建议仅在无法稳定连接 CurseForge 或 Modrinth 时才考虑勾选。" /> ToolTip="将 Mod、资源包、光影包的文件直接放入整合包中,这样在导入时就无需联网下载它们。&#xa;建议仅在无法稳定连接 CurseForge 或 Modrinth 时才考虑勾选。" />
<local:MyCheckBox Text="Modrinth 上传模式" x:Name="CheckAdvancedModrinth" <local:MyCheckBox Text="仅从 Modrinth 下载资源文件" x:Name="CheckAdvancedModrinth"
ToolTip="如果你想要打包上传到 Modrinth,勾选此项会生成完全符合 Modrinth 要求的整合包文件。&#xa;由于 Modrinth 要求,只能从 CurseForge 下载的资源将无法联网下载,会被直接放入整合包中。&#xa;此外,勾选后也不能在整合包中包含 PCL 启动器文件。" /> ToolTip="若资源未在 Modrinth 上托管,则将其原始文件直接放入整合包中。&#xa;如果你想将整合包上传到 Modrinth,这能帮助你分辨哪些文件未在 Modrinth 上托管。" />
<local:MyHint Theme="Blue" RelativeSetup="HintExportConfig" CanClose="True" Margin="0,20,0,2" <local:MyHint Theme="Blue" RelativeSetup="HintExportConfig" CanClose="True" Margin="0,20,0,2"
Text="配置文件中含有更多高级选项,例如精准控制导出的文件、设置整合包存放位置等。&#xa;要修改这些选项,请先点击 “保存配置”,在编辑配置文件后再导入。" /> Text="配置文件中含有更多高级选项,例如精准控制导出的文件、设置整合包存放位置等。&#xa;要修改这些选项,请先点击 “保存配置”,在编辑配置文件后再导入。" />
<Grid Height="35" Margin="0,12,0,0"> <Grid Height="35" Margin="0,12,0,0">
@@ -254,7 +270,7 @@
<local:MyButton Grid.Column="0" x:Name="BtnAdvancedImport" MinWidth="140" Text="读取配置" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" /> <local:MyButton Grid.Column="0" x:Name="BtnAdvancedImport" MinWidth="140" Text="读取配置" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" />
<local:MyButton Grid.Column="1" x:Name="BtnAdvancedExport" MinWidth="140" Text="保存配置" Padding="13,0" Margin="0,0,20,0" /> <local:MyButton Grid.Column="1" x:Name="BtnAdvancedExport" MinWidth="140" Text="保存配置" Padding="13,0" Margin="0,0,20,0" />
<local:MyButton Grid.Column="2" MinWidth="140" Text="整合包制作指南" Padding="13,0" Margin="0,0,20,0" x:Name="BtnAdvancedHelp" <local:MyButton Grid.Column="2" MinWidth="140" Text="整合包制作指南" Padding="13,0" Margin="0,0,20,0" x:Name="BtnAdvancedHelp"
EventType="打开帮助" /> local:CustomEventService.EventType="打开帮助" />
</Grid> </Grid>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
@@ -15,27 +15,28 @@ Public Class ExportOption
Public Property RequireModLoaderOrOptiFine As Boolean = False Public Property RequireModLoaderOrOptiFine As Boolean = False
End Class End Class
Public Class PageVersionExport Public Class PageInstanceExport
Implements IRefreshable Implements IRefreshable
Private CurrentVersion As String = "" Private CurrentInstance As String = ""
Private Sub PageVersionExport_Loaded() Handles Me.Loaded Private Sub PageInstanceExport_Loaded() Handles Me.Loaded
AniControlEnabled += 1 AniControlEnabled += 1
If CurrentVersion <> PageVersionLeft.Version.Path Then RefreshAll() '切换到了另一个版本,重置页面 If CurrentInstance <> PageInstanceLeft.Instance.PathVersion Then RefreshAll() '切换到了另一个版本,重置页面
BtnAdvancedHelp.EventData = If(VersionBranchName = "Release", "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json") CustomEventService.SetEventData(BtnAdvancedHelp,
If(VersionBranchCode = 50, "指南/整合包制作 - Public.json", "指南/整合包制作 - Snapshot.json"))
AniControlEnabled -= 1 AniControlEnabled -= 1
End Sub End Sub
Public Sub RefreshAll() Implements IRefreshable.Refresh Public Sub RefreshAll() Implements IRefreshable.Refresh
Log($"[Export] 刷新导出页面") Log($"[Export] 刷新导出页面")
HintOptiFine.Visibility = If(PageVersionLeft.Version.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed) HintOptiFine.Visibility = If(PageInstanceLeft.Instance.Version.HasOptiFine, Visibility.Visible, Visibility.Collapsed)
CurrentVersion = PageVersionLeft.Version.Path CurrentInstance = PageInstanceLeft.Instance.PathVersion
TextExportName.Text = "" TextExportName.Text = ""
TextExportName.HintText = PageVersionLeft.Version.Name TextExportName.HintText = PageInstanceLeft.Instance.Name
TextExportVersion.Text = "" TextExportVersion.Text = ""
TextExportVersion.HintText = "1.0.0" TextExportVersion.HintText = "1.0.0"
CheckAdvancedInclude.Checked = False CheckAdvancedInclude.Checked = False
CheckAdvancedModrinth.Checked = False CheckAdvancedModrinth.Checked = False
GetExportOption(CheckOptionsBasic).Description = PageVersionLeft.Version.GetDefaultDescription() GetExportOption(CheckOptionsBasic).Description = PageInstanceLeft.Instance.VersionDisplayName()
ResetConfigOverrides() ResetConfigOverrides()
ReloadAllSubOptions() ReloadAllSubOptions()
RefreshAllOptionsUI() RefreshAllOptionsUI()
@@ -57,7 +58,7 @@ Public Class PageVersionExport
Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String()) Private Sub ReloadSubOptions(Panel As StackPanel, AcceptCompressedFile As Boolean, AcceptFolder As Boolean, ParamArray Folders As String())
Panel.Children.Clear() Panel.Children.Clear()
For Each Folder In Folders For Each Folder In Folders
Dim TargetFolder As New DirectoryInfo(PageVersionLeft.Version.PathIndie & Folder) Dim TargetFolder As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Folder)
If Not TargetFolder.Exists() Then Continue For If Not TargetFolder.Exists() Then Continue For
'查找文件夹下的对应项 '查找文件夹下的对应项
If AcceptCompressedFile Then If AcceptCompressedFile Then
@@ -99,7 +100,7 @@ Public Class PageVersionExport
Return False Return False
End Try End Try
End Function End Function
Dim PathInfo As New DirectoryInfo(PageVersionLeft.Version.PathIndie) Dim PathInfo As New DirectoryInfo(PageInstanceLeft.Instance.PathIndie)
AllEntries.AddRange(PathInfo.EnumerateFiles().Select(Function(f) f.Name)) AllEntries.AddRange(PathInfo.EnumerateFiles().Select(Function(f) f.Name))
For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory) For Each SubFolder In PathInfo.EnumerateDirectories().Where(IsValidDirectory)
AllEntries.Add($"{SubFolder.Name}\") AllEntries.Add($"{SubFolder.Name}\")
@@ -111,9 +112,9 @@ Public Class PageVersionExport
Dim IsVisible = Dim IsVisible =
Function(TargetOption As ExportOption) As Boolean Function(TargetOption As ExportOption) As Boolean
'检查需要 OptiFine 或 Mod 加载器 '检查需要 OptiFine 或 Mod 加载器
If TargetOption.RequireOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine Then Return False If TargetOption.RequireOptiFine AndAlso Not PageInstanceLeft.Instance.Version.HasOptiFine Then Return False
If TargetOption.RequireModLoader AndAlso Not PageVersionLeft.Version.Modable Then Return False If TargetOption.RequireModLoader AndAlso Not PageInstanceLeft.Instance.Modable Then Return False
If TargetOption.RequireModLoaderOrOptiFine AndAlso Not PageVersionLeft.Version.Version.HasOptiFine AndAlso Not PageVersionLeft.Version.Modable Then Return False If TargetOption.RequireModLoaderOrOptiFine AndAlso Not PageInstanceLeft.Instance.Version.HasOptiFine AndAlso Not PageInstanceLeft.Instance.Modable Then Return False
'粗略检查是否可能有符合规则的文件/文件夹 '粗略检查是否可能有符合规则的文件/文件夹
Return StandardizeLines(If(TargetOption.Rules, TargetOption.ShowRules).Split("|"c), True).Any( Return StandardizeLines(If(TargetOption.Rules, TargetOption.ShowRules).Split("|"c), True).Any(
Function(Rule As String) Function(Rule As String)
@@ -129,9 +130,9 @@ Public Class PageVersionExport
Rule = Rule.Trim("*?".ToCharArray) Rule = Rule.Trim("*?".ToCharArray)
If Rule.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries).Count >= 3 Then If Rule.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries).Count >= 3 Then
If Rule.EndsWithF("\") Then If Rule.EndsWithF("\") Then
Return IsValidDirectory(New DirectoryInfo(PageVersionLeft.Version.PathIndie & Rule)) '文件夹有效 Return IsValidDirectory(New DirectoryInfo(PageInstanceLeft.Instance.PathIndie & Rule)) '文件夹有效
Else Else
Return File.Exists(PageVersionLeft.Version.PathIndie & Rule) '文件有效 Return File.Exists(PageInstanceLeft.Instance.PathIndie & Rule) '文件有效
End If End If
Else Else
Return False Return False
@@ -304,9 +305,9 @@ Public Class PageVersionExport
'保存配置文件 '保存配置文件
Private Sub ExportConfig() Handles BtnAdvancedExport.Click Private Sub ExportConfig() Handles BtnAdvancedExport.Click
Try Try
Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Setup.Get("CacheExportConfig")) Dim ConfigPath As String = SelectSaveFile("选择文件位置", "export_config.txt", "整合包导出配置(*.txt)|*.txt", Settings.Get("CacheExportConfig"))
If String.IsNullOrEmpty(ConfigPath) Then Return If String.IsNullOrEmpty(ConfigPath) Then Return
Setup.Set("CacheExportConfig", ConfigPath) Settings.Set("CacheExportConfig", ConfigPath)
Dim ConfigLines As New List(Of String) Dim ConfigLines As New List(Of String)
'ini 段 'ini 段
ConfigLines.Add("Name:" & TextExportName.Text) ConfigLines.Add("Name:" & TextExportName.Text)
@@ -323,9 +324,9 @@ Public Class PageVersionExport
ConfigLines.Add("# 二次分发可能违反使用协议,请尽量不要公开发布包含资源文件的整合包!") ConfigLines.Add("# 二次分发可能违反使用协议,请尽量不要公开发布包含资源文件的整合包!")
ConfigLines.Add("DontCheckHostedAssets:" & CheckAdvancedInclude.Checked) ConfigLines.Add("DontCheckHostedAssets:" & CheckAdvancedInclude.Checked)
ConfigLines.Add("") ConfigLines.Add("")
ConfigLines.Add("# 如果你想要打包上传到 Modrinth,启用此项会生成完全符合 Modrinth 要求的整合包文件。") ConfigLines.Add("# 若资源未在 Modrinth 上托管,则将其原始文件直接放入整合包中。")
ConfigLines.Add("# 由于 Modrinth 要求,只能从 CurseForge 下载的资源将无法联网下载,会被直接放入整合包中。") ConfigLines.Add("# 如果你想将整合包上传到 Modrinth,这能帮助你分辨哪些文件未在 Modrinth 上托管。")
ConfigLines.Add("# 此选项与 IncludeLauncher、IncludeLauncherCustom、DontCheckHostedAssets 冲突。") ConfigLines.Add("# 此选项与 DontCheckHostedAssets 冲突。")
ConfigLines.Add("ModrinthUploadMode:" & CheckAdvancedModrinth.Checked) ConfigLines.Add("ModrinthUploadMode:" & CheckAdvancedModrinth.Checked)
ConfigLines.Add("") ConfigLines.Add("")
ConfigLines.Add("# 导出的文件的存放位置。") ConfigLines.Add("# 导出的文件的存放位置。")
@@ -341,7 +342,7 @@ Public Class PageVersionExport
ConfigLines.AddRange(GetExtraFileLines()) ConfigLines.AddRange(GetExtraFileLines())
'结束 '结束
WriteFile(ConfigPath, ConfigLines.Join(vbCrLf)) WriteFile(ConfigPath, ConfigLines.Join(vbCrLf))
Hint("已保存配置文件:" & ConfigPath, HintType.Finish) Hint("已保存配置文件:" & ConfigPath, HintType.Green)
OpenExplorer(ConfigPath) OpenExplorer(ConfigPath)
Catch ex As Exception Catch ex As Exception
Log(ex, "保存配置失败", LogLevel.Msgbox) Log(ex, "保存配置失败", LogLevel.Msgbox)
@@ -350,9 +351,9 @@ Public Class PageVersionExport
'读取配置文件 '读取配置文件
Private Sub ImportConfig() Handles BtnAdvancedImport.Click Private Sub ImportConfig() Handles BtnAdvancedImport.Click
Try Try
Dim ConfigPath As String = SelectFile("整合包导出配置(*.txt)|*.txt", "选择配置文件", Setup.Get("CacheExportConfig")) Dim ConfigPath As String = SelectFile("整合包导出配置(*.txt)|*.txt", "选择配置文件", Settings.Get("CacheExportConfig"))
If String.IsNullOrEmpty(ConfigPath) Then Return If String.IsNullOrEmpty(ConfigPath) Then Return
Setup.Set("CacheExportConfig", ConfigPath) Settings.Set("CacheExportConfig", ConfigPath)
Dim Segments As String() = ReadFile(ConfigPath).Split(Sperator) Dim Segments As String() = ReadFile(ConfigPath).Split(Sperator)
'ini 段 'ini 段
Dim Ini As New Dictionary(Of String, String) Dim Ini As New Dictionary(Of String, String)
@@ -366,8 +367,8 @@ Public Class PageVersionExport
TextExportVersion.Text = Ini.GetOrDefault("Version", "") TextExportVersion.Text = Ini.GetOrDefault("Version", "")
CheckOptionsPcl.Checked = Ini.GetOrDefault("IncludeLauncher", True) CheckOptionsPcl.Checked = Ini.GetOrDefault("IncludeLauncher", True)
CheckOptionsPclCustom.Checked = Ini.GetOrDefault("IncludeLauncherCustom", True) CheckOptionsPclCustom.Checked = Ini.GetOrDefault("IncludeLauncherCustom", True)
CheckAdvancedModrinth.Checked = Ini.GetOrDefault("ModrinthUploadMode", False)
CheckAdvancedInclude.Checked = Ini.GetOrDefault("DontCheckHostedAssets", False) CheckAdvancedInclude.Checked = Ini.GetOrDefault("DontCheckHostedAssets", False)
If Not CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = Ini.GetOrDefault("ModrinthUploadMode", False) '#7979,加个特判
ConfigPackPath = Ini.GetOrDefault("PackPath", Nothing) ConfigPackPath = Ini.GetOrDefault("PackPath", Nothing)
'导出内容段 '导出内容段
RulesOverrides = Segments(1).Replace(vbCr, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ToList RulesOverrides = Segments(1).Replace(vbCr, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ToList
@@ -378,7 +379,7 @@ Public Class PageVersionExport
ExtraFiles = Nothing ExtraFiles = Nothing
End If End If
'结束 '结束
Hint("已读取配置文件:" & ConfigPath, HintType.Finish) Hint("已读取配置文件:" & ConfigPath, HintType.Green)
Catch ex As Exception Catch ex As Exception
Log(ex, "读取配置失败", LogLevel.Msgbox) Log(ex, "读取配置失败", LogLevel.Msgbox)
End Try End Try
@@ -418,12 +419,12 @@ Public Class PageVersionExport
Log($"[Export] 使用配置文件中指定的导出路径:{ConfigPackPath}") Log($"[Export] 使用配置文件中指定的导出路径:{ConfigPackPath}")
Catch ex As Exception Catch ex As Exception
Log(ex, $"无法使用配置文件中指定的导出路径({ConfigPackPath})", LogLevel.Debug) Log(ex, $"无法使用配置文件中指定的导出路径({ConfigPackPath})", LogLevel.Debug)
If MyMsgBox($"指定的路径:{ConfigPackPath}{vbCrLf}{vbCrLf}{GetExceptionDetail(ex)}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return If MyMsgBox($"指定的路径:{ConfigPackPath}{vbCrLf}{vbCrLf}{ex.GetDetail}", "无法使用配置文件中指定的导出路径", "确定", "取消") = 2 Then Return
End Try End Try
End If End If
If PackPath Is Nothing Then If PackPath Is Nothing Then
Dim Extensions As New List(Of String) Dim Extensions As New List(Of String)
If Not CheckAdvancedModrinth.Checked Then Extensions.Add("压缩文件(*.zip)|*.zip") Extensions.Add("压缩文件(*.zip)|*.zip")
If Not CheckOptionsPcl.Checked Then Extensions.Add("Modrinth 整合包文件(*.mrpack)|*.mrpack") If Not CheckOptionsPcl.Checked Then Extensions.Add("Modrinth 整合包文件(*.mrpack)|*.mrpack")
PackPath = SelectSaveFile("选择导出位置", PackPath = SelectSaveFile("选择导出位置",
PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), Extensions.Join("|")) PackName & If(String.IsNullOrEmpty(TextExportVersion.Text), "", " " & TextExportVersion.Text), Extensions.Join("|"))
@@ -434,7 +435,7 @@ Public Class PageVersionExport
'缓存所需参数 '缓存所需参数
Dim CacheFolder = RequestTaskTempFolder() Dim CacheFolder = RequestTaskTempFolder()
Dim OverridesFolder = CacheFolder & "modpack\overrides\" Dim OverridesFolder = CacheFolder & "modpack\overrides\"
Dim McVersion = PageVersionLeft.Version Dim McVersion = PageInstanceLeft.Instance
Dim PathIndie As String = McVersion.PathIndie Dim PathIndie As String = McVersion.PathIndie
Dim CheckHostedAssets As Boolean = Not CheckAdvancedInclude.Checked Dim CheckHostedAssets As Boolean = Not CheckAdvancedInclude.Checked
Dim ModrinthUploadMode As Boolean = CheckAdvancedModrinth.Checked Dim ModrinthUploadMode As Boolean = CheckAdvancedModrinth.Checked
@@ -484,7 +485,7 @@ Public Class PageVersionExport
'检查规则 '检查规则
Dim ShouldKeep As Boolean = False Dim ShouldKeep As Boolean = False
For Each Rule In AllRules For Each Rule In AllRules
Dim Revert = Rule.StartsWith("!") Dim Revert = Rule.StartsWithF("!")
If RelativePath Like Rule.TrimStart("!") Then ShouldKeep = Not Revert If RelativePath Like Rule.TrimStart("!") Then ShouldKeep = Not Revert
Next Next
If Not ShouldKeep Then Continue For If Not ShouldKeep Then Continue For
@@ -492,7 +493,7 @@ Public Class PageVersionExport
CopyFile(Entry.FullName, TargetPath) CopyFile(Entry.FullName, TargetPath)
'若为压缩包,考虑联网获取路径 '若为压缩包,考虑联网获取路径
If CheckHostedAssets AndAlso If CheckHostedAssets AndAlso
{".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.ToLower) AndAlso {".zip", ".rar", ".jar", ".disabled", ".old"}.Contains(Entry.Extension.Lower) AndAlso
{"mods", "packs", "openloader", "resource"}.Any(Function(s) RelativePath.Contains(s)) Then {"mods", "packs", "openloader", "resource"}.Any(Function(s) RelativePath.Contains(s)) Then
Dim ModFile As New McMod(TargetPath) Dim ModFile As New McMod(TargetPath)
Dim Unused = ModFile.ModrinthHash '提前计算 Hash Dim Unused = ModFile.ModrinthHash '提前计算 Hash
@@ -517,19 +518,20 @@ Public Class PageVersionExport
If Directory.Exists(Line) Then If Directory.Exists(Line) Then
CopyDirectory(Line, BaseFolder & GetFolderNameFromPath(Line) & "\") CopyDirectory(Line, BaseFolder & GetFolderNameFromPath(Line) & "\")
Else Else
Hint($"未找到配置文件中指定的文件夹:{Line}", HintType.Critical) Hint($"未找到配置文件中指定的文件夹:{Line}", HintType.Red)
End If End If
Else Else
If File.Exists(Line) Then If File.Exists(Line) Then
CopyFile(Line, BaseFolder & GetFileNameFromPath(Line)) CopyFile(Line, BaseFolder & GetFileNameFromPath(Line))
Else Else
Hint($"未找到配置文件中指定的单个文件:{Line}", HintType.Critical) Hint($"未找到配置文件中指定的单个文件:{Line}", HintType.Red)
End If End If
End If End If
Next Next
Loader.Progress = 0.97 Loader.Progress = 0.97
'复制 PCL 版本设置 '复制 PCL 版本设置
CopyDirectory(McVersion.Path & "PCL\", OverridesFolder & "PCL\") CopyDirectory(McVersion.PathVersion & "PCL\", OverridesFolder & "PCL\")
WriteIni(OverridesFolder & "PCL\Setup.ini", "IsStar", False)
#If BETA Then #If BETA Then
'复制 PCL 本体 '复制 PCL 本体
If IncludePCL Then CopyFile(PathWithName, CacheFolder & "Plain Craft Launcher.exe") If IncludePCL Then CopyFile(PathWithName, CacheFolder & "Plain Craft Launcher.exe")
@@ -564,8 +566,8 @@ Public Class PageVersionExport
Sub() Sub()
Try Try
Dim ModrinthHashes = Loader.Input.Select(Function(m) m.ModrinthHash) Dim ModrinthHashes = Loader.Input.Select(Function(m) m.ModrinthHash)
Dim ModrinthRaw = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST", Dim ModrinthRaw As JObject = DlModRequest("https://api.modrinth.com/v2/version_files", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject) $"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")
For Each ModFile In Loader.Input For Each ModFile In Loader.Input
'查找对应的文件 '查找对应的文件
If Not ModrinthRaw.ContainsKey(ModFile.ModrinthHash) Then Continue For If Not ModrinthRaw.ContainsKey(ModFile.ModrinthHash) Then Continue For
@@ -587,10 +589,10 @@ Public Class PageVersionExport
RunInNewThread( RunInNewThread(
Sub() Sub()
Try Try
If ModrinthUploadMode Then Return 'Modrinth 上传模式下,不能从 CurseForge 获取信息 If ModrinthUploadMode Then Return 'Modrinth 上传模式下,不从 CurseForge 获取信息
Dim CurseForgeHashes = Loader.Input.Select(Function(m) m.CurseForgeHash) Dim CurseForgeHashes = Loader.Input.Select(Function(m) m.CurseForgeHash)
Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432/", "POST", Dim CurseForgeRaw As JContainer = DlModRequest("https://api.curseforge.com/v1/fingerprints/432/", HttpMethod.Post,
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer) $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")("data")("exactMatches")
For Each ResultJson As JObject In CurseForgeRaw For Each ResultJson As JObject In CurseForgeRaw
If Not ResultJson.ContainsKey("file") Then Continue For If Not ResultJson.ContainsKey("file") Then Continue For
Dim File As JObject = ResultJson("file") Dim File As JObject = ResultJson("file")
@@ -615,7 +617,7 @@ Public Class PageVersionExport
'等待线程结束 '等待线程结束
Do Until EndedThreadCount = 2 Do Until EndedThreadCount = 2
If Loader.IsAborted Then Return If Loader.IsInterrupted Then Return
Thread.Sleep(10) Thread.Sleep(10)
Loop Loop
@@ -646,17 +648,17 @@ Public Class PageVersionExport
Files.Add(New JObject From { Files.Add(New JObject From {
{"path", ModFile.Path.AfterFirst(OverridesFolder).Replace("\", "/")}, {"path", ModFile.Path.AfterFirst(OverridesFolder).Replace("\", "/")},
{"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.Path)}}}, {"hashes", New JObject From {{"sha1", ModFile.ModrinthHash}, {"sha512", GetFileSHA512(ModFile.Path)}}},
{"downloads", New JArray(Pair.Value.OrderByDescending(Function(u) u.Contains("modrinth.com")))}, {"downloads", New JArray(Pair.Value.OrderBy(Function(u) u.Contains("modrinth.com")))}, '不优先选择 Modrinth
{"fileSize", New FileInfo(ModFile.Path).Length} {"fileSize", New FileInfo(ModFile.Path).Length}
}) })
File.Delete(ModFile.Path) File.Delete(ModFile.Path)
Next Next
Loader.Progress = 0.2 Loader.Progress = 0.2
'导出最终 JSON 文件 '导出最终 JSON 文件
Dim Dependencies As New JObject From {{"minecraft", McVersion.Version.McName}} Dim Dependencies As New JObject From {{"minecraft", McVersion.Version.VanillaName}}
If McVersion.Version.HasForge Then Dependencies.Add("forge", McVersion.Version.ForgeVersion) If McVersion.Version.HasForge Then Dependencies.Add("forge", McVersion.Version.Forge)
If McVersion.Version.HasFabric Then Dependencies.Add("fabric-loader", McVersion.Version.FabricVersion) If McVersion.Version.HasFabric Then Dependencies.Add("fabric-loader", McVersion.Version.Fabric)
If McVersion.Version.HasNeoForge Then Dependencies.Add("neoforge", McVersion.Version.NeoForgeVersion) If McVersion.Version.HasNeoForge Then Dependencies.Add("neoforge", McVersion.Version.NeoForge)
Dim ResultJson As New JObject From { Dim ResultJson As New JObject From {
{"game", "minecraft"}, {"game", "minecraft"},
{"formatVersion", 1}, {"formatVersion", 1},
@@ -674,7 +676,7 @@ Public Class PageVersionExport
'首次压缩整合包 '首次压缩整合包
ZipFile.CreateFromDirectory(CacheFolder & "modpack\", CacheFolder & "modpack.mrpack") ZipFile.CreateFromDirectory(CacheFolder & "modpack\", CacheFolder & "modpack.mrpack")
Loader.Progress = 0.5 Loader.Progress = 0.5
Directory.Delete(CacheFolder & "modpack\", True) DeleteDirectory(CacheFolder & "modpack\")
Loader.Progress = 0.6 Loader.Progress = 0.6
'二次压缩整合包 '二次压缩整合包
ZipFile.CreateFromDirectory(CacheFolder, PackPath) ZipFile.CreateFromDirectory(CacheFolder, PackPath)
@@ -684,7 +686,7 @@ Public Class PageVersionExport
ZipFile.CreateFromDirectory(CacheFolder & "modpack\", PackPath) ZipFile.CreateFromDirectory(CacheFolder & "modpack\", PackPath)
Loader.Progress = 0.8 Loader.Progress = 0.8
End If End If
Directory.Delete(CacheFolder, True) DeleteDirectory(CacheFolder, True)
OpenExplorer(PackPath) OpenExplorer(PackPath)
End Sub) With {.ProgressWeight = 6}) End Sub) With {.ProgressWeight = 6})
@@ -709,12 +711,6 @@ Public Class PageVersionExport
End If End If
End Sub End Sub
'勾选 Modrinth 上传模式时,禁止打包 PCL
Private Sub CheckAdvancedModrinth_Change(sender As Object, user As Boolean) Handles CheckAdvancedModrinth.Change
If CheckAdvancedModrinth.Checked Then CheckOptionsPcl.Checked = False
CheckOptionsPcl.IsEnabled = Not CheckAdvancedModrinth.Checked
End Sub
'勾选打包资源文件时,禁止开启 Modrinth 上传模式 '勾选打包资源文件时,禁止开启 Modrinth 上传模式
Private Sub CheckAdvancedInclude_Change(sender As Object, user As Boolean) Handles CheckAdvancedInclude.Change Private Sub CheckAdvancedInclude_Change(sender As Object, user As Boolean) Handles CheckAdvancedInclude.Change
If CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = False If CheckAdvancedInclude.Checked Then CheckAdvancedModrinth.Checked = False
@@ -1,7 +1,7 @@
<local:MyPageLeft x:Class="PageVersionLeft" <local:MyPageLeft x:Class="PageInstanceLeft"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" AnimatedControl="{Binding ElementName=PanItem, Mode=OneWay}"> xmlns:local="clr-namespace:PCL" AnimatedControl="PanItem">
<StackPanel Margin="0,12,0,0" Name="PanItem"> <StackPanel Margin="0,12,0,0" Name="PanItem">
<local:MyListItem x:Name="ItemOverall" IsScaleAnimationEnabled="False" Checked="True" Type="RadioBox" Tag="0" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="概览" <local:MyListItem x:Name="ItemOverall" IsScaleAnimationEnabled="False" Checked="True" Type="RadioBox" Tag="0" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="概览"
Logo="M12 0l-11 6v12.131l11 5.869 11-5.869v-12.066l-11-6.065zm-1 21.2l-6.664-3.555 4.201-2.801c1.08-.719-.066-2.359-1.243-1.575l-4.294 2.862v-7.901l8 4.363v8.607zm-6.867-14.63l6.867-3.746v4.426c0 1.323 2 1.324 2 0v-4.415l6.91 3.811-7.905 4.218-7.872-4.294zm8.867 6.03l8-4.269v7.8l-4.263-2.842c-1.181-.785-2.323.855-1.245 1.574l4.172 2.781-6.664 3.556v-8.6z" /> Logo="M12 0l-11 6v12.131l11 5.869 11-5.869v-12.066l-11-6.065zm-1 21.2l-6.664-3.555 4.201-2.801c1.08-.719-.066-2.359-1.243-1.575l-4.294 2.862v-7.901l8 4.363v8.607zm-6.867-14.63l6.867-3.746v4.426c0 1.323 2 1.324 2 0v-4.415l6.91 3.811-7.905 4.218-7.872-4.294zm8.867 6.03l8-4.269v7.8l-4.263-2.842c-1.181-.785-2.323.855-1.245 1.574l4.172 2.781-6.664 3.556v-8.6z" />
@@ -1,13 +1,13 @@
Public Class PageVersionLeft Public Class PageInstanceLeft
Implements IRefreshable Implements IRefreshable
''' <summary> ''' <summary>
''' 当前显示设置的 MC 版本。 ''' 当前显示设置的 MC 版本。
''' </summary> ''' </summary>
Public Shared Version As McVersion = Nothing Public Shared Instance As McInstance = Nothing
Public Sub RefreshModDisabled() Handles Me.Loaded Public Sub RefreshModDisabled() Handles Me.Loaded
If Version IsNot Nothing AndAlso Version.Modable Then If Instance IsNot Nothing AndAlso Instance.Modable Then
ItemMod.Visibility = Visibility.Visible ItemMod.Visibility = Visibility.Visible
ItemModDisabled.Visibility = Visibility.Collapsed ItemModDisabled.Visibility = Visibility.Collapsed
Else Else
@@ -26,7 +26,7 @@
''' <summary> ''' <summary>
''' 勾选事件改变页面。 ''' 勾选事件改变页面。
''' </summary> ''' </summary>
Private Sub PageCheck(sender As MyListItem, e As RouteEventArgs) Handles ItemOverall.Check, ItemMod.Check, ItemModDisabled.Check, ItemSetup.Check, ItemExport.Check Private Sub PageCheck(sender As FrameworkElement, e As RouteEventArgs) Handles ItemOverall.Check, ItemMod.Check, ItemModDisabled.Check, ItemSetup.Check, ItemExport.Check
'尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0 '尚未初始化控件属性时,sender.Tag 为 Nothing,会导致切换到页面 0
'若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False) '若使用 IsLoaded,则会导致模拟点击不被执行(模拟点击切换页面时,控件的 IsLoaded 为 False)
If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag)) If sender.Tag IsNot Nothing Then PageChange(Val(sender.Tag))
@@ -35,21 +35,21 @@
Public Function PageGet(Optional ID As FormMain.PageSubType = -1) Public Function PageGet(Optional ID As FormMain.PageSubType = -1)
If ID = -1 Then ID = PageID If ID = -1 Then ID = PageID
Select Case ID Select Case ID
Case FormMain.PageSubType.VersionOverall Case FormMain.PageSubType.InstanceOverall
If FrmVersionOverall Is Nothing Then FrmVersionOverall = New PageVersionOverall If FrmInstanceOverall Is Nothing Then FrmInstanceOverall = New PageInstanceOverall
Return FrmVersionOverall Return FrmInstanceOverall
Case FormMain.PageSubType.VersionMod Case FormMain.PageSubType.InstanceMod
If FrmVersionMod Is Nothing Then FrmVersionMod = New PageVersionMod If FrmInstanceMod Is Nothing Then FrmInstanceMod = New PageInstanceMod
Return FrmVersionMod Return FrmInstanceMod
Case FormMain.PageSubType.VersionModDisabled Case FormMain.PageSubType.InstanceModDisabled
If FrmVersionModDisabled Is Nothing Then FrmVersionModDisabled = New PageVersionModDisabled If FrmInstanceModDisabled Is Nothing Then FrmInstanceModDisabled = New PageInstanceModDisabled
Return FrmVersionModDisabled Return FrmInstanceModDisabled
Case FormMain.PageSubType.VersionSetup Case FormMain.PageSubType.InstanceSetup
If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup If IsNothing(FrmInstanceSetup) Then FrmInstanceSetup = New PageInstanceSetup
Return FrmVersionSetup Return FrmInstanceSetup
Case FormMain.PageSubType.VersionExport Case FormMain.PageSubType.InstanceExport
If FrmVersionExport Is Nothing Then FrmVersionExport = New PageVersionExport If FrmInstanceExport Is Nothing Then FrmInstanceExport = New PageInstanceExport
Return FrmVersionExport Return FrmInstanceExport
Case Else Case Else
Throw New Exception("未知的版本设置子页面种类:" & ID) Throw New Exception("未知的版本设置子页面种类:" & ID)
End Select End Select
@@ -99,19 +99,19 @@
End Sub End Sub
Public Sub Refresh(SubType As FormMain.PageSubType) Public Sub Refresh(SubType As FormMain.PageSubType)
Select Case SubType Select Case SubType
Case FormMain.PageSubType.VersionMod Case FormMain.PageSubType.InstanceMod
PageVersionMod.Refresh() PageInstanceMod.Refresh()
ItemMod.Checked = True ItemMod.Checked = True
Case FormMain.PageSubType.VersionExport Case FormMain.PageSubType.InstanceExport
If FrmVersionExport IsNot Nothing Then FrmVersionExport.RefreshAll() If FrmInstanceExport IsNot Nothing Then FrmInstanceExport.RefreshAll()
ItemExport.Checked = True ItemExport.Checked = True
End Select End Select
End Sub End Sub
Public Sub Reset(sender As Object, e As EventArgs) Public Sub Reset(sender As Object, e As EventArgs)
If MyMsgBox("是否要初始化该版本的版本独立设置?该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then If MyMsgBox("是否要初始化该版本的版本独立设置?该操作不可撤销。", "初始化确认",, "取消", IsWarn:=True) = 1 Then
If IsNothing(FrmVersionSetup) Then FrmVersionSetup = New PageVersionSetup If IsNothing(FrmInstanceSetup) Then FrmInstanceSetup = New PageInstanceSetup
FrmVersionSetup.Reset() FrmInstanceSetup.Reset()
ItemSetup.Checked = True ItemSetup.Checked = True
End If End If
End Sub End Sub
@@ -2,8 +2,8 @@
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:local="clr-namespace:PCL" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
mc:Ignorable="d" x:Class="PageVersionMod" mc:Ignorable="d" x:Class="PageInstanceMod"
PanScroll="{Binding ElementName=PanBack}"> PanScroll="PanBack">
<Grid> <Grid>
<Grid x:Name="PanAllBack"> <Grid x:Name="PanAllBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
@@ -22,7 +22,6 @@
<local:MyButton x:Name="BtnManageInstall" Grid.Column="1" MinWidth="110" Text="从文件安装" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnManageInstall" Grid.Column="1" MinWidth="110" Text="从文件安装" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageDownload" Grid.Column="2" MinWidth="110" Text="下载新 Mod" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnManageDownload" Grid.Column="2" MinWidth="110" Text="下载新 Mod" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageSelectAll" Grid.Column="3" MinWidth="110" Text="全选" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" /> <local:MyButton x:Name="BtnManageSelectAll" Grid.Column="3" MinWidth="110" Text="全选" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" />
<local:MyButton x:Name="BtnManageCheck" Grid.Column="4" MinWidth="110" Text="检查 Mod" Padding="13,0" Margin="0,0,15,0" HorizontalAlignment="Left" ToolTip="快速检查 Mod 的版本要求、重复、前置缺失等问题。&#xa;结果仅供参考,由于部分 Mod 标注的信息有误,可能并不准确。" Visibility="Collapsed" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,14" Title=" " MinHeight="55"> <local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,14" Title=" " MinHeight="55">
@@ -31,7 +30,6 @@
<local:MyRadioButton Tag="1" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已启用" x:Name="BtnFilterEnabled" /> <local:MyRadioButton Tag="1" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已启用" x:Name="BtnFilterEnabled" />
<local:MyRadioButton Tag="2" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已禁用" x:Name="BtnFilterDisabled" /> <local:MyRadioButton Tag="2" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已禁用" x:Name="BtnFilterDisabled" />
<local:MyRadioButton Tag="3" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="可更新" x:Name="BtnFilterCanUpdate" /> <local:MyRadioButton Tag="3" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="可更新" x:Name="BtnFilterCanUpdate" />
<local:MyRadioButton Tag="4" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="错误" x:Name="BtnFilterError" />
</StackPanel> </StackPanel>
<StackPanel Margin="20,48,18,22" Name="PanList" VerticalAlignment="Top" /> <StackPanel Margin="20,48,18,22" Name="PanList" VerticalAlignment="Top" />
</local:MyCard> </local:MyCard>

Some files were not shown because too many files have changed in this diff Show More